!*******************************************************************************
!>  @file v3fit_context.f
!>  @brief Contains module @ref v3fit_context.
!
!  Note separating the Doxygen comment block here so detailed decription is
!  found in the Module not the file.
!
!>  Defines a @ref v3fit_context_class object to contain all the memory for
!>  running v3fit. Contains methods to write memory to disk.
!*******************************************************************************

      MODULE v3fit_context
      USE v3fit_input
      USE v3fit_params
      USE commandline_parser
      USE reconstruction
      USE ezcdf

      IMPLICIT NONE

!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) v3fit context
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!>  Base class representing a v3fit context. This contains all memory needed to
!>  operate v3fit.
!-------------------------------------------------------------------------------
      TYPE v3fit_context_class
!>  Stopping criteria for change in g^2.
         REAL (rprec)                                 :: recon_stop

!>  File input output unit for the runlog file. This file is a human readable
!>  output history of a v3fit run.
         INTEGER                                      :: runlog_iou
!>  File input output unit for the recout file. This file is a human readable
!>  output of the final result.
         INTEGER                                      :: recout_iou

!>  The parsed command line options.
         TYPE (commandline_parser_class), POINTER :: cl_parser => null()
!>  The equilibrium model.
         TYPE (model_class), POINTER                  :: model => null()
!>  Guassian process models.
         TYPE (gaussp_class_pointer), DIMENSION(:), POINTER ::                 &
     &      gp => null()
!>  Array of signals.
!>  @see signal
         TYPE (signal_pointer), DIMENSION(:), POINTER ::                       &
     &      signals => null()
!>  Array of derived parameters.
!>  @see param
         TYPE (param_pointer), DIMENSION(:), POINTER  ::                       &
     &      derived_params => null()
!>  Arrays of reconstruction parameters.
!>  @see param
         TYPE (param_pointer), DIMENSION(:), POINTER :: params => null()
!>  Array of locking parameters.
         TYPE (param_pointer), DIMENSION(:), POINTER  :: locks => null()
!>  The reconstruction algorithm object.
         TYPE (reconstruction_class), POINTER         :: recon => null()

!  The default for the following index is -1 indicating that this signal hasn't
!  been created.
!>  Index of the first instance of a @ref magnetic signal. The default -1
!>  represents no @ref magnetic signal created.
         INTEGER :: magnetic_index = -1
!>  Index of the first instance of a @ref sxrem signal. The default -1
!>  represents no @ref sxrem signal created.
         INTEGER :: sxrem_index = -1
!>  Index of the first instance of a @ref intpol signal. The default -1
!>  represents no @ref intpol signal created.
         INTEGER :: intpol_index = -1
!>  Index of the first instance of a @ref thomson signal. The default -1
!>  represents no @ref thomson signal created.
         INTEGER :: thomson_index = -1
!>  Index of the first instance of a @ref extcurz signal. The default -1
!>  represents no @ref extcurz signal created.
         INTEGER :: extcurz_index = -1
!>  Index of the first instance of a @ref mse signal. The default -1
!>  represents no @ref mse signal created.
         INTEGER :: mse_index = -1
!>  Index of the first instance of a @ref ece signal. The default -1
!>  represents no @ref ece signal created.
         INTEGER :: ece_index = -1
!>  Index of the first instance of a @ref limiter signal. The default -1
!>  represents no @ref limiter signal created.
         INTEGER :: limiter_index = -1
!>  Index of the first instance of a @ref prior_gaussian signal. The default -1
!>  represents no @ref prior_gaussian signal created.
         INTEGER :: prior_gaussian_index = -1
!>  Index of the first instance of a @ref prior_gaussian signal. The default -1
!>  represents no @ref prior_gaussian signal created.
         INTEGER :: sxrem_ratio_index = -1
!>  Index of the first instance of a @ref combination_class signal. The default
!>  -1 represents no @ref combination_class signal created.
         INTEGER :: combination_index = -1

!>  NetCDF result file to write out the results in machine readable form.
         INTEGER :: result_ncid

!--- MPI -----------------------------------------------------------------------
#if defined (MPI_OPT)
!>  MPI communicator reference for full domain.
         INTEGER :: global_comm = MPI_COMM_NULL
!>  MPI communicator reference for the equilibrium domain.
         INTEGER :: equilibrium_comm = MPI_COMM_NULL
!>  MPI communicator reference for the reconstruction domain.
         INTEGER :: reconstruction_comm = MPI_COMM_NULL
#endif
      END TYPE

      CONTAINS
!*******************************************************************************
!  CONSTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!>  @brief Construct a @ref v3fit_context_class object.
!>
!>  Allocates memory and initializes a @ref v3fit_context_class object with an
!>  instance of a @ref commandline_parser object. This opens files for the
!>  recout, runlog, and result files. Over allocates space for the number of
!>  signals.
!>
!>  @param[in] cl_parser An instance of a commandline parser object.
!>  @returns A pointer to a constructed @ref v3fit_context_class object.
!-------------------------------------------------------------------------------
      FUNCTION v3fit_context_construct(cl_parser)

      IMPLICIT NONE

!  Declare Arguments
      TYPE (v3fit_context_class), POINTER  :: v3fit_context_construct
      TYPE (commandline_parser_class), POINTER :: cl_parser

!  local variables
      REAL (rprec)                         :: start_time

!  Start of executable code
      start_time = profiler_get_start_time()

      ALLOCATE(v3fit_context_construct)

      v3fit_context_construct%cl_parser => cl_parser

      CALL profiler_set_stop_time('v3fit_context_construct', start_time)

      END FUNCTION

!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!>  @brief Deconstruct a @ref v3fit_context_class object.
!>
!>  Deallocates memory and uninitializes a @ref v3fit_context_class object. This
!>  all the v3fit constructed objects are destroyed here.
!>
!>  @param[inout] this A @ref v3fit_context_class instance.
!-------------------------------------------------------------------------------
      SUBROUTINE v3fit_context_destruct(this)

      IMPLICIT NONE

!  Declare Arguments
      TYPE (v3fit_context_class), POINTER :: this

!  local variables
      INTEGER                             :: i

!  Start of executable code
      IF (ASSOCIATED(this%cl_parser)) THEN
         CALL commandline_parser_destruct(this%cl_parser)
         this%cl_parser => null()
      END IF

      IF (ASSOCIATED(this%model)) THEN
         CALL model_destruct(this%model)
         this%model => null()
      END IF

!  Deconstruct and deallocate all the signals.
      IF (ASSOCIATED(this%gp)) THEN
         DO i = 1, SIZE(this%gp)
            IF (ASSOCIATED(this%gp(i)%p)) THEN
               CALL gaussp_destruct(this%gp(i)%p)
               this%gp(i)%p => null()
            END IF
         END DO
         DEALLOCATE(this%gp)
         this%signals => null()
      END IF

!  Deconstruct and deallocate all the signals.
      IF (ASSOCIATED(this%signals)) THEN
         DO i = 1, SIZE(this%signals)
            IF (ASSOCIATED(this%signals(i)%p)) THEN
               DEALLOCATE(this%signals(i)%p)
               this%signals(i)%p => null()
            END IF
         END DO
         DEALLOCATE(this%signals)
         this%signals => null()
      END IF

!  Deconstruct and deallocate all the derived parameters.
      IF (ASSOCIATED(this%derived_params)) THEN
         DO i = 1, SIZE(this%derived_params)
            IF (ASSOCIATED(this%derived_params(i)%p)) THEN
               CALL param_destruct(this%derived_params(i)%p)
               this%derived_params(i)%p => null()
            END IF
         END DO
         DEALLOCATE(this%derived_params)
         this%derived_params => null()
      END IF

!  Deconstruct and deallocate all the parameters.
      IF (ASSOCIATED(this%params)) THEN
         DO i = 1, SIZE(this%params)
            IF (ASSOCIATED(this%params(i)%p)) THEN
               CALL param_destruct(this%params(i)%p)
               this%params(i)%p => null()
            END IF
         END DO
         DEALLOCATE(this%params)
         this%params => null()
      END IF

!  Deconstruct and deallocate all the parameters.
      IF (ASSOCIATED(this%params)) THEN
         DO i = 1, SIZE(this%locks)
            IF (ASSOCIATED(this%locks(i)%p)) THEN
               CALL param_destruct(this%locks(i)%p)
               this%locks(i)%p => null()
            END IF
         END DO
         DEALLOCATE(this%locks)
         this%locks => null()
      END IF

      IF (ASSOCIATED(this%recon)) THEN
         CALL reconstruction_destruct(this%recon)
         this%recon => null()
      END IF

!  Reset the signal index
      this%prior_gaussian_index = -1
      this%magnetic_index = -1
      this%sxrem_index = -1
      this%intpol_index = -1
      this%thomson_index = -1
      this%extcurz_index = -1
	  this%mse_index = -1
	  this%ece_index = -1
      this%limiter_index = -1
      this%sxrem_ratio_index = -1
      this%combination_index = -1

      DEALLOCATE(this)

      END SUBROUTINE

!*******************************************************************************
!  UTILITY SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!>  @brief Resize the arrays.
!>
!>  Resizes the signal arrays to contain only the minimun necessary to hold all
!>  signals. If no signals were constructed, the signal array is not allocated.
!>
!>  @param[inout] this A @ref v3fit_context_class instance.
!-------------------------------------------------------------------------------
      SUBROUTINE v3fit_context_resize(this)

      IMPLICIT NONE

!  Declare Arguments
      TYPE (v3fit_context_class), INTENT(inout)    :: this

!  local variables
      INTEGER                                      :: i
      INTEGER                                      :: minsize
      TYPE (signal_pointer), DIMENSION(:), POINTER :: temp_signal
      REAL (rprec)                                 :: start_time

!  Start of executable code
      start_time = profiler_get_start_time()

      WRITE (*,*) ' *** Resizing context arrays'
      WRITE (this%runlog_iou,*) ' *** Resizing context arrays'

!  Search an array for the first instance of a null pointer.
      IF (ASSOCIATED(this%signals)) THEN
         minsize = SIZE(this%signals)
         DO i = 1, SIZE(this%signals)
            IF (.not.ASSOCIATED(this%signals(i)%p)) THEN
               minsize = i - 1
               EXIT
            END IF
         END DO

!  Deallocate the array if no signals are used. Reallocate the array if it is
!  smaller.
         IF (minsize .eq. 0) THEN
            DEALLOCATE(this%signals)
            this%signals => null()

            CALL profiler_set_stop_time('v3fit_context_resize',                &
     &                                  start_time)

            RETURN
         ELSE IF (minsize .lt. SIZE(this%signals)) THEN
            ALLOCATE(temp_signal(minsize))
            DO i = 1, minsize
               temp_signal(i)%p => this%signals(i)%p
            END DO

            DEALLOCATE(this%signals)
            this%signals => temp_signal
         END IF

      END IF

      CALL profiler_set_stop_time('v3fit_context_resize', start_time)

      END SUBROUTINE

!-------------------------------------------------------------------------------
!>  @brief Create output files.
!>
!>  Creates output files that reconstructed results are written to.
!>
!>  @param[inout] this A @ref v3fit_context_class instance.
!-------------------------------------------------------------------------------
      SUBROUTINE v3fit_context_create_files(this)
      USE safe_open_mod

      IMPLICIT NONE

!  Declare Arguments
      TYPE (v3fit_context_class), INTENT(inout) :: this

!  local variables
      CHARACTER (len=path_length)               :: filename
      INTEGER                                   :: status
      INTEGER                                   :: recon_rank
      REAL (rprec)                              :: start_time

!  Start of executable code
      start_time = profiler_get_start_time()

#if defined(MPI_OPT)
      CALL MPI_COMM_RANK(this%reconstruction_comm, recon_rank, status)
#else
      recon_rank = 0
#endif

      filename = commandline_parser_get_string(this%cl_parser, '-file')

!  Setup the runlog file.
!  Initalize a default value of the I\O unit. V3FIT increments from there.
      this%runlog_iou = 0
      CALL safe_open(this%runlog_iou, status,                                  &
     &               TRIM('runlog.' // filename_base(filename)),               &
     &               'replace', 'formatted', delim_in='none')
      CALL assert_eq(0, status, 'v3fit_context_construct: ' //                 &
     &               'Safe_open of runlog. ' //                                &
     &               TRIM(filename_base(filename)) // 'failed')

!  Setup the recout file.
!  Initalize a default value of the I\O unit. V3FIT increments from there.
      this%recout_iou = 0
      CALL safe_open(this%recout_iou, status,                                  &
     &               TRIM('recout.' // filename_base(filename)),               &
     &               'replace', 'formatted', delim_in='none')
      CALL assert_eq(0, status, 'v3fit_context_construct: ' //                 &
     &               'Safe_open of recout. ' //                                &
     &               TRIM(filename_base(filename)) // 'failed')

      IF (commandline_parser_is_flag_set(this%cl_parser,                       &
     &                                   '-restart') .and.                     &
     &    recon_rank .eq. 0) THEN
         filename = commandline_parser_get_string(this%cl_parser,              &
     &                                            '-restart')
         status = nf90_open(filename, NF90_WRITE, this%result_ncid)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      ELSE
!  Create a result file.
         status = nf90_create('result.' // TRIM(filename_base(filename))       &
     &                        // '.nc', nf90_clobber,                          &
     &                        this%result_ncid)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

      WRITE (this%runlog_iou, *) 'V3FITA RUN'
      WRITE (this%runlog_iou, *) '  Namelist Input from file ',                &
     &                           TRIM(filename)

      WRITE (this%recout_iou, *) 'V3FITA RUN'
      WRITE (this%recout_iou, *) '  Namelist Input from file ',                &
     &                           TRIM(filename)

      CALL profiler_set_stop_time('v3fit_context_create_files',                &
     &                            start_time)

      END SUBROUTINE

!-------------------------------------------------------------------------------
!>  @brief Close output files.
!>
!>  Closes output files that reconstructed results are written to.
!>
!>  @param[inout] this A @ref v3fit_context_class instance.
!-------------------------------------------------------------------------------
      SUBROUTINE v3fit_context_close_files(this)

      IMPLICIT NONE

!  Declare Arguments
      TYPE (v3fit_context_class), INTENT(inout) :: this

!  local variables
      INTEGER                                   :: status
      REAL (rprec)                              :: start_time

!  Start of executable code
      start_time = profiler_get_start_time()

      CLOSE(this%runlog_iou)
      CLOSE(this%recout_iou)

      status = nf90_close(this%result_ncid)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

      CALL profiler_set_stop_time('v3fit_context_close_files',                 &
     &                            start_time)

      END SUBROUTINE

!-------------------------------------------------------------------------------
!>  @brief Write the @ref v3fit_context_class out to disk.
!>
!>  Writes out the results of v3fit to the recout file.
!>
!>  @param[inout] this A @ref v3fit_context_class instance.
!>  @note The 'this' parameter is intent(inout) because
!>        @ref signal::signal_write calls @ref signal::signal_get_g2 which needs
!>        to be intent(inout).
!-------------------------------------------------------------------------------
      SUBROUTINE v3fit_context_write(this)

      IMPLICIT NONE

!  Declare Arguments
      TYPE (v3fit_context_class), INTENT(inout) :: this

!  local variables
      INTEGER                                   :: i, j
      REAL (rprec), DIMENSION(:), ALLOCATABLE   :: sem_row
      INTEGER                                   :: sem_offset
!  Fortran 95 doesn't allow allocatable strings. Need to allocate a string large
!  enough to hold every possible parameter. Fortran 95 doesn't allow allocatable
!  scalar types so make this a pointer. This large string needs to be allocated
!  to avoid a stack overflow.
      CHARACTER (len=26 + 14*v3fit_max_parameters), POINTER ::                 &
     &   sem_header
      INTEGER, DIMENSION(:), ALLOCATABLE        :: indices
      CLASS (signal_class), POINTER             :: temp_signal
      REAL (rprec)                              :: start_time

!  local parameters
      CHARACTER (len=12), PARAMETER :: prefix = '            '

!  Start of executable code
      start_time = profiler_get_start_time()

      WRITE (*,*) ' *** Writing context to disk'
      WRITE (this%runlog_iou,*) ' *** Writing context to disk'

!  Make the sem_header null so it may be allocated and deallocated.
      sem_header => null()

!  Write out the reconstruction
      IF (ASSOCIATED(this%recon)) THEN
         CALL reconstruction_write(this%recon, this%recout_iou)
      END IF

!  Write out the derived parameters
      IF (ASSOCIATED(this%derived_params)) THEN
         CALL param_write_header_short(this%recout_iou)
         DO j = 1, SIZE(this%derived_params)
            CALL param_write_short(this%derived_params(j)%p,                   &
     &                             this%recout_iou, j, this%model)
         END DO

!  Write out the derived parameter correlation matrix.
         IF (SIZE(this%derived_params) .gt. 0) THEN
            IF (ASSOCIATED(this%derived_params(1)%p%correlation)) THEN
               CALL v3fit_context_write_param_header(this,                     &
     &                  this%derived_params, prefix,                           &
     &                  ' *** Derived parameter covariance matrix')

               DO j = 1, SIZE(this%derived_params)
                  CALL param_write_correlation(this%derived_params(j)%p,       &
     &                                         this%recout_iou,                &
     &                                         this%model)
               END DO
            END IF
         END IF
      END IF

!  Write out the parameters
      IF (ASSOCIATED(this%params)) THEN
         CALL param_write_header(this%recout_iou)
         DO j = 1, SIZE(this%params)
            CALL param_write(this%params(j)%p, this%recout_iou, j,             &
     &                       this%model)
         END DO

!  Write out the reconstruction parameter correlation matrix.
         IF (SIZE(this%params) .gt. 0 .and.                                    &
     &       ASSOCIATED(this%params(1)%p%correlation)) THEN
            CALL v3fit_context_write_param_header(this, this%params,           &
     &                                            prefix,                      &
     &                                            ' *** Reconstruction '       &
     &                                            // 'parameter ' //           &
     &                                            'covariance ' //             &
     &                                            'matrix')

            DO j = 1, SIZE(this%params)
               CALL param_write_correlation(this%params(j)%p,                  &
     &                                      this%recout_iou, this%model)
            END DO
         END IF

!  Only need to write out the signal effectiveness matrix if signals exist.
         IF (ASSOCIATED(this%signals)) THEN

!  Write out the signal effectiveness matrix. This matrix will be written out
!  so that each parameter is one a column and each row is a a signal. Start by
!  generating the header.
            CALL v3fit_context_write_param_header(this, this%params,           &
     &                                            '   #  s_name     ' //       &
     &                                            '         ',                 &
     &                                            ' *** Signal ' //            &
     &                                            'Effectiveness ' //          &
     &                                            'Matrix')

!  Write out each row of the sem matrix.
!  Reuse the sem_header string to generate the format string. The format string
!  will be
!
!  i4,2x,a20,<num_params>(2x,es12.5)
            ALLOCATE(sem_row(SIZE(this%params)))
            ALLOCATE(sem_header)
            WRITE (sem_header, 1002) SIZE(this%params)

            DO i = 1, SIZE(this%signals)
               temp_signal => this%signals(i)%p

               DO j = 1, SIZE(this%params)
                  sem_row(j) = this%params(j)%p%recon%sem(i)
               END DO

               WRITE (this%recout_iou, sem_header(1:26))                       &
     &            i, temp_signal%s_name, sem_row
            END DO

!  Write out the total for each column. Sum over all the signals for a single
!  parameter. This should be 1.0.
            WRITE (sem_header, 1003) SIZE(this%params)
            DO j = 1, SIZE(this%params)
               sem_row(j) = SUM(this%params(j)%p%recon%sem)
            END DO

            WRITE (this%recout_iou, *)
            WRITE (this%recout_iou, sem_header) sem_row

!  Write out the most effective signal.
            ALLOCATE(indices(SIZE(this%params)))

            WRITE (sem_header, 1001) '    Most Effective Signal:'
            sem_offset = 26
            DO j = 1, SIZE(this%params)
               indices(j) = MAXLOC(this%params(j)%p%recon%sem, 1)
               sem_row(j) = this%params(j)%p%recon%sem(indices(j))

               WRITE (sem_header, 1000)                                        &
     &            sem_header(1:sem_offset),                                    &
     &            TRIM(this%signals(indices(j))%p%s_name)
               sem_offset = sem_offset + 14
            END DO
            WRITE (this%recout_iou, 1001)                                      &
     &         sem_header(1:26 + 14*SIZE(this%params))

            WRITE (sem_header, 1005) SIZE(this%params)
            WRITE (this%recout_iou, sem_header) indices

            WRITE (sem_header, 1006) SIZE(this%params)
            WRITE (this%recout_iou, sem_header) sem_row

            DEALLOCATE(indices)
            DEALLOCATE(sem_header)
            DEALLOCATE(sem_row)
         END IF

1000  FORMAT (a,2x,a12)
1001  FORMAT (a)
1002  FORMAT ('(i4,2x,a20,',i3,'(2x,es12.5))')
1003  FORMAT ('(20x,''Total:''',i3,'(2x,es12.5))')
1005  FORMAT ('(13x,''Signal Index:''',i3,'(2x,i12))')
1006  FORMAT ('(16x,''Max Value:''',i3,'(2x,es12.5))')
      END IF

!  Write out the model.
      IF (ASSOCIATED(this%model)) THEN
         CALL model_write(this%model, this%recout_iou)
      END IF

!  Write out the signals
      IF (ASSOCIATED(this%signals)) THEN
         WRITE (this%recout_iou, *)
         WRITE (this%recout_iou, *) ' *** Signals'

         DO i = 1, SIZE(this%signals)
            temp_signal => this%signals(i)%p

!  Check if the index has reached a new signal type
            IF ((1                         .eq. i) .or.                        &
     &          (this%magnetic_index       .eq. i) .or.                        &
     &          (this%sxrem_index          .eq. i) .or.                        &
     &          (this%intpol_index         .eq. i) .or.                        &
     &          (this%thomson_index        .eq. i) .or.                        &
     &          (this%extcurz_index        .eq. i) .or.                        &
     &          (this%mse_index            .eq. i) .or.                        &
     &          (this%ece_index            .eq. i) .or.                        &
     &          (this%limiter_index        .eq. i) .or.                        &
     &          (this%prior_gaussian_index .eq. i) .or.                        &
     &          (this%sxrem_ratio_index    .eq. i) .or.                        &
     &          (this%combination_index    .eq. i)) THEN

               CALL temp_signal%write_header(this%recout_iou)
            END IF

            CALL temp_signal%write(this%recout_iou, i, this%model)
         END DO

!  All the signals should be written out before auxiliary information.
         DO i = 1, SIZE(this%signals)
            temp_signal => this%signals(i)%p
            CALL temp_signal%write_auxiliary(this%recout_iou, i,               &
     &                                       this%model)
         END DO
      END IF

      CALL profiler_set_stop_time('v3fit_context_write', start_time)

      END SUBROUTINE

!-------------------------------------------------------------------------------
!>  @brief Write the @ref param_class::correlation header out to disk.
!>
!>  Writes out the results of header for a correlation matric. This header is
!>  formatted by a an inital col left blank followed by eack parameter name
!>  spaced 14 spaced apart from each other.
!>
!>  @param[inout] this      A @ref v3fit_context_class instance.
!>  @param[in]    params    Array of parameter objects.
!>  @param[in]    prefix    Prefix string to format the header.
!>  @param[in]    type_name Type name of the parameters.
!>  @note The 'this' parameter is intent(inout) because
!>        @ref signal::signal_write calls @ref signal::signal_get_g2 which needs
!>        to be intent(inout).
!>  @node The 'prefix' parameter must be an exact length string with all white
!>        space predefined.
!-------------------------------------------------------------------------------
      SUBROUTINE v3fit_context_write_param_header(this, params, prefix,        &
     &                                            type_name)

      IMPLICIT NONE

!  Declare Arguments
      TYPE (v3fit_context_class), INTENT(inout) :: this
      TYPE (param_pointer), DIMENSION(:)        :: params
      CHARACTER (len=*)                         :: prefix
      CHARACTER (len=*)                         :: type_name

!  local variables
!  Fortran 95 doesn't allow allocatable strings. Need to allocate a string large
!  enough to hold every possible parameter. Fortran 95 doesn't allow allocatable
!  scalar types so make this a pointer. This large string needs to be allocated
!  to avoid a stack overflow. The longest header generate will be the signal
!  effectiveness matrix. Make the start of this string at least 26 characters.
      CHARACTER (len=26 + 14*v3fit_max_parameters), POINTER :: header
      INTEGER                                   :: offset, j
      REAL (rprec)                              :: start_time

!  Start of executable code
      start_time = profiler_get_start_time()

      WRITE (this%recout_iou, *)
      WRITE (this%recout_iou, *) type_name

! The header is formatted as
!
!  <prefix> (param_name[12]) ...
!
!  Start by allocating a string large enough to hold the entire header. The
!  length of this string needs to be the size of the prefix plus an additional
!  14 for each parameter. The prefix string must be an exact length.
      header => null()
      ALLOCATE(header)

      WRITE (header, 1000) prefix
      offset = LEN(prefix)
      DO j = 1, SIZE(params)
         WRITE (header, 1001) header(1:offset),                                &
     &                        param_get_name(params(j)%p, this%model)
         offset = offset + 14
      END DO

      WRITE (this%recout_iou, 1000) header(1:offset)

      DEALLOCATE(header)

      CALL profiler_set_stop_time('v3fit_context_write_param_header',          &
     &                            start_time)

1000  FORMAT (a)
1001  FORMAT (a,2x,a12)

      END SUBROUTINE

!*******************************************************************************
!  NETCDF SUBROUTINES
!*******************************************************************************
!>  @page result_file_main Result File
!>
!>  @tableofcontents
!>  @section result_file_main_intro_sec Introduction
!>  This page documents the contents of a result NetCDF file.
!>
!>  @section result_file_main_dim_sec Dimensions
!>  @header{Dimension, Description, Code Reference}
!>  @begin_table
!>     @item{maxnsteps,   The max number of reconstruction steps., v3fit_input::nrstep}
!>     @item{ndparam,     Number of derived parameters.,           v3fit_input::n_dp}
!>     @item{nparam,      Number of reconstruction parameters.,    v3fit_input::n_rp}
!>     @item{nparamindex, Number of parameter indices.,            data_parameters::data_max_indices}
!>     @item{nsignal,     Number of constructed signals.,          v3fit_context::v3fit_context_class::signals}
!>     @item{string_len,  Max lenth of strings.,                   data_parameters::data_name_length}
!>  @end_table
!>  @subsection result_file_main_eq_dim_sec Equilibrium Dimensions
!>  Equilibrium dimensions change depending on the equilibrium used.
!>  * Model @ref result_file_model_dim_sec
!>  * VMEC @ref result_file_vmec_dim_sec
!>
!>  @section result_file_main_var_sec Variables
!>  @header{Variable(Dimensions), Description, Code Reference}
!>  @begin_table
!>     @item{nsteps,         Actual number of steps taken.,           reconstruction::reconstruction_class::current_step}
!>     @item{g2 (maxnsteps), g^2 value for each reconstruction step., reconstruction::reconstruction_get_g2}
!>  @end_table
!>  @table_section{result_file_main_dir_param_var_sec, Derived Parameter Variables}
!>     @item{derived_param_name (string_len\, ndparam),           Name of the derived parameter.,               v3fit_params::param_get_name}
!>     @item{derived_param_index (nparamindex\, ndparam),         Indices of the derived parameter.,            v3fit_params::param_class::indices}
!>     @item{derived_param_value (ndparam\, maxnsteps),           Parameter values for each derived step.,      v3fit_params::param_get_value}
!>     @item{derived_param_sigma (ndparam\, maxnsteps),           Parameter sigmas for each derived step.,      v3fit_params::param_class::sigma}
!>     @item{derived_param_corr  (ndparam\, ndparam\, maxnsteps), Correlation matrix of the derived parameters, v3fit_params::param_class::correlation}
!>  @end_table
!>  @table_section{result_file_main_param_var_sec, Reconstruction Parameter Variables}
!>     @item{param_name (string_len\, nparam),                 Name of the reconstruction parameter.,               v3fit_params::param_get_name}
!>     @item{param_index (nparamindex\, nparam),               Indices of the reconstruction parameter.,            v3fit_params::param_class::indices}
!>     @item{param_value (nparam\, maxnsteps),                 Parameter values for each reconstruction step.,      v3fit_params::param_get_value}
!>     @item{param_sigma (nparam\, maxnsteps),                 Parameter sigmas for each reconstruction step.,      v3fit_params::param_class::sigma}
!>     @item{param_corr  (nparam\, nparam\, maxnsteps),        Correlation matrix of the reconstruction parameters, v3fit_params::param_class::correlation}
!>     @item{signal_eff_matrix (nsignal\, nparam\, maxnsteps), Signal effectiveness for each reconstruction step.,  v3fit_params::param_recon_class::sem}
!>  @end_table
!>  @table_section{result_file_main_sig_var_sec, Signal Variables}
!>     @item{signal_name (string_len\, nsignal),       Short name of the signal.,                                signal::signal_class::s_name}
!>     @item{signal_type (string_len\, nsignal),       Description of the signal.,                               signal::signal_get_type}
!>     @item{signal_weight (nsignal),                  Weight value of the signal.,                              signal::signal_class::weight}
!>     @item{signal_observed_value (nsignal),          Observed value of the signal.,                            signal::signal_class::observed}
!>     @item{signal_model_value (nsignal\, maxnsteps), Modeled value of the signal at each reconstruction step., signal::signal_get_modeled_signal}
!>     @item{signal_sigma_value (nsignal\, maxnsteps), Sigma value of the signal at each reconstruction step.,   signal::signal_get_g2}
!>  @end_table
!>  @subsection result_file_main_eq_var_sec Equilibrium Variables
!>  Equilibrium variables change depending on the equilibrium used.
!>  * Model @ref result_file_model_var_sec
!>  * VMEC @ref result_file_vmec_var_sec
!-------------------------------------------------------------------------------
!>  @brief Initialize the dimensions and variables of the result file.
!>
!>  Defines dimensions, variables and writes out the initial step of v3fit to
!>  result netcdf file. Multi dimensional arrays need to be transposed so arrays
!>  appear in the correct order in non fortran languages.
!>
!>  @param[inout] this     A @ref v3fit_context_class instance.
!>  @param[in]    eq_steps Number of steps taken by the equilibrium.
!-------------------------------------------------------------------------------
      SUBROUTINE v3fit_context_init_data(this, eq_steps)

      IMPLICIT NONE

!  Declare Arguments
      TYPE (v3fit_context_class), INTENT(inout) :: this
      INTEGER, INTENT(in)                       :: eq_steps

!  local variables
      INTEGER :: i, status
      INTEGER :: maxnsteps_dim_id
      INTEGER :: ndparam_dim_id
      INTEGER :: nparam_dim_id
      INTEGER :: nparamindex_dim_id
      INTEGER :: nsignal_dim_id
      INTEGER :: n_sig_models_dim_id
      INTEGER :: string_len_dim_id
      INTEGER :: nsteps_id
      INTEGER :: eq_steps_id
      INTEGER :: g2_id
      INTEGER :: derived_param_name_id
      INTEGER :: derived_param_index_id
      INTEGER :: derived_param_value_id
      INTEGER :: derived_param_sigma_id
      INTEGER :: derived_param_corr_id
      INTEGER :: param_name_id
      INTEGER :: param_index_id
      INTEGER :: param_value_id
      INTEGER :: param_sigma_id
      INTEGER :: param_corr_id
      INTEGER :: param_sem_id
      INTEGER :: signal_name_id
      INTEGER :: signal_type_id
      INTEGER :: signal_weight_id
      INTEGER :: signal_observed_value_id
      INTEGER :: signal_model_value_id
      INTEGER :: signal_sigma_value_id

      CLASS (signal_class), POINTER             :: temp_signal
      REAL (rprec)                              :: start_time

!  Start of executable code
      start_time = profiler_get_start_time()

!  Define dimensions
      status = nf90_noerr

      IF (ASSOCIATED(this%recon)) THEN
         status = nf90_def_dim(this%result_ncid, 'maxnsteps',                  &
     &                         nf90_unlimited, maxnsteps_dim_id)
      ELSE
         status = nf90_def_dim(this%result_ncid, 'maxnsteps', 1,               &
     &                         maxnsteps_dim_id)
      END IF
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

      IF (ASSOCIATED(this%params)  .or.                                        &
     &    ASSOCIATED(this%signals) .or.                                        &
     &    ASSOCIATED(this%model)) THEN
         status = nf90_def_dim(this%result_ncid, 'string_len',                 &
     &                         data_name_length, string_len_dim_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

      IF (ASSOCIATED(this%derived_params) .and.                                &
     &    SIZE(this%derived_params) .gt. 0) THEN
         status = nf90_def_dim(this%result_ncid, 'ndparam',                    &
     &                         SIZE(this%derived_params),                      &
     &                         ndparam_dim_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

      IF (ASSOCIATED(this%params)) THEN
         status = nf90_def_dim(this%result_ncid, 'nparam',                     &
     &                         SIZE(this%params), nparam_dim_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_dim(this%result_ncid, 'nparamindex',                &
     &                         2, nparamindex_dim_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

      IF (ASSOCIATED(this%signals)) THEN
         status = nf90_def_dim(this%result_ncid, 'nsignal',                    &
     &                         SIZE(this%signals), nsignal_dim_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

      IF (ASSOCIATED(this%signals)) THEN
         status = nf90_def_dim(this%result_ncid, 'n_sig_models', 4,            &
     &                         n_sig_models_dim_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

!  Define variables
      status = nf90_def_var(this%result_ncid, 'nsteps', nf90_int,              &
     &                      varid=nsteps_id)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

      status = nf90_def_var(this%result_ncid, 'eq_steps', nf90_int,            &
     &                      varid=eq_steps_id)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

      IF (ASSOCIATED(this%recon)) THEN
         status = nf90_def_var(this%result_ncid, 'g2', nf90_double,            &
     &                         dimids=(/ maxnsteps_dim_id /),                  &
     &                         varid=g2_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

!  Define derived parameter variables.
      IF (ASSOCIATED(this%derived_params) .and.                                &
     &    SIZE(this%derived_params) .gt. 0) THEN
         status = nf90_def_var(this%result_ncid, 'derived_param_name',         &
     &                         nf90_char,                                      &
     &                         dimids=(/ string_len_dim_id,                    &
     &                                   ndparam_dim_id /),                    &
     &                         varid=derived_param_name_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'derived_param_index',        &
     &                         nf90_int,                                       &
     &                         dimids=(/ nparamindex_dim_id,                   &
     &                                   ndparam_dim_id /),                    &
     &                         varid=derived_param_index_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'derived_param_value',        &
     &                         nf90_double,                                    &
     &                         dimids=(/ ndparam_dim_id,                       &
     &                                   maxnsteps_dim_id /),                  &
     &                         varid=derived_param_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'derived_param_sigma',        &
     &                         nf90_double,                                    &
     &                         dimids=(/ ndparam_dim_id,                       &
     &                                   maxnsteps_dim_id /),                  &
     &                         varid=derived_param_sigma_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'derived_param_corr',         &
     &                         nf90_double,                                    &
     &                         dimids=(/ ndparam_dim_id,                       &
     &                                   ndparam_dim_id,                       &
     &                                   maxnsteps_dim_id /),                  &
     &                         varid=derived_param_corr_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

!  Define reconstruction parameter variables.
      IF (ASSOCIATED(this%params)) THEN
         status = nf90_def_var(this%result_ncid, 'param_name',                 &
     &                         nf90_char, dimids=(/ string_len_dim_id,         &
     &                                              nparam_dim_id /),          &
     &                         varid=param_name_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'param_index',                &
     &                         nf90_int, dimids=(/ nparamindex_dim_id,         &
     &                                             nparam_dim_id /),           &
     &                         varid=param_index_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'param_value',                &
     &                         nf90_double,                                    &
     &                         dimids=(/ nparam_dim_id,                        &
     &                                   maxnsteps_dim_id /),                  &
     &                         varid=param_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'param_sigma',                &
     &                         nf90_double,                                    &
     &                         dimids=(/ nparam_dim_id,                        &
     &                                   maxnsteps_dim_id /),                  &
     &                         varid=param_sigma_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'param_corr',                 &
     &                         nf90_double,                                    &
     &                         dimids=(/ nparam_dim_id,                        &
     &                                   nparam_dim_id,                        &
     &                                   maxnsteps_dim_id /),                  &
     &                         varid=param_corr_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'signal_eff_matrix',          &
     &                         nf90_double,                                    &
     &                         dimids=(/ nsignal_dim_id,                       &
     &                                   nparam_dim_id,                        &
     &                                   maxnsteps_dim_id /),                  &
     &                         varid=param_sem_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

!  Define signal variables.
      IF (ASSOCIATED(this%signals)) THEN
         status = nf90_def_var(this%result_ncid, 'signal_name',                &
     &                         nf90_char, dimids=(/ string_len_dim_id,         &
     &                                              nsignal_dim_id /),         &
     &                         varid=signal_name_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'signal_type',                &
     &                         nf90_char, dimids=(/ string_len_dim_id,         &
     &                                              nsignal_dim_id /),         &
     &                         varid=signal_type_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'signal_weight',              &
     &                         nf90_double, dimids=(/ nsignal_dim_id /),       &
     &                         varid=signal_weight_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid,                               &
     &                         'signal_observed_value',                        &
     &                         nf90_double, dimids=(/ nsignal_dim_id /),       &
     &                         varid=signal_observed_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'signal_model_value',         &
     &                         nf90_double,                                    &
     &                         dimids=(/ n_sig_models_dim_id,                  &
     &                                   nsignal_dim_id,                       &
     &                                   maxnsteps_dim_id /),                  &
     &                         varid=signal_model_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_def_var(this%result_ncid, 'signal_sigma',               &
     &                         nf90_double,                                    &
     &                         dimids=(/ nsignal_dim_id,                       &
     &                                   maxnsteps_dim_id /),                  &
     &                         varid=signal_sigma_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

      IF (ASSOCIATED(this%model)) THEN
         CALL model_def_result(this%model, this%result_ncid,                   &
     &                         maxnsteps_dim_id, string_len_dim_id)
      END IF

! Finished defining netcdf file. Exit out of define mode.
      status = nf90_enddef(this%result_ncid)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

      IF (ASSOCIATED(this%derived_params)) THEN
         DO i = 1, SIZE(this%derived_params)
            status = nf90_put_var(this%result_ncid,                            &
     &                  derived_param_name_id,                                 &
     &                  param_get_name(this%derived_params(i)%p,               &
     &                                 this%model),                            &
     &                  start=(/ 1, i /),                                      &
     &                  count=(/ data_name_length, 1 /))
            CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

            status = nf90_put_var(this%result_ncid,                            &
     &                            derived_param_index_id,                      &
     &                            this%derived_params(i)%p%indices,            &
     &                            start=(/ 1, i /),                            &
     &                            count=(/ 2, 1 /))
            CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
         END DO
      END IF

      IF (ASSOCIATED(this%params)) THEN
         DO i = 1, SIZE(this%params)
            status = nf90_put_var(this%result_ncid, param_name_id,             &
     &                            param_get_name(this%params(i)%p,             &
     &                                               this%model),              &
     &                            start=(/ 1, i /),                            &
     &                            count=(/ data_name_length, 1 /))
            CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

            status = nf90_put_var(this%result_ncid, param_index_id,            &
     &                            this%params(i)%p%indices,                    &
     &                            start=(/ 1, i /),                            &
     &                            count=(/ 2, 1 /))
            CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
         END DO
      END IF

      IF (ASSOCIATED(this%signals)) THEN
         DO i = 1, SIZE(this%signals)
            temp_signal => this%signals(i)%p

            status = nf90_put_var(this%result_ncid, signal_name_id,            &
     &                            this%signals(i)%p%s_name,                    &
     &                            start=(/ 1, i /),                              &
     &                            count=(/ data_name_length, 1 /))
            CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

            status = nf90_put_var(this%result_ncid, signal_type_id,            &
     &                            temp_signal%get_type(),                      &
     &                            start=(/ 1, i /),                            &
     &                            count=(/ data_name_length, 1 /))
            CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

            status = nf90_put_var(this%result_ncid,                            &
     &                            signal_weight_id,                            &
     &                            this%signals(i)%p%weight, start=(/i/))
            CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

            status = nf90_put_var(this%result_ncid,                            &
     &                            signal_observed_value_id,                    &
     &                            this%signals(i)%p%observed,                  &
     &                            start=(/i/))
            CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
         END DO
      END IF

      IF (ASSOCIATED(this%model)) THEN
         CALL model_write_init_data(this%model, this%result_ncid)
      END IF

      CALL v3fit_context_write_step_data(this, .true., eq_steps)

      CALL profiler_set_stop_time('v3fit_context_init_data', start_time)

      END SUBROUTINE

!-------------------------------------------------------------------------------
!>  @brief Write step data to the defined variables.
!>
!>  Writes out the data for a reconstruction step to the result file. If this
!>  is being called for the first time. Do not read the number of steps.
!>
!>  @param[inout] this       A @ref v3fit_context_class instance.
!>  @param[in]    first_step Flags to determine if this is the first instance
!>                           this has been called.
!>  @param[in]    eq_steps   Number of steps the equilibrium took.
!>  @note The only caller of this subrotine that should set first_step to true
!>  should be @ref v3fit_context_init_data. All others should callers should set
!>  first_step to false.
!-------------------------------------------------------------------------------
      SUBROUTINE v3fit_context_write_step_data(this, first_step,               &
     &                                         eq_steps)

      IMPLICIT NONE

!  Declare Arguments
      TYPE (v3fit_context_class), INTENT(inout) :: this
      LOGICAL, INTENT(in)                       :: first_step
      INTEGER, INTENT(in)                       :: eq_steps

!  local variables
      INTEGER :: i, status
      INTEGER :: current_step
      INTEGER :: nsteps_id
      INTEGER :: eq_steps_id
      INTEGER :: g2_id
      INTEGER :: derived_param_value_id
      INTEGER :: derived_param_sigma_id
      INTEGER :: derived_param_corr_id
      INTEGER :: param_value_id
      INTEGER :: param_sigma_id
      INTEGER :: param_corr_id
      INTEGER :: param_sem_id
      INTEGER :: signal_model_value_id
      INTEGER :: signal_sigma_value_id

      CLASS (signal_class), POINTER             :: temp_signal
      REAL (rprec)                              :: start_time

!  Start of executable code
      start_time = profiler_get_start_time()

!  Update number of steps taken.
      status = nf90_inq_varid(this%result_ncid, 'nsteps', nsteps_id)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      IF (first_step) THEN
         status = nf90_put_var(this%result_ncid, nsteps_id, 0)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
         current_step = 1
      ELSE
         status = nf90_get_var(this%result_ncid, nsteps_id,                    &
     &                         current_step)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
         current_step = current_step + 1
         status = nf90_put_var(this%result_ncid, nsteps_id,                    &
     &                         current_step)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

!  Use current_step as an array index. The Netcdf arrays start at 1 so this
!  needs to be incremented to point to the correct index.
         current_step = current_step + 1
      END IF

      status = nf90_inq_varid(this%result_ncid, 'eq_steps', eq_steps_id)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      status = nf90_put_var(this%result_ncid, eq_steps_id, eq_steps)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

      CALL model_write_step_data(this%model, this%result_ncid,                 &
     &                           current_step)

      IF (ASSOCIATED(this%recon)) THEN
         status = nf90_inq_varid(this%result_ncid, 'g2', g2_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
         status = nf90_put_var(this%result_ncid, g2_id,                        &
     &                         reconstruction_get_g2(this%recon),              &
     &                         start=(/current_step/))
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      END IF

      IF (ASSOCIATED(this%derived_params) .and.                                &
     &    SIZE(this%derived_params) .gt. 0) THEN
         status = nf90_inq_varid(this%result_ncid,                             &
     &                           'derived_param_value',                        &
     &                           derived_param_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_inq_varid(this%result_ncid,                             &
     &                           'derived_param_sigma',                        &
     &                           derived_param_sigma_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_inq_varid(this%result_ncid,                             &
     &                           'derived_param_corr',                         &
     &                           derived_param_corr_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         DO i = 1, SIZE(this%derived_params)
            CALL param_write_step_data(this%derived_params(i)%p,               &
     &                                 this%model, this%result_ncid,           &
     &                                 current_step, i,                        &
     &                                 derived_param_value_id,                 &
     &                                 derived_param_sigma_id,                 &
     &                                 derived_param_corr_id)
         END DO
      END IF

      IF (ASSOCIATED(this%params)) THEN
         status = nf90_inq_varid(this%result_ncid, 'param_value',              &
     &                           param_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_inq_varid(this%result_ncid, 'param_sigma',              &
     &                           param_sigma_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_inq_varid(this%result_ncid, 'param_corr',               &
     &                           param_corr_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_inq_varid(this%result_ncid, 'signal_eff_matrix',        &
     &                           param_sem_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         DO i = 1, SIZE(this%params)
            CALL param_write_step_data(this%params(i)%p, this%model,           &
     &                                 this%result_ncid, current_step,         &
     &                                 i, param_value_id,                      &
     &                                 param_sigma_id,                         &
     &                                 param_corr_id,                          &
     &                                 param_sem_id)
         END DO
      END IF

      IF (ASSOCIATED(this%signals)) THEN
         status = nf90_inq_varid(this%result_ncid, 'signal_model_value',       &
     &                           signal_model_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_inq_varid(this%result_ncid, 'signal_sigma',             &
     &                           signal_sigma_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         DO i = 1, SIZE(this%signals)
            temp_signal => this%signals(i)%p

            CALL temp_signal%write_step_data(this%model,                       &
     &                                       this%result_ncid,                 &
     &                                       current_step, i,                  &
     &                                       signal_model_value_id,            &
     &                                       signal_sigma_value_id)
         END DO
      END IF

!  Flush the step data to disk. This ensures that data is recorded in the event
!  of a fatal error that stops v3fit execution.
      status = nf90_sync(this%result_ncid)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

      CALL profiler_set_stop_time('v3fit_context_write_step_data',             &
     &                            start_time)

      END SUBROUTINE

!-------------------------------------------------------------------------------
!>  @brief Restart the reconstruction.
!>
!>  Reloads a reconstruction from the result file.
!>
!>  @param[inout] this         A @ref v3fit_context_class instance.
!>  @param[inout] current_step Reconstruction step left off from.
!>  @returns The current step.
!-------------------------------------------------------------------------------
      FUNCTION v3fit_context_restart(this, current_step)

      IMPLICIT NONE

!  Declare Arguments
      INTEGER                                   :: v3fit_context_restart
      TYPE (v3fit_context_class), INTENT(inout) :: this
      INTEGER, INTENT(inout)                    :: current_step

!  local variables
      INTEGER                                   :: i
      INTEGER                                   :: status
      INTEGER                                   :: nsteps_id
      INTEGER                                   :: eq_steps_id
      INTEGER                                   :: param_value_id
      INTEGER                                   :: param_sigma_id
      INTEGER                                   :: param_corr_id
      REAL (rprec)                              :: start_time

!  Start of executable code
      start_time = profiler_get_start_time()

!  The current step starts at zero but the NetCDF file starts at 1. Increment
!  the current step when passing it into subroutines.
      status = nf90_inq_varid(this%result_ncid, 'nsteps', nsteps_id)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      status = nf90_get_var(this%result_ncid, nsteps_id, current_step)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      current_step = current_step + 1

      IF (ASSOCIATED(this%params)) THEN
         status = nf90_inq_varid(this%result_ncid, 'param_value',              &
     &                           param_value_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_inq_varid(this%result_ncid, 'param_sigma',              &
     &                           param_sigma_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         status = nf90_inq_varid(this%result_ncid, 'param_corr',               &
     &                           param_corr_id)
         CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

         DO i = 1, SIZE(this%params)
            CALL param_restart(this%params(i)%p, this%model,                   &
     &                         this%result_ncid,                               &
     &                         current_step,                                   &
     &                         i, param_value_id, param_sigma_id,              &
     &                         param_corr_id, this%equilibrium_comm,           &
     &                         this%recon%use_central)
         END DO

         CALL model_restart(this%model, this%result_ncid,                      &
     &                      current_step)

         CALL reconstruction_restart(this%recon, this%result_ncid,             &
     &                               current_step,                             &
     &                               this%signals, this%derived_params,        &
     &                               this%model)

      END IF

      status = nf90_inq_varid(this%result_ncid, 'eq_steps', eq_steps_id)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))
      status = nf90_get_var(this%result_ncid, eq_steps_id,                     &
     &                      v3fit_context_restart)
      CALL assert_eq(status, nf90_noerr, nf90_strerror(status))

      CALL profiler_set_stop_time('v3fit_context_restart', start_time)

      END FUNCTION

      END MODULE


! Subroutine EPHOTO

! This software is part of the GLOW model.  Use is governed by the Open Source
! Academic Research License Agreement contained in the file glowlicense.txt.
! For more information see the file glow.txt.

! Adapted from Banks & Nagy 2-stream input code by Stan Solomon, 6/1988
! Modified to handle Auger electrons, Stan Solomon, 7/1990
! Reads cross sectons from files (for 1-nm bins), Scott Bailey, ~1994
! Modified bin structure, fixed CIII problem, Stan Solomon, 12/2000
! Corrected additional Auger problem, Liying Qian, 11/2002
! Converged above three branches, Stan Solomon, 3/2005
! Removed LIMIN, wavelength loop now runs from 1 to LMAX, SCS, 3/2005
! Converted common blocks to use-associated variables, Ben Foster, 2015
! Refactored to f90, SCS, 6/2016

! This subroutine calculates photoionization, rates, certain
! photodissociative excitation rates, and the photoelectron production
! spectrum as a function of altitude.  Uses continuously variable energy
! grid.  Three major species: O, O2, N2; NO is treated as a minor (non-
! absorbing) specie.

! Input supplied through use-associated variables defined in module cglow.f90:
! WAVE1   wavelength array, upper bound; Angstroms
! WAVE2   wavelength array, lower bound; Angstroms
! SFLUX   solar flux array; photons cm-2 sec-1
! ZZ      altitude array; cm above earth
! ZMAJ    density array for species O, O2, N2, altitude; cm-3
! ZNO     density of NO at each altitude; cm-3
! ZCOL    slant column density for species O, O2, N2, altitude; cm-2
! ENER    energy grid for photoelectrons; eV
! DEL     array of energy grid increments; eV

! Output provided through use-associated variables defined in module cglow.f90:
! PESPEC  photoelectron production spectrum for each altitude; cm-3 s-1
! PHOTOI  photoionization rates for state, species, altitude; cm-3 s-1
! PHOTOD  photodissoc./exc. rates for state, species, alt.; cm-3 s-1
! PHONO   photoionization/dissoc./exc. rates for NO; cm-3 s-1

! Other definitions:
! DSPECT  ionization rate in particular wavelength bin; cm-3 s-1
! TAU     optical depth, dimensionless
! FLUX    solar flux at altitude; cm-2 s-1
! SIGABS  photoabsorption cross sections, O, O2, N2; cm2
! SIGION  photoionization cross sections, O, O2, N2; cm2
! SIGAO, SIGAO2, SIGAN2, SIGIO, SIGIO2, SIGIN2; cross sect. data arrays
! NNN     number of states for each species
! TPOT    ionization potentials for each species, state; eV
! PROB    branching ratios for each state, species, and wavelength bin:
!         O+ states: 4S, 2Do, 2Po, 4Pe, 2Pe
!         O2+ states: X, a+A, b, dissoc.
!         N2+ states: X, A, B, C, F, dissoc.
! PROBO, PROBO2, PROBN2; branching ratio data arrays
! BSO2    yield of O(1S) from dissociation of O2
! EPSIL1  energy loss lower bound for state, species, wavelength; eV
! EPSIL2  energy loss upper bound for state, species, wavelength; eV
! SIGNO   NO photoionization xsect at Ly-alpha
! AUGE    Mean energy of Auger electrons for each species; eV
! AUGL    Wavelength threshold for Auger electrons; Angstroms

! Array dimensions:
! JMAX    number of altitude levels
! NBINS   number of energetic electron energy bins
! LMAX    number of wavelength intervals for solar flux
! NMAJ    number of major species
! NST     number of states produced by photoionization/dissociation

subroutine ephoto

  use cglow,only: jmax,nbins,lmax,nmaj,nst
  use cglow,only: wave1,wave2,phono,photoi,photod,pespec,zcol,sflux
  use cglow,only: zmaj,del,ener,zno
  use cglow,only: data_dir

  implicit none
  save

  integer :: nnn(nmaj)
  real ::   dspect(jmax), flux(lmax,jmax), &
            sigion(nmaj,lmax), sigabs(nmaj,lmax), &
            tpot(nst,nmaj), prob(nst,nmaj,lmax), &
            epsil1(nst,nmaj,lmax), epsil2(nst,nmaj,lmax), &
            sigao(lmax), sigao2(lmax), sigan2(lmax), &
            sigio(lmax), sigio2(lmax), sigin2(lmax), &
            probo(nst,lmax), probo2(nst,lmax), probn2(nst,lmax), &
            bso2(lmax), auge(nmaj), augl(nmaj), tau(lmax), &
            rion(lmax,nmaj,jmax)

  real,parameter :: signo = 2.0e-18
  integer :: ifirst=1
  integer :: l,n,k,i,j,m,m1,m2
  real :: aa,bb,fac,e1,e2,y,r1,r2
  character(len=1024) :: filepath

  nnn = (/5,4,6/)
  tpot(1:nst,1) = (/13.61, 16.93, 18.63, 28.50, 40.00,  0.00/)
  tpot(1:nst,2) = (/12.07, 16.10, 18.20, 20.00,  0.00,  0.00/)
  tpot(1:nst,3) = (/15.60, 16.70, 18.80, 30.00, 34.80, 25.00/)
  auge = (/500.,500.,360./)
  augl = (/24.,24.,33./)
  bso2(1:12) = 0.
  bso2(13) = .01
  bso2(14) = .03
  bso2(15:21) = .10
  bso2(22:29) = .07
  bso2(30:34) = .03
  bso2(35:39) = .01
  bso2(40:lmax) = 0.

! First time only: Read cross section data from files, convert to cm2,
! calculate energy losses:

  if (ifirst == 1) then
    ifirst = 0

    filepath = trim(data_dir)//'ephoto_xn2.dat'
    open(unit=1,file=filepath,status='old',action='read')
    read(1,*)
    read(1,*)
    read(1,*)
    read(1,*)
    do l=lmax,1,-1
      read(1,*) aa,bb,(probn2(n,l),n=1,nst),sigin2(l),sigan2(l)
    enddo
    close(1)

    filepath = trim(data_dir)//'ephoto_xo2.dat'
    open(unit=1,file=filepath,status='old',action='read')
    read(1,*)
    read(1,*)
    read(1,*)
    read(1,*)
    do l=lmax,1,-1
      read(1,*) aa,bb,(probo2(n,l),n=1,nst),sigio2(l),sigao2(l)
    enddo
    close(1)

    filepath = trim(data_dir)//'ephoto_xo.dat'
    open(unit=1,file=filepath,status='old',action='read')
    read(1,*)
    read(1,*)
    read(1,*)
    read(1,*)
    do l=lmax,1,-1
      read(1,*) aa,bb,(probo(n,l),n=1,nst),sigio(l),sigao(l)
    enddo
    close(1)

    do l=1,lmax
      sigabs(1,l) = sigao(l)  * 1.e-18
      sigabs(2,l) = sigao2(l) * 1.e-18
      sigabs(3,l) = sigan2(l) * 1.e-18
      sigion(1,l) = sigio(l)  * 1.e-18
      sigion(2,l) = sigio2(l) * 1.e-18
      sigion(3,l) = sigin2(l) * 1.e-18
    enddo

    do l=1,lmax
      do k=1,nst
        prob(k,1,l) = probo(k,l)
        prob(k,2,l) = probo2(k,l)
        prob(k,3,l) = probn2(k,l)
      enddo
    enddo

    do l=1,lmax
      do i=1,nmaj
        do k=1,nnn(i)
          epsil1(k,i,l)=12397.7/wave1(l)-tpot(k,i)
          epsil2(k,i,l)=12397.7/wave2(l)-tpot(k,i)
          if (wave1(l) <= augl(i)) then
            epsil1(k,i,l) = epsil1(k,i,l) - auge(i)
            epsil2(k,i,l) = epsil2(k,i,l) - auge(i)
          endif
        enddo
      enddo
    enddo

  endif       ! end of first-time-only conditional

! Zero arrays:

  phono(:,:) = 0.
  photoi(:,:,:) = 0.
  photod(:,:,:) = 0.
  pespec(:,:) = 0.

! Calculate attenuated solar flux at all altitudes and wavelengths:

  do l=1,lmax
    do j=1,jmax
      tau(l)=0.
      do i=1,nmaj
        tau(l)=tau(l)+sigabs(i,l)*zcol(i,j)
      enddo
      if (tau(l) < 20.) then
        flux(l,j)=sflux(l)*exp(-tau(l))
      else
        flux(l,j) = 0.0
      endif

! Calculate SRC photodissociation of O2, dissociative excitation of
! O(1S), photodissociation of N2, and photoionization of NO by solar Ly-alpha:

      if (wave1(l) < 1751. .and. wave2(l) > 1349.) then
        photod(1,2,j)=photod(1,2,j)+zmaj(2,j)*sigabs(2,l)*flux(l,j)
      endif
        photod(2,2,j) = photod(2,2,j) + zmaj(2,j)*sigabs(2,l)*flux(l,j)*bso2(l)
        photod(1,3,j) = photod(1,3,j) + zmaj(3,j)*(sigabs(3,l)-sigion(3,l))*flux(l,j)
      if (wave1(l) < 1221. .and. wave2(l) > 1209.) then
        phono(1,j) = phono(1,j) + zno(j)*signo*flux(l,j)
      endif
    enddo
  enddo

! Calculate ionization rates and photoelectron production:

! Loop over wavelengths:

  do l=1,lmax

! Loop over species:

    do i=1,nmaj

! Calculate total ionization rates for all species and altitudes:

      do j=1,jmax
        rion(l,i,j)=zmaj(i,j)*sigion(i,l)*flux(l,j)
      enddo

! Loop over states to calculate state-specific ionization rates at all altitudes:

      do k=1,nnn(i)
        e1= epsil1(k,i,l)
        e2= epsil2(k,i,l)

        if (e2 >= 0.) then

          if (e1 < 0.) e1=0.
          do j=1,jmax
            dspect(j) = rion(l,i,j)*prob(k,i,l)
            photoi(k,i,j) = photoi(k,i,j) + dspect(j)
          enddo

! Find box numbers m1, m2 corresponding to energies e1, e2:

          call boxnum (e1, e2, m1, m2, r1, r2, nbins, del, ener)

! Fill the boxes from m1 to m2 at all altitudes:

          if (m1 <= nbins) then
            y = e2 - e1
            do n=m1,m2
              if (m1 == m2) then
                fac = 1.
              else
                if (n == m1) then
                  fac = (r1-e1) / y
                else
                  if (n == m2) then
                    fac = (e2-r2) / y
                  else
                    fac = del(n) / y
                  endif
                endif
              endif
              do j=1,jmax
                pespec(n,j) = pespec(n,j) + dspect(j) * fac
              enddo
            enddo
          endif

        endif

      enddo     ! bottom of states loop

! Generate Auger electrons if energy is sufficient:

      if (wave1(l) <= augl(i)) then
        e1 = auge(i)
        e2 = auge(i)
        call boxnum (e1, e2, m1, m2, r1, r2, nbins, del, ener)
        if (m1 <= nbins .and. m2 <= nbins) then
          do j=1,jmax
            pespec(m1,j) = pespec(m1,j) + rion(l,i,j)
          enddo
        endif
      endif

    enddo     ! bottom of species loop

  enddo     ! bottom of wavelength loop

  return

end subroutine ephoto

subroutine boxnum (e1, e2, m1, m2, r1, r2, nbins, del, ener)

! This subroutine finds the box numbers corresponding to
! energies e1 and e2, and calls them m1 and m2.
! r1 is the upper edge of the lower box, r2 is the lower edge of the
! upper box.

  implicit none

  real,intent(in) :: e1,e2
  real,intent(in) :: del(nbins), ener(nbins)
  integer,intent(in) :: nbins
  real,intent(out) :: r1,r2
  integer,intent(out) :: m1,m2
  integer :: i,j

  do i=1,nbins
    if (e1 < ener(i)+del(i)/2.) then
      m1 = i
      r1 = ener(i) + del(i)/2.
      do j=1,nbins
        if (e2 < ener(j)+del(j)/2.) then
          m2 = j
          r2 = ener(j) - del(j)/2.
          return
        endif
      enddo
      m2 = nbins
      r2 = e2 - del(nbins)
      return
    endif
  enddo
  m1 = nbins+1
  return

end subroutine boxnum


      SUBROUTINE ML5_0_MP_COMPUTE_LOOP_COEFS(PS,ANSDP)
C
C     Generated by MadGraph5_aMC@NLO v. %(version)s, %(date)s
C     By the MadGraph5_aMC@NLO Development Team
C     Visit launchpad.net/madgraph5 and amcatnlo.web.cern.ch
C
C     Returns amplitude squared summed/avg over colors
C     and helicities for the point in phase space P(0:3,NEXTERNAL)
C     and external lines W(0:6,NEXTERNAL)
C
C     Process: d d~ > t t~ QED=0 QCD=2 [ virt = QCD ]
C
      IMPLICIT NONE
C
C     CONSTANTS
C
      CHARACTER*64 PARAMFILENAME
      PARAMETER ( PARAMFILENAME='MadLoopParams.dat')
      INTEGER NBORNAMPS
      PARAMETER (NBORNAMPS=1)
      INTEGER    NLOOPS, NLOOPGROUPS, NCTAMPS
      PARAMETER (NLOOPS=11, NLOOPGROUPS=8, NCTAMPS=29)
      INTEGER    NLOOPAMPS
      PARAMETER (NLOOPAMPS=40)
      INTEGER    NCOLORROWS
      PARAMETER (NCOLORROWS=NLOOPAMPS)
      INTEGER    NEXTERNAL
      PARAMETER (NEXTERNAL=4)
      INTEGER    NWAVEFUNCS,NLOOPWAVEFUNCS
      PARAMETER (NWAVEFUNCS=6,NLOOPWAVEFUNCS=26)
      INTEGER MAXLWFSIZE
      PARAMETER (MAXLWFSIZE=4)
      INTEGER LOOPMAXCOEFS, VERTEXMAXCOEFS
      PARAMETER (LOOPMAXCOEFS=15, VERTEXMAXCOEFS=5)
      INTEGER    NCOMB
      PARAMETER (NCOMB=16)
      REAL*16    ZERO
      PARAMETER (ZERO=0E0_16)
      COMPLEX*32 IMAG1
      PARAMETER (IMAG1=(0E0_16,1E0_16))
C     These are constants related to the split orders
      INTEGER    NSO, NSQUAREDSO, NAMPSO
      PARAMETER (NSO=0, NSQUAREDSO=0, NAMPSO=0)

C
C     ARGUMENTS
C
      REAL*16 PS(0:3,NEXTERNAL)
      REAL*8 ANSDP(3,0:NSQUAREDSO)
C
C     LOCAL VARIABLES
C
      LOGICAL DPW_COPIED
      INTEGER I,J,K,H,HEL_MULT,ITEMP
      REAL*16 TEMP2
      INTEGER NHEL(NEXTERNAL), IC(NEXTERNAL)
      REAL*16 P(0:3,NEXTERNAL)
      DATA IC/NEXTERNAL*1/
      REAL*16 ANS(3,0:NSQUAREDSO)
      COMPLEX*32 COEFS(MAXLWFSIZE,0:VERTEXMAXCOEFS-1,MAXLWFSIZE)
      COMPLEX*32 CFTOT
C
C     FUNCTIONS
C
      INTEGER ML5_0_ML5SOINDEX_FOR_BORN_AMP
      INTEGER ML5_0_ML5SOINDEX_FOR_LOOP_AMP
      INTEGER ML5_0_ML5SQSOINDEX
C
C     GLOBAL VARIABLES
C
      INCLUDE 'mp_coupl_same_name.inc'

      LOGICAL CHECKPHASE, HELDOUBLECHECKED
      COMMON/ML5_0_INIT/CHECKPHASE, HELDOUBLECHECKED

      INTEGER HELOFFSET
      INTEGER GOODHEL(NCOMB)
      LOGICAL GOODAMP(NSQUAREDSO,NLOOPGROUPS)
      COMMON/ML5_0_FILTERS/GOODAMP,GOODHEL,HELOFFSET

      INTEGER HELPICKED
      COMMON/ML5_0_HELCHOICE/HELPICKED

      INTEGER USERHEL
      COMMON/ML5_0_USERCHOICE/USERHEL

      INTEGER SQSO_TARGET
      COMMON/ML5_0_SOCHOICE/SQSO_TARGET

      LOGICAL UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE,CT_REQ_SO_DONE
     $ ,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_SO_DONE
     $ ,CTCALL_REQ_SO_DONE,FILTER_SO
      COMMON/ML5_0_SO_REQS/UVCT_REQ_SO_DONE,MP_UVCT_REQ_SO_DONE
     $ ,CT_REQ_SO_DONE,MP_CT_REQ_SO_DONE,LOOP_REQ_SO_DONE,MP_LOOP_REQ_S
     $ O_DONE,CTCALL_REQ_SO_DONE,FILTER_SO

      COMPLEX*32 AMP(NBORNAMPS)
      COMMON/ML5_0_MP_AMPS/AMP
      COMPLEX*16 DP_AMP(NBORNAMPS)
      COMMON/ML5_0_AMPS/DP_AMP
      COMPLEX*32 W(20,NWAVEFUNCS)
      COMMON/ML5_0_MP_W/W

      COMPLEX*16 DPW(20,NWAVEFUNCS)
      COMMON/ML5_0_W/DPW

      COMPLEX*32 WL(MAXLWFSIZE,0:LOOPMAXCOEFS-1,MAXLWFSIZE,0:NLOOPWAVEF
     $ UNCS)
      COMPLEX*32 PL(0:3,0:NLOOPWAVEFUNCS)
      COMMON/ML5_0_MP_WL/WL,PL

      COMPLEX*32 LOOPCOEFS(0:LOOPMAXCOEFS-1,NSQUAREDSO,NLOOPGROUPS)
      COMMON/ML5_0_MP_LCOEFS/LOOPCOEFS

      COMPLEX*32 AMPL(3,NCTAMPS)
      COMMON/ML5_0_MP_AMPL/AMPL

      INTEGER CF_D(NCOLORROWS,NBORNAMPS)
      INTEGER CF_N(NCOLORROWS,NBORNAMPS)
      COMMON/ML5_0_CF/CF_D,CF_N

      INTEGER HELC(NEXTERNAL,NCOMB)
      COMMON/ML5_0_HELCONFIGS/HELC

      LOGICAL MP_DONE_ONCE
      COMMON/ML5_0_MP_DONE_ONCE/MP_DONE_ONCE

C     ----------
C     BEGIN CODE
C     ----------

C     To be on the safe side, we always update the MP params here.
C     It can be redundant as this routine can be called a couple of
C      times for the same PS point during the stability checks.
C     But it is really not time consuming and I would rather be safe.
      CALL MP_UPDATE_AS_PARAM()

      MP_DONE_ONCE = .TRUE.

C     AS A SAFETY MEASURE WE FIRST COPY HERE THE PS POINT
      DO I=1,NEXTERNAL
        DO J=0,3
          P(J,I)=PS(J,I)
        ENDDO
      ENDDO

      DO I=0,3
        PL(I,0)=(ZERO,ZERO)
      ENDDO
      DO I=1,MAXLWFSIZE
        DO J=0,LOOPMAXCOEFS-1
          DO K=1,MAXLWFSIZE
            IF(I.EQ.K.AND.J.EQ.0) THEN
              WL(I,J,K,0)=(1.0E0_16,ZERO)
            ELSE
              WL(I,J,K,0)=(ZERO,ZERO)
            ENDIF
          ENDDO
        ENDDO
      ENDDO

      DO K=1, 3
        DO I=1,NCTAMPS
          AMPL(K,I)=(ZERO,ZERO)
        ENDDO
      ENDDO

      DO I=1, NBORNAMPS
        DP_AMP(I) = (0.0D0,0.0D0)
        AMP(I) = (ZERO, ZERO)
      ENDDO

      DO I=1,NLOOPGROUPS
        DO J=0,LOOPMAXCOEFS-1
          DO K=1,NSQUAREDSO
            LOOPCOEFS(J,K,I)=(ZERO,ZERO)
          ENDDO
        ENDDO
      ENDDO

      DO K=1,3
        DO J=0,NSQUAREDSO
          ANSDP(K,J)=0.0D0
          ANS(K,J)=ZERO
        ENDDO
      ENDDO

      DPW_COPIED = .FALSE.
      DO H=1,NCOMB
        IF ((HELPICKED.EQ.H).OR.((HELPICKED.EQ.-1).AND.(CHECKPHASE.OR.(
     $   .NOT.HELDOUBLECHECKED).OR.(GOODHEL(H).GT.-HELOFFSET.AND.GOODHE
     $   L(H).NE.0)))) THEN
          DO I=1,NEXTERNAL
            NHEL(I)=HELC(I,H)
          ENDDO

          MP_UVCT_REQ_SO_DONE=.FALSE.
          MP_CT_REQ_SO_DONE=.FALSE.
          MP_LOOP_REQ_SO_DONE=.FALSE.

          IF (.NOT.CHECKPHASE.AND.HELDOUBLECHECKED.AND.HELPICKED.EQ.
     $     -1) THEN
            HEL_MULT=GOODHEL(H)
          ELSE
            HEL_MULT=1
          ENDIF

          CALL MP_IXXXXX(P(0,1),ZERO,NHEL(1),+1*IC(1),W(1,1))
          CALL MP_OXXXXX(P(0,2),ZERO,NHEL(2),-1*IC(2),W(1,2))
          CALL MP_OXXXXX(P(0,3),MDL_MT,NHEL(3),+1*IC(3),W(1,3))
          CALL MP_IXXXXX(P(0,4),MDL_MT,NHEL(4),-1*IC(4),W(1,4))
          CALL MP_FFV1P0_3(W(1,1),W(1,2),GC_5,ZERO,ZERO,W(1,5))
C         Amplitude(s) for born diagram with ID 1
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),GC_5,AMP(1))
          CALL MP_FFV1P0_3(W(1,4),W(1,3),GC_5,ZERO,ZERO,W(1,6))
C         Counter-term amplitude(s) for loop diagram number 2
          CALL MP_R2_GG_1_0(W(1,5),W(1,6),R2_GGQ,AMPL(1,1))
          CALL MP_R2_GG_1_0(W(1,5),W(1,6),R2_GGQ,AMPL(1,2))
          CALL MP_R2_GG_1_0(W(1,5),W(1,6),R2_GGQ,AMPL(1,3))
          CALL MP_R2_GG_1_0(W(1,5),W(1,6),R2_GGQ,AMPL(1,4))
C         Counter-term amplitude(s) for loop diagram number 5
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,5))
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,6))
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,7))
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,8))
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQB,AMPL(1,9))
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,10))
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQT,AMPL(1,11))
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQQ_1EPS,AMPL(2,12))
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),UV_GQQG_1EPS,AMPL(2,13))
          CALL MP_FFV1_0(W(1,1),W(1,2),W(1,6),R2_GQQ,AMPL(1,14))
C         Counter-term amplitude(s) for loop diagram number 7
          CALL MP_R2_GG_1_R2_GG_3_0(W(1,5),W(1,6),R2_GGQ,R2_GGB,AMPL(1
     $     ,15))
C         Counter-term amplitude(s) for loop diagram number 8
          CALL MP_R2_GG_1_R2_GG_3_0(W(1,5),W(1,6),R2_GGQ,R2_GGT,AMPL(1
     $     ,16))
C         Counter-term amplitude(s) for loop diagram number 9
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,17))
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,18))
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,19))
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,20))
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQB,AMPL(1,21))
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,22))
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQT,AMPL(1,23))
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQQ_1EPS,AMPL(2,24))
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),UV_GQQG_1EPS,AMPL(2,25))
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),R2_GQQ,AMPL(1,26))
C         Counter-term amplitude(s) for loop diagram number 11
          CALL MP_R2_GG_1_R2_GG_2_0(W(1,5),W(1,6),R2_GGG_1,R2_GGG_2
     $     ,AMPL(1,27))
 2000     CONTINUE
          MP_CT_REQ_SO_DONE=.TRUE.

C         Amplitude(s) for UVCT diagram with ID 13
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),GC_5,AMPL(1,28))
          AMPL(1,28)=AMPL(1,28)*(2.0D0*UVWFCT_T_0)
C         Amplitude(s) for UVCT diagram with ID 14
          CALL MP_FFV1_0(W(1,4),W(1,3),W(1,5),GC_5,AMPL(2,29))
          AMPL(2,29)=AMPL(2,29)*(2.0D0*UVWFCT_B_0_1EPS)
 3000     CONTINUE
          MP_UVCT_REQ_SO_DONE=.TRUE.

          DO I=1,NCTAMPS
            DO J=1,NBORNAMPS
              CFTOT=CMPLX(CF_N(I,J)/REAL(ABS(CF_D(I,J)),KIND=16)
     $         ,0.0E0_16,KIND=16)
              IF(CF_D(I,J).LT.0) CFTOT=CFTOT*IMAG1
              ITEMP = ML5_0_ML5SQSOINDEX(ML5_0_ML5SOINDEX_FOR_LOOP_AMP(
     $         I),ML5_0_ML5SOINDEX_FOR_BORN_AMP(J))
              IF (.NOT.FILTER_SO.OR.SQSO_TARGET.EQ.ITEMP) THEN
                DO K=1,3
                  TEMP2 = HEL_MULT*2.0E0_16*REAL(CFTOT*AMPL(K,I)
     $             *CONJG(AMP(J)),KIND=16)
                  ANS(K,ITEMP)=ANS(K,ITEMP)+TEMP2
                  ANS(K,0)=ANS(K,0)+TEMP2
                ENDDO
              ENDIF
            ENDDO
          ENDDO

C         Coefficient construction for loop diagram with ID 2
          CALL MP_FFV1L2_1(PL(0,0),W(1,5),GC_5,ZERO,ZERO,PL(0,1),COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
     $     ,1))
          CALL MP_FFV1L2_1(PL(0,1),W(1,6),GC_5,ZERO,ZERO,PL(0,2),COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,1),4,COEFS,4,4,WL(1,0,1
     $     ,2))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,2),2,4,1,1,4,30,H)
C         Coefficient construction for loop diagram with ID 3
          CALL MP_FFV1L3_2(PL(0,0),W(1,1),GC_5,ZERO,ZERO,PL(0,3),COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
     $     ,3))
          CALL MP_FFV1L1P0_3(PL(0,3),W(1,2),GC_5,ZERO,ZERO,PL(0,4)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_0(WL(1,0,1,3),4,COEFS,4,4,WL(1,0,1
     $     ,4))
          CALL MP_FFV1L3_2(PL(0,4),W(1,4),GC_5,MDL_MT,MDL_WT,PL(0,5)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,4),4,COEFS,4,4,WL(1,0,1
     $     ,5))
          CALL MP_FFV1L1P0_3(PL(0,5),W(1,3),GC_5,ZERO,ZERO,PL(0,6)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_2_0(WL(1,0,1,5),4,COEFS,4,4,WL(1,0,1
     $     ,6))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,6),2,4,2,1,1,31,H)
C         Coefficient construction for loop diagram with ID 4
          CALL MP_FFV1L3_1(PL(0,4),W(1,3),GC_5,MDL_MT,MDL_WT,PL(0,7)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,4),4,COEFS,4,4,WL(1,0,1
     $     ,7))
          CALL MP_FFV1L2P0_3(PL(0,7),W(1,4),GC_5,ZERO,ZERO,PL(0,8)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_2_0(WL(1,0,1,7),4,COEFS,4,4,WL(1,0,1
     $     ,8))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,8),2,4,3,1,1,32,H)
C         Coefficient construction for loop diagram with ID 5
          CALL MP_VVV1L2P0_1(PL(0,4),W(1,6),GC_4,ZERO,ZERO,PL(0,9)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,4),4,COEFS,4,4,WL(1,0,1
     $     ,9))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,9),2,4,4,1,1,33,H)
C         Coefficient construction for loop diagram with ID 6
          CALL MP_FFV1L2P0_3(PL(0,0),W(1,1),GC_5,ZERO,ZERO,PL(0,10)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_0(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
     $     ,10))
          CALL MP_FFV1L3_1(PL(0,10),W(1,2),GC_5,ZERO,ZERO,PL(0,11)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,10),4,COEFS,4,4,WL(1,0
     $     ,1,11))
          CALL MP_FFV1L2_1(PL(0,11),W(1,6),GC_5,ZERO,ZERO,PL(0,12)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,11),4,COEFS,4,4,WL(1,0
     $     ,1,12))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,12),2,4,4,1,1,34,H)
C         Coefficient construction for loop diagram with ID 7
          CALL MP_FFV1L2_1(PL(0,0),W(1,5),GC_5,MDL_MB,ZERO,PL(0,13)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
     $     ,13))
          CALL MP_FFV1L2_1(PL(0,13),W(1,6),GC_5,MDL_MB,ZERO,PL(0,14)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,13),4,COEFS,4,4,WL(1,0
     $     ,1,14))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,14),2,4,5,1,1,35,H)
C         Coefficient construction for loop diagram with ID 8
          CALL MP_FFV1L2_1(PL(0,0),W(1,5),GC_5,MDL_MT,MDL_WT,PL(0,15)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
     $     ,15))
          CALL MP_FFV1L2_1(PL(0,15),W(1,6),GC_5,MDL_MT,MDL_WT,PL(0,16)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,15),4,COEFS,4,4,WL(1,0
     $     ,1,16))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,16),2,4,6,1,1,36,H)
C         Coefficient construction for loop diagram with ID 9
          CALL MP_FFV1L1P0_3(PL(0,0),W(1,3),GC_5,ZERO,ZERO,PL(0,17)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_0(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
     $     ,17))
          CALL MP_FFV1L3_2(PL(0,17),W(1,4),GC_5,MDL_MT,MDL_WT,PL(0,18)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,17),4,COEFS,4,4,WL(1,0
     $     ,1,18))
          CALL MP_FFV1L1_2(PL(0,18),W(1,5),GC_5,MDL_MT,MDL_WT,PL(0,19)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,18),4,COEFS,4,4,WL(1,0
     $     ,1,19))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,19),2,4,7,1,1,37,H)
C         Coefficient construction for loop diagram with ID 10
          CALL MP_FFV1L3_1(PL(0,0),W(1,3),GC_5,MDL_MT,MDL_WT,PL(0,20)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
     $     ,20))
          CALL MP_FFV1L2P0_3(PL(0,20),W(1,4),GC_5,ZERO,ZERO,PL(0,21)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_0(WL(1,0,1,20),4,COEFS,4,4,WL(1,0
     $     ,1,21))
          CALL MP_VVV1L2P0_1(PL(0,21),W(1,5),GC_4,ZERO,ZERO,PL(0,22)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,21),4,COEFS,4,4,WL(1,0
     $     ,1,22))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,22),2,4,8,1,1,38,H)
C         Coefficient construction for loop diagram with ID 11
          CALL MP_VVV1L2P0_1(PL(0,0),W(1,5),GC_4,ZERO,ZERO,PL(0,23)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),4,COEFS,4,4,WL(1,0,1
     $     ,23))
          CALL MP_VVV1L2P0_1(PL(0,23),W(1,6),GC_4,ZERO,ZERO,PL(0,24)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,23),4,COEFS,4,4,WL(1,0
     $     ,1,24))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,24),2,4,1,2,1,39,H)
C         Coefficient construction for loop diagram with ID 12
          CALL MP_GHGHGL2_1(PL(0,0),W(1,5),GC_4,ZERO,ZERO,PL(0,25)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_0_1(WL(1,0,1,0),1,COEFS,1,1,WL(1,0,1
     $     ,25))
          CALL MP_GHGHGL2_1(PL(0,25),W(1,6),GC_4,ZERO,ZERO,PL(0,26)
     $     ,COEFS)
          CALL MP_ML5_0_UPDATE_WL_1_1(WL(1,0,1,25),1,COEFS,1,1,WL(1,0
     $     ,1,26))
          CALL MP_ML5_0_CREATE_LOOP_COEFS(WL(1,0,1,26),2,1,1,1,1,40,H)
 4000     CONTINUE
          MP_LOOP_REQ_SO_DONE=.TRUE.

C         Copy the qp wfs to the dp ones as they are used to setup the
C          CT calls.
C         This needs to be done once since only the momenta of these
C          WF matters.
          IF(.NOT.DPW_COPIED) THEN
            DO I=1,NWAVEFUNCS
              DO J=1,MAXLWFSIZE+4
                DPW(J,I)=DBLE(W(J,I))
              ENDDO
            ENDDO
            DPW_COPIED=.TRUE.
          ENDIF

        ENDIF
      ENDDO

      DO I=1,3
        DO J=0,NSQUAREDSO
          ANSDP(I,J)=ANS(I,J)
        ENDDO
      ENDDO

C     Grouping of loop diagrams now done directly when creating the
C      LOOPCOEFS.

      END