      subroutine timcrl
!***********************************************************************
!  Copyright, 1993, 2004,  The  Regents of the University of California.
!  This program was prepared by the Regents of the University of
!  California at Los Alamos National Laboratory (the University) under
!  contract No. W-7405-ENG-36 with the U.S. Department of Energy (DOE).
!  All rights in the program are reserved by the DOE and the University.
!  Permission is granted to the public to copy and use this software
!  without charge, provided that this Notice and any statement of
!  authorship are reproduced on all copies. Neither the U.S. Government
!  nor the University makes any warranty, express or implied, or
!  assumes any liability or responsibility for the use of this software.
C***********************************************************************
CD1
CD1 PURPOSE
CD1
CD1 Procedure to adjust timestep.
CD1
C***********************************************************************
CD2
CD2 REVISION HISTORY
CD2
CD2 Revision                    ECD
CD2 Date         Programmer     Number  Comments
CD2
CD2 25-OCT-93    Z. Dash        22      Add prolog.
CD2              G. Zyvoloski           Initial implementation.
CD2
CD2 $Log:   /pvcs.config/fehm90/src/timcrl.f_a  $
!D2
!D2    Rev 2.5   06 Jan 2004 10:44:22   pvcs
!D2 FEHM Version 2.21, STN 10086-2.21-00, Qualified October 2003
!D2
!D2    Rev 2.4   29 Jan 2003 09:21:28   pvcs
!D2 FEHM Version 2.20, STN 10086-2.20-00
!D2
!D2    Rev 2.3   14 Nov 2001 13:28:42   pvcs
!D2 FEHM Version 2.12, STN 10086-2.12-00
!D2
!D2    Rev 2.2   06 Jun 2001 13:28:18   pvcs
!D2 FEHM Version 2.11, STN 10086-2.11-00
!D2
!D2    Rev 2.1   30 Nov 2000 12:12:48   pvcs
!D2 FEHM Version 2.10, STN 10086-2.10-00
!D2
!D2    Rev 2.0   Fri May 07 14:47:42 1999   pvcs
!D2 FEHM Version 2.0, SC-194 (Fortran 90)
CD2
CD2    Rev 1.8   Fri Jun 28 09:04:36 1996   zvd
CD2 Added timestep error termination write to ierr
CD2
CD2    Rev 1.7   Tue Jun 04 09:22:50 1996   gaz
CD2 modified time step cut in TS failure so it would always decrease
CD2
CD2    Rev 1.6   Fri May 10 08:48:54 1996   gaz
CD2 changed 'ditnd =  1.0d+20' to 'ditnd =  1.0d+80'
CD2
CD2    Rev 1.5   Fri Feb 02 12:53:40 1996   hend
CD2 Updated Requirements Traceability
CD2
CD2    Rev 1.4   08/16/95 16:28:24   robinson
CD2 Changed name of variable to set print out interval
CD2
CD2    Rev 1.3   06/02/95 10:30:46   llt
CD2 read in absolute value of MAXIT in ctrl macro (gaz)
CD2
CD2    Rev 1.2   01/28/95 13:56:20   llt
CD2 water balance equation was modified
CD2
CD2    Rev 1.1   03/18/94 15:56:02   gaz
CD2 Added solve_new and cleaned up memory management.
CD2
CD2    Rev 1.0   01/20/94 10:28:56   pvcs
CD2 original version in process of being certified
CD2
C***********************************************************************
CD3
CD3 INTERFACES
CD3
CD3 Formal Calling Parameters
CD3
CD3   None
CD3
CD3 Interface Tables
CD3
CD3   None
CD3
CD3 Files
CD3
CD3   Name                     Use  Description
CD3
CD3   iatty                    O    File used for check information
CD4   iout                     O    File used for general code output
CD3   iptty                    O    Output to the tty
CD3
C***********************************************************************
CD4
CD4 GLOBAL OBJECTS
CD4
CD4 Global Constants
CD4
CD4   None
CD4
CD4 Global Types
CD4
CD4   None
CD4
CD4 Global Variables
CD4
CD4                            COMMON
CD4   Identifier      Type     Block  Description
CD4
CD4   aiaa            REAL*8   faar   Time step multiplication factor
CD4   aiar            REAL*8   faar   Time step reduction factor
CD4   aw              REAL*8   faar   Time step weighting parameter for heat and
CD4                                     mass solution (ctrl)
CD4   awt             REAL*8   faar   Value of implicitness factor
CD4   ay              REAL*8   faar   Time step weighting parameter for tracer
CD4   day             REAL*8   faar   Current time step size in days
CD4   daycf           REAL*8   faar   Time at which tracer solution stops
CD4   daycs           REAL*8   faar   Time at which tracer solution starts
CD4   dayhf           REAL*8   faar   Time at which flow solution stops
CD4   dayhs           REAL*8   faar   Time at which flow solution starts
CD4   daymax          REAL*8   faar   Maximum time step allowed
CD4   daymin          REAL*8   faar   Minimum time step allowed
CD4   daynew          REAL*8   faar   Parameter used in time step control
CD4   days            REAL*8   faar   Current simulation time
CD4   daysi           REAL*8   faar   Simulation time at last time step
CD4   daysp           REAL*8   faar   Time at next time step
CD4   dit             REAL*8   fdd1   Array containing time step changes
CD4   ditnd           REAL*8   faar   Next time step change time
CD4   iac             INT      faai   Counter for print-out interval
CD4   iad             INT      faai   Current iteration number in flow solution
CD4   iamm            INT      faai   Maximum iterations allowed for time step
CD4                                     increase (heat and mass solution)
CD4   iatty           INT      faai   Unit number for check file
CD4   iccen           INT      faai   ?
CD4   icgts           INT      faai   Parameter controlling the time of solution
CD4                                     parameter changes
CD4   icontr          INT      faai   Parameter used in contour plot management
CD4   ics             INT      faai   Parameter indicating status of tracer
CD4                                     solution
CD4   icf             INT      faai   Parameter indicating status of tracer
CD4                                     solution
CD4   ifinsh          INT      faai   Indicates if the finishing criteria for
CD4                                     the simulation is achieved
CD4   ihf             INT      faai   Parameter indicating status of flow
CD4                                     solution
CD4   ihs             INT      faai   Parameter indicating status of flow
CD4                                     solution
CD4   iprtout         INT      faai   Print-out interval, number of time steps
CD4   ilt             INT      faai   Parameter used in time step control
CD4   iout            INT      faai   Unit number for output file
CD4   iptty           INT      faai   Unit number for tty
CD4   l               INT      faai   Current time step number
CD4   maxit           INT      faai   Maximum number of iterations allowed
CD4                                     before time step is halved
CD4   nicg            INT      faai   Parameter used in time step control
CD4   nsave           INT      faai   Indicates if a restart file will be
CD4                                     created in the current problem
CD4   tims            REAL*8   faar   Ending simulation time
CD4
CD4 Global Subprograms
CD4
CD4   Identifier      Type     Description
CD4
CD4   co2ctr                   Control co2 simulation
CD4   contr                    Write contour plot file output
CD4   daycrl          REAL*8   Compute new time step size using adjusted
CD4                              timestep multipier if necessary
CD4   disk                     Write information to save file
CD4   dual                     Control dual porosity simulation
CD4   plot                     Write history plot file output
CD4
C***********************************************************************
CD5
CD5 LOCAL IDENTIFIERS
CD5
CD5 Local Constants
CD5
CD5   None
CD5
CD5 Local Types
CD5
CD5   None
CD5
CD5 Local variables
CD5
CD5   Identifier      Type     Description
CD5
CD5   dafac           REAL*8   ?
CD5   pravg           REAL*8   ?
CD5   tfacd           REAL*8   ?
CD5   tmavg           REAL*8   ?
CD5
CD5 Local Subprograms
CD5
CD5   None
CD5
C***********************************************************************
CD6
CD6 FUNCTIONAL DESCRIPTION
CD6
C***********************************************************************
CD7
CD7 ASSUMPTIONS AND LIMITATIONS
CD7
CD7 None
CD7
C***********************************************************************
CD8
CD8 SPECIAL COMMENTS
CD8
CD8  Requirements from SDN: 10086-RD-2.20-00
CD8    SOFTWARE REQUIREMENTS DOCUMENT (RD) for the
CD8    FEHM Application Version 2.20
CD8
C***********************************************************************
CD9
CD9 REQUIREMENTS TRACEABILITY
CD9
CD9 2.5.1 Implement time-step mechanism
CD9
C***********************************************************************
CDA
CDA REFERENCES
CDA
CDA None
CDA
C***********************************************************************

      use comdi
      use compart
      use comdti
      use comsplitts
      use comai
      use avsio, only : dit_flag
      implicit none

      real*8 dafac, daycrl, pravg, tfacd, tmavg

      tfacd = max(5.0d00,aiaa*aiar)
      if (l .eq. 1 .and. iad .lt. abs(maxit))  then
         daynew =  daynew / aiaa
         iac    =  iprtout
         if (abs(daycs) .lt. zero_t .and. iccen .ne. 0)  then
            ics    =  1
            if (iout .ne. 0) write(iout  ,6000)
            if (iatty .gt. 0)  write(iatty ,6000)
 6000       format(/,1x,'tracer started at days = 0.0')
         end if
      end if

      if (daynew .lt. daymin)  day    =  daymin
      daysi  =  days
      if (iad    .gt. abs(maxit) )  then
         daynew =  daynew/tfacd
         dtot_next = 0.0
      endif
      if (iad    .le. iamm  )  then
         daynew =  daycrl(0)
      endif
      if (daynew .gt. daymax)  daynew =  daymax
      day    =  daynew

      if (day .lt. daymin)  then
         days   =  daysi
         if (iout .ne. 0) write(iout  ,6010)  l , day , days
         write(ierr  ,6010)  l , day , days
         if (iptty .gt. 0)  write(iptty ,6010)  l , day , days
 6010    format(/,1x,'timestep less than daymin',i5,2g20.6)
c**** reset variables to old ts values ****
         nsave  =  1
         call  dual    (1)
c gaz change nicg to nicg-1 below
c zvd 13-Jun-07 checked to make sure nicg > 1
         if (allocated(itc) .and. nicg .gt. 1) then
            if (itc(nicg-1).gt.0) then
               if (isave .ne. 0) call diskwrite
            endif
         endif
c**** set co2 pressure ****
         call  co2ctr  (2)
         days   = -1.0
         if (hist_flag) then
            call plot_new (1, 0.0d00, 0.0d00, 0.0d00, 0.0d00)
         else
            call plot (1, tmavg, pravg)
         end if
         call  contr   (-1)
         call  contr   ( 1)
         stop
      end if

      icontr =  0
      ifinsh =  0
c**** adjust time step ****
      daysi  =  days
      ilt    =  0
      daysp  =  days + day

c     only use dits if transient)
      if(isteady.eq.0) then
         if (daysp .ge. ditnd)  then
            day    =  ditnd - days
            ilt    =  1
            daysp  =  ditnd
c If dit_flag is true, contour data will not be written for each dit
c New cont keyword "nodit"
            if (.not. dit_flag) icontr =  1
            if (icgts .ne. 0)  then
               iprtout    =  iabs(itc(nicg))
               iac    =  iprtout
               dafac  =  dit(nicg+icgts)
               if (dafac  .lt. 0.0)  aiaa   = -dafac
               if (aiaa.lt.1.0) aiaa = 1.0
               if (dafac  .ge. 0.0)  daynew = dafac
               if (daynew .gt. daymax)  daynew = daymax
               aw = dit(icgts + icgts + nicg)
c     Add change to include changing max time step
               if(dit(3*icgts + nicg) .gt. 0.) then
                  daymax = dit(3*icgts + nicg)
               end if
               if (aw .lt. 1.0)  aw =  1.0
               if (aw .gt. 1.0)  aw =  1.5
               if (l .eq. 1)  then
                  awt    =  aw
                  aw     =  1.0
               end if
               ay     =  1.0 - aw
               nicg   =  nicg+1
               ditnd =  dit(nicg)
               if (nicg .gt. icgts)  ditnd =  1.0d+80
            end if
         end if
      endif

      if ((iccen .ne. 0).or.ptrak)  then
         if (daysp .ge. dayhf .and. ihf .eq. 0)  then
            if (iout .ne. 0) write(iout  ,6020)  l
            if (iatty .gt. 0)  write(iatty ,6020)  l
 6020       format(/,1x,'note>>h.t. solution stopped after time step',
     *           i7)
            ihf    =  1
            iac    =  iprtout
            if (l .ne. 1)  then
               day    =  dayhf - days
               daysp  =  dayhf
            end if
         end if

         if (daysp .ge. dayhs .and. ihs .eq. 0)  then
            if (iout .ne. 0) write(iout  ,6021)  l
            if (iatty .gt. 0)  write(iatty ,6021)  l
 6021       format(/,1x,'note>>h.t. solution started on time step',i7)
            ihs    =  1
            iac    =  iprtout
            if (l .ne. 1)  then
               day    =  dayhs - days
               daysp  =  dayhs
            end if
         end if

         if (daysp .ge. daycs .and. ics .eq. 0)  then
            if (iout .ne. 0) write(iout  ,6022)  l
            if (iatty .gt. 0)  write(iatty ,6022)  l
 6022       format(/,1x,'note>>tracer solution started on time step',i7)
            ics    =  1
            iac    =  iprtout
            if (l .ne. 1)  then
               if (abs(daycs) .gt. zero_t)  then
                  day    =  daycs - days
                  daysp  =  daycs
               end if
            end if
         end if

         if (daysp .ge. daycf .and. icf .eq. 0)  then
            if (iout .ne. 0) write(iout  ,6023)  l
            if (iatty .gt. 0)  write(iatty ,6023)  l
 6023       format(/,1x,'note>>tracer solution stopped after time step',
     *           i7)
            icf    =  1
            iac    =  iprtout
            if (l .ne. 1)  then
               day    =  daycf - days
               daysp  =  daycf
            end if
         end if
      end if

c
c     adjust for time varying boundary conditions
c
      days=daysp
      call flow_boundary_conditions(3)
      daysp=days
      days=daysp-day
      if (nicg .gt.1) then
         if (daysp .lt. dit(nicg - 1)) then
            nicg = nicg - 1
            ditnd =  dit(nicg)
         end if
      end if

      if (daysp .ge. tims)  then
c     Took out check for rip changes - need to determine why it was there
c     if (l .ne. 1)  then
         day    =  tims - days
         daysp  =  tims
         iac    =  iprtout
c     end if
         ifinsh =  1
      end if
      days   =  daysp
      if (day .lt. daymin)  then
         days   =  daysi + daymin
         day    =  daymin
      end if

      return
      end


c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     ###############################################################
c     ##                                                           ##
c     ##  subroutine kbond  --  bond stretch parameter assignment  ##
c     ##                                                           ##
c     ###############################################################
c
c
c     "kbond" assigns a force constant and ideal bond length
c     to each bond in the structure and processes any new or
c     changed parameter values
c
c
      subroutine kbond
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'atoms.i'
      include 'bond.i'
      include 'couple.i'
      include 'fields.i'
      include 'inform.i'
      include 'iounit.i'
      include 'kbonds.i'
      include 'keys.i'
      include 'potent.i'
      include 'usage.i'
      integer i,j
      integer ia,ib,ita,itb
      integer nb,nb5,nb4,nb3
      integer size,next
      integer minat,iring
      real*8 fc,bd
      logical header,done
      logical use_ring
      character*4 pa,pb
      character*6 label
      character*8 blank,pt
      character*20 keyword
      character*120 record
      character*120 string
c
c
c     process keywords containing bond stretch parameters
c
      blank = '        '
      header = .true.
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         iring = -1
         if (keyword(1:5) .eq. 'BOND ')  iring = 0
         if (keyword(1:6) .eq. 'BOND5 ')  iring = 5
         if (keyword(1:6) .eq. 'BOND4 ')  iring = 4
         if (keyword(1:6) .eq. 'BOND3 ')  iring = 3
         if (iring .ge. 0) then
            ia = 0
            ib = 0
            fc = 0.0d0
            bd = 0.0d0
            string = record(next:120)
            read (string,*,err=10,end=10)  ia,ib,fc,bd
   10       continue
            if (.not. silent) then
               if (header) then
                  header = .false.
                  write (iout,20)
   20             format (/,' Additional Bond Stretching Parameters :',
     &                    //,5x,'Atom Classes',9x,'K(S)',6x,'Length',/)
               end if
               if (iring .eq. 0) then
                  write (iout,30)  ia,ib,fc,bd
   30             format (6x,2i4,4x,f12.3,f12.4)
               else
                  if (iring .eq. 5)  label = '5-Ring'
                  if (iring .eq. 4)  label = '4-Ring'
                  if (iring .eq. 3)  label = '3-Ring'
                  write (iout,40)  ia,ib,fc,bd,label
   40             format (6x,2i4,4x,f12.3,f12.4,3x,a6)
               end if
            end if
            size = 4
            call numeral (ia,pa,size)
            call numeral (ib,pb,size)
            if (ia .le. ib) then
               pt = pa//pb
            else
               pt = pb//pa
            end if
            if (iring .eq. 0) then
               do j = 1, maxnb
                  if (kb(j).eq.blank .or. kb(j).eq.pt) then
                     kb(j) = pt
                     bcon(j) = fc
                     blen(j) = bd
                     goto 60
                  end if
               end do
               write (iout,50)
   50          format (/,' KBOND  --  Too many Bond Stretching',
     &                       ' Parameters')
               abort = .true.
   60          continue
            else if (iring .eq. 5) then
               do j = 1, maxnb5
                  if (kb5(j).eq.blank .or. kb5(j).eq.pt) then
                     kb5(j) = pt
                     bcon5(j) = fc
                     blen5(j) = bd
                     goto 80
                  end if
               end do
               write (iout,70)
   70          format (/,' KBOND  --  Too many 5-Ring Stretching',
     &                       ' Parameters')
               abort = .true.
   80          continue
            else if (iring .eq. 4) then
               do j = 1, maxnb4
                  if (kb4(j).eq.blank .or. kb4(j).eq.pt) then
                     kb4(j) = pt
                     bcon4(j) = fc
                     blen4(j) = bd
                     goto 100
                  end if
               end do
               write (iout,90)
   90          format (/,' KBOND  --  Too many 4-Ring Stretching',
     &                       ' Parameters')
               abort = .true.
  100          continue
            else if (iring .eq. 3) then
               do j = 1, maxnb3
                  if (kb3(j).eq.blank .or. kb3(j).eq.pt) then
                     kb3(j) = pt
                     bcon3(j) = fc
                     blen3(j) = bd
                     goto 120
                  end if
               end do
               write (iout,110)
  110          format (/,' KBOND  --  Too many 3-Ring Stretching',
     &                       ' Parameters')
               abort = .true.
  120          continue
            end if
         end if
      end do
c
c     determine the total number of forcefield parameters
c
      nb = maxnb
      nb5 = maxnb5
      nb4 = maxnb4
      nb3 = maxnb3
      do i = maxnb, 1, -1
         if (kb(i) .eq. blank)  nb = i - 1
      end do
      do i = maxnb5, 1, -1
         if (kb5(i) .eq. blank)  nb5 = i - 1
      end do
      do i = maxnb4, 1, -1
         if (kb4(i) .eq. blank)  nb4 = i - 1
      end do
      do i = maxnb3, 1, -1
         if (kb3(i) .eq. blank)  nb3 = i - 1
      end do
      use_ring = .false.
      if (min(nb5,nb4,nb3) .ne. 0)  use_ring = .true.
c
c     use special bond parameter assignment method for MMFF
c
      if (forcefield .eq. 'MMFF94') then
         call kbondm
         return
      end if
c
c     assign ideal bond length and force constant for each bond
c
      header = .true.
      do i = 1, nbond
         ia = ibnd(1,i)
         ib = ibnd(2,i)
         ita = class(ia)
         itb = class(ib)
         size = 4
         call numeral (ita,pa,size)
         call numeral (itb,pb,size)
         if (ita .le. itb) then
            pt = pa//pb
         else
            pt = pb//pa
         end if
         bk(i) = 0.0d0
         bl(i) = 0.0d0
         done = .false.
c
c     make a check for bonds contained inside small rings
c
         iring = 0
         if (use_ring) then
            call chkring (iring,ia,ib,0,0)
            if (iring .eq. 6)  iring = 0
            if (iring.eq.5 .and. nb5.eq.0)  iring = 0
            if (iring.eq.4 .and. nb4.eq.0)  iring = 0
            if (iring.eq.3 .and. nb3.eq.0)  iring = 0
         end if
c
c     assign bond stretching parameters for each bond
c
         if (iring .eq. 0) then
            do j = 1, nb
               if (kb(j) .eq. pt) then
                  bk(i) = bcon(j)
                  bl(i) = blen(j)
                  done = .true.
                  goto 130
               end if
            end do
c
c     assign stretching parameters for 5-membered ring bonds
c
         else if (iring .eq. 5) then
            do j = 1, nb5
               if (kb5(j) .eq. pt) then
                  bk(i) = bcon5(j)
                  bl(i) = blen5(j)
                  done = .true.
                  goto 130
               end if
            end do
c
c     assign stretching parameters for 4-membered ring bonds
c
         else if (iring .eq. 4) then
            do j = 1, nb4
               if (kb4(j) .eq. pt) then
                  bk(i) = bcon4(j)
                  bl(i) = blen4(j)
                  done = .true.
                  goto 130
               end if
            end do
c
c     assign stretching parameters for 3-membered ring bonds
c
         else if (iring .eq. 3) then
            do j = 1, nb3
               if (kb3(j) .eq. pt) then
                  bk(i) = bcon3(j)
                  bl(i) = blen3(j)
                  done = .true.
                  goto 130
               end if
            end do
         end if
c
c     warning if suitable bond stretching parameter not found
c
  130    continue
         minat = min(atomic(ia),atomic(ib))
         if (minat .eq. 0)  done = .true.
         if (use_bond .and. .not.done) then
            if (use(ia) .or. use(ib))  abort = .true.
            if (header) then
               header = .false.
               write (iout,140)
  140          format (/,' Undefined Bond Stretching Parameters :',
     &                 //,' Type',13x,'Atom Names',11x,
     &                    'Atom Classes',/)
            end if
            label = 'Bond  '
            if (iring .eq. 5)  label = '5-Ring'
            if (iring .eq. 4)  label = '4-Ring'
            if (iring .eq. 3)  label = '3-Ring'
            write (iout,150)  label,ia,name(ia),ib,name(ib),ita,itb
  150       format (1x,a6,5x,i6,'-',a3,i6,'-',a3,7x,2i5)
         end if
      end do
c
c     check for electronegativity bond length corrections
c
      call keneg
c
c     turn off the bond stretch potential if it is not used
c
      if (nbond .eq. 0)  use_bond = .false.
      return
      end
c
c
c     #################################################################
c     ##                                                             ##
c     ##  subroutine keneg  --  assign electronegativity parameters  ##
c     ##                                                             ##
c     #################################################################
c
c
c     "keneg" applies primary and secondary electronegativity bond
c     length corrections to applicable bond parameters
c
c     note this version does not scale multiple corrections to the
c     same bond by increasing powers of 0.62 as in MM3
c
c
      subroutine keneg
      implicit none
      include 'sizes.i'
      include 'angle.i'
      include 'atmlst.i'
      include 'atmtyp.i'
      include 'bond.i'
      include 'couple.i'
      include 'inform.i'
      include 'iounit.i'
      include 'kbonds.i'
      include 'keys.i'
      include 'tors.i'
      integer i,j,k,m,nel
      integer ia,ib,ic,id
      integer ita,itb,itc,itd
      integer size,next
      real*8 dl,factor
      logical header
      character*4 pa,pb,pc,pd
      character*12 blank
      character*12 pt,pt1,pt2
      character*20 keyword
      character*120 record
      character*120 string
c
c
c     process keywords containing electronegativity parameters
c
      blank = '            '
      header = .true.
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:9) .eq. 'ELECTNEG ') then
            ia = 0
            ib = 0
            ic = 0
            dl = 0.0d0
            string = record(next:120)
            read (string,*,err=10,end=10)  ia,ib,ic,dl
   10       continue
            if (.not. silent) then
               if (header) then
                  header = .false.
                  write (iout,20)
   20             format (/,' Additional Electronegativity',
     &                       ' Parameters :',
     &                    //,5x,'Atom Classes',18x,'dLength',/)
               end if
               write (iout,30)  ia,ib,ic,dl
   30          format (4x,3i4,14x,f12.4)
            end if
            size = 4
            call numeral (ia,pa,size)
            call numeral (ib,pb,size)
            call numeral (ic,pc,size)
            pt = pa//pb//pc
            do j = 1, maxnel
               if (kel(j).eq.blank .or. kel(j).eq.pt) then
                  kel(j) = pt
                  dlen(j) = dl
                  goto 50
               end if
            end do
            write (iout,40)
   40       format (/,' KENEG  --  Too many Electronegativity',
     &                    ' Parameters')
            abort = .true.
   50       continue
         end if
      end do
c
c     determine the total number of forcefield parameters
c
      nel = maxnel
      do i = 1, maxnel
         if (kel(i) .eq. blank) then
            nel = i - 1
            goto 60
         end if
      end do
   60 continue
c
c     check angles for primary electronegativity corrections
c
      if (nel .ne. 0) then
         do i = 1, nangle
            ia = iang(1,i)
            ib = iang(2,i)
            ic = iang(3,i)
            ita = class(ia)
            itb = class(ib)
            itc = class(ic)
            size = 4
            call numeral (ita,pa,size)
            call numeral (itb,pb,size)
            call numeral (itc,pc,size)
            pt1 = pa//pb//pc
            pt2 = pc//pb//pa
c
c     search the parameter set for a match to either bond
c
            do j = 1, nel
               if (kel(j) .eq. pt1) then
                  do k = 1, n12(ia)
                     if (i12(k,ia) .eq. ib) then
                        m = bndlist(k,ia)
                        bl(m) = bl(m) + dlen(j)
                     end if
                  end do
                  goto 70
               else if (kel(j) .eq. pt2) then
                  do k = 1, n12(ic)
                     if (i12(k,ic) .eq. ib) then
                        m = bndlist(k,ic)
                        bl(m) = bl(m) + dlen(j)
                     end if
                  end do
                  goto 70
               end if
            end do
   70       continue
         end do
c
c     check torsions for secondary electronegativity corrections
c
         factor = 0.4d0
         do i = 1, ntors
            ia = itors(1,i)
            ib = itors(2,i)
            ic = itors(3,i)
            id = itors(4,i)
            ita = class(ia)
            itb = class(ib)
            itc = class(ic)
            itd = class(id)
            size = 4
            call numeral (ita,pa,size)
            call numeral (itb,pb,size)
            call numeral (itc,pc,size)
            call numeral (itd,pd,size)
            pt1 = pa//pb//pd
            pt2 = pd//pc//pa
c
c     turn off electronegativity effect for attached hydrogens
c
            if (atomic(id) .le. 1)  pt1 = blank
            if (atomic(ia) .le. 1)  pt2 = blank
c
c     search the parameter set for a match to either bond
c
            do j = 1, nel
               if (kel(j) .eq. pt1) then
                  do k = 1, n12(ia)
                     if (i12(k,ia) .eq. ib) then
                        m = bndlist(k,ia)
                        bl(m) = bl(m) + factor*dlen(j)
                     end if
                  end do
                  goto 80
               else if (kel(j) .eq. pt2) then
                  do k = 1, n12(id)
                     if (i12(k,id) .eq. ic) then
                        m = bndlist(k,id)
                        bl(m) = bl(m) + factor*dlen(j)
                     end if
                  end do
                  goto 80
               end if
            end do
   80       continue
         end do
      end if
      return
      end
c
c
c     ##################################################################
c     ##                                                              ##
c     ##  subroutine kbondm  --  assign MMFF bond stretch parameters  ##
c     ##                                                              ##
c     ##################################################################
c
c
c     "kbondm" assigns a force constant and ideal bond length to
c     each bond according to the Merck Molecular Force Field (MMFF)
c
c     literature reference:
c
c     R. Blom and A. Haaland, "A Modification of the Schomaker-Stevenson
c     Rule for Prediction of Single Bond Distances", Journal of
c     Molecular Structure, 128, 21-27 (1985)
c
c
      subroutine kbondm
      implicit none
      include 'sizes.i'
      include 'atmtyp.i'
      include 'bond.i'
      include 'keys.i'
      include 'merck.i'
      include 'potent.i'
      integer i,j
      integer ia,ib,ita,itb
      integer next,minat
      integer list(20)
      real*8 khia,khib,cst
      real*8 rad0a,rad0b
      logical header,done
      character*20 keyword
      character*120 record
      character*120 string
c
c
c     get single bonds that could be double (MMFF bond type=1)
c
      nlignes = 0
      do i = 1, nkey
         next = 1
         record = keyline(i)
         call gettext (record,keyword,next)
         call upcase (keyword)
         if (keyword(1:12) .eq. 'MMFF-PIBOND ') then
            do j = 1, 20
               list(j) = 0
            end do
            string = record(next:120)
            read (string,*,err=10,end=10)  (list(j),j=1,20)
   10       continue
            do j = 1, 20, 2
               if (list(j).ne.0 .and. list(j+1).ne.0) then
                  nlignes = nlignes + 1
                  bt_1(nlignes,1) = list(j)
                  bt_1(nlignes,2) = list(j+1)
               else
                  goto 20
               end if
            end do
   20       continue
         end if
      end do
c
c     assign MMFF bond length and force constant values
c
      header = .true.
      do i = 1, nbond
         ia = ibnd(1,i)
         ib = ibnd(2,i)
         ita = class(ia)
         itb = class(ib)
         if (ia .le. ib) then
            do j = 1, nlignes
               if (ia.eq.bt_1(j,1) .and. ib.eq.bt_1(j,2)) then
                  bk(i) = mmff_kb1(ita,itb)
                  bl(i) = mmff_b1(ita,itb)
                  done = .true.
                  if (bk(i) .eq. 1000.0d0)  done = .false.
                  if (bl(i) .eq. 1000.0d0)  done = .false.
                  goto 30
               end if
            end do
            bk(i) = mmff_kb(ita,itb)
            bl(i) = mmff_b0(ita,itb)
            done = .true.
            if (bk(i) .eq. 1000.0d0)  done = .false.
            if (bl(i) .eq. 1000.0d0)  done = .false.
            goto 30
         else if (ib .le. ia) then
            do j = 1, nlignes
               if (ib.eq.bt_1(j,1) .and. ia.eq.bt_1(j,2)) then
                  bk(i) = mmff_kb1(itb,ita)
                  bl(i) = mmff_b1(itb,ita)
                  done = .true.
                  if (bk(i) .eq. 1000.0d0)  done = .false.
                  if (bl(i) .eq. 1000.0d0)  done = .false.
                  goto 30
               end if
            end do
            bk(i) = mmff_kb(itb,ita)
            bl(i) = mmff_b0(itb,ita)
            done = .true.
            if (bk(i) .eq. 1000.0d0)  done = .false.
            if (bl(i) .eq. 1000.0d0)  done = .false.
            goto 30
         end if
c
c     estimate missing bond parameters via an empirical rule
c
   30    continue
         minat = min(atomic(ia),atomic(ib))
         if (minat .eq. 0)  done = .true.
         if (.not. done) then
            khia = paulel(atomic(ia))
            khib = paulel(atomic(ib))
            rad0a = rad0(atomic(ia))
            rad0b = rad0(atomic(ib))
            cst = 0.085d0
            if (atomic(ia).eq.1 .or. atomic(ib).eq.1)  cst = 0.05d0
            bl(i) = rad0a + rad0b - cst*abs(khia-khib)**1.4d0
            bk(i) = kbref(atomic(ia),atomic(ib))
     &                 * (r0ref(atomic(ia),atomic(ib))/bl(i))**6
         end if
      end do
c
c     turn off the bond stretch potential if it is not used
c
      if (nbond .eq. 0)  use_bond = .false.
      return
      end


SUBROUTINE read_fitting_control_file ( pge_idx, l1b_radiance_esdt, pge_error_status )

  ! ***********************************************************
  !
  !   Read fitting control parameters from input control file
  !
  ! ***********************************************************

  USE OMSAO_precision_module
  USE OMSAO_indices_module, ONLY: &
       max_rs_idx, calfit_strings, max_calfit_idx, radfit_strings, mxs_idx, n_max_fitpars, &
       hwe_idx, refspec_strings,    icf_idx, pge_static_input_luns,                        &
       genline_str, socline_str, racline_str, rrsline_str, procline_str,                   &
       rafline_str, rspline_str, iofline_str, molline_str, eoi3str, us1_idx, us2_idx,      &
       pge_oclo_idx,  pge_hcho_idx, pge_no2_idx, pge_gly_idx, pge_no2d_idx,                &
       solcal_idx, radcal_idx, radref_idx, radfit_idx, wavwindow_str, fitresconst_str,     &
       destriping_str, scpline_str, nrmline_str, comline_str, o3amf_str, maxgoodcol_str,   &
       comm_idx, procmode_diag, procmode_prod, solmonthave_str, wfmod_amf_str,             &
       newshift_str, refseccor_str, scattweight_str
  USE OMSAO_parameters_module,   ONLY: maxchlen, forever, n_fit_winwav, max_mol_fit
  USE OMSAO_variables_module,    ONLY: &
       fitcol_idx, n_mol_fit, max_itnum_sol, max_itnum_rad, yn_smooth, yn_doas,            &
       fitvar_sol_init, fitvar_rad_init,  fitvar_rad_saved, szamax,                        &
       zatmos, lo_sunbnd, up_sunbnd, lo_radbnd, up_radbnd, n_refspec,                      &
       yn_use_labslitfunc, radwavcal_freq, tol, epsrel,  epsabs,  epsx, pm_one, phase,     &
       fit_winwav_lim, fit_winexc_lim, pixnum_lim, radfit_latrange,                        &
       static_input_fnames, fitvar_rad_str, verb_thresh_lev, winwav_min, winwav_max,       &
       have_undersampling, l1b_rad_filename,                                               &
       n_fitres_loop, fitres_range, l1b_channel, yn_solar_i0,                              &
       yn_solar_comp, solar_comp_typ, solar_comp_orb, yn_spectrum_norm, yn_common_iter,    &
       common_fitpos, common_fitvar, common_latrange, yn_o3amf_cor, yn_diagnostic_run,     &
       max_good_col, yn_solmonthave, yn_newshift, yn_refseccor, yn_sw
  USE OMSAO_prefitcol_module, ONLY: yn_bro_prefit, yn_o3_prefit, yn_lqh2o_prefit
  USE OMSAO_omidata_module, ONLY: vis_lower_wvl, omi_ccdpix_selection, nxtrack_max
  USE OMSAO_radiance_ref_module, ONLY: &
       yn_radiance_reference, radref_latrange, yn_remove_target, target_npol
  USE OMSAO_destriping_module, ONLY: &
       ctr_pol_base, ctr_pol_scal, ctr_pol_patt, ctr_nloop, ctrdst_latrange, ctr_nblocks, &
       ctr_fitfunc_calls, ctr_maxcol, yn_remove_ctrbias, ctr_bias_pol, yn_run_destriping
  USE OMSAO_casestring_module, ONLY: lower_case
  USE OMSAO_errstat_module
  USE OMSAO_wfamf_module, ONLY: &
       yn_amf_wfmod, amf_wfmod_idx, amf_alb_lnd, amf_alb_sno, amf_wvl, amf_wvl2, &
       amf_alb_cld, amf_max_sza

  IMPLICIT NONE

  ! ---------------
  ! Input variables
  ! ---------------
  INTEGER (KIND=i4), INTENT (IN) :: pge_idx

  ! ---------------
  ! Output variable
  ! ---------------
  CHARACTER (LEN=maxchlen), INTENT (OUT)   :: l1b_radiance_esdt
  INTEGER   (KIND=i4),      INTENT (INOUT) :: pge_error_status

  ! ---------------
  ! Local variables
  ! ---------------
  INTEGER   (KIND=i4)      :: i, j, k, file_read_stat, sidx, ridx
  INTEGER   (KIND=i4)      :: fit_ctrl_unit
  CHARACTER (LEN=maxchlen) :: tmpchar
  CHARACTER (LEN=3)        :: idxchar
  LOGICAL                  :: yn_eoi
  REAL      (KIND=r8)      :: vartmp, lotmp, uptmp

  ! ==============================
  ! Name of this module/subroutine
  ! ==============================
  CHARACTER (LEN=25), PARAMETER :: modulename = 'read_fitting_control_file'

  ! ========================
  ! Error handling variables
  ! ========================
  INTEGER (KIND=i4) :: errstat, version

  ! =================================
  ! External OMI and Toolkit routines
  ! =================================
  INTEGER (KIND=i4) :: pgs_smf_teststatuslevel, pgs_io_gen_openf, pgs_io_gen_closef

  errstat = pge_errstat_ok

  ! ---------------------------
  ! Initialize output variables
  ! ---------------------------
  ctr_pol_base    = 0      ; ctr_pol_scal = 0 ; ctr_pol_patt      = 0
  ctr_nloop       = 0      ; ctr_nloop    = 0 ; ctr_fitfunc_calls = 0
  ctrdst_latrange = 0.0_r4 ; ctr_maxcol   = 0.0_r8
  ctr_bias_pol    = 0      ; yn_remove_ctrbias = .FALSE.

  ! -------------------------
  ! Open fitting control file
  ! -------------------------
  version = 1
  errstat = PGS_IO_GEN_OPENF ( &
       pge_static_input_luns(icf_idx), PGSd_IO_Gen_RSeqFrm, 0, &
       fit_ctrl_unit, version )
  errstat = PGS_SMF_TESTSTATUSLEVEL(errstat)
  CALL error_check ( &
       errstat, PGS_SMF_MASK_LEV_S, pge_errstat_fatal, OMSAO_F_OPEN_FITCTRL_FILE, &
       modulename//f_sep//TRIM(ADJUSTL(static_input_fnames(icf_idx))), &
       vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  ! -----------------------------------------------
  ! Position cursor to read molecule name(s) to fit
  ! -----------------------------------------------
  REWIND ( fit_ctrl_unit )
  CALL skip_to_filemark ( fit_ctrl_unit, molline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//molline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  READ (fit_ctrl_unit, '(A)') tmpchar
  CALL get_mols_for_fitting ( tmpchar, n_mol_fit, fitcol_idx, errstat )
  CALL error_check ( &
       errstat, pge_errstat_ok, pge_errstat_fatal, OMSAO_F_GET_MOLFITNAME, &
       modulename, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  ! --------------------------------------------------------------
  ! Position cursor to read processing mode. Set YN_DIAGNOSTIC_RUN
  ! to .TRUE. if "diagnostic" is selected as processing mode.
  ! --------------------------------------------------------------
  REWIND ( fit_ctrl_unit )
  CALL skip_to_filemark ( fit_ctrl_unit, procline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//procline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  READ (fit_ctrl_unit, '(A)') tmpchar
  tmpchar = lower_case ( TRIM(ADJUSTL(tmpchar)) )
  IF ( TRIM(ADJUSTL(tmpchar)) == procmode_diag ) THEN
     yn_diagnostic_run = .TRUE.
  ELSE
     yn_diagnostic_run = .FALSE.
  END IF

  ! ------------------------------------------------
  ! Position cursor to read general input parameters
  ! ------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, genline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//genline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  READ (fit_ctrl_unit, *) yn_smooth
  READ (fit_ctrl_unit, *) yn_doas
  READ (fit_ctrl_unit, *) pixnum_lim(1:2)
  READ (fit_ctrl_unit, *) pixnum_lim(3:4)
  READ (fit_ctrl_unit, *) radfit_latrange(1:2)
  READ (fit_ctrl_unit, *) tol
  READ (fit_ctrl_unit, *) epsrel
  READ (fit_ctrl_unit, *) epsabs
  READ (fit_ctrl_unit, *) epsx

  ! ------------------------------------------------
  ! Check for consistency of pixel limits to process
  ! ------------------------------------------------
  IF ( ANY ( pixnum_lim(3:4) < 1 ) ) pixnum_lim(3:4) = (/ 1, nxtrack_max /)
  IF ( pixnum_lim(1) > pixnum_lim(2) ) pixnum_lim(1) = pixnum_lim(2)
  IF ( pixnum_lim(3) > pixnum_lim(4) ) pixnum_lim(3) = pixnum_lim(4)

  ! -------------------------------------------------
  ! Position cursor to read solar composite selection
  ! -------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, scpline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//scpline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  READ (fit_ctrl_unit, *) yn_solar_comp
  IF ( yn_solar_comp ) READ (fit_ctrl_unit,*) solar_comp_typ

  ! -----------------------------------------------------
  ! Position cursor to read solar monthly average section
  ! -----------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, solmonthave_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//scpline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  READ (fit_ctrl_unit, *) yn_solmonthave

  ! -------------------------------------------------------
  ! Position cursor to read spectum normalization selection
  ! -------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, nrmline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//nrmline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  READ (fit_ctrl_unit, *) yn_spectrum_norm

  ! ---------------------------------------------------------------------
  ! Position cursor to read common mode iteration. .TRUE. will lead to a
  ! second run through the orbit, using the common mode spectrum that has
  ! been created during the first pass.
  ! ---------------------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, comline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//comline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  READ (fit_ctrl_unit, *) yn_common_iter
  IF ( yn_common_iter ) READ (fit_ctrl_unit, *) common_latrange

  ! ---------------------------------------------------------------------
  ! Position cursor to read radiance reference settings.
  ! ---------------------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, rrsline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//rrsline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  READ (fit_ctrl_unit, *) yn_radiance_reference
  READ (fit_ctrl_unit, *) yn_remove_target, target_npol
  READ (fit_ctrl_unit, *) radref_latrange(1:2)

  ! ----------------------------------------------------------
  ! Position cursor to read solar calibration input parameters
  ! ----------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, socline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//socline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  READ (fit_ctrl_unit, *) max_itnum_sol

  yn_use_labslitfunc = .TRUE.
  solpars: DO i = 1, max_calfit_idx

     READ (fit_ctrl_unit, *) idxchar, vartmp, lotmp, uptmp
     ! ---------------------------------------------------------
     ! Check for consitency of bounds and adjust where necessary
     ! ---------------------------------------------------------
     IF ( lotmp > vartmp .OR. uptmp < vartmp ) THEN
        lotmp = vartmp ; uptmp = vartmp
     END IF
     IF ( lotmp == uptmp .AND. lotmp /= vartmp ) THEN
        uptmp = vartmp ; lotmp = vartmp
     END IF

     IF ( idxchar == eoi3str ) EXIT solpars

     CALL string2index ( calfit_strings, max_calfit_idx, idxchar, sidx )
     IF ( sidx > 0 ) THEN
        fitvar_sol_init(sidx) = vartmp
        lo_sunbnd(sidx) = lotmp ; up_sunbnd(sidx) = uptmp
        ! ----------------------------------------------------
        ! Check whether we will be doing slit function fitting
        ! ----------------------------------------------------
        IF ( sidx == hwe_idx .AND. fitvar_sol_init(sidx) > 0.0_r8 ) yn_use_labslitfunc = .FALSE.
     END IF
  END DO solpars

  ! -------------------------------------------------------------
  ! Position cursor to read radiance calibration input parameters
  ! -------------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, racline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//racline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  ! --------------------------------------------------------------------
  ! Special logicals for HCHO - O3 and BrO prefits. Two-dimensional:
  ! (1) Use O3/BrO prefitted columns?
  ! (2) Vary those prefitted columns within their fitting uncertainties?
  !
  ! Special logicals for CHOCHO - Liquid Water prefits. Two-dimensional:
  ! (1) Use Liquid Water prefitted columns?
  ! (2) Vary those prefitted columns within their fitting uncertainties?
  ! --------------------------------------------------------------------
  SELECT CASE ( pge_idx )
  CASE ( pge_hcho_idx )
     READ (fit_ctrl_unit, *) yn_o3_prefit (1:2)
     READ (fit_ctrl_unit, *) yn_bro_prefit(1:2)
  CASE ( pge_gly_idx )
     READ (fit_ctrl_unit, *) yn_lqh2o_prefit (1:2)
  CASE DEFAULT
  END SELECT

  READ (fit_ctrl_unit, *) yn_solar_i0
  READ (fit_ctrl_unit, *) max_itnum_rad
  READ (fit_ctrl_unit, *) radwavcal_freq
  READ (fit_ctrl_unit, *) szamax
  READ (fit_ctrl_unit, *) zatmos
  READ (fit_ctrl_unit, *) phase
  fitvar_rad_init = 0.0_r8
  radpars: DO i = 1, max_calfit_idx
     READ (fit_ctrl_unit, *) idxchar, vartmp, lotmp, uptmp
     ! ---------------------------------------------------------
     ! Check for consitency of bounds and adjust where necessary
     ! ---------------------------------------------------------
     IF ( lotmp > vartmp .OR. uptmp < vartmp ) THEN
        lotmp = vartmp ; uptmp = vartmp
     END IF
     IF ( lotmp == uptmp .AND. lotmp /= vartmp ) THEN
        uptmp = vartmp ; lotmp = vartmp
     END IF

     IF ( idxchar == eoi3str ) EXIT radpars
     CALL string2index ( calfit_strings, max_calfit_idx, idxchar, sidx )
     IF ( sidx > 0 ) THEN
        fitvar_rad_init(sidx) = vartmp
        fitvar_rad_str (sidx) = TRIM(ADJUSTL(idxchar))
        lo_radbnd(sidx) = lotmp ; up_radbnd(sidx) = uptmp
     END IF
  END DO radpars
  fitvar_rad_saved = fitvar_rad_init

  ! ---------------------------------------------------------------------
  ! Check the latitude for the radiance reference, a.k.a. wavelength
  ! calibration spectrum.
  ! If larger than 90 deg, set to 0.0, i.e., the Equator.
  ! ---------------------------------------------------------------------
  WHERE ( ABS(radref_latrange) > 90.0_r4 )
     radref_latrange = 0.0_r4
  END WHERE

  ! ---------------------------------------------------------
  ! Position cursor to read WFmodified AMF logical
  ! ---------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, wfmod_amf_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//wfmod_amf_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN
  READ (fit_ctrl_unit, *) yn_amf_wfmod, amf_wfmod_idx
  READ (fit_ctrl_unit, *) amf_alb_lnd, amf_alb_sno, amf_alb_cld
  IF ( .NOT. yn_amf_wfmod ) READ (fit_ctrl_unit, *) amf_wvl, amf_wvl2, amf_max_sza

  ! ---------------------------------------------------------
  ! Position cursor to read O3 AMF correction logical
  ! ---------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, o3amf_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//o3amf_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN
  READ (fit_ctrl_unit, *) yn_o3amf_cor

  ! ---------------------------------------------------------
  ! Position cursor to read radiance fitting input parameters
  ! ---------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, rafline_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//rafline_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN

  ! ------------------------------------------------------------------------
  ! By default we set the undersampling spectrum to FALSE. Only if we select
  ! it to be included in the fitting does it become trues. This way we save
  ! computation time for cases where we don't include the undersampling.
  ! ------------------------------------------------------------------------
  have_undersampling = .FALSE.
  getpars: DO j = 1, max_rs_idx
     READ (UNIT=fit_ctrl_unit, FMT='(A)', IOSTAT=errstat) tmpchar
     CALL error_check ( &
          errstat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
          modulename//f_sep//"radiance fitting parameters", vb_lev_default, pge_error_status )
     IF ( pge_error_status >= pge_errstat_error ) RETURN

     CALL check_for_endofinput ( TRIM(ADJUSTL(tmpchar)), yn_eoi )
     IF ( yn_eoi ) EXIT getpars
     CALL string2index ( refspec_strings, max_rs_idx, tmpchar, ridx )

     ! ------------------------------------------------------------------------
     ! The loop goes over MXS_IDX+1 to catch any "eoi" that may have been added
     ! after a three-element block initialization (O3 for polynomial-dependent
     ! cross-section correction).
     ! ------------------------------------------------------------------------
     getblock: DO k = 1, mxs_idx+1

        READ (fit_ctrl_unit, *) idxchar, vartmp, lotmp, uptmp
        IF ( TRIM(ADJUSTL(idxchar)) == 'eoi' ) EXIT getblock

        ! ---------------------------------------------------------
        ! Check for consitency of bounds and adjust where necessary
        ! ---------------------------------------------------------
        IF ( lotmp > vartmp .OR. uptmp < vartmp ) THEN
           lotmp = vartmp ; uptmp = vartmp
        END IF
        IF ( lotmp == uptmp .AND. lotmp /= vartmp ) THEN
           uptmp = vartmp ; lotmp = vartmp
        END IF

        CALL string2index ( radfit_strings, mxs_idx, idxchar, sidx )

        IF ( sidx > 0 .AND. ridx > 0 ) THEN
           i = max_calfit_idx + (ridx-1)*mxs_idx + sidx
           fitvar_rad_init(i) = vartmp
           fitvar_rad_str (i) = TRIM(ADJUSTL(tmpchar))
           lo_radbnd (i) = lotmp ; up_radbnd (i) = uptmp
           IF ( (ridx == us1_idx .OR. ridx == us2_idx) .AND. &
                ANY ( (/ vartmp,lotmp,uptmp /) /= 0.0_r8 ) ) have_undersampling(ridx) = .TRUE.

           ! --------------------------------------------------
           ! Check for on-line Common Mode spectrum computation
           ! --------------------------------------------------
           IF ( ridx == comm_idx .AND. yn_common_iter ) THEN
              common_fitvar(1:3) = (/ vartmp, lotmp, uptmp /)
              common_fitpos      = sidx
           END IF
        END IF
     END DO getblock
  END DO getpars

  ! ------------------------------------------------------------------
  ! Formerly wavelength array specifications, now superceeded by the
  ! CCD pixel specifications. Included here for backward compatibility
  ! and easy of human reading (how else would we know the extend of
  ! the CCD pixel slice in terms of wavelengths?)
  ! ------------------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, wavwindow_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//wavwindow_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN
  READ (fit_ctrl_unit, *) l1b_channel
  READ (fit_ctrl_unit, *) fit_winwav_lim(1:n_fit_winwav), fit_winexc_lim(1:2)

  ! ------------------------------------------------------------------
  ! Acceptable window for the fitting residual in multiples of its
  ! standard deviation, and the number of iterations  we will perform
  ! to get the residual within these bounds. Negative values stand for
  ! "no constraints" - this is mainly for the radiance wavelength
  ! calibration, which consists of the fitting of the solar reference to a
  ! radiance spectrum and hence produces a large residual anyway.  Smaller
  ! windows and more iterations lead to larger execution times.
  ! ------------------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, fitresconst_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//fitresconst_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN
  READ (fit_ctrl_unit, *) fitres_range(solcal_idx), n_fitres_loop(solcal_idx)
  READ (fit_ctrl_unit, *) fitres_range(radcal_idx), n_fitres_loop(radcal_idx)
  READ (fit_ctrl_unit, *) fitres_range(radref_idx), n_fitres_loop(radref_idx)
  READ (fit_ctrl_unit, *) fitres_range(radfit_idx), n_fitres_loop(radfit_idx)

  ! ---------------------------------------------------------------------------
  ! Position cursor to read maximum good column amount
  ! ---------------------------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, maxgoodcol_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//maxgoodcol_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN
  READ (fit_ctrl_unit, *) max_good_col

  ! ---------------------------------------------------------------------------
  ! Position cursor to read destriping parameters:
  ! * Order of cross track polynomials (Baseline, Scaling; XTR pattern)
  ! * Number of swath lines (or latitude limits) to be averaged for XTR pattern
  ! * Maximum number of calls to fitting function
  ! * Number of iterations for destriping
  ! * Absolute maximum column value (+/- range) to include in averaging
  ! ---------------------------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, destriping_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//destriping_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN
  READ (fit_ctrl_unit, *) yn_run_destriping
  READ (fit_ctrl_unit, *) yn_remove_ctrbias, ctr_bias_pol
  READ (fit_ctrl_unit, *) ctr_pol_base, ctr_pol_scal, ctr_pol_patt
  READ (fit_ctrl_unit, *) ctr_nblocks, ctrdst_latrange
  READ (fit_ctrl_unit, *) ctr_fitfunc_calls
  READ (fit_ctrl_unit, *) ctr_nloop

  ! --------------------------------------------------------
  ! Position cursor to read new shift and squeeze option gga
  ! --------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, newshift_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//destriping_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN
  READ (fit_ctrl_unit, *) yn_newshift

  ! -------------------------------------------------------------------
  ! Position cursor to read logical for Reference Sector Correction gga
  ! -------------------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, refseccor_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//destriping_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN
  READ (fit_ctrl_unit, *) yn_refseccor

  ! ------------------------------------------------------------------
  ! Position cursor to read logical for Scattering Weights and ... gga
  ! ------------------------------------------------------------------
  REWIND (fit_ctrl_unit)
  CALL skip_to_filemark ( fit_ctrl_unit, scattweight_str, tmpchar, file_read_stat )
  CALL error_check ( &
       file_read_stat, file_read_ok, pge_errstat_fatal, OMSAO_F_READ_FITCTRL_FILE, &
       modulename//f_sep//destriping_str, vb_lev_default, pge_error_status )
  IF ( pge_error_status >= pge_errstat_error ) RETURN
  READ (fit_ctrl_unit, *) yn_sw

  ! -------------------------------------------------------------------
  ! Unless we come up with a reason against it, the maximum good column
  ! also applies to the destriping procedure.
  ! -------------------------------------------------------------------
  ctr_maxcol = max_good_col

  ! -------------------------------------------------------------------------
  ! Determine minimum and maximum wavelength in selected read/fitting windows
  ! -------------------------------------------------------------------------
  winwav_min = MINVAL((/ fit_winwav_lim(1:n_fit_winwav) /))
  winwav_max = MAXVAL((/ fit_winwav_lim(1:n_fit_winwav) /))

  errstat = pge_errstat_ok

  ! ----------------------------------------------------------------------
  ! At this point we check whether we have to read from UV2 or VIS file.
  ! This is set throught the 3-letter string preceeding the start and end
  ! wavelengths of the fitting window. Of course, the PCF must contain the
  ! corresponding file under the LUN associated with the radiance file.
  ! ----------------------------------------------------------------------
  SELECT CASE ( l1b_channel )
  CASE ( 'UV1' )
     l1b_radiance_esdt  = 'OML1BRUG'
  CASE ( 'UV2' )
     l1b_radiance_esdt  = 'OML1BRUG'
  CASE ( 'VIS' )
     l1b_radiance_esdt  = 'OML1BRVG'
  END SELECT

  CALL find_radiance_fitting_variables ( errstat )

  IF ( yn_doas ) THEN
     pm_one     = -1.0_r8
  ELSE
     pm_one     =  1.0_r8
  END IF

  ! -----------------------------------------------
  ! Close fitting control file, report SUCCESS read
  ! -----------------------------------------------
  errstat = PGS_IO_GEN_CLOSEF ( fit_ctrl_unit )
  errstat = PGS_SMF_TESTSTATUSLEVEL(errstat)
  CALL error_check ( &
       errstat, pgs_smf_mask_lev_s, pge_errstat_warning, OMSAO_W_CLOSE_FITCTRL_FILE, &
       modulename//f_sep//TRIM(ADJUSTL(static_input_fnames(icf_idx))),               &
       vb_lev_default, pge_error_status )

  CALL error_check ( &
       0, 1, pge_errstat_ok, OMSAO_S_READ_FITCTRL_FILE,                &
       modulename//f_sep//TRIM(ADJUSTL(static_input_fnames(icf_idx))), &
       vb_lev_default, pge_error_status )

  RETURN
END SUBROUTINE read_fitting_control_file

SUBROUTINE get_mols_for_fitting ( tmpchar, n_mol_fit, fitcol_idx, errstat )

  USE OMSAO_precision_module,  ONLY: i4
  USE OMSAO_indices_module,    ONLY: refspec_strings, max_rs_idx
  USE OMSAO_parameters_module, ONLY: max_mol_fit
  USE OMSAO_errstat_module,    ONLY: pge_errstat_error, pge_errstat_ok

  IMPLICIT NONE

  ! ===============
  ! Input variables
  ! ===============
  CHARACTER (LEN=*), INTENT (IN) :: tmpchar

  ! ================
  ! Output variables
  ! ================
  INTEGER (KIND=i4),                          INTENT (OUT) :: errstat, n_mol_fit
  INTEGER (KIND=i4), DIMENSION (max_mol_fit), INTENT (OUT) :: fitcol_idx

  ! ===============
  ! Local variables
  ! ===============
  INTEGER   (KIND=i4)          :: i, ncl, sstart, sidx
  LOGICAL                      :: yn_eoc
  CHARACTER (LEN=LEN(tmpchar)) :: tmpsub, local_tmpchar

  errstat = pge_errstat_ok

  ! ----------------------------
  ! Initialize output quantities
  ! ----------------------------
  n_mol_fit = 0  ;  fitcol_idx = 0

  ! -----------------------------
  ! Copy tmpchar to local_tmpchar
  ! -----------------------------
  local_tmpchar = tmpchar

  ! -----------------------------------------------
  ! Get names and indices for main molecules to fit
  ! -----------------------------------------------
  sstart = 0 ; ncl = 0 ; yn_eoc = .FALSE.
  getmolnames: DO i = 1, max_mol_fit
     ! ---------------------------------------------------------
     ! Extract index string, find index, then extract file name.
     ! ---------------------------------------------------------
     CALL get_substring ( local_tmpchar, sstart, tmpsub, ncl, yn_eoc )

     IF ( ncl > 0 ) THEN
        CALL string2index ( refspec_strings, max_rs_idx, tmpsub(1:ncl), sidx )
        IF ( sidx > 0 ) THEN
           n_mol_fit = n_mol_fit + 1
           fitcol_idx(n_mol_fit) = sidx
        END IF
     END IF
     IF ( yn_eoc ) EXIT getmolnames
  END DO getmolnames
  IF ( n_mol_fit == 0 .OR. ALL(fitcol_idx == 0) ) errstat = pge_errstat_error

  RETURN
END SUBROUTINE get_mols_for_fitting

SUBROUTINE find_radiance_fitting_variables ( errstat )

  USE OMSAO_precision_module
  USE OMSAO_errstat_module
  USE OMSAO_indices_module,      ONLY:                     &
       max_rs_idx, max_calfit_idx, mns_idx, mxs_idx,       &
       calfit_titles,  radfit_titles,  refspec_titles,     &
       calfit_strings, radfit_strings, refspec_strings,    &
       o3_t1_idx, o3_t2_idx, o3_t3_idx, bro_idx, comm_idx, &
       hwe_idx, asy_idx, ad1_idx, ad2_idx
  USE OMSAO_variables_module,    ONLY: &
       n_fitvar_rad, all_radfit_idx, mask_fitvar_rad, fitvar_rad_init,         &
       lo_radbnd, up_radbnd, n_fincol_idx, n_mol_fit, fitcol_idx, fincol_idx,  &
       yn_common_iter, common_fitpos, ozone_idx, ozone_log
  USE OMSAO_prefitcol_module, ONLY:                                            &
       o3_prefit_fitidx, bro_prefit_fitidx, yn_bro_prefit, yn_o3_prefit,       &
       n_prefit_vars
  USE OMSAO_omidata_module,      ONLY: &
       correlation_names, correlation_names_concat, nclenfit

  IMPLICIT NONE

  ! ---------------------------------------------------------------------
  ! Correlation Matrix Output: Only the correlations
  ! with the first main fitting element - FINCOL_IDX(1,1) - are written
  ! to file. This is only relevant for OMSAO3, where the final column can
  ! be composed of more than one fitting index.
  ! ---------------------------------------------------------------------

  ! ----------------
  ! Output Variables
  ! ----------------
  INTEGER (KIND=i4), INTENT (INOUT) :: errstat

  ! ---------------
  ! Local Variables
  ! ---------------
  INTEGER (KIND=i4) :: i, j, k, idx, locerrstat

  CHARACTER (LEN=maxchlen), EXTERNAL :: int2string

  ! CCM Fit Lineshape for every spectrum
  LOGICAL :: yn_fit_itf = .TRUE.

  locerrstat = pge_errstat_ok

  ! -------------------------------------------------------------
  ! Find the indices of those variables that are actually varied
  ! during the fitting, and save those in MASK_FITVAR_RAD. Save
  ! the number of varied parameters in N_FITVAR_RAD.
  !
  ! In addition, we need to determine the fitting indices that
  ! will make up the final fitted column of the molecule(s) in
  ! question. For this we have to jump through a double loop:
  ! Since we are compressing the fitting parameter array to
  ! include only the varied parameters, the final covariance
  ! matrix, which is crucial for determining the uncertainties,
  ! only knows the compressed indices. Therefore we have to have
  ! an "index of an index" type array, that remembers the index
  ! position of indices of the final molecule(s), AS THEY APPEAR
  ! IN THE COMPRESSED FITTING PARAMETER LIST.
  !
  ! For the latter task it is easier to split the loops into
  ! calibration parameters (unrelated to the final fitted column)
  ! and reference spectra parameters.
  !
  ! Later addition: ALL_RADFIT_IDX contains the indices of the
  ! fitting parameters without, in the case of the trace gases,
  ! sub-indices, but with MAX_CALFIT_IDX added for uniqueness.
  ! Remembering these values here saves us some headaches when
  ! we collect the columns of all fitting parameters and want to
  ! match those with reference spectra normalization factors.
  ! -------------------------------------------------------------
  n_fitvar_rad = 0 ; mask_fitvar_rad = 0; correlation_names = ""; nclenfit = 0
  all_radfit_idx = 0

  ! --------------------------------
  ! First the calibration parameters
  ! --------------------------------
  DO i = 1, max_calfit_idx

     IF ( i == hwe_idx .OR. i == asy_idx ) THEN

        IF ( .NOT. yn_fit_itf ) CYCLE

     END IF

     IF ( lo_radbnd(i) < up_radbnd(i) ) THEN
        n_fitvar_rad = n_fitvar_rad + 1
        mask_fitvar_rad(n_fitvar_rad) = i
        all_radfit_idx (n_fitvar_rad) = i
        correlation_names(n_fitvar_rad) = &
             TRIM(ADJUSTL(calfit_strings(i)))//": "//TRIM(ADJUSTL(calfit_titles(i)))
     END IF

  END DO

  ! ------------------------------------
  ! Now the reference spectra parameters
  ! ------------------------------------
  n_fincol_idx  = 0
  n_prefit_vars = 0
  DO i = 1, max_rs_idx
     idx = max_calfit_idx + (i-1)*mxs_idx
     DO j = mns_idx, mxs_idx
        ! ----------------------------------------------
        ! Assign only entries that are varied in the fit
        ! ----------------------------------------------
        IF ( lo_radbnd(idx+j) < up_radbnd(idx+j) ) THEN
           n_fitvar_rad = n_fitvar_rad + 1
           mask_fitvar_rad(n_fitvar_rad) = idx+j
           all_radfit_idx (n_fitvar_rad) = max_calfit_idx + i
           correlation_names(n_fitvar_rad) = &
                TRIM(ADJUSTL(refspec_strings(i)))//' - '//TRIM(ADJUSTL(radfit_strings(j)))//&
                ": "//TRIM(ADJUSTL(refspec_titles(i)))//" "//TRIM(ADJUSTL(radfit_titles(j)))

           ! --------------------------------------------------------------------------
           ! And here the loop over the final column molecules. We have to match the
           ! FITCOL_IDX with the current molecule index, and then remember the position
           ! of the fitting index in the MASK_FITVAR_RAD array. The second index
           ! remembers the reference spectrum that is associated with this molecule, so
           ! that we can easily access its normalization factor.
           ! --------------------------------------------------------------------------
           getfincol: DO k = 1, n_mol_fit
              IF ( fitcol_idx(k) == i ) THEN
                 n_fincol_idx = n_fincol_idx + 1
                 fincol_idx (1,n_fincol_idx) = n_fitvar_rad
                 fincol_idx (2,n_fincol_idx) = i
                 EXIT getfincol
              END IF
           END DO getfincol
           ! ----------------------------------------------------------------
           ! To select which TOMS profile is to be used in AMF calculation we
           ! need an idea of O3 column
           ! ----------------------------------------------------------------
           IF ( i .EQ. o3_t1_idx .OR. i .EQ. o3_t2_idx .OR. i .EQ. o3_t1_idx &
                .AND. ozone_log )  THEN
              ozone_idx = n_fitvar_rad
              ozone_log = .FALSE.
           ENDIF

        END IF

        ! -------------------------------------------------------------------------
        ! Check for any indices that correspond to pre-fitted columns
        ! -------------------------------------------------------------------------
        SELECT CASE ( i )
        CASE ( bro_idx )
           IF ( yn_bro_prefit(1) .AND. &
                (fitvar_rad_init(idx+j) /= 0.0_r8 .OR. &
                (lo_radbnd(idx+j)       < up_radbnd(idx+j))) ) bro_prefit_fitidx   = idx+j
        CASE ( o3_t1_idx:o3_t3_idx )
           IF ( yn_o3_prefit(1) .AND. &
                (fitvar_rad_init(idx+j) /= 0.0_r8 .OR. &
                (lo_radbnd(idx+j)       < up_radbnd(idx+j))) ) o3_prefit_fitidx(i) = idx+j
        CASE DEFAULT
        END SELECT

     END DO

     ! ---------------------------------------------------------------
     ! Finally, check for Common Mode Iteration. If selected, we have
     ! to add the fitting parameter information here but keep it fixed
     ! at Zero for the first round. This is a bit of a kludge, and it
     ! wastes time because we are carrying along a Zero value fitting
     ! parameter, but since the initialization of the output file and
     ! also the set-up of temporary arrays require all dimensions, it
     ! is really the easiest way to do things.
     ! ---------------------------------------------------------------
     IF ( i == comm_idx .AND. yn_common_iter ) THEN

        ! ------------------------------------------------------------------
        ! The Common Mode fitting position has been saved from the
        ! fitting control file
        ! ------------------------------------------------------------------
        j = common_fitpos
        idx = max_calfit_idx + (i-1)*mxs_idx+j

        !n_fitvar_rad = n_fitvar_rad + 1
        !mask_fitvar_rad(n_fitvar_rad) = idx
        !all_radfit_idx (n_fitvar_rad) = max_calfit_idx + i
        !correlation_names(n_fitvar_rad) = &
        !     TRIM(ADJUSTL(refspec_strings(i)))//' - '//TRIM(ADJUSTL(radfit_strings(j)))//&
        !     ": "//TRIM(ADJUSTL(refspec_titles(i)))//" "//TRIM(ADJUSTL(radfit_titles(j)))

        lo_radbnd      (idx) = 0.0_r8
        up_radbnd      (idx) = 0.0_r8
        fitvar_rad_init(idx) = 0.0_r8
     END IF

  END DO

  ! -------------------------------------------------
  ! Find out which indices hold information for ozone
  ! -------------------------------------------------
  IF (ozone_log)       ozone_log = .FALSE.
  IF (.NOT. ozone_log) ozone_log = .TRUE.

  ! ------------------------------------------------------------------------------------
  ! Concatinate the names of fitting elements that will appear in the correlation matrix
  ! ------------------------------------------------------------------------------------
  correlation_names_concat = ''
  DO i = 1, n_fitvar_rad
     correlation_names_concat = &
          TRIM(ADJUSTL(correlation_names_concat))//TRIM(ADJUSTL(correlation_names(i)))
     IF ( i < n_fitvar_rad )    &
          correlation_names_concat = TRIM(ADJUSTL(correlation_names_concat))//','
  END DO
  nclenfit = LEN_TRIM(ADJUSTL(correlation_names_concat))

  errstat = MAX ( errstat, locerrstat )

  RETURN
END SUBROUTINE find_radiance_fitting_variables