SUBROUTINE SOLVE_BAND_CLR_FESFT(IERR 1,6SBCF3A.24
! Atmospheric Column SBCF3A.25
& , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS SBCF3A.26
! Angular Integration SBCF3A.27
& , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT SBCF3A.28
& , L_RESCALE, N_ORDER_GAUSS SBCF3A.29
! Treatment of Scattering SBCF3A.30
& , I_SCATTER_METHOD_BAND SBCF3A.31
! Options for Solver SBCF3A.32
& , I_SOLVER, L_NET, N_AUGMENT ADB1F405.571
! Gaseous Properties SBCF3A.34
& , I_BAND, N_GAS SBCF3A.35
& , INDEX_ABSORB, I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC SBCF3A.36
& , K_ESFT, W_ESFT, SCALE_VECTOR SBCF3A.37
& , P_REFERENCE, T_REFERENCE SBCF3A.38
& , GAS_MIX_RATIO, GAS_FRAC_RESCALED SBCF3A.39
& , L_DOPPLER, DOPPLER_CORRECTION SBCF3A.40
! Spectral region SBCF3A.41
& , ISOLIR SBCF3A.42
! Solar Properties SBCF3A.43
& , SEC_0, SOLAR_FLUX SBCF3A.44
! Infra-red Properties SBCF3A.45
& , PLANCK_SOURCE_BAND SBCF3A.46
& , DIFF_PLANCK_BAND SBCF3A.47
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2 SBCF3A.48
! Surface Properties SBCF3A.49
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, THERMAL_GROUND_BAND SBCF3A.50
! Clear-sky Optical Propeties SBCF3A.51
& , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE SBCF3A.52
& , FORWARD_SCATTER_FREE SBCF3A.53
! Cloudy Properties SBCF3A.54
& , L_CLOUD, I_CLOUD SBCF3A.55
! Cloud Geometry SBCF3A.56
& , N_CLOUD_TOP SBCF3A.57
& , N_CLOUD_TYPE, FRAC_CLOUD SBCF3A.58
& , I_REGION_CLOUD, FRAC_REGION ADB1F402.635
& , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE SBCF3A.59
& , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE SBCF3A.60
& , CLOUD_OVERLAP SBCF3A.61
& , N_COLUMN, L_COLUMN, AREA_COLUMN SBCF3A.62
! Cloudy Optical Properties SBCF3A.63
& , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD SBCF3A.64
& , ASYMMETRY_CLOUD SBCF3A.65
& , FORWARD_SCATTER_CLOUD SBCF3A.66
! Fluxes Calculated SBCF3A.67
& , FLUX_DIRECT_BAND, FLUX_DIFFUSE_BAND SBCF3A.68
! Flags for Clear-sky Calculations SBCF3A.69
& , L_CLEAR, I_SOLVER_CLEAR SBCF3A.70
! Clear-sky Fluxes Calculated SBCF3A.71
& , FLUX_DIRECT_CLEAR_BAND, FLUX_DIFFUSE_CLEAR_BAND SBCF3A.72
& , NPD_PROFILE, NPD_LAYER, NPD_COLUMN SBCF3A.73
& , NPD_BAND, NPD_SPECIES SBCF3A.74
& , NPD_ESFT_TERM, NPD_SCALE_VARIABLE, NPD_SCALE_FNC SBCF3A.75
& ) SBCF3A.76
! SBCF3A.77
! SBCF3A.78
! SBCF3A.79
IMPLICIT NONE SBCF3A.80
! SBCF3A.81
! SBCF3A.82
! SIZES OF DUMMY ARRAYS. SBCF3A.83
INTEGER !, INTENT(IN) SBCF3A.84
& NPD_PROFILE SBCF3A.85
! MAXIMUM NUMBER OF PROFILES SBCF3A.86
& , NPD_LAYER SBCF3A.87
! MAXIMUM NUMBER OF LAYERS SBCF3A.88
& , NPD_BAND SBCF3A.89
! MAXIMUM NUMBER OF SPECTRAL BANDS SBCF3A.90
& , NPD_SPECIES SBCF3A.91
! MAXIMUM NUMBER OF SPECIES SBCF3A.92
& , NPD_ESFT_TERM SBCF3A.93
! MAXIMUM NUMBER OF ESFT TERMS SBCF3A.94
& , NPD_SCALE_VARIABLE SBCF3A.95
! MAXIMUM NUMBER OF SCALE VARIABLES SBCF3A.96
& , NPD_SCALE_FNC SBCF3A.97
! MAXIMUM NUMBER OF SCALING FUNCTIONS SBCF3A.98
& , NPD_COLUMN SBCF3A.99
! NUMBER OF COLUMNS PER POINT SBCF3A.100
! SBCF3A.101
! INCLUDE COMDECKS. SBCF3A.102
*CALL DIMFIX3A 
SBCF3A.103
*CALL STDIO3A SBCF3A.104
*CALL ESFTSC3A SBCF3A.105
*CALL PRMCH3A SBCF3A.106
*CALL PRECSN3A SBCF3A.107
*CALL DIFFKE3A SBCF3A.108
*CALL SPCRG3A SBCF3A.109
*CALL ERROR3A SBCF3A.110
! SBCF3A.111
! SBCF3A.112
! SBCF3A.113
! DUMMY ARGUMENTS. SBCF3A.114
INTEGER !, INTENT(OUT) SBCF3A.115
& IERR SBCF3A.116
! ERROR FLAG SBCF3A.117
! SBCF3A.118
! Atmospheric Column SBCF3A.119
INTEGER !, INTENT(IN) SBCF3A.120
& N_PROFILE SBCF3A.121
! NUMBER OF PROFILES SBCF3A.122
& , N_LAYER SBCF3A.123
! NUMBER OF LAYERS SBCF3A.124
& , I_TOP SBCF3A.125
! TOP OF VERTICAL GRID SBCF3A.126
LOGICAL !, INTENT(IN) SBCF3A.127
& L_LAYER SBCF3A.128
! PROPERTIES GIVEN IN LAYERS SBCF3A.129
REAL !, INTENT(IN) SBCF3A.130
& D_MASS(NPD_PROFILE, NPD_LAYER) SBCF3A.131
! MASS THICKNESS OF EACH LAYER SBCF3A.132
& , P(NPD_PROFILE, 0: NPD_LAYER) SBCF3A.133
! PRESSURE SBCF3A.134
& , T(NPD_PROFILE, 0: NPD_LAYER) SBCF3A.135
! TEMPERATURE SBCF3A.136
! SBCF3A.137
! Angular Integration SBCF3A.138
INTEGER !, INTENT(IN) SBCF3A.139
& I_ANGULAR_INTEGRATION SBCF3A.140
! ANGULAR INTEGRATION SCHEME SBCF3A.141
& , I_2STREAM SBCF3A.142
! TWO-STREAM SCHEME SBCF3A.143
& , N_ORDER_GAUSS SBCF3A.144
! ORDER OF GAUSSIAN INTEGRATION SBCF3A.145
LOGICAL !, INTENT(IN) SBCF3A.146
& L_2_STREAM_CORRECT SBCF3A.147
! USE AN EDGE CORRECTION SBCF3A.148
& , L_RESCALE SBCF3A.149
! RESCALE OPTICAL PROPERTIES SBCF3A.150
! SBCF3A.151
! Treatment of Scattering SBCF3A.152
INTEGER !, INTENT(IN) SBCF3A.153
& I_SCATTER_METHOD_BAND SBCF3A.154
! METHOD OF TREATING SCATTERING SBCF3A.155
! SBCF3A.156
! Options for Solver SBCF3A.157
INTEGER !, INTENT(IN) SBCF3A.158
& I_SOLVER SBCF3A.159
! SOLVER USED SBCF3A.160
& , N_AUGMENT SBCF3A.163
! LENGTH OF LONG FLUX VECTOR SBCF3A.164
LOGICAL !, INTENT(IN) SBCF3A.165
& L_NET SBCF3A.166
! CALCULATE NET FLUXES SBCF3A.167
! SBCF3A.168
! Gaseous Properties SBCF3A.169
INTEGER !, INTENT(IN) SBCF3A.170
& I_BAND SBCF3A.171
! BAND BEING CONSIDERED SBCF3A.172
& , N_GAS SBCF3A.173
! NUMBER OF GASES IN BAND SBCF3A.174
& , INDEX_ABSORB(NPD_SPECIES, NPD_BAND) SBCF3A.175
! LIST OF ABSORBERS IN BANDS SBCF3A.176
& , I_BAND_ESFT(NPD_BAND, NPD_SPECIES) SBCF3A.177
! NUMBER OF TERMS IN BAND SBCF3A.178
& , I_SCALE_ESFT(NPD_BAND, NPD_SPECIES) SBCF3A.179
! TYPE OF ESFT SCALING SBCF3A.180
& , I_SCALE_FNC(NPD_BAND, NPD_SPECIES) SBCF3A.181
! TYPE OF SCALING FUNCTION SBCF3A.182
LOGICAL !, INTENT(IN) SBCF3A.183
& L_DOPPLER(NPD_SPECIES) SBCF3A.184
! DOPPLER BROADENING INCLUDED SBCF3A.185
REAL !, INTENT(IN) SBCF3A.186
& K_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES) SBCF3A.187
! EXPONENTIAL ESFT TERMS SBCF3A.188
& , W_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES) SBCF3A.189
! WEIGHTS FOR ESFT SBCF3A.190
& , SCALE_VECTOR(NPD_SCALE_VARIABLE, NPD_ESFT_TERM, NPD_BAND SBCF3A.191
& , NPD_SPECIES) SBCF3A.192
! ABSORBER SCALING PARAMETERS SBCF3A.193
& , P_REFERENCE(NPD_SPECIES, NPD_BAND) SBCF3A.194
! REFERENCE SCALING PRESSURE SBCF3A.195
& , T_REFERENCE(NPD_SPECIES, NPD_BAND) SBCF3A.196
! REFERENCE SCALING TEMPERATURE SBCF3A.197
& , GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES) SBCF3A.198
! GAS MASS MIXING RATIOS SBCF3A.199
& , GAS_FRAC_RESCALED(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES) SBCF3A.200
! RESCALED GAS MASS FRACTIONS SBCF3A.201
& , DOPPLER_CORRECTION(NPD_SPECIES) SBCF3A.202
! DOPPLER BROADENING TERMS SBCF3A.203
! SBCF3A.204
! Spectral Region SBCF3A.205
INTEGER !, INTENT(IN) SBCF3A.206
& ISOLIR SBCF3A.207
! VISIBLE OR IR SBCF3A.208
! SBCF3A.209
! Solar Properties SBCF3A.210
REAL !, INTENT(IN) SBCF3A.211
& SEC_0(NPD_PROFILE) SBCF3A.212
! SECANT OF SOLAR ZENITH ANGLE SBCF3A.213
& , SOLAR_FLUX(NPD_PROFILE) SBCF3A.214
! INCIDENT SOLAR FLUX IN BAND SBCF3A.215
! SBCF3A.216
! Infra-red Properties SBCF3A.217
LOGICAL !, INTENT(IN) SBCF3A.218
& L_IR_SOURCE_QUAD SBCF3A.219
! USE A QUADRATIC SOURCE FUNCTION SBCF3A.220
REAL !, INTENT(IN) SBCF3A.221
& PLANCK_SOURCE_BAND(NPD_PROFILE, 0: NPD_LAYER) SBCF3A.222
! PLANCKIAN SOURCE IN BAND SBCF3A.223
& , DIFF_PLANCK_BAND(NPD_PROFILE, NPD_LAYER) SBCF3A.224
! THERMAL SOURCE FUNCTION SBCF3A.225
& , DIFF_PLANCK_BAND_2(NPD_PROFILE, NPD_LAYER) SBCF3A.226
! 2x2ND DIFFERENCE OF PLANCKIAN IN BAND SBCF3A.227
! SBCF3A.228
! Surface Properties SBCF3A.229
REAL !, INTENT(IN) SBCF3A.230
& ALBEDO_SURFACE_DIFF(NPD_PROFILE) SBCF3A.231
! DIFFUSE SURFACE ALBEDO SBCF3A.232
& , ALBEDO_SURFACE_DIR(NPD_PROFILE) SBCF3A.233
! DIRECT SURFACE ALBEDO SBCF3A.234
& , THERMAL_GROUND_BAND(NPD_PROFILE) SBCF3A.235
! THERMAL SOURCE FUNCTION AT GROUND SBCF3A.236
! SBCF3A.237
! Clear-sky Optical Properties SBCF3A.238
REAL !, INTENT(IN) SBCF3A.239
& K_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER) SBCF3A.240
! FREE ABSORPTIVE EXTINCTION SBCF3A.241
& , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER) SBCF3A.242
! FREE SCATTERING EXTINCTION SBCF3A.243
& , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER) SBCF3A.244
! CLEAR-SKY ASYMMETRY SBCF3A.245
& , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER) SBCF3A.246
! FREE FORWARD SCATTERING SBCF3A.247
! SBCF3A.248
! SBCF3A.249
! Cloudy Properties SBCF3A.250
LOGICAL !, INTENT(IN) SBCF3A.251
& L_CLOUD SBCF3A.252
! CLOUDS REQUIRED SBCF3A.253
INTEGER !, INTENT(IN) SBCF3A.254
& I_CLOUD SBCF3A.255
! CLOUD SCHEME USED SBCF3A.256
! SBCF3A.257
! Cloud Geometry SBCF3A.258
INTEGER !, INTENT(IN) SBCF3A.259
& N_CLOUD_TOP SBCF3A.260
! TOP CLOUDY LAYER SBCF3A.261
& , N_CLOUD_TYPE SBCF3A.262
! NUMBER OF TYPES OF CLOUDS SBCF3A.263
& , N_FREE_PROFILE(NPD_LAYER) SBCF3A.264
! NUMBER OF FREE PROFILES SBCF3A.265
& , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER) SBCF3A.266
! INDICES OF FREE PROFILES SBCF3A.267
& , N_CLOUD_PROFILE(NPD_LAYER) SBCF3A.268
! NUMBER OF CLOUDY PROFILES SBCF3A.269
& , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER) SBCF3A.270
! INDICES OF CLOUDY PROFILES SBCF3A.271
& , N_COLUMN(NPD_PROFILE) SBCF3A.272
! NUMBER OF COLUMNS REQUIRED SBCF3A.273
& , I_REGION_CLOUD(NPD_CLOUD_TYPE) ADB1F402.636
! REGIONS IN WHICH TYPES OF CLOUDS FALL ADB1F402.637
LOGICAL !, INTENT(IN) SBCF3A.274
& L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN) SBCF3A.275
! COLUMN FLAGS FOR COLUMNS SBCF3A.276
REAL !, INTENT(IN) SBCF3A.277
& W_CLOUD(NPD_PROFILE, NPD_LAYER) SBCF3A.278
! CLOUDY FRACTION SBCF3A.279
& , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER) SBCF3A.280
! FRACTIONS OF DIFFERENT TYPES OF CLOUD SBCF3A.281
& , W_FREE(NPD_PROFILE, NPD_LAYER) SBCF3A.282
! CLEAR-SKY FRACTION SBCF3A.283
& , CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF) SBCF3A.284
! COEFFICIENTS FOR TRANSFER FOR ENERGY AT INTERFACES SBCF3A.285
& , AREA_COLUMN(NPD_PROFILE, NPD_COLUMN) SBCF3A.286
! AREAS OF COLUMNS SBCF3A.287
& , FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION) ADB1F402.638
! FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION ADB1F402.639
! SBCF3A.288
! Cloudy Optical Properties SBCF3A.289
REAL SBCF3A.290
& K_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) SBCF3A.291
! CLOUDY ABSORPTIVE EXTINCTION SBCF3A.292
& , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) SBCF3A.293
! CLOUDY SCATTERING EXTINCTION SBCF3A.294
& , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) SBCF3A.295
! CLOUDY ASYMMETRY SBCF3A.296
& , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) SBCF3A.297
! CLOUDY FORWARD SCATTERING SBCF3A.298
! SBCF3A.299
! Fluxes Calculated SBCF3A.300
REAL !, INTENT(OUT) SBCF3A.301
& FLUX_DIRECT_BAND(NPD_PROFILE, 0: NPD_LAYER) SBCF3A.302
! DIRECT FLUX IN BAND SBCF3A.303
& , FLUX_DIFFUSE_BAND(NPD_PROFILE, 2*NPD_LAYER+2) SBCF3A.304
! DIFFUSE FLUX IN BAND SBCF3A.305
! SBCF3A.306
! Flags for Clear-sky Fluxes SBCF3A.307
LOGICAL !, INTENT(IN) SBCF3A.308
& L_CLEAR SBCF3A.309
! CALCULATE CLEAR-SKY PROPERTIES SBCF3A.310
INTEGER !, INTENT(IN) SBCF3A.311
& I_SOLVER_CLEAR SBCF3A.312
! CLEAR SOLVER USED SBCF3A.313
! SBCF3A.314
! Clear-sky Fluxes Calculated SBCF3A.315
REAL !, INTENT(IN) SBCF3A.316
& FLUX_DIRECT_CLEAR_BAND(NPD_PROFILE, 0: NPD_LAYER) SBCF3A.317
! CLEAR-SKY DIRECT FLUX IN BAND SBCF3A.318
& , FLUX_DIFFUSE_CLEAR_BAND(NPD_PROFILE, 2*NPD_LAYER+2) SBCF3A.319
! CLEAR-SKY DIFFUSE FLUX IN BAND SBCF3A.320
! SBCF3A.321
! SBCF3A.322
! SBCF3A.323
! LOCAL VARIABLES. SBCF3A.324
INTEGER SBCF3A.325
& I SBCF3A.326
! LOOP VARIABLE SBCF3A.327
& , J SBCF3A.328
! LOOP VARIABLE SBCF3A.329
& , L SBCF3A.330
! LOOP VARIABLE SBCF3A.331
INTEGER SBCF3A.332
& I_GAS_BAND SBCF3A.333
! INDEX OF ACTIVE GAS SBCF3A.334
& , IEX SBCF3A.335
! INDEX OF ESFT TERM SBCF3A.336
REAL SBCF3A.337
& SOURCE_GROUND(NPD_PROFILE) SBCF3A.338
! GROUND SOURCE FUNCTION SBCF3A.339
& , FLUX_INC_DIRECT(NPD_PROFILE) SBCF3A.340
! INCIDENT DIRECT FLUX SBCF3A.341
& , FLUX_INC_DOWN(NPD_PROFILE) SBCF3A.342
! INCIDENT DOWNWARD FLUX SBCF3A.343
& , ESFT_WEIGHT SBCF3A.344
! ESFT WEIGHT FOR CURRENT CALCULATION SBCF3A.345
& , TAU_GAS(NPD_PROFILE, NPD_LAYER) SBCF3A.346
! OPTICAL DEPTH OF GAS SBCF3A.347
REAL SBCF3A.348
& FLUX_DIRECT_PART(NPD_PROFILE, 0: NPD_LAYER) SBCF3A.349
! PARTIAL DIRECT FLUX SBCF3A.350
& , FLUX_DIFFUSE_PART(NPD_PROFILE, 2*NPD_LAYER+2) SBCF3A.351
! PARTIAL DIFFUSE FLUX SBCF3A.352
& , FLUX_GAS_DIRECT(NPD_PROFILE, 0: NPD_LAYER) SBCF3A.353
! DIRECT GASEOUS FLUX SBCF3A.354
& , FLUX_GAS_DIFFUSE(NPD_PROFILE, 2*NPD_LAYER+2) SBCF3A.355
! DIFFUSE GASEOUS FLUX SBCF3A.356
& , FLUX_RATIO_DIRECT(NPD_PROFILE, 0: NPD_LAYER) SBCF3A.357
! RATIO OF DIRECT FLUXES SBCF3A.358
& , FLUX_RATIO_DIFFUSE(NPD_PROFILE, 2*NPD_LAYER+2) SBCF3A.359
! RATIO OF DIFFUSE FLUXES SBCF3A.360
& , DUMMY_ARRAY(NPD_PROFILE, 2*NPD_LAYER+2) SBCF3A.361
! DUMMY ARRAY FOR ARGUMENT LISTS SBCF3A.362
! SBCF3A.363
! SUBROUTINES CALLED: SBCF3A.364
EXTERNAL SBCF3A.365
& SOLVE_BAND_ONE_GAS, INITIALIZE_FLUX, SCALE_ABSORB SBCF3A.366
& , MONOCHROMATIC_GAS_FLUX, AUGMENT_FLUX SBCF3A.367
! SBCF3A.368
! SBCF3A.369
! SBCF3A.370
! MODIFIED FAST EXPONENTIAL OVERLAP, SUPERPOSING ONE GAS AT A TIME SBCF3A.371
! ON THE MAJOR GAS. SBCF3A.372
! SBCF3A.373
! INITIAL SOLUTION FOR THE FLUXES WITH THE MAJOR GAS. SBCF3A.374
CALL SOLVE_BAND_ONE_GAS(IERR SBCF3A.375
! Atmospheric Properties SBCF3A.376
& , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS SBCF3A.377
! Angular Integration SBCF3A.378
& , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT SBCF3A.379
& , L_RESCALE, N_ORDER_GAUSS SBCF3A.380
! Treatment of Scattering SBCF3A.381
& , I_SCATTER_METHOD_BAND SBCF3A.382
! Options for Solver SBCF3A.383
& , I_SOLVER, L_NET, N_AUGMENT ADB1F405.572
! Gaseous Properties SBCF3A.385
& , I_BAND, INDEX_ABSORB(1, I_BAND) SBCF3A.386
& , I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC SBCF3A.387
& , K_ESFT, W_ESFT, SCALE_VECTOR SBCF3A.388
& , P_REFERENCE, T_REFERENCE SBCF3A.389
& , GAS_MIX_RATIO, GAS_FRAC_RESCALED SBCF3A.390
& , L_DOPPLER, DOPPLER_CORRECTION SBCF3A.391
! Spectral Region SBCF3A.392
& , ISOLIR SBCF3A.393
! Solar Properties SBCF3A.394
& , SEC_0, SOLAR_FLUX SBCF3A.395
! Infra-red Propeties SBCF3A.396
& , PLANCK_SOURCE_BAND(1, 0) SBCF3A.397
& , PLANCK_SOURCE_BAND(1, N_LAYER) SBCF3A.398
& , DIFF_PLANCK_BAND SBCF3A.399
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2 SBCF3A.400
! Surface Properties SBCF3A.401
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, THERMAL_GROUND_BAND SBCF3A.402
! Clear-sky Optical Properties SBCF3A.403
& , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE SBCF3A.404
& , FORWARD_SCATTER_FREE SBCF3A.405
! Cloudy Properties SBCF3A.406
& , L_CLOUD, I_CLOUD SBCF3A.407
! Cloud Geometry SBCF3A.408
& , N_CLOUD_TOP SBCF3A.409
& , N_CLOUD_TYPE, FRAC_CLOUD SBCF3A.410
& , I_REGION_CLOUD, FRAC_REGION ADB1F402.640
& , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE SBCF3A.411
& , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE SBCF3A.412
& , CLOUD_OVERLAP SBCF3A.413
& , N_COLUMN, L_COLUMN, AREA_COLUMN SBCF3A.414
! Cloudy Optical Properties SBCF3A.415
& , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD SBCF3A.416
& , ASYMMETRY_CLOUD SBCF3A.417
& , FORWARD_SCATTER_CLOUD SBCF3A.418
! Fluxes Calculated SBCF3A.419
& , FLUX_DIRECT_BAND, FLUX_DIFFUSE_BAND SBCF3A.420
! Flags for Clear-sky Fluxes SBCF3A.421
& , L_CLEAR, I_SOLVER_CLEAR SBCF3A.422
! Clear-sky Flues Calculated SBCF3A.423
& , FLUX_DIRECT_CLEAR_BAND, FLUX_DIFFUSE_CLEAR_BAND SBCF3A.424
! Planckian Function SBCF3A.425
& , PLANCK_SOURCE_BAND SBCF3A.426
! Dimensions of Arrays SBCF3A.427
& , NPD_PROFILE, NPD_LAYER, NPD_COLUMN SBCF3A.428
& , NPD_BAND, NPD_SPECIES SBCF3A.429
& , NPD_ESFT_TERM, NPD_SCALE_VARIABLE, NPD_SCALE_FNC SBCF3A.430
& ) SBCF3A.431
IF (IERR.NE.I_NORMAL) RETURN SBCF3A.432
! SBCF3A.433
! SBCF3A.434
! SBCF3A.435
! SBCF3A.436
! THE FLUX RATIOS ARE THE RATIOS OF THE FLUXES WITH JUST ONE GAS TO SBCF3A.437
! THE FLUXES WITH NO EXTINCTION. THE PRODUCT OVER ALL MINOR GASES IS SBCF3A.438
! USED TO CALCULATE THE OVERALL FLUX. THERE IS NO NEED TO USE THE SBCF3A.439
! CLEAR RATIOS. SBCF3A.440
! SBCF3A.441
CALL INITIALIZE_FLUX(N_PROFILE, N_LAYER, N_AUGMENT SBCF3A.442
& , ISOLIR SBCF3A.443
& , FLUX_RATIO_DIRECT, FLUX_RATIO_DIFFUSE SBCF3A.444
& , .FALSE. SBCF3A.445
& , DUMMY_ARRAY, DUMMY_ARRAY SBCF3A.446
& , 1.0E+00 SBCF3A.447
& , NPD_PROFILE, NPD_LAYER SBCF3A.448
& , L_NET SBCF3A.449
& ) SBCF3A.450
! SBCF3A.451
DO J=2, N_GAS SBCF3A.452
! SBCF3A.453
! INITIALIZE THE FLUX IN THE BAND TO ZERO. IN THIS SBCF3A.454
! LOOP FLUX_GAS_... IS USED AS A TEMPORARY VARIABLE SBCF3A.455
! TO HOLD THE FLUXES FOR ONE GAS. SBCF3A.456
CALL INITIALIZE_FLUX(N_PROFILE, N_LAYER, N_AUGMENT SBCF3A.457
& , ISOLIR SBCF3A.458
& , FLUX_GAS_DIRECT, FLUX_GAS_DIFFUSE SBCF3A.459
& , .FALSE. SBCF3A.460
& , DUMMY_ARRAY, DUMMY_ARRAY SBCF3A.461
& , 0.0E+00 SBCF3A.462
& , NPD_PROFILE, NPD_LAYER SBCF3A.463
& , L_NET SBCF3A.464
& ) SBCF3A.465
! SBCF3A.466
I_GAS_BAND=INDEX_ABSORB(J, I_BAND) SBCF3A.467
DO IEX=1, I_BAND_ESFT(I_BAND, I_GAS_BAND) SBCF3A.468
! SBCF3A.469
! STORE THE ESFT WEIGHT FOR FUTURE USE. SBCF3A.470
ESFT_WEIGHT=W_ESFT(IEX, I_BAND, I_GAS_BAND) SBCF3A.471
! SBCF3A.472
! RESCALE THE AMOUNT OF GAS FOR THIS ABSORBER IF REQUIRED. SBCF3A.473
IF (I_SCALE_ESFT(I_BAND, I_GAS_BAND).EQ.IP_SCALE_TERM) THEN SBCF3A.474
CALL SCALE_ABSORB(IERR, N_PROFILE, N_LAYER SBCF3A.475
& , GAS_MIX_RATIO(1, 0, I_GAS_BAND), P, T SBCF3A.476
& , L_LAYER, I_TOP SBCF3A.477
& , GAS_FRAC_RESCALED(1, 0, I_GAS_BAND) SBCF3A.478
& , I_SCALE_FNC(I_BAND, I_GAS_BAND) SBCF3A.479
& , P_REFERENCE(I_GAS_BAND, I_BAND) SBCF3A.480
& , T_REFERENCE(I_GAS_BAND, I_BAND) SBCF3A.481
& , SCALE_VECTOR(1, IEX, I_BAND, I_GAS_BAND) SBCF3A.482
& , L_DOPPLER(I_GAS_BAND) SBCF3A.483
& , DOPPLER_CORRECTION(I_GAS_BAND) SBCF3A.484
& , NPD_PROFILE, NPD_LAYER, NPD_SCALE_FNC SBCF3A.485
& , NPD_SCALE_VARIABLE SBCF3A.486
& ) SBCF3A.487
IF (IERR.NE.I_NORMAL) RETURN SBCF3A.488
ENDIF SBCF3A.489
! SBCF3A.490
! SET THE APPROPRIATE BOUNDARY TERMS FOR THE TWO-STREAM SBCF3A.491
! TOTAL UPWARD AND DOWNWARD FLUXES AT THE BOUNDARIES. SBCF3A.492
! SBCF3A.493
IF (ISOLIR.EQ.IP_SOLAR) THEN SBCF3A.494
! THIS TREATMENT OF THE OVERLAPS DOES NOT APPLY TO SBCF3A.495
! THE SOLAR REGION. SBCF3A.496
WRITE(IU_ERR, '(/A)') SBCF3A.497
& '*** ERROR: CLEAR-SKY FESFT IS NOT APPROPRIATE ' SBCF3A.498
& //'IN THE SOLAR REGION.' SBCF3A.499
IERR=I_ERR_FATAL SBCF3A.500
RETURN SBCF3A.501
ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN SBCF3A.502
! INFRA-RED REGION. SBCF3A.503
DO L=1, N_PROFILE SBCF3A.504
FLUX_INC_DIRECT(L)=0.0E+00 SBCF3A.505
FLUX_INC_DOWN(L)=-PLANCK_SOURCE_BAND(L, 0) SBCF3A.506
SOURCE_GROUND(L)=THERMAL_GROUND_BAND(L) SBCF3A.507
& -(1.0E+00-ALBEDO_SURFACE_DIFF(L)) SBCF3A.508
& *PLANCK_SOURCE_BAND(L, N_LAYER) SBCF3A.509
ENDDO SBCF3A.510
ENDIF SBCF3A.511
! SBCF3A.512
! SET THE OPTICAL DEPTHS OF EACH LAYER. SBCF3A.513
DO I=1, N_LAYER SBCF3A.514
DO L=1, N_PROFILE SBCF3A.515
TAU_GAS(L, I)=K_ESFT(IEX, I_BAND, I_GAS_BAND) SBCF3A.516
& *GAS_FRAC_RESCALED(L, I, I_GAS_BAND) SBCF3A.517
& *D_MASS(L, I) SBCF3A.518
ENDDO SBCF3A.519
ENDDO SBCF3A.520
! SBCF3A.521
! SBCF3A.522
! CALCULATE THE FLUXES WITH JUST THIS GAS. SBCF3A.523
CALL MONOCHROMATIC_GAS_FLUX(N_PROFILE, N_LAYER SBCF3A.524
& , L_NET SBCF3A.525
& , TAU_GAS SBCF3A.526
& , ISOLIR, SEC_0, FLUX_INC_DIRECT, FLUX_INC_DOWN SBCF3A.527
& , DIFF_PLANCK_BAND, SOURCE_GROUND SBCF3A.528
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR SBCF3A.529
& , DIFFUSIVITY_FACTOR_MINOR SBCF3A.530
& , FLUX_DIRECT_PART, FLUX_DIFFUSE_PART SBCF3A.531
& , NPD_PROFILE, NPD_LAYER SBCF3A.532
& ) SBCF3A.533
! SBCF3A.534
! INCREMENT THE FLUXES WITHIN THE BAND. THERE IS NO NEED TO SBCF3A.535
! INCREMENT THE CLEAR FLUXES HERE SINCE THE WHOLE CALCULATION SBCF3A.536
! IS WITHOUT CLOUDS. SBCF3A.537
CALL AUGMENT_FLUX(N_PROFILE, N_LAYER, N_AUGMENT SBCF3A.538
& , ISOLIR, .FALSE. SBCF3A.539
& , ESFT_WEIGHT SBCF3A.540
& , FLUX_GAS_DIRECT, FLUX_GAS_DIFFUSE SBCF3A.541
& , FLUX_DIRECT_PART, FLUX_DIFFUSE_PART SBCF3A.542
& , DUMMY_ARRAY, DUMMY_ARRAY SBCF3A.543
& , DUMMY_ARRAY, DUMMY_ARRAY SBCF3A.544
& , NPD_PROFILE, NPD_LAYER SBCF3A.545
& ) SBCF3A.546
! SBCF3A.547
ENDDO SBCF3A.548
! SBCF3A.549
! CALCULATE THE FLUX RATIO. SBCF3A.550
IF (ISOLIR.EQ.IP_INFRA_RED) THEN SBCF3A.551
IF (L_NET) THEN SBCF3A.552
DO I=1, N_AUGMENT SBCF3A.553
DO L=1, N_PROFILE SBCF3A.554
FLUX_RATIO_DIFFUSE(L, I)=FLUX_RATIO_DIFFUSE(L, I) SBCF3A.555
& *FLUX_GAS_DIFFUSE(L, I) SBCF3A.556
& /(-THERMAL_GROUND_BAND(L)) SBCF3A.557
ENDDO SBCF3A.558
ENDDO SBCF3A.559
ELSE SBCF3A.560
! THIS METHOD WILL FAIL IF USED FOR THE DIFFUSE FLUXES SBCF3A.561
! IF THERE ARE INVERSIONS IN THE PROFILE. AT THE GROUND SBCF3A.562
! THE UPWARD DIFFUSE FLUX WILL BE 0, EVEN WITHOUT SBCF3A.563
! AN INVERSION, SO TOL_DIV IS USED TO RESTORE CONDITIONING. SBCF3A.564
DO I=0, N_LAYER SBCF3A.565
DO L=1, N_PROFILE SBCF3A.566
FLUX_RATIO_DIFFUSE(L, 2*I+1) SBCF3A.567
& =FLUX_RATIO_DIFFUSE(L, 2*I+1) SBCF3A.568
& *FLUX_GAS_DIFFUSE(L, 2*I+1) SBCF3A.569
& /(THERMAL_GROUND_BAND(L)*(1.0E+00+TOL_DIV) SBCF3A.570
& -PLANCK_SOURCE_BAND(L, I)) SBCF3A.571
FLUX_RATIO_DIFFUSE(L, 2*I+2) SBCF3A.572
& =FLUX_RATIO_DIFFUSE(L, 2*I+2) SBCF3A.573
& *FLUX_GAS_DIFFUSE(L, 2*I+2) SBCF3A.574
& /(-PLANCK_SOURCE_BAND(L, I)) SBCF3A.575
ENDDO SBCF3A.576
ENDDO SBCF3A.577
ENDIF SBCF3A.578
ENDIF SBCF3A.579
! SBCF3A.580
ENDDO SBCF3A.581
! SBCF3A.582
! LIMIT THE RATIO OF DIFFUSE FLUXES. SBCF3A.583
DO I=1, N_AUGMENT SBCF3A.584
DO L=1, N_PROFILE SBCF3A.585
FLUX_RATIO_DIFFUSE(L, I)=MAX(0.0E+00 SBCF3A.586
& , FLUX_RATIO_DIFFUSE(L, I)) SBCF3A.587
FLUX_RATIO_DIFFUSE(L, I)=MIN(1.0E+00 SBCF3A.588
& , FLUX_RATIO_DIFFUSE(L, I)) SBCF3A.589
ENDDO SBCF3A.590
ENDDO SBCF3A.591
! SBCF3A.592
! THE OVERALL FLUX IN THE BAND IS CALCULATED FROM THE SBCF3A.593
! FLUX FOR THE MAJOR GAS AND THE FLUX RATIOS. THE SAME RATIOS CAN BE SBCF3A.594
! USED FOR THE CLEAR FLUXES IN THIS CASE. SBCF3A.595
DO I=1, N_AUGMENT SBCF3A.596
DO L=1, N_PROFILE SBCF3A.597
FLUX_DIFFUSE_BAND(L, I)=FLUX_RATIO_DIFFUSE(L, I) SBCF3A.598
& *FLUX_DIFFUSE_BAND(L, I) SBCF3A.599
ENDDO SBCF3A.600
ENDDO SBCF3A.601
IF (L_CLEAR) THEN SBCF3A.602
DO I=1, N_AUGMENT SBCF3A.603
DO L=1, N_PROFILE SBCF3A.604
FLUX_DIFFUSE_CLEAR_BAND(L, I) SBCF3A.605
& =FLUX_RATIO_DIFFUSE(L, I) SBCF3A.606
& *FLUX_DIFFUSE_CLEAR_BAND(L, I) SBCF3A.607
ENDDO SBCF3A.608
ENDDO SBCF3A.609
ENDIF SBCF3A.610
! SBCF3A.611
! SBCF3A.612
! SBCF3A.613
RETURN SBCF3A.614
END SBCF3A.615
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SBCF3A.616
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.76