C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     LSM_ABSFACLOC       **
C*****************************
C
C **** LSM SERVICE ROUTINE ONLY ****
C
      DOUBLE PRECISION FUNCTION LSM_ABSFACLOC(ABSC_NU,PSI_LOC,
     +                          ABSCOR_LAMFN,IPACK,PRESET,P00,
     +                          AKNORM,IERR)
C
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Return the factor for local absorption correction
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      INTEGER IPACK
      REAL ABSCOR_LAMFN
      REAL ABSC_NU,PSI_LOC
      LOGICAL PRESET
      REAL P00(*)
      REAL AKNORM(*)
      INTEGER IERR

C Parameters:
C 
C  ABSC_NU        (R)   'nu' value (degrees)
C  PSI_LOC        (R)   Local 'psi' value (degrees)
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  IPACK          (R)   Pack no.
C  PRESET         (R)   'Pre-calculated P00, AKNORM values passed' flag
C  P00(*)         (R)   The value of P(0,0) for each pack if PRESET = .TRUE.
C  AKNORM(*)      (R)   Value of 'k_norm' for each pack if PRESET = .TRUE. 
C                       and internal flag IABSOPT=2.
C  IERR           (W)   Error flag =0 OK
C                                  =1 Value out of range
C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'scp.finc'
      INCLUDE 'scps_counters.finc'
      INCLUDE 'other_scale.finc'
      INCLUDE 'x_array.finc'
      INCLUDE 'scale_presets.finc'
C
C====== FUNCTION TYPES:
C
      REAL LSM_CHEB_2D_VAL
C
C====== LOCALS:
C
      INTEGER I
      INTEGER KERR
      REAL AKN
      DOUBLE PRECISION P(MAXCOEFFS)
      DOUBLE PRECISION ANU, APSI
      DOUBLE PRECISION PG,MINPSI,MAXPSI,MINNU,MAXNU
C
C------------------------------------------------------------------------------
C    
      ANU = ABSC_NU 
      APSI = PSI_LOC
      MINPSI = LOCMINPSI(IPACK)
      MAXPSI = LOCMAXPSI(IPACK)
      MINNU = LOCMINNU(IPACK)
      MAXNU = LOCMAXNU(IPACK)
      DO 40 I = 1, (NABSL(IPACK)*MABSL(IPACK))-1
         P(I+1) = SCPLOC((IPACK-1)*MAXCOEFFS+I)
 40   CONTINUE

      IF (PRESET) THEN
         P(1) = P00(IPACK)
      ELSE
         P(1) = 0.0
         P(1) = LSM_CHEB_2D_VAL(MINPSI,MAXPSI,MINNU,MAXNU,P, 
     +                  NABSL(IPACK)-1,MABSL(IPACK)-1,
     +                   0.0D0, 0.0D0, KERR)
         P(1) = 4.0*(1.0 - P(1))
      END IF

      PG = LSM_CHEB_2D_VAL(MINPSI,MAXPSI,MINNU,MAXNU,P,  
     +                NABSL(IPACK)-1,MABSL(IPACK)-1,
     +                APSI, ANU, KERR)
      IF (KERR.NE.0)THEN
         LSM_ABSFACLOC = 0.0
         IERR = 1
         RETURN
      END IF
      IF (IABSOPT.EQ.1) THEN
         LSM_ABSFACLOC = EXP(ABSCOR_LAMFN*ABSTHICK(IPACK)*PG)
         RETURN
      END IF
      IF (IABSOPT.EQ.2) THEN
         IF (PRESET) THEN
            AKN = AKNORM(IPACK)
         ELSE
            AKN = EXP(ABSTHICK(IPACK)*AMULAMREF)
         END IF
         LSM_ABSFACLOC = (AKN*PG)**(ABSCOR_LAMFN)
      END IF

      RETURN

      END