C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     LSM_ABSFACGLOB      **
C*****************************
C
C **** LSM SERVICE ROUTINE ONLY ****
C
      DOUBLE PRECISION FUNCTION LSM_ABSFACGLOB (ABSC_NU, PSI_GLO,
     +                ABSCOR_LAMFN, PRESET,PQ00, AKNORM,IERR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Return the global absorption factor
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
      REAL ABSC_NU,PSI_GLO,ABSCOR_LAMFN
      LOGICAL PRESET
      REAL PQ00
      REAL AKNORM(*)
      INTEGER IERR
C
C Parameters:
C
C  ABSC_NU        (R)   'nu' value (degrees)
C  PSI_GLO        (R)   Global '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  PRESET         (R)   'Pre-calculated PQ00, AKNORM values passed' flag
C  PQ00           (R)   The value of P(0,0) or Q(0,0) 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 (Cheb case only)
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
      REAL LSM_FOUR_VAL
C
C====== LOCALS:
C
      INTEGER NM, I
      INTEGER KERR
      REAL AKN
      DOUBLE PRECISION ANU, APSI     
      DOUBLE PRECISION P(MAXCOEFFS),Q(MAXCOEFFS)
      DOUBLE PRECISION PG
      DOUBLE PRECISION MINPSI,MAXPSI,MINNU,MAXNU
C
C------------------------------------------------------------------------------
C
      IERR = 0    
      ANU = ABSC_NU 
      APSI = PSI_GLO
      MINPSI = GLOBMINPSI
      MAXPSI = GLOBMAXPSI
      MINNU = GLOBMINNU
      MAXNU = GLOBMAXNU


      IF (IOPTABSG.EQ.1) THEN
         DO 60 I = 1, (NABSG*MABSG)-1
            P(I+1) = SCP(NCSCP(7)+I)
 60      CONTINUE
         IF (PRESET) THEN
            P(1) = PQ00
         ELSE
            P(1) = 0.0
            P(1) = LSM_CHEB_2D_VAL(MINPSI,MAXPSI,MINNU,MAXNU,P, 
     +                   NABSG-1,MABSG-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,
     +                NABSG-1,MABSG-1, 
     +                APSI, ANU, KERR)
         IF (KERR.NE.0) THEN
            LSM_ABSFACGLOB = 0.0
            IERR = 1
            RETURN
         END IF
         IF (IABSOPT.EQ.1) THEN
            LSM_ABSFACGLOB = EXP(ABSCOR_LAMFN*ABSTHICK(1)*PG)
            RETURN
         END IF
         IF (IABSOPT.EQ.2) THEN
            IF (PRESET) THEN
               AKN = AKNORM(1)
            ELSE
               AKN = EXP(ABSTHICK(1)*AMULAMREF)
            END IF
            LSM_ABSFACGLOB = (AKN*PG)**(ABSCOR_LAMFN)
         END IF
      ELSE
         NM = NABSG * MABSG - 1
         DO 40 I = 1, (NABSG*MABSG)-1
            P(I+1) = SCP(NCSCP(7)+I)
            Q(I+1) = SCP(NCSCP(7)+NM+I)
 40      CONTINUE
         P(1) = 0.0
         Q(1) = 0.0
         IF (PRESET) THEN
            Q(1) = PQ00
         ELSE
            Q(1) = LSM_FOUR_VAL (P, Q, NABSG-1, MABSG-1, 0.0D0, 0.0D0)
            Q(1) = 1.0 - Q(1)
         END IF
         PG = LSM_FOUR_VAL (P, Q, NABSG-1, MABSG-1, APSI, ANU)
         IF (IABSOPT.EQ.1) THEN
            LSM_ABSFACGLOB = EXP(ABSCOR_LAMFN*ABSTHICK(1)*PG)
            RETURN
         END IF
         IF (IABSOPT.EQ.2) THEN
            IF (PRESET) THEN
               AKN = AKNORM(1)
            ELSE
               AKN = EXP(ABSTHICK(1)*AMULAMREF)
            END IF
            LSM_ABSFACGLOB = (AKN*PG)**(ABSCOR_LAMFN)
         END IF
      END IF
      RETURN
      END