SUBROUTINE R2_SET_GAS_MIX_RATIO(IERR 2FILL3A.24
& , N_PROFILE, NLEVS, NWET, NOZONE FILL3A.25
& , I_GATHER FILL3A.26
& , N_ABSORB, TYPE_ABSORB FILL3A.27
& , L_N2O, L_CH4, L_CFC11, L_CFC12, L_O2 FILL3A.28
& , L_CFC113, L_HCFC22, L_HFC125, L_HFC134A ADB1F405.16
& , H2O, CO2, O3, N2O_MIX_RATIO, CH4_MIX_RATIO FILL3A.29
& , C11_MIX_RATIO, C12_MIX_RATIO, O2_MIX_RATIO FILL3A.30
& , C113_MIX_RATIO, HCFC22_MIX_RATIO ADB1F405.17
& , HFC125_MIX_RATIO, HFC134A_MIX_RATIO ADB1F405.18
& , GAS_MIX_RATIO FILL3A.31
& , CO2_DIM1, CO2_DIM2, CO2_3D, L_CO2_3D ACN2F405.110
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_SPECIES FILL3A.32
& ) FILL3A.33
! FILL3A.34
! FILL3A.35
! COMDECKS INCLUDED FILL3A.36
*CALL GASID3A 
FILL3A.37
*CALL STDIO3A FILL3A.38
*CALL ERROR3A FILL3A.39
! FILL3A.40
! DUMMY ARGUMENTS. FILL3A.41
! FILL3A.42
INTEGER !, INTENT(OUT) FILL3A.43
& IERR FILL3A.44
! ERROR FLAG FILL3A.45
! FILL3A.46
! SIZES OF ARRAYS: FILL3A.47
INTEGER !, INTENT(IN) FILL3A.48
& NPD_FIELD FILL3A.49
! SIZE OF ARRAY FROM UM FILL3A.50
& , NPD_PROFILE FILL3A.51
! SIZE OF ARRAY FILL3A.52
& , NPD_LAYER FILL3A.53
! SIZE OF ARRAY FILL3A.54
& , NPD_SPECIES FILL3A.55
! SIZE OF ARRAY FILL3A.56
! FILL3A.57
! SIZES USED: FILL3A.58
INTEGER !, INTENT(IN) FILL3A.59
& N_PROFILE FILL3A.60
! NUMBER OF PROFILES FILL3A.61
& , NLEVS FILL3A.62
! NUMBER OF LEVELS FILL3A.63
& , NWET FILL3A.64
! NUMBER OF WET LEVELS FILL3A.65
& , NOZONE FILL3A.66
! NUMBER OF OZONE LEVELS FILL3A.67
! FILL3A.68
! GATHERING ARRAY: FILL3A.69
INTEGER !, INTENT(IN) FILL3A.70
& I_GATHER(NPD_FIELD) FILL3A.71
! LIST OF POINTS TO BE GATHERED FILL3A.72
! FILL3A.73
! TYPES OF GASES: FILL3A.74
INTEGER !, INTENT(IN) FILL3A.75
& N_ABSORB FILL3A.76
! NUMBER OF ABSORBERS FILL3A.77
& , TYPE_ABSORB(NPD_SPECIES) FILL3A.78
! TYPES OF ABSORBERS FILL3A.79
! FILL3A.80
! FLAGS FOR MINOR GASES: FILL3A.81
LOGICAL !,INTENT(IN) FILL3A.82
& L_N2O FILL3A.83
! FLAG FOR NITROUS OXIDE FILL3A.84
& , L_CH4 FILL3A.85
! FLAG FOR METHANE FILL3A.86
& , L_CFC11 FILL3A.87
! FLAG FOR CFC11 FILL3A.88
& , L_CFC12 FILL3A.89
! FLAG FOR CFC12 FILL3A.90
& , L_O2 FILL3A.91
! FLAG FOR O2 FILL3A.92
& , L_CFC113 ADB1F405.19
! FLAG FOR CFC113 ADB1F405.20
& , L_HCFC22 ADB1F405.21
! FLAG FOR HCFC22 ADB1F405.22
& , L_HFC125 ADB1F405.23
! FLAG FOR HFC125 ADB1F405.24
& , L_HFC134A ADB1F405.25
! FLAG FOR HFC134A ADB1F405.26
! FILL3A.93
! MIXING RATIOS SUPPLIED: FILL3A.94
INTEGER CO2_DIM1, CO2_DIM2 ! dimensions of CO2_3D field ACN2F405.111
LOGICAL L_CO2_3D ! controls use of 3D co2 field ACN2F405.112
REAL !, INTENT(IN) FILL3A.95
& H2O(NPD_FIELD, NWET) FILL3A.96
! MASS MIXING RATIO OF WATER VAPOUR FILL3A.97
& , CO2 FILL3A.98
! MASS MIXING RATIO OF CARBON DIOXIDE FILL3A.99
& , CO2_3D(CO2_DIM1, CO2_DIM2) ACN2F405.113
! 3D MASS MIXING RATIO OF CO2 (full field) ACN2F405.114
& , O3(NPD_FIELD, NOZONE) FILL3A.100
! MASS MIXING RATIO OF OZONE FILL3A.101
& , N2O_MIX_RATIO FILL3A.102
! MASS MIXING RATIO OF NITROUS OXIDE FILL3A.103
& , CH4_MIX_RATIO FILL3A.104
! MASS MIXING RATIO OF METHANE FILL3A.105
& , C11_MIX_RATIO FILL3A.106
! MASS MIXING RATIO OF CFC11 FILL3A.107
& , C12_MIX_RATIO FILL3A.108
! MASS MIXING RATIO OF CFC12 FILL3A.109
& , O2_MIX_RATIO FILL3A.110
! MASS MIXING RATIO OF O2 FILL3A.111
& , C113_MIX_RATIO ADB1F405.27
! MASS MIXING RATIO OF CFC113 ADB1F405.28
& , HCFC22_MIX_RATIO ADB1F405.29
! MASS MIXING RATIO OF HCFC22 ADB1F405.30
& , HFC125_MIX_RATIO ADB1F405.31
! MASS MIXING RATIO OF HFC125 ADB1F405.32
& , HFC134A_MIX_RATIO ADB1F405.33
! MASS MIXING RATIO OF HFC134A ADB1F405.34
! FILL3A.112
! ARRAY OF ASSIGNED MXING RATIOS: FILL3A.113
REAL !, INTENT(OUT) FILL3A.114
& GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES) FILL3A.115
! MIXING RATIOS FILL3A.116
! FILL3A.117
! LOCAL VARIABLES. FILL3A.118
! FILL3A.119
! POINTERS TO GASES: FILL3A.120
INTEGER FILL3A.121
& IUMP_H2O FILL3A.122
! POINTER TO WATER VAPOUR FILL3A.123
& , IUMP_CO2 FILL3A.124
! POINTER TO CARBON DIOXIDE FILL3A.125
& , IUMP_O3 FILL3A.126
! POINTER TO OZONE FILL3A.127
& , IUMP_N2O FILL3A.128
! POINTER TO NITOUS OXIDE FILL3A.129
& , IUMP_CH4 FILL3A.130
! POINTER TO METHANE FILL3A.131
& , IUMP_CFC11 FILL3A.132
! POINTER TO CFC11 FILL3A.133
& , IUMP_CFC12 FILL3A.134
! POINTER TO CFC12 FILL3A.135
& , IUMP_O2 FILL3A.136
! POINTER TO O2 FILL3A.137
& , IUMP_CFC113 ADB1F405.35
! POINTER TO CFC113 ADB1F405.36
& , IUMP_HCFC22 ADB1F405.37
! POINTER TO HCFC22 ADB1F405.38
& , IUMP_HFC125 ADB1F405.39
! POINTER TO HFC125 ADB1F405.40
& , IUMP_HFC134A ADB1F405.41
! POINTER TO HFC134A ADB1F405.42
INTEGER FILL3A.139
& I FILL3A.140
! LOOP VARIABLE FILL3A.141
& , L FILL3A.142
! LOOP VARIABLE FILL3A.143
& , LG FILL3A.144
! CORRESPONDING UNGATHERED INDEX FILL3A.145
! FILL3A.146
REAL FILL3A.147
& H2OLMN FILL3A.148
! LIMITING CONCENTRATION OF WATER VAPOUR FILL3A.149
PARAMETER(H2OLMN=1.E-8) FILL3A.150
! FILL3A.151
! FILL3A.152
! FILL3A.153
! FILL3A.154
! MATCH THE INDEXING NUMBERS OF GASEOUS SPECIES IN THE SPECTRAL FILL3A.155
! FILE WITH ACTUAL TYPES OF GASES KNOWN TO THE UM. FILL3A.156
! FILL3A.157
! SET ALL POINTERS TO 0 INITIALLY TO FLAG MISSING GASES. FILL3A.158
IUMP_H2O=0 FILL3A.159
IUMP_CO2=0 FILL3A.160
IUMP_O3=0 FILL3A.161
IUMP_N2O=0 FILL3A.162
IUMP_CH4=0 FILL3A.163
IUMP_CFC11=0 FILL3A.164
IUMP_CFC12=0 FILL3A.165
IUMP_O2=0 FILL3A.166
IUMP_CFC113=0 ADB1F405.43
IUMP_HCFC22=0 ADB1F405.44
IUMP_HFC125=0 ADB1F405.45
IUMP_HFC134A=0 ADB1F405.46
! FILL3A.167
! FILL3A.168
DO I=1, N_ABSORB FILL3A.169
! FILL3A.170
IF (TYPE_ABSORB(I).EQ.IP_H2O) THEN FILL3A.171
IUMP_H2O=I FILL3A.172
ELSE IF (TYPE_ABSORB(I).EQ.IP_CO2) THEN FILL3A.173
IUMP_CO2=I FILL3A.174
ELSE IF (TYPE_ABSORB(I).EQ.IP_O3) THEN FILL3A.175
IUMP_O3=I FILL3A.176
ELSE IF (TYPE_ABSORB(I).EQ.IP_N2O) THEN FILL3A.177
IUMP_N2O=I FILL3A.178
ELSE IF (TYPE_ABSORB(I).EQ.IP_CH4) THEN FILL3A.179
IUMP_CH4=I FILL3A.180
ELSE IF (TYPE_ABSORB(I).EQ.IP_CFC11) THEN FILL3A.181
IUMP_CFC11=I FILL3A.182
ELSE IF (TYPE_ABSORB(I).EQ.IP_CFC12) THEN FILL3A.183
IUMP_CFC12=I FILL3A.184
ELSE IF (TYPE_ABSORB(I).EQ.IP_O2) THEN FILL3A.185
IUMP_O2=I FILL3A.186
ELSE IF (TYPE_ABSORB(I).EQ.IP_CFC113) THEN ADB1F405.47
IUMP_CFC113=I ADB1F405.48
ELSE IF (TYPE_ABSORB(I).EQ.IP_HCFC22) THEN ADB1F405.49
IUMP_HCFC22=I ADB1F405.50
ELSE IF (TYPE_ABSORB(I).EQ.IP_HFC125) THEN ADB1F405.51
IUMP_HFC125=I ADB1F405.52
ELSE IF (TYPE_ABSORB(I).EQ.IP_HFC134A) THEN ADB1F405.53
IUMP_HFC134A=I ADB1F405.54
ENDIF FILL3A.187
! FILL3A.188
ENDDO FILL3A.189
! FILL3A.190
! FILL3A.191
! ASSIGN MIXING RATIOS OF THE GASES TO THE MAIN ARRAYS. FILL3A.192
! FILL3A.193
! WATER VAPOUR: FILL3A.194
! FILL3A.195
IF (IUMP_H2O.GT.0) THEN FILL3A.196
! THE UPPER LEVELS RECEIVE A CONSTANT SMALL VALUE. FILL3A.197
DO I=1, NLEVS-NWET FILL3A.198
DO L=1, N_PROFILE FILL3A.199
GAS_MIX_RATIO(L, I, IUMP_H2O)=H2OLMN FILL3A.200
ENDDO FILL3A.201
ENDDO FILL3A.202
DO I=NLEVS-NWET+1, NLEVS FILL3A.203
DO L=1, N_PROFILE FILL3A.204
LG=I_GATHER(L) FILL3A.205
GAS_MIX_RATIO(L, I, IUMP_H2O)=H2O(LG, NLEVS-I+1) FILL3A.206
ENDDO FILL3A.207
ENDDO FILL3A.208
ELSE FILL3A.209
WRITE(IU_ERR, '(/A)') FILL3A.210
& '*** ERROR: WATER VAPOUR IS NOT IN THE SPECTRAL FILE.' FILL3A.211
IERR=I_ERR_FATAL FILL3A.212
RETURN FILL3A.213
ENDIF FILL3A.214
! FILL3A.215
! CARBON DIOXIDE: FILL3A.216
! FILL3A.217
IF (IUMP_CO2.GT.0) THEN FILL3A.218
DO I=1, NLEVS FILL3A.219
IF (L_CO2_3D) THEN ACN2F405.115
DO L=1, N_PROFILE ACN2F405.116
LG=I_GATHER(L) ACN2F405.117
GAS_MIX_RATIO(L, I, IUMP_CO2)=CO2_3D(LG, NLEVS-I+1) ACN2F405.118
ENDDO ACN2F405.119
ELSE ACN2F405.120
DO L=1, N_PROFILE ACN2F405.121
GAS_MIX_RATIO(L, I, IUMP_CO2)=CO2 ACN2F405.122
ENDDO ACN2F405.123
ENDIF ACN2F405.124
ENDDO FILL3A.223
ELSE FILL3A.224
WRITE(IU_ERR, '(/A)') FILL3A.225
& '*** ERROR: CARBON DIOXIDE IS NOT IN THE SPECTRAL FILE.' FILL3A.226
IERR=I_ERR_FATAL FILL3A.227
RETURN FILL3A.228
ENDIF FILL3A.229
! FILL3A.230
! OZONE: FILL3A.231
! FILL3A.232
IF (IUMP_O3.GT.0) THEN FILL3A.233
! THE CLIMATOLOGY OF OZONE IS GIVEN ON NOZONE LEVELS, ADB1F401.197
! THE LOWEST VALUE SUPPLYING THE MIXING RATIO ON ADB1F401.198
! ALL LOWER LEVELS. ADB1F401.199
DO I=1, NOZONE FILL3A.235
DO L=1, N_PROFILE FILL3A.236
LG=I_GATHER(L) FILL3A.237
GAS_MIX_RATIO(L, I, IUMP_O3)=O3(LG, NOZONE+1-I) FILL3A.238
ENDDO FILL3A.239
ENDDO FILL3A.240
DO I=NOZONE+1, NLEVS FILL3A.241
DO L=1, N_PROFILE FILL3A.242
LG=I_GATHER(L) ADB1F401.200
GAS_MIX_RATIO(L, I, IUMP_O3)=O3(LG, 1) ADB1F401.201
ENDDO FILL3A.244
ENDDO FILL3A.245
ELSE FILL3A.246
WRITE(IU_ERR, '(/A)') FILL3A.247
& '*** ERROR: OZONE IS NOT IN THE SPECTRAL FILE.' FILL3A.248
IERR=I_ERR_FATAL FILL3A.249
RETURN FILL3A.250
ENDIF FILL3A.251
! FILL3A.252
! FILL3A.253
! FILL3A.254
! OTHER TRACE GASES: FILL3A.255
! FILL3A.256
! THESE GASES ARE NOT ALWAYS INCLUDED IN THE CALCULATION. FILL3A.257
! TESTING IS THEREFORE MORE INTRICATE. FILL3A.258
! FILL3A.259
IF (IUMP_N2O.GT.0) THEN FILL3A.260
! THE GAS IS IN THE SPECTRAL FILE. IF IT HAS BEEN SELECTED FILL3A.261
! FROM THE UI ITS MIXING RATIO MUST BE SET. IF IT IS IN THE FILL3A.262
! FILE BUT NOT SELECTED THE MIXING RATIO IS SET TO 0. FILL3A.263
IF (L_N2O) THEN FILL3A.264
DO I=1, NLEVS FILL3A.265
DO L=1, N_PROFILE FILL3A.266
GAS_MIX_RATIO(L, I, IUMP_N2O)=N2O_MIX_RATIO FILL3A.267
ENDDO FILL3A.268
ENDDO FILL3A.269
ELSE FILL3A.270
DO I=1, NLEVS FILL3A.271
DO L=1, N_PROFILE FILL3A.272
GAS_MIX_RATIO(L, I, IUMP_N2O)=0.0E+00 FILL3A.273
ENDDO FILL3A.274
ENDDO FILL3A.275
ENDIF FILL3A.276
ELSE FILL3A.277
! THE GAS IS NOT IN THE SPECTRAL FILE. AN ERROR RESULTS IF FILL3A.278
! IT WAS TO BE INCLUDED IN THE CALCULATION. FILL3A.279
IF (L_N2O) THEN FILL3A.280
WRITE(IU_ERR, '(/A)') FILL3A.281
& '*** ERROR: NITROUS OXIDE IS NOT IN THE SPECTRAL FILE.' FILL3A.282
IERR=I_ERR_FATAL FILL3A.283
RETURN FILL3A.284
ENDIF FILL3A.285
ENDIF FILL3A.286
! FILL3A.287
IF (IUMP_CH4.GT.0) THEN FILL3A.288
! THE GAS IS IN THE SPECTRAL FILE. IF IT HAS BEEN SELECTED FILL3A.289
! FROM THE UI ITS MIXING RATIO MUST BE SET. IF IT IS IN THE FILL3A.290
! FILE BUT NOT SELECTED THE MIXING RATIO IS SET TO 0. FILL3A.291
IF (L_CH4) THEN FILL3A.292
DO I=1, NLEVS FILL3A.293
DO L=1, N_PROFILE FILL3A.294
GAS_MIX_RATIO(L, I, IUMP_CH4)=CH4_MIX_RATIO FILL3A.295
ENDDO FILL3A.296
ENDDO FILL3A.297
ELSE FILL3A.298
DO I=1, NLEVS FILL3A.299
DO L=1, N_PROFILE FILL3A.300
GAS_MIX_RATIO(L, I, IUMP_CH4)=0.0E+00 FILL3A.301
ENDDO FILL3A.302
ENDDO FILL3A.303
ENDIF FILL3A.304
ELSE FILL3A.305
! THE GAS IS NOT IN THE SPECTRAL FILE. AN ERROR RESULTS IF FILL3A.306
! IT WAS TO BE INCLUDED IN THE CALCULATION. FILL3A.307
IF (L_CH4) THEN FILL3A.308
WRITE(IU_ERR, '(/A)') FILL3A.309
& '*** ERROR: METHANE IS NOT IN THE SPECTRAL FILE.' FILL3A.310
IERR=I_ERR_FATAL FILL3A.311
RETURN FILL3A.312
ENDIF FILL3A.313
ENDIF FILL3A.314
! FILL3A.315
IF (IUMP_CFC11.GT.0) THEN FILL3A.316
! THE GAS IS IN THE SPECTRAL FILE. IF IT HAS BEEN SELECTED FILL3A.317
! FROM THE UI ITS MIXING RATIO MUST BE SET. IF IT IS IN THE FILL3A.318
! FILE BUT NOT SELECTED THE MIXING RATIO IS SET TO 0. FILL3A.319
IF (L_CFC11) THEN FILL3A.320
DO I=1, NLEVS FILL3A.321
DO L=1, N_PROFILE FILL3A.322
GAS_MIX_RATIO(L, I, IUMP_CFC11)=C11_MIX_RATIO FILL3A.323
ENDDO FILL3A.324
ENDDO FILL3A.325
ELSE FILL3A.326
DO I=1, NLEVS FILL3A.327
DO L=1, N_PROFILE FILL3A.328
GAS_MIX_RATIO(L, I, IUMP_CFC11)=0.0E+00 FILL3A.329
ENDDO FILL3A.330
ENDDO FILL3A.331
ENDIF FILL3A.332
ELSE FILL3A.333
! THE GAS IS NOT IN THE SPECTRAL FILE. AN ERROR RESULTS IF FILL3A.334
! IT WAS TO BE INCLUDED IN THE CALCULATION. FILL3A.335
IF (L_CFC11) THEN FILL3A.336
WRITE(IU_ERR, '(/A)') FILL3A.337
& '*** ERROR: CFC11 IS NOT IN THE SPECTRAL FILE.' FILL3A.338
IERR=I_ERR_FATAL FILL3A.339
RETURN FILL3A.340
ENDIF FILL3A.341
ENDIF FILL3A.342
! FILL3A.343
IF (IUMP_CFC12.GT.0) THEN FILL3A.344
! THE GAS IS IN THE SPECTRAL FILE. IF IT HAS BEEN SELECTED FILL3A.345
! FROM THE UI ITS MIXING RATIO MUST BE SET. IF IT IS IN THE FILL3A.346
! FILE BUT NOT SELECTED THE MIXING RATIO IS SET TO 0. FILL3A.347
IF (L_CFC12) THEN FILL3A.348
DO I=1, NLEVS FILL3A.349
DO L=1, N_PROFILE FILL3A.350
GAS_MIX_RATIO(L, I, IUMP_CFC12)=C12_MIX_RATIO FILL3A.351
ENDDO FILL3A.352
ENDDO FILL3A.353
ELSE FILL3A.354
DO I=1, NLEVS FILL3A.355
DO L=1, N_PROFILE FILL3A.356
GAS_MIX_RATIO(L, I, IUMP_CFC12)=0.0E+00 FILL3A.357
ENDDO FILL3A.358
ENDDO FILL3A.359
ENDIF FILL3A.360
ELSE FILL3A.361
! THE GAS IS NOT IN THE SPECTRAL FILE. AN ERROR RESULTS IF FILL3A.362
! IT WAS TO BE INCLUDED IN THE CALCULATION. FILL3A.363
IF (L_CFC12) THEN FILL3A.364
WRITE(IU_ERR, '(/A)') FILL3A.365
& '*** ERROR: CFC12 IS NOT IN THE SPECTRAL FILE.' FILL3A.366
IERR=I_ERR_FATAL FILL3A.367
RETURN FILL3A.368
ENDIF FILL3A.369
ENDIF FILL3A.370
! FILL3A.371
IF (IUMP_O2.GT.0) THEN FILL3A.372
! THE GAS IS IN THE SPECTRAL FILE. IF IT HAS BEEN SELECTED FILL3A.373
! FROM THE UI ITS MIXING RATIO MUST BE SET. IF IT IS IN THE FILL3A.374
! FILE BUT NOT SELECTED THE MIXING RATIO IS SET TO 0. FILL3A.375
IF (L_O2) THEN FILL3A.376
DO I=1, NLEVS FILL3A.377
DO L=1, N_PROFILE FILL3A.378
GAS_MIX_RATIO(L, I, IUMP_O2)=O2_MIX_RATIO FILL3A.379
ENDDO FILL3A.380
ENDDO FILL3A.381
ELSE FILL3A.382
DO I=1, NLEVS FILL3A.383
DO L=1, N_PROFILE FILL3A.384
GAS_MIX_RATIO(L, I, IUMP_O2)=0.0E+00 FILL3A.385
ENDDO FILL3A.386
ENDDO FILL3A.387
ENDIF FILL3A.388
ELSE FILL3A.389
! THE GAS IS NOT IN THE SPECTRAL FILE. AN ERROR RESULTS IF FILL3A.390
! IT WAS TO BE INCLUDED IN THE CALCULATION. FILL3A.391
IF (L_O2) THEN FILL3A.392
WRITE(IU_ERR, '(/A)') FILL3A.393
& '*** ERROR: O2 IS NOT IN THE SPECTRAL FILE.' FILL3A.394
IERR=I_ERR_FATAL FILL3A.395
RETURN FILL3A.396
ENDIF FILL3A.397
ENDIF FILL3A.398
! ADB1F405.55
IF (IUMP_CFC113.GT.0) THEN ADB1F405.56
! THE GAS IS IN THE SPECTRAL FILE. IF IT HAS BEEN SELECTED ADB1F405.57
! FROM THE UI ITS MIXING RATIO MUST BE SET. IF IT IS IN THE ADB1F405.58
! FILE BUT NOT SELECTED THE MIXING RATIO IS SET TO 0. ADB1F405.59
IF (L_CFC113) THEN ADB1F405.60
DO I=1, NLEVS ADB1F405.61
DO L=1, N_PROFILE ADB1F405.62
GAS_MIX_RATIO(L, I, IUMP_CFC113)=C113_MIX_RATIO ADB1F405.63
ENDDO ADB1F405.64
ENDDO ADB1F405.65
ELSE ADB1F405.66
DO I=1, NLEVS ADB1F405.67
DO L=1, N_PROFILE ADB1F405.68
GAS_MIX_RATIO(L, I, IUMP_CFC113)=0.0E+00 ADB1F405.69
ENDDO ADB1F405.70
ENDDO ADB1F405.71
ENDIF ADB1F405.72
ELSE ADB1F405.73
! THE GAS IS NOT IN THE SPECTRAL FILE. AN ERROR RESULTS IF ADB1F405.74
! IT WAS TO BE INCLUDED IN THE CALCULATION. ADB1F405.75
IF (L_CFC113) THEN ADB1F405.76
WRITE(IU_ERR, '(/A)') ADB1F405.77
& '*** ERROR: CFC113 IS NOT IN THE SPECTRAL FILE.' ADB1F405.78
IERR=I_ERR_FATAL ADB1F405.79
RETURN ADB1F405.80
ENDIF ADB1F405.81
ENDIF ADB1F405.82
! ADB1F405.83
IF (IUMP_HCFC22.GT.0) THEN ADB1F405.84
! THE GAS IS IN THE SPECTRAL FILE. IF IT HAS BEEN SELECTED ADB1F405.85
! FROM THE UI ITS MIXING RATIO MUST BE SET. IF IT IS IN THE ADB1F405.86
! FILE BUT NOT SELECTED THE MIXING RATIO IS SET TO 0. ADB1F405.87
IF (L_HCFC22) THEN ADB1F405.88
DO I=1, NLEVS ADB1F405.89
DO L=1, N_PROFILE ADB1F405.90
GAS_MIX_RATIO(L, I, IUMP_HCFC22)=HCFC22_MIX_RATIO ADB1F405.91
ENDDO ADB1F405.92
ENDDO ADB1F405.93
ELSE ADB1F405.94
DO I=1, NLEVS ADB1F405.95
DO L=1, N_PROFILE ADB1F405.96
GAS_MIX_RATIO(L, I, IUMP_HCFC22)=0.0E+00 ADB1F405.97
ENDDO ADB1F405.98
ENDDO ADB1F405.99
ENDIF ADB1F405.100
ELSE ADB1F405.101
! THE GAS IS NOT IN THE SPECTRAL FILE. AN ERROR RESULTS IF ADB1F405.102
! IT WAS TO BE INCLUDED IN THE CALCULATION. ADB1F405.103
IF (L_HCFC22) THEN ADB1F405.104
WRITE(IU_ERR, '(/A)') ADB1F405.105
& '*** ERROR: HCFC22 IS NOT IN THE SPECTRAL FILE.' ADB1F405.106
IERR=I_ERR_FATAL ADB1F405.107
RETURN ADB1F405.108
ENDIF ADB1F405.109
ENDIF ADB1F405.110
! ADB1F405.111
IF (IUMP_HFC125.GT.0) THEN ADB1F405.112
! THE GAS IS IN THE SPECTRAL FILE. IF IT HAS BEEN SELECTED ADB1F405.113
! FROM THE UI ITS MIXING RATIO MUST BE SET. IF IT IS IN THE ADB1F405.114
! FILE BUT NOT SELECTED THE MIXING RATIO IS SET TO 0. ADB1F405.115
IF (L_HFC125) THEN ADB1F405.116
DO I=1, NLEVS ADB1F405.117
DO L=1, N_PROFILE ADB1F405.118
GAS_MIX_RATIO(L, I, IUMP_HFC125)=HFC125_MIX_RATIO ADB1F405.119
ENDDO ADB1F405.120
ENDDO ADB1F405.121
ELSE ADB1F405.122
DO I=1, NLEVS ADB1F405.123
DO L=1, N_PROFILE ADB1F405.124
GAS_MIX_RATIO(L, I, IUMP_HFC125)=0.0E+00 ADB1F405.125
ENDDO ADB1F405.126
ENDDO ADB1F405.127
ENDIF ADB1F405.128
ELSE ADB1F405.129
! THE GAS IS NOT IN THE SPECTRAL FILE. AN ERROR RESULTS IF ADB1F405.130
! IT WAS TO BE INCLUDED IN THE CALCULATION. ADB1F405.131
IF (L_HFC125) THEN ADB1F405.132
WRITE(IU_ERR, '(/A)') ADB1F405.133
& '*** ERROR: HFC125 IS NOT IN THE SPECTRAL FILE.' ADB1F405.134
IERR=I_ERR_FATAL ADB1F405.135
RETURN ADB1F405.136
ENDIF ADB1F405.137
ENDIF ADB1F405.138
! ADB1F405.139
IF (IUMP_HFC134A.GT.0) THEN ADB1F405.140
! THE GAS IS IN THE SPECTRAL FILE. IF IT HAS BEEN SELECTED ADB1F405.141
! FROM THE UI ITS MIXING RATIO MUST BE SET. IF IT IS IN THE ADB1F405.142
! FILE BUT NOT SELECTED THE MIXING RATIO IS SET TO 0. ADB1F405.143
IF (L_HFC134A) THEN ADB1F405.144
DO I=1, NLEVS ADB1F405.145
DO L=1, N_PROFILE ADB1F405.146
GAS_MIX_RATIO(L, I, IUMP_HFC134A)=HFC134A_MIX_RATIO ADB1F405.147
ENDDO ADB1F405.148
ENDDO ADB1F405.149
ELSE ADB1F405.150
DO I=1, NLEVS ADB1F405.151
DO L=1, N_PROFILE ADB1F405.152
GAS_MIX_RATIO(L, I, IUMP_HFC134A)=0.0E+00 ADB1F405.153
ENDDO ADB1F405.154
ENDDO ADB1F405.155
ENDIF ADB1F405.156
ELSE ADB1F405.157
! THE GAS IS NOT IN THE SPECTRAL FILE. AN ERROR RESULTS IF ADB1F405.158
! IT WAS TO BE INCLUDED IN THE CALCULATION. ADB1F405.159
IF (L_HFC134A) THEN ADB1F405.160
WRITE(IU_ERR, '(/A)') ADB1F405.161
& '*** ERROR: HFC134A IS NOT IN THE SPECTRAL FILE.' ADB1F405.162
IERR=I_ERR_FATAL ADB1F405.163
RETURN ADB1F405.164
ENDIF ADB1F405.165
ENDIF ADB1F405.166
! FILL3A.399
! FILL3A.400
! FILL3A.401
RETURN FILL3A.402
END FILL3A.403
!+ Subroutine to set thermodynamic properties FILL3A.404
! FILL3A.405
! Purpose: FILL3A.406
! Pressures, temperatures at the centres and edges of layers FILL3A.407
! and the masses in layers are set. FILL3A.408
! FILL3A.409
! Method: FILL3A.410
! Straightforward. FILL3A.411
! FILL3A.412
! Current Owner of Code: J. M. Edwards FILL3A.413
! FILL3A.414
! History: FILL3A.415
! Version Date Comment FILL3A.416
! 4.0 27-07-95 Original Code FILL3A.417
! (J. M. Edwards) FILL3A.418
! 4.1 10-06-96 Old formulation over ADB1F401.202
! sea-ice removed. ADB1F401.203
! (J. M. Edwards) ADB1F401.204
! 4.2 08-08-96 Ground temperature ADB1F402.145
! set equal to that ADB1F402.146
! in the middle of the ADB1F402.147
! bottom layer. ADB1F402.148
! (J. M. Edwards) ADB1F402.149
! FILL3A.419
! Description of Code: FILL3A.420
! FORTRAN 77 with extensions listed in documentation. FILL3A.421
! FILL3A.422
!- --------------------------------------------------------------------- FILL3A.423
SUBROUTINE R2_SET_THERMODYNAMIC( 2FILL3A.424
& N_PROFILE, NLEVS, I_GATHER, L_BOUNDARY_TEMPERATURE FILL3A.425
& , PSTAR, TSTAR, AB, BB, AC, BC, PEXNER, TAC ADB1F401.205
& , P, T, T_BDY, T_SURFACE, D_MASS ADB1F401.206
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER FILL3A.428
& ) FILL3A.429
! FILL3A.430
! FILL3A.431
! FILL3A.432
IMPLICIT NONE FILL3A.433
! FILL3A.434
! FILL3A.435
! INCLUDED COMDECKS FILL3A.436
*CALL C_G FILL3A.437
*CALL C_R_CP FILL3A.439
*CALL PRMCH3A FILL3A.440
*CALL PRECSN3A FILL3A.441
! FILL3A.442
! DUMMY ARGUMENTS. FILL3A.443
! SIZES OF ARRAYS: FILL3A.444
INTEGER !, INTENT(IN) FILL3A.445
& NPD_FIELD FILL3A.446
! SIZE OF ARRAY FROM UM FILL3A.447
& , NPD_PROFILE FILL3A.448
! MAXIMUM NUMBER OF PROFILES FILL3A.449
& , NPD_LAYER FILL3A.450
! MAXIMUM NUMBER OF LAYERS FILL3A.451
! FILL3A.452
! SIZES USED: FILL3A.453
INTEGER !, INTENT(IN) FILL3A.454
& N_PROFILE FILL3A.455
! NUMBER OF PROFILES FILL3A.456
& , NLEVS FILL3A.457
! NUMBER OF LEVELS FILL3A.458
& , I_GATHER(NPD_FIELD) FILL3A.459
! LIST OF POINTS TO GATHER FILL3A.460
! FILL3A.461
REAL !, INTENT(IN) FILL3A.462
& PSTAR(NPD_FIELD) FILL3A.463
! SURFACE PRESSURES FILL3A.464
& , TSTAR(NPD_FIELD) FILL3A.465
! SURFACE TEMPERSTURES FILL3A.466
& , AB(NLEVS+1) FILL3A.467
! A AT EDGES OF LAYERS FILL3A.468
& , BB(NLEVS+1) FILL3A.469
! B AT EDGES OF LAYERS FILL3A.470
& , AC(NLEVS) FILL3A.471
! A AT CENTRES OF LAYERS FILL3A.472
& , BC(NLEVS) FILL3A.473
! B AT CENTRES OF LAYERS FILL3A.474
& , TAC(NPD_FIELD, NLEVS) FILL3A.475
! TEMPERATURES AT CENTRES OF LAYERS FILL3A.476
& , PEXNER(NPD_FIELD, NLEVS+1) FILL3A.477
! EXNER FUNCTION AT BOUNDARIES FILL3A.478
! FILL3A.481
LOGICAL !, INTENT(IN) FILL3A.482
& L_BOUNDARY_TEMPERATURE FILL3A.483
! FLAG TO CALCULATE TEMPERATURES AT BOUNADRIES OF LAYERS. FILL3A.484
! FILL3A.485
! FILL3A.486
REAL !, INTENT(OUT) FILL3A.487
& D_MASS(NPD_PROFILE, NPD_LAYER) FILL3A.488
! MASS THICKNESSES OF LAYERS FILL3A.489
& , P(NPD_PROFILE, 0: NPD_LAYER) FILL3A.490
! PRESSURE FIELD FILL3A.491
& , T(NPD_PROFILE, 0: NPD_LAYER) FILL3A.492
! TEMPERATURE FIELD FILL3A.493
& , T_BDY(NPD_PROFILE, 0: NPD_LAYER) FILL3A.494
! TEMPERATURES AT EDGES OF LAYERS FILL3A.495
& , T_SURFACE(NPD_PROFILE) ADB1F401.207
! GATHERED TEMPERATURE OF SURFACE ADB1F401.208
! FILL3A.496
! FILL3A.497
! LOCAL VARIABLES. FILL3A.498
! FILL3A.499
INTEGER FILL3A.500
& I FILL3A.501
! LOOP VARIABLE FILL3A.502
& , II FILL3A.503
! LOOP VARIABLE FILL3A.504
& , L FILL3A.505
! LOOP VARIABLE FILL3A.506
& , LG FILL3A.507
! INDEX TO GATHER FILL3A.508
! FILL3A.509
REAL FILL3A.510
& PU FILL3A.511
! PRESSURE FOR UPPER LAYER FILL3A.512
& , PL FILL3A.513
! PRESSURE FOR LOWER LAYER FILL3A.514
& , PML1 FILL3A.515
! PRESSURE FOR INTERPOLATION FILL3A.516
& , WTL FILL3A.517
! WEIGHT FOR LOWER LAYER FILL3A.518
& , WTU FILL3A.519
! WEIGHT FOR UPPER LAYER FILL3A.520
! FILL3A.523
*CALL P_EXNERC FILL3A.524
! FILL3A.525
! FILL3A.526
! FILL3A.527
! CALCULATE PROPERTIES AT THE CENTRES OF LAYERS. FILL3A.528
DO I=1, NLEVS FILL3A.529
DO L=1, N_PROFILE FILL3A.530
LG=I_GATHER(L) FILL3A.531
P(L, I)=AC(NLEVS+1-I)+BC(NLEVS+1-I)*PSTAR(LG) FILL3A.532
T(L, I)=TAC(LG, NLEVS+1-I) FILL3A.533
D_MASS(L, I)=(AB(NLEVS+1-I)-AB(NLEVS+2-I) FILL3A.534
& +PSTAR(LG)*(BB(NLEVS+1-I)-BB(NLEVS+2-I))) FILL3A.535
& /G FILL3A.536
ENDDO FILL3A.537
ENDDO FILL3A.538
! FILL3A.539
! FILL3A.540
IF (L_BOUNDARY_TEMPERATURE) THEN FILL3A.541
! ADB1F401.209
! GATHER THE SURFACE TEMPERATURE. ADB1F401.210
DO L=1, N_PROFILE ADB1F401.211
LG=I_GATHER(L) ADB1F401.212
T_SURFACE(L)=TSTAR(LG) ADB1F401.213
ENDDO ADB1F401.214
! ADB1F401.215
! INTERPOLATE TEMPERATURES AT THE BOUNDARIES OF LAYERS FILL3A.542
! FROM THE EXNER FUNCTION. FILL3A.543
DO L=1, N_PROFILE FILL3A.544
LG=I_GATHER(L) FILL3A.545
! ADB1F401.216
! TAKE THE TEMPERATURE OF THE AIR JUST ABOVE THE SURFACE AS ADB1F401.217
! THE TEMPERATURE AT THE MIDDLE OF THE BOTTOM LAYER. ADB1F402.150
T_BDY(L, NLEVS)=TAC(LG, 1) ADB1F402.151
! TAKE THE TEMPERATURE AS CONSTANT ACROSS THE TOP HALF-LAYER. FILL3A.557
T_BDY(L, 0)=TAC(LG, NLEVS) FILL3A.558
! ADB1F401.220
ENDDO FILL3A.559
! ADB1F401.221
DO I=1, NLEVS-1 FILL3A.560
II=NLEVS-I FILL3A.561
DO L=1, N_PROFILE FILL3A.562
LG=I_GATHER(L) FILL3A.563
PU=PSTAR(LG)*BB(II+2)+AB(II+2) FILL3A.564
PL=PSTAR(LG)*BB(II+1)+AB(II+1) FILL3A.565
PML1=PSTAR(LG)*BB(II)+AB(II) FILL3A.566
WTU=TAC(LG, II+1)*(PEXNER(LG, II+1) FILL3A.567
& /P_EXNER_C(PEXNER(LG, II+2), PEXNER(LG, II+1) FILL3A.568
& , PU, PL, KAPPA)-1.0E+00) FILL3A.569
WTL=TAC(LG, II)*(PEXNER(LG, II) FILL3A.570
& /P_EXNER_C(PEXNER(LG, II+1), PEXNER(LG, II) FILL3A.571
& , PL, PML1, KAPPA)-1.0E+00) FILL3A.572
T_BDY(L, I)=(WTU*TAC(LG, NLEVS+1-I) FILL3A.573
& +WTL*TAC(LG, NLEVS-I))/(WTL+WTU) FILL3A.574
ENDDO FILL3A.575
ENDDO FILL3A.576
! ADB1F401.222
ENDIF FILL3A.577
! FILL3A.578
! FILL3A.579
! FILL3A.580
RETURN FILL3A.581
END FILL3A.582
!+ Subroutine to assign Properties of Clouds. FILL3A.583
! FILL3A.584
! Purpose: FILL3A.585
! The fractions of different types of clouds and their microphysical FILL3A.586
! preoperties are set. FILL3A.587
! FILL3A.588
! Method: FILL3A.589
! Straightforward. FILL3A.590
! FILL3A.591
! Current Owner of Code: J. M. Edwards FILL3A.592
! FILL3A.593
! History: FILL3A.594
! Version Date Comment FILL3A.595
! 4.0 27-07-95 Original Code FILL3A.596
! (J. M. Edwards) FILL3A.597
! 4.1 10-06-96 New flag L_AEROSOL_CCN ADB1F401.223
! introduced to allow ADB1F401.224
! inclusion of indirect ADB1F401.225
! aerosol forcing alone. ADB1F401.226
! Correction of comments ADB1F401.227
! for LCCWC1 and LCCWC2. ADB1F401.228
! Correction of level at ADB1F401.229
! which temperature for ADB1F401.230
! partitioning ADB1F401.231
! convective homogeneously ADB1F401.232
! mixed cloud is taken. ADB1F401.233
! (J. M. Edwards) ADB1F401.234
! 4.4 08-04-97 Changes for new precip AYY1F404.385
! scheme (qCF prognostic) AYY1F404.386
! (A. C. Bushell) AYY1F404.387
! 4.4 15-09-97 A parametrization of ADB2F404.12
! ice crystals with a ADB2F404.13
! temperature dependedence ADB2F404.14
! of the size has been ADB2F404.15
! added. ADB2F404.16
! Explicit checking of ADB2F404.17
! the sizes of particles ADB2F404.18
! for the domain of ADB2F404.19
! validity of the para- ADB2F404.20
! metrization has been ADB2F404.21
! added. ADB2F404.22
! (J. M. Edwards) ADB2F404.23
! 4.5 18-05-98 New option for ADB1F405.167
! partitioning between ADB1F405.168
! ice and water in ADB1F405.169
! convective cloud ADB1F405.170
! included. ADB1F405.171
! (J. M. Edwards) ADB1F405.172
! 4.5 13/05/98 Changes to R2_SET_CLOUD_FIELD to use ASK1F405.296
! original sect 9 cloud fraction when ASK1F405.297
! an extended 'area' cloud fraction is ASK1F405.298
! used everywhere else in Radiation. ASK1F405.299
! S. Cusack ASK1F405.300
! FILL3A.598
! Description of Code: FILL3A.599
! FORTRAN 77 with extensions listed in documentation. FILL3A.600
! FILL3A.601
!- --------------------------------------------------------------------- FILL3A.602
SUBROUTINE R2_SET_CLOUD_FIELD(N_PROFILE, NLEVS, NCLDS 2,5FILL3A.603
& , I_GATHER FILL3A.604
& , P, T, D_MASS FILL3A.605
& , CCB, CCT, CCA, CCCWP FILL3A.606
& , LCCWC1, LCCWC2, LCA_AREA, LCA_BULK ASK1F405.301
& , L_MICROPHYSICS, L_AEROSOL_CCN AYY1F404.388
& , SULP_DIM1, SULP_DIM2, ACCUM_SULPHATE, DISS_SULPHATE AYY1F404.389
& , L_CLOUD_WATER_PARTITION, LAND_G AYY1F404.390
& , I_CLOUD_REPRESENTATION, I_CONDENSED_PARAM ADB2F404.24
& , CONDENSED_MIN_DIM, CONDENSED_MAX_DIM ADB2F404.25
& , N_CONDENSED, TYPE_CONDENSED FILL3A.610
& , W_CLOUD, FRAC_CLOUD, L_LOCAL_CNV_PARTITION ADB1F405.173
& , CONDENSED_MIX_RAT_AREA, CONDENSED_DIM_CHAR ASK1F405.302
& , RE_CONV, RE_CONV_FLAG, RE_STRAT, RE_STRAT_FLAG FILL3A.613
& , WGT_CONV, WGT_CONV_FLAG, WGT_STRAT, WGT_STRAT_FLAG FILL3A.614
& , LWP_STRAT, LWP_STRAT_FLAG FILL3A.615
& , NTOT_DIAG, NTOT_DIAG_FLAG AAJ3F404.89
& , STRAT_LWC_DIAG, STRAT_LWC_DIAG_FLAG AAJ3F404.90
& , SO4_CCN_DIAG, SO4_CCN_DIAG_FLAG AAJ3F404.91
& , COND_SAMP_WGT, COND_SAMP_WGT_FLAG AAJ3F404.92
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_AEROSOL_SPECIES FILL3A.616
& , N_CCA_LEV, L_3D_CCA AJX0F404.60
& ) FILL3A.617
! FILL3A.618
! FILL3A.619
! FILL3A.620
IMPLICIT NONE FILL3A.621
! FILL3A.622
! FILL3A.623
! COMDECKS INCLUDED. FILL3A.624
*CALL PRMCH3A FILL3A.625
*CALL PRECSN3A FILL3A.626
*CALL DIMFIX3A FILL3A.627
*CALL CLDCMP3A FILL3A.628
*CALL CLDTYP3A FILL3A.629
*CALL CLREPP3A FILL3A.630
*CALL ICLPRM3A ADB2F404.27
*CALL C_0_DG_C FILL3A.631
*CALL C_R_CP FILL3A.632
! FILL3A.633
! FILL3A.634
! DIMENSIONS OF ARRAYS: FILL3A.635
INTEGER !, INTENT(IN) FILL3A.636
& NPD_FIELD FILL3A.637
! FIELD SIZE IN CALLING PROGRAM FILL3A.638
& , NPD_PROFILE FILL3A.639
! SIZE OF ARRAY OF PROFILES FILL3A.640
& , NPD_LAYER FILL3A.641
! MAXIMUM NUMBER OF LAYERS FILL3A.642
& , NPD_AEROSOL_SPECIES FILL3A.643
! MAXIMUM NUMBER OF AEROSOL_SPECIES FILL3A.644
& , SULP_DIM1 AYY1F404.391
! 1ST DIMENSION OF ARRAYS OF SULPHATE AYY1F404.392
& , SULP_DIM2 AYY1F404.393
! 2ND DIMENSION OF ARRAYS OF SULPHATE AYY1F404.394
& , N_CCA_LEV AJX0F404.61
! NUMBER OF LEVELS FOR CONVECTIVE CLOUD AMOUNT AJX0F404.62
! FILL3A.645
! ACTUAL SIZES USED: FILL3A.646
INTEGER !, INTENT(IN) FILL3A.647
& N_PROFILE FILL3A.648
! NUMBER OF PROFILES FILL3A.649
& , NLEVS FILL3A.650
! NUMBER OF ATMOSPHERIC LAYERS FILL3A.651
& , NCLDS FILL3A.652
! NUMBER OF CLOUDY LEVELS FILL3A.653
! FILL3A.654
! GATHERING ARRAY: FILL3A.655
INTEGER !, INTENT(IN) FILL3A.656
& I_GATHER(NPD_FIELD) FILL3A.657
! LIST OF POINTS TO BE GATHERED FILL3A.658
! FILL3A.659
! THERMODYNAMIC FIELDS: FILL3A.660
REAL !, INTENT(IN) FILL3A.661
& P(NPD_PROFILE, 0: NPD_LAYER) FILL3A.662
! PRESSURES FILL3A.663
& , T(NPD_PROFILE, 0: NPD_LAYER) FILL3A.664
! TEMPERATURES FILL3A.665
& , D_MASS(NPD_PROFILE, NPD_LAYER) FILL3A.666
! MASS THICKNESSES OF LAYERS FILL3A.667
! FILL3A.668
! CONVECTIVE CLOUDS: FILL3A.669
INTEGER !, INTENT(IN) FILL3A.670
& CCB(NPD_FIELD) FILL3A.671
! BASE OF CONVECTIVE CLOUD FILL3A.672
& , CCT(NPD_FIELD) FILL3A.673
! TOP OF CONVECTIVE CLOUD FILL3A.674
REAL !, INTENT(IN) FILL3A.675
& CCA(NPD_FIELD,N_CCA_LEV) AJX0F404.63
! FRACTION OF CONVECTIVE CLOUD FILL3A.677
& , CCCWP(NPD_FIELD) FILL3A.678
! WATER PATH OF CONVECTIVE CLOUD FILL3A.679
LOGICAL !, INTENT(IN) AJX0F404.64
& L_3D_CCA AJX0F404.65
& , L_LOCAL_CNV_PARTITION ADB1F405.174
! FLAG TO CARRY OUT THE PARTITIONING BETWEEN ICE ADB1F405.175
! AND WATER IN CONVECTIVE CLOUDS AS A FUNCTION OF ADB1F405.176
! THE LOCAL TEMPERATURE ADB1F405.177
! FILL3A.680
! LAYER CLOUDS: FILL3A.681
REAL !, INTENT(IN) FILL3A.682
& LCCWC1(NPD_FIELD, NCLDS+1/(NCLDS+1)) FILL3A.683
! LIQUID WATER CONTENTS AYY1F404.395
& , LCCWC2(NPD_FIELD, NCLDS+1/(NCLDS+1)) FILL3A.685
! ICE WATER CONTENTS AYY1F404.396
& , LCA_AREA(NPD_FIELD, NCLDS+1/(NCLDS+1)) ASK1F405.303
! AREA COVERAGE FRACTIONS OF LAYER CLOUDS ASK1F405.304
& , LCA_BULK(NPD_FIELD, NCLDS+1/(NCLDS+1)) ASK1F405.305
! BULK COVERAGE FRACTIONS OF LAYER CLOUDS ASK1F405.306
! FILL3A.689
! ARRAYS FOR MICROPHYSICS: FILL3A.690
LOGICAL !, INTENT(IN) FILL3A.691
& L_MICROPHYSICS FILL3A.692
! MICROPHYSICAL FLAG FILL3A.693
& , L_AEROSOL_CCN ADB1F401.242
! FLAG TO USE AEROSOLS TO FIND CCN ADB1F401.243
& , L_CLOUD_WATER_PARTITION AYY1F404.397
! FLAG TO USE PROGNOSTIC CLOUD ICE CONTENTS AYY1F404.398
& , LAND_G(NPD_PROFILE) FILL3A.696
! FLAG FOR LAND POINTS FILL3A.697
REAL !, INTENT(IN) FILL3A.698
& ACCUM_SULPHATE(SULP_DIM1, SULP_DIM2) AYY1F404.399
! MIXING RATIOS OF ACCUMULATION-MODE SULPHATE AYY1F404.400
& , DISS_SULPHATE(SULP_DIM1, SULP_DIM2) AYY1F404.401
! MIXING RATIOS OF DISSOLVED SULPHATE AYY1F404.402
! FILL3A.702
! REPRESENTATION OF CLOUDS FILL3A.703
INTEGER !, INTENT(IN) FILL3A.704
& I_CLOUD_REPRESENTATION FILL3A.705
! REPRESENTATION OF CLOUDS FILL3A.706
! ADB2F404.28
! PARAMETRIZATIONS FOR CLOUDS: ADB2F404.29
INTEGER !, INTENT(IN) ADB2F404.30
& I_CONDENSED_PARAM(NPD_CLOUD_COMPONENT) ADB2F404.31
! TYPES OF PARAMETRIZATION USED FOR CONDENSED ADB2F404.32
! COMPONENTS IN CLOUDS ADB2F404.33
! LIMITS ON SIZES OF PARTICLES ADB2F404.34
REAL !, INTENT(IN) ADB2F404.35
& CONDENSED_MIN_DIM(NPD_CLOUD_COMPONENT) ADB2F404.36
! MINIMUM DIMENSION OF EACH CONDENSED COMPONENT ADB2F404.37
& , CONDENSED_MAX_DIM(NPD_CLOUD_COMPONENT) ADB2F404.38
! MAXIMUM DIMENSION OF EACH CONDENSED COMPONENT ADB2F404.39
! FILL3A.707
! ASSIGNED CLOUD FIELDS: FILL3A.708
INTEGER !, INTENT(OUT) FILL3A.709
& N_CONDENSED FILL3A.710
! NUMBER OF CONDENSED COMPONENTS FILL3A.711
& , TYPE_CONDENSED(NPD_CLOUD_COMPONENT) FILL3A.712
! TYPES OF CONDENSED COMPONENTS FILL3A.713
REAL !, INTENT(OUT) FILL3A.714
& W_CLOUD(NPD_PROFILE, NPD_LAYER) FILL3A.715
! TOTAL AMOUNTS OF CLOUD FILL3A.716
& , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) FILL3A.717
! FRACTION OF EACH TYPE OF CLOUD ADB1F401.244
& , CONDENSED_DIM_CHAR(NPD_PROFILE, 0: NPD_LAYER ADB2F404.40
& , NPD_CLOUD_COMPONENT) ADB2F404.41
! CHARACTERISTIC DIMENSIONS OF CLOUDY COMPONENTS ADB2F404.42
& , CONDENSED_MIX_RAT_AREA(NPD_PROFILE, 0: NPD_LAYER ASK1F405.307
& , NPD_CLOUD_COMPONENT) FILL3A.722
! MASS MIXING RATIOS OF CONDENSED COMPONENTS USING AREA CLD ASK1F405.308
& , NTOT_DIAG_G(NPD_PROFILE, NPD_LAYER) AAJ3F404.93
! DIAGNOSTIC ARRAY FOR NTOT (GATHERED) AAJ3F404.94
& , STRAT_LWC_DIAG_G(NPD_PROFILE, NPD_LAYER) AAJ3F404.95
! DIAGNOSTIC ARRAY FOR STRATIFORM LWC (GATHERED) AAJ3F404.96
& , SO4_CCN_DIAG_G(NPD_PROFILE, NPD_LAYER) AAJ3F404.97
! DIAGNOSTIC ARRAY FOR SO4 CCN MASS CONC (GATHERED) AAJ3F404.98
! AAJ3F404.99
! FILL3A.724
! MICROPHYSICAL DIAGNOSTICS: FILL3A.725
LOGICAL FILL3A.726
& RE_CONV_FLAG FILL3A.727
! DIAGNOSE EFFECTIVE RADIUS*WEIGHT FOR CONVECTIVE CLOUD FILL3A.728
& , RE_STRAT_FLAG FILL3A.729
! DIAGNOSE EFFECTIVE RADIUS*WEIGHT FOR STRATIFORM CLOUD FILL3A.730
& , WGT_CONV_FLAG FILL3A.731
! DIAGNOSE WEIGHT FOR CONVECTIVE CLOUD FILL3A.732
& , WGT_STRAT_FLAG FILL3A.733
! DIAGNOSE WEIGHT FOR STRATIFORM CLOUD FILL3A.734
& , LWP_STRAT_FLAG FILL3A.735
! DIAGNOSE LIQUID WATER PATH*WEIGHT FOR STRATIFORM CLOUD FILL3A.736
& , NTOT_DIAG_FLAG AAJ3F404.100
! DIAGNOSE DROPLET CONCENTRATION*WEIGHT AAJ3F404.101
& , STRAT_LWC_DIAG_FLAG AAJ3F404.102
! DIAGNOSE STRATIFORM LWC*WEIGHT AAJ3F404.103
& , SO4_CCN_DIAG_FLAG AAJ3F404.104
! DIAGNOSE SO4 CCN MASS CONC*COND. SAMP. WEIGHT AAJ3F404.105
& , COND_SAMP_WGT_FLAG AAJ3F404.106
! DIAGNOSE CONDITIONAL SAMPLING WEIGHT AAJ3F404.107
! FILL3A.737
REAL FILL3A.738
& RE_CONV(NPD_FIELD, NCLDS) FILL3A.739
! EFFECTIVE RADIUS*WEIGHT FOR CONVECTIVE CLOUD FILL3A.740
& , RE_STRAT(NPD_FIELD, NCLDS) FILL3A.741
! EFFECTIVE RADIUS*WEIGHT FOR STRATIFORM CLOUD FILL3A.742
& , WGT_CONV(NPD_FIELD, NCLDS) FILL3A.743
! WEIGHT FOR CONVECTIVE CLOUD FILL3A.744
& , WGT_STRAT(NPD_FIELD, NCLDS) FILL3A.745
! WEIGHT FOR STRATIFORM CLOUD FILL3A.746
& , LWP_STRAT(NPD_FIELD, NCLDS) FILL3A.747
! LIQUID WATER PATH*WEIGHT FOR STRATIFORM CLOUD FILL3A.748
& , NTOT_DIAG(NPD_FIELD, NCLDS) AAJ3F404.108
! DROPLET CONCENTRATION*WEIGHT AAJ3F404.109
& , STRAT_LWC_DIAG(NPD_FIELD, NCLDS) AAJ3F404.110
! STRATIFORM LWC*WEIGHT AAJ3F404.111
& , SO4_CCN_DIAG(NPD_FIELD, NCLDS) AAJ3F404.112
! SO4 CCN MASS CONC*COND. SAMP. WEIGHT AAJ3F404.113
& , COND_SAMP_WGT(NPD_FIELD, NCLDS) AAJ3F404.114
! CONDITIONAL SAMPLING WEIGHT AAJ3F404.115
! AAJ3F404.116
! FILL3A.749
! FILL3A.750
! LOCAL VARIABLES: FILL3A.751
INTEGER FILL3A.752
& I FILL3A.753
! LOOP VARIABLE FILL3A.754
& , J ADB2F404.43
! LOOP VARIABLE ADB2F404.44
& , L FILL3A.755
! LOOP VARIABLE FILL3A.756
& , LG FILL3A.757
! INDEX TO GATHER FILL3A.758
LOGICAL ADB1F405.178
& L_GLACIATED_TOP(NPD_PROFILE) ADB1F405.179
! LOGICAL FOR GLACIATED TOPS IN CONVECTIVE CLOUD. ADB1F405.180
ADB1F405.181
! FILL3A.759
REAL FILL3A.760
& LIQ_FRAC(NPD_PROFILE) FILL3A.761
! FRACTION OF LIQUID CLOUD WATER FILL3A.762
& , LIQ_FRAC_CONV(NPD_PROFILE) FILL3A.763
! FRACTION OF LIQUID WATER IN CONVECTIVE CLOUD FILL3A.764
& , T_GATHER(NPD_PROFILE) FILL3A.765
! GATHERED TEMPERATURE FOR LSP_FOCWWIL FILL3A.766
& , T_LIST(NPD_PROFILE) FILL3A.767
! LIST OF TEMPERATURES FILL3A.768
& , TOTAL_MASS(NPD_PROFILE) FILL3A.769
! TOTAL MASS IN CONVECTIVE CLOUD FILL3A.770
& , CC_DEPTH(NPD_PROFILE) FILL3A.771
! DEPTH OF CONVECTIVE CLOUD FILL3A.772
& , CONDENSED_MIX_RAT_BULK(NPD_PROFILE, 0: NPD_LAYER ASK1F405.309
& , NPD_CLOUD_COMPONENT) ASK1F405.310
! MASS MIXING RATIOS OF CONDENSED COMPONENTS USING BULK CLD ASK1F405.311
& , DENSITY_AIR(NPD_PROFILE, NPD_LAYER) FILL3A.773
! DENSITY OF AIR ADB2F404.45
& , CONVECTIVE_CLOUD_LAYER(NPD_PROFILE) FILL3A.775
! AMOUNT OF CONVECTIVE CLOUD IN TH CURRENT LAYER FILL3A.776
& , MEAN_WATER_CONTENT FILL3A.781
! MEAN WATER CONTENT FILL3A.782
& , MEAN_ICE_CONTENT FILL3A.783
! MEAN ICE CONTENT FILL3A.784
& , CONDENSED_LIMIT FILL3A.785
! LOWER LIMIT ON WATER CONTENTS FILL3A.786
! FILL3A.787
PARAMETER(CONDENSED_LIMIT=1.E-8) FILL3A.788
! FILL3A.789
! FILL3A.790
! FILL3A.791
! CHECK THE LIMITS FOR CONVECTIVE CLOUD. FILL3A.792
DO L=1, N_PROFILE FILL3A.793
LG=I_GATHER(L) FILL3A.794
IF ( (CCB(LG).GT.NCLDS).OR.(CCB(LG).LT.1) ) CCB(LG)=1 FILL3A.795
IF ( (CCT(LG).GT.NCLDS+1).OR.(CCT(LG).LT.2) ) CCT(LG)=NCLDS+1 FILL3A.796
IF (L_3D_CCA) THEN AJX0F404.66
IF (CCA(LG,CCB(LG)).LT.TOL_TEST) CCCWP(LG)=0.0E+00 AJX0F404.67
ELSE AJX0F404.68
IF (CCA(LG,1).LT.TOL_TEST) CCCWP(LG)=0.0E+00 AJX0F404.69
ENDIF AJX0F404.70
ENDDO FILL3A.798
! FILL3A.799
! FILL3A.800
! SET THE COMPONENTS WITHIN THE CLOUDS. IN THE UNIFIED MODEL WE FILL3A.801
! HAVE FOUR COMPONENTS: STRATIFORM ICE AND WATER AND CONVECTIVE FILL3A.802
! ICE AND WATER. FILL3A.803
N_CONDENSED=4 FILL3A.804
TYPE_CONDENSED(1)=IP_CLCMP_ST_WATER FILL3A.805
TYPE_CONDENSED(2)=IP_CLCMP_ST_ICE FILL3A.806
TYPE_CONDENSED(3)=IP_CLCMP_CNV_WATER FILL3A.807
TYPE_CONDENSED(4)=IP_CLCMP_CNV_ICE FILL3A.808
! FILL3A.809
! FILL3A.810
! FILL3A.811
! SET THE TOTAL AMOUNTS OF CLOUD AND THE FRACTIONS COMPRISED BY FILL3A.812
! CONVECTIVE AND STRATIFORM COMPONENTS. FILL3A.813
! FILL3A.814
! ZERO THE AMOUNTS OF CLOUD IN THE UPPER LAYERS. FILL3A.815
DO I=1, NLEVS-NCLDS FILL3A.816
DO L=1, N_PROFILE FILL3A.817
W_CLOUD(L, I)=0.0E+00 FILL3A.818
ENDDO FILL3A.819
ENDDO FILL3A.820
! FILL3A.821
IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CONV_STRAT .AND. AYY1F404.403
& .NOT. L_CLOUD_WATER_PARTITION) THEN AYY1F404.404
! This cloud representation not available with new cloud microphysics AYY1F404.405
! FILL3A.823
! THE CLOUDS ARE DIVIDED INTO MIXED-PHASE STRATIFORM AND FILL3A.824
! CONVECTIVE CLOUDS: LSP_FOCWWIL GIVES THE PARTITIONING BETWEEN ADB1F405.182
! ICE AND WATER IN STRATIFORM CLOUDS AND IN CONVECTIVE CLOUD, ADB1F405.183
! UNLESS THE OPTION TO PARTITION AS A FUNCTION OF THE LOCAL ADB1F405.184
! TEMPERATURE IS SELECTED. WITHIN CONVECTIVE CLOUD THE LIQUID ADB1F405.185
! WATER CONTENT IS DISTRIBUTED UNIFORMLY THROUGHOUT THE CLOUD. ADB1F405.186
! FILL3A.829
! CONVECTIVE CLOUD: FILL3A.830
! FILL3A.831
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.832
DO L=1, N_PROFILE FILL3A.833
CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER)=0.0E+00 ASK1F405.312
CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE)=0.0E+00 ASK1F405.313
CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER)=0.0E+00 ASK1F405.314
CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_ICE)=0.0E+00 ASK1F405.315
ENDDO FILL3A.836
ENDDO FILL3A.837
! FILL3A.838
! FILL3A.841
IF (L_LOCAL_CNV_PARTITION) THEN ADB1F405.187
! ADB1F405.188
! PARTITION BETWEEN ICE AND WATER USING THE RELATIONSHIPS ADB1F405.189
! GIVEN IN BOWER ET AL. (1996, Q.J. 122 p 1815-1844). ICE ADB1F405.190
! IS ALLOWED IN A LAYER WARMER THAN THE FREEZING POINT ADB1F405.191
! ONLY IF THE TOP OF THE CLOUD IS GLACIATED. ADB1F405.192
! ADB1F405.193
DO L=1, N_PROFILE ADB1F405.194
IF (T(L, NLEVS+2-CCT(I_GATHER(L))).LT.TM) THEN ADB1F405.195
L_GLACIATED_TOP(L)=.TRUE. ADB1F405.196
ELSE ADB1F405.197
L_GLACIATED_TOP(L)=.FALSE. ADB1F405.198
ENDIF ADB1F405.199
ENDDO ADB1F405.200
ADB1F405.201
ELSE ADB1F405.202
! ADB1F405.203
! PARTITION BETWEEN ICE AND WATER AS DIRECTED BY THE ADB1F405.204
! TEMPERATURE IN THE MIDDLE OF THE TOP LAYER OF THE CLOUD. ADB1F405.205
! THE PARTITIONING MAY BE PRECALCULATED IN THIS CASE. ADB1F405.206
! ADB1F405.207
DO L=1, N_PROFILE ADB1F405.208
T_GATHER(L)=T(L, NLEVS+2-CCT(I_GATHER(L))) ADB1F405.209
ENDDO ADB1F405.210
CALL LSP_FOCWWIL(T_GATHER, N_PROFILE, LIQ_FRAC_CONV) ADB1F405.211
! ADB1F405.212
ENDIF ADB1F405.213
! ADB1F405.214
! ADB1F405.215
DO L=1, N_PROFILE FILL3A.842
TOTAL_MASS(L)=0.0E+00 FILL3A.851
ENDDO FILL3A.852
! FILL3A.853
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.46
DO L=1, N_PROFILE FILL3A.855
LG=I_GATHER(L) FILL3A.856
IF ( (CCT(LG).GE.NLEVS+2-I).AND. FILL3A.857
& (CCB(LG).LE.NLEVS+1-I) ) THEN FILL3A.858
TOTAL_MASS(L)=TOTAL_MASS(L)+D_MASS(L, I) FILL3A.859
ENDIF FILL3A.860
ENDDO FILL3A.861
ENDDO FILL3A.862
! ADB1F405.216
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.47
DO L=1, N_PROFILE FILL3A.864
LG=I_GATHER(L) FILL3A.865
IF ( (CCT(LG).GE.NLEVS+2-I).AND. FILL3A.866
& (CCB(LG).LE.NLEVS+1-I) ) THEN FILL3A.867
IF (L_LOCAL_CNV_PARTITION) THEN ADB1F405.217
! THE PARTITIONING IS RECALCULATED FOR EACH LAYER ADB1F405.218
! OTHERWISE A GENERIC VALUE IS USED. ADB1F405.219
LIQ_FRAC_CONV(L)=MAX(0.0E+00, MIN(1.0E+00 ADB1F405.220
& , 1.61E-02*(T(L, I)-TM)+8.9E-01)) ADB1F405.221
IF ((T(L, I).GT.TM).AND.(.NOT.L_GLACIATED_TOP(L))) ADB1F405.222
& LIQ_FRAC_CONV(L)=1.0E+00 ADB1F405.223
ENDIF ADB1F405.224
CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER) ASK1F405.316
& =CCCWP(LG)*LIQ_FRAC_CONV(L) ADB1F405.225
& /(TOTAL_MASS(L)+TOL_MACHINE) FILL3A.870
CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE) ASK1F405.317
& =CCCWP(LG)*(1.0E+00-LIQ_FRAC_CONV(L)) ADB1F405.226
& /(TOTAL_MASS(L)+TOL_MACHINE) FILL3A.873
CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER) ASK1F405.318
& =CCCWP(LG)*LIQ_FRAC_CONV(L) ASK1F405.319
& /(TOTAL_MASS(L)+TOL_MACHINE) ASK1F405.320
CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_ICE) ASK1F405.321
& =CCCWP(LG)*(1.0-LIQ_FRAC_CONV(L)) ASK1F405.322
& /(TOTAL_MASS(L)+TOL_MACHINE) ASK1F405.323
ENDIF FILL3A.874
ENDDO FILL3A.875
ENDDO FILL3A.876
! FILL3A.877
! FILL3A.878
! STRATIFORM CLOUDS: FILL3A.879
! FILL3A.880
! PARTITION BETWEEN ICE AND WATER DEPENDING ON THE FILL3A.881
! LOCAL TEMPERATURE. FILL3A.882
! FILL3A.883
DO I=1, NCLDS FILL3A.889
CALL LSP_FOCWWIL(T(L, NLEVS+1-I), N_PROFILE, LIQ_FRAC) ADB1F401.245
DO L=1, N_PROFILE FILL3A.890
LG=I_GATHER(L) FILL3A.891
IF (LCA_AREA(LG, I).GT.TOL_TEST) THEN ASK1F405.324
CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.325
& =(LCCWC1(LG, I)+LCCWC2(LG, I)) FILL3A.894
& *LIQ_FRAC(L)/LCA_AREA(LG, I) ASK1F405.326
CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I, IP_CLCMP_ST_ICE) ASK1F405.327
& =(LCCWC1(LG, I)+LCCWC2(LG, I)) FILL3A.897
& *(1.0E+00-LIQ_FRAC(L))/LCA_AREA(LG, I) ASK1F405.328
ELSE FILL3A.899
CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.329
& =0.0E+00 FILL3A.901
CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I, IP_CLCMP_ST_ICE) ASK1F405.330
& =0.0E+00 FILL3A.903
ENDIF FILL3A.904
! ASK1F405.331
IF (LCA_BULK(LG, I).GT.TOL_TEST) THEN ASK1F405.332
CONDENSED_MIX_RAT_BULK(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.333
& =(LCCWC1(LG, I)+LCCWC2(LG, I)) ASK1F405.334
& *LIQ_FRAC(L)/LCA_BULK(LG, I) ASK1F405.335
CONDENSED_MIX_RAT_BULK(L, NLEVS+1-I, IP_CLCMP_ST_ICE) ASK1F405.336
& =(LCCWC1(LG, I)+LCCWC2(LG, I)) ASK1F405.337
& *(1.0E+00-LIQ_FRAC(L))/LCA_BULK(LG, I) ASK1F405.338
ELSE ASK1F405.339
CONDENSED_MIX_RAT_BULK(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.340
& =0.0E+00 ASK1F405.341
CONDENSED_MIX_RAT_BULK(L, NLEVS+1-I, IP_CLCMP_ST_ICE) ASK1F405.342
& =0.0E+00 ASK1F405.343
ENDIF ASK1F405.344
ENDDO FILL3A.905
ENDDO FILL3A.906
! FILL3A.907
! FILL3A.908
! CLOUD FRACTIONS: FILL3A.909
! FILL3A.910
IF (L_3D_CCA) THEN AJX0F404.71
DO I=1, NCLDS FILL3A.911
DO L=1, N_PROFILE FILL3A.912
LG=I_GATHER(L) FILL3A.913
W_CLOUD(L, NLEVS+1-I) AJX0F404.72
& =CCA(LG,I)+(1.0E+00-CCA(LG,I))*LCA_AREA(LG, I) ASK1F405.345
FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_CONV) AJX0F404.74
& =CCA(LG,I)/(W_CLOUD(L, NLEVS+1-I)+TOL_MACHINE) AJX0F404.75
FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_STRAT) AJX0F404.76
& =1.0E+00-FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_CONV) AJX0F404.77
ENDDO AJX0F404.78
ENDDO AJX0F404.79
ELSE AJX0F404.80
DO I=1, NCLDS AJX0F404.81
DO L=1, N_PROFILE AJX0F404.82
LG=I_GATHER(L) AJX0F404.83
IF ( (I.LE.CCT(LG)-1).AND.(I.GE.CCB(LG)) ) THEN FILL3A.914
W_CLOUD(L, NLEVS+1-I) FILL3A.915
& =CCA(LG,1)+(1.0E+00-CCA(LG,1))*LCA_AREA(LG, I) ASK1F405.346
FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_CONV) FILL3A.917
& =CCA(LG,1)/(W_CLOUD(L, NLEVS+1-I)+TOL_MACHINE) AJX0F404.85
ELSE FILL3A.919
W_CLOUD(L, NLEVS+1-I)=LCA_AREA(LG, I) ASK1F405.347
FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_CONV)=0.0E+00 FILL3A.921
ENDIF FILL3A.922
FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_STRAT) FILL3A.923
& =1.0E+00-FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_CONV) FILL3A.924
ENDDO FILL3A.925
ENDDO FILL3A.926
ENDIF AJX0F404.86
! FILL3A.927
! REMOVE VERY THIN CLOUDS TO PREVENT FILL3A.928
! PROBLEMS OF ILL-CONDITIONING. FILL3A.929
! FILL3A.930
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.931
DO L=1, N_PROFILE FILL3A.932
MEAN_WATER_CONTENT FILL3A.933
& =CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_ST_WATER) ASK1F405.348
& +(CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER) ASK1F405.349
& -CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_ST_WATER)) ASK1F405.350
& *FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CONV) FILL3A.937
MEAN_ICE_CONTENT FILL3A.938
& =CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_ST_ICE) ASK1F405.351
& +(CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE) ASK1F405.352
& -CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_ST_ICE)) ASK1F405.353
& *FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CONV) FILL3A.942
IF ( (MEAN_WATER_CONTENT.LT.CONDENSED_LIMIT) FILL3A.943
& .AND.(MEAN_ICE_CONTENT.LT.CONDENSED_LIMIT) ) THEN FILL3A.944
W_CLOUD(L, I)=0.0E+00 FILL3A.945
ENDIF FILL3A.946
ENDDO FILL3A.947
ENDDO FILL3A.948
! FILL3A.949
! FILL3A.950
! FILL3A.951
! FILL3A.952
ELSE IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CSIW) THEN FILL3A.953
! FILL3A.954
! HERE THE CLOUDS ARE SPLIT INTO FOUR SEPARATE TYPES. FILL3A.955
! THE PARTITIONING BETWEEN ICE AND WATER IS REGARDED AS ADB1F405.227
! DETERMINING THE AREAS WITHIN THE GRID_BOX COVERED BY ADB1F405.228
! ICE OR WATER CLOUD, RATHER THAN AS DETERMINING THE IN-CLOUD ADB1F405.229
! MIXING RATIOS. THE GRID-BOX MEAN ICE WATER CONTENTS IN ADB1F405.230
! STRATIFORM CLOUDS MAY BE PREDICTED BY THE ICE MICROPHYSICS ADB1F405.231
! SCHEME OR MAY BE DETERMINED AS A FUNCTION OF THE TEMPERATURE ADB1F405.232
! (LSP_FOCWWIL). IN CONVECTIVE CLOUDS THE PARTITIONING MAY BE ADB1F405.233
! DONE USING THE SAME FUNCTION, LSP_FOCWWIL, BASED ON A SINGLE ADB1F405.234
! TEMPERATURE, OR USING A PARTITION BASED ON THE LOCAL ADB1F405.235
! TEMPERATURE. ADB1F405.236
! FILL3A.959
! CONVECTIVE CLOUD: FILL3A.960
! FILL3A.961
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.962
DO L=1, N_PROFILE FILL3A.963
CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER)=0.0E+00 ASK1F405.354
CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE)=0.0E+00 ASK1F405.355
CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER)=0.0E+00 ASK1F405.356
CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_ICE)=0.0E+00 ASK1F405.357
ENDDO FILL3A.966
ENDDO FILL3A.967
! FILL3A.968
DO L=1, N_PROFILE FILL3A.969
TOTAL_MASS(L)=0.0E+00 FILL3A.970
ENDDO FILL3A.971
! FILL3A.972
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.48
DO L=1, N_PROFILE FILL3A.974
LG=I_GATHER(L) FILL3A.975
IF ( (CCT(LG).GE.NLEVS+2-I).AND. FILL3A.976
& (CCB(LG).LE.NLEVS+1-I) ) THEN FILL3A.977
TOTAL_MASS(L)=TOTAL_MASS(L)+D_MASS(L, I) FILL3A.978
ENDIF FILL3A.979
ENDDO FILL3A.980
ENDDO FILL3A.981
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.49
DO L=1, N_PROFILE FILL3A.983
LG=I_GATHER(L) FILL3A.984
IF ( (CCT(LG).GE.NLEVS+2-I).AND. FILL3A.985
& (CCB(LG).LE.NLEVS+1-I) ) THEN FILL3A.986
CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER) ASK1F405.358
& =CCCWP(LG)/(TOTAL_MASS(L)+TOL_MACHINE) FILL3A.988
CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE) ASK1F405.359
& =CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER) ASK1F405.360
CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER) ASK1F405.361
& =CCCWP(LG)/(TOTAL_MASS(L)+TOL_MACHINE) ASK1F405.362
CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_ICE) ASK1F405.363
& =CONDENSED_MIX_RAT_BULK(L, I, IP_CLCMP_CNV_WATER) ASK1F405.364
ENDIF FILL3A.991
ENDDO FILL3A.992
ENDDO FILL3A.993
! FILL3A.994
! STRATIFORM CLOUDS: FILL3A.995
! FILL3A.996
DO I=1, NCLDS FILL3A.997
DO L=1, N_PROFILE FILL3A.998
LG=I_GATHER(L) FILL3A.999
IF (LCA_AREA(LG, I).GT.TOL_TEST) THEN ASK1F405.365
CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.366
& =(LCCWC1(LG, I)+LCCWC2(LG, I))/LCA_AREA(LG, I) ASK1F405.367
CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I, IP_CLCMP_ST_ICE) ASK1F405.368
& =CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.369
ELSE FILL3A.1005
CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.370
& =0.0E+00 FILL3A.1007
CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I, IP_CLCMP_ST_ICE) ASK1F405.371
& =0.0E+00 FILL3A.1009
ENDIF FILL3A.1010
! ASK1F405.372
IF (LCA_BULK(LG, I).GT.TOL_TEST) THEN ASK1F405.373
CONDENSED_MIX_RAT_BULK(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.374
& =(LCCWC1(LG, I)+LCCWC2(LG, I))/LCA_BULK(LG, I) ASK1F405.375
CONDENSED_MIX_RAT_BULK(L, NLEVS+1-I, IP_CLCMP_ST_ICE) ASK1F405.376
& =CONDENSED_MIX_RAT_BULK(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.377
ELSE ASK1F405.378
CONDENSED_MIX_RAT_BULK(L, NLEVS+1-I, IP_CLCMP_ST_WATER) ASK1F405.379
& =0.0E+00 ASK1F405.380
CONDENSED_MIX_RAT_BULK(L, NLEVS+1-I, IP_CLCMP_ST_ICE) ASK1F405.381
& =0.0E+00 ASK1F405.382
ENDIF ASK1F405.383
ENDDO FILL3A.1011
ENDDO FILL3A.1012
! FILL3A.1013
! FILL3A.1014
! CLOUD FRACTIONS: FILL3A.1015
! FILL3A.1016
IF (L_LOCAL_CNV_PARTITION) THEN ADB1F405.237
! ADB1F405.238
! PARTITION BETWEEN ICE AND WATER USING THE RELATIONSHIPS ADB1F405.239
! GIVEN IN BOWER ET AL. (1996, Q.J. 122 p 1815-1844). ICE ADB1F405.240
! IS ALLOWED IN A LAYER WARMER THAN THE FREEZING POINT ADB1F405.241
! ONLY IF THE TOP OF THE CLOUD IS GLACIATED. ADB1F405.242
! ADB1F405.243
DO L=1, N_PROFILE ADB1F405.244
IF (T(L, NLEVS+2-CCT(I_GATHER(L))).LT.TM) THEN ADB1F405.245
L_GLACIATED_TOP(L)=.TRUE. ADB1F405.246
ELSE ADB1F405.247
L_GLACIATED_TOP(L)=.FALSE. ADB1F405.248
ENDIF ADB1F405.249
ENDDO ADB1F405.250
ADB1F405.251
ELSE ADB1F405.252
! ADB1F405.253
! PARTITION BETWEEN ICE AND WATER AS DIRECTED BY THE ADB1F405.254
! TEMPERATURE IN THE MIDDLE OF THE TOP LAYER OF THE CLOUD. ADB1F405.255
! THE PARTITIONING MAY BE PRECALCULATED IN THIS CASE. ADB1F405.256
! ADB1F405.257
DO L=1, N_PROFILE ADB1F405.258
T_GATHER(L)=T(L, NLEVS+2-CCT(I_GATHER(L))) ADB1F405.259
ENDDO ADB1F405.260
CALL LSP_FOCWWIL(T_GATHER, N_PROFILE, LIQ_FRAC_CONV) ADB1F405.261
! ADB1F405.262
ENDIF ADB1F405.263
! FILL3A.1023
! FILL3A.1024
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1025
! FILL3A.1026
IF (.NOT. L_CLOUD_WATER_PARTITION) AYY1F404.406
! PARTITION STRATIFORM CLOUDS USING THE LOCAL TEMPERATURE. FILL3A.1027
& CALL LSP_FOCWWIL(T(1, I), N_PROFILE, LIQ_FRAC) AYY1F404.407
! FILL3A.1029
IF (L_3D_CCA) THEN AJX0F404.87
DO L=1, N_PROFILE FILL3A.1030
LG=I_GATHER(L) FILL3A.1031
CONVECTIVE_CLOUD_LAYER(L)=CCA(LG,NLEVS+1-I) AJX4F405.4
ENDDO AJX0F404.89
ELSE AJX0F404.90
DO L=1, N_PROFILE AJX0F404.91
LG=I_GATHER(L) AJX0F404.92
IF ( (CCT(LG).GE.NLEVS+2-I).AND. FILL3A.1033
& (CCB(LG).LE.NLEVS+1-I) ) THEN FILL3A.1034
CONVECTIVE_CLOUD_LAYER(L)=CCA(LG,1) AJX0F404.93
ELSE FILL3A.1036
CONVECTIVE_CLOUD_LAYER(L)=0.0E+00 FILL3A.1037
ENDIF FILL3A.1038
ENDDO AJX0F404.94
ENDIF AJX0F404.95
! FILL3A.1039
DO L=1, N_PROFILE AJX0F404.96
LG=I_GATHER(L) AJX0F404.97
W_CLOUD(L, I) FILL3A.1040
& =CONVECTIVE_CLOUD_LAYER(L) FILL3A.1041
& +(1.0E+00-CONVECTIVE_CLOUD_LAYER(L)) FILL3A.1042
& *LCA_AREA(LG, NLEVS+1-I) ASK1F405.384
! AYY1F404.408
IF (L_CLOUD_WATER_PARTITION) THEN AYY1F404.409
! PARTITION STRATIFORM CLOUDS USING THE RATIO OF CLOUD WATER CONTENTS. AYY1F404.410
IF (LCA_AREA(LG, NLEVS+1-I).GT.TOL_TEST) THEN ASK1F405.385
LIQ_FRAC(L) = LCCWC1(LG, NLEVS+1-I) / AYY1F404.412
& (LCCWC1(LG, NLEVS+1-I) + LCCWC2(LG, NLEVS+1-I)) AYY1F404.413
ELSE AYY1F404.414
LIQ_FRAC(L) = 0.0E+00 AYY1F404.415
ENDIF AYY1F404.416
ENDIF AYY1F404.417
! FILL3A.1044
IF (L_LOCAL_CNV_PARTITION) THEN ADB1F405.264
! ADB1F405.265
! THE PARTITIONING BETWEEN ICE AND WATER MUST BE ADB1F405.266
! RECALCULATED FOR THIS LAYER AS A FUNCTION OF THE ADB1F405.267
! LOCAL TEMPERATURE, BUT ICE IS ALLOWED ABOVE THE ADB1F405.268
! FREEZING POINT ONLY IF THE TOP OF THE CLOUD IS i ADB1F405.269
! GLACIATED. ADB1F405.270
LIQ_FRAC_CONV(L)=MAX(0.0E+00, MIN(1.0E+00 ADB1F405.271
& , 1.61E-02*(T(L, I)-TM)+8.9E-01)) ADB1F405.272
IF ( (T(L, I).GT.TM).AND. ADB1F405.273
& .NOT.L_GLACIATED_TOP(L) ) THEN ADB1F405.274
LIQ_FRAC_CONV(L)=1.0E+00 ADB1F405.275
ENDIF ADB1F405.276
ADB1F405.277
ENDIF ADB1F405.278
! ADB1F405.279
FRAC_CLOUD(L, I, IP_CLOUD_TYPE_SW) FILL3A.1045
& =LIQ_FRAC(L)*(1.0E+00-CONVECTIVE_CLOUD_LAYER(L)) FILL3A.1046
& *LCA_AREA(LG, NLEVS+1-I) ASK1F405.386
& /(W_CLOUD(L, I)+TOL_MACHINE) FILL3A.1048
FRAC_CLOUD(L, I, IP_CLOUD_TYPE_SI) FILL3A.1049
& =(1.0E+00-LIQ_FRAC(L)) FILL3A.1050
& *(1.0E+00-CONVECTIVE_CLOUD_LAYER(L)) FILL3A.1051
& *LCA_AREA(LG, NLEVS+1-I)/(W_CLOUD(L, I)+TOL_MACHINE) ASK1F405.387
FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CW) FILL3A.1053
& =LIQ_FRAC_CONV(L)*CONVECTIVE_CLOUD_LAYER(L) FILL3A.1054
& /(W_CLOUD(L, I)+TOL_MACHINE) FILL3A.1055
FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CI) FILL3A.1056
& =(1.0E+00-LIQ_FRAC_CONV(L))*CONVECTIVE_CLOUD_LAYER(L) FILL3A.1057
& /(W_CLOUD(L, I)+TOL_MACHINE) FILL3A.1058
! FILL3A.1059
ENDDO FILL3A.1060
ENDDO FILL3A.1061
! FILL3A.1062
! FILL3A.1063
! REMOVE VERY THIN CLOUDS TO PREVENT FILL3A.1064
! PROBLEMS OF ILL-CONDITIONING. FILL3A.1065
! FILL3A.1066
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1067
DO L=1, N_PROFILE FILL3A.1068
MEAN_WATER_CONTENT FILL3A.1069
& =CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_ST_WATER) ASK1F405.388
& *FRAC_CLOUD(L, I, IP_CLOUD_TYPE_SW) FILL3A.1071
& +CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_WATER) ASK1F405.389
& *FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CW) FILL3A.1073
MEAN_ICE_CONTENT FILL3A.1074
& =CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_ST_ICE) ASK1F405.390
& *FRAC_CLOUD(L, I, IP_CLOUD_TYPE_SI) FILL3A.1076
& +CONDENSED_MIX_RAT_AREA(L, I, IP_CLCMP_CNV_ICE) ASK1F405.391
& *FRAC_CLOUD(L, I, IP_CLOUD_TYPE_CI) FILL3A.1078
IF ( (MEAN_WATER_CONTENT.LT.CONDENSED_LIMIT) FILL3A.1079
& .AND.(MEAN_ICE_CONTENT.LT.CONDENSED_LIMIT) ) THEN FILL3A.1080
W_CLOUD(L, I)=0.0E+00 FILL3A.1081
ENDIF FILL3A.1082
ENDDO FILL3A.1083
ENDDO FILL3A.1084
! FILL3A.1085
! FILL3A.1086
ENDIF FILL3A.1087
! FILL3A.1088
! FILL3A.1089
! FILL3A.1090
! EFFECTIVE RADII OF WATER CLOUDS: A MICROPHYSICAL PARAMETRIZATION ADB2F404.50
! IS AVAILABLE; OTHERWISE STANDARD VALUES ARE USED. ADB2F404.51
! FILL3A.1093
IF (L_MICROPHYSICS) THEN FILL3A.1094
! FILL3A.1095
! STANDARD VALUES ARE USED FOR ICE CRYSTALS, BUT FILL3A.1096
! A PARAMETRIZATION PROVIDED BY UMIST AND MRF FILL3A.1097
! IS USED FOR DROPLETS. FILL3A.1098
! FILL3A.1099
! CALCULATE THE DENSITY OF AIR. ADB2F404.52
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1101
DO L=1, N_PROFILE FILL3A.1102
DENSITY_AIR(L, I)=P(L, I)/(R*T(L, I)) FILL3A.1103
ENDDO FILL3A.1104
ENDDO FILL3A.1105
! FILL3A.1106
DO L=1, N_PROFILE FILL3A.1107
CC_DEPTH(L)=0.0E+00 FILL3A.1108
ENDDO FILL3A.1109
! FILL3A.1110
DO L=1, N_PROFILE FILL3A.1111
LG=I_GATHER(L) FILL3A.1112
DO I=NLEVS+2-CCT(LG), NLEVS+1-CCB(LG) FILL3A.1113
CC_DEPTH(L)=CC_DEPTH(L)+D_MASS(L, I)/DENSITY_AIR(L, I) FILL3A.1114
ENDDO FILL3A.1115
ENDDO FILL3A.1116
! FILL3A.1117
CALL R2_RE_MRF_UMIST(N_PROFILE, NLEVS, NCLDS FILL3A.1125
& , I_GATHER AYY1F404.418
& , L_AEROSOL_CCN AYY1F404.419
& , ACCUM_SULPHATE, DISS_SULPHATE AYY1F404.420
& , I_CLOUD_REPRESENTATION FILL3A.1127
& , LAND_G, DENSITY_AIR, CONDENSED_MIX_RAT_BULK, CC_DEPTH ASK1F405.392
& , CONDENSED_DIM_CHAR AAJ3F404.117
& , NTOT_DIAG_G AAJ3F404.118
& , STRAT_LWC_DIAG_G AAJ3F404.119
& , SO4_CCN_DIAG_G AAJ3F404.120
& , SULP_DIM1, SULP_DIM2 AYY1F404.421
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_AEROSOL_SPECIES AYY1F404.422
& ) FILL3A.1131
! ADB2F404.53
! CONSTRAIN THE SIZES OF DROPLETS TO LIE WITHIN THE RANGE OF ADB2F404.54
! VALIDITY OF THE PARAMETRIZATION SCHEME. ADB2F404.55
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.56
DO L=1, N_PROFILE ADB2F404.57
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_WATER) ADB2F404.58
& =MAX(CONDENSED_MIN_DIM(IP_CLCMP_ST_WATER) ADB2F404.59
& , MIN(CONDENSED_MAX_DIM(IP_CLCMP_ST_WATER) ADB2F404.60
& , CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_WATER))) ADB2F404.61
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_WATER) ADB2F404.62
& =MAX(CONDENSED_MIN_DIM(IP_CLCMP_CNV_WATER) ADB2F404.63
& , MIN(CONDENSED_MAX_DIM(IP_CLCMP_CNV_WATER) ADB2F404.64
& , CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_WATER))) ADB2F404.65
ENDDO ADB2F404.66
ENDDO ADB2F404.67
! FILL3A.1132
! FILL3A.1133
! SET MICROPHYSICAL DIAGNOSTICS. WEIGHTS FOR CLOUD CALCULATED FILL3A.1134
! HERE ARE USED SOLELY FOR THE MICROPHYSICS AND DO NOT HAVE FILL3A.1135
! AN INDEPENDENT MEANING. FILL3A.1136
! FILL3A.1137
IF (WGT_CONV_FLAG) THEN FILL3A.1138
IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CONV_STRAT) THEN FILL3A.1139
DO I=1, NCLDS FILL3A.1140
DO L=1, N_PROFILE FILL3A.1141
LG=I_GATHER(L) FILL3A.1142
WGT_CONV(LG, I)=W_CLOUD(L, NLEVS+1-I) FILL3A.1143
& *FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_CONV) FILL3A.1144
ENDDO FILL3A.1145
ENDDO FILL3A.1146
ELSE IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CSIW) THEN FILL3A.1147
DO I=1, NCLDS FILL3A.1148
DO L=1, N_PROFILE FILL3A.1149
LG=I_GATHER(L) FILL3A.1150
WGT_CONV(LG, I)=W_CLOUD(L, NLEVS+1-I) FILL3A.1151
& *FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_CW) FILL3A.1152
ENDDO FILL3A.1153
ENDDO FILL3A.1154
ENDIF FILL3A.1155
ENDIF FILL3A.1156
! FILL3A.1157
IF (RE_CONV_FLAG) THEN FILL3A.1158
DO I=1, NCLDS FILL3A.1159
DO L=1, N_PROFILE FILL3A.1160
LG=I_GATHER(L) FILL3A.1161
! EFFECTIVE RADII ARE GIVEN IN MICRONS. FILL3A.1162
RE_CONV(LG, I) FILL3A.1163
& =CONDENSED_DIM_CHAR(L, NLEVS+1-I ADB2F404.68
& , IP_CLCMP_CNV_WATER) ADB2F404.69
& *WGT_CONV(LG, I)*1.0E+06 FILL3A.1165
ENDDO FILL3A.1166
ENDDO FILL3A.1167
ENDIF FILL3A.1168
! FILL3A.1169
IF (WGT_STRAT_FLAG) THEN FILL3A.1170
IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CONV_STRAT) THEN FILL3A.1171
DO I=1, NCLDS FILL3A.1172
DO L=1, N_PROFILE FILL3A.1173
LG=I_GATHER(L) FILL3A.1174
WGT_STRAT(LG, I)=W_CLOUD(L, NLEVS+1-I) FILL3A.1175
& *FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_STRAT) FILL3A.1176
ENDDO FILL3A.1177
ENDDO FILL3A.1178
ELSE IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CSIW) THEN FILL3A.1179
DO I=1, NCLDS FILL3A.1180
DO L=1, N_PROFILE FILL3A.1181
LG=I_GATHER(L) FILL3A.1182
WGT_STRAT(LG, I)=W_CLOUD(L, NLEVS+1-I) FILL3A.1183
& *FRAC_CLOUD(L, NLEVS+1-I, IP_CLOUD_TYPE_SW) FILL3A.1184
ENDDO FILL3A.1185
ENDDO FILL3A.1186
ENDIF FILL3A.1187
ENDIF FILL3A.1188
! FILL3A.1189
IF (RE_STRAT_FLAG) THEN FILL3A.1190
DO I=1, NCLDS FILL3A.1191
DO L=1, N_PROFILE FILL3A.1192
LG=I_GATHER(L) FILL3A.1193
! EFFECTIVE RADII ARE GIVEN IN MICRONS. FILL3A.1194
RE_STRAT(LG, I) FILL3A.1195
& =CONDENSED_DIM_CHAR(L, NLEVS+1-I ADB2F404.70
& , IP_CLCMP_ST_WATER) ADB2F404.71
& *WGT_STRAT(LG, I)*1.0E+06 FILL3A.1197
ENDDO FILL3A.1198
ENDDO FILL3A.1199
ENDIF FILL3A.1200
FILL3A.1201
IF (LWP_STRAT_FLAG) THEN FILL3A.1202
DO I=1, NCLDS FILL3A.1203
DO L=1, N_PROFILE FILL3A.1204
LG=I_GATHER(L) FILL3A.1205
LWP_STRAT(LG, I) FILL3A.1206
& =CONDENSED_MIX_RAT_AREA(L, NLEVS+1-I ASK1F405.393
& , IP_CLCMP_ST_WATER)*D_MASS(L, NLEVS+1-I) FILL3A.1208
& *WGT_STRAT(LG, I) FILL3A.1209
ENDDO FILL3A.1210
ENDDO FILL3A.1211
ENDIF FILL3A.1212
AAJ3F404.121
IF (NTOT_DIAG_FLAG) THEN AAJ3F404.122
DO I=1, NCLDS AAJ3F404.123
DO L=1, N_PROFILE AAJ3F404.124
LG=I_GATHER(L) AAJ3F404.125
NTOT_DIAG(LG, I) AAJ3F404.126
& =NTOT_DIAG_G(L, NLEVS+1-I)*WGT_STRAT(LG, I) AAJ3F404.127
ENDDO AAJ3F404.128
ENDDO AAJ3F404.129
ENDIF AAJ3F404.130
AAJ3F404.131
IF (STRAT_LWC_DIAG_FLAG) THEN AAJ3F404.132
DO I=1, NCLDS AAJ3F404.133
DO L=1, N_PROFILE AAJ3F404.134
LG=I_GATHER(L) AAJ3F404.135
STRAT_LWC_DIAG(LG, I) AAJ3F404.136
& =STRAT_LWC_DIAG_G(L, NLEVS+1-I)*WGT_STRAT(LG, I) AAJ3F404.137
ENDDO AAJ3F404.138
ENDDO AAJ3F404.139
ENDIF AAJ3F404.140
AAJ3F404.141
! Non-cloud diagnostics are "weighted" by the conditional sampling AAJ3F404.142
! weight COND_SAMP_WGT, but as this is 1.0 if the SW radiation is AAJ3F404.143
! active, and 0.0 if it is not, there is no need to actually AAJ3F404.144
! multiply by it. AAJ3F404.145
AAJ3F404.146
IF (COND_SAMP_WGT_FLAG) THEN AAJ3F404.147
DO I=1, NCLDS AAJ3F404.148
DO L=1, N_PROFILE AAJ3F404.149
LG=I_GATHER(L) AAJ3F404.150
COND_SAMP_WGT(LG, I)=1.0 AAJ3F404.151
ENDDO AAJ3F404.152
ENDDO AAJ3F404.153
ENDIF AAJ3F404.154
AAJ3F404.155
IF (SO4_CCN_DIAG_FLAG) THEN AAJ3F404.156
DO I=1, NCLDS AAJ3F404.157
DO L=1, N_PROFILE AAJ3F404.158
LG=I_GATHER(L) AAJ3F404.159
SO4_CCN_DIAG(LG, I) AAJ3F404.160
& =SO4_CCN_DIAG_G(L, NLEVS+1-I) AAJ3F404.161
ENDDO AAJ3F404.162
ENDDO AAJ3F404.163
ENDIF AAJ3F404.164
! FILL3A.1213
! FILL3A.1214
ELSE FILL3A.1215
! FILL3A.1216
! ALL EFFECTIVE RADII ARE SET TO STANDARD VALUES. FILL3A.1217
! FILL3A.1218
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1219
DO L=1, N_PROFILE FILL3A.1220
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_WATER)=7.E-6 ADB2F404.72
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_WATER)=7.E-6 ADB2F404.73
ENDDO FILL3A.1225
ENDDO FILL3A.1226
! FILL3A.1227
ENDIF FILL3A.1228
! ADB2F404.74
! ADB2F404.75
! ADB2F404.76
! SET THE CHARACTERISTIC DIMENSIONS OF ICE CRYSTALS: ADB2F404.77
! ADB2F404.78
! ICE CRYSTALS IN STRATIFORM CLOUDS: ADB2F404.79
! ADB2F404.80
IF (I_CONDENSED_PARAM(IP_CLCMP_ST_ICE).EQ. ADB2F404.81
& IP_SLINGO_SCHRECKER_ICE) THEN ADB2F404.82
! ADB2F404.83
! THIS PARAMETRIZATION IS BASED ON THE EFFECTIVE RADIUS ADB2F404.84
! AND A STANDARD VALUE OF 30-MICRONS IS ASSUMED. ADB2F404.85
! ADB2F404.86
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.87
DO L=1, N_PROFILE ADB2F404.88
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE)=30.E-6 ADB2F404.89
ENDDO ADB2F404.90
ENDDO ADB2F404.91
! ADB2F404.92
ELSE IF (I_CONDENSED_PARAM(IP_CLCMP_ST_ICE).EQ. ADB2F404.93
& IP_ICE_ADT) THEN ADB2F404.94
! ADB2F404.95
! THIS PARAMETRIZATION IS BASED ON THE MEAN MAXIMUM ADB2F404.96
! DIMENSION OF THE CRYSTAL, DETERMINED AS A FUNCTION OF ADB2F404.97
! THE LOCAL TEMPERATURE. THE SIZE IS LIMITED TO ITS VALUE ADB2F404.98
! AT THE FREEZING LEVEL. ADB2F404.99
! ADB2F404.100
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.101
DO L=1, N_PROFILE ADB2F404.102
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE) ADB2F404.103
& =MIN(7.198755E-04 ADB2F404.104
& , EXP(5.522E-02*(T(L, I)-2.7965E+02))/9.702E+02) ADB2F404.105
ENDDO ADB2F404.106
ENDDO ADB2F404.107
! ADB2F404.108
ENDIF ADB2F404.109
! ADB2F404.110
! ADB2F404.111
! ICE CRYSTALS IN CONVECTIVE CLOUDS: ADB2F404.112
! ADB2F404.113
IF (I_CONDENSED_PARAM(IP_CLCMP_CNV_ICE).EQ. ADB2F404.114
& IP_SLINGO_SCHRECKER_ICE) THEN ADB2F404.115
! ADB2F404.116
! THIS PARAMETRIZATION IS BASED ON THE EFFECTIVE RADIUS ADB2F404.117
! AND A STANDARD VALUE OF 30-MICRONS IS ASSUMED. ADB2F404.118
! ADB2F404.119
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.120
DO L=1, N_PROFILE ADB2F404.121
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE)=30.E-6 ADB2F404.122
ENDDO ADB2F404.123
ENDDO ADB2F404.124
! ADB2F404.125
ELSE IF (I_CONDENSED_PARAM(IP_CLCMP_CNV_ICE).EQ. ADB2F404.126
& IP_ICE_ADT) THEN ADB2F404.127
! ADB2F404.128
! THIS PARAMETRIZATION IS BASED ON THE MEAN MAXIMUM ADB2F404.129
! DIMENSION OF THE CRYSTAL, DETERMINED AS A FUNCTION OF ADB2F404.130
! THE LOCAL TEMPERATURE. THE SIZE IS LIMITED TO ITS VALUE ADB2F404.131
! AT THE FREEZING LEVEL. ADB2F404.132
! ADB2F404.133
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.134
DO L=1, N_PROFILE ADB2F404.135
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE) ADB2F404.136
& =MIN(7.198755E-04 ADB2F404.137
& , EXP(5.522E-02*(T(L, I)-2.7965E+02))/9.702E+02) ADB2F404.138
ENDDO ADB2F404.139
ENDDO ADB2F404.140
! ADB2F404.141
ENDIF ADB2F404.142
! ADB2F404.143
! ADB2F404.144
! ADB2F404.145
! CONSTRAIN THE SIZES OF ICE CRYSTALS TO LIE WITHIN THE RANGE ADB2F404.146
! OF VALIDITY OF THE PARAMETRIZATION SCHEME. ADB2F404.147
DO I=NLEVS+1-NCLDS, NLEVS ADB2F404.148
DO L=1, N_PROFILE ADB2F404.149
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE) ADB2F404.150
& =MAX(CONDENSED_MIN_DIM(IP_CLCMP_ST_ICE) ADB2F404.151
& , MIN(CONDENSED_MAX_DIM(IP_CLCMP_ST_ICE) ADB2F404.152
& , CONDENSED_DIM_CHAR(L, I, IP_CLCMP_ST_ICE))) ADB2F404.153
CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE) ADB2F404.154
& =MAX(CONDENSED_MIN_DIM(IP_CLCMP_CNV_ICE) ADB2F404.155
& , MIN(CONDENSED_MAX_DIM(IP_CLCMP_CNV_ICE) ADB2F404.156
& , CONDENSED_DIM_CHAR(L, I, IP_CLCMP_CNV_ICE))) ADB2F404.157
ENDDO ADB2F404.158
ENDDO ADB2F404.159
! ADB2F404.160
! FILL3A.1229
! FILL3A.1230
RETURN FILL3A.1231
END FILL3A.1232
!+ Subroutine to set the parametrization schemes for clouds. FILL3A.1233
! FILL3A.1234
! Purpose: FILL3A.1235
! The parametrization schemes for each component within a cloud FILL3A.1236
! are set. FILL3A.1237
! FILL3A.1238
! Method: FILL3A.1239
! Straightforward. FILL3A.1240
! FILL3A.1241
! Current Owner of Code: J. M. Edwards FILL3A.1242
! FILL3A.1243
! History: FILL3A.1244
! Version Date Comment FILL3A.1245
! 4.0 27-07-95 Original Code FILL3A.1246
! (J. M. Edwards) FILL3A.1247
! 4.4 15-09-97 Code to check the ADB2F404.161
! range of validity of ADB2F404.162
! parametrizations ADB2F404.163
! added. ADB2F404.164
! (J. M. Edwards) ADB2F404.165
! 4.5 18-05-98 Error message for ADB1F405.280
! ice corrected. ADB1F405.281
! (J. M. Edwards) ADB1F405.282
! FILL3A.1248
! Description of Code: FILL3A.1249
! FORTRAN 77 with extensions listed in documentation. FILL3A.1250
! FILL3A.1251
!- --------------------------------------------------------------------- FILL3A.1252
SUBROUTINE R2_SET_CLOUD_PARAMETRIZATION(IERR, N_BAND 2,4FILL3A.1253
& , I_ST_WATER, I_CNV_WATER, I_ST_ICE, I_CNV_ICE FILL3A.1254
& , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST FILL3A.1255
& , DROP_PARM_MIN_DIM, DROP_PARM_MAX_DIM ADB2F404.166
& , L_ICE_TYPE, I_ICE_PARAMETRIZATION, ICE_PARAMETER_LIST FILL3A.1256
& , ICE_PARM_MIN_DIM, ICE_PARM_MAX_DIM ADB2F404.167
& , I_CONDENSED_PARAM, CONDENSED_PARAM_LIST FILL3A.1257
& , CONDENSED_MIN_DIM, CONDENSED_MAX_DIM ADB2F404.168
& , NPD_BAND, NPD_DROP_TYPE, NPD_ICE_TYPE, NPD_CLOUD_PARAMETER FILL3A.1258
& ) FILL3A.1259
! FILL3A.1260
! FILL3A.1261
! FILL3A.1262
IMPLICIT NONE FILL3A.1263
! FILL3A.1264
! FILL3A.1265
! COMDECKS INCLUDED. FILL3A.1266
*CALL DIMFIX3A FILL3A.1267
*CALL CLDCMP3A FILL3A.1268
*CALL STDIO3A FILL3A.1269
*CALL ERROR3A FILL3A.1270
! FILL3A.1271
! FILL3A.1272
! DUMMY ARGUMENTS: FILL3A.1273
! FILL3A.1274
INTEGER !, INTENT(OUT) FILL3A.1275
& IERR FILL3A.1276
! ERROR FLAG FILL3A.1277
! FILL3A.1278
! SIZES OF ARRAYS: FILL3A.1279
INTEGER !, INTENT(IN) FILL3A.1280
& NPD_BAND FILL3A.1281
! MAXIMUM NUMBER OF SPECTRAL BANDS FILL3A.1282
& , NPD_DROP_TYPE FILL3A.1283
! MAXIMUM NUMBER OF TYPES OF DROPLETS FILL3A.1284
& , NPD_ICE_TYPE FILL3A.1285
! MAXIMUM NUMBER OF TYPES OF ICE CRYSTALS FILL3A.1286
& , NPD_CLOUD_PARAMETER FILL3A.1287
! MAXIMUM NUMBER OF PARAMETERS FOR CLOUDS FILL3A.1288
! FILL3A.1289
INTEGER !, INTENT(IN) FILL3A.1290
& N_BAND FILL3A.1291
! NUMBER OF SPECTRAL BANDS FILL3A.1292
! FILL3A.1293
! TYPES OF DROPLETS AND CRYSTALS: FILL3A.1294
INTEGER !, INTENT(IN) FILL3A.1295
& I_ST_WATER FILL3A.1296
! TYPE OF WATER DROPLETS IN STRATIFORM CLOUDS FILL3A.1297
& , I_CNV_WATER FILL3A.1298
! TYPE OF WATER DROPLETS IN CONVECTIVE CLOUDS FILL3A.1299
& , I_ST_ICE FILL3A.1300
! TYPE OF ICE CRYSTALS IN STRATIFORM CLOUDS FILL3A.1301
& , I_CNV_ICE FILL3A.1302
! TYPE OF ICE CRYSTALS IN CONVECTIVE CLOUDS FILL3A.1303
! FILL3A.1304
LOGICAL !, INTENT(IN) FILL3A.1305
& L_DROP_TYPE(NPD_DROP_TYPE) FILL3A.1306
! FLAGS FOR TYPES OF DROPLET PRESENT FILL3A.1307
& , L_ICE_TYPE(NPD_ICE_TYPE) FILL3A.1308
! FLAGS FOR TYPES OF ICE CRYSTAL PRESENT FILL3A.1309
INTEGER !, INTENT(IN) FILL3A.1310
& I_DROP_PARAMETRIZATION(NPD_DROP_TYPE) FILL3A.1311
! PARAMETRIZATIONS OF TYPES OF DROPLETS FILL3A.1312
& , I_ICE_PARAMETRIZATION(NPD_ICE_TYPE) FILL3A.1313
! PARAMETRIZATIONS OF TYPES OF ICE CRYSTALS FILL3A.1314
REAL !, INTENT(IN) FILL3A.1315
& DROP_PARAMETER_LIST(NPD_CLOUD_PARAMETER FILL3A.1316
& , NPD_BAND, NPD_DROP_TYPE) FILL3A.1317
! PARAMETERS FOR OPTICAL PARAMETRIZATIONS OF DROPLETS FILL3A.1318
& , DROP_PARM_MIN_DIM(NPD_DROP_TYPE) ADB2F404.169
! MINIMUM SIZE OF DROPLETS PERMITTED IN PARAMETRIZATIONS ADB2F404.170
& , DROP_PARM_MAX_DIM(NPD_DROP_TYPE) ADB2F404.171
! MAXIMUM SIZE OF DROPLETS PERMITTED IN PARAMETRIZATIONS ADB2F404.172
& , ICE_PARAMETER_LIST(NPD_CLOUD_PARAMETER FILL3A.1319
& , NPD_BAND, NPD_ICE_TYPE) FILL3A.1320
! PARAMETERS FOR OPTICAL PARAMETRIZATIONS OF ICE CRYSTALS FILL3A.1321
& , ICE_PARM_MIN_DIM(NPD_ICE_TYPE) ADB2F404.173
! MINIMUM SIZE OF ICE CRYSTALS PERMITTED IN PARAMETRIZATIONS ADB2F404.174
& , ICE_PARM_MAX_DIM(NPD_ICE_TYPE) ADB2F404.175
! MAXIMUM SIZE OF ICE CRYSTALS PERMITTED IN PARAMETRIZATIONS ADB2F404.176
! FILL3A.1322
INTEGER !, INTENT(OUT) FILL3A.1323
& I_CONDENSED_PARAM(NPD_CLOUD_COMPONENT) FILL3A.1324
! TYPES OF PARAMETRIZATION USED FOR CONDENSED ADB2F404.177
! COMPONENTS IN CLOUDS ADB2F404.178
REAL !, INTENT(OUT) FILL3A.1325
& CONDENSED_PARAM_LIST(NPD_CLOUD_PARAMETER FILL3A.1326
& , NPD_CLOUD_COMPONENT, NPD_BAND) FILL3A.1327
! COEFFICIENTS FOR PARAMETRIZATION OF CONDENSED PHASES FILL3A.1328
& , CONDENSED_MIN_DIM(NPD_CLOUD_COMPONENT) ADB2F404.179
! MINIMUM DIMENSION OF EACH CONDENSED COMPONENT ADB2F404.180
& , CONDENSED_MAX_DIM(NPD_CLOUD_COMPONENT) ADB2F404.181
! MAXIMUM DIMENSION OF EACH CONDENSED COMPONENT ADB2F404.182
! FILL3A.1329
! FILL3A.1330
! LOCAL VARIABLES: FILL3A.1331
INTEGER FILL3A.1332
& I FILL3A.1333
! LOOP VARIABLE FILL3A.1334
& , J FILL3A.1335
! LOOP VARIABLE FILL3A.1336
& , I_SCHEME FILL3A.1337
! PARAMETRIZATION SCHEME FILL3A.1338
! FILL3A.1339
! FUNCTIONS CALLED: FILL3A.1340
INTEGER FILL3A.1341
& SET_N_CLOUD_PARAMETER FILL3A.1342
! FUNCTION TO FIND NUMBER OF PARAMETERS FOR CLOUDS FILL3A.1343
EXTERNAL FILL3A.1344
& SET_N_CLOUD_PARAMETER FILL3A.1345
! FILL3A.1346
! FILL3A.1347
! FILL3A.1348
! SELECT PARAMETRIZATION FOR WATER IN STRATIFORM CLOUDS: FILL3A.1349
! FILL3A.1350
IF ( (I_ST_WATER.LE.NPD_DROP_TYPE).AND. FILL3A.1351
& (L_DROP_TYPE(I_ST_WATER)) ) THEN FILL3A.1352
I_SCHEME=I_DROP_PARAMETRIZATION(I_ST_WATER) FILL3A.1353
I_CONDENSED_PARAM(IP_CLCMP_ST_WATER)=I_SCHEME FILL3A.1354
CONDENSED_MIN_DIM(IP_CLCMP_ST_WATER) ADB2F404.183
& =DROP_PARM_MIN_DIM(I_ST_WATER) ADB2F404.184
CONDENSED_MAX_DIM(IP_CLCMP_ST_WATER) ADB2F404.185
& =DROP_PARM_MAX_DIM(I_ST_WATER) ADB2F404.186
ELSE FILL3A.1355
WRITE(IU_ERR, '(/A, /A)') '*** ERROR: NO DATA EXIST FOR TYPE ' FILL3A.1356
& , 'OF DROPLET SELECTED IN STRATIFORM WATER CLOUDS.' FILL3A.1357
IERR=I_ERR_FATAL FILL3A.1358
RETURN FILL3A.1359
ENDIF FILL3A.1360
! FILL3A.1361
DO I=1, N_BAND FILL3A.1362
DO J=1, SET_N_CLOUD_PARAMETER(I_SCHEME, IP_CLCMP_ST_WATER) FILL3A.1363
CONDENSED_PARAM_LIST(J, IP_CLCMP_ST_WATER, I) FILL3A.1364
& =DROP_PARAMETER_LIST(J, I, I_ST_WATER) FILL3A.1365
ENDDO FILL3A.1366
ENDDO FILL3A.1367
! FILL3A.1368
! FILL3A.1369
! SELECT PARAMETRIZATION FOR WATER IN CONVECTIVE CLOUDS: FILL3A.1370
! FILL3A.1371
IF ( (I_CNV_WATER.LE.NPD_DROP_TYPE).AND. FILL3A.1372
& (L_DROP_TYPE(I_CNV_WATER)) ) THEN FILL3A.1373
I_SCHEME=I_DROP_PARAMETRIZATION(I_CNV_WATER) FILL3A.1374
I_CONDENSED_PARAM(IP_CLCMP_CNV_WATER)=I_SCHEME FILL3A.1375
CONDENSED_MIN_DIM(IP_CLCMP_CNV_WATER) ADB2F404.187
& =DROP_PARM_MIN_DIM(I_CNV_WATER) ADB2F404.188
CONDENSED_MAX_DIM(IP_CLCMP_CNV_WATER) ADB2F404.189
& =DROP_PARM_MAX_DIM(I_CNV_WATER) ADB2F404.190
ELSE FILL3A.1376
WRITE(IU_ERR, '(/A, /A)') '*** ERROR: NO DATA EXIST FOR TYPE ' FILL3A.1377
& , 'OF DROPLET SELECTED IN CONVECTIVE WATER CLOUDS.' FILL3A.1378
IERR=I_ERR_FATAL FILL3A.1379
RETURN FILL3A.1380
ENDIF FILL3A.1381
! FILL3A.1382
DO I=1, N_BAND FILL3A.1383
DO J=1, SET_N_CLOUD_PARAMETER(I_SCHEME, IP_CLCMP_CNV_WATER) FILL3A.1384
CONDENSED_PARAM_LIST(J, IP_CLCMP_CNV_WATER, I) FILL3A.1385
& =DROP_PARAMETER_LIST(J, I, I_CNV_WATER) FILL3A.1386
ENDDO FILL3A.1387
ENDDO FILL3A.1388
! FILL3A.1389
! FILL3A.1390
! SELECT PARAMETRIZATION FOR ICE IN STRATIFORM CLOUDS: FILL3A.1391
! FILL3A.1392
IF ( (I_ST_ICE.LE.NPD_ICE_TYPE).AND. FILL3A.1393
& (L_ICE_TYPE(I_ST_ICE)) ) THEN FILL3A.1394
I_SCHEME=I_ICE_PARAMETRIZATION(I_ST_ICE) FILL3A.1395
I_CONDENSED_PARAM(IP_CLCMP_ST_ICE)=I_SCHEME FILL3A.1396
CONDENSED_MIN_DIM(IP_CLCMP_ST_ICE) ADB2F404.191
& =ICE_PARM_MIN_DIM(I_ST_ICE) ADB2F404.192
CONDENSED_MAX_DIM(IP_CLCMP_ST_ICE) ADB2F404.193
& =ICE_PARM_MAX_DIM(I_ST_ICE) ADB2F404.194
ELSE FILL3A.1397
WRITE(IU_ERR, '(/A, /A)') '*** ERROR: NO DATA EXIST FOR TYPE ' FILL3A.1398
& , 'OF CRYSTAL SELECTED IN STRATIFORM ICE CLOUDS.' ADB1F405.283
IERR=I_ERR_FATAL FILL3A.1400
RETURN FILL3A.1401
ENDIF FILL3A.1402
! FILL3A.1403
DO I=1, N_BAND FILL3A.1404
DO J=1, SET_N_CLOUD_PARAMETER(I_SCHEME, IP_CLCMP_ST_ICE) FILL3A.1405
CONDENSED_PARAM_LIST(J, IP_CLCMP_ST_ICE, I) FILL3A.1406
& =ICE_PARAMETER_LIST(J, I, I_ST_ICE) FILL3A.1407
ENDDO FILL3A.1408
ENDDO FILL3A.1409
! FILL3A.1410
! FILL3A.1411
! SELECT PARAMETRIZATION FOR ICE IN CONVECTIVE CLOUDS: FILL3A.1412
! FILL3A.1413
IF ( (I_CNV_ICE.LE.NPD_ICE_TYPE).AND. FILL3A.1414
& (L_ICE_TYPE(I_CNV_ICE)) ) THEN FILL3A.1415
I_SCHEME=I_ICE_PARAMETRIZATION(I_CNV_ICE) FILL3A.1416
I_CONDENSED_PARAM(IP_CLCMP_CNV_ICE)=I_SCHEME FILL3A.1417
CONDENSED_MIN_DIM(IP_CLCMP_CNV_ICE) ADB2F404.195
& =ICE_PARM_MIN_DIM(I_CNV_ICE) ADB2F404.196
CONDENSED_MAX_DIM(IP_CLCMP_CNV_ICE) ADB2F404.197
& =ICE_PARM_MAX_DIM(I_CNV_ICE) ADB2F404.198
ELSE FILL3A.1418
WRITE(IU_ERR, '(/A, /A)') '*** ERROR: NO DATA EXIST FOR TYPE ' FILL3A.1419
& , 'OF CRYSTAL SELECTED IN CONVECTIVE ICE CLOUDS.' ADB1F405.284
IERR=I_ERR_FATAL FILL3A.1421
RETURN FILL3A.1422
ENDIF FILL3A.1423
! FILL3A.1424
DO I=1, N_BAND FILL3A.1425
DO J=1, SET_N_CLOUD_PARAMETER(I_SCHEME, IP_CLCMP_CNV_ICE) FILL3A.1426
CONDENSED_PARAM_LIST(J, IP_CLCMP_CNV_ICE, I) FILL3A.1427
& =ICE_PARAMETER_LIST(J, I, I_CNV_ICE) FILL3A.1428
ENDDO FILL3A.1429
ENDDO FILL3A.1430
! FILL3A.1431
! FILL3A.1432
! FILL3A.1433
RETURN FILL3A.1434
END FILL3A.1435
!+ Subroutine to set fields of aerosols. FILL3A.1436
! FILL3A.1437
! Purpose: FILL3A.1438
! The mixing ratios of aerosols are transferred to the large array. ADB1F402.152
! FILL3A.1440
! Method: FILL3A.1441
! Straightforward. FILL3A.1442
! FILL3A.1443
! Current Owner of Code: J. M. Edwards FILL3A.1444
! FILL3A.1445
! History: FILL3A.1446
! Version Date Comment FILL3A.1447
! 4.0 27-07-95 Original Code FILL3A.1448
! (J. M. Edwards) FILL3A.1449
! 4.1 12-06-96 Code rewritten to ADB1F401.248
! include two types ADB1F401.249
! of sulphate provided ADB1F401.250
! by the sulphur cycle. ADB1F401.251
! (J. M. Edwards) ADB1F401.252
! 4.2 08-08-96 Climatological aerosol ADB1F402.153
! model added. ADB1F402.154
! (J. M. Edwards) ADB1F402.155
! 4.4 15-09-97 Code for aerosols ADB2F404.199
! generalized to allow ADB2F404.200
! arbitrary combinations. ADB2F404.201
! (J. M. Edwards) ADB2F404.202
! FILL3A.1450
! Description of Code: FILL3A.1451
! FORTRAN 77 with extensions listed in documentation. FILL3A.1452
! FILL3A.1453
!- --------------------------------------------------------------------- FILL3A.1454
SUBROUTINE R2_SET_AEROSOL_FIELD(IERR 2,1ADB1F402.156
& , N_PROFILE, NLEVS, N_AEROSOL, TYPE_AEROSOL ADB2F404.203
& , I_GATHER FILL3A.1456
& , L_CLIMAT_AEROSOL, N_LEVELS_BL ADB1F402.158
& , L_USE_SULPC_DIRECT ADB2F404.204
& , SULP_DIM1, SULP_DIM2 ADB1F402.160
& , ACCUM_SULPHATE, AITKEN_SULPHATE ADB1F402.161
&,L_USE_SOOT_DIRECT, SOOT_DIM1, SOOT_DIM2, FRESH_SOOT, AGED_SOOT ALR3F405.69
& , LAND, LYING_SNOW, PSTAR, AB, BB, TRINDX ADB1F402.162
& , AEROSOL_MIX_RATIO ADB1F402.163
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_AEROSOL_SPECIES FILL3A.1458
& ) FILL3A.1459
! FILL3A.1460
! FILL3A.1461
! FILL3A.1462
IMPLICIT NONE FILL3A.1463
! FILL3A.1464
! ADB1F402.164
! COMDECKS INCLUDED. ADB1F402.165
*CALL C_G ADB1F402.166
*CALL STDIO3A ADB1F402.167
*CALL ERROR3A ADB1F402.168
*CALL AERCMP3A ADB2F404.205
! FILL3A.1465
! DUMMY ARGUMENTS. FILL3A.1466
! FILL3A.1467
! SIZES OF ARRAYS: FILL3A.1468
INTEGER !, INTENT(IN) FILL3A.1469
& NPD_FIELD FILL3A.1470
! FIELD SIZE IN CALLING PROGRAM FILL3A.1471
& , NPD_PROFILE FILL3A.1472
! SIZE OF ARRAY OF PROFILES FILL3A.1473
& , NPD_LAYER FILL3A.1474
! MAXIMUM NUMBER OF LAYERS FILL3A.1475
& , NPD_AEROSOL_SPECIES FILL3A.1476
! MAXIMUM NUMBER OF AEROSOL SPECIES FILL3A.1477
! FILL3A.1478
INTEGER !, INTENT(OUT) ADB1F402.169
& IERR ADB1F402.170
! ERROR FLAG ADB1F402.171
! ADB1F402.172
! ACTUAL SIZES USED: FILL3A.1479
INTEGER !, INTENT(IN) FILL3A.1480
& N_PROFILE FILL3A.1481
! NUMBER OF PROFILES FILL3A.1482
& , NLEVS FILL3A.1483
! NUMBER OF ATMOSPHERIC LAYERS FILL3A.1484
& , N_LEVELS_BL ADB1F402.173
! NUMBER OF LEVELS IN THE BOUNDARY LAYER ADB1F402.174
& , N_AEROSOL ADB1F402.175
! NUMBER OF AEROSOLS IN SPECTRAL FILE ADB1F402.176
& , TYPE_AEROSOL(NPD_AEROSOL_SPECIES) ADB2F404.206
! ACTUAL TYPES OF AEROSOLS ADB2F404.207
! FILL3A.1485
! GATHERING ARRAY: FILL3A.1486
INTEGER !, INTENT(IN) FILL3A.1487
& I_GATHER(NPD_FIELD) FILL3A.1488
! LIST OF POINTS TO GATHER FILL3A.1489
! FILL3A.1490
! FLAG FOR THE CLIMATOLOGICAL AEROSOL DISTRIBUTION. ADB1F402.177
LOGICAL !, INTENT(IN) ADB1F402.178
& L_CLIMAT_AEROSOL ADB1F402.179
! FLAG FOR CLIMATOLOGICAL AEROSOL DISTRIBUTION ADB1F402.180
! ADB1F402.181
! VARIABLES FOR THE SULPHUR CYCLE: ADB1F402.182
LOGICAL !, INTENT(IN) ADB1F402.183
& L_USE_SULPC_DIRECT ADB1F402.184
! FLAG TO USE SULPHUR CYCLE FOR DIRECT EFFECT ADB1F402.185
INTEGER !, INTENT(IN) ADB1F402.188
& SULP_DIM1,SULP_DIM2 ADB1F402.189
! DIMENSIONS FOR _SULPHATE ARRAYS, (P_FIELD,P_LEVELS or 1,1) ADB1F402.190
REAL !, INTENT(IN) FILL3A.1492
& ACCUM_SULPHATE(SULP_DIM1, SULP_DIM2) ADB1F402.191
! MASS MIXING RATIOS OF ACCUMULATION MODE AEROSOL ADB1F401.255
& , AITKEN_SULPHATE(SULP_DIM1, SULP_DIM2) ADB1F402.192
! MASS MIXING RATIOS OF AITKEN MODE AEROSOL ADB1F401.257
! ADB1F402.193
! Declare soot variables: ALR3F405.70
LOGICAL L_USE_SOOT_DIRECT !USE DIRECT RAD. EFFECT OF SOOT AEROSOL ALR3F405.71
INTEGER SOOT_DIM1,SOOT_DIM2 ALR3F405.72
!DIMENSIONS FOR SOOT ARRAYS, (P_FIELD,P_LEVELS or 1,1) ALR3F405.73
REAL FRESH_SOOT(SOOT_DIM1, SOOT_DIM2) ! MMR OF FRESH SOOT ALR3F405.74
& , AGED_SOOT(SOOT_DIM1, SOOT_DIM2) ! MMR OF AGED SOOT ALR3F405.75
! GENERAL ATMOSPHERIC PROPERTIES: ADB1F402.194
INTEGER !, INTENT(IN) ADB1F402.195
& TRINDX(NPD_FIELD) ADB1F402.196
! LAYER BOUNDARY OF TROPOPAUSE ADB1F402.197
REAL !, INTENT(IN) ADB1F402.198
& PSTAR(NPD_FIELD) ADB1F402.199
! SURFACE PRESSURES ADB1F402.200
& , AB(NLEVS+1) ADB1F402.201
! A AT BOUNDARIES OF LAYERS ADB1F402.202
& , BB(NLEVS+1) ADB1F402.203
! B AT BOUNDARIES OF LAYERS ADB1F402.204
! ADB1F402.205
! SURFACE FIELDS ADB1F402.206
LOGICAL !, INTENT(IN) ADB1F402.207
& LAND(NPD_FIELD) ADB1F402.208
! LAND SEA MASK ADB1F402.209
REAL !, INTENT(IN) ADB1F402.210
& LYING_SNOW(NPD_FIELD) ADB1F402.211
! DEPTH OF LYING SNOW ADB1F402.212
! FILL3A.1495
REAL !, INTENT(OUT) FILL3A.1496
& AEROSOL_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER FILL3A.1497
& , NPD_AEROSOL_SPECIES) FILL3A.1498
! MIXING RATIOS OF AEROSOLS FILL3A.1499
! FILL3A.1500
! FILL3A.1501
! FILL3A.1502
! LOCAL VARIABLES: FILL3A.1503
INTEGER FILL3A.1504
& I FILL3A.1505
! LOOP VARIABLE FILL3A.1506
& , J ADB1F402.213
! LOOP VARIABLE ADB1F402.214
& , L FILL3A.1507
! LOOP VARIABLE FILL3A.1508
& , LG FILL3A.1509
! INDEX FOR GATHERING FILL3A.1510
& , BLTOP ADB1F402.215
! INDEX OF UPPER BOUNDARY OF PLANETARY BOUNDARY LAYER ADB1F402.216
& , I_AEROSOL ADB2F404.208
! ACTUAL TYPE OF AEROSOL BEING CONSIDERED ADB2F404.209
! ADB2F404.210
! ADB2F404.211
! ARRAYS FOR THE CLIMATOLOGICAL AEROSOL MODEL ADB2F404.212
LOGICAL ADB2F404.213
& L_IN_CLIMAT(NPD_AEROSOL_COMPONENT) ADB2F404.214
! FLAGS TO INDICATE WHICH AEROSOLS ARE INCLUDED IN ADB2F404.215
! THE CLIMATOLOGY: THIS MAY BE USED ADB2F404.216
! TO ENABLE VARIOUS COMPONENTS TO BE REPLACED BY ADB2F404.217
! FULLY PROGNOSTIC SCHEMES. ADB2F404.218
INTEGER ADB2F404.219
& I_CLIM_POINTER(NPD_AEROSOL_COMPONENT) ADB2F404.220
! POINTERS TO HARD-WIRED INDICES OF THE ORIGINAL ADB2F404.221
! CLIMATOLOGICAL AEROSOL MODEL ADB2F404.222
REAL ADB2F404.223
& AEROSOL_MIX_RATIO_CLIM(NPD_PROFILE, 0: NPD_LAYER, 5) ADB2F404.224
! MIXING RATIOS OF THE CLIMATOLOGICAL AEROSOLS ADB2F404.225
! ADB2F404.226
! SUBROUTINES CALLED: ADB2F404.227
EXTERNAL ADB2F404.228
& R2_SET_AERO_CLIM_HADCM3 ADB2F404.229
! ADB2F404.230
! ADB2F404.231
! INITIALIZATION FOR THE CLIMATOLOGICAL AEROSOL MODEL: ADB2F404.232
! ADB2F404.233
DATA L_IN_CLIMAT/NPD_AEROSOL_COMPONENT*.FALSE./ ADB2F404.234
DATA L_IN_CLIMAT(IP_WATER_SOLUBLE)/.TRUE./ ADB2F404.235
DATA L_IN_CLIMAT(IP_DUST_LIKE)/.TRUE./ ADB2F404.236
DATA L_IN_CLIMAT(IP_OCEANIC)/.TRUE./ ADB2F404.237
DATA L_IN_CLIMAT(IP_SOOT)/.TRUE./ ADB2F404.238
DATA L_IN_CLIMAT(IP_SULPHURIC)/.TRUE./ ADB2F404.239
! ADB2F404.240
! MATCHING OF COMPONENTS TO ORIGINAL HARD-WIRED SETTINGS: ADB2F404.241
DATA I_CLIM_POINTER(IP_WATER_SOLUBLE)/1/ ADB2F404.242
DATA I_CLIM_POINTER(IP_DUST_LIKE)/2/ ADB2F404.243
DATA I_CLIM_POINTER(IP_OCEANIC)/3/ ADB2F404.244
DATA I_CLIM_POINTER(IP_SOOT)/4/ ADB2F404.245
DATA I_CLIM_POINTER(IP_SULPHURIC)/5/ ADB2F404.246
! ADB2F404.247
! Use climatological soot if climatological aerosols are on and not ALR3F405.76
! using interactive soot. ALR3F405.77
L_IN_CLIMAT(IP_SOOT) = L_IN_CLIMAT(IP_SOOT) ALR3F405.78
& .AND.(.NOT.L_USE_SOOT_DIRECT) ALR3F405.79
! ADB2F404.248
! ADB2F404.249
IF (L_CLIMAT_AEROSOL) THEN ADB2F404.250
! ADB2F404.251
! SET THE MIXING RATIOS OF THE CLIMATOLOGICAL AEROSOLS ADB2F404.252
! USED IN THE CLIMATOLOGY OF HADCM3. A SEPARATE SUBROUTINE ADB2F404.253
! IS USED TO ENSURE BIT-REPRODUCIBLE RESULTS BY USING ADB2F404.254
! EARLIER CODE. THIS COULD BE ALTERED IF A NEW CLIMATOLOGY WERE ADB2F404.255
! USED. ADB2F404.256
! ADB2F404.257
CALL R2_SET_AERO_CLIM_HADCM3(N_PROFILE, NLEVS ADB2F404.258
& , I_GATHER ADB2F404.259
& , N_LEVELS_BL ADB2F404.260
& , LAND, LYING_SNOW, PSTAR, AB, BB, TRINDX ADB2F404.261
& , AEROSOL_MIX_RATIO_CLIM ADB2F404.262
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER ADB2F404.263
& ) ADB2F404.264
! ADB2F404.265
ENDIF ADB2F404.266
! ADB2F404.267
! ADB2F404.268
! THE AEROSOLS REQUIRED BY FOR THE CALCULATION SHOULD HAVE BEEN ADB2F404.269
! SELECTED WHEN THE SPECTRAL FILE WAS READ IN. EACH TYPE SHOULD ADB2F404.270
! BE SET APPROPRIATELY. ADB2F404.271
! ADB2F404.272
DO J=1, N_AEROSOL ADB2F404.273
! ADB2F404.274
I_AEROSOL=TYPE_AEROSOL(J) ADB2F404.275
! ADB2F404.276
IF (L_CLIMAT_AEROSOL.AND.L_IN_CLIMAT(I_AEROSOL)) THEN ADB2F404.277
! ADB2F404.278
DO I=1, NLEVS ADB2F404.279
DO L=1, N_PROFILE ADB2F404.280
AEROSOL_MIX_RATIO(L, I, J) ADB2F404.281
& =AEROSOL_MIX_RATIO_CLIM(L, I ADB2F404.282
& , I_CLIM_POINTER(I_AEROSOL)) ADB2F404.283
ENDDO ADB2F404.284
ENDDO ADB2F404.285
! ADB2F404.286
ELSE IF ( (I_AEROSOL.EQ.IP_ACCUM_SULPHATE).AND. ADB2F404.287
& L_USE_SULPC_DIRECT) THEN ADB2F404.288
! ADB2F404.289
! Aerosols related to the sulphur cycle (note that dissolved ADB2F404.290
! sulphate does not contribute to the direct effect): ADB2F404.291
! ADB2F404.292
DO I=1, NLEVS ADB2F404.293
DO L=1, N_PROFILE ADB2F404.294
LG=I_GATHER(L) ADB2F404.295
AEROSOL_MIX_RATIO(L, I, J) ADB2F404.296
& =ACCUM_SULPHATE(LG, NLEVS+1-I) ADB2F404.297
ENDDO ADB2F404.298
ENDDO ADB2F404.299
! ADB2F404.300
ELSE IF ( (I_AEROSOL.EQ.IP_AITKEN_SULPHATE).AND. ADB2F404.301
& L_USE_SULPC_DIRECT) THEN ADB2F404.302
DO I=1, NLEVS ADB2F404.303
DO L=1, N_PROFILE ADB2F404.304
LG=I_GATHER(L) ADB2F404.305
AEROSOL_MIX_RATIO(L, I, J) ADB2F404.306
& =AITKEN_SULPHATE(LG, NLEVS+1-I) ADB2F404.307
ENDDO ADB2F404.308
ENDDO ADB2F404.309
! ADB2F404.310
ELSE IF ((I_AEROSOL.EQ.IP_FRESH_SOOT) ALR3F405.80
& .AND.L_USE_SOOT_DIRECT) THEN ALR3F405.81
DO I=1, NLEVS ALR3F405.82
DO L=1, N_PROFILE ALR3F405.83
LG=I_GATHER(L) ALR3F405.84
AEROSOL_MIX_RATIO(L, I, J)=FRESH_SOOT(LG, NLEVS+1-I) ALR3F405.85
ENDDO ALR3F405.86
ENDDO ALR3F405.87
! ALR3F405.88
ELSE IF ((I_AEROSOL.EQ.IP_AGED_SOOT) ALR3F405.89
& .AND.L_USE_SOOT_DIRECT) THEN ALR3F405.90
DO I=1, NLEVS ALR3F405.91
DO L=1, N_PROFILE ALR3F405.92
LG=I_GATHER(L) ALR3F405.93
AEROSOL_MIX_RATIO(L, I, J)=AGED_SOOT(LG, NLEVS+1-I) ALR3F405.94
ENDDO ALR3F405.95
ENDDO ALR3F405.96
! ALR3F405.97
! ADB2F404.311
ELSE ADB2F404.312
! ADB2F404.313
! The options to the radiation code do not require this ADB2F404.314
! aerosol to be considered: its mixing ratio is set to 0. ADB2F404.315
! This block of code should not normally be executed, ADB2F404.316
! but may be required for ease of including modifications. ADB2F404.317
! ADB2F404.318
DO I=1, NLEVS ADB2F404.319
DO L=1, N_PROFILE ADB2F404.320
LG=I_GATHER(L) ADB2F404.321
AEROSOL_MIX_RATIO(L, I, J)=0.0E+00 ADB2F404.322
ENDDO ADB2F404.323
ENDDO ADB2F404.324
! ADB2F404.325
! ADB2F404.326
ENDIF ADB2F404.327
! ADB2F404.328
ENDDO ADB2F404.329
! ADB2F404.330
! ADB2F404.331
! ADB2F404.332
RETURN ADB2F404.333
END ADB2F404.334
!+ Subroutine to set fields of climatological aerosols in HADCM3. ADB2F404.335
! ADB2F404.336
! Purpose: ADB2F404.337
! This routine sets the mixing ratios of climatological aerosols. ADB2F404.338
! A separate subroutine is used to ensure that the mixing ratios ADB2F404.339
! of these aerosols are bit-comparable with earlier versions of ADB2F404.340
! the model where the choice of aerosols was more restricted: ADB2F404.341
! keeping the code in its original form reduces the opportunity ADB2F404.342
! for optimizations which compromise bit-reproducibilty. ADB2F404.343
! The climatoogy used here is the one devised for HADCM3. ADB2F404.344
! ADB2F404.345
! Method: ADB2F404.346
! Straightforward. ADB2F404.347
! ADB2F404.348
! Current Owner of Code: J. M. Edwards ADB2F404.349
! ADB2F404.350
! History: ADB2F404.351
! Version Date Comment ADB2F404.352
! 4.4 29-09-97 Original Code ADB2F404.353
! very closely based on ADB2F404.354
! previous versions of ADB2F404.355
! this scheme. ADB2F404.356
! (J. M. Edwards) ADB2F404.357
! 4.5 12/05/98 Swap loop order in final nest of loops to GRB0F405.11
! improve vectorization. RBarnes@ecmwf.int GRB0F405.12
! ADB2F404.358
! Description of Code: ADB2F404.359
! FORTRAN 77 with extensions listed in documentation. ADB2F404.360
! ADB2F404.361
!- --------------------------------------------------------------------- ADB2F404.362
SUBROUTINE R2_SET_AERO_CLIM_HADCM3(N_PROFILE, NLEVS 1ADB2F404.363
& , I_GATHER ADB2F404.364
& , N_LEVELS_BL ADB2F404.365
& , LAND, LYING_SNOW, PSTAR, AB, BB, TRINDX ADB2F404.366
& , AEROSOL_MIX_RATIO_CLIM ADB2F404.367
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER ADB2F404.368
& ) ADB2F404.369
! ADB2F404.370
! ADB2F404.371
! ADB2F404.372
IMPLICIT NONE ADB2F404.373
! ADB2F404.374
! ADB2F404.375
! COMDECKS INCLUDED. ADB2F404.376
*CALL C_G ADB2F404.377
! ADB2F404.378
! DUMMY ARGUMENTS. ADB2F404.379
! ADB2F404.380
! SIZES OF ARRAYS: ADB2F404.381
INTEGER !, INTENT(IN) ADB2F404.382
& NPD_FIELD ADB2F404.383
! FIELD SIZE IN CALLING PROGRAM ADB2F404.384
& , NPD_PROFILE ADB2F404.385
! SIZE OF ARRAY OF PROFILES ADB2F404.386
& , NPD_LAYER ADB2F404.387
! MAXIMUM NUMBER OF LAYERS ADB2F404.388
! ADB2F404.389
! ACTUAL SIZES USED: ADB2F404.390
INTEGER !, INTENT(IN) ADB2F404.391
& N_PROFILE ADB2F404.392
! NUMBER OF PROFILES ADB2F404.393
& , NLEVS ADB2F404.394
! NUMBER OF ATMOSPHERIC LAYERS ADB2F404.395
& , N_LEVELS_BL ADB2F404.396
! NUMBER OF LEVELS IN THE BOUNDARY LAYER ADB2F404.397
! ADB2F404.398
! GATHERING ARRAY: ADB2F404.399
INTEGER !, INTENT(IN) ADB2F404.400
& I_GATHER(NPD_FIELD) ADB2F404.401
! LIST OF POINTS TO GATHER ADB2F404.402
! ADB2F404.403
! GENERAL ATMOSPHERIC PROPERTIES: ADB2F404.404
INTEGER !, INTENT(IN) ADB2F404.405
& TRINDX(NPD_FIELD) ADB2F404.406
! LAYER BOUNDARY OF TROPOPAUSE ADB2F404.407
REAL !, INTENT(IN) ADB2F404.408
& PSTAR(NPD_FIELD) ADB2F404.409
! SURFACE PRESSURES ADB2F404.410
& , AB(NLEVS+1) ADB2F404.411
! A AT BOUNDARIES OF LAYERS ADB2F404.412
& , BB(NLEVS+1) ADB2F404.413
! B AT BOUNDARIES OF LAYERS ADB2F404.414
! ADB2F404.415
! SURFACE FIELDS ADB2F404.416
LOGICAL !, INTENT(IN) ADB2F404.417
& LAND(NPD_FIELD) ADB2F404.418
! LAND-SEA MASK ADB2F404.419
REAL !, INTENT(IN) ADB2F404.420
& LYING_SNOW(NPD_FIELD) ADB2F404.421
! DEPTH OF LYING SNOW ADB2F404.422
! ADB2F404.423
REAL !, INTENT(OUT) ADB2F404.424
& AEROSOL_MIX_RATIO_CLIM(NPD_PROFILE, 0: NPD_LAYER, 5) ADB2F404.425
! MIXING RATIOS OF CLIMATOLOGICAL AEROSOLS ADB2F404.426
! ADB2F404.427
! ADB2F404.428
! ADB2F404.429
! LOCAL VARIABLES: ADB2F404.430
INTEGER ADB2F404.431
& I ADB2F404.432
! LOOP VARIABLE ADB2F404.433
& , J ADB2F404.434
! LOOP VARIABLE ADB2F404.435
& , L ADB2F404.436
! LOOP VARIABLE ADB2F404.437
& , LG ADB2F404.438
! INDEX FOR GATHERING ADB2F404.439
& , BLTOP ADB2F404.440
! INDEX OF UPPER BOUNDARY OF PLANETARY BOUNDARY LAYER ADB2F404.441
REAL ADB1F402.217
& PRESSURE_WT(NPD_FIELD) ADB1F402.218
! ARRAY FOR SCALING AEROSOL AMOUNTS FOR DIFFERENT SURFACE ADB1F402.219
! PRESSURES ADB1F402.220
! ADB1F402.221
! TOTAL COLUMN MASS (KG M-2) OF EACH AEROSOL SPECIES IN ADB1F402.222
! THE BOUNDARY LAYER, THE FREE TROPOSPHERE AND THE STRATOSPHERE ADB1F402.223
! RESPECTIVELY. THIS MODEL ASSUMES THAT THERE ARE FIVE AEROSOLS. ADB1F402.224
REAL ADB1F402.225
& BL_OCEANMASS(5) ADB1F402.226
& , BL_LANDMASS(5) ADB1F402.227
& , FREETROP_MASS(5) ADB1F402.228
& , STRAT_MASS(5) ADB1F402.229
! ADB1F402.230
! INITIALIZATION FOR THE CLIMATOLOGICAL AEROSOL MODEL ADB1F402.231
DATA BL_LANDMASS/2.77579E-5, 6.70018E-5, 0.0, 9.57169E-7, 0.0/ ADB1F402.232
DATA BL_OCEANMASS/1.07535E-5, 0.0, 2.043167E-4, 0.0, 0.0/ ADB1F402.233
DATA FREETROP_MASS/3.46974E-6, 8.37523E-6, 0.0, 1.19646E-7, 0.0/ ADB1F402.234
DATA STRAT_MASS/0.0, 0.0, 0.0, 0.0, 1.86604E-6/ ADB1F402.235
! FILL3A.1516
! FILL3A.1517
! FILL3A.1518
! TROPOSPHERIC AEROSOL LOADING IS A SIMPLE FUNCTION OF SURFACE ADB2F404.442
! PRESSURE: HALVING PSTAR HALVES THE TROPOSPHERIC AEROSOL BURDEN. ADB2F404.443
! THE STRATOSPHERIC BURDEN IS INDEPENDENT OF PSTAR. NOTE THE ADB2F404.444
! FACTOR MULTIPLING AEROSOL AMOUNTS USES A REFERENCE PRESSURE ADB2F404.445
! OF 1013 mbars. ADB2F404.446
DO L=1, N_PROFILE ADB2F404.447
PRESSURE_WT(L)=PSTAR(I_GATHER(L))*(1.0/1.013E5) ADB2F404.448
END DO ADB2F404.449
! ADB1F402.269
! For each of the 5 aerosol species, the column amount in the ADB2F404.450
! boundary layer, free troposphere and stratosphere are known for ADB2F404.451
! a standard atmosphere over ocean and land. These can be used ADB2F404.452
! to find mixing ratios for the UM by dividing total aerosol by ADB1F405.285
! total air mass (and using pressure weighting in the ADB2F404.454
! troposphere). ADB2F404.455
! ADB1F402.270
! Firstly, mixing ratios are set for the 5 aerosol species in the ADB2F404.456
! stratosphere. ADB2F404.457
DO I=1,5 ADB2F404.458
DO L=1, N_PROFILE ADB2F404.459
LG=I_GATHER(L) ADB2F404.460
AEROSOL_MIX_RATIO_CLIM(L,NLEVS+1-TRINDX(LG),I) ADB2F404.461
& =STRAT_MASS(I)*G/ ADB2F404.462
& ((AB(TRINDX(LG))+BB(TRINDX(LG))*PSTAR(LG)) ADB2F404.463
& -(AB(NLEVS+1)+BB(NLEVS+1)*PSTAR(LG))) ADB2F404.464
END DO ADB2F404.465
END DO ADB2F404.466
DO I=1,5 ADB2F404.467
DO L=1, N_PROFILE ADB2F404.468
LG=I_GATHER(L) ADB2F404.469
DO J=(TRINDX(LG)+1),NLEVS ADB2F404.470
AEROSOL_MIX_RATIO_CLIM(L,NLEVS+1-J,I)= ADB2F404.471
& AEROSOL_MIX_RATIO_CLIM(L,NLEVS+1-TRINDX(LG),I) ADB2F404.472
END DO ADB2F404.473
END DO ADB2F404.474
END DO ADB2F404.475
! Now, the mixing ratios are set for the 5 aerosol species ADB2F404.476
! in the free troposphere. ADB2F404.477
! The half-level at the top of the boundary layer is BLTOP ADB2F404.478
BLTOP=N_LEVELS_BL+1 ADB2F404.479
DO I=1,5 ADB2F404.480
DO L=1, N_PROFILE ADB2F404.481
LG=I_GATHER(L) ADB2F404.482
AEROSOL_MIX_RATIO_CLIM(L,NLEVS+1-BLTOP,I) ADB2F404.483
& =FREETROP_MASS(I)*G* ADB2F404.484
& PRESSURE_WT(L)/((AB(BLTOP)+BB(BLTOP)*PSTAR(LG))- ADB2F404.485
& (AB(TRINDX(LG))+BB(TRINDX(LG))*PSTAR(LG))) ADB2F404.486
END DO ADB2F404.487
END DO ADB2F404.488
DO L=1, N_PROFILE ADB2F404.489
LG=I_GATHER(L) ADB2F404.490
IF ((BLTOP+1).LE.(TRINDX(LG)-1)) THEN ADB2F404.491
DO I=1,5 ADB2F404.492
DO J=(BLTOP+1),(TRINDX(LG)-1) ADB2F404.493
AEROSOL_MIX_RATIO_CLIM(L,NLEVS+1-J,I)= ADB2F404.494
& AEROSOL_MIX_RATIO_CLIM(L,NLEVS+1-BLTOP,I) ADB2F404.495
END DO ADB2F404.496
END DO ADB2F404.497
END IF ADB2F404.498
END DO ADB2F404.499
! ADB1F402.271
! Now, the boundary layer mixing ratios are set for the ADB2F404.500
! 5 aerosol species. A continental aerosol is used over most land ADB2F404.501
! areas, but not over ice sheets, which are identified by the ADB2F404.502
! criterion used in the boundary layer scheme that the mass of ADB2F404.503
! lying snow exceeds 5000 kgm-2. Over ice sheets a maritime ADB2F404.504
! aerosol is used. ADB2F404.505
DO I=1,5 ADB2F404.506
DO L=1, N_PROFILE FILL3A.1520
LG=I_GATHER(L) ADB2F404.507
IF ( LAND(LG).AND.(LYING_SNOW(LG).LT.5.0E+03) ) THEN ADB2F404.508
AEROSOL_MIX_RATIO_CLIM(L,NLEVS+2-BLTOP,I) ADB2F404.509
& =BL_LANDMASS(I)*G*PRESSURE_WT(L) ADB2F404.510
& /(PSTAR(LG)-(AB(BLTOP)+BB(BLTOP)*PSTAR(LG))) ADB2F404.511
ELSE ADB2F404.512
AEROSOL_MIX_RATIO_CLIM(L,NLEVS+2-BLTOP,I) ADB2F404.513
& =BL_OCEANMASS(I)*G*PRESSURE_WT(L) ADB2F404.514
& /(PSTAR(LG)-(AB(BLTOP)+BB(BLTOP)*PSTAR(LG))) ADB2F404.515
END IF ADB2F404.516
END DO ADB1F402.282
END DO ADB2F404.517
DO I=1,5 ADB2F404.518
DO J=1,(BLTOP-2) GRB0F405.13
DO L=1, N_PROFILE GRB0F405.14
AEROSOL_MIX_RATIO_CLIM(L,NLEVS+1-J,I)= ADB2F404.521
& AEROSOL_MIX_RATIO_CLIM(L,NLEVS+2-BLTOP,I) ADB2F404.522
END DO ADB1F402.299
END DO ADB1F402.300
END DO ADB2F404.523
! FILL3A.1526
! FILL3A.1527
! FILL3A.1528
RETURN FILL3A.1529
END FILL3A.1530
!+ Subroutine to calculate the total cloud cover. FILL3A.1531
! FILL3A.1532
! Purpose: FILL3A.1533
! The total cloud cover at all grid-points is determined. FILL3A.1534
! FILL3A.1535
! Method: FILL3A.1536
! A separate calculation is made for each different assumption about FILL3A.1537
! the overlap. FILL3A.1538
! FILL3A.1539
! Current Owner of Code: J. M. Edwards FILL3A.1540
! FILL3A.1541
! History: FILL3A.1542
! Version Date Comment FILL3A.1543
! 4.0 27-07-95 Original Code FILL3A.1544
! (J. M. Edwards) FILL3A.1545
! 4.2 08-08-96 Code added for coherent ADB1F402.383
! convective cloud. ADB1F402.384
! (J. M. Edwards) ADB1F402.385
! FILL3A.1546
! Description of Code: FILL3A.1547
! FORTRAN 77 with extensions listed in documentation. FILL3A.1548
! FILL3A.1549
!- --------------------------------------------------------------------- FILL3A.1550
SUBROUTINE R2_CALC_TOTAL_CLOUD_COVER(N_PROFILE, NLEVS, NCLDS 2FILL3A.1551
& , I_CLOUD, W_CLOUD, TOTAL_CLOUD_COVER FILL3A.1552
& , NPD_PROFILE, NPD_LAYER FILL3A.1553
& ) FILL3A.1554
! FILL3A.1555
! FILL3A.1556
! FILL3A.1557
IMPLICIT NONE FILL3A.1558
! FILL3A.1559
! FILL3A.1560
! DECLARATION OF ARRAY SIZES. FILL3A.1561
INTEGER !, INTENT(IN) FILL3A.1562
& NPD_PROFILE FILL3A.1563
! MAXIMUM NUMBER OF PROFILES FILL3A.1564
& , NPD_LAYER FILL3A.1565
! MAXIMUM NUMBER OF LAYERS FILL3A.1566
! FILL3A.1567
! COMDECKS INCLUDED FILL3A.1568
*CALL CLSCHM3A FILL3A.1569
! FILL3A.1570
! FILL3A.1571
! DUMMY ARGUMENTS. FILL3A.1572
INTEGER !, INTENT(IN) FILL3A.1573
& N_PROFILE FILL3A.1574
! NUMBER OF PROFILES FILL3A.1575
& , NLEVS FILL3A.1576
! NUMBER OF LAYERS FILL3A.1577
& , NCLDS FILL3A.1578
! NUMBER OF CLOUDY LAYERS FILL3A.1579
& , I_CLOUD FILL3A.1580
! CLOUD SCHEME EMPLOYED FILL3A.1581
REAL !, INTENT(IN) FILL3A.1582
& W_CLOUD(NPD_PROFILE, NPD_LAYER) FILL3A.1583
! CLOUD AMOUNTS FILL3A.1584
! FILL3A.1585
REAL !, INTENT(OUT) FILL3A.1586
& TOTAL_CLOUD_COVER(NPD_PROFILE) FILL3A.1587
! TOTAL CLOUD COVER FILL3A.1588
! FILL3A.1589
! FILL3A.1590
! LOCAL VARIABLES. FILL3A.1591
INTEGER FILL3A.1592
& L FILL3A.1593
! LOOP VARIABLE FILL3A.1594
& , I FILL3A.1595
! LOOP VARIABLE FILL3A.1596
! FILL3A.1597
! FILL3A.1598
! FILL3A.1599
! DIFFERENT OVERLAP ASSUMPTIONS ARE CODED INTO EACH SOLVER. FILL3A.1600
! FILL3A.1601
IF (I_CLOUD.EQ.IP_CLOUD_MIX_MAX) THEN FILL3A.1602
! FILL3A.1603
! USE THE TOTAL CLOUD COVER TEMPORARILY TO HOLD THE CLEAR-SKY FILL3A.1604
! FRACTION AND CONVERT BACK TO CLOUD COVER LATER. FILL3A.1605
! WE CALCULATE THIS QUANTITY BY IMAGINING A TOTALLY TRANSPARENT FILL3A.1606
! ATMOSPHERE CONTAINING TOTALLY OPAQUE CLOUDS AND FINDING THE FILL3A.1607
! TRANSMISSION. FILL3A.1608
DO L=1, N_PROFILE FILL3A.1609
TOTAL_CLOUD_COVER(L)=1.0E+00-W_CLOUD(L, NLEVS+1-NCLDS) FILL3A.1610
ENDDO FILL3A.1611
DO I=NLEVS+1-NCLDS, NLEVS-1 FILL3A.1612
DO L=1, N_PROFILE FILL3A.1613
IF (W_CLOUD(L, I+1).GT.W_CLOUD(L, I)) THEN FILL3A.1614
TOTAL_CLOUD_COVER(L)=TOTAL_CLOUD_COVER(L) FILL3A.1615
& *(1.0E+00-W_CLOUD(L, I+1))/(1.0E+00-W_CLOUD(L, I)) FILL3A.1616
ENDIF FILL3A.1617
ENDDO FILL3A.1618
ENDDO FILL3A.1619
DO L=1, N_PROFILE FILL3A.1620
TOTAL_CLOUD_COVER(L)=1.0E+00-TOTAL_CLOUD_COVER(L) FILL3A.1621
ENDDO FILL3A.1622
! FILL3A.1623
ELSE IF (I_CLOUD.EQ.IP_CLOUD_MIX_RANDOM) THEN FILL3A.1624
! FILL3A.1625
! USE THE TOTAL CLOUD COVER TEMPORARILY TO HOLD THE CLEAR-SKY FILL3A.1626
! FRACTION AND CONVERT BACK TO CLOUD COVER LATER. FILL3A.1627
DO L=1, N_PROFILE FILL3A.1628
TOTAL_CLOUD_COVER(L)=1.0E+00 FILL3A.1629
ENDDO FILL3A.1630
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1631
DO L=1, N_PROFILE FILL3A.1632
TOTAL_CLOUD_COVER(L)=TOTAL_CLOUD_COVER(L) FILL3A.1633
& *(1.0E+00-W_CLOUD(L, I)) FILL3A.1634
ENDDO FILL3A.1635
ENDDO FILL3A.1636
DO L=1, N_PROFILE FILL3A.1637
TOTAL_CLOUD_COVER(L)=1.0E+00-TOTAL_CLOUD_COVER(L) FILL3A.1638
ENDDO FILL3A.1639
! FILL3A.1640
ELSE IF (I_CLOUD.EQ.IP_CLOUD_COLUMN_MAX) THEN FILL3A.1641
! FILL3A.1642
DO L=1, N_PROFILE FILL3A.1643
TOTAL_CLOUD_COVER(L)=0.0E+00 FILL3A.1644
ENDDO FILL3A.1645
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1646
DO L=1, N_PROFILE FILL3A.1647
TOTAL_CLOUD_COVER(L)=MAX(TOTAL_CLOUD_COVER(L) FILL3A.1648
& , W_CLOUD(L, I)) FILL3A.1649
ENDDO FILL3A.1650
ENDDO ADB1F402.386
! ADB1F402.387
ELSE IF (I_CLOUD.EQ.IP_CLOUD_TRIPLE) THEN ADB1F402.388
! ADB1F402.389
! USE THE TOTAL CLOUD COVER TEMPORARILY TO HOLD THE CLEAR-SKY ADB1F402.390
! FRACTION AND CONVERT BACK TO CLOUD COVER LATER. ADB1F402.391
! WE CALCULATE THIS QUANTITY BY IMAGINING A TOTALLY TRANSPARENT ADB1F402.392
! ATMOSPHERE CONTAINING TOTALLY OPAQUE CLOUDS AND FINDING THE ADB1F402.393
! TRANSMISSION. ADB1F402.394
DO L=1, N_PROFILE ADB1F402.395
TOTAL_CLOUD_COVER(L)=1.0E+00-W_CLOUD(L, NLEVS+1-NCLDS) ADB1F402.396
ENDDO ADB1F402.397
DO I=NLEVS+1-NCLDS, NLEVS-1 ADB1F402.398
DO L=1, N_PROFILE ADB1F402.399
IF (W_CLOUD(L, I+1).GT.W_CLOUD(L, I)) THEN ADB1F402.400
TOTAL_CLOUD_COVER(L)=TOTAL_CLOUD_COVER(L) ADB1F402.401
& *(1.0E+00-W_CLOUD(L, I+1))/(1.0E+00-W_CLOUD(L, I)) ADB1F402.402
ENDIF ADB1F402.403
ENDDO ADB1F402.404
ENDDO ADB1F402.405
DO L=1, N_PROFILE ADB1F402.406
TOTAL_CLOUD_COVER(L)=1.0E+00-TOTAL_CLOUD_COVER(L) ADB1F402.407
ENDDO FILL3A.1651
! FILL3A.1652
ELSE IF (I_CLOUD.EQ.IP_CLOUD_CLEAR) THEN FILL3A.1653
! FILL3A.1654
DO L=1, N_PROFILE FILL3A.1655
TOTAL_CLOUD_COVER(L)=0.0E+00 FILL3A.1656
ENDDO FILL3A.1657
! FILL3A.1658
ENDIF FILL3A.1659
! FILL3A.1660
! FILL3A.1661
! FILL3A.1662
RETURN FILL3A.1663
END FILL3A.1664
!+ Subroutine to implement the MRF UMIST parametrization. FILL3A.1665
! FILL3A.1666
! Purpose: FILL3A.1667
! Effective Radii are calculated in accordance with this FILL3A.1668
! parametrization. FILL3A.1669
! FILL3A.1670
! Method: FILL3A.1671
! The number density of CCN is found from the concentration FILL3A.1672
! of aerosols, if available. This yields the number density of FILL3A.1673
! droplets: if aerosols are not present, the number of droplets FILL3A.1674
! is fixed. Effective radii are calculated from the number of FILL3A.1675
! droplets and the LWC. Limits are applied to these values. In FILL3A.1676
! deep convective clouds fixed values are assumed. FILL3A.1677
! FILL3A.1678
! Current Owner of Code: J. M. Edwards FILL3A.1679
! FILL3A.1680
! History: FILL3A.1681
! Version Date Comment FILL3A.1682
! 4.0 27-07-95 Original Code FILL3A.1683
! (J. M. Edwards) FILL3A.1684
! 4.4 15-09-97 Accumulation-mode ADB2F404.524
! and dissolved sulphate ADB2F404.525
! passed directly to ADB2F404.526
! this routine to allow ADB2F404.527
! the indirect effect to ADB2F404.528
! be used without ADB2F404.529
! aerosols being needed ADB2F404.530
! in the spectral file. ADB2F404.531
! (J. M. Edwards) ADB2F404.532
! 4.5 18-05-98 Obsolete bounds on ADB1F405.286
! effective radius ADB1F405.287
! removed. ADB1F405.288
! (J. M. Edwards) ADB1F405.289
! FILL3A.1685
! Description of Code: FILL3A.1686
! FORTRAN 77 with extensions listed in documentation. FILL3A.1687
! FILL3A.1688
!- --------------------------------------------------------------------- FILL3A.1689
SUBROUTINE R2_RE_MRF_UMIST(N_PROFILE, NLEVS, NCLDS 1,1FILL3A.1690
& , I_GATHER AYY1F404.423
& , L_AEROSOL_CCN, ACCUM_SULPHATE, DISS_SULPHATE AYY1F404.424
& , I_CLOUD_REPRESENTATION FILL3A.1692
& , LAND_G, DENSITY_AIR, CONDENSED_MIX_RATIO, CC_DEPTH FILL3A.1693
& , CONDENSED_RE FILL3A.1694
& , NTOT_DIAG_G AAJ3F404.165
& , STRAT_LWC_DIAG_G AAJ3F404.166
& , SO4_CCN_DIAG_G AAJ3F404.167
& , SULP_DIM1, SULP_DIM2 AYY1F404.425
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_AEROSOL_SPECIES AYY1F404.426
& ) FILL3A.1696
! FILL3A.1697
! FILL3A.1698
! FILL3A.1699
IMPLICIT NONE FILL3A.1700
! FILL3A.1701
! FILL3A.1702
! COMDECKS INCLUDED: ADB2F404.533
*CALL C_PI FILL3A.1704
*CALL C_DENSTY FILL3A.1705
*CALL C_MICRO FILL3A.1706
*CALL DIMFIX3A FILL3A.1707
*CALL CLDCMP3A FILL3A.1708
*CALL CLREPP3A FILL3A.1709
! FILL3A.1710
! FILL3A.1711
! DUMMY ARGUMENTS: FILL3A.1712
! FILL3A.1713
! SIZES OF ARRAYS: FILL3A.1714
INTEGER !, INTENT(IN) FILL3A.1715
& NPD_FIELD AYY1F404.427
! SIZE OF INPUT FIELDS TO THE RADIATION AYY1F404.428
& , NPD_PROFILE AYY1F404.429
! MAXIMUM NUMBER OF PROFILES FILL3A.1717
& , NPD_LAYER FILL3A.1718
! MAXIMUM NUMBER OF LAYERS FILL3A.1719
& , NPD_AEROSOL_SPECIES FILL3A.1720
! MAXIMUM NUMBER OF AEROSOL SPECIES FILL3A.1721
& , SULP_DIM1 AYY1F404.430
! 1ST DIMENSION OF ARRAYS OF SULPHATE AYY1F404.431
& , SULP_DIM2 AYY1F404.432
! 2ND DIMENSION OF ARRAYS OF SULPHATE AYY1F404.433
! FILL3A.1722
INTEGER !, INTENT(IN) FILL3A.1723
& N_PROFILE FILL3A.1724
! NUMBER OF ATMOSPHERIC PROFILES FILL3A.1725
& , NLEVS FILL3A.1726
! NUMBER OF LEVELS FILL3A.1727
& , NCLDS FILL3A.1728
! NUMBER OF CLOUDY LEVELS FILL3A.1729
! AYY1F404.434
INTEGER !, INTENT(IN) AYY1F404.435
& I_GATHER(NPD_FIELD) AYY1F404.436
! LIST OF POINTS TO BE GATHERED AYY1F404.437
LOGICAL !, INTENT(IN) FILL3A.1730
& LAND_G(NPD_PROFILE) FILL3A.1731
! GATHERED MASK FOR LAND POINTS FILL3A.1732
INTEGER !, INTENT(IN) FILL3A.1733
& I_CLOUD_REPRESENTATION FILL3A.1734
! REPRESENTATION OF CLOUDS FILL3A.1735
! FILL3A.1736
! VARIABLES FOR AEROSOLS FILL3A.1737
LOGICAL !, INTENT(IN) FILL3A.1738
& L_AEROSOL_CCN ADB1F401.269
! FLAG TO USE AEROSOLS TO FIND CCN. ADB1F401.270
REAL !, INTENT(IN) FILL3A.1741
& ACCUM_SULPHATE(SULP_DIM1, SULP_DIM2) AYY1F404.438
! MIXING RATIOS OF ACCUMULATION MODE SULPHATE AYY1F404.439
& , DISS_SULPHATE(SULP_DIM1, SULP_DIM2) AYY1F404.440
! MIXING RATIOS OF DISSOLVED SULPHATE AYY1F404.441
! FILL3A.1745
REAL !, INTENT(IN) FILL3A.1746
& DENSITY_AIR(NPD_PROFILE, NPD_LAYER) FILL3A.1747
! DENSITY OF AIR FILL3A.1748
! FILL3A.1749
REAL !, INTENT(IN) FILL3A.1750
& CONDENSED_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER FILL3A.1751
& , NPD_CLOUD_COMPONENT) FILL3A.1752
! MIXING RATIOS OF CONDENSED SPECIES FILL3A.1753
& , CC_DEPTH(NPD_PROFILE) FILL3A.1754
! DEPTH OF CONVECTIVE CLOUD FILL3A.1755
! FILL3A.1756
REAL !, INTENT(OUT) FILL3A.1757
& CONDENSED_RE(NPD_PROFILE, 0: NPD_LAYER, NPD_CLOUD_COMPONENT) FILL3A.1758
! EFFECTIVE RADII OF CONDENSED COMPONENTS OF CLOUDS FILL3A.1759
! FILL3A.1760
REAL !, INTENT(OUT) AAJ3F404.168
& NTOT_DIAG_G(NPD_PROFILE, NPD_LAYER) AAJ3F404.169
! DIAGNOSTIC ARRAY FOR NTOT (GATHERED) AAJ3F404.170
& , STRAT_LWC_DIAG_G(NPD_PROFILE, NPD_LAYER) AAJ3F404.171
! DIAGNOSTIC ARRAY FOR STRATIFORM LWC (GATHERED) AAJ3F404.172
& , SO4_CCN_DIAG_G(NPD_PROFILE, NPD_LAYER) AAJ3F404.173
! DIAGNOSTIC ARRAY FOR SO4 CCN MASS CONC (GATHERED) AAJ3F404.174
! AAJ3F404.175
! FILL3A.1761
! LOCAL VARIABLES: FILL3A.1762
INTEGER FILL3A.1763
& I FILL3A.1764
! LOOP VARIABLE FILL3A.1765
& , L FILL3A.1766
! LOOP VARIABLE FILL3A.1767
! FILL3A.1768
REAL FILL3A.1769
& TOTAL_MIX_RATIO_ST(NPD_PROFILE) FILL3A.1770
! TOTAL MIXING RATIO OF WATER SUBSTANCE IN STRATIFORM CLOUD FILL3A.1771
& , TOTAL_MIX_RATIO_CNV(NPD_PROFILE) FILL3A.1772
! TOTAL MIXING RATIO OF WATER SUBSTANCE IN STRATIFORM CLOUD FILL3A.1773
! FILL3A.1774
REAL FILL3A.1775
& N_DROP(NPD_PROFILE, NPD_LAYER) FILL3A.1776
! NUMBER DENSITY OF DROPLETS FILL3A.1777
& , KPARAM FILL3A.1778
! RATIO OF CUBES OF VOLUME RADIUS TO EFFECTIVE RADIUS FILL3A.1779
! FILL3A.1780
! FIXED CONSTANTS OF THE PARAMETRIZATION: FILL3A.1781
REAL FILL3A.1782
& DEEP_CONVECTIVE_CLOUD ADB1F405.290
! THRESHOLD VALUE FOR DEEP CONVECTIVE CLOUD FILL3A.1788
PARAMETER( FILL3A.1789
& DEEP_CONVECTIVE_CLOUD=5.0E+02 ADB1F405.291
& ) FILL3A.1793
! FILL3A.1794
! FILL3A.1795
! FILL3A.1796
! CALCULATE THE NUMBER DENSITY OF DROPLETS FILL3A.1797
CALL R2_FIND_NUMBER_DROP(N_PROFILE, NLEVS, NCLDS FILL3A.1798
& , I_GATHER AYY1F404.442
& , DENSITY_AIR, L_AEROSOL_CCN AYY1F404.443
& , ACCUM_SULPHATE, DISS_SULPHATE AYY1F404.444
& , LAND_G FILL3A.1800
& , N_DROP FILL3A.1801
& , SO4_CCN_DIAG_G AAJ3F404.176
& , SULP_DIM1, SULP_DIM2 AYY1F404.445
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_AEROSOL_SPECIES AYY1F404.446
& ) FILL3A.1803
! FILL3A.1804
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1805
! FILL3A.1806
! FIND THE TOTAL MIXING RATIO OF WATER SUBSTANCE IN THE CLOUD FILL3A.1807
! AS IMPLIED BY THE REPRESENTATION. FILL3A.1808
IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CONV_STRAT) THEN FILL3A.1809
DO L=1, N_PROFILE FILL3A.1810
TOTAL_MIX_RATIO_ST(L) FILL3A.1811
& =CONDENSED_MIX_RATIO(L, I, IP_CLCMP_ST_WATER) FILL3A.1812
& +CONDENSED_MIX_RATIO(L, I, IP_CLCMP_ST_ICE) FILL3A.1813
TOTAL_MIX_RATIO_CNV(L) FILL3A.1814
& =CONDENSED_MIX_RATIO(L, I, IP_CLCMP_CNV_WATER) FILL3A.1815
& +CONDENSED_MIX_RATIO(L, I, IP_CLCMP_CNV_ICE) FILL3A.1816
ENDDO FILL3A.1817
ELSE IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CSIW) THEN FILL3A.1818
DO L=1, N_PROFILE FILL3A.1819
TOTAL_MIX_RATIO_ST(L) FILL3A.1820
& =CONDENSED_MIX_RATIO(L, I, IP_CLCMP_ST_WATER) FILL3A.1821
TOTAL_MIX_RATIO_CNV(L) FILL3A.1822
& =CONDENSED_MIX_RATIO(L, I, IP_CLCMP_CNV_WATER) FILL3A.1823
ENDDO FILL3A.1824
ENDIF FILL3A.1825
DO L=1, N_PROFILE FILL3A.1826
IF (LAND_G(L)) THEN FILL3A.1827
KPARAM=KPARAM_LAND FILL3A.1828
ELSE FILL3A.1829
KPARAM=KPARAM_SEA FILL3A.1830
ENDIF FILL3A.1831
CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER) FILL3A.1832
& =(3.0E+00*TOTAL_MIX_RATIO_CNV(L)*DENSITY_AIR(L, I) FILL3A.1833
& /(4.0E+00*PI*RHO_WATER*KPARAM*N_DROP(L, I))) FILL3A.1834
& **(1.0E+00/3.0E+00) FILL3A.1835
CONDENSED_RE(L, I, IP_CLCMP_ST_WATER) FILL3A.1836
& =(3.0E+00*TOTAL_MIX_RATIO_ST(L)*DENSITY_AIR(L, I) FILL3A.1837
& /(4.0E+00*PI*RHO_WATER*KPARAM*N_DROP(L, I))) FILL3A.1838
& **(1.0E+00/3.0E+00) FILL3A.1839
ENDDO FILL3A.1840
DO L=1, N_PROFILE AAJ3F404.177
NTOT_DIAG_G(L, I)=N_DROP(L, I)*1.0E-06 AAJ3F404.178
STRAT_LWC_DIAG_G(L, I) AAJ3F404.179
& =TOTAL_MIX_RATIO_ST(L)*DENSITY_AIR(L, I)*1.0E03 AAJ3F404.180
ENDDO AAJ3F404.181
ENDDO FILL3A.1841
! FILL3A.1842
! RESET THE EFFECTIVE RADII FOR DEEP CONVECTIVE CLOUDS. FILL3A.1857
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1858
DO L=1, N_PROFILE FILL3A.1859
IF (CC_DEPTH(L).GT.DEEP_CONVECTIVE_CLOUD) THEN FILL3A.1860
IF (LAND_G(L)) THEN FILL3A.1861
CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)=DCONRE_LAND FILL3A.1862
ELSE FILL3A.1863
CONDENSED_RE(L, I, IP_CLCMP_CNV_WATER)=DCONRE_SEA FILL3A.1864
ENDIF FILL3A.1865
ENDIF FILL3A.1866
ENDDO FILL3A.1867
ENDDO FILL3A.1868
! FILL3A.1869
! FILL3A.1870
! FILL3A.1871
RETURN FILL3A.1872
END FILL3A.1873
!+ Subroutine to calculate the number density of droplets. FILL3A.1874
! FILL3A.1875
! Purpose: FILL3A.1876
! The number density of cloud droplets is calculated. FILL3A.1877
! FILL3A.1878
! Method: FILL3A.1879
! Straightforward. FILL3A.1880
! FILL3A.1881
! Current Owner of Code: J. M. Edwards FILL3A.1882
! FILL3A.1883
! History: FILL3A.1884
! Version Date Comment FILL3A.1885
! 4.0 27-07-95 Original Code FILL3A.1886
! (J. M. Edwards) FILL3A.1887
! 4.4 15-09-97 Accumulation-mode ADB2F404.534
! and dissolved sulphate ADB2F404.535
! passed directly to ADB2F404.536
! this routine to allow ADB2F404.537
! the indirect effect to ADB2F404.538
! be used without ADB2F404.539
! aerosols being needed ADB2F404.540
! in the spectral file. ADB2F404.541
! The number of CCN now ADB2F404.542
! depends on the ADB2F404.543
! dissolved sulphate as ADB2F404.544
! well as the accumulation ADB2F404.545
! mode sulphate. ADB2F404.546
! (J. M. Edwards) ADB2F404.547
! FILL3A.1888
! Description of Code: FILL3A.1889
! FORTRAN 77 with extensions listed in documentation. FILL3A.1890
! FILL3A.1891
!- --------------------------------------------------------------------- FILL3A.1892
SUBROUTINE R2_FIND_NUMBER_DROP(N_PROFILE, NLEVS, NCLDS 1FILL3A.1893
& , I_GATHER AYY1F404.447
& , DENSITY_AIR, L_AEROSOL_CCN AYY1F404.448
& , ACCUM_SULPHATE, DISS_SULPHATE AYY1F404.449
& , LAND_G FILL3A.1895
& , N_DROP FILL3A.1896
& , SO4_CCN_DIAG_G AAJ3F404.182
& , SULP_DIM1, SULP_DIM2 AYY1F404.450
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_AEROSOL_SPECIES AYY1F404.451
& ) FILL3A.1898
! FILL3A.1899
! FILL3A.1900
! FILL3A.1901
IMPLICIT NONE FILL3A.1902
! FILL3A.1903
! FILL3A.1904
! COMDECKS INCLUDED: FILL3A.1905
*CALL C_PI FILL3A.1906
*CALL C_R_CP FILL3A.1907
*CALL C_MICRO FILL3A.1908
! FILL3A.1909
! FILL3A.1910
! DUMMY ARGUMENTS: FILL3A.1911
! FILL3A.1912
! SIZES OF ARRAYS: FILL3A.1913
INTEGER !, INTENT(IN) FILL3A.1914
& NPD_FIELD AYY1F404.452
! SIZE OF INPUT FIELDS AYY1F404.453
& , NPD_PROFILE AYY1F404.454
! MAXIMUM NUMBER OF PROFILES FILL3A.1916
& , NPD_LAYER FILL3A.1917
! MAXIMUM NUMBER OF LAYERS FILL3A.1918
& , NPD_AEROSOL_SPECIES FILL3A.1919
! MAXIMUM NUMBER OF AEROSOL SPECIES FILL3A.1920
& , SULP_DIM1 AYY1F404.455
! 1ST DIMENSION OF ARRAYS OF SULPHATE AYY1F404.456
& , SULP_DIM2 AYY1F404.457
! 2ND DIMENSION OF ARRAYS OF SULPHATE AYY1F404.458
INTEGER !, INTENT(IN) FILL3A.1921
& I_GATHER(NPD_FIELD) AYY1F404.459
! LIST OF POINTS TO BE GATHERED AYY1F404.460
INTEGER !, INTENT(IN) AYY1F404.461
& N_PROFILE FILL3A.1922
! NUMBER OF ATMOSPHERIC PROFILES FILL3A.1923
& , NLEVS FILL3A.1924
! NUMBER OF LEVELS FILL3A.1925
& , NCLDS FILL3A.1926
! NUMBER OF CLOUDY LEVELS FILL3A.1927
LOGICAL !, INTENT(IN) FILL3A.1928
& L_AEROSOL_CCN ADB1F401.273
! FLAG TO USE AEROSOLS TO FIND CCN ADB1F401.274
& , LAND_G(NPD_PROFILE) FILL3A.1931
! GATHERED MASK FOR LAND POINTS FILL3A.1932
REAL !, INTENT(IN) FILL3A.1933
& ACCUM_SULPHATE(SULP_DIM1, SULP_DIM2) AYY1F404.462
! MIXING RATIOS OF ACCUMULATION-MODE SULPHATE AYY1F404.463
& , DISS_SULPHATE(SULP_DIM1, SULP_DIM2) AYY1F404.464
! MIXING RATIOS OF DISSOLVED SULPHATE AYY1F404.465
& , DENSITY_AIR(NPD_PROFILE, NPD_LAYER) FILL3A.1937
! DENSITY OF AIR FILL3A.1938
! FILL3A.1939
REAL !, INTENT(OUT) FILL3A.1940
& N_DROP(NPD_PROFILE, NPD_LAYER) FILL3A.1941
! NUMBER DENSITY OF DROPLETS FILL3A.1942
! AAJ3F404.183
REAL AAJ3F404.184
& SO4_CCN_DIAG_G(NPD_PROFILE, NPD_LAYER) AAJ3F404.185
! SO4 CCN MASS CONC DIAGNOSTIC ARRAY (GATHERED) AAJ3F404.186
! AAJ3F404.187
! FILL3A.1943
! FILL3A.1944
! LOCAL VARIABLES: FILL3A.1945
INTEGER FILL3A.1946
& I FILL3A.1947
! LOOP VARIABLE FILL3A.1948
& , L FILL3A.1949
! LOOP VARIABLE FILL3A.1950
REAL FILL3A.1951
& PARTICLE_VOLUME FILL3A.1952
! MEAN VOLUME OF A PARTICLE FILL3A.1953
& , N_CCN FILL3A.1954
! NUMBER DENSITY OF CCN FILL3A.1955
! FILL3A.1956
REAL FILL3A.1961
& RADIUS_0 FILL3A.1962
! MEDIAN RADIUS OF LOG-NORMAL DISTRIBUTION FILL3A.1963
& , SIGMA_0 FILL3A.1964
! GEOMETRIC STANDARD DEVIATION FILL3A.1965
& , DENSITY_SULPHATE FILL3A.1966
! DENSITY OF SULPHATE AEROSOL FILL3A.1967
PARAMETER( FILL3A.1968
& RADIUS_0=5.0E-08 FILL3A.1969
& , SIGMA_0=2.0 FILL3A.1970
& , DENSITY_SULPHATE=1.769E+03 FILL3A.1971
& ) FILL3A.1973
! FILL3A.1974
! FILL3A.1975
! FILL3A.1976
IF (L_AEROSOL_CCN) THEN ADB1F401.278
! FILL3A.1978
! IF AEROSOLS ARE INCLUDED THE NUMBER OF CCN IS FOUND FROM THE FILL3A.1979
! CONCENTRATION OF ACCUMULATION-MODE AND DISSOLVED SULPHATE. ADB2F404.548
! NOTE THAT IN PRINCIPLE EACH MODE MIGHT HAVE A DIFFERENT ADB2F404.549
! DENSITY AND SIZE DISTRIBUTION. ADB2F404.550
! THE DROPLET NUMBER CONCENTRATION IS HELD TO A MINIMUM AAJ2F404.1
! VALUE OF 5.0E+06 (5cm-3). AAJ2F404.2
! FILL3A.1981
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1982
DO L=1, N_PROFILE FILL3A.1983
PARTICLE_VOLUME=(4.0E+00*PI/3.0E+00)*RADIUS_0**3 FILL3A.1984
& *EXP(4.5E+00*(LOG(SIGMA_0))**2) FILL3A.1985
N_CCN=(ACCUM_SULPHATE(I_GATHER(L), NLEVS+1-I) AYY1F404.466
& +DISS_SULPHATE(I_GATHER(L), NLEVS+1-I)) AYY1F404.467
& *DENSITY_AIR(L, I) FILL3A.1987
& /(DENSITY_SULPHATE*PARTICLE_VOLUME) FILL3A.1988
N_DROP(L, I)=3.75E+08*(1.0E+00-EXP(-2.5E-9*N_CCN)) FILL3A.1989
IF (N_DROP(L, I) .LT. 5.0E+06) N_DROP(L, I)=5.0E+06 AAJ2F404.3
! CONVERT THE MASS MIXING RATIOS FROM (NH4)2SO4 AAJ3F404.188
! TO MASS PER UNIT VOLUME OF SO4(IN MICROGRAMMES AAJ3F404.189
! PER CUBIC METRE) FOR DIAGNOSTIC PURPOSES. AAJ3F404.190
SO4_CCN_DIAG_G(L, I)= AAJ3F404.191
& (ACCUM_SULPHATE(I_GATHER(L), NLEVS+1-I) AAJ3F404.192
& +DISS_SULPHATE(I_GATHER(L), NLEVS+1-I)) AAJ3F404.193
& * DENSITY_AIR(L, I) * (96./132.) * 1.0E+09 AAJ3F404.194
ENDDO FILL3A.1990
ENDDO FILL3A.1991
! FILL3A.1992
ELSE FILL3A.1993
! FILL3A.1994
! WITHOUT AEROSOLS THE NUMBERS OF DROPLETS ARE FIXED. FILL3A.1995
! FILL3A.1996
DO I=NLEVS+1-NCLDS, NLEVS FILL3A.1997
DO L=1, N_PROFILE FILL3A.1998
IF (LAND_G(L)) THEN FILL3A.1999
N_DROP(L, I)=NTOT_LAND FILL3A.2000
ELSE FILL3A.2001
N_DROP(L, I)=NTOT_SEA FILL3A.2002
ENDIF FILL3A.2003
ENDDO FILL3A.2004
ENDDO FILL3A.2005
! FILL3A.2006
ENDIF FILL3A.2007
! FILL3A.2008
! FILL3A.2009
! FILL3A.2010
RETURN FILL3A.2011
END FILL3A.2012
!+ Subroutine to set the actual process options for the radiation code. ADB1F401.281
! ADB1F401.282
! Purpose: ADB1F401.283
! To set a consistent set of process options for the radiation. ADB1F401.284
! ADB1F401.285
! Method: ADB1F401.286
! The global options for the spectral region are compared with the ADB1F401.287
! contents of the spectral file. The global options should be set ADB1F401.288
! to reflect the capabilities of the code enabled in the model. ADB1F401.289
! ADB1F401.290
! Current Owner of Code: J. M. Edwards ADB1F401.291
! ADB1F401.292
! History: ADB1F401.293
! Version Date Comment ADB1F401.294
! 4.1 04-03-96 Original Code ADB1F401.295
! (J. M. Edwards) ADB1F401.296
! Parts of this code are ADB1F401.297
! rather redundant. The ADB1F401.298
! form of writing is for ADB1F401.299
! near consistency with ADB1F401.300
! HADAM3. ADB1F401.301
! ADB1F401.302
! 4.5 April 1998 Check for inconsistencies between soot ALR3F405.98
! spectral file and options used. L Robinson. ALR3F405.99
! Description of Code: ADB1F401.303
! FORTRAN 77 with extensions listed in documentation. ADB1F401.304
! ADB1F401.305
!- --------------------------------------------------------------------- ADB1F401.306
SUBROUTINE R2_COMPARE_PROC(IERR, L_PRESENT 2ADB1F401.307
& , L_RAYLEIGH_PERMITTED, L_GAS_PERMITTED, L_CONTINUUM_PERMITTED ADB1F401.308
& , L_DROP_PERMITTED, L_AEROSOL_PERMITTED ADB1F401.309
& , L_AEROSOL_CCN_PERMITTED, L_ICE_PERMITTED ADB1F401.310
& , L_USE_SULPC_DIRECT, L_USE_SULPC_INDIRECT ADB1F401.311
& ,L_USE_SOOT_DIRECT ALR3F405.100
& , L_CLIMAT_AEROSOL ADB1F402.408
& , L_RAYLEIGH, L_GAS, L_CONTINUUM ADB1F401.312
& , L_DROP, L_AEROSOL, L_AEROSOL_CCN, L_ICE ADB1F401.313
& , NPD_TYPE ADB1F401.314
& ) ADB1F401.315
! ADB1F401.316
! ADB1F401.317
! ADB1F401.318
IMPLICIT NONE ADB1F401.319
! ADB1F401.320
! ADB1F401.321
! COMDECKS INCLUDED. ADB1F401.322
*CALL STDIO3A ADB1F401.323
*CALL ERROR3A ADB1F401.324
! ADB1F401.325
! ADB1F401.326
! DUMMY ARGUMENTS: ADB1F401.327
INTEGER !, INTENT(OUT) ADB1F401.328
& IERR ADB1F401.329
! ERROR FLAG ADB1F401.330
INTEGER !, INTENT(IN) ADB1F401.331
& NPD_TYPE ADB1F401.332
! NUMBER OF TYPES OF SPECTRAL DATA ADB1F401.333
! ADB1F401.334
LOGICAL !, INTENT(IN) ADB1F401.335
& L_PRESENT(0: NPD_TYPE) ADB1F401.336
! ARRAY INDICATING BLOCKS OF DATA PRESENT ADB1F401.337
! IN THE SPECTRAL FILE. ADB1F401.338
! ADB1F401.339
! PROCESSES PERMITTED WITHIN THE UNIFIED MODEL. ADB1F401.340
LOGICAL !, INTENT(IN) ADB1F401.341
& L_RAYLEIGH_PERMITTED ADB1F401.342
! RAYLEIGH SCATTERING PERMITTED IN THE MODEL ADB1F401.343
& , L_GAS_PERMITTED ADB1F401.344
! GASEOUS ABSORPTION PERMITTED IN THE MODEL ADB1F401.345
& , L_CONTINUUM_PERMITTED ADB1F401.346
! CONTINUUM ABSORPTION PERMITTED IN THE MODEL ADB1F401.347
& , L_DROP_PERMITTED ADB1F401.348
! CLOUD DROPLET EXTINCTION PERMITTED IN THE MODEL ADB1F401.349
& , L_AEROSOL_PERMITTED ADB1F401.350
! AEROSOL EXTINCTION PERMITTED IN THE MODEL ADB1F401.351
& , L_AEROSOL_CCN_PERMITTED ADB1F401.352
! DETERMINATION OF CCN FROM AEROSOLS PERMITTED IN THE MODEL ADB1F401.353
& , L_ICE_PERMITTED ADB1F401.354
! ICE EXTINCTION PERMITTED IN THE MODEL ADB1F401.355
! ADB1F401.356
! OPTIONS PASSED IN ADB1F401.357
LOGICAL ADB1F401.358
& L_USE_SULPC_DIRECT ADB1F401.359
! LOGICAL TO USE SULPHUR CYCLE FOR THE DIRECT EFFECT ADB1F401.360
& , L_USE_SULPC_INDIRECT ADB1F401.361
! LOGICAL TO USE SULPHUR CYCLE FOR THE INDIRECT EFFECT ADB1F401.362
& ,L_USE_SOOT_DIRECT ALR3F405.101
! LOGICAL TO USE DIRECT RADIATIVE EFFECT DUE TO SOOT ALR3F405.102
& , L_CLIMAT_AEROSOL ADB1F402.409
! LOGICAL TO USE CLIMATOLOGICAL AEROSOL MODEL ADB1F402.410
! ADB1F401.363
! PROCESSES TO BE ENABLED IN THE RUN. ADB1F401.364
LOGICAL !, INTENT(OUT) ADB1F401.365
& L_RAYLEIGH ADB1F401.366
! RAYLEIGH SCATTERING TO BE ENABLED IN THE RUN ADB1F401.367
& , L_GAS ADB1F401.368
! GASEOUS ABSORPTION TO BE ENABLED IN THE RUN ADB1F401.369
& , L_CONTINUUM ADB1F401.370
! CONTINUUM ABSORPTION TO BE ENABLED IN THE RUN ADB1F401.371
& , L_DROP ADB1F401.372
! CLOUD DROPLET EXTINCTION TO BE ENABLED IN THE RUN ADB1F401.373
& , L_AEROSOL ADB1F401.374
! AEROSOL EXTINCTION TO BE ENABLED IN THE RUN ADB1F401.375
& , L_AEROSOL_CCN ADB1F401.376
! DETERMINATION OF CCN FROM AEROSOL TO BE ENABLED IN THE RUN ADB1F401.377
& , L_ICE ADB1F401.378
! ICE EXTINCTION TO BE ENABLED IN THE RUN ADB1F401.379
! ADB1F401.380
! ADB1F401.381
! ADB1F401.382
! EACH OPTICAL PROCESS INCLUDED IN THE RADIATION CODE MAY BE ADB1F401.383
! PERMITTED OR DENIED IN THE UNIFIED MODEL, DEPENDING ON THE ADB1F401.384
! PRESENCE OF SUPPORTING CODE. TO BE ENABLED IN A RUN AN OPTICAL ADB1F401.385
! PROCESS MUST BE PERMITTED IN THE UNIFIED MODEL AND HAVE ADB1F401.386
! SUITABLE SPECTRAL DATA. ADB1F401.387
L_RAYLEIGH=L_RAYLEIGH_PERMITTED.AND.L_PRESENT(3) ADB1F401.388
L_GAS=L_GAS_PERMITTED.AND.L_PRESENT(5) ADB1F401.389
L_CONTINUUM=L_CONTINUUM_PERMITTED.AND.L_PRESENT(9) ADB1F401.390
L_DROP=L_DROP_PERMITTED.AND.L_PRESENT(10) ADB1F401.391
L_ICE=L_ICE_PERMITTED.AND.L_PRESENT(12) ADB1F401.392
! ADB1F401.393
! SET THE CONTROLLING FLAG FOR THE DIRECT RADIATIVE EFFECTS OF ADB1F402.411
! AEROSOLS. ADB1F402.412
IF (L_AEROSOL_PERMITTED) THEN ADB1F402.413
! SET THE FLAG AND THEN CHECK THE SPECTRAL FILE. ADB1F402.414
L_AEROSOL=L_USE_SULPC_DIRECT.OR.L_CLIMAT_AEROSOL ADB1F402.415
& .OR. L_USE_SOOT_DIRECT ALR3F405.103
IF (L_AEROSOL.AND.(.NOT.L_PRESENT(11))) THEN ADB1F402.416
WRITE(IU_ERR, '(/A, /A)') ADB1F402.417
& '*** ERROR: THE SPECTRAL FILE CONTAINS NO DATA ' ADB1F402.418
& //'FOR AEROSOLS.', 'SUCH DATA ARE REQUIRED FOR THE ' ADB1F402.419
& //'DIRECT EFFECT.' ADB1F402.420
IERR=I_ERR_FATAL ADB1F402.421
RETURN ADB1F402.422
ENDIF ADB1F402.423
ELSE ADB1F402.424
! CHECK THAT AEROSOLS HAVE NOT BEEN REQUESTED ADB1F402.425
! WHEN NOT PERMITTED. ADB1F402.426
IF (L_USE_SULPC_DIRECT ALR3F405.104
& .OR.L_CLIMAT_AEROSOL ALR3F405.105
& .OR.L_USE_SOOT_DIRECT) THEN ALR3F405.106
WRITE(IU_ERR, '(/A, /A)') ADB1F402.428
& '*** ERROR: THE DIRECT EFFECTS AEROSOLS ARE NOT ' ADB1F402.429
& , 'PERMITTED IN THIS CONFIGURATION OF THE ' ADB1F402.430
& //'RADIATION CODE.' ADB1F402.431
IERR=I_ERR_FATAL ADB1F402.432
RETURN ADB1F402.433
ENDIF ADB1F402.434
ENDIF ADB1F402.435
! ADB1F402.436
! SET THE CONTROLLING FLAG FOR THE INDIRECT EFFECTS OF AEROSOLS. ADB1F402.437
! AT PRESENT THIS DEPENDS SOLELY ON THE SULPHUR CYCLE. ADB1F402.438
L_AEROSOL_CCN=L_USE_SULPC_INDIRECT ADB1F402.439
! ADB1F401.420
! ADB1F401.421
! ADB1F401.422
RETURN ADB1F401.423
END ADB1F401.424
*ENDIF DEF,A01_3A,OR,DEF,A02_3A FILL3A.2013
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.24