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