
C LAST UPDATE:
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     LSM_CALC_PRESETS    **
C*****************************
C
C **** LSM SERVICE ROUTINE ONLY ****
C
      SUBROUTINE LSM_CALC_PRESETS
C
      INCLUDE 'implicit_none.finc'
C
C
C Purpose: Calculate preset values for scaling routine PQ00_GLOB, 
C          P00_LOC, AKNORM, ANORMREF
C
C Author:  Steffi Arzt, John Campbell, July 1997
C
C Arguments:
C
C none
C
C Parameters:
C
C none
C
C====== PARAMETERS:
C
      INCLUDE 'limits.finc'
C
C====== GLOBALS:
C
      INCLUDE 'scp.finc'
      INCLUDE 'scps_counters.finc'
      INCLUDE 'scale_presets.finc'
      INCLUDE 'other_scale.finc'
C
C====== FUNCTION TYPES:
C
      REAL LSM_CHEB_2D_VAL
      REAL LSM_FOUR_VAL
      DOUBLE PRECISION LSM_ANORM
      INTEGER LSM_NORM_RANGE
C
C====== LOCALS:
C
      INTEGER I
      INTEGER IPK
      INTEGER KN
      INTEGER NM
      INTEGER KERR
      DOUBLE PRECISION P(MAXCOEFFS),Q(MAXCOEFFS)
C
C----------------------------------------------------------------------------
C
C====== P(0,0) or Q(0,0) for global absorption correction
C
      IF (IOPTABSG.EQ.1) THEN
         DO 10 I = 1, (NABSG*MABSG)-1
            P(I+1) = SCP(NCSCP(7)+I)
 10      CONTINUE
         P(1) = 0.0
         P(1) = LSM_CHEB_2D_VAL(DBLE(GLOBMINPSI),DBLE(GLOBMAXPSI),
     +                   DBLE(GLOBMINNU),DBLE(GLOBMAXNU),P, 
     +                   NABSG-1,MABSG-1, 0.0D0, 0.0D0, KERR)
         P(1) = 4.0*(1.0 - P(1))
         PQ00_GLOB_STORE = P(1)
      ELSE
         NM = NABSG * MABSG - 1
         DO 20 I = 1, (NABSG*MABSG)-1
            P(I+1) = SCP(NCSCP(7)+I)
            Q(I+1) = SCP(NCSCP(7)+NM+I)
 20      CONTINUE
         P(1) = 0.0
         Q(1) = 0.0
         Q(1) = LSM_FOUR_VAL (P, Q, NABSG-1, MABSG-1, 0.0D0, 0.0D0)
         Q(1) = 1.0 - Q(1)
         PQ00_GLOB_STORE = Q(1)
      END IF
C
C====== P(0,0) for local absorption correction
C
      DO 40 IPK = 1, NPK
         P(1) = 0.0
         DO 30 I = 1, (NABSL(IPK)*MABSL(IPK))-1
            P(I+1) = SCPLOC((IPK-1)*MAXCOEFFS+I)
 30      CONTINUE
         P(1) = LSM_CHEB_2D_VAL(DBLE(LOCMINPSI(IPK)),
     +                  DBLE(LOCMAXPSI(IPK)),
     +                  DBLE(LOCMINNU(IPK)),
     +                  DBLE(LOCMAXNU(IPK)),P, 
     +                  NABSL(IPK)-1,MABSL(IPK)-1,
     +                   0.0D0, 0.0D0, KERR)
         P(1) = 4.0*(1.0 - P(1))
         P00_LOC_STORE(IPK) = P(1)
 40   CONTINUE
C
C====== AKNORM if Normalised absorption surface
C
      DO 50 IPK = 1, NPK
         AKNORM_STORE(IPK) = EXP(ABSTHICK(IPK)*AMULAMREF)
 50   CONTINUE
      KN = LSM_NORM_RANGE (REFNORMLAM)
      ANORMREF_STORE = LSM_ANORM(KN, REFNORMLAM, KERR)
      RETURN
      END
