
CD-Section: LSM Refinement Routines
C These routines are used to set up the list of LSM parameters which are
C to be refined and to carry out the refinement of such parameters.
CD-end

C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     LSM_SET_RFLAGS    **
C***************************
C
C
CD-Routine: Set LSM parameter refinement flags - LSM_SET_RFLAGS
C This routine sets which parameters are to be refined using the
C next call to the refinement routine LSM_REFINE. For special cases
C it may also be necessary to call the associated routines LSM_ADD_RFLAG
C and LSM_CLR_RFLAG may to 'fine tune' the list of parameters set by
C LSM_SET_RFLAGS. Plate scaling factors for the top plate of a pack are
C ignored and the pack scale and temperature factors for pack 1 are
C never refined. Note that parameters based on packs defined via LSM_OMIT 
C will always be omitted.
CD-end
CD-Fortran:
      SUBROUTINE  LSM_SET_RFLAGS (IPLATE_SC1, IPACK_SC1,
     +            IPACK_BFAC1, NORM1, ABSCORGLOB1, ABSCORLOC1, REF_SC1,
     +            REF_BFAC1)
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set LSM Parameter Refinement Flags
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      INTEGER IPLATE_SC1 
      INTEGER IPACK_SC1
      INTEGER IPACK_BFAC1
      LOGICAL NORM1
      LOGICAL ABSCORGLOB1
      LOGICAL ABSCORLOC1
      LOGICAL REF_SC1
      LOGICAL REF_BFAC1
C
CD-Parameters:
C  IPLATE_SC1   i (R)   Flag >0  Refine plate scaling parameters for
C                                plate IPLATE_SC (for all packs).
C                            =0  Refine plate scaling parameters for all
C                                plates with valid data present in LIRL.
C                                (for all packs)
C                            =-1 Do not refine plate scaling parameters.
C  IPACK_SC1    i (R)   Flag >0  Refine pack scaling factor for pack
C                                IPACK_SC (must not be pack 1).
C                            =0  Refine pack scaling factors for all
C                                packs (except pack 1) with valid data
C                                present in LIRL.
C                            =-1 Do not refine pack scale factors.
C  IPACK_BFAC1  i (R)   Flag >0  Refine pack temperature factor for pack
C                                IPACK_SC (must not be pack 1),
C                            =0  Refine pack temperature factors for all
C                                packs (except pack 1) with valid data
C                                present in LIRL.
C                            =-1 Do not refine pack temperature factors.
C  NORM1        l (R)   Flag =.true.  Refine normalisation curves for all
C                                     defined ranges.
C                            =.false. Do not refine normalisation curves.
C  ABSCORGLOB1  l (R)   Flag =.true.  Refine global absorption correction.
C                            =.false. Do not refine absorption correction.
C  ABSCORLOC1   l (R)   Flag =.true.  Refine local absorption correction.
C                            =.false. Do not refine local absorption
C  REF_SC1      l (R)   Flag =.true.  Refine scale factor to reference
C                                     data.
C                            =.false. Do not refine scale factor to
C                                     reference data.
C  REF_BFAC1    l (R)   Flag =.true.  Refine temperature factor to reference
C                                     data.
C                                     correction.
C                            =.false. Do not refine temperature factor to
C                                     reference data.
CD-end
C
C Implementation note: Always ignore plate scaling parameters for top
C                      plate and do not refine pack scale & temperature
C                      factors for pack 1.

C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'ref_flags.finc'
      INCLUDE 'scps_counters.finc'
      INCLUDE 'scp.finc'
      INCLUDE 'other_scale.finc'
      INCLUDE 'x_array.finc'
      INCLUDE 'use_reflns.finc'
C
C====== LOCALS:
C

      INTEGER I, J, K, IC

C     INTEGER I, J, K, IC             ! Temp/loop variables
     
C          
C-------------------------------------------------------------------------------
C
C
C====== Set initial refinement flags
C

      IPLATE_SC = IPLATE_SC1
      IPACK_SC = IPACK_SC1
      IPACK_BFAC = IPACK_BFAC1
      REF_SC = REF_SC1
      REF_BFAC = REF_BFAC1
      NORM = NORM1 
      ABSCORGLOB = ABSCORGLOB1
      ABSCORLOC = ABSCORLOC1

      DO 10 I = 1, MXPAR
	 REFLAGS(I) = .FALSE.
10    CONTINUE 

C
C====== Set plate scale flags (only alphas refinable)
C
      IC = MAXRANGE*MAXPACK*MAXPLATES

 170  IF (IPLATE_SC.EQ.0) THEN
         DO 20 I = 1, MAXRANGE
            IF (PLSCRAN(I)) THEN
               DO 60 J = 1, NPK
                  IF (OMIT(J)) GO TO 60
                  DO 70 K = 2, NPL(J)
	             REFLAGS(IC + (I-1)*MAXPACK*MAXPLATES+
     +                          (J-1)*MAXPLATES+K) = .TRUE.
70                CONTINUE
60             CONTINUE
            END IF
20       CONTINUE 
      END IF
 
      IF (IPLATE_SC.GT.1) THEN
         DO 30 I = 1, MAXRANGE
            IF (PLSCRAN(I)) THEN
               DO 50 J = 1, NPK 
                  IF (OMIT(J)) GO TO 50
	          REFLAGS(IC + (I-1)*MAXPACK*MAXPLATES + 
     +            (J-1)*MAXPLATES+IPLATE_SC) = .TRUE.
50             CONTINUE 
            END IF
30       CONTINUE 
      END IF
C        
C====== Set pack scale refinement flags (except for pack 1)
C
      IF (IPACK_SC.EQ.0.AND.NPK.GT.1) THEN
         DO 80 I = 2, NPK
            IF (OMIT(I)) GO TO 80
	    REFLAGS(NCSCP(2)+I) = .TRUE.
80       CONTINUE
      END IF
 
      IF (IPACK_SC.GT.1.AND..NOT.OMIT(IPACK_SC)) THEN
	 REFLAGS(NCSCP(2)+IPACK_SC) = .TRUE.
      END IF
C
C====== Set pack BFAC refinement flags (except for pack 1)
C
      IF (IPACK_BFAC.EQ.0.AND.NPK.GT.1) THEN
         DO 90 I = 2, NPK
            IF (OMIT(I)) GO TO 90
	    REFLAGS(NCSCP(3)+I) = .TRUE.
90       CONTINUE
      END IF

      IF (IPACK_BFAC.GT.1.AND..NOT.OMIT(IPACK_SC)) THEN
	 REFLAGS(NCSCP(3)+IPACK_BFAC) = .TRUE.
      END IF
C
C====== Set refset scale flags
C
      IF (REF_SC) THEN
            REFLAGS(NCSCP(4)+1) = .TRUE.
      END IF
C
C====== Set refset bfac flags
C
      IF (REF_BFAC) THEN
            REFLAGS(NCSCP(5)+1) = .TRUE.
      END IF
C
C====== Set normalisation flags
C
      IF (NORM) THEN
         DO 100 I = 1, MAXRANGE
            IF (NORMRAN(I)) THEN
               DO 110 J = 1, NNORM(I)
                  IF (J.EQ.1) GO TO 110
                  REFLAGS(NCSCP(6)+(I-1)*POLCOEFFS+J) = .TRUE.
 110           CONTINUE
            END IF
100      CONTINUE
      END IF
C
C====== Set global absorption flags
C
      IF (ABSCORGLOB) THEN
         IF (IOPTABSG.EQ.1) THEN
            DO 120 I = 1, NABSG*MABSG - 1
               REFLAGS(NCSCP(7)+I) = .TRUE.
120         CONTINUE 
         END IF 
         IF (IOPTABSG.EQ.2) THEN
            DO 130 I = 1, 2*NABSG*MABSG - 2
               REFLAGS(NCSCP(7)+I) = .TRUE.
130         CONTINUE 
         END IF 
      END IF
      IF (ABSCORLOC) THEN
         DO 140 I = 1, NPK
            IF (OMIT(I)) GO TO 140
            DO 150 J = 1, NABSL(I)*MABSL(I)-1
               REFLAGSLOC(I,J) = .TRUE.
 150        CONTINUE
 140     CONTINUE
      END IF

      RETURN

      END
