C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.12704 
C                                                                                  RAD_ALL.12705 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.12706 
C restrictions as set forth in the contract.                                       RAD_ALL.12707 
C                                                                                  RAD_ALL.12708 
C                Meteorological Office                                             RAD_ALL.12709 
C                London Road                                                       RAD_ALL.12710 
C                BRACKNELL                                                         RAD_ALL.12711 
C                Berkshire UK                                                      RAD_ALL.12712 
C                RG12 2SZ                                                          RAD_ALL.12713 
C                                                                                  RAD_ALL.12714 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.12715 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.12716 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.12717 
C Modelling at the above address.                                                  RAD_ALL.12718 
C ******************************COPYRIGHT******************************            RAD_ALL.12719 
C                                                                                  RAD_ALL.12720 
!+ Subroutine to calculate optical properties of water clouds.                     RAD_ALL.12721 
!                                                                                  RAD_ALL.12722 
! Method:                                                                          RAD_ALL.12723 
!       If the optical properties come from an observational                       RAD_ALL.12724 
!       distribution a separate subroutine is called. Otherwise                    RAD_ALL.12725 
!       appropriate mean quantities in the layer are calculated                    RAD_ALL.12726 
!       as the parametrization requires and these values are                       RAD_ALL.12727 
!       substituted into the parametrization to give the optical                   RAD_ALL.12728 
!       properties.                                                                RAD_ALL.12729 
!                                                                                  RAD_ALL.12730 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.12731 
!                                                                                  RAD_ALL.12732 
! History:                                                                         RAD_ALL.12733 
!       Version         Date                    Comment                            RAD_ALL.12734 
!       4.0             27-07-95                Original Code                      RAD_ALL.12735 
!                                               (J. M. Edwards)                    RAD_ALL.12736 
!       4.2             Oct. 96     T3E migration: HF functions                    RAD_ALL.12737 
!                                   replaced by T3E vec_lib function               RAD_ALL.12738 
!                                   rtor_v      (S.J.Swarbrick)                    RAD_ALL.12739 
!                                                                                  RAD_ALL.12740 
! Description of Code:                                                             RAD_ALL.12741 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.12742 
!                                                                                  RAD_ALL.12743 
!- ---------------------------------------------------------------------           RAD_ALL.12744 
      SUBROUTINE OPT_PROP_WATER_CLOUD(IERR                                         RAD_ALL.12745 
     &   , N_PROFILE, N_LAYER, N_CLOUD_TOP                                         RAD_ALL.12746 
     &   , N_CLOUD_PROFILE, I_CLOUD_PROFILE                                        RAD_ALL.12747 
     &   , L_RESCALE, L_LAYER, L_CLOUD_LAYER                                       RAD_ALL.12748 
     &   , I_PARAMETRIZATION_DROP, CLOUD_PARAMETER                                 RAD_ALL.12749 
     &   , LIQ_WATER_MASS_FRAC, RADIUS_EFFECT                                      RAD_ALL.12750 
     &   , K_EXT_TOT_CLOUD, K_EXT_SCAT_CLOUD                                       RAD_ALL.12751 
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                                  RAD_ALL.12752 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.12753 
     &   , NPD_CLOUD_PARAMETER                                                     RAD_ALL.12754 
     &   )                                                                         RAD_ALL.12755 
!                                                                                  RAD_ALL.12756 
!                                                                                  RAD_ALL.12757 
      IMPLICIT NONE                                                                RAD_ALL.12758 
!                                                                                  RAD_ALL.12759 
!                                                                                  RAD_ALL.12760 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.12761 
     &     NPD_PROFILE                                                             RAD_ALL.12762 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.12763 
     &   , NPD_LAYER                                                               RAD_ALL.12764 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.12765 
     &   , NPD_CLOUD_PARAMETER                                                     RAD_ALL.12766 
!             MAXIMUM NUMBER OF CLOUD PARAMETERS                                   RAD_ALL.12767 
!                                                                                  RAD_ALL.12768 
!     INCLUDE COMDECKS                                                             RAD_ALL.12769 
!     ------------------------------------------------------------------           STDIO3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       STDIO3A.3     
!                                                                                  STDIO3A.4     
!     MODULE TO SET UNIT NUMBERS FOR STANDARD I/O.                                 STDIO3A.5     
!                                                                                  STDIO3A.6     
      INTEGER                                                                      STDIO3A.7     
     &     IU_STDIN                                                                STDIO3A.8     
!             UNIT NUMBER FOR STANDARD INPUT                                       STDIO3A.9     
     &   , IU_STDOUT                                                               STDIO3A.10    
!             UNIT NUMBER FOR STANDARD OUTPUT                                      STDIO3A.11    
     *   , IU_ERR                                                                  STDIO3A.12    
!             UNIT NUMBER FOR ERROR MESSAGES                                       STDIO3A.13    
!                                                                                  STDIO3A.14    
      PARAMETER(                                                                   STDIO3A.15    
     &     IU_STDIN=5                                                              STDIO3A.16    
     &   , IU_STDOUT=6                                                             STDIO3A.17    
     *   , IU_ERR=6                                                                STDIO3A.18    
     &   )                                                                         STDIO3A.19    
!                                                                                  STDIO3A.20    
!     ------------------------------------------------------------------           STDIO3A.21    
!     ------------------------------------------------------------------           WCLPRM3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       WCLPRM3A.3     
!                                                                                  WCLPRM3A.4     
!     MODULE TO SET NUMBERS FOR WATER CLOUD SCHEMES.                               WCLPRM3A.5     
!                                                                                  WCLPRM3A.6     
      INTEGER                                                                      WCLPRM3A.7     
     &     NPD_CLOUD_FIT                                                           WCLPRM3A.8     
!             NUMBER OF CLOUD FITTING SCHEMES                                      WCLPRM3A.9     
     &   , IP_SLINGO_SCHRECKER                                                     WCLPRM3A.10    
!             PARAMETRIZATION OF SLINGO-SCHRECKER                                  WCLPRM3A.11    
     &   , IP_ACKERMAN_STEPHENS                                                    WCLPRM3A.12    
!             PARAMETRIZATION OF ACKERMAN & STEPHENS                               WCLPRM3A.13    
     &   , IP_DROP_UNPARAMETRIZED                                                  WCLPRM3A.14    
!             UNPARAMETRIZED DROPLET DATA                                          WCLPRM3A.15    
!                                                                                  WCLPRM3A.16    
      PARAMETER(                                                                   WCLPRM3A.17    
     &     NPD_CLOUD_FIT=3                                                         WCLPRM3A.18    
     &   , IP_SLINGO_SCHRECKER=1                                                   WCLPRM3A.19    
     &   , IP_ACKERMAN_STEPHENS=2                                                  WCLPRM3A.20    
     &   , IP_DROP_UNPARAMETRIZED=3                                                WCLPRM3A.21    
     &   )                                                                         WCLPRM3A.22    
!                                                                                  WCLPRM3A.23    
!     ------------------------------------------------------------------           WCLPRM3A.24    
!     ------------------------------------------------------------------           ERROR3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       ERROR3A.3     
!                                                                                  ERROR3A.4     
!     MODULE TO SET ERROR FLAGS IN THE RADIATION CODE.                             ERROR3A.5     
!                                                                                  ERROR3A.6     
      INTEGER                                                                      ERROR3A.7     
     &     I_NORMAL                                                                ERROR3A.8     
!             ERROR FREE CONDITION                                                 ERROR3A.9     
     &   , I_ERR_FATAL                                                             ERROR3A.10    
!             FATAL ERROR: IMMEDIATE RETURN                                        ERROR3A.11    
     &   , I_ABORT_CALCULATION                                                     ERROR3A.12    
!             CALCULATION ABORTED                                                  ERROR3A.13    
     &   , I_MISSING_DATA                                                          ERROR3A.14    
!             MISSING DATA ERROR: CONDITIONAL                                      ERROR3A.15    
     &   , I_ERR_IO                                                                ERROR3A.16    
!             I/O ERROR                                                            ERROR3A.17    
     &   , I_ERR_RANGE                                                             ERROR3A.18    
!             INTERPOLATION RANGE ERROR                                            ERROR3A.19    
     &   , I_ERR_EXIST                                                             ERROR3A.20    
!             EXISTENCE ERROR                                                      ERROR3A.21    
!                                                                                  ERROR3A.22    
      PARAMETER(                                                                   ERROR3A.23    
     &     I_NORMAL=0                                                              ERROR3A.24    
     &   , I_ERR_FATAL=1                                                           ERROR3A.25    
     &   , I_ABORT_CALCULATION=2                                                   ERROR3A.26    
     &   , I_MISSING_DATA=3                                                        ERROR3A.27    
     &   , I_ERR_IO=4                                                              ERROR3A.28    
     &   , I_ERR_RANGE=5                                                           ERROR3A.29    
     &   , I_ERR_EXIST=6                                                           ERROR3A.30    
     &   )                                                                         ERROR3A.31    
!                                                                                  ERROR3A.32    
!     ------------------------------------------------------------------           ERROR3A.33    
!                                                                                  RAD_ALL.12773 
!     DUMMY VARIABLES.                                                             RAD_ALL.12774 
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.12775 
     &     IERR                                                                    RAD_ALL.12776 
!             ERROR FLAG                                                           RAD_ALL.12777 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.12778 
     &     N_PROFILE                                                               RAD_ALL.12779 
!             NUMBER OF PROFILES                                                   RAD_ALL.12780 
     &   , N_LAYER                                                                 RAD_ALL.12781 
!             NUMBER OF LAYERS                                                     RAD_ALL.12782 
     &   , N_CLOUD_TOP                                                             RAD_ALL.12783 
!             TOPMOST CLOUDY LAYER                                                 RAD_ALL.12784 
     &   , I_PARAMETRIZATION_DROP                                                  RAD_ALL.12785 
!             TREATMENT OF DROPLETS                                                RAD_ALL.12786 
     &   , N_CLOUD_PROFILE(NPD_LAYER)                                              RAD_ALL.12787 
!             NUMBER OF CLOUDY PROFILES                                            RAD_ALL.12788 
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.12789 
!             PROFILES CONTAINING CLOUDS                                           RAD_ALL.12790 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.12791 
     &     L_LAYER                                                                 RAD_ALL.12792 
!             VARIABLES GIVEN IN LAYERS                                            RAD_ALL.12793 
     &   , L_CLOUD_LAYER                                                           RAD_ALL.12794 
!             CLOUD VARIABLES GIVEN IN LAYERS                                      RAD_ALL.12795 
     &   , L_RESCALE                                                               RAD_ALL.12796 
!             FLAG FOR DELTA-RESCALING                                             RAD_ALL.12797 
      REAL      !, INTENT(IN)                                                      RAD_ALL.12798 
     &     CLOUD_PARAMETER(NPD_CLOUD_PARAMETER)                                    RAD_ALL.12799 
!             CLOUD PARAMETERS                                                     RAD_ALL.12800 
     &   , LIQ_WATER_MASS_FRAC(NPD_PROFILE, 0: NPD_LAYER)                          RAD_ALL.12801 
!             LIQUID WATER CONTENT                                                 RAD_ALL.12802 
     &   , RADIUS_EFFECT(NPD_PROFILE, 0: NPD_LAYER)                                RAD_ALL.12803 
!             EFFECTIVE RADIUS                                                     RAD_ALL.12804 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.12805 
     &     K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER)                                RAD_ALL.12806 
!             SCATTERING EXTINCTION                                                RAD_ALL.12807 
     &   , K_EXT_TOT_CLOUD(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.12808 
!             TOTAL EXTINCTION                                                     RAD_ALL.12809 
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.12810 
!             CLOUDY ASYMMETRIES                                                   RAD_ALL.12811 
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER)                           RAD_ALL.12812 
!             CLOUDY FORWARD SCATTERING                                            RAD_ALL.12813 
!                                                                                  RAD_ALL.12814 
!     LOCAL VARIABLES.                                                             RAD_ALL.12815 
      INTEGER                                                                      RAD_ALL.12816 
     &     L                                                                       RAD_ALL.12817 
!             LOOP VARIABLE                                                        RAD_ALL.12818 
     &   , LL                                                                      RAD_ALL.12819 
!             LOOP VARIABLE                                                        RAD_ALL.12820 
     &   , I                                                                       RAD_ALL.12821 
!             LOOP VARIABLE                                                        RAD_ALL.12822 
     &   , j !loop variable                                                        RAD_ALL.12823 
      REAL                                                                         RAD_ALL.12824 
     &     ASYMMETRY_PROCESS(NPD_PROFILE)                                          RAD_ALL.12825 
!             ASYMMETRY FACTOR FOR CURRENT PROC.                                   RAD_ALL.12826 
     &   , RADIUS_AVE(3)                                                           RAD_ALL.12827 
!             AVERAGE EFFECTIVE RADIUS IN LAYER                                    RAD_ALL.12828 
     &   , LIQ_MASS_FRAC_AVE                                                       RAD_ALL.12829 
!             AVERAGE LIQUID WATER MASS FRACTION                                   RAD_ALL.12830 
     &   , cp(3),cpp(3)                                                            RAD_ALL.12831 
!             workspace array                                                      RAD_ALL.12832 
!     HALF-PRECISION FUNCTIONS FOR THE UNIFIED MODEL.                              RAD_ALL.12833 
!                                                                                  RAD_ALL.12834 
!                                                                                  RAD_ALL.12835 
!                                                                                  RAD_ALL.12836 
!                                                                                  RAD_ALL.12837 
      IF (I_PARAMETRIZATION_DROP.EQ.IP_SLINGO_SCHRECKER) THEN                      RAD_ALL.12838 
!                                                                                  RAD_ALL.12839 
!        WE CALCULATE AVERAGE PROPERTIES FOR THE LAYER AND PUT THESE               RAD_ALL.12840 
!        INTO THE PARAMETRIZATION, RATHER THAN CALCULATING THE                     RAD_ALL.12841 
!        PARAMETRIZATION AT EACH LEVEL: USUALLY THIS IS MORE ACCURATE.             RAD_ALL.12842 
!        IT ALSO FITS MORE NATURALLY WITH CASES WHERE DATA ARE GIVEN               RAD_ALL.12843 
!        IN LAYERS.                                                                RAD_ALL.12844 
!                                                                                  RAD_ALL.12845 
!                                                                                  RAD_ALL.12846 
         DO I=N_CLOUD_TOP, N_LAYER                                                 RAD_ALL.12847 
            DO LL=1, N_CLOUD_PROFILE(I)                                            RAD_ALL.12848 
               L=I_CLOUD_PROFILE(LL, I)                                            RAD_ALL.12849 
               LIQ_MASS_FRAC_AVE=LIQ_WATER_MASS_FRAC(L, I)                         RAD_ALL.12850 
               RADIUS_AVE(1)=RADIUS_EFFECT(L, I)                                   RAD_ALL.12851 
               K_EXT_TOT_CLOUD(L, I)                                               RAD_ALL.12852 
     &            =LIQ_MASS_FRAC_AVE*(CLOUD_PARAMETER(1)                           RAD_ALL.12853 
     &            +CLOUD_PARAMETER(2)/RADIUS_AVE(1))                               RAD_ALL.12854 
               K_EXT_SCAT_CLOUD(L, I)=K_EXT_TOT_CLOUD(L, I)                        RAD_ALL.12855 
     &            *(1.0E+00-CLOUD_PARAMETER(3)                                     RAD_ALL.12856 
     &            -CLOUD_PARAMETER(4)*RADIUS_AVE(1))                               RAD_ALL.12857 
               ASYMMETRY_PROCESS(L)=                                               RAD_ALL.12858 
     &            CLOUD_PARAMETER(5)+CLOUD_PARAMETER(6)                            RAD_ALL.12859 
     &            *RADIUS_AVE(1)                                                   RAD_ALL.12860 
               ASYMMETRY_CLOUD(L, I)=                                              RAD_ALL.12861 
     &            K_EXT_SCAT_CLOUD(L, I)*ASYMMETRY_PROCESS(L)                      RAD_ALL.12862 
            ENDDO                                                                  RAD_ALL.12863 
            IF (L_RESCALE) THEN                                                    RAD_ALL.12864 
               DO LL=1, N_CLOUD_PROFILE(I)                                         RAD_ALL.12865 
                  L=I_CLOUD_PROFILE(LL, I)                                         RAD_ALL.12866 
                  FORWARD_SCATTER_CLOUD(L, I)                                      RAD_ALL.12867 
     &               =K_EXT_SCAT_CLOUD(L, I)                                       RAD_ALL.12868 
     &               *ASYMMETRY_PROCESS(L)**2                                      RAD_ALL.12869 
               ENDDO                                                               RAD_ALL.12870 
            ENDIF                                                                  RAD_ALL.12871 
         ENDDO                                                                     RAD_ALL.12872 
!                                                                                  RAD_ALL.12873 
      ELSE IF (I_PARAMETRIZATION_DROP.EQ.IP_ACKERMAN_STEPHENS) THEN                RAD_ALL.12874 
!                                                                                  RAD_ALL.12875 
!     Set up CP array for use in rtor_v function                                   RAD_ALL.12876 
         CP(1)=CLOUD_PARAMETER(3)                                                  RAD_ALL.12877 
         CP(2)=CLOUD_PARAMETER(6)                                                  RAD_ALL.12878 
         CP(3)=CLOUD_PARAMETER(9)                                                  RAD_ALL.12879 
!                                                                                  RAD_ALL.12880 
         DO I=N_CLOUD_TOP, N_LAYER                                                 RAD_ALL.12881 
            DO LL=1, N_CLOUD_PROFILE(I)                                            RAD_ALL.12882 
               L=I_CLOUD_PROFILE(LL, I)                                            RAD_ALL.12883 
               LIQ_MASS_FRAC_AVE=LIQ_WATER_MASS_FRAC(L, I)                         RAD_ALL.12884 
               RADIUS_AVE(1)=RADIUS_EFFECT(L, I)                                   RAD_ALL.12885 
               RADIUS_AVE(2)=RADIUS_EFFECT(L, I)                                   RAD_ALL.12886 
               RADIUS_AVE(3)=RADIUS_EFFECT(L, I)                                   RAD_ALL.12887 
               do j=1,3                                                            RAD_ALL.12891 
                 cpp(j)=radius_ave(j)**cp(j)                                       RAD_ALL.12892 
               end do                                                              RAD_ALL.12893 
               K_EXT_TOT_CLOUD(L, I)=LIQ_MASS_FRAC_AVE                             RAD_ALL.12895 
     &            *( CLOUD_PARAMETER(1)+CLOUD_PARAMETER(2)                         RAD_ALL.12896 
     &            *  CPP(1) )                                                      RAD_ALL.12897 
               K_EXT_SCAT_CLOUD(L, I)=K_EXT_TOT_CLOUD(L, I)                        RAD_ALL.12898 
     &            *(1.0E+00-CLOUD_PARAMETER(4)-CLOUD_PARAMETER(5)                  RAD_ALL.12899 
     &            *  CPP(2) )                                                      RAD_ALL.12900 
               ASYMMETRY_PROCESS(L)=                                               RAD_ALL.12901 
     &            CLOUD_PARAMETER(7)+CLOUD_PARAMETER(8)                            RAD_ALL.12902 
     &            *  CPP(3)                                                        RAD_ALL.12903 
               ASYMMETRY_CLOUD(L, I)=                                              RAD_ALL.12904 
     &            K_EXT_SCAT_CLOUD(L, I)*ASYMMETRY_PROCESS(L)                      RAD_ALL.12905 
            ENDDO                                                                  RAD_ALL.12906 
            IF (L_RESCALE) THEN                                                    RAD_ALL.12907 
               DO LL=1, N_CLOUD_PROFILE(I)                                         RAD_ALL.12908 
                  L=I_CLOUD_PROFILE(LL, I)                                         RAD_ALL.12909 
                  FORWARD_SCATTER_CLOUD(L, I)                                      RAD_ALL.12910 
     &               =K_EXT_SCAT_CLOUD(L, I)                                       RAD_ALL.12911 
     &               *ASYMMETRY_PROCESS(L)**2                                      RAD_ALL.12912 
               ENDDO                                                               RAD_ALL.12913 
            ENDIF                                                                  RAD_ALL.12914 
         ENDDO                                                                     RAD_ALL.12915 
!                                                                                  RAD_ALL.12916 
      ELSE                                                                         RAD_ALL.12917 
         WRITE(IU_ERR, '(/A)') '*** ERROR: AN INVALID PARAMETRIZATION '            RAD_ALL.12918 
     &      //'OF CLOUD DROPLETS HAS BEEN USED.'                                   RAD_ALL.12919 
         IERR=I_ERR_FATAL                                                          RAD_ALL.12920 
         RETURN                                                                    RAD_ALL.12921 
      ENDIF                                                                        RAD_ALL.12922 
!                                                                                  RAD_ALL.12923 
!                                                                                  RAD_ALL.12924 
      RETURN                                                                       RAD_ALL.12925 
      END       
