C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.844   
C                                                                                  RAD_ALL.845   
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.846   
C restrictions as set forth in the contract.                                       RAD_ALL.847   
C                                                                                  RAD_ALL.848   
C                Meteorological Office                                             RAD_ALL.849   
C                London Road                                                       RAD_ALL.850   
C                BRACKNELL                                                         RAD_ALL.851   
C                Berkshire UK                                                      RAD_ALL.852   
C                RG12 2SZ                                                          RAD_ALL.853   
C                                                                                  RAD_ALL.854   
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.855   
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.856   
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.857   
C Modelling at the above address.                                                  RAD_ALL.858   
C ******************************COPYRIGHT******************************            RAD_ALL.859   
C                                                                                  RAD_ALL.860   
!+ Subroutine to calculate densities.                                              RAD_ALL.861   
!                                                                                  RAD_ALL.862   
! Method:                                                                          RAD_ALL.863   
!       This routine calculates the density of air and the molar                   RAD_ALL.864   
!       densities of the broadening species for the self and foreign-              RAD_ALL.865   
!       broadened continua using the gas law including the effect                  RAD_ALL.866   
!       of water vapour.                                                           RAD_ALL.867   
!                                                                                  RAD_ALL.868   
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.869   
!                                                                                  RAD_ALL.870   
! History:                                                                         RAD_ALL.871   
!       Version         Date                    Comment                            RAD_ALL.872   
!       4.0             27-07-95                Original Code                      RAD_ALL.873   
!                                               (J. M. Edwards)                    RAD_ALL.874   
!                                                                                  RAD_ALL.875   
! Description of Code:                                                             RAD_ALL.876   
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.877   
!                                                                                  RAD_ALL.878   
!- ---------------------------------------------------------------------           RAD_ALL.879   
      SUBROUTINE CALCULATE_DENSITY(N_PROFILE, N_LAYER, L_CONTINUUM                 RAD_ALL.880   
     &   , WATER_FRAC, P, T, I_TOP                                                 RAD_ALL.881   
     &   , DENSITY, MOLAR_DENSITY_WATER, MOLAR_DENSITY_FRN                         RAD_ALL.882   
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.883   
     &   )                                                                         RAD_ALL.884   
!                                                                                  RAD_ALL.885   
!                                                                                  RAD_ALL.886   
      IMPLICIT NONE                                                                RAD_ALL.887   
!                                                                                  RAD_ALL.888   
!                                                                                  RAD_ALL.889   
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.890   
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.891   
     &     NPD_PROFILE                                                             RAD_ALL.892   
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.893   
     &   , NPD_LAYER                                                               RAD_ALL.894   
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.895   
!                                                                                  RAD_ALL.896   
!     INCLUDE COMDECKS                                                             RAD_ALL.897   
C*L------------------COMDECK C_R_CP-------------------------------------           C_R_CP.2     
C R IS GAS CONSTANT FOR DRY AIR                                                    C_R_CP.3     
C CP IS SPECIFIC HEAT OF DRY AIR AT CONSTANT PRESSURE                              C_R_CP.4     
C PREF IS REFERENCE SURFACE PRESSURE                                               C_R_CP.5     
      REAL R,CP,KAPPA,PREF  ! PREFTOKI                                             C_R_CP.6     
                                                                                   C_R_CP.7     
      PARAMETER(R=287.05,                                                          C_R_CP.8     
     &          CP=1005.,                                                          C_R_CP.9     
     &          KAPPA=R/CP,                                                        C_R_CP.10    
     &          PREF=100000.)                                                      C_R_CP.11    
C*----------------------------------------------------------------------           C_R_CP.12    
                                                                                   C_R_CP.13    
C*L------------------COMDECK C_EPSLON-----------------------------------           C_EPSLON.2     
C EPSILON IS RATIO OF MOLECULAR WEIGHTS OF WATER AND DRY AIR                       C_EPSLON.3     
      REAL EPSILON,C_VIRTUAL                                                       C_EPSLON.4     
                                                                                   C_EPSLON.5     
      PARAMETER(EPSILON=0.62198,                                                   C_EPSLON.6     
     &          C_VIRTUAL=1./EPSILON-1.)                                           C_EPSLON.7     
C*----------------------------------------------------------------------           C_EPSLON.8     
                                                                                   C_EPSLON.9     
!     ------------------------------------------------------------------           PHYCN03A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       PHYCN03A.3     
!                                                                                  PHYCN03A.4     
!     MODULE SETTING PHYSICAL CONSTANTS.                                           PHYCN03A.5     
!                                                                                  PHYCN03A.6     
      REAL                                                                         PHYCN03A.7     
     &     MOL_WEIGHT_AIR                                                          PHYCN03A.8     
!             MOLAR WEIGHT OF DRY AIR                                              PHYCN03A.9     
     &   , N2_MASS_FRAC                                                            PHYCN03A.10    
!             MASS FRACTION OF NITROGEN                                            PHYCN03A.11    
!                                                                                  PHYCN03A.12    
      PARAMETER(                                                                   PHYCN03A.13    
     &     MOL_WEIGHT_AIR=28.966E-3                                                PHYCN03A.14    
     &   , N2_MASS_FRAC=0.781E+00                                                  PHYCN03A.15    
     &   )                                                                         PHYCN03A.16    
!                                                                                  PHYCN03A.17    
!     ------------------------------------------------------------------           PHYCN03A.18    
!                                                                                  RAD_ALL.901   
!     DUMMY ARGUMENTS.                                                             RAD_ALL.902   
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.903   
     &     N_PROFILE                                                               RAD_ALL.904   
!             NUMBER OF PROFILES                                                   RAD_ALL.905   
     &   , N_LAYER                                                                 RAD_ALL.906   
!             NUMBER OF LAYERS                                                     RAD_ALL.907   
     &   , I_TOP                                                                   RAD_ALL.908   
!             TOP VERTICAL INDEX                                                   RAD_ALL.909   
      LOGICAL                                                                      RAD_ALL.910   
     &     L_CONTINUUM                                                             RAD_ALL.911   
!             CONTINUUM FLAG                                                       RAD_ALL.912   
      REAL      !, INTENT(IN)                                                      RAD_ALL.913   
     &     WATER_FRAC(NPD_PROFILE, 0: NPD_LAYER)                                   RAD_ALL.914   
!             MASS FRACTION OF WATER                                               RAD_ALL.915   
     &   , P(NPD_PROFILE, 0: NPD_LAYER)                                            RAD_ALL.916   
!             PRESSURE                                                             RAD_ALL.917   
     &   , T(NPD_PROFILE, 0: NPD_LAYER)                                            RAD_ALL.918   
!             TEMPERATURE                                                          RAD_ALL.919   
      REAL      !, INTENT(OUT)                                                     RAD_ALL.920   
     &     DENSITY(NPD_PROFILE, 0: NPD_LAYER)                                      RAD_ALL.921   
!             AIR DENSITY                                                          RAD_ALL.922   
     &   , MOLAR_DENSITY_WATER(NPD_PROFILE, 0: NPD_LAYER)                          RAD_ALL.923   
!             MOLAR DENSITY OF WATER                                               RAD_ALL.924   
     &   , MOLAR_DENSITY_FRN(NPD_PROFILE, 0: NPD_LAYER)                            RAD_ALL.925   
!             MOLAR DENSITY OF FOREIGN SPECIES                                     RAD_ALL.926   
!                                                                                  RAD_ALL.927   
!     LOCAL VARIABLES.                                                             RAD_ALL.928   
      INTEGER                                                                      RAD_ALL.929   
     &     L                                                                       RAD_ALL.930   
!             LOOP VARIABLE                                                        RAD_ALL.931   
     &   , I                                                                       RAD_ALL.932   
!             LOOP VARIABLE                                                        RAD_ALL.933   
!                                                                                  RAD_ALL.934   
!                                                                                  RAD_ALL.935   
!     FIND THE AIR DENSITY FIRST.                                                  RAD_ALL.936   
      DO I=I_TOP, N_LAYER                                                          RAD_ALL.937   
         DO L=1, N_PROFILE                                                         RAD_ALL.938   
            DENSITY(L, I)=P(L, I)/(R*T(L, I)                                       RAD_ALL.939   
     &         *(1.0E+00+C_VIRTUAL*WATER_FRAC(L, I)))                              RAD_ALL.940   
         ENDDO                                                                     RAD_ALL.941   
      ENDDO                                                                        RAD_ALL.942   
!                                                                                  RAD_ALL.943   
      IF (L_CONTINUUM) THEN                                                        RAD_ALL.944   
         DO I=I_TOP, N_LAYER                                                       RAD_ALL.945   
            DO L=1, N_PROFILE                                                      RAD_ALL.946   
               MOLAR_DENSITY_FRN(L, I)=DENSITY(L, I)                               RAD_ALL.947   
     &            *(1.0E+00-WATER_FRAC(L, I))/MOL_WEIGHT_AIR                       RAD_ALL.948   
               MOLAR_DENSITY_WATER(L, I)=DENSITY(L, I)                             RAD_ALL.949   
     &            *WATER_FRAC(L, I)/(EPSILON*MOL_WEIGHT_AIR)                       RAD_ALL.950   
            ENDDO                                                                  RAD_ALL.951   
         ENDDO                                                                     RAD_ALL.952   
      ENDIF                                                                        RAD_ALL.953   
!                                                                                  RAD_ALL.954   
!                                                                                  RAD_ALL.955   
      RETURN                                                                       RAD_ALL.956   
      END     
