!+ Subroutine to calculate optical properties of water clouds.
!
! Method:
!       If the optical properties come from an observational
!       distribution a separate subroutine is called. Otherwise
!       appropriate mean quantities in the layer are calculated
!       as the parametrization requires and these values are
!       substituted into the parametrization to give the optical
!       properties.
!
! 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 OPT_PROP_WATER_CLOUD(IERR
     &   , N_PROFILE, N_LAYER, N_CLOUD_TOP
     &   , N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &   , L_RESCALE, L_LAYER, L_CLOUD_LAYER
     &   , I_PARAMETRIZATION_DROP, CLOUD_PARAMETER
     &   , LIQ_WATER_MASS_FRAC, RADIUS_EFFECT
     &   , P, DENSITY
     &   , N_LAYER_DROP_DATA, DROP_PRESSURE, DROP_ABSORPTION
     &   , DROP_SCATTERING, DROP_ASYMMETRY
     &   , K_EXT_TOT_CLOUD, K_EXT_SCAT_CLOUD
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUSION OF HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/cloud_parametrization.pcf'
      INCLUDE 'incl/layer_distrib.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_CLOUD_TOP
!             TOPMOST CLOUDY LAYER
     &   , I_PARAMETRIZATION_DROP
!             TREATMENT OF DROPLETS
     &   , N_LAYER_DROP_DATA
!             NUMBER OF WATER CLOUD DATA LAYERS
     &   , N_CLOUD_PROFILE(NPD_LAYER)
!             NUMBER OF CLOUDY PROFILES
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)
!             PROFILES CONTAINING CLOUDS
      LOGICAL	!, INTENT(IN)
     &     L_LAYER
!             VARIABLES GIVEN IN LAYERS
     &   , L_CLOUD_LAYER
!             CLOUD VARIABLES GIVEN IN LAYERS
     &   , L_RESCALE
!             FLAG FOR DELTA-RESCALING 
      REAL*8	!, INTENT(IN)
     &     CLOUD_PARAMETER(NPD_CLOUD_PARAMETER)
!             CLOUD PARAMETERS
     &   , LIQ_WATER_MASS_FRAC(NPD_PROFILE, 0: NPD_LAYER)
!             LIQUID WATER CONTENT
     &   , RADIUS_EFFECT(NPD_PROFILE, 0: NPD_LAYER)
!             EFFECTIVE RADIUS
      REAL*8	!, INTENT(IN)
     &     P(NPD_PROFILE, 0: NPD_LAYER)
!             PRESSURE
     &   , DENSITY(NPD_PROFILE, 0: NPD_LAYER)
!             DENSITY AT LEVELS
     &   , DROP_PRESSURE(0: NPD_CLOUD_DATA_LAYER)
!             PRESSURE AT CLOUD DATA LEVELS
     &   , DROP_ABSORPTION(0: NPD_CLOUD_DATA_LAYER)
!             CLOUD ABSORPTION
     &   , DROP_SCATTERING(0: NPD_CLOUD_DATA_LAYER)
!             CLOUD SCATTERING
     &   , DROP_ASYMMETRY(0: NPD_CLOUD_DATA_LAYER)
!             CLOUD ASYMMETRY
      REAL*8	!, INTENT(OUT)
     &     K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER)
!             SCATTERING EXTINCTION
     &   , K_EXT_TOT_CLOUD(NPD_PROFILE, NPD_LAYER)
!             TOTAL EXTINCTION
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER)
!             CLOUDY ASYMMETRIES
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER)
!             CLOUDY FORWARD SCATTERING
!
!     LOCAL VARIABLES.
      INTEGER
     &     L
!             LOOP VARIABLE
     &   , LL
!             LOOP VARIABLE
     &   , I
!             LOOP VARIABLE
      REAL*8
     &     ASYMMETRY_PROCESS(NPD_PROFILE)
!             ASYMMETRY FACTOR FOR CURRENT PROC.
     &   , RADIUS_AVE
!             AVERAGE EFFECTIVE RADIUS IN LAYER
     &   , LIQ_MASS_FRAC_AVE
!             AVERAGE LIQUID WATER MASS FRACTION
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OBS_CLOUD_PROP
!
!
!
      IF (I_PARAMETRIZATION_DROP.EQ.IP_SLINGO_SCHRECKER) THEN
!
!        WE CALCULATE AVERAGE PROPERTIES FOR THE LAYER AND PUT THESE
!        INTO THE PARAMETRIZATION, RATHER THAN CALCULATING THE
!        PARAMETRIZATION AT EACH LEVEL: USUALLY THIS IS MORE ACCURATE.
!        IT ALSO FITS MORE NATURALLY WITH CASES WHERE DATA ARE GIVEN
!        IN LAYERS.
!
!
         DO I=N_CLOUD_TOP, N_LAYER
            DO LL=1, N_CLOUD_PROFILE(I)
               L=I_CLOUD_PROFILE(LL, I)
               IF (L_CLOUD_LAYER) THEN
                  LIQ_MASS_FRAC_AVE=LIQ_WATER_MASS_FRAC(L, I)
                  RADIUS_AVE=RADIUS_EFFECT(L, I)
               ELSE
                  LIQ_MASS_FRAC_AVE=LIQ_WATER_MASS_FRAC(L, I)
     &              +WEIGHT_UPPER_CLOUD
     &              *(LIQ_WATER_MASS_FRAC(L, I-1)
     &              -LIQ_WATER_MASS_FRAC(L, I))
                  RADIUS_AVE=RADIUS_EFFECT(L, I)
     &               +WEIGHT_UPPER_CLOUD
     &               *(RADIUS_EFFECT(L, I-1)-RADIUS_EFFECT(L, I))
               ENDIF
               K_EXT_TOT_CLOUD(L, I)
     &            =LIQ_MASS_FRAC_AVE*(CLOUD_PARAMETER(1)
     &            +CLOUD_PARAMETER(2)/RADIUS_AVE)
               K_EXT_SCAT_CLOUD(L, I)=K_EXT_TOT_CLOUD(L, I)
     &            *(1.0D+00-CLOUD_PARAMETER(3)
     &            -CLOUD_PARAMETER(4)*RADIUS_AVE)
               ASYMMETRY_PROCESS(L)=
     &            CLOUD_PARAMETER(5)+CLOUD_PARAMETER(6)
     &            *RADIUS_AVE
               ASYMMETRY_CLOUD(L, I)=
     &            K_EXT_SCAT_CLOUD(L, I)*ASYMMETRY_PROCESS(L)
            ENDDO
            IF (L_RESCALE) THEN
               DO LL=1, N_CLOUD_PROFILE(I)
                  L=I_CLOUD_PROFILE(LL, I)
                  FORWARD_SCATTER_CLOUD(L, I)
     &               =K_EXT_SCAT_CLOUD(L, I)
     &               *ASYMMETRY_PROCESS(L)**2
               ENDDO
            ENDIF
         ENDDO
!
      ELSE IF (I_PARAMETRIZATION_DROP.EQ.IP_ACKERMAN_STEPHENS) THEN
!
         DO I=N_CLOUD_TOP, N_LAYER
            DO LL=1, N_CLOUD_PROFILE(I)
               L=I_CLOUD_PROFILE(LL, I)
               IF (L_CLOUD_LAYER) THEN
                  LIQ_MASS_FRAC_AVE=LIQ_WATER_MASS_FRAC(L, I)
                  RADIUS_AVE=RADIUS_EFFECT(L, I)
               ELSE
                  LIQ_MASS_FRAC_AVE=LIQ_WATER_MASS_FRAC(L, I)
     &              +WEIGHT_UPPER_CLOUD
     &              *(LIQ_WATER_MASS_FRAC(L, I-1)
     &              -LIQ_WATER_MASS_FRAC(L, I))
                  RADIUS_AVE=RADIUS_EFFECT(L, I)
     &               +WEIGHT_UPPER_CLOUD
     &               *(RADIUS_EFFECT(L, I-1)-RADIUS_EFFECT(L, I))
               ENDIF
               K_EXT_TOT_CLOUD(L, I)=LIQ_MASS_FRAC_AVE
     &            *(CLOUD_PARAMETER(1)+CLOUD_PARAMETER(2)
     &            *EXP(CLOUD_PARAMETER(3)*LOG(RADIUS_AVE)))
               K_EXT_SCAT_CLOUD(L, I)=K_EXT_TOT_CLOUD(L, I)
     &            *(1.0D+00-CLOUD_PARAMETER(4)
     &            -CLOUD_PARAMETER(5)*EXP(CLOUD_PARAMETER(6)
     &            *LOG(RADIUS_AVE)))
               ASYMMETRY_PROCESS(L)=
     &            CLOUD_PARAMETER(7)+CLOUD_PARAMETER(8)
     &            *EXP(CLOUD_PARAMETER(9)*LOG(RADIUS_AVE))
               ASYMMETRY_CLOUD(L, I)=
     &            K_EXT_SCAT_CLOUD(L, I)*ASYMMETRY_PROCESS(L)
            ENDDO
            IF (L_RESCALE) THEN
               DO LL=1, N_CLOUD_PROFILE(I)
                  L=I_CLOUD_PROFILE(LL, I)
                  FORWARD_SCATTER_CLOUD(L, I)
     &               =K_EXT_SCAT_CLOUD(L, I)
     &               *ASYMMETRY_PROCESS(L)**2
               ENDDO
            ENDIF
         ENDDO
!
      ELSE IF (I_PARAMETRIZATION_DROP.EQ.IP_DROP_UNPARAMETRIZED) THEN
!
         CALL OBS_CLOUD_PROP(IERR
     &      , N_PROFILE, N_LAYER, N_LAYER_DROP_DATA
     &      , L_RESCALE
     &      , N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &      , P, DENSITY, L_LAYER
     &      , DROP_PRESSURE, DROP_ABSORPTION
     &      , DROP_SCATTERING, DROP_ASYMMETRY
     &      , K_EXT_TOT_CLOUD, K_EXT_SCAT_CLOUD, ASYMMETRY_CLOUD
     &      , FORWARD_SCATTER_CLOUD
     &      )
!
      ELSE
         WRITE(IU_ERR, '(/A)') '*** ERROR: AN INVALID PARAMETRIZATION '
     &      //'OF CLOUD DROPLETS HAS BEEN USED.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!
!
      RETURN
      END
