*IF DEF,A70_1A,OR,DEF,A70_1B APB4F405.45
*IF DEF,A01_3A,OR,DEF,A02_3A MONFX3A.2
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.13467
C GTS2F400.13468
C Use, duplication or disclosure of this code is subject to the GTS2F400.13469
C restrictions as set forth in the contract. GTS2F400.13470
C GTS2F400.13471
C Meteorological Office GTS2F400.13472
C London Road GTS2F400.13473
C BRACKNELL GTS2F400.13474
C Berkshire UK GTS2F400.13475
C RG12 2SZ GTS2F400.13476
C GTS2F400.13477
C If no contract has been raised with this copy of the code, the use, GTS2F400.13478
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.13479
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.13480
C Modelling at the above address. GTS2F400.13481
C ******************************COPYRIGHT****************************** GTS2F400.13482
C GTS2F400.13483
!+ Subroutine to solve for the monochromatic fluxes. MONFX3A.3
! MONFX3A.4
! Method: MONFX3A.5
! The final single scattering properties are calculated MONFX3A.6
! and rescaled. An appropriate subroutine is called to MONFX3A.7
! calculate the fluxes depending on the treatment of MONFX3A.8
! cloudiness. MONFX3A.9
! MONFX3A.10
! Current Owner of Code: J. M. Edwards MONFX3A.11
! MONFX3A.12
! History: MONFX3A.13
! Version Date Comment MONFX3A.14
! 4.0 27-07-95 Original Code MONFX3A.15
! (J. M. Edwards) MONFX3A.16
! 4.2 08-08-96 Code for vertically ADB1F402.523
! coherent cloud added. ADB1F402.524
! (J. M. Edwards) ADB1F402.525
! 4.5 18-05-98 Variable for obsolete ADB1F405.381
! solver removed. ADB1F405.382
! Unused variables ADB1F405.383
! removed from call ADB1F405.384
! to TRPILE_COLUMN. ADB1F405.385
! (J. M. Edwards) ADB1F405.386
! MONFX3A.17
! Description of Code: MONFX3A.18
! FORTRAN 77 with extensions listed in documentation. MONFX3A.19
! MONFX3A.20
!- --------------------------------------------------------------------- MONFX3A.21
SUBROUTINE MONOCHROMATIC_FLUX(IERR 7,8MONFX3A.22
! Atmospheric Propetries MONFX3A.23
& , N_PROFILE, N_LAYER, D_MASS MONFX3A.24
! Angular Integration MONFX3A.25
& , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT MONFX3A.26
& , L_RESCALE, N_ORDER_GAUSS MONFX3A.27
! Treatment of Scattering MONFX3A.28
& , I_SCATTER_METHOD_BAND MONFX3A.29
! Options for Solver MONFX3A.30
& , I_SOLVER, L_NET, N_AUGMENT ADB1F405.387
! Gaseous Propeties MONFX3A.32
& , K_GAS_ABS MONFX3A.33
! Options for Equivalent Extinction MONFX3A.34
& , L_SCALE_SOLAR, ADJUST_SOLAR_KE MONFX3A.35
! Spectral Region MONFX3A.36
& , ISOLIR MONFX3A.37
! Infra-red Properties MONFX3A.38
& , DIFF_PLANCK MONFX3A.39
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_2 MONFX3A.40
! Conditions at TOA MONFX3A.41
& , SEC_0, FLUX_INC_DIRECT, FLUX_INC_DOWN MONFX3A.42
! Surface Propeties MONFX3A.43
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND MONFX3A.44
& , GROUND_EMISSION MONFX3A.45
! Clear-sky Optical Propeties MONFX3A.46
& , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE MONFX3A.47
& , FORWARD_SCATTER_FREE MONFX3A.48
! Cloudy Properties MONFX3A.49
& , L_CLOUD, I_CLOUD MONFX3A.50
! Cloud Geometry MONFX3A.51
& , N_CLOUD_TOP MONFX3A.52
& , N_CLOUD_TYPE, FRAC_CLOUD MONFX3A.53
& , I_REGION_CLOUD, FRAC_REGION ADB1F402.526
& , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE MONFX3A.54
& , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE MONFX3A.55
& , CLOUD_OVERLAP MONFX3A.56
& , N_COLUMN, L_COLUMN, AREA_COLUMN MONFX3A.57
! Cloudy Optical Propeties MONFX3A.58
& , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD MONFX3A.59
& , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD MONFX3A.60
! Fluxes Calculated MONFX3A.61
& , FLUX_DIRECT, FLUX_TOTAL MONFX3A.62
! Flags for Clear-sky Calculation MONFX3A.63
& , L_CLEAR, I_SOLVER_CLEAR MONFX3A.64
! Clear-sky Fluxes Calculated MONFX3A.65
& , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR MONFX3A.66
! Planckian Source MONFX3A.67
& , PLANCK_SOURCE MONFX3A.68
! Dimensions of Arrays MONFX3A.69
& , NPD_PROFILE, NPD_LAYER, NPD_COLUMN MONFX3A.70
& ) MONFX3A.71
! MONFX3A.72
! MONFX3A.73
IMPLICIT NONE MONFX3A.74
! MONFX3A.75
! MONFX3A.76
! SIZES OF DUMMY ARRAYS. MONFX3A.77
INTEGER !, INTENT(IN) MONFX3A.78
& NPD_PROFILE MONFX3A.79
! MAXIMUM NUMBER OF PROFILES MONFX3A.80
& , NPD_LAYER MONFX3A.81
! MAXIMUM NUMBER OF LAYERS MONFX3A.82
& , NPD_COLUMN MONFX3A.83
! NUMBER OF COLUMNS PER POINT MONFX3A.84
! MONFX3A.85
! INCLUDE COMDECKS. MONFX3A.86
*CALL DIMFIX3A
MONFX3A.87
*CALL CLSCHM3A
MONFX3A.88
*CALL ANGINT3A
MONFX3A.89
*CALL ERROR3A
MONFX3A.90
! MONFX3A.91
! MONFX3A.92
! MONFX3A.93
! DUMMY ARGUMENTS. MONFX3A.94
INTEGER !, INTENT(OUT) MONFX3A.95
& IERR MONFX3A.96
! ERROR FLAG MONFX3A.97
! MONFX3A.98
! Atmospheric Properties MONFX3A.99
INTEGER !, INTENT(IN) MONFX3A.100
& N_PROFILE MONFX3A.101
! NUMBER OF PROFILES MONFX3A.102
& , N_LAYER MONFX3A.103
! NUMBER OF LAYERS MONFX3A.104
REAL !, INTENT(IN) MONFX3A.105
& D_MASS(NPD_PROFILE, NPD_LAYER) MONFX3A.106
! MASS THICKNESS OF EACH LAYER MONFX3A.107
! MONFX3A.108
! Angular Integration MONFX3A.109
INTEGER !, INTENT(IN) MONFX3A.110
& I_ANGULAR_INTEGRATION MONFX3A.111
! ANGULAR INTEGRATION SCHEME MONFX3A.112
& , I_2STREAM MONFX3A.113
! TWO-STREAM SCHEME MONFX3A.114
& , N_ORDER_GAUSS MONFX3A.115
! ORDER OF GAUSSIAN INTEGRATION MONFX3A.116
LOGICAL !, INTENT(IN) MONFX3A.117
& L_2_STREAM_CORRECT MONFX3A.118
! CORRECTION TO TWO-STREAM SCHEME MONFX3A.119
& , L_RESCALE MONFX3A.120
! RESCALE OPTICAL PROPERTIES MONFX3A.121
! MONFX3A.122
! Treatment of Scattering MONFX3A.123
INTEGER !, INTENT(IN) MONFX3A.124
& I_SCATTER_METHOD_BAND MONFX3A.125
! MONFX3A.126
! Options for Solver MONFX3A.127
INTEGER !, INTENT(IN) MONFX3A.128
& I_SOLVER MONFX3A.129
! SOLVER USED MONFX3A.130
& , N_AUGMENT MONFX3A.133
! LENGTH OF LONG FLUX VECTOR MONFX3A.134
LOGICAL !, INTENT(IN) MONFX3A.135
& L_NET MONFX3A.136
! CALCULATE NET FLUXES MONFX3A.137
! MONFX3A.138
! Gaseous Properties MONFX3A.139
REAL !, INTENT(IN) MONFX3A.140
& K_GAS_ABS(NPD_PROFILE, NPD_LAYER) MONFX3A.141
! GASEOUS ABSORPTIVE EXTINCTIONS MONFX3A.142
! MONFX3A.143
! Variables for Equivalent Extinction MONFX3A.144
LOGICAL !, INTENT(IN) MONFX3A.145
& L_SCALE_SOLAR MONFX3A.146
! APPLY SCALING TO SOLAR FLUX MONFX3A.147
REAL !, INTENT(IN) MONFX3A.148
& ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER) MONFX3A.149
! ADJUSTMENT OF SOLAR BEAM WITH EQUIVALENT EXTINCTION MONFX3A.150
! MONFX3A.151
! Spectral Region MONFX3A.152
INTEGER !, INTENT(IN) MONFX3A.153
& ISOLIR MONFX3A.154
! VISIBLE OR IR MONFX3A.155
! MONFX3A.156
! Infra-red Properties MONFX3A.157
LOGICAL !, INTENT(IN) MONFX3A.158
& L_IR_SOURCE_QUAD MONFX3A.159
! FLAG FOR QUADRATIC IR-SOURCE MONFX3A.160
REAL !, INTENT(IN) MONFX3A.161
& PLANCK_SOURCE(NPD_PROFILE, 0: NPD_LAYER) MONFX3A.162
! MONOCHROMATIC PLANCKIAN SOURCE MONFX3A.163
& , DIFF_PLANCK(NPD_PROFILE, NPD_LAYER) MONFX3A.164
! THERMAL SOURCE FUNCTION MONFX3A.165
& , DIFF_PLANCK_2(NPD_PROFILE, NPD_LAYER) MONFX3A.166
! 2ND DIFF. OF THERMAL SOURCE FUNCTION MONFX3A.167
! MONFX3A.168
! Conditions at TOA MONFX3A.169
REAL !, INTENT(IN) MONFX3A.170
& SEC_0(NPD_PROFILE) MONFX3A.171
! SECANT OF SOLAR ZENITH ANGLE MONFX3A.172
& , FLUX_INC_DIRECT(NPD_PROFILE) MONFX3A.173
! INCIDENT DIRECT FLUX MONFX3A.174
& , FLUX_INC_DOWN(NPD_PROFILE) MONFX3A.175
! INCIDENT DOWNWARD FLUX MONFX3A.176
! MONFX3A.177
! Surface Propeties MONFX3A.178
REAL !, INTENT(IN) MONFX3A.179
& ALBEDO_SURFACE_DIFF(NPD_PROFILE) MONFX3A.180
! DIFFUSE SURFACE ALBEDO MONFX3A.181
& , ALBEDO_SURFACE_DIR(NPD_PROFILE) MONFX3A.182
! DIRECT SURFACE ALBEDO MONFX3A.183
& , SOURCE_GROUND(NPD_PROFILE) MONFX3A.184
! GROUND SOURCE FUNCTION MONFX3A.185
REAL !, INTENT(IN) MONFX3A.186
& GROUND_EMISSION(NPD_PROFILE) MONFX3A.187
! TOTAL FLUX EMITTED FROM GROUND MONFX3A.188
! MONFX3A.189
! Optical Properties MONFX3A.190
REAL !, INTENT(IN) MONFX3A.191
& K_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER) MONFX3A.192
! FREE ABSORPTIVE EXTINCTION MONFX3A.193
& , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER) MONFX3A.194
! FREE SCATTERING EXTINCTION MONFX3A.195
& , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER) MONFX3A.196
! CLEAR-SKY ASYMMETRY MONFX3A.197
& , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER) MONFX3A.198
! FREE FORWARD SCATTERING MONFX3A.199
! MONFX3A.200
! Cloudy Properties MONFX3A.201
LOGICAL !, INTENT(IN) MONFX3A.202
& L_CLOUD MONFX3A.203
! CLOUDS REQUIRED MONFX3A.204
INTEGER !, INTENT(IN) MONFX3A.205
& I_CLOUD MONFX3A.206
! CLOUD SCHEME USED MONFX3A.207
! MONFX3A.208
! Cloud Geometry MONFX3A.209
INTEGER !, INTENT(IN) MONFX3A.210
& N_CLOUD_TOP MONFX3A.211
! TOPMOST CLOUDY LAYER MONFX3A.212
& , N_CLOUD_TYPE MONFX3A.213
! NUMBER OF TYPES OF CLOUDS MONFX3A.214
& , N_FREE_PROFILE(NPD_LAYER) MONFX3A.215
! NUMBER OF FREE PROFILES MONFX3A.216
& , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER) MONFX3A.217
! INDICES OF FREE PROFILES MONFX3A.218
& , N_CLOUD_PROFILE(NPD_LAYER) MONFX3A.219
! NUMBER OF CLOUDY PROFILES MONFX3A.220
& , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER) MONFX3A.221
! INDICES OF CLOUDY PROFILES MONFX3A.222
& , N_COLUMN(NPD_PROFILE) MONFX3A.223
! NUMBER OF COLUMNS REQUIRED MONFX3A.224
& , I_REGION_CLOUD(NPD_CLOUD_TYPE) ADB1F402.527
! REGIONS IN WHICH TYPES OF CLOUDS FALL ADB1F402.528
LOGICAL !, INTENT(IN) MONFX3A.225
& L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN) MONFX3A.226
! FLAGS FOR CONTENTS OF COLUMNS MONFX3A.227
REAL !, INTENT(IN) MONFX3A.228
& W_CLOUD(NPD_PROFILE, NPD_LAYER) MONFX3A.229
! CLOUDY FRACTION MONFX3A.230
& , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) MONFX3A.231
! FRACTIONS OF DIFFERENT TYPES OF CLOUD MONFX3A.232
& , W_FREE(NPD_PROFILE, NPD_LAYER) MONFX3A.233
! CLEAR-SKY FRACTION MONFX3A.234
& , CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF) MONFX3A.235
! COEFFICIENTS FOR ENERGY TRANSFER AT INTERFACES MONFX3A.236
& , AREA_COLUMN(NPD_PROFILE, NPD_COLUMN) MONFX3A.237
! AREAS OF COLUMNS MONFX3A.238
& , FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION) ADB1F402.529
! FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION ADB1F402.530
! MONFX3A.239
! Cloudy Optical Properties MONFX3A.240
REAL !, INTENT(IN) MONFX3A.241
& K_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) MONFX3A.242
! CLOUDY ABSORPTIVE EXTINCTION MONFX3A.243
& , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) MONFX3A.244
! CLOUDY SCATTERING EXTINCTION MONFX3A.245
& , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) MONFX3A.246
! CLOUDY ASYMMETRY MONFX3A.247
& , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) MONFX3A.248
! CLOUDY FORWARD SCATTERING MONFX3A.249
! MONFX3A.250
! Fluxes Calculated MONFX3A.251
REAL !, INTENT(OUT) MONFX3A.252
& FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER) MONFX3A.253
! DIRECT FLUX MONFX3A.254
& , FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2) MONFX3A.255
! TOTAL FLUX MONFX3A.256
! MONFX3A.257
! Flags for Clear-sky Calculations MONFX3A.258
LOGICAL !, INTENT(IN) MONFX3A.259
& L_CLEAR MONFX3A.260
! CALCULATE CLEAR-SKY PROPERTIES MONFX3A.261
INTEGER !, INTENT(IN) MONFX3A.262
& I_SOLVER_CLEAR MONFX3A.263
! CLEAR SOLVER USED MONFX3A.264
! MONFX3A.265
! Clear-sky Fluxes Calculated MONFX3A.266
REAL !, INTENT(OUT) MONFX3A.267
& FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER) MONFX3A.268
! CLEAR-SKY DIRECT FLUX MONFX3A.269
& , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2) MONFX3A.270
! CLEAR-SKY TOTAL FLUX MONFX3A.271
! MONFX3A.272
! MONFX3A.273
! MONFX3A.274
! LOCAL VARIABLES. MONFX3A.275
INTEGER MONFX3A.276
& K MONFX3A.277
! LOOP VARIABLE MONFX3A.278
REAL MONFX3A.279
& TAU_FREE(NPD_PROFILE, NPD_LAYER) MONFX3A.280
! FREE OPTICAL DEPTH MONFX3A.281
& , OMEGA_FREE(NPD_PROFILE, NPD_LAYER) MONFX3A.282
! FREE ALBEDO OF S. S. MONFX3A.283
& , TAU_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) MONFX3A.284
! CLOUDY OPTICAL DEPTH MONFX3A.285
& , OMEGA_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) MONFX3A.286
! CLOUDY SINGLE SCATTERING ALBEDO MONFX3A.287
! MONFX3A.288
! SUBROUTINES CALLED: MONFX3A.289
EXTERNAL MONFX3A.290
& SINGLE_SCATTERING_ALL, RESCALE_TAU_OMEGA MONFX3A.291
& , TWO_STREAM MONFX3A.292
& , MIX_COLUMN, CLOUD_COLUMN MONFX3A.293
& , GAUSS_ANGLE MONFX3A.294
! MONFX3A.295
! MONFX3A.296
! MONFX3A.297
! CALCULATE SINGLE SCATTERING PROPERTIES FOR ALL ATMOSPHERIC MONFX3A.298
! CONSTITUENTS. MONFX3A.299
! MONFX3A.300
CALL SINGLE_SCATTERING_ALL
(I_SCATTER_METHOD_BAND MONFX3A.301
! Atmospheric Properties MONFX3A.302
& , N_PROFILE, N_LAYER, D_MASS MONFX3A.303
! Cloudy Properties MONFX3A.304
& , L_CLOUD, N_CLOUD_TOP, N_CLOUD_TYPE MONFX3A.305
! Optical Properties MONFX3A.306
& , K_GREY_TOT_FREE, K_EXT_SCAT_FREE MONFX3A.307
& , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD MONFX3A.308
& , K_GAS_ABS MONFX3A.309
! Single Scattering Properties MONFX3A.310
& , TAU_FREE, OMEGA_FREE MONFX3A.311
& , TAU_CLOUD, OMEGA_CLOUD MONFX3A.312
! Dimensions of Arrays MONFX3A.313
& , NPD_PROFILE, NPD_LAYER MONFX3A.314
& ) MONFX3A.315
! MONFX3A.316
! MONFX3A.317
! MONFX3A.318
IF (I_ANGULAR_INTEGRATION.EQ.IP_TWO_STREAM) THEN MONFX3A.319
! MONFX3A.320
! RESCALE TAU AND OMEGA. THE ASYMMETRY HAS ALREADY BEEN RESCALED. MONFX3A.321
! MONFX3A.322
IF (L_RESCALE) THEN MONFX3A.323
! MONFX3A.324
CALL RESCALE_TAU_OMEGA
(N_PROFILE, 1, N_LAYER MONFX3A.325
& , TAU_FREE, OMEGA_FREE, FORWARD_SCATTER_FREE MONFX3A.326
& , NPD_PROFILE, NPD_LAYER MONFX3A.327
& ) MONFX3A.328
! MONFX3A.329
IF (L_CLOUD) THEN MONFX3A.330
! MONFX3A.331
DO K=1, N_CLOUD_TYPE MONFX3A.332
CALL RESCALE_TAU_OMEGA
(N_PROFILE, N_CLOUD_TOP MONFX3A.333
& , N_LAYER MONFX3A.334
& , TAU_CLOUD(1, 1, K), OMEGA_CLOUD(1, 1, K) MONFX3A.335
& , FORWARD_SCATTER_CLOUD(1, 1, K) MONFX3A.336
& , NPD_PROFILE, NPD_LAYER MONFX3A.337
& ) MONFX3A.338
ENDDO MONFX3A.339
! MONFX3A.340
ENDIF MONFX3A.341
! MONFX3A.342
ENDIF MONFX3A.343
! MONFX3A.344
! MONFX3A.345
! SOLVE THE EQUATIONS USING THE SCHEME INDICATED BY THE VALUES MONFX3A.346
! OF I_CLOUD AND I_SOLVER. MONFX3A.347
IF (I_CLOUD.EQ.IP_CLOUD_CLEAR) THEN MONFX3A.348
! MONFX3A.349
! A TWO-STREAM SCHEME WITH NO CLOUDS. MONFX3A.350
CALL TWO_STREAM
(IERR MONFX3A.351
! Atmospheric Properties MONFX3A.352
& , N_PROFILE, N_LAYER MONFX3A.353
! Two-stream Scheme MONFX3A.354
& , I_2STREAM MONFX3A.355
! Corrections to Two-stream Equations MONFX3A.356
& , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION MONFX3A.357
! Options for Solver MONFX3A.358
& , L_NET, I_SOLVER MONFX3A.359
! Options for Equivalent Extinction MONFX3A.360
& , L_SCALE_SOLAR, ADJUST_SOLAR_KE MONFX3A.361
! Spectral Region MONFX3A.362
& , ISOLIR MONFX3A.363
! Infra-red Properties MONFX3A.364
& , DIFF_PLANCK MONFX3A.365
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_2 MONFX3A.366
! Conditions at TOA MONFX3A.367
& , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0 MONFX3A.368
! Surface Conditions MONFX3A.369
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND MONFX3A.370
! Single Scattering Propeties MONFX3A.371
& , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE MONFX3A.372
! Fluxes Calculated MONFX3A.373
& , FLUX_DIRECT, FLUX_TOTAL MONFX3A.374
! Flag for Clear-sky Fluxes MONFX3A.375
& , L_CLEAR MONFX3A.376
! Clear-sky Fluxes Calculated MONFX3A.377
& , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR MONFX3A.378
! Sizes of Arrays MONFX3A.379
& , NPD_PROFILE, NPD_LAYER MONFX3A.380
& ) MONFX3A.381
IF (IERR.NE.I_NORMAL) RETURN MONFX3A.382
! MONFX3A.383
ELSEIF ( (I_CLOUD.EQ.IP_CLOUD_MIX_MAX) MONFX3A.384
& .OR. (I_CLOUD.EQ.IP_CLOUD_MIX_RANDOM) ) THEN MONFX3A.385
! MONFX3A.386
! CLOUDS ARE TREATED USING ZDUNKOWSKI'S MIXED-COLUMN SCHEME. MONFX3A.387
! THE GEOMETRY HAS BEEN SET BEFORE. MONFX3A.388
! MONFX3A.389
CALL MIX_COLUMN
(IERR MONFX3A.390
! Atmospheric Properties MONFX3A.391
& , N_PROFILE, N_LAYER MONFX3A.392
! Two-stream Scheme MONFX3A.393
& , I_2STREAM MONFX3A.394
! Corrections to Two-stream Equations MONFX3A.395
& , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION MONFX3A.396
! Options for Solver MONFX3A.397
& , I_SOLVER, L_NET ADB1F405.388
! Options for Equivalent Extinction MONFX3A.399
& , L_SCALE_SOLAR, ADJUST_SOLAR_KE MONFX3A.400
! Spectral Region MONFX3A.401
& , ISOLIR MONFX3A.402
! Infra-red Properties MONFX3A.403
& , DIFF_PLANCK MONFX3A.404
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_2 MONFX3A.405
! Conditions at TOA MONFX3A.406
& , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0 MONFX3A.407
! Conditions at Surface MONFX3A.408
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND MONFX3A.409
! Clear-sky Single Scattering Properties MONFX3A.410
& , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE MONFX3A.411
! Cloud Geometry MONFX3A.412
& , N_CLOUD_TOP MONFX3A.413
& , N_CLOUD_TYPE, FRAC_CLOUD MONFX3A.414
& , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE ADB1F402.531
& , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE ADB1F402.532
& , CLOUD_OVERLAP ADB1F402.533
! Cloudy Optical Properties ADB1F402.534
& , TAU_CLOUD, OMEGA_CLOUD, ASYMMETRY_CLOUD ADB1F402.535
! Fluxes Calculated ADB1F402.536
& , FLUX_DIRECT, FLUX_TOTAL ADB1F402.537
! Flags for Clear-sky Calculations ADB1F402.538
& , L_CLEAR, I_SOLVER_CLEAR ADB1F402.539
! Clear-sky Fluxes Calculated ADB1F402.540
& , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR ADB1F402.541
! Dimensions of Arrays ADB1F402.542
& , NPD_PROFILE, NPD_LAYER ADB1F402.543
& ) ADB1F402.544
IF (IERR.NE.I_NORMAL) RETURN ADB1F402.545
ELSEIF (I_CLOUD.EQ.IP_CLOUD_TRIPLE) THEN ADB1F402.546
! ADB1F402.547
! CLOUDS ARE TREATED USING A DECOMPOSITION OF THE COLUMN ADB1F402.548
! INTO CLEAR-SKY, STRATIFORM AND CONVECTIVE REGIONS, ALL ADB1F402.549
! MAXIMALLY OVERLAPPED. ADB1F402.550
! ADB1F402.551
CALL TRIPLE_COLUMN
(IERR ADB1F402.552
! Atmospheric Properties ADB1F402.553
& , N_PROFILE, N_LAYER ADB1F402.554
! Two-stream Scheme ADB1F402.555
& , I_2STREAM ADB1F402.556
! Corrections to Two-stream Equations ADB1F402.557
& , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION ADB1F402.558
! Options for Solver ADB1F402.559
& , I_SOLVER, L_NET ADB1F405.390
! Options for Equivalent Extinction ADB1F402.561
& , L_SCALE_SOLAR, ADJUST_SOLAR_KE ADB1F402.562
! Spectral Region ADB1F402.563
& , ISOLIR ADB1F402.564
! Infra-red Properties ADB1F402.565
& , DIFF_PLANCK ADB1F402.566
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_2 ADB1F402.567
! Conditions at TOA ADB1F402.568
& , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0 ADB1F402.569
! Conditions at Surface ADB1F402.570
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND ADB1F402.571
! Clear-sky Single Scattering Properties ADB1F402.572
& , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE ADB1F402.573
! Cloud Geometry ADB1F402.574
& , N_CLOUD_TOP ADB1F402.575
& , N_CLOUD_TYPE, FRAC_CLOUD ADB1F402.576
& , I_REGION_CLOUD, FRAC_REGION ADB1F402.577
& , W_FREE, W_CLOUD ADB1F405.389
& , CLOUD_OVERLAP MONFX3A.417
! Cloudy Optical Properties MONFX3A.418
& , TAU_CLOUD, OMEGA_CLOUD, ASYMMETRY_CLOUD MONFX3A.419
! Fluxes Calculated MONFX3A.420
& , FLUX_DIRECT, FLUX_TOTAL MONFX3A.421
! Flags for Clear-sky Calculations MONFX3A.422
& , L_CLEAR, I_SOLVER_CLEAR MONFX3A.423
! Clear-sky Fluxes Calculated MONFX3A.424
& , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR MONFX3A.425
! Dimensions of Arrays MONFX3A.426
& , NPD_PROFILE, NPD_LAYER MONFX3A.427
& ) MONFX3A.428
IF (IERR.NE.I_NORMAL) RETURN MONFX3A.429
! MONFX3A.430
ELSEIF (I_CLOUD.EQ.IP_CLOUD_COLUMN_MAX) THEN MONFX3A.431
! CLOUDS ARE TREATED ON THE ASSUMPTION OF MAXIMUM OVERLAP MONFX3A.432
! IN A COLUMN MODEL. MONFX3A.433
CALL CLOUD_COLUMN
(IERR MONFX3A.434
! Atmospheric Properties MONFX3A.435
& , N_PROFILE, N_LAYER MONFX3A.436
! Two-stream Scheme MONFX3A.437
& , I_2STREAM MONFX3A.438
! Corrections to Two-stream Equations MONFX3A.439
& , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION MONFX3A.440
! Options for Solver MONFX3A.441
& , I_SOLVER, N_AUGMENT MONFX3A.442
! Options for Equivalent Extinction MONFX3A.443
& , L_SCALE_SOLAR, ADJUST_SOLAR_KE MONFX3A.444
! Spectral Region MONFX3A.445
& , ISOLIR MONFX3A.446
! Infra-red Properties MONFX3A.447
& , DIFF_PLANCK MONFX3A.448
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_2 MONFX3A.449
! Conditions at TOA MONFX3A.450
& , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0 MONFX3A.451
! Conditions at Surface MONFX3A.452
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND MONFX3A.453
! Clear-sky Single Scattering Properties MONFX3A.454
& , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE MONFX3A.455
! Cloud Geometry MONFX3A.456
& , N_CLOUD_TOP MONFX3A.457
& , N_CLOUD_TYPE, FRAC_CLOUD MONFX3A.458
& , N_COLUMN, L_COLUMN, AREA_COLUMN MONFX3A.459
! Cloudy Optical Properties MONFX3A.460
& , TAU_CLOUD, OMEGA_CLOUD, ASYMMETRY_CLOUD MONFX3A.461
! Fluxes Calculated MONFX3A.462
& , FLUX_DIRECT, FLUX_TOTAL MONFX3A.463
! Flags for Clear-sky Calculations MONFX3A.464
& , L_CLEAR, I_SOLVER_CLEAR MONFX3A.465
! Clear-sky Fluxes Calculated MONFX3A.466
& , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR MONFX3A.467
! Dimensions of Arrays MONFX3A.468
& , NPD_PROFILE, NPD_LAYER, NPD_COLUMN MONFX3A.469
& ) MONFX3A.470
IF (IERR.NE.I_NORMAL) RETURN MONFX3A.471
! MONFX3A.472
ENDIF MONFX3A.473
! MONFX3A.474
ELSE IF (I_ANGULAR_INTEGRATION.EQ.IP_IR_GAUSS) THEN MONFX3A.475
! MONFX3A.476
! FULL ANGULAR RESOLUTION USING GASUSSIAN INTEGRATION. MONFX3A.477
CALL GAUSS_ANGLE
(N_PROFILE, N_LAYER, L_NET, N_AUGMENT MONFX3A.478
& , N_ORDER_GAUSS MONFX3A.479
& , TAU_FREE MONFX3A.480
& , FLUX_INC_DOWN MONFX3A.481
& , DIFF_PLANCK, SOURCE_GROUND, ALBEDO_SURFACE_DIFF MONFX3A.482
& , FLUX_TOTAL MONFX3A.483
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_2 MONFX3A.484
& , NPD_PROFILE, NPD_LAYER MONFX3A.485
& ) MONFX3A.486
IF (IERR.NE.I_NORMAL) RETURN MONFX3A.487
! MONFX3A.488
ENDIF MONFX3A.489
! MONFX3A.490
! MONFX3A.491
RETURN MONFX3A.492
END MONFX3A.493
*ENDIF DEF,A01_3A,OR,DEF,A02_3A MONFX3A.494
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.46