!+ Subroutine to scale amounts of absorbers.
!
! Method:
!	The mixing ratio is multiplied by a factor determined 
!	by the type of scaling selected.
!	
!
! Current Owner of Code: J. M. Edwards
!
! History:
!	Version		Date			Comment
!	1.0		12-04-95		First Version under RCS
!						(J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE SCALE_ABSORB(IERR, N_PROFILE, N_LAYER
     &   , GAS_MIX_RATIO, P, T, L_LAYER, I_TOP
     &   , GAS_FRAC_RESCALED
     &   , I_FNC, P_REFERENCE, T_REFERENCE, SCALE_PARAMETER
     &   , L_DOPPLER, DOPPLER_CORRECTION
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/scale_fnc.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_PROFILE
!             NUMBER OF PROFILES
     &   , N_LAYER
!             NUMBER OF LAYERS
     &   , I_FNC
!             TYPE OF SCALING FUNCTION
     &   , I_TOP
!             UPPERMOST INDEX FOR SCALING (THIS WILL BE 1 FOR FIELDS
!             GIVEN IN LAYERS, AS IN THE UNIFIED MODEL, OR 0 FOR
!             FIELDS GIVEN AT THE BOUNDARIES OF LAYERS)
      LOGICAL	!, INTENT(IN)
     &     L_LAYER
!             DATA SPECIFIED IN LAYERS
     &   , L_DOPPLER
!             FLAG FOR DOPPLER TERM
      REAL*8	!, INTENT(IN)
     &     GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER)
!             MASS MIXING RATIO OF GAS
     &   , P(NPD_PROFILE, 0: NPD_LAYER)
!             PRESSURE
     &   , T(NPD_PROFILE, 0: NPD_LAYER)
!             TEMPERATURE
     &   , P_REFERENCE
!             REFERENCE PRESSURE
     &   , T_REFERENCE
!             REFERENCE TEMPERATURE
     &   , SCALE_PARAMETER(NPD_SCALE_VARIABLE)
!             SCALING PARAMTERS
     &   , DOPPLER_CORRECTION
!             DOPPLER-BROADENING CORRECTION
      REAL*8	!, INTENT(OUT)
     &     GAS_FRAC_RESCALED(NPD_PROFILE, 0: NPD_LAYER)
!             MASS FRACTION OF GAS
!
!     LOCAL VARIABLES.
      INTEGER
     &     L
!             LOOP VARIABLE
     &   , I
!             LOOP VARIABLE
      REAL*8
     &     PRESSURE_OFFSET
!             OFFSET TO PRESSURE
!
!
!
!     SET THE OFFSET TO THE PRESSURE FOR THE DOPPLER CORRECTION.
      IF (L_DOPPLER) THEN
         PRESSURE_OFFSET=DOPPLER_CORRECTION
      ELSE
         PRESSURE_OFFSET=0.0D+00
      ENDIF
!
!     THE ARRAY GAS_FRAC_RESCALED IS USED INITIALLY TO HOLD ONLY THE
!     SCALING FUNCTIONS, AND ONLY LATER IS IT MULTIPLIED BY THE
!     MIXING RATIOS
!
      IF (I_FNC.EQ.IP_SCALE_POWER_LAW) THEN
         DO I=I_TOP, N_LAYER
            DO L=1, N_PROFILE
               GAS_FRAC_RESCALED(L, I)=
     &            EXP(SCALE_PARAMETER(1)*LOG((P(L, I)
     &            +PRESSURE_OFFSET)
     &            /(P_REFERENCE+PRESSURE_OFFSET))
     &            +SCALE_PARAMETER(2)*LOG(T(L, I)/T_REFERENCE))
            ENDDO
         ENDDO
      ELSE IF (I_FNC.EQ.IP_SCALE_FNC_NULL) THEN
         RETURN
      ELSE IF (I_FNC.EQ.IP_SCALE_POWER_QUAD) THEN
         DO I=I_TOP, N_LAYER
            DO L=1, N_PROFILE
               GAS_FRAC_RESCALED(L, I)=
     &            EXP(SCALE_PARAMETER(1)
     &            *LOG((P(L, I)+PRESSURE_OFFSET)
     &            /(P_REFERENCE+PRESSURE_OFFSET)))
     &            *(1.0D+00
     &            +SCALE_PARAMETER(2)*(T(L, I)/T_REFERENCE-1.0D+00)
     &            +SCALE_PARAMETER(3)*(T(L, I)
     &            /T_REFERENCE-1.0D+00)**2)
            ENDDO
         ENDDO
      ELSE IF (I_FNC.EQ.IP_SCALE_DOPPLER_QUAD) THEN
!        THERE IS NO DOPPLER TERM HERE SINCE IT IS IMPLICITLY INCLUDED
!        IN THE SCALING.
         DO I=I_TOP, N_LAYER
            DO L=1, N_PROFILE
               GAS_FRAC_RESCALED(L, I)=
     &            EXP(SCALE_PARAMETER(1)
     &            *LOG((P(L, I)+SCALE_PARAMETER(2))
     &            /(P_REFERENCE+SCALE_PARAMETER(2))))
     &            *(1.0D+00
     &            +SCALE_PARAMETER(3)*(T(L, I)/T_REFERENCE-1.0D+00)
     &            +SCALE_PARAMETER(4)*(T(L, I)/T_REFERENCE-1.0D+00)**2)
            ENDDO
         ENDDO
      ELSE
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: AN ILLEGAL TYPE OF SCALING HAS BEEN GIVEN.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     MULTIPLY BY THE MIXING RATIO AND LIMIT NEGATIVE SCALINGS.
      IF (L_LAYER) THEN
         DO I=N_LAYER, 1, -1
            DO L=1, N_PROFILE
               GAS_FRAC_RESCALED(L, I)=MAX(DBLE(0.0D+00)
     &            , GAS_FRAC_RESCALED(L, I)*GAS_MIX_RATIO(L, I))
            ENDDO
         ENDDO
      ELSE
!        CONVERT TO VALUES IN LAYERS.
         DO I=N_LAYER, 1, -1
            DO L=1, N_PROFILE
               GAS_FRAC_RESCALED(L, I)
     &            =0.5D+00*(GAS_FRAC_RESCALED(L, I-1)
     &            *GAS_MIX_RATIO(L, I-1)
     &            +GAS_FRAC_RESCALED(L, I)*GAS_MIX_RATIO(L, I))
               GAS_FRAC_RESCALED(L, I)
     &            =MAX(DBLE(0.0D+00), GAS_FRAC_RESCALED(L, I))
            ENDDO
         ENDDO
      ENDIF
!
!
      RETURN
      END
