C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C***************************
C**     LSM_CALCSCFAC     **
C***************************
C
C **** LSM SERVICE ROUTINE ONLY ****
C
      SUBROUTINE LSM_CALCSCFAC (SC, IPACK, IPLATE, KPLS, KNORM,
     +           ABSC_NU, PSI_LOC, PSI_GLO, ABSCOR_LAMFN,  
     +           STOL2, ALAM, ALAM3COS2TH, OB_LPFAC, PRESET,
     +           PQ00_GLOB, P00_LOC, AKNORM, ANORMREF, IERR)       
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Calculates the scale factor for a reflection
C
C Author:  Steffi Arzt,  John Campbell, July 1997
C
C Arguments:
C
      INTEGER IPACK, IPLATE
      INTEGER KPLS, KNORM  
      REAL SC
      REAL ABSC_NU, PSI_LOC, PSI_GLO, ALAM              
      REAL ABSCOR_LAMFN, STOL2, ALAM3COS2TH 
      REAL OB_LPFAC
      LOGICAL PRESET
      REAL PQ00_GLOB
      REAL P00_LOC(*)
      REAL AKNORM(*)
      REAL ANORMREF
      INTEGER IERR
C
C Parameters: 
C SC             (W)   Returned scaling factor
C IPACK          (R)   Pack number for the spot
C IPLATE         (R)   Plate number for the spot
C KPLS           (R)   Plate scaling range no.  
C KNORM          (R)   Normalisation range no.
C ABSC_NU        (R)   'nu' value
C PSI_LOC        (R)   Local 'psi' value
C PSI_GLO        (R)   Global 'psi' value
C ABSCOR_LAMFN   (R)   Lambda function (mu(lam) or mu(lam)/mu(lam_ref) for
C                      modelling path length or normalised abs factor
C                      respectively
C STOL2          (R)   Sin**2(theta)/lambda**2
C ALAM           (R)   Wavelength
C ALAM3COS2TH    (R)   lambda**3/cos(2*theta))
C OB_LPFAC       (R)   Combines obliquity/Lorentz/Polarisation factor
C PRESET         (R)   'Pre-calculated PQ00_GLOB, P))_LOC, AKNORM values 
C                      passed' flag
C PQ00_GLOB      (R)   The value of P(0,0) or Q(0,0) for global
C                      absorption correction if PRESET = .TRUE. and
C                      (NABSG-1.NE.0.OR.MABSG-1.NE.0)
C P00_LOC(*)     (R)   The values of P(0,0) for local absorption correction 
C                      if PRESET = .TRUE. and (NABSL(IPACK)-1.NE.0.OR.
C                      MABSL(IPACK)-1.NE.0) for each pack
C AKNORM(*)      (R)   Values of 'k_norm' for each pack if PRESET = .TRUE. 
C                      and internal flag IABSOPT=2 for each pack
C ANORMREF       (R)   Value of normalisation curve at NORM_LAMREF if
C                      PRESET = .TRUE.
C IERR           (W)   Error flag =0 OK
C                                 =1 Invalid plate scaling range
C                                 =2 Out of range of normalisation curves
C                                 =3 Out of range for global abs. corr.
C                                 =4 Out of range for local abs. corr.
C
C
C
C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'scp.finc'
      INCLUDE 'scps_counters.finc'
      INCLUDE 'ref_flags.finc'
      INCLUDE 'other_scale.finc'
C
C====== FUNCTION TYPES:
C
      INTEGER LSM_NORM_RANGE
      DOUBLE PRECISION LSM_ANORM
      DOUBLE PRECISION LSM_ABSFACGLOB
      DOUBLE PRECISION LSM_ABSFACLOC
C
C====== LOCALS:
C
      INTEGER IC 
      INTEGER KN
      INTEGER KERR
      REAL ANR
      REAL PLK, PLA
C     INTEGER IC                   ! Temp/loop variables
C-------------------------------------------------------------------------------
C
      IERR = 0
      SC = 1.0
C
C======  Plate scale factor
C
      IF (PLFLAG.AND.IPLATE.GT.1) THEN   
         IF (KPLS.LE.0) THEN
            SC = 0.0
            IERR = 1
            RETURN
         END IF
         IC = MAXRANGE*MAXPACK*MAXPLATES
         PLK = SCP((KPLS-1)*MAXPACK*MAXPLATES+
     +         (IPACK-1)*MAXPLATES+IPLATE)
         PLA = SCP((KPLS-1)*MAXPACK*MAXPLATES+
     +         (IPACK-1)*MAXPLATES+IPLATE+IC)
         SC = PLK*EXP(PLA*ALAM3COS2TH)
      END IF
C      
C======  Pack scale factor
C
      SC = SC * SCP(NCSCP(2)+IPACK)
C
C======  Pack bfac factor
C
      IF (SCP(NCSCP(3)+IPACK).NE.0.0) SC =  SC * 
     +              EXP(-SCP(NCSCP(3)+IPACK)*STOL2)
C
C======  Refset scale factor
C
      SC = SC * SCP(NCSCP(4)+1)
C
C======  Refset bfac factor
C
      IF (SCP(NCSCP(5)+1).NE.0.0) SC = SC * 
     +              EXP(-SCP(NCSCP(5)+1)*STOL2)
C
C======  Lambda normalization 
C
      IF (PRESET) THEN
         ANR = 1.0/ANORMREF
      ELSE
         KN = LSM_NORM_RANGE (REFNORMLAM)
         ANR = 1.0/LSM_ANORM(KN, REFNORMLAM, KERR)
         IF (KERR.NE.0) THEN
            SC = 0.0
            IERR = 2
            RETURN
         END IF
      END IF
      SC = SC * LSM_ANORM(KNORM, ALAM, KERR) * ANR
      IF (KERR.NE.0) THEN
         SC = 0.0
         IERR = 2
         RETURN
      END IF
C
C======  Absorption correction
C
      IF (NABSG-1.NE.0.OR.MABSG-1.NE.0) THEN
         SC = SC * LSM_ABSFACGLOB(ABSC_NU,PSI_GLO,ABSCOR_LAMFN,PRESET,
     +                            PQ00_GLOB, AKNORM, KERR)
         IF (KERR.NE.0) THEN
            SC = 0.0
            IERR = 3
            RETURN
          END IF
      END IF

      IF (NABSL(IPACK)-1.NE.0.OR.MABSL(IPACK)-1.NE.0) THEN
         SC = SC * LSM_ABSFACLOC(ABSC_NU,PSI_LOC,ABSCOR_LAMFN,IPACK,
     +                           PRESET,P00_LOC,AKNORM,KERR)
         IF (KERR.NE.0) THEN
            SC = 0.0
            IERR = 4
            RETURN
         END IF
      END IF
C
C======  Polarization/Lorenz/cover factor
C
      SC = SC * OB_LPFAC 


      RETURN

      END