!+ Subroutine to set observational optical properties of aerosols.
!
! Method:
!	Splined fits to the given data at the corresponding pressure 
!	levels are carried out. Optical properties at the required
!	pressure levels are calculated from the splined fits.
!
! 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 OBS_AEROSOL_PROP(IERR
     &   , N_PROFILE, N_LAYER, N_AEROSOL_DATA_LAYER
     &   , L_RESCALE
     &   , P, DENSITY, L_LAYER
     &   , OBS_AEROSOL_PRESSURE, OBS_AEROSOL_ABSORPTION
     &   , OBS_AEROSOL_SCATTERING, OBS_AEROSOL_ASYMMETRY
     &   , K_EXT_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &   , FORWARD_SCATTER_FREE
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUSION OF HEADER FILES.
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY VARIABLES.
      INTEGER   !, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER   !, INTENT(IN)
     &     N_PROFILE
!             NUMBER OF PROFILES
     &   , N_LAYER
!             NUMBER OF LAYERS
     &   , N_AEROSOL_DATA_LAYER
!             NUMBER OF AEROSOL DATA LAYERS
      LOGICAL   !, INTENT(IN)
     &     L_LAYER
!             VARIABLES GIVEN IN LAYERS
     &   , L_RESCALE
!             DELTA_RESCALING REQUIRED
      REAL*8  !, INTENT(IN)
     &     OBS_AEROSOL_PRESSURE(0: NPD_AEROSOL_DATA_LAYER)
!             PRESSURE AT CLOUD DATA LEVELS
     &   , OBS_AEROSOL_ABSORPTION(0: NPD_AEROSOL_DATA_LAYER)
!             AEROSOL ABSORPTION
     &   , OBS_AEROSOL_SCATTERING(0: NPD_AEROSOL_DATA_LAYER)
!             AEROSOL SCATTERING
     &   , OBS_AEROSOL_ASYMMETRY(0: NPD_AEROSOL_DATA_LAYER)
!             AEROSOL ASYMMETRY
     &   , P(NPD_PROFILE, 0: NPD_LAYER)
!             PRESSURE FIELD
     &   , DENSITY(NPD_PROFILE, 0: NPD_LAYER)
!             DENSITY AT LEVELS
      REAL*8  !, INTENT(INOUT)
     &     K_EXT_TOT_FREE(NPD_PROFILE, NPD_LAYER)
!             TOTAL EXTINCTION
     &   , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER)
!             SCATTERING EXTINCTION
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)
!             FREE ASYMMETRIES
     &   , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER)
!             FREE FORWARD SCATTERING
!
!     LOCAL VARIABLES.
      INTEGER
     &     L
!             LOOP VARIABLE
     &   , I
!             LOOP VARIABLE
     &   , N_AEROSOL_DATA_LEVEL
!             NUMBER OF LEVELS OF AEROSOL DATA
      REAL*8
     &     K_SCATTER
!             SCATTERING VARIABLE
     &   , K_ABSORB
!             ABSORPTION VARIABLE
     &   , P_AVE
!             AVERAGE PRESSURE
     &   , AEROSOL_LAYER_ASYMMETRY
!             ASYMMETRY BY AEROSOL LAYERS
     &   , WORK(0: NPD_AEROSOL_DATA_LAYER)
!             WORK ARRAY
     &   , SECOND_DERIVATIVE_ABS(0: NPD_AEROSOL_DATA_LAYER)
!             SECOND DERIVATIVES OF AEROSOL TERMS
     &   , SECOND_DERIVATIVE_SCAT(0: NPD_AEROSOL_DATA_LAYER)
!             SECOND DERIVATIVES OF AEROSOL TERMS
     &   , SECOND_DERIVATIVE_ASYM(0: NPD_AEROSOL_DATA_LAYER)
!             SECOND DERIVATIVES OF AEROSOL TERMS
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     SPLINE_FIT, SPLINE_EVALUATE
!
!
!
!     INTERPOLATE THE SINGLE SCATTERING PROPERTIES TO THE PRESSURE
!     LEVELS USING CUBIC SPLINES.
      N_AEROSOL_DATA_LEVEL=N_AEROSOL_DATA_LAYER+1
!
!     THIS ROUTINE IS NOT INTENDED TO RUN IN VECTOR MODE,
!     AND HAS THEREFORE NOT BEEN OPTIMIZED FOR SUCH USE.
!
!     CALCULATE THE SECOND DERIVATIVES FOR THE SPLINE FITS.
!     ABSORPTION:
      CALL SPLINE_FIT(N_AEROSOL_DATA_LEVEL, OBS_AEROSOL_PRESSURE
     &   , OBS_AEROSOL_ABSORPTION, SECOND_DERIVATIVE_ABS, WORK)
!     SCATTERING:
      CALL SPLINE_FIT(N_AEROSOL_DATA_LEVEL, OBS_AEROSOL_PRESSURE
     &   , OBS_AEROSOL_SCATTERING, SECOND_DERIVATIVE_SCAT, WORK)
!     ASYMMETRY:
      CALL SPLINE_FIT(N_AEROSOL_DATA_LEVEL, OBS_AEROSOL_PRESSURE
     &   , OBS_AEROSOL_ASYMMETRY, SECOND_DERIVATIVE_ASYM, WORK)
!
      DO I=1, N_LAYER
         DO L=1, N_PROFILE
            IF (L_LAYER) THEN
               P_AVE=P(L, I)
            ELSE
               P_AVE=0.5D+00*(P(L, I-1)+P(L, I))
            ENDIF
!
!           ABSORPTION:
            CALL SPLINE_EVALUATE(IERR, N_AEROSOL_DATA_LEVEL
     &         , OBS_AEROSOL_PRESSURE, OBS_AEROSOL_ABSORPTION
     &         , SECOND_DERIVATIVE_ABS, P_AVE
     &         , K_ABSORB
     &         )
            IF (IERR.NE.I_NORMAL) THEN
               IF (IERR.EQ.I_ERR_RANGE) THEN
                  K_ABSORB=0.0D+00
!                 RECOVER FROM THIS ERROR.
                  IERR=I_NORMAL
               ELSE
                  RETURN
               ENDIF
            ENDIF
!
!           SCATTERING:
            CALL SPLINE_EVALUATE(IERR, N_AEROSOL_DATA_LEVEL
     &         , OBS_AEROSOL_PRESSURE, OBS_AEROSOL_SCATTERING
     &         , SECOND_DERIVATIVE_SCAT, P_AVE
     &         , K_SCATTER
     &         )
            IF (IERR.NE.I_NORMAL) THEN
               IF (IERR.EQ.I_ERR_RANGE) THEN
                  K_SCATTER=0.0D+00
!                 RECOVER FROM THIS ERROR.
                  IERR=I_NORMAL
               ELSE
                  RETURN
               ENDIF
            ENDIF
!
!           ASYMMETRY:
            CALL SPLINE_EVALUATE(IERR, N_AEROSOL_DATA_LEVEL
     &         , OBS_AEROSOL_PRESSURE, OBS_AEROSOL_ASYMMETRY
     &         , SECOND_DERIVATIVE_ASYM, P_AVE
     &         , AEROSOL_LAYER_ASYMMETRY
     &         )
            IF (IERR.NE.I_NORMAL) THEN
               IF (IERR.EQ.I_ERR_RANGE) THEN
                  AEROSOL_LAYER_ASYMMETRY=0.0D+00
!                 RECOVER FROM THIS ERROR.
                  IERR=I_NORMAL
               ELSE
                  RETURN
               ENDIF
            ENDIF
!
!           SCALE OUT THE DENSITY: THIS IS DONE SO THAT ON LATER
!           MULTIPLICATION BY THE MASS IN THE LAYER WE OBTAIN THE
!           OPTICAL THICKNESS.
            IF (L_LAYER) THEN
               K_ABSORB=K_ABSORB/DENSITY(L, I)
               K_SCATTER=K_SCATTER/DENSITY(L, I)
            ELSE
               K_ABSORB=K_ABSORB
     &            /(0.5D+00*(DENSITY(L, I-1)+DENSITY(L, I)))
               K_SCATTER=K_SCATTER
     &            /(0.5D+00*(DENSITY(L, I-1)+DENSITY(L, I)))
            ENDIF
            K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I)
     &         +K_ABSORB+K_SCATTER
            K_EXT_SCAT_FREE(L, I)=K_EXT_SCAT_FREE(L, I)
     &         +K_SCATTER
            ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I)
     &         +AEROSOL_LAYER_ASYMMETRY*K_SCATTER
            IF (L_RESCALE) THEN
               FORWARD_SCATTER_FREE(L, I)
     &            =FORWARD_SCATTER_FREE(L, I)
     &            +K_SCATTER*AEROSOL_LAYER_ASYMMETRY**2
            ENDIF
         ENDDO
      ENDDO
!
!
!
      RETURN
      END
