
C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**********************
C**     LSM_SCFAC    **
C**********************
C
C
CD-Routine: Get scaling factor for a reflection - LSM_SCFAC
C Gets the required intensity scaling factor for a given reflection
C intensity of a reflection in the LIRL. Note that the current values
C of the scaling parameters must have been copied to the internal
C scaling arrays (using LSM_KDMCOPY) before using this routine and
C the routine LSM_TOP_LIRL must also have been called. The reflection
C list accessed is that selected when LSM_TOP_LIRL was called.
C **Note** Remember to declare this as a REAL function wherever used.
CD-end
CD-Fortran:
      REAL FUNCTION LSM_SCFAC (IREF, IERR)
CD-end
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Get scaling factor
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      INTEGER IREF
      INTEGER IERR
C
CD-Parameters:
C  IREF        i (R)   The reflection index within the LIRL
C  IERR        i (W)   Error flag =0     OK
C                                 =1     Cannot get scaling factor
C                                 =-1    'markup_required' flag found to
C                                        be set
C                                 =-100  LINDX is invalid.
CD-end
C
C Implementation note: Checks that 'markup required' flag not set

C
C====== Parameter statements:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'use_reflns.finc'
      INCLUDE 'lsm_flags.finc'

C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      INTEGER IPACK, IPLATE
      INTEGER KNORM, KPLS, IUSE
      INTEGER KERR
      REAL AINT, SIGINT, ALAM, REFINT
      REAL ABSCOR_NU, PSI_LOC, PSI_GLO
      REAL STOL2, AL3C2T
      REAL ABSCOR_LAMFN
      REAL OB_LPFAC
      REAL SC
      REAL DUM
      REAL DUMARR(2)

C     INTEGER IPACK     !The pack number 
C     INTEGER IPLATE    !The plate number 
C     INTEGER KNORM     !Normalisation curve range no. flag
C     INTEGER KPLS      !Plate to plate scaling range flag
C     INTEGER IUSE      !Use reflection flag =1 yes, =0 no
C     INTEGER KERR      !Error flag
C     REAL AINT         !Intensity value (unscaled)
C     REAL SIGINT       !sig(I) (unscaled)
C     REAL ALAM         !The lambda value
C     REAL  REFINT      !The reference intensity
C     REAL ABSCOR_NU    !'nu' angle for absorption correction 
C     REAL PSI_LOC      !'psi' angle for absorption correction (local)
C     REAL PSI_GLO      !'psi' angle for absorption correction (global)
C     REAL STOL2        !sin**theta/lambda**2
C     REAL AL3C2T       !lambda**3/(cos(2*theta))
C     REAL ABSCOR_LAMFN !lambda dependent function for absorption correction
C     REAL OB_LPFAC     !Combined obliquity/Lorentz/polarisation factor
C     REAL SC           !Scale factor
C     REAL DUM          !Dummy variable
C     REAL DUMARR(2)    !Dummy array
C
C-------------------------------------------------------------------------------
C
      IERR = 0
      LSM_SCFAC = 0.0
      IF (MARKUP_REQUIRED.OR.SELECT_REQUIRED) THEN
         IERR = -1
         RETURN
      END IF

      CALL LIRLF_LSM_SCALOBS (LINDX_USE, IREF, IPACK, IPLATE,
     +              AINT, SIGINT, ALAM, REFINT,
     +              ABSCOR_NU, PSI_LOC, PSI_GLO, STOL2,
     +              AL3C2T, ABSCOR_LAMFN, OB_LPFAC,
     +              KNORM, KPLS, IUSE, KERR)
      IF (KERR.NE.0) THEN
         IERR = -100
         RETURN
      END IF

      IF (KNORM.EQ.0.OR.KPLS.EQ.0) THEN
         IERR = 1
         RETURN
      END IF

      CALL LSM_CALCSCFAC (SC, IPACK, IPLATE, KPLS, KNORM,
     +           ABSCOR_NU, PSI_LOC, PSI_GLO, ABSCOR_LAMFN,  
     +           STOL2, ALAM, AL3C2T, OB_LPFAC, .FALSE.,
     +           DUM, DUM, DUMARR, DUM, KERR)
      IF (KERR.NE.0) THEN
         IERR = 1
         RETURN
      END IF

      LSM_SCFAC = SC

      RETURN
      END
