*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.93
*IF DEF,A01_3A,OR,DEF,A02_3A SMAP3A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13892
C GTS2F400.13893
C Use, duplication or disclosure of this code is subject to the GTS2F400.13894
C restrictions as set forth in the contract. GTS2F400.13895
C GTS2F400.13896
C Meteorological Office GTS2F400.13897
C London Road GTS2F400.13898
C BRACKNELL GTS2F400.13899
C Berkshire UK GTS2F400.13900
C RG12 2SZ GTS2F400.13901
C GTS2F400.13902
C If no contract has been raised with this copy of the code, the use, GTS2F400.13903
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13904
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13905
C Modelling at the above address. GTS2F400.13906
C ******************************COPYRIGHT****************************** GTS2F400.13907
C GTS2F400.13908
!+ Subroutine to set moist aerosol properties independent of bands. SMAP3A.3
! SMAP3A.4
! Method: SMAP3A.5
! The mean relative humidities are calculated and pointers to SMAP3A.6
! the lookup tables are set. SMAP3A.7
! SMAP3A.8
! Current Owner of Code: J. M. Edwards SMAP3A.9
! SMAP3A.10
! History: SMAP3A.11
! Version Date Comment SMAP3A.12
! 4.0 27-07-95 Original Code SMAP3A.13
! (J. M. Edwards) SMAP3A.14
! 4.3 17-12-96 Code extended to permit AWO1F403.41
! use with both moist AWO1F403.42
! and dry aerosols. AWO1F403.43
! (J. M. Edwards) AWO1F403.44
! SMAP3A.15
! Description of Code: SMAP3A.16
! FORTRAN 77 with extensions listed in documentation. SMAP3A.17
! SMAP3A.18
!- --------------------------------------------------------------------- SMAP3A.19
SUBROUTINE SET_MOIST_AEROSOL_PROPERTIES(IERR 1,1AWO1F403.45
& , N_PROFILE, N_LAYER AWO1F403.46
& , L_LAYER, N_AEROSOL, I_AEROSOL_PARAMETRIZATION, NHUMIDITY SMAP3A.21
& , WATER_MIX_RATIO, T, P, DELTA_HUMIDITY SMAP3A.22
& , MEAN_REL_HUMIDITY, I_HUMIDITY_POINTER SMAP3A.23
& , NPD_PROFILE, NPD_LAYER, NPD_AEROSOL_SPECIES SMAP3A.24
& ) SMAP3A.25
! SMAP3A.26
! SMAP3A.27
! SMAP3A.28
IMPLICIT NONE SMAP3A.29
! SMAP3A.30
! SMAP3A.31
! SIZES OF DUMMY ARRAYS. SMAP3A.32
INTEGER !, INTENT(IN) SMAP3A.33
& NPD_PROFILE SMAP3A.34
! MAXIMUM NUMBER OF PROFILES SMAP3A.35
& , NPD_LAYER SMAP3A.36
! MAXIMUM NUMBER OF LAYERS SMAP3A.37
& , NPD_AEROSOL_SPECIES SMAP3A.38
! MAXIMUM NUMBER OF AEROSOLS SMAP3A.39
! SMAP3A.40
! INCLUDE COMDECKS. AWO1F403.47
*CALL ERROR3A 
AWO1F403.48
*CALL AERPRM3A AWO1F403.49
*CALL STDIO3A AWO1F403.50
! AWO1F403.51
! DUMMY ARGUMENTS. SMAP3A.41
INTEGER !, INTENT(OUT) AWO1F403.52
& IERR AWO1F403.53
! ERROR FLAG AWO1F403.54
! AWO1F403.55
INTEGER !, INTENT(IN) SMAP3A.42
& N_PROFILE SMAP3A.43
! NUMBER OF PROFILES SMAP3A.44
& , N_LAYER SMAP3A.45
! NUMBER OF LAYERS SMAP3A.46
& , N_AEROSOL SMAP3A.47
! NUMBER OF AEROSOL SPECIES SMAP3A.48
& , I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES) SMAP3A.49
! PARAMETRIZATIONS OF AEROSOL SMAP3A.50
! SPECIES SMAP3A.51
& , NHUMIDITY(NPD_AEROSOL_SPECIES) SMAP3A.52
! NUMBER OF HUMIDITY VALUES SMAP3A.53
INTEGER !, INTENT(OUT) SMAP3A.54
& I_HUMIDITY_POINTER(NPD_PROFILE, NPD_LAYER) SMAP3A.55
! POINTERS TO LOOK-UP TABLES SMAP3A.56
LOGICAL !, INTENT(IN) SMAP3A.57
& L_LAYER SMAP3A.58
! LAYER FLAG SMAP3A.59
REAL !, INTENT(IN) SMAP3A.60
& WATER_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER) SMAP3A.61
! MIXING RATIO OF WATER VAPOUR SMAP3A.62
& , T(NPD_PROFILE, 0: NPD_LAYER) SMAP3A.63
! TEMPERATURES SMAP3A.64
& , P(NPD_PROFILE, 0: NPD_LAYER) SMAP3A.65
! PRESSURES SMAP3A.66
REAL !, INTENT(OUT) SMAP3A.67
& MEAN_REL_HUMIDITY(NPD_PROFILE, NPD_LAYER) SMAP3A.68
! MEAN HUMIDITIES OF LAYERS SMAP3A.69
& , DELTA_HUMIDITY SMAP3A.70
! INCREMENT IN HUMIDITY SMAP3A.71
! SMAP3A.72
! SMAP3A.73
! LOCAL VARIABLES. SMAP3A.74
INTEGER SMAP3A.75
& I SMAP3A.76
! LOOP VARIABLE SMAP3A.77
& , J AWO1F403.56
! LOOP VARIABLE AWO1F403.57
& , L SMAP3A.78
! LOOP VARIABLE SMAP3A.79
& , NHUMIDITY_COMMON AWO1F403.58
! COMMON NUMBER OF HUMIDITIES FOR MOIST AEROSOLS AWO1F403.59
REAL SMAP3A.80
& MIX_RATIO_SAT(NPD_PROFILE, 0: NPD_LAYER) SMAP3A.81
! SATURATED HUMIDITY MIXING RATIO SMAP3A.82
! SMAP3A.83
! SUBROUTINES CALLED: SMAP3A.84
EXTERNAL SMAP3A.85
& QSAT_WAT SMAP3A.86
! SMAP3A.87
! SMAP3A.88
! SMAP3A.89
! SET UP ARRAY OF POINTERS TO INCLUDE THE EFFECTS OF HUMIDITY. SMAP3A.90
! CALCULATE THE SATURATED MIXING RATIO. SMAP3A.91
DO I=1, N_LAYER SMAP3A.92
CALL QSAT_WAT(MIX_RATIO_SAT(1, I), T(1, I), P(1, I) SMAP3A.93
& , N_PROFILE) SMAP3A.94
ENDDO SMAP3A.95
! AWO1F403.60
! DETERMINE THE NUMBER OF HUMIDITIES TO BE USED FOR MOIST AWO1F403.61
! AEROSOLS. THIS MUST BE THE SAME FOR ALL MOIST AEROSOLS AWO1F403.62
! IN THE CURRENT VERSION OF THE CODE. AWO1F403.63
NHUMIDITY_COMMON=0 AWO1F403.64
DO J=1, N_AEROSOL AWO1F403.65
IF (I_AEROSOL_PARAMETRIZATION(J).EQ.IP_AEROSOL_PARAM_MOIST) AWO1F403.66
& THEN AWO1F403.67
IF (NHUMIDITY(J).GT.0) THEN AWO1F403.68
! SET THE ACTUAL COMMON VALUE. AWO1F403.69
IF (NHUMIDITY_COMMON.EQ.0) THEN AWO1F403.70
NHUMIDITY_COMMON=NHUMIDITY(J) AWO1F403.71
ELSE IF (NHUMIDITY(J).NE.NHUMIDITY_COMMON) THEN AWO1F403.72
! THERE IS AN INCONSISTENCY. AWO1F403.73
WRITE(IU_ERR, '(/A)') AWO1F403.74
& '***ERROR: THE LOOK-UP TABLES FOR MOIST AEROSOLS ' AWO1F403.75
& , 'ARE OF DIFFERENT SIZES. THIS IS NOT PERMITTED.' AWO1F403.76
IERR=I_ERR_FATAL AWO1F403.77
RETURN AWO1F403.78
ENDIF AWO1F403.79
ENDIF AWO1F403.80
ENDIF AWO1F403.81
ENDDO AWO1F403.82
! THE LOOK-UP TABLE IS ASSUMED TO BE UNIFORM IN HUMIDITY. SMAP3A.96
DELTA_HUMIDITY=1.0E+00/(REAL(NHUMIDITY_COMMON)-1.0E+00) AWO1F403.83
DO I=1, N_LAYER SMAP3A.98
DO L=1, N_PROFILE SMAP3A.99
MEAN_REL_HUMIDITY(L, I) SMAP3A.100
& =WATER_MIX_RATIO(L, I)*(1.0E+00-MIX_RATIO_SAT(L, I)) SMAP3A.101
& /((1.0E+00-WATER_MIX_RATIO(L, I))*MIX_RATIO_SAT(L, I)) SMAP3A.102
! CHECK THAT THE MEAN RELATIVE HUMIDITY AWO1F403.84
! DOES NOT EXCEED OR EQUAL 1.0. AWO1F403.85
MEAN_REL_HUMIDITY(L, I)=MIN(MEAN_REL_HUMIDITY(L, I) AWO1F403.86
& , 0.99999) AWO1F403.87
I_HUMIDITY_POINTER(L, I)=1 SMAP3A.103
& +INT(MEAN_REL_HUMIDITY(L, I)*(NHUMIDITY_COMMON-1)) AWO1F403.88
ENDDO SMAP3A.105
ENDDO SMAP3A.106
! SMAP3A.107
! SMAP3A.108
! AWO1F403.89
AWO1F403.90
RETURN SMAP3A.109
END SMAP3A.110
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SMAP3A.111
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.94