*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.9
*IF DEF,A01_3A,OR,DEF,A02_3A CADEN3A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13127
C GTS2F400.13128
C Use, duplication or disclosure of this code is subject to the GTS2F400.13129
C restrictions as set forth in the contract. GTS2F400.13130
C GTS2F400.13131
C Meteorological Office GTS2F400.13132
C London Road GTS2F400.13133
C BRACKNELL GTS2F400.13134
C Berkshire UK GTS2F400.13135
C RG12 2SZ GTS2F400.13136
C GTS2F400.13137
C If no contract has been raised with this copy of the code, the use, GTS2F400.13138
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13139
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13140
C Modelling at the above address. GTS2F400.13141
C ******************************COPYRIGHT****************************** GTS2F400.13142
C GTS2F400.13143
!+ Subroutine to calculate densities. CADEN3A.3
! CADEN3A.4
! Method: CADEN3A.5
! This routine calculates the density of air and the molar CADEN3A.6
! densities of the broadening species for the self and foreign- CADEN3A.7
! broadened continua using the gas law including the effect CADEN3A.8
! of water vapour. CADEN3A.9
! CADEN3A.10
! Current Owner of Code: J. M. Edwards CADEN3A.11
! CADEN3A.12
! History: CADEN3A.13
! Version Date Comment CADEN3A.14
! 4.0 27-07-95 Original Code CADEN3A.15
! (J. M. Edwards) CADEN3A.16
! CADEN3A.17
! Description of Code: CADEN3A.18
! FORTRAN 77 with extensions listed in documentation. CADEN3A.19
! CADEN3A.20
!- --------------------------------------------------------------------- CADEN3A.21
SUBROUTINE CALCULATE_DENSITY(N_PROFILE, N_LAYER, L_CONTINUUM 1CADEN3A.22
& , WATER_FRAC, P, T, I_TOP CADEN3A.23
& , DENSITY, MOLAR_DENSITY_WATER, MOLAR_DENSITY_FRN CADEN3A.24
& , NPD_PROFILE, NPD_LAYER CADEN3A.25
& ) CADEN3A.26
! CADEN3A.27
! CADEN3A.28
IMPLICIT NONE CADEN3A.29
! CADEN3A.30
! CADEN3A.31
! SIZES OF DUMMY ARRAYS. CADEN3A.32
INTEGER !, INTENT(IN) CADEN3A.33
& NPD_PROFILE CADEN3A.34
! MAXIMUM NUMBER OF PROFILES CADEN3A.35
& , NPD_LAYER CADEN3A.36
! MAXIMUM NUMBER OF LAYERS CADEN3A.37
! CADEN3A.38
! INCLUDE COMDECKS CADEN3A.39
*CALL C_R_CP 
CADEN3A.40
*CALL C_EPSLON CADEN3A.41
*CALL PHYCN03A CADEN3A.42
! CADEN3A.43
! DUMMY ARGUMENTS. CADEN3A.44
INTEGER !, INTENT(IN) CADEN3A.45
& N_PROFILE CADEN3A.46
! NUMBER OF PROFILES CADEN3A.47
& , N_LAYER CADEN3A.48
! NUMBER OF LAYERS CADEN3A.49
& , I_TOP CADEN3A.50
! TOP VERTICAL INDEX CADEN3A.51
LOGICAL CADEN3A.52
& L_CONTINUUM CADEN3A.53
! CONTINUUM FLAG CADEN3A.54
REAL !, INTENT(IN) CADEN3A.55
& WATER_FRAC(NPD_PROFILE, 0: NPD_LAYER) CADEN3A.56
! MASS FRACTION OF WATER CADEN3A.57
& , P(NPD_PROFILE, 0: NPD_LAYER) CADEN3A.58
! PRESSURE CADEN3A.59
& , T(NPD_PROFILE, 0: NPD_LAYER) CADEN3A.60
! TEMPERATURE CADEN3A.61
REAL !, INTENT(OUT) CADEN3A.62
& DENSITY(NPD_PROFILE, 0: NPD_LAYER) CADEN3A.63
! AIR DENSITY CADEN3A.64
& , MOLAR_DENSITY_WATER(NPD_PROFILE, 0: NPD_LAYER) CADEN3A.65
! MOLAR DENSITY OF WATER CADEN3A.66
& , MOLAR_DENSITY_FRN(NPD_PROFILE, 0: NPD_LAYER) CADEN3A.67
! MOLAR DENSITY OF FOREIGN SPECIES CADEN3A.68
! CADEN3A.69
! LOCAL VARIABLES. CADEN3A.70
INTEGER CADEN3A.71
& L CADEN3A.72
! LOOP VARIABLE CADEN3A.73
& , I CADEN3A.74
! LOOP VARIABLE CADEN3A.75
! CADEN3A.76
! CADEN3A.77
! FIND THE AIR DENSITY FIRST. CADEN3A.78
DO I=I_TOP, N_LAYER CADEN3A.79
DO L=1, N_PROFILE CADEN3A.80
DENSITY(L, I)=P(L, I)/(R*T(L, I) CADEN3A.81
& *(1.0E+00+C_VIRTUAL*WATER_FRAC(L, I))) CADEN3A.82
ENDDO CADEN3A.83
ENDDO CADEN3A.84
! CADEN3A.85
IF (L_CONTINUUM) THEN CADEN3A.86
DO I=I_TOP, N_LAYER CADEN3A.87
DO L=1, N_PROFILE CADEN3A.88
MOLAR_DENSITY_FRN(L, I)=DENSITY(L, I) CADEN3A.89
& *(1.0E+00-WATER_FRAC(L, I))/MOL_WEIGHT_AIR CADEN3A.90
MOLAR_DENSITY_WATER(L, I)=DENSITY(L, I) CADEN3A.91
& *WATER_FRAC(L, I)/(EPSILON*MOL_WEIGHT_AIR) CADEN3A.92
ENDDO CADEN3A.93
ENDDO CADEN3A.94
ENDIF CADEN3A.95
! CADEN3A.96
! CADEN3A.97
RETURN CADEN3A.98
END CADEN3A.99
*ENDIF DEF,A01_3A,OR,DEF,A02_3A CADEN3A.100
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.10