*IF DEF,A70_1B GREYK3B.2
*IF DEF,A01_3A,OR,DEF,A02_3A GREYK3B.3
C ******************************COPYRIGHT****************************** GREYK3B.4
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. GREYK3B.5
C GREYK3B.6
C Use, duplication or disclosure of this code is subject to the GREYK3B.7
C restrictions as set forth in the contract. GREYK3B.8
C GREYK3B.9
C Meteorological Office GREYK3B.10
C London Road GREYK3B.11
C BRACKNELL GREYK3B.12
C Berkshire UK GREYK3B.13
C RG12 2SZ GREYK3B.14
C GREYK3B.15
C If no contract has been raised with this copy of the code, the use, GREYK3B.16
C duplication or disclosure of it is strictly prohibited. Permission GREYK3B.17
C to do so must first be obtained in writing from the Head of Numerical GREYK3B.18
C Modelling at the above address. GREYK3B.19
C ******************************COPYRIGHT****************************** GREYK3B.20
C GREYK3B.21
!+ Subroutine to calculate grey extinctions. GREYK3B.22
! GREYK3B.23
! Method: GREYK3B.24
! For each activated optical process, excluding gaseous GREYK3B.25
! absorption, increments are calculated for the total and GREYK3B.26
! scattering extinctions, and the products of the asymmetry GREYK3B.27
! factor and the forward scattering factor in clear and GREYK3B.28
! cloudy regions. These increments are summed, and the grey GREYK3B.29
! total and scattering extinctions and the asymmetry and forward GREYK3B.30
! scattering factors are thus calculated. GREYK3B.31
! GREYK3B.32
! Current Owner of Code: J. M. Edwards GREYK3B.33
! GREYK3B.34
! History: GREYK3B.35
! Version Date Comment GREYK3B.36
! 4.5 11-06-98 Optimised Version GREYK3B.37
! (P. Burton) GREYK3B.38
! GREYK3B.39
! Description of Code: GREYK3B.40
! FORTRAN 77 with extensions listed in documentation. GREYK3B.41
! GREYK3B.42
!- --------------------------------------------------------------------- GREYK3B.43
SUBROUTINE GREY_EXTINCTION(IERR 1,4GREYK3B.44
& , N_PROFILE, N_LAYER, L_LAYER, P, T, DENSITY GREYK3B.45
& , L_RESCALE GREYK3B.46
& , L_RAYLEIGH, RAYLEIGH_COEFF GREYK3B.47
& , L_CONTINUUM, N_CONTINUUM, I_CONTINUUM_POINTER, K_CONTINUUM GREYK3B.48
& , AMOUNT_CONTINUUM GREYK3B.49
& , L_AEROSOL, N_AEROSOL, AEROSOL_MIX_RATIO GREYK3B.50
& , I_AEROSOL_PARAMETRIZATION GREYK3B.51
& , I_HUMIDITY_POINTER, HUMIDITIES, DELTA_HUMIDITY GREYK3B.52
& , MEAN_REL_HUMIDITY GREYK3B.53
& , AEROSOL_ABSORPTION, AEROSOL_SCATTERING, AEROSOL_ASYMMETRY GREYK3B.54
& , L_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE, N_CLOUD_TOP GREYK3B.55
& , L_CLOUD_LAYER, I_CLOUD GREYK3B.56
& , N_CONDENSED, L_CLOUD_CMP, I_PHASE_CMP GREYK3B.57
& , I_CONDENSED_PARAM, CONDENSED_PARAM_LIST GREYK3B.58
& , CONDENSED_MIX_RATIO, CONDENSED_DIM_CHAR GREYK3B.59
& , N_CLOUD_TYPE, I_CLOUD_TYPE GREYK3B.60
& , K_EXT_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE GREYK3B.61
& , FORWARD_SCATTER_FREE GREYK3B.62
& , K_EXT_TOT_CLOUD, K_EXT_SCAT_CLOUD GREYK3B.63
& , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD GREYK3B.64
& , NPD_PROFILE, NPD_LAYER, NPD_CONTINUUM GREYK3B.65
& , NPD_AEROSOL_SPECIES, NPD_HUMIDITIES GREYK3B.66
& , NPD_CLOUD_PARAMETER GREYK3B.67
& ) GREYK3B.68
! GREYK3B.69
! GREYK3B.70
! GREYK3B.71
IMPLICIT NONE GREYK3B.72
! GREYK3B.73
! GREYK3B.74
INTEGER !, INTENT(IN) GREYK3B.75
& NPD_PROFILE GREYK3B.76
! MAXIMUM NUMBER OF PROFILES GREYK3B.77
& , NPD_LAYER GREYK3B.78
! MAXIMUM NUMBER OF LAYERS GREYK3B.79
& , NPD_AEROSOL_SPECIES GREYK3B.80
! MAXIMUM NUMBER OF AEROSOLS GREYK3B.81
& , NPD_HUMIDITIES GREYK3B.82
! MAXIMUM NUMBER OF HUMIDITIES GREYK3B.83
& , NPD_CONTINUUM GREYK3B.84
! MAXIMUM NUMBER OF CONTINUA GREYK3B.85
& , NPD_CLOUD_PARAMETER GREYK3B.86
! MAXIMUM NUMBER OF CLOUD PARAMETERS GREYK3B.87
! GREYK3B.88
! INCLUDE COMDECKS GREYK3B.89
*CALL STDIO3A
GREYK3B.90
*CALL DIMFIX3A
GREYK3B.91
*CALL PRMCH3A
GREYK3B.92
*CALL PRECSN3A
GREYK3B.93
*CALL AERPRM3A
GREYK3B.94
*CALL CLSCHM3A
GREYK3B.95
*CALL PHASE3A
GREYK3B.96
*CALL ERROR3A
GREYK3B.97
! GREYK3B.98
! GREYK3B.99
! GREYK3B.100
! DUMMY ARGUMENTS. GREYK3B.101
INTEGER !, INTENT(OUT) GREYK3B.102
& IERR GREYK3B.103
! ERROR FLAG GREYK3B.104
! GREYK3B.105
! GREYK3B.106
! BASIC ATMOSPHERIC PROPERTIES: GREYK3B.107
! GREYK3B.108
LOGICAL !, INTENT(IN) GREYK3B.109
& L_LAYER GREYK3B.110
! VARIABLES GIVEN IN LAYERS GREYK3B.111
! GREYK3B.112
INTEGER !, INTENT(IN) GREYK3B.113
& N_PROFILE GREYK3B.114
! NUMBER OF PROFILES GREYK3B.115
& , N_LAYER GREYK3B.116
! NUMBER OF LAYERS GREYK3B.117
! GREYK3B.118
REAL !, INTENT(IN) GREYK3B.119
& P(NPD_PROFILE, 0: NPD_LAYER) GREYK3B.120
! PRESSURE GREYK3B.121
& , T(NPD_PROFILE, 0: NPD_LAYER) GREYK3B.122
! TEMPERATURE GREYK3B.123
& , DENSITY(NPD_PROFILE, 0: NPD_LAYER) GREYK3B.124
! DENSITY AT LEVELS GREYK3B.125
! GREYK3B.126
! GREYK3B.127
! OPTICAL SWITCHES: GREYK3B.128
LOGICAL !, INTENT(IN) GREYK3B.129
& L_RESCALE GREYK3B.130
! DELTA-RESCALING REQUIRED GREYK3B.131
! GREYK3B.132
! GREYK3B.133
! RAYLEIGH SCATTERING: GREYK3B.134
! GREYK3B.135
LOGICAL !, INTENT(IN) GREYK3B.136
& L_RAYLEIGH GREYK3B.137
! RAYLEIGH SCATTERING ACTIVATED GREYK3B.138
! GREYK3B.139
REAL !, INTENT(IN) GREYK3B.140
& RAYLEIGH_COEFF GREYK3B.141
! RAYLEIGH COEFFICIENT GREYK3B.142
! GREYK3B.143
! GREYK3B.144
! CONTINUUM PROCESSES: GREYK3B.145
LOGICAL !, INTENT(IN) GREYK3B.146
& L_CONTINUUM GREYK3B.147
! CONTINUUM ABSORPTION ACTIVATED GREYK3B.148
! GREYK3B.149
INTEGER !, INTENT(IN) GREYK3B.150
& N_CONTINUUM GREYK3B.151
! NUMBER OF CONTINUA GREYK3B.152
& , I_CONTINUUM_POINTER(NPD_CONTINUUM) GREYK3B.153
! POINTERS TO ACTIVE CONTINUA GREYK3B.154
! GREYK3B.155
REAL !, INTENT(IN) GREYK3B.156
& K_CONTINUUM(NPD_CONTINUUM) GREYK3B.157
! CONTINUUM EXTINCTION GREYK3B.158
& , AMOUNT_CONTINUUM(NPD_PROFILE, 0: NPD_LAYER, NPD_CONTINUUM) GREYK3B.159
! AMOUNTS FOR CONTINUA GREYK3B.160
! GREYK3B.161
! GREYK3B.162
! PROPERTIES OF AEROSOLS: GREYK3B.163
! GREYK3B.164
LOGICAL !, INTENT(IN) GREYK3B.165
& L_AEROSOL GREYK3B.166
! AEROSOLS ACTIVATED GREYK3B.167
! GREYK3B.168
INTEGER !, INTENT(IN) GREYK3B.169
& N_AEROSOL GREYK3B.170
! NUMBER OF AEROSOL SPECIES GREYK3B.171
& , I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES) GREYK3B.172
! PARAMETRIZATIONS OF AEROSOLS GREYK3B.173
& , I_HUMIDITY_POINTER(NPD_PROFILE, NPD_LAYER) GREYK3B.174
! POINTER TO AEROSOL LOOK-UP TABLE GREYK3B.175
! GREYK3B.176
REAL !, INTENT(IN) GREYK3B.177
& AEROSOL_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER GREYK3B.178
& , NPD_AEROSOL_SPECIES) GREYK3B.179
! NUMBER DENSTY OF AEROSOLS GREYK3B.180
& , AEROSOL_ABSORPTION(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES) GREYK3B.181
! AEROSOL ABSORPTION IN BAND/MIX RT. GREYK3B.182
& , AEROSOL_SCATTERING(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES) GREYK3B.183
! AEROSOL SCATTERING IN BAND/MIX RT. GREYK3B.184
& , AEROSOL_ASYMMETRY(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES) GREYK3B.185
! AEROSOL ASYMMETRY IN BAND GREYK3B.186
& , HUMIDITIES(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES) GREYK3B.187
! ARRAY OF HUMIDITIES GREYK3B.188
& , DELTA_HUMIDITY GREYK3B.189
! INCREMENT IN HUMIDITY GREYK3B.190
& , MEAN_REL_HUMIDITY(NPD_PROFILE, NPD_LAYER) GREYK3B.191
! MIXING RATIO OF WATER VAPOUR GREYK3B.192
! GREYK3B.193
! GREYK3B.194
! GREYK3B.195
! PROPERTIES OF CLOUDS: GREYK3B.196
! GREYK3B.197
LOGICAL !, INTENT(IN) GREYK3B.198
& L_CLOUD GREYK3B.199
! CLOUDS ACTIVATED GREYK3B.200
! GREYK3B.201
! GEOMETRY OF CLOUDS: GREYK3B.202
! GREYK3B.203
LOGICAL !, INTENT(IN) GREYK3B.204
& L_CLOUD_LAYER GREYK3B.205
! CLOUD VARIABLES GIVEN IN LAYERS GREYK3B.206
! GREYK3B.207
INTEGER !, INTENT(IN) GREYK3B.208
& N_CLOUD_TOP GREYK3B.209
! TOPMOST CLOUDY LAYER GREYK3B.210
& , I_CLOUD GREYK3B.211
! CLOUD SCHEME TO BE USED GREYK3B.212
& , N_CLOUD_TYPE GREYK3B.213
! NUMBER OF TYPES OF CLOUDS GREYK3B.214
& , N_CLOUD_PROFILE(NPD_LAYER) GREYK3B.215
! NUMBER OF CLOUDY PROFILES IN EACH LAYER GREYK3B.216
& , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER) GREYK3B.217
! PROFILES CONTAINING CLOUDS GREYK3B.218
& , I_CLOUD_TYPE(NPD_CLOUD_COMPONENT) GREYK3B.219
! TYPES OF CLOUD TO WHICH EACH COMPONENT CONTRIBUTES GREYK3B.220
! GREYK3B.221
! MICROPHYSICAL QUANTITIES: GREYK3B.222
INTEGER !, INTENT(IN) GREYK3B.223
& N_CONDENSED GREYK3B.224
! NUMBER OF CONDENSED COMPONENTS GREYK3B.225
& , I_PHASE_CMP(NPD_CLOUD_COMPONENT) GREYK3B.226
! PHASES OF CLOUDY COMPONENTS GREYK3B.227
& , I_CONDENSED_PARAM(NPD_CLOUD_COMPONENT) GREYK3B.228
! PARAMETRIZATION SCHEMES FOR CLOUDY COMPONENTS GREYK3B.229
! GREYK3B.230
LOGICAL !, INTENT(IN) GREYK3B.231
& L_CLOUD_CMP(NPD_CLOUD_COMPONENT) GREYK3B.232
! FLAGS TO ACTIVATE CLOUDY COMPONENTS GREYK3B.233
! GREYK3B.234
REAL !, INTENT(IN) GREYK3B.235
& CONDENSED_PARAM_LIST(NPD_CLOUD_PARAMETER GREYK3B.236
& , NPD_CLOUD_COMPONENT) GREYK3B.237
! COEFFICIENTS IN PARAMETRIZATION SCHEMES GREYK3B.238
& , CONDENSED_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER GREYK3B.239
& , NPD_CLOUD_COMPONENT) GREYK3B.240
! MIXING RATIOS OF CLOUDY COMPONENTS GREYK3B.241
& , CONDENSED_DIM_CHAR(NPD_PROFILE, 0: NPD_LAYER GREYK3B.242
& , NPD_CLOUD_COMPONENT) GREYK3B.243
! EFFECTIVE RADII OF CLOUDY COMPONENTS GREYK3B.244
! GREYK3B.245
! GREYK3B.246
! GREYK3B.247
! CALCULATED OPTICAL PROPETIES: GREYK3B.248
! GREYK3B.249
REAL !, INTENT(OUT) GREYK3B.250
& K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER) GREYK3B.251
! FREE SCATTERING EXTINCTION GREYK3B.252
& , K_EXT_TOT_FREE(NPD_PROFILE, NPD_LAYER) GREYK3B.253
! TOTAL FREE EXTINCTION GREYK3B.254
& , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER) GREYK3B.255
! FREE ASYMMETRIES GREYK3B.256
& , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER) GREYK3B.257
! FREE FORWARD SCATTERING GREYK3B.258
& , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) GREYK3B.259
! CLOUDY SCATTERING EXTINCTION GREYK3B.260
& , K_EXT_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) GREYK3B.261
! TOTAL CLOUDY EXTINCTION GREYK3B.262
& , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) GREYK3B.263
! CLOUDY ASYMMETRIES GREYK3B.264
& , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) GREYK3B.265
! CLOUDY FORWARD SCATTERING GREYK3B.266
! GREYK3B.267
! GREYK3B.268
! GREYK3B.269
! LOCAL VARIABLES. GREYK3B.270
INTEGER GREYK3B.271
& I_CONTINUUM GREYK3B.272
! TEMPORARY CONTINUUM INDEX GREYK3B.273
& , I_POINTER GREYK3B.274
! TEMPORARY POINTER GREYK3B.275
& , L GREYK3B.276
! LOOP VARIABLE GREYK3B.277
& , LL GREYK3B.278
! LOOP VARIABLE GREYK3B.279
& , I GREYK3B.280
! LOOP VARIABLE GREYK3B.281
& , J GREYK3B.282
! LOOP VARIABLE GREYK3B.283
& , K GREYK3B.284
! LOOP VARIABLE GREYK3B.285
& , N_INDEX GREYK3B.286
! NUMBER OF INDICES SATISFYING TEST GREYK3B.287
& , INDEX(NPD_PROFILE) GREYK3B.288
! INDICES OF TESTED POINTS GREYK3B.289
! GREYK3B.290
! TEMPORARY OPTICAL PROPERTIES: GREYK3B.291
! GREYK3B.292
REAL GREYK3B.293
& K_EXT_SCAT_CLOUD_COMP(NPD_PROFILE, NPD_LAYER) GREYK3B.294
! SCATTERING EXTINCTION OF CLOUDY COMPONENT GREYK3B.295
& , K_EXT_TOT_CLOUD_COMP(NPD_PROFILE, NPD_LAYER) GREYK3B.296
! TOTAL EXTINCTION OF CLOUDY COMPONENT GREYK3B.297
& , ASYMMETRY_CLOUD_COMP(NPD_PROFILE, NPD_LAYER) GREYK3B.298
! ASYMMETRIES OF CLOUDY COMPONENT GREYK3B.299
& , FORWARD_SCATTER_CLOUD_COMP(NPD_PROFILE, NPD_LAYER) GREYK3B.300
! FORWARD SCATTERING OF CLOUDY COMPONENT GREYK3B.301
& , K_SCATTER(NPD_PROFILE) GREYK3B.302
! SCATTERING VARIABLE GREYK3B.303
& , ASYMMETRY_PROCESS(NPD_PROFILE) GREYK3B.304
! ASYMMETRY FACTOR FOR CURRENT PROC. GREYK3B.305
! GREYK3B.306
! GREYK3B.307
REAL GREYK3B.308
& WEIGHT_UPPER GREYK3B.309
! UPPER WEIGHT FOR INTERPOLATION GREYK3B.310
& , WEIGHT_LOWER GREYK3B.311
! LOWER WEIGHT FOR INTERPOLATION GREYK3B.312
! GREYK3B.313
! Temporary variables for the divisions GREYK3B.314
REAL GREYK3B.315
& TMP_INV,TMP_INV1 GREYK3B.316
GREYK3B.317
! SUBROUTINES CALLED: GREYK3B.318
EXTERNAL GREYK3B.319
& OPT_PROP_WATER_CLOUD, OPT_PROP_ICE_CLOUD GREYK3B.320
! GREYK3B.321
! CRAY DIRECTIVES FOR THE WHOLE ROUTINE: GREYK3B.322
! POINTS ARE NOT REPEATED IN THE INDEXING ARRAY, SO IT IS SAFE GREYK3B.323
! TO VECTORIZE OVER INDIRECTLY ADDRESSED ARRAYS. GREYK3B.324
Cfpp$ NODEPCHK R GREYK3B.325
! GREYK3B.326
! GREYK3B.327
! GREYK3B.328
! INITIALIZE THE EXTINCTION COEFFICIENTS AND THE ASYMMETRY PRODUCT. GREYK3B.329
GREYK3B.330
IF(L_RESCALE) THEN GREYK3B.331
GREYK3B.332
! Forward scattering is required only in the visible where GREYK3B.333
! delta-rescaling is performed. GREYK3B.334
GREYK3B.335
IF(.NOT.L_RAYLEIGH) THEN GREYK3B.336
GREYK3B.337
DO I=1, N_LAYER GREYK3B.338
DO L=1, N_PROFILE GREYK3B.339
K_EXT_TOT_FREE(L, I)=0.0E+00 GREYK3B.340
K_EXT_SCAT_FREE(L, I)=0.0E+00 GREYK3B.341
ASYMMETRY_FREE(L, I)=0.0E+00 GREYK3B.342
FORWARD_SCATTER_FREE(L, I)=0.0E+00 GREYK3B.343
ENDDO GREYK3B.344
ENDDO GREYK3B.345
GREYK3B.346
ELSE IF(L_RAYLEIGH) THEN GREYK3B.347
GREYK3B.348
! INCLUDE RAYLEIGH SCATTERING. GREYK3B.349
GREYK3B.350
DO I=1, N_LAYER GREYK3B.351
DO L=1, N_PROFILE GREYK3B.352
K_EXT_TOT_FREE(L, I)=0.0E+00 GREYK3B.353
K_EXT_SCAT_FREE(L, I)=RAYLEIGH_COEFF GREYK3B.354
ASYMMETRY_FREE(L, I)=0.0E+00 GREYK3B.355
FORWARD_SCATTER_FREE(L, I)=0.0E+00 GREYK3B.356
ENDDO GREYK3B.357
ENDDO GREYK3B.358
END IF GREYK3B.359
GREYK3B.360
ELSE IF(.NOT.L_RESCALE) THEN GREYK3B.361
GREYK3B.362
IF(.NOT.L_RAYLEIGH) THEN GREYK3B.363
GREYK3B.364
DO I=1, N_LAYER GREYK3B.365
DO L=1, N_PROFILE GREYK3B.366
K_EXT_TOT_FREE(L, I)=0.0E+00 GREYK3B.367
K_EXT_SCAT_FREE(L, I)=0.0E+00 GREYK3B.368
ASYMMETRY_FREE(L, I)=0.0E+00 GREYK3B.369
ENDDO GREYK3B.370
ENDDO GREYK3B.371
GREYK3B.372
ELSE IF(L_RAYLEIGH) THEN GREYK3B.373
GREYK3B.374
! INCLUDE RAYLEIGH SCATTERING. GREYK3B.375
GREYK3B.376
DO I=1, N_LAYER GREYK3B.377
DO L=1, N_PROFILE GREYK3B.378
K_EXT_TOT_FREE(L, I)=0.0E+00 GREYK3B.379
K_EXT_SCAT_FREE(L, I)=RAYLEIGH_COEFF GREYK3B.380
ASYMMETRY_FREE(L, I)=0.0E+00 GREYK3B.381
ENDDO GREYK3B.382
ENDDO GREYK3B.383
GREYK3B.384
END IF GREYK3B.385
GREYK3B.386
END IF GREYK3B.387
GREYK3B.388
! GREYK3B.389
IF (L_AEROSOL) THEN GREYK3B.390
! INCLUDE THE EFFECTS OF AEROSOL. GREYK3B.391
DO J=1, N_AEROSOL GREYK3B.392
IF (I_AEROSOL_PARAMETRIZATION(J) GREYK3B.393
& .EQ.IP_AEROSOL_PARAM_DRY) THEN GREYK3B.394
DO I=1, N_LAYER GREYK3B.395
DO L=1, N_PROFILE GREYK3B.396
K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I) GREYK3B.397
& +AEROSOL_MIX_RATIO(L, I, J) GREYK3B.398
& *AEROSOL_ABSORPTION(1, J) GREYK3B.399
K_SCATTER(L)=AEROSOL_MIX_RATIO(L, I, J) GREYK3B.400
& *AEROSOL_SCATTERING(1, J) GREYK3B.401
K_EXT_SCAT_FREE(L, I)=K_EXT_SCAT_FREE(L, I) GREYK3B.402
& +K_SCATTER(L) GREYK3B.403
ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I) GREYK3B.404
& +K_SCATTER(L)*AEROSOL_ASYMMETRY(1, J) GREYK3B.405
ENDDO GREYK3B.406
IF (L_RESCALE) THEN GREYK3B.407
! THIS BLOCK IS PLACED WITHIN THE LOOP OVER I TO SAVE GREYK3B.408
! STORAGE. THE COST OF RE-EXECUTING THE TEST IS QUITE GREYK3B.409
! SMALL. GREYK3B.410
DO L=1, N_PROFILE GREYK3B.411
FORWARD_SCATTER_FREE(L, I) GREYK3B.412
& =FORWARD_SCATTER_FREE(L, I)+K_SCATTER(L) GREYK3B.413
& *(AEROSOL_ASYMMETRY(1, J))**2 GREYK3B.414
ENDDO GREYK3B.415
ENDIF GREYK3B.416
ENDDO GREYK3B.417
ELSE IF (I_AEROSOL_PARAMETRIZATION(J) GREYK3B.418
& .EQ.IP_AEROSOL_PARAM_MOIST) THEN GREYK3B.419
DO I=1, N_LAYER GREYK3B.420
DO L=1, N_PROFILE GREYK3B.421
I_POINTER=I_HUMIDITY_POINTER(L, I) GREYK3B.422
WEIGHT_UPPER=(MEAN_REL_HUMIDITY(L, I) GREYK3B.423
& -HUMIDITIES(I_POINTER, J)) GREYK3B.424
& /DELTA_HUMIDITY GREYK3B.425
WEIGHT_LOWER=1.0E+00-WEIGHT_UPPER GREYK3B.426
K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I) GREYK3B.427
& +AEROSOL_MIX_RATIO(L, I, J) GREYK3B.428
& *(AEROSOL_ABSORPTION(I_POINTER, J) GREYK3B.429
& *WEIGHT_LOWER+WEIGHT_UPPER GREYK3B.430
& *AEROSOL_ABSORPTION(I_POINTER+1, J)) GREYK3B.431
K_SCATTER(L)= GREYK3B.432
& AEROSOL_MIX_RATIO(L, I, J) GREYK3B.433
& *(AEROSOL_SCATTERING(I_POINTER, J) GREYK3B.434
& *WEIGHT_LOWER+WEIGHT_UPPER GREYK3B.435
& *AEROSOL_SCATTERING(I_POINTER+1, J)) GREYK3B.436
K_EXT_SCAT_FREE(L, I)=K_EXT_SCAT_FREE(L, I) GREYK3B.437
& +K_SCATTER(L) GREYK3B.438
ASYMMETRY_PROCESS(L)= GREYK3B.439
& AEROSOL_ASYMMETRY(I_POINTER, J) GREYK3B.440
& *WEIGHT_LOWER+WEIGHT_UPPER GREYK3B.441
& *AEROSOL_ASYMMETRY(I_POINTER+1, J) GREYK3B.442
ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I) GREYK3B.443
& +K_SCATTER(L)*ASYMMETRY_PROCESS(L) GREYK3B.444
ENDDO GREYK3B.445
IF (L_RESCALE) THEN GREYK3B.446
DO L=1, N_PROFILE GREYK3B.447
FORWARD_SCATTER_FREE(L, I) GREYK3B.448
& =FORWARD_SCATTER_FREE(L, I)+K_SCATTER(L) GREYK3B.449
& *(ASYMMETRY_PROCESS(L))**2 GREYK3B.450
ENDDO GREYK3B.451
ENDIF GREYK3B.452
ENDDO GREYK3B.453
ELSE GREYK3B.454
WRITE(IU_ERR, '(/A, I3, A)') GREYK3B.455
& '*** ERROR : I_AEROSOL_PARAMETRIZATION FOR SPECIES ' GREYK3B.456
& , J, ' HAS BEEN SET TO AN ILLEGAL VALUE.' GREYK3B.457
IERR=I_ERR_FATAL GREYK3B.458
RETURN GREYK3B.459
GREYK3B.460
ENDIF GREYK3B.461
ENDDO GREYK3B.462
ENDIF GREYK3B.463
! GREYK3B.464
IF (L_CONTINUUM) THEN GREYK3B.465
! INCLUDE CONTINUUM ABSORPTION. GREYK3B.466
DO J=1, N_CONTINUUM GREYK3B.467
I_CONTINUUM=I_CONTINUUM_POINTER(J) GREYK3B.468
DO I=1, N_LAYER GREYK3B.469
DO L=1, N_PROFILE GREYK3B.470
K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I) GREYK3B.471
& +K_CONTINUUM(I_CONTINUUM) GREYK3B.472
& *AMOUNT_CONTINUUM(L, I, I_CONTINUUM) GREYK3B.473
ENDDO GREYK3B.474
ENDDO GREYK3B.475
ENDDO GREYK3B.476
ENDIF GREYK3B.477
! GREYK3B.478
! GREYK3B.479
! ADD THE SCATTERING ON TO THE TOTAL EXTINCTION. THE FINAL FREE GREYK3B.480
! ASYMMETRY IS NOT CALCULATED HERE SINCE THE PRODUCT OF ASYMMETRY GREYK3B.481
! AND SCATTERING IS ALSO NEEDED TO CALCULATE THE CLOUDY ASYMMETRY. GREYK3B.482
DO I=1, N_LAYER GREYK3B.483
DO L=1, N_PROFILE GREYK3B.484
K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I) GREYK3B.485
& +K_EXT_SCAT_FREE(L, I) GREYK3B.486
ENDDO GREYK3B.487
ENDDO GREYK3B.488
! GREYK3B.489
! GREYK3B.490
! IF THERE ARE NO CLOUDS CALCULATE THE FINAL OPTICAL PROPERTIES GREYK3B.491
! AND RETURN TO THE CALLING ROUTINE. GREYK3B.492
! GREYK3B.493
IF (.NOT.L_CLOUD) THEN GREYK3B.494
GREYK3B.495
IF(.NOT.L_RESCALE) THEN GREYK3B.496
DO I=1, N_LAYER GREYK3B.497
DO L=1, N_PROFILE GREYK3B.498
IF (K_EXT_SCAT_FREE(L, I).GT.TOL_DIV) THEN GREYK3B.499
ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I) GREYK3B.500
& /K_EXT_SCAT_FREE(L, I) GREYK3B.501
ENDIF GREYK3B.502
ENDDO GREYK3B.503
ENDDO GREYK3B.504
ELSE IF (L_RESCALE) THEN GREYK3B.505
DO I=1, N_LAYER GREYK3B.506
DO L=1, N_PROFILE GREYK3B.507
IF (K_EXT_SCAT_FREE(L, I).GT.TOL_DIV) THEN GREYK3B.508
TMP_INV=1.0/K_EXT_SCAT_FREE(L,I) GREYK3B.509
FORWARD_SCATTER_FREE(L, I) GREYK3B.510
& =FORWARD_SCATTER_FREE(L, I) GREYK3B.511
& *TMP_INV GREYK3B.512
ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I) GREYK3B.513
& *TMP_INV GREYK3B.514
ENDIF GREYK3B.515
ENDDO GREYK3B.516
ENDDO GREYK3B.517
GREYK3B.518
ENDIF GREYK3B.519
GREYK3B.520
RETURN GREYK3B.521
GREYK3B.522
ENDIF GREYK3B.523
GREYK3B.524
GREYK3B.525
! GREYK3B.526
! ADDITION OF CLOUDY PROPERTIES: GREYK3B.527
! GREYK3B.528
! GREYK3B.529
! ADD IN BACKGROUND CONTIBUTIONS: GREYK3B.530
! GREYK3B.531
! GREYK3B.532
! ALL THE PROCESSES OCCURRING OUTSIDE CLOUDS ALSO OCCUR GREYK3B.533
! WITHIN THEM. GREYK3B.534
DO K=1, N_CLOUD_TYPE GREYK3B.535
DO I=1, N_LAYER GREYK3B.536
DO L=1, N_PROFILE GREYK3B.537
K_EXT_TOT_CLOUD(L, I, K)=K_EXT_TOT_FREE(L, I) GREYK3B.538
K_EXT_SCAT_CLOUD(L, I, K)=K_EXT_SCAT_FREE(L, I) GREYK3B.539
ASYMMETRY_CLOUD(L, I, K)=ASYMMETRY_FREE(L, I) GREYK3B.540
FORWARD_SCATTER_CLOUD(L, I, K) GREYK3B.541
& =FORWARD_SCATTER_FREE(L, I) GREYK3B.542
ENDDO GREYK3B.543
ENDDO GREYK3B.544
ENDDO GREYK3B.545
! GREYK3B.546
! GREYK3B.547
! GREYK3B.548
! ADD ON THE TERMS REPRESENTING PROCESSES WITHIN CLOUDS. GREYK3B.549
! GREYK3B.550
! LOOP OVER THE CONDENSED COMPONENTS, CALCULATING THEIR OPTICAL GREYK3B.551
! PROPERTIES AND THEN ASSIGN THEM TO THE ARRAYS FOR THE TYPES OF GREYK3B.552
! CLOUD. GREYK3B.553
! GREYK3B.554
DO K=1, N_CONDENSED GREYK3B.555
! GREYK3B.556
! FLAGS FOR DEALING WITH COMPONENTS WERE SET IN THE SUBROUTINE GREYK3B.557
! SET_CLOUD_POINTER. WE NOW DETERMINE WHETHER THE COMPONENT IS GREYK3B.558
! TO BE INCLUDED AND CALCULATE ITS OPTICAL PROPERTIES ACCORDING GREYK3B.559
! TO THE PHASE OF THE COMPONENT. THESE CONTRIBUTIONS ARE ADDED GREYK3B.560
! TO THE ARRAYS FOR THE SELECTED TYPE OF CLOUD. GREYK3B.561
! GREYK3B.562
IF (L_CLOUD_CMP(K)) THEN GREYK3B.563
! GREYK3B.564
IF (I_PHASE_CMP(K).EQ.IP_PHASE_WATER) THEN GREYK3B.565
! GREYK3B.566
! INCLUDE SCATTERING BY WATER DROPLETS. GREYK3B.567
! GREYK3B.568
CALL OPT_PROP_WATER_CLOUD
(IERR GREYK3B.569
& , N_PROFILE, N_LAYER, N_CLOUD_TOP GREYK3B.570
& , N_CLOUD_PROFILE, I_CLOUD_PROFILE GREYK3B.571
& , L_RESCALE, L_LAYER, L_CLOUD_LAYER GREYK3B.572
& , I_CONDENSED_PARAM(K), CONDENSED_PARAM_LIST(1, K) GREYK3B.573
& , CONDENSED_MIX_RATIO(1, 0, K) GREYK3B.574
& , CONDENSED_DIM_CHAR(1, 0, K) GREYK3B.575
& , K_EXT_TOT_CLOUD_COMP, K_EXT_SCAT_CLOUD_COMP GREYK3B.576
& , ASYMMETRY_CLOUD_COMP, FORWARD_SCATTER_CLOUD_COMP GREYK3B.577
& , NPD_PROFILE, NPD_LAYER GREYK3B.578
& , NPD_CLOUD_PARAMETER GREYK3B.579
& ) GREYK3B.580
! GREYK3B.581
ELSE IF (I_PHASE_CMP(K).EQ.IP_PHASE_ICE) THEN GREYK3B.582
! GREYK3B.583
! INCLUDE SCATTERING BY ICE CRYSTALS. GREYK3B.584
! GREYK3B.585
CALL OPT_PROP_ICE_CLOUD
(IERR GREYK3B.586
& , N_PROFILE, N_LAYER, N_CLOUD_TOP GREYK3B.587
& , N_CLOUD_PROFILE, I_CLOUD_PROFILE GREYK3B.588
& , L_RESCALE, L_LAYER, L_CLOUD_LAYER GREYK3B.589
& , I_CONDENSED_PARAM(K), CONDENSED_PARAM_LIST(1, K) GREYK3B.590
& , CONDENSED_MIX_RATIO(1, 0, K) GREYK3B.591
& , CONDENSED_DIM_CHAR(1, 0, K) GREYK3B.592
& , T, DENSITY GREYK3B.593
& , K_EXT_TOT_CLOUD_COMP, K_EXT_SCAT_CLOUD_COMP GREYK3B.594
& , ASYMMETRY_CLOUD_COMP, FORWARD_SCATTER_CLOUD_COMP GREYK3B.595
& , NPD_PROFILE, NPD_LAYER GREYK3B.596
& , NPD_CLOUD_PARAMETER GREYK3B.597
& ) GREYK3B.598
! GREYK3B.599
ENDIF GREYK3B.600
! GREYK3B.601
! GREYK3B.602
! GREYK3B.603
! INCREMENT THE ARRAYS OF OPTICAL PROPERTIES. GREYK3B.604
! GREYK3B.605
! GREYK3B.606
DO I=N_CLOUD_TOP, N_LAYER GREYK3B.607
DO LL=1, N_CLOUD_PROFILE(I) GREYK3B.608
L=I_CLOUD_PROFILE(LL, I) GREYK3B.609
K_EXT_TOT_CLOUD(L, I, I_CLOUD_TYPE(K)) GREYK3B.610
& =K_EXT_TOT_CLOUD(L, I, I_CLOUD_TYPE(K)) GREYK3B.611
& +K_EXT_TOT_CLOUD_COMP(L, I) GREYK3B.612
K_EXT_SCAT_CLOUD(L, I, I_CLOUD_TYPE(K)) GREYK3B.613
& =K_EXT_SCAT_CLOUD(L, I, I_CLOUD_TYPE(K)) GREYK3B.614
& +K_EXT_SCAT_CLOUD_COMP(L, I) GREYK3B.615
ASYMMETRY_CLOUD(L, I, I_CLOUD_TYPE(K)) GREYK3B.616
& =ASYMMETRY_CLOUD(L, I, I_CLOUD_TYPE(K)) GREYK3B.617
& +ASYMMETRY_CLOUD_COMP(L, I) GREYK3B.618
ENDDO GREYK3B.619
ENDDO GREYK3B.620
IF (L_RESCALE) THEN GREYK3B.621
DO I=N_CLOUD_TOP, N_LAYER GREYK3B.622
DO LL=1, N_CLOUD_PROFILE(I) GREYK3B.623
L=I_CLOUD_PROFILE(LL, I) GREYK3B.624
FORWARD_SCATTER_CLOUD(L, I, I_CLOUD_TYPE(K)) GREYK3B.625
& =FORWARD_SCATTER_CLOUD(L, I, I_CLOUD_TYPE(K)) GREYK3B.626
& +FORWARD_SCATTER_CLOUD_COMP(L, I) GREYK3B.627
ENDDO GREYK3B.628
ENDDO GREYK3B.629
ENDIF GREYK3B.630
! GREYK3B.631
ENDIF GREYK3B.632
! GREYK3B.633
ENDDO GREYK3B.634
! GREYK3B.635
! GREYK3B.636
! GREYK3B.637
! GREYK3B.638
! CALCULATE THE FINAL OPTICAL PROPERTIES. GREYK3B.639
! THE SCATTERING WAS INCLUDED IN THE FREE TOTAL EXTINCTION EARLIER, GREYK3B.640
! BUT WE HAVE YET TO DIVIDE THE PRODUCT OF THE ASYMMETRY AND THE GREYK3B.641
! SCATTERING BY THE MEAN SCATTERING. GREYK3B.642
! GREYK3B.643
DO I=1, N_LAYER GREYK3B.644
! GREYK3B.645
N_INDEX=0 GREYK3B.646
DO L =1,N_PROFILE GREYK3B.647
IF (K_EXT_SCAT_FREE(L,I).GT.TOL_DIV) THEN GREYK3B.648
N_INDEX =N_INDEX+1 GREYK3B.649
INDEX(N_INDEX)=L GREYK3B.650
END IF GREYK3B.651
END DO GREYK3B.652
! GREYK3B.653
IF(.NOT.L_RESCALE) THEN GREYK3B.654
DO K=1, N_INDEX GREYK3B.655
ASYMMETRY_FREE(INDEX(K), I)=ASYMMETRY_FREE(INDEX(K), I) GREYK3B.656
& /K_EXT_SCAT_FREE(INDEX(K), I) GREYK3B.657
ENDDO GREYK3B.658
! GREYK3B.659
ELSE IF (L_RESCALE.AND.N_INDEX.GT.0) THEN GREYK3B.660
TMP_INV=1.0 GREYK3B.661
& /K_EXT_SCAT_FREE(INDEX(1), I) GREYK3B.662
DO K=1, N_INDEX-1 GREYK3B.663
TMP_INV1=1.0 GREYK3B.664
& /K_EXT_SCAT_FREE(INDEX(K+1), I) GREYK3B.665
FORWARD_SCATTER_FREE(INDEX(K), I) GREYK3B.666
& =FORWARD_SCATTER_FREE(INDEX(K), I) GREYK3B.667
& *TMP_INV GREYK3B.668
ASYMMETRY_FREE(INDEX(K), I)=ASYMMETRY_FREE(INDEX(K), I) GREYK3B.669
& *TMP_INV GREYK3B.670
TMP_INV=TMP_INV1 GREYK3B.671
ENDDO GREYK3B.672
FORWARD_SCATTER_FREE(INDEX(N_INDEX), I) GREYK3B.673
& =FORWARD_SCATTER_FREE(INDEX(N_INDEX), I) GREYK3B.674
& *TMP_INV GREYK3B.675
ASYMMETRY_FREE(INDEX(N_INDEX), I)= GREYK3B.676
& ASYMMETRY_FREE(INDEX(N_INDEX), I) GREYK3B.677
& *TMP_INV GREYK3B.678
ENDIF GREYK3B.679
ENDDO GREYK3B.680
! GREYK3B.681
! GREYK3B.682
! REPEAT FOR CLOUDS. GREYK3B.683
DO K=1, N_CLOUD_TYPE GREYK3B.684
DO I=N_CLOUD_TOP, N_LAYER GREYK3B.685
! GREYK3B.686
J =1 GREYK3B.687
N_INDEX=0 GREYK3B.688
DO L =1,N_PROFILE GREYK3B.689
IF (K_EXT_SCAT_CLOUD(L,I,K).GT.TOL_DIV) THEN GREYK3B.690
INDEX(J)=L GREYK3B.691
J =J+1 GREYK3B.692
N_INDEX =N_INDEX+1 GREYK3B.693
END IF GREYK3B.694
END DO GREYK3B.695
GREYK3B.696
IF(.NOT.L_RESCALE) THEN GREYK3B.697
DO J=1, N_INDEX GREYK3B.698
ASYMMETRY_CLOUD(INDEX(J), I, K) GREYK3B.699
& =ASYMMETRY_CLOUD(INDEX(J), I, K) GREYK3B.700
& /K_EXT_SCAT_CLOUD(INDEX(J), I, K) GREYK3B.701
ENDDO GREYK3B.702
ELSE IF (L_RESCALE.AND.N_INDEX.GT.0) THEN GREYK3B.703
TMP_INV=1.0 GREYK3B.704
& /K_EXT_SCAT_CLOUD(INDEX(1), I, K) GREYK3B.705
DO J=1, N_INDEX-1 GREYK3B.706
TMP_INV1=1.0 GREYK3B.707
& /K_EXT_SCAT_CLOUD(INDEX(J+1), I, K) GREYK3B.708
FORWARD_SCATTER_CLOUD(INDEX(J), I, K) GREYK3B.709
& =FORWARD_SCATTER_CLOUD(INDEX(J), I, K) GREYK3B.710
& *TMP_INV GREYK3B.711
ASYMMETRY_CLOUD(INDEX(J), I, K) GREYK3B.712
& =ASYMMETRY_CLOUD(INDEX(J), I, K) GREYK3B.713
& *TMP_INV GREYK3B.714
TMP_INV=TMP_INV1 GREYK3B.715
ENDDO GREYK3B.716
FORWARD_SCATTER_CLOUD(INDEX(N_INDEX), I, K) GREYK3B.717
& =FORWARD_SCATTER_CLOUD(INDEX(N_INDEX), I, K) GREYK3B.718
& *TMP_INV GREYK3B.719
ASYMMETRY_CLOUD(INDEX(N_INDEX), I, K) GREYK3B.720
& =ASYMMETRY_CLOUD(INDEX(N_INDEX), I, K) GREYK3B.721
& *TMP_INV GREYK3B.722
ENDIF GREYK3B.723
GREYK3B.724
GREYK3B.725
ENDDO GREYK3B.726
ENDDO GREYK3B.727
GREYK3B.728
RETURN GREYK3B.729
END GREYK3B.730
GREYK3B.731
*ENDIF DEF,A01_3A,OR,DEF,A02_3A GREYK3B.732
*ENDIF DEF,A70_1B GREYK3B.733