SUBROUTINE SOLVE_BAND_FESFT(IERR 1,7SBF3A.24
! Atmospheric Column SBF3A.25
& , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS SBF3A.26
! Angular Integration SBF3A.27
& , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT SBF3A.28
& , L_RESCALE, N_ORDER_GAUSS SBF3A.29
! Treatment of Scattering SBF3A.30
& , I_SCATTER_METHOD_BAND SBF3A.31
! Options for Solver SBF3A.32
& , I_SOLVER, L_NET, N_AUGMENT ADB1F405.576
! Gaseous Propeties SBF3A.34
& , I_BAND, N_GAS SBF3A.35
& , INDEX_ABSORB, I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC SBF3A.36
& , K_ESFT, W_ESFT, SCALE_VECTOR SBF3A.37
& , P_REFERENCE, T_REFERENCE SBF3A.38
& , GAS_MIX_RATIO, GAS_FRAC_RESCALED SBF3A.39
& , L_DOPPLER, DOPPLER_CORRECTION SBF3A.40
! Spectral Region SBF3A.41
& , ISOLIR SBF3A.42
! Solar Properties SBF3A.43
& , SEC_0, SOLAR_FLUX SBF3A.44
! Infra-red Properties SBF3A.45
& , PLANCK_SOURCE_TOP, PLANCK_SOURCE_BOTTOM SBF3A.46
& , DIFF_PLANCK_BAND SBF3A.47
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2 SBF3A.48
! Surface Properties SBF3A.49
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR SBF3A.50
& , THERMAL_GROUND_BAND SBF3A.51
! Clear-sky Optical Properties SBF3A.52
& , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE SBF3A.53
& , FORWARD_SCATTER_FREE SBF3A.54
! Cloudy Properties SBF3A.55
& , L_CLOUD, I_CLOUD SBF3A.56
! Cloud Geometry SBF3A.57
& , N_CLOUD_TOP SBF3A.58
& , N_CLOUD_TYPE, FRAC_CLOUD SBF3A.59
& , I_REGION_CLOUD, FRAC_REGION ADB1F402.645
& , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE SBF3A.60
& , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE SBF3A.61
& , CLOUD_OVERLAP SBF3A.62
& , N_COLUMN, L_COLUMN, AREA_COLUMN SBF3A.63
! Cloudy Optical Properties SBF3A.64
& , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD SBF3A.65
& , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD SBF3A.66
! Fluxes Calculated SBF3A.67
& , FLUX_DIRECT_BAND, FLUX_DIFFUSE_BAND SBF3A.68
! Flags for Clear-sky Fluxes SBF3A.69
& , L_CLEAR, I_SOLVER_CLEAR SBF3A.70
! Clear-sky Fluxes SBF3A.71
& , FLUX_DIRECT_CLEAR_BAND, FLUX_DIFFUSE_CLEAR_BAND SBF3A.72
! Planckian Function SBF3A.73
& , PLANCK_SOURCE_BAND SBF3A.74
! Dimensions of Arrays SBF3A.75
& , NPD_PROFILE, NPD_LAYER, NPD_COLUMN SBF3A.76
& , NPD_BAND, NPD_SPECIES SBF3A.77
& , NPD_ESFT_TERM, NPD_SCALE_VARIABLE, NPD_SCALE_FNC SBF3A.78
& ) SBF3A.79
! SBF3A.80
! SBF3A.81
! SBF3A.82
IMPLICIT NONE SBF3A.83
! SBF3A.84
! SBF3A.85
! SIZES OF DUMMY ARRAYS. SBF3A.86
INTEGER !, INTENT(IN) SBF3A.87
& NPD_PROFILE SBF3A.88
! MAXIMUM NUMBER OF PROFILES SBF3A.89
& , NPD_LAYER SBF3A.90
! MAXIMUM NUMBER OF LAYERS SBF3A.91
& , NPD_BAND SBF3A.92
! MAXIMUM NUMBER OF SPECTRAL BANDS SBF3A.93
& , NPD_SPECIES SBF3A.94
! MAXIMUM NUMBER OF SPECIES SBF3A.95
& , NPD_ESFT_TERM SBF3A.96
! MAXIMUM NUMBER OF ESFT TERMS SBF3A.97
& , NPD_SCALE_VARIABLE SBF3A.98
! MAXIMUM NUMBER OF SCALE VARIABLES SBF3A.99
& , NPD_SCALE_FNC SBF3A.100
! MAXIMUM NUMBER OF SCALING FUNCTIONS SBF3A.101
& , NPD_COLUMN SBF3A.102
! NUMBER OF COLUMNS PER POINT SBF3A.103
! SBF3A.104
! INCLUDE COMDECKS. SBF3A.105
*CALL DIMFIX3A 
SBF3A.106
*CALL ESFTSC3A SBF3A.107
*CALL SPCRG3A SBF3A.108
*CALL ERROR3A SBF3A.109
! SBF3A.110
! SBF3A.111
! SBF3A.112
! DUMMY ARGUMENTS. SBF3A.113
INTEGER !, INTENT(OUT) SBF3A.114
& IERR SBF3A.115
! ERROR FLAG SBF3A.116
INTEGER !, INTENT(IN) SBF3A.117
& N_PROFILE SBF3A.118
! NUMBER OF PROFILES SBF3A.119
& , N_LAYER SBF3A.120
! NUMBER OF LAYERS SBF3A.121
& , I_TOP SBF3A.122
! TOP OF VERTICAL GRID SBF3A.123
LOGICAL !, INTENT(IN) SBF3A.124
& L_LAYER SBF3A.125
! PROPERTIES GIVEN IN LAYERS SBF3A.126
REAL !, INTENT(IN) SBF3A.127
& D_MASS(NPD_PROFILE, NPD_LAYER) SBF3A.128
! MASS THICKNESS OF EACH LAYER SBF3A.129
& , P(NPD_PROFILE, 0: NPD_LAYER) SBF3A.130
! PRESSURE SBF3A.131
& , T(NPD_PROFILE, 0: NPD_LAYER) SBF3A.132
! TEMPERATURE SBF3A.133
! SBF3A.134
! Angular Integration SBF3A.135
INTEGER !, INTENT(IN) SBF3A.136
& I_ANGULAR_INTEGRATION SBF3A.137
! ANGULAR INTEGRATION SCHEME SBF3A.138
& , I_2STREAM SBF3A.139
! TWO-STREAM SCHEME SBF3A.140
& , N_ORDER_GAUSS SBF3A.141
! ORDER OF GAUSSIAN INTEGRATION SBF3A.142
LOGICAL !, INTENT(IN) SBF3A.143
& L_2_STREAM_CORRECT SBF3A.144
! USE AN EDGE CORRECTION SBF3A.145
& , L_RESCALE SBF3A.146
! RESCALE OPTICAL PROPERTIES SBF3A.147
! SBF3A.148
! Treatment of Scattering SBF3A.149
INTEGER !, INTENT(IN) SBF3A.150
& I_SCATTER_METHOD_BAND SBF3A.151
! METHOD OF TREATING SCATTERING SBF3A.152
! SBF3A.153
! Options for solver SBF3A.154
INTEGER !, INTENT(IN) SBF3A.155
& I_SOLVER SBF3A.156
! SOLVER USED SBF3A.157
& , N_AUGMENT SBF3A.160
! LENGTH OF LONG FLUX VECTOR SBF3A.161
LOGICAL !, INTENT(IN) SBF3A.162
& L_NET SBF3A.163
! CALCULATE NET FLUXES SBF3A.164
! SBF3A.165
! Gaseous Properties SBF3A.166
INTEGER !, INTENT(IN) SBF3A.167
& I_BAND SBF3A.168
! BAND BEING CONSIDERED SBF3A.169
& , N_GAS SBF3A.170
! NUMBER OF GASES IN BAND SBF3A.171
& , INDEX_ABSORB(NPD_SPECIES, NPD_BAND) SBF3A.172
! LIST OF ABSORBERS IN BANDS SBF3A.173
& , I_BAND_ESFT(NPD_BAND, NPD_SPECIES) SBF3A.174
! NUMBER OF TERMS IN BAND SBF3A.175
& , I_SCALE_ESFT(NPD_BAND, NPD_SPECIES) SBF3A.176
! TYPE OF ESFT SCALING SBF3A.177
& , I_SCALE_FNC(NPD_BAND, NPD_SPECIES) SBF3A.178
! TYPE OF SCALING FUNCTION SBF3A.179
LOGICAL !, INTENT(IN) SBF3A.180
& L_DOPPLER(NPD_SPECIES) SBF3A.181
! DOPPLER BROADENING INCLUDED SBF3A.182
REAL !, INTENT(IN) SBF3A.183
& K_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES) SBF3A.184
! EXPONENTIAL ESFT TERMS SBF3A.185
& , W_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES) SBF3A.186
! WEIGHTS FOR ESFT SBF3A.187
& , SCALE_VECTOR(NPD_SCALE_VARIABLE, NPD_ESFT_TERM, NPD_BAND SBF3A.188
& , NPD_SPECIES) SBF3A.189
! ABSORBER SCALING PARAMETERS SBF3A.190
& , P_REFERENCE(NPD_SPECIES, NPD_BAND) SBF3A.191
! REFERENCE SCALING PRESSURE SBF3A.192
& , T_REFERENCE(NPD_SPECIES, NPD_BAND) SBF3A.193
! REFERENCE SCALING TEMPERATURE SBF3A.194
& , GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES) SBF3A.195
! GAS MASS MIXING RATIOS SBF3A.196
& , GAS_FRAC_RESCALED(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES) SBF3A.197
! RESCALED GAS MASS FRACTIONS SBF3A.198
& , DOPPLER_CORRECTION(NPD_SPECIES) SBF3A.199
! DOPPLER BROADENING TERMS SBF3A.200
! SBF3A.201
! Spectral Region SBF3A.202
INTEGER !, INTENT(IN) SBF3A.203
& ISOLIR SBF3A.204
! VISIBLE OR IR SBF3A.205
! SBF3A.206
! Solar Properties SBF3A.207
REAL !, INTENT(IN) SBF3A.208
& SEC_0(NPD_PROFILE) SBF3A.209
! SECANT OF SOLAR ZENITH ANGLE SBF3A.210
& , SOLAR_FLUX(NPD_PROFILE) SBF3A.211
! INCIDENT SOLAR FLUX IN BAND SBF3A.212
! SBF3A.213
! Infra-red Properties SBF3A.214
LOGICAL !, INTENT(IN) SBF3A.215
& L_IR_SOURCE_QUAD SBF3A.216
! USE A QUADRATIC SOURCE FUNCTION SBF3A.217
REAL !, INTENT(IN) SBF3A.218
& PLANCK_SOURCE_TOP(NPD_PROFILE) SBF3A.219
! PLANCKIAN SOURCE AT TOP SBF3A.220
& , PLANCK_SOURCE_BOTTOM(NPD_PROFILE) SBF3A.221
! PLANCKIAN SOURCE AT BOTTOM SBF3A.222
& , DIFF_PLANCK_BAND(NPD_PROFILE, NPD_LAYER) SBF3A.223
! THERMAL SOURCE FUNCTION SBF3A.224
& , DIFF_PLANCK_BAND_2(NPD_PROFILE, NPD_LAYER) SBF3A.225
! 2x2ND DIFFERENCE OF PLANCKIAN IN BAND SBF3A.226
! SBF3A.227
! Surface Properties SBF3A.228
REAL !, INTENT(IN) SBF3A.229
& ALBEDO_SURFACE_DIFF(NPD_PROFILE) SBF3A.230
! DIFFUSE SURFACE ALBEDO SBF3A.231
& , ALBEDO_SURFACE_DIR(NPD_PROFILE) SBF3A.232
! DIRECT SURFACE ALBEDO SBF3A.233
& , THERMAL_GROUND_BAND(NPD_PROFILE) SBF3A.234
! THERMAL SOURCE FUNCTION AT GROUND SBF3A.235
! SBF3A.236
! Clear-sky Optical Properties SBF3A.237
REAL !, INTENT(IN) SBF3A.238
& K_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER) SBF3A.239
! FREE ABSORPTIVE EXTINCTION SBF3A.240
& , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER) SBF3A.241
! FREE SCATTERING EXTINCTION SBF3A.242
& , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER) SBF3A.243
! CLEAR-SKY ASYMMETRY SBF3A.244
& , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER) SBF3A.245
! FREE FORWARD SCATTERING SBF3A.246
! SBF3A.247
! Cloudy Properties SBF3A.248
LOGICAL !, INTENT(IN) SBF3A.249
& L_CLOUD SBF3A.250
! CLOUDS REQUIRED SBF3A.251
INTEGER !, INTENT(IN) SBF3A.252
& I_CLOUD SBF3A.253
! CLOUD SCHEME USED SBF3A.254
! SBF3A.255
! Cloud Geometry SBF3A.256
INTEGER !, INTENT(IN) SBF3A.257
& N_CLOUD_TOP SBF3A.258
! TOP CLOUDY LAYER SBF3A.259
& , N_CLOUD_TYPE SBF3A.260
! NUMBER OF TYPES OF CLOUDS SBF3A.261
& , N_FREE_PROFILE(NPD_LAYER) SBF3A.262
! NUMBER OF FREE PROFILES SBF3A.263
& , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER) SBF3A.264
! INDICES OF FREE PROFILES SBF3A.265
& , N_CLOUD_PROFILE(NPD_LAYER) SBF3A.266
! NUMBER OF CLOUDY PROFILES SBF3A.267
& , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER) SBF3A.268
! INDICES OF CLOUDY PROFILES SBF3A.269
& , N_COLUMN(NPD_PROFILE) SBF3A.270
! NUMBER OF COLUMNS REQUIRED SBF3A.271
& , I_REGION_CLOUD(NPD_CLOUD_TYPE) ADB1F402.646
! REGIONS IN WHICH TYPES OF CLOUDS FALL ADB1F402.647
LOGICAL !, INTENT(IN) SBF3A.272
& L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN) SBF3A.273
! COLUMN FLAGS FOR COLUMNS SBF3A.274
REAL !, INTENT(IN) SBF3A.275
& W_CLOUD(NPD_PROFILE, NPD_LAYER) SBF3A.276
! CLOUDY FRACTION SBF3A.277
& , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) SBF3A.278
! FRACTIONS OF TYPES OF CLOUD SBF3A.279
& , W_FREE(NPD_PROFILE, NPD_LAYER) SBF3A.280
! CLEAR-SKY FRACTION SBF3A.281
& , CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF) SBF3A.282
! COEFFICIENTS FOR TRANSFER FOR ENERGY AT INTERFACES SBF3A.283
& , AREA_COLUMN(NPD_PROFILE, NPD_COLUMN) SBF3A.284
! AREAS OF COLUMNS SBF3A.285
& , FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION) ADB1F402.648
! FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION ADB1F402.649
! SBF3A.286
! Cloudy Optical Propeties SBF3A.287
REAL !, INTENT(IN) SBF3A.288
& K_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) SBF3A.289
! CLOUDY ABSORPTIVE EXTINCTION SBF3A.290
& , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) SBF3A.291
! CLOUDY SCATTERING EXTINCTION SBF3A.292
& , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) SBF3A.293
! CLOUDY ASYMMETRY SBF3A.294
& , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) SBF3A.295
! CLOUDY FORWARD SCATTERING SBF3A.296
! SBF3A.297
! Fluxes Calculated SBF3A.298
REAL !, INTENT(OUT) SBF3A.299
& FLUX_DIRECT_BAND(NPD_PROFILE, 0: NPD_LAYER) SBF3A.300
! DIRECT FLUX IN BAND SBF3A.301
& , FLUX_DIFFUSE_BAND(NPD_PROFILE, 2*NPD_LAYER+2) SBF3A.302
! DIFFUSE FLUX IN BAND SBF3A.303
! SBF3A.304
! Flags for Clear-sky Calculations SBF3A.305
LOGICAL !, INTENT(IN) SBF3A.306
& L_CLEAR SBF3A.307
! CALCULATE CLEAR-SKY FLUXES SBF3A.308
INTEGER !, INTENT(IN) SBF3A.309
& I_SOLVER_CLEAR SBF3A.310
! CLEAR SOLVER USED SBF3A.311
! SBF3A.312
! Clear-sky Fluxes Calculated SBF3A.313
REAL !, INTENT(OUT) SBF3A.314
& FLUX_DIRECT_CLEAR_BAND(NPD_PROFILE, 0: NPD_LAYER) SBF3A.315
! CLEAR-SKY DIRECT FLUX IN BAND SBF3A.316
& , FLUX_DIFFUSE_CLEAR_BAND(NPD_PROFILE, 2*NPD_LAYER+2) SBF3A.317
! CLEAR-SKY DIFFUSE FLUX IN BAND SBF3A.318
! SBF3A.319
! Planckian Source Function SBF3A.320
REAL !, INTENT(IN) SBF3A.321
& PLANCK_SOURCE_BAND(NPD_PROFILE, 0: NPD_LAYER) SBF3A.322
! PLANCKIAN SOURCE IN BAND SBF3A.323
! SBF3A.324
! SBF3A.325
! SBF3A.326
! LOCAL VARIABLES. SBF3A.327
INTEGER SBF3A.328
& I SBF3A.329
! LOOP VARIABLE SBF3A.330
& , J SBF3A.331
! LOOP VARIABLE SBF3A.332
& , L SBF3A.333
! LOOP VARIABLE SBF3A.334
INTEGER SBF3A.335
& I_GAS_BAND SBF3A.336
! INDEX OF ACTIVE GAS SBF3A.337
& , I_GAS_POINTER(NPD_SPECIES) SBF3A.338
! POINTER ARRAY FOR MONOCHROMATIC ESFTs SBF3A.339
& , IEX SBF3A.340
! INDEX OF ESFT TERM SBF3A.341
REAL SBF3A.342
& K_ESFT_MONO(NPD_SPECIES) SBF3A.343
! ESFT MONOCHROMATIC EXPONENTS SBF3A.344
& , K_GAS_ABS(NPD_PROFILE, NPD_LAYER) SBF3A.345
! GASEOUS ABSORPTION SBF3A.346
& , SOURCE_GROUND(NPD_PROFILE) SBF3A.347
! GROUND SOURCE FUNCTION SBF3A.348
& , FLUX_INC_DIRECT(NPD_PROFILE) SBF3A.349
! INCIDENT DIRECT FLUX SBF3A.350
& , FLUX_INC_DOWN(NPD_PROFILE) SBF3A.351
! INCIDENT DOWNWARD FLUX SBF3A.352
& , ESFT_WEIGHT SBF3A.353
! ESFT WEIGHT FOR CURRENT CALCULATION SBF3A.354
& , DUMMY_KE(NPD_PROFILE, NPD_LAYER) SBF3A.355
! DUMMY ARRAY (NOT USED) SBF3A.356
REAL SBF3A.357
& FLUX_DIRECT_PART(NPD_PROFILE, 0: NPD_LAYER) SBF3A.358
! PARTIAL DIRECT FLUX SBF3A.359
& , FLUX_DIFFUSE_PART(NPD_PROFILE, 2*NPD_LAYER+2) SBF3A.360
! PARTIAL DIFFUSE FLUX SBF3A.361
& , FLUX_DIRECT_CLEAR_PART(NPD_PROFILE, 0: NPD_LAYER) SBF3A.362
! PARTIAL CLEAR-SKY DIRECT FLUX SBF3A.363
& , FLUX_DIFFUSE_CLEAR_PART(NPD_PROFILE, 2*NPD_LAYER+2) SBF3A.364
! PARTIAL CLEAR-SKY DIFFUSE FLUX SBF3A.365
& , FLUX_DIRECT_GREY(NPD_PROFILE, 0: NPD_LAYER) SBF3A.366
! GREY DIRECT FLUX SBF3A.367
& , FLUX_DIFFUSE_GREY(NPD_PROFILE, 2*NPD_LAYER+2) SBF3A.368
! GREY DIFFUSE FLUX SBF3A.369
& , FLUX_DIRECT_CLEAR_GREY(NPD_PROFILE, 0: NPD_LAYER) SBF3A.370
! GREY CLEAR-SKY DIRECT FLUX SBF3A.371
& , FLUX_DIFFUSE_CLEAR_GREY(NPD_PROFILE, 2*NPD_LAYER+2) SBF3A.372
! GREY CLEAR-SKY DIFFUSE FLUX SBF3A.373
& , FLUX_RATIO_DIRECT(NPD_PROFILE, 0: NPD_LAYER) SBF3A.374
! RATIO OF DIRECT FLUXES SBF3A.375
& , FLUX_RATIO_DIFFUSE(NPD_PROFILE, 2*NPD_LAYER+2) SBF3A.376
! RATIO OF DIFFUSE FLUXES SBF3A.377
& , FLUX_RATIO_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER) SBF3A.378
! RATIO OF CLEAR-SKY DIRECT FLUXES SBF3A.379
& , FLUX_RATIO_DIFFUSE_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2) SBF3A.380
! RATIO OF CLEAR-SKY DIFFUSE FLUXES SBF3A.381
! SBF3A.382
! SUBROUTINES CALLED: SBF3A.383
EXTERNAL SBF3A.384
& INITIALIZE_FLUX, SCALE_ABSORB, GAS_OPTICAL_PROPERTIES SBF3A.385
& , MONOCHROMATIC_FLUX, AUGMENT_FLUX SBF3A.386
! SBF3A.387
! SBF3A.388
! SBF3A.389
! FAST EXPONENTIAL OVERLAP, SUPERPOSING ONE GAS AT A TIME. SBF3A.390
! SBF3A.391
! INITIAL SOLUTION FOR GREY FLUXES. SBF3A.392
! SET THE APPROPRIATE BOUNDARY CONDITIONS FOR THE TOTAL SBF3A.393
! UPWARD AND DOWNWARD FLUXES. SBF3A.394
! SBF3A.395
IF (ISOLIR.EQ.IP_SOLAR) THEN SBF3A.396
! VISIBLE REGION. SBF3A.397
DO L=1, N_PROFILE SBF3A.398
SOURCE_GROUND(L)=0.0E+00 SBF3A.399
FLUX_INC_DIRECT(L)=SOLAR_FLUX(L) SBF3A.400
FLUX_INC_DOWN(L)=SOLAR_FLUX(L) SBF3A.401
ENDDO SBF3A.402
ELSEIF (ISOLIR.EQ.IP_INFRA_RED) THEN SBF3A.403
! INFRA-RED REGION. SBF3A.404
DO L=1, N_PROFILE SBF3A.405
FLUX_INC_DIRECT(L)=0.0E+00 SBF3A.406
FLUX_DIRECT_GREY(L, N_LAYER)=0.0E+00 ADB1F401.832
FLUX_INC_DOWN(L)=-PLANCK_SOURCE_TOP(L) SBF3A.407
SOURCE_GROUND(L)=THERMAL_GROUND_BAND(L) SBF3A.408
& -(1.0E+00-ALBEDO_SURFACE_DIFF(L)) SBF3A.409
& *PLANCK_SOURCE_BOTTOM(L) SBF3A.410
ENDDO SBF3A.411
IF (L_CLEAR) THEN ADB1F401.833
DO L=1, N_PROFILE ADB1F401.834
FLUX_DIRECT_CLEAR_GREY(L, N_LAYER)=0.0E+00 ADB1F401.835
ENDDO ADB1F401.836
ENDIF ADB1F401.837
ENDIF SBF3A.412
! SBF3A.413
! THIS CALL CONTAINS NO GASEOUS ABSORPTION SO K_GAS_ABS MUST SBF3A.414
! BE ZEROED. SBF3A.415
DO I=1, N_LAYER SBF3A.416
DO L=1, N_PROFILE SBF3A.417
K_GAS_ABS(L, I)=0.0E+00 SBF3A.418
ENDDO SBF3A.419
ENDDO SBF3A.420
! SBF3A.421
! SBF3A.422
CALL MONOCHROMATIC_FLUX(IERR SBF3A.423
! Atmospheric Properties SBF3A.424
& , N_PROFILE, N_LAYER, D_MASS SBF3A.425
! Angular Integration SBF3A.426
& , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT SBF3A.427
& , L_RESCALE, N_ORDER_GAUSS SBF3A.428
! Treatment of Scattering SBF3A.429
& , I_SCATTER_METHOD_BAND SBF3A.430
! Options for Solver SBF3A.431
& , I_SOLVER, L_NET, N_AUGMENT ADB1F405.577
! Gaseous Properties SBF3A.433
& , K_GAS_ABS SBF3A.434
! Options for Equivalent Extinction SBF3A.435
& , .FALSE., DUMMY_KE SBF3A.436
! Spectral Region SBF3A.437
& , ISOLIR SBF3A.438
! Infra-red Properties SBF3A.439
& , DIFF_PLANCK_BAND SBF3A.440
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2 SBF3A.441
! Conditions at TOA SBF3A.442
& , SEC_0, SOLAR_FLUX, FLUX_INC_DOWN SBF3A.443
! Surface Properties SBF3A.444
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR SBF3A.445
& , SOURCE_GROUND, THERMAL_GROUND_BAND SBF3A.446
! Clear-sky Optical Properties SBF3A.447
& , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE SBF3A.448
& , FORWARD_SCATTER_FREE SBF3A.449
! Cloudy Properties SBF3A.450
& , L_CLOUD, I_CLOUD SBF3A.451
! Cloud Geometry SBF3A.452
& , N_CLOUD_TOP SBF3A.453
& , N_CLOUD_TYPE, FRAC_CLOUD SBF3A.454
& , I_REGION_CLOUD, FRAC_REGION ADB1F402.650
& , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE SBF3A.455
& , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE SBF3A.456
& , CLOUD_OVERLAP SBF3A.457
& , N_COLUMN, L_COLUMN, AREA_COLUMN SBF3A.458
! Cloudy Optical Properties SBF3A.459
& , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD SBF3A.460
& , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD SBF3A.461
! Fluxes Calculated SBF3A.462
& , FLUX_DIRECT_GREY, FLUX_DIFFUSE_GREY SBF3A.463
! Flags for Clear-sky Calculations SBF3A.464
& , L_CLEAR, I_SOLVER_CLEAR SBF3A.465
! Clear-sky Fluxes Calculated SBF3A.466
& , FLUX_DIRECT_CLEAR_GREY, FLUX_DIFFUSE_CLEAR_GREY SBF3A.467
! Planckian Function SBF3A.468
& , PLANCK_SOURCE_BAND SBF3A.469
! Dimensions of Arrays SBF3A.470
& , NPD_PROFILE, NPD_LAYER, NPD_COLUMN SBF3A.471
& ) SBF3A.472
IF (IERR.NE.I_NORMAL) RETURN SBF3A.473
! SBF3A.474
! FESFT IS BASED ON THE DIFFUSE FLUXES, WHEREAS TOTAL FLUXES SBF3A.475
! ARE USED HERE IN THE SOLAR: CONVERSION BACK TO DIFFUSE SBF3A.476
! FLUXES IS REQUIRED. SBF3A.477
IF (ISOLIR.EQ.IP_SOLAR) THEN SBF3A.478
IF (L_NET) THEN SBF3A.479
DO I=1, N_AUGMENT SBF3A.480
DO L=1, N_PROFILE SBF3A.481
FLUX_DIFFUSE_GREY(L, I)=FLUX_DIFFUSE_GREY(L, I) SBF3A.482
& -FLUX_DIRECT_GREY(L, I-1) SBF3A.483
ENDDO SBF3A.484
ENDDO SBF3A.485
ELSE SBF3A.486
DO I=1, N_AUGMENT SBF3A.487
DO L=1, N_PROFILE SBF3A.488
FLUX_DIFFUSE_GREY(L, 2*I)=FLUX_DIFFUSE_GREY(L, 2*I) SBF3A.489
& -FLUX_DIRECT_GREY(L, I-1) SBF3A.490
ENDDO SBF3A.491
ENDDO SBF3A.492
ENDIF SBF3A.493
IF (L_CLEAR) THEN SBF3A.494
IF (L_NET) THEN SBF3A.495
DO I=1, N_AUGMENT SBF3A.496
DO L=1, N_PROFILE SBF3A.497
FLUX_DIFFUSE_CLEAR_GREY(L, I) SBF3A.498
& =FLUX_DIFFUSE_CLEAR_GREY(L, I) SBF3A.499
& -FLUX_DIRECT_CLEAR_GREY(L, I-1) SBF3A.500
ENDDO SBF3A.501
ENDDO SBF3A.502
ELSE SBF3A.503
DO I=1, N_AUGMENT SBF3A.504
DO L=1, N_PROFILE SBF3A.505
FLUX_DIFFUSE_CLEAR_GREY(L, 2*I) SBF3A.506
& =FLUX_DIFFUSE_CLEAR_GREY(L, 2*I) SBF3A.507
& -FLUX_DIRECT_CLEAR_GREY(L, I-1) SBF3A.508
ENDDO SBF3A.509
ENDDO SBF3A.510
ENDIF SBF3A.511
ENDIF SBF3A.512
ENDIF SBF3A.513
! SBF3A.514
! SBF3A.515
! SBF3A.516
! SBF3A.517
! THE FLUX RATIOS ARE THE RATIOS OF THE GASEOUS FLUXES TO SBF3A.518
! THE GREY FLUXES. THE PRODUCT OVER ALL GASES IS USED TO SBF3A.519
! CALCULATE THE OVERALL FLUX. SBF3A.520
CALL INITIALIZE_FLUX(N_PROFILE, N_LAYER, N_AUGMENT SBF3A.521
& , ISOLIR SBF3A.522
& , FLUX_RATIO_DIRECT, FLUX_RATIO_DIFFUSE SBF3A.523
& , L_CLEAR SBF3A.524
& , FLUX_RATIO_DIRECT_CLEAR, FLUX_RATIO_DIFFUSE_CLEAR SBF3A.525
& , 1.0E+00 SBF3A.526
& , NPD_PROFILE, NPD_LAYER SBF3A.527
& , L_NET SBF3A.528
& ) SBF3A.529
! SBF3A.530
DO J=1, N_GAS SBF3A.531
! SBF3A.532
! INITIALIZE THE FLUX IN THE BAND TO ZERO. IN THIS SBF3A.533
! LOOP FLUX_..._BAND IS USED AS A TEMPORARY VARIABLE SBF3A.534
! TO HOLD THE FLUXES FOR ONE GAS. SBF3A.535
CALL INITIALIZE_FLUX(N_PROFILE, N_LAYER, N_AUGMENT SBF3A.536
& , ISOLIR SBF3A.537
& , FLUX_DIRECT_BAND, FLUX_DIFFUSE_BAND SBF3A.538
& , L_CLEAR SBF3A.539
& , FLUX_DIRECT_CLEAR_BAND, FLUX_DIFFUSE_CLEAR_BAND SBF3A.540
& , 0.0E+00 SBF3A.541
& , NPD_PROFILE, NPD_LAYER SBF3A.542
& , L_NET SBF3A.543
& ) SBF3A.544
! SBF3A.545
I_GAS_BAND=INDEX_ABSORB(J, I_BAND) SBF3A.546
I_GAS_POINTER(1)=I_GAS_BAND SBF3A.547
DO IEX=1, I_BAND_ESFT(I_BAND, I_GAS_BAND) SBF3A.548
! SBF3A.549
! STORE THE ESFT WEIGHT FOR FUTURE USE. SBF3A.550
ESFT_WEIGHT=W_ESFT(IEX, I_BAND, I_GAS_BAND) SBF3A.551
! SBF3A.552
! RESCALE THE AMOUNT OF GAS FOR THIS ABSORBER IF REQUIRED. SBF3A.553
IF (I_SCALE_ESFT(I_BAND, I_GAS_BAND).EQ.IP_SCALE_TERM) THEN SBF3A.554
CALL SCALE_ABSORB(IERR, N_PROFILE, N_LAYER SBF3A.555
& , GAS_MIX_RATIO(1, 0, I_GAS_BAND), P, T SBF3A.556
& , L_LAYER, I_TOP SBF3A.557
& , GAS_FRAC_RESCALED(1, 0, I_GAS_BAND) SBF3A.558
& , I_SCALE_FNC(I_BAND, I_GAS_BAND) SBF3A.559
& , P_REFERENCE(I_GAS_BAND, I_BAND) SBF3A.560
& , T_REFERENCE(I_GAS_BAND, I_BAND) SBF3A.561
& , SCALE_VECTOR(1, IEX, I_BAND, I_GAS_BAND) SBF3A.562
& , L_DOPPLER(I_GAS_BAND) SBF3A.563
& , DOPPLER_CORRECTION(I_GAS_BAND) SBF3A.564
& , NPD_PROFILE, NPD_LAYER, NPD_SCALE_FNC SBF3A.565
& , NPD_SCALE_VARIABLE SBF3A.566
& ) SBF3A.567
IF (IERR.NE.I_NORMAL) RETURN SBF3A.568
ENDIF SBF3A.569
! SBF3A.570
! SET THE APPROPRIATE SOURCE TERMS FOR THE TWO-STREAM SBF3A.571
! EQUATIONS. SBF3A.572
! SET THE GROUND SOURCE FUNCTION SBF3A.573
IF (ISOLIR.EQ.IP_SOLAR) THEN SBF3A.574
! VISIBLE REGION. SBF3A.575
DO L=1, N_PROFILE SBF3A.576
SOURCE_GROUND(L)=0.0E+00 SBF3A.577
FLUX_INC_DOWN(L)=SOLAR_FLUX(L) SBF3A.578
FLUX_INC_DIRECT(L)=SOLAR_FLUX(L) SBF3A.579
ENDDO SBF3A.580
ELSEIF (ISOLIR.EQ.IP_INFRA_RED) THEN SBF3A.581
! INFRA-RED REGION. SBF3A.582
DO L=1, N_PROFILE SBF3A.583
FLUX_INC_DIRECT(L)=0.0E+00 SBF3A.584
FLUX_DIRECT_PART(L, N_LAYER)=0.0E+00 ADB1F401.838
FLUX_INC_DOWN(L)=-PLANCK_SOURCE_TOP(L) SBF3A.585
SOURCE_GROUND(L)=THERMAL_GROUND_BAND(L) SBF3A.586
& -(1.0E+00-ALBEDO_SURFACE_DIFF(L)) SBF3A.587
& *PLANCK_SOURCE_BOTTOM(L) SBF3A.588
ENDDO SBF3A.589
IF (L_CLEAR) THEN ADB1F401.839
DO L=1, N_PROFILE ADB1F401.840
FLUX_DIRECT_CLEAR_PART(L, N_LAYER)=0.0E+00 ADB1F401.841
ENDDO ADB1F401.842
ENDIF ADB1F401.843
ENDIF SBF3A.590
! SBF3A.591
! ASSIGN THE MONOCHROMATIC ABSORPTION COEFFICIENT. SBF3A.592
K_ESFT_MONO(I_GAS_BAND)=K_ESFT(IEX, I_BAND, I_GAS_BAND) SBF3A.593
! SBF3A.594
CALL GAS_OPTICAL_PROPERTIES(N_PROFILE, N_LAYER SBF3A.595
& , 1, I_GAS_POINTER, K_ESFT_MONO SBF3A.596
& , GAS_FRAC_RESCALED SBF3A.597
& , K_GAS_ABS SBF3A.598
& , NPD_PROFILE, NPD_LAYER, NPD_SPECIES SBF3A.599
& ) SBF3A.600
! SBF3A.601
CALL MONOCHROMATIC_FLUX(IERR SBF3A.602
! Atmospheric Properties SBF3A.603
& , N_PROFILE, N_LAYER, D_MASS SBF3A.604
! Angular Integration SBF3A.605
& , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT SBF3A.606
& , L_RESCALE, N_ORDER_GAUSS SBF3A.607
! Treatment of Scattering SBF3A.608
& , I_SCATTER_METHOD_BAND SBF3A.609
! Options for Solver SBF3A.610
& , I_SOLVER, L_NET, N_AUGMENT ADB1F405.578
! Gaseous Propreties SBF3A.612
& , K_GAS_ABS SBF3A.613
! Options for Equivalent Extinction SBF3A.614
& , .FALSE., DUMMY_KE SBF3A.615
! Spectral Region SBF3A.616
& , ISOLIR SBF3A.617
! Infra-red Properties SBF3A.618
& , DIFF_PLANCK_BAND SBF3A.619
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2 SBF3A.620
! Conditions at TOA SBF3A.621
& , SEC_0, FLUX_INC_DIRECT, FLUX_INC_DOWN SBF3A.622
! Surface Properties SBF3A.623
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND SBF3A.624
& , THERMAL_GROUND_BAND SBF3A.625
! Clear-sky Optical Properties SBF3A.626
& , K_GREY_TOT_FREE, K_EXT_SCAT_FREE SBF3A.627
& , ASYMMETRY_FREE, FORWARD_SCATTER_FREE SBF3A.628
! Cloudy Properties SBF3A.629
& , L_CLOUD, I_CLOUD SBF3A.630
! Cloud Geometry SBF3A.631
& , N_CLOUD_TOP SBF3A.632
& , N_CLOUD_TYPE, FRAC_CLOUD SBF3A.633
& , I_REGION_CLOUD, FRAC_REGION ADB1F402.651
& , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE SBF3A.634
& , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE SBF3A.635
& , CLOUD_OVERLAP SBF3A.636
& , N_COLUMN, L_COLUMN, AREA_COLUMN SBF3A.637
! Cloudy Optical Properties SBF3A.638
& , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD SBF3A.639
& , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD SBF3A.640
! Flxues Calculated SBF3A.641
& , FLUX_DIRECT_PART, FLUX_DIFFUSE_PART SBF3A.642
! Flags for Clear-sky Calculations SBF3A.643
& , L_CLEAR, I_SOLVER_CLEAR SBF3A.644
! Clear-sky Fluxes Calculated SBF3A.645
& , FLUX_DIRECT_CLEAR_PART, FLUX_DIFFUSE_CLEAR_PART SBF3A.646
! Planckian Function SBF3A.647
& , PLANCK_SOURCE_BAND SBF3A.648
! Dimensions of Arrays SBF3A.649
& , NPD_PROFILE, NPD_LAYER, NPD_COLUMN SBF3A.650
& ) SBF3A.651
IF (IERR.NE.I_NORMAL) RETURN SBF3A.652
! SBF3A.653
! CONVERT THE TOTAL FLUXES BACK TO DIFFUSE FLUXES. ADB1F401.844
IF (ISOLIR.EQ.IP_SOLAR) THEN SBF3A.655
IF (L_NET) THEN SBF3A.656
DO I=1, N_AUGMENT SBF3A.657
DO L=1, N_PROFILE SBF3A.658
FLUX_DIFFUSE_PART(L, I) SBF3A.659
& =FLUX_DIFFUSE_PART(L, I) SBF3A.660
& -FLUX_DIRECT_PART(L, I-1) SBF3A.661
ENDDO SBF3A.662
ENDDO SBF3A.663
ELSE SBF3A.664
DO I=1, N_AUGMENT SBF3A.665
DO L=1, N_PROFILE SBF3A.666
FLUX_DIFFUSE_PART(L, 2*I) SBF3A.667
& =FLUX_DIFFUSE_PART(L, 2*I) SBF3A.668
& -FLUX_DIRECT_PART(L, I-1) SBF3A.669
ENDDO SBF3A.670
ENDDO SBF3A.671
ENDIF SBF3A.672
IF (L_CLEAR) THEN SBF3A.673
IF (L_NET) THEN SBF3A.674
DO I=1, N_AUGMENT SBF3A.675
DO L=1, N_PROFILE SBF3A.676
FLUX_DIFFUSE_CLEAR_PART(L, I) SBF3A.677
& =FLUX_DIFFUSE_CLEAR_PART(L, I) SBF3A.678
& -FLUX_DIRECT_CLEAR_PART(L, I-1) SBF3A.679
ENDDO SBF3A.680
ENDDO SBF3A.681
ELSE SBF3A.682
DO I=1, N_AUGMENT SBF3A.683
DO L=1, N_PROFILE SBF3A.684
FLUX_DIFFUSE_CLEAR_PART(L, 2*I) SBF3A.685
& =FLUX_DIFFUSE_CLEAR_PART(L, 2*I) SBF3A.686
& -FLUX_DIRECT_CLEAR_PART(L, I-1) SBF3A.687
ENDDO SBF3A.688
ENDDO SBF3A.689
ENDIF SBF3A.690
ENDIF SBF3A.691
ENDIF SBF3A.692
! SBF3A.693
! INCREMENT THE FLUXES WITHIN THE BAND. SBF3A.694
CALL AUGMENT_FLUX(N_PROFILE, N_LAYER, N_AUGMENT SBF3A.695
& , ISOLIR, L_CLEAR SBF3A.696
& , ESFT_WEIGHT SBF3A.697
& , FLUX_DIRECT_BAND, FLUX_DIFFUSE_BAND SBF3A.698
& , FLUX_DIRECT_PART, FLUX_DIFFUSE_PART SBF3A.699
& , FLUX_DIRECT_CLEAR_BAND, FLUX_DIFFUSE_CLEAR_BAND SBF3A.700
& , FLUX_DIRECT_CLEAR_PART, FLUX_DIFFUSE_CLEAR_PART SBF3A.701
& , NPD_PROFILE, NPD_LAYER SBF3A.702
& ) SBF3A.703
! SBF3A.704
ENDDO SBF3A.705
! SBF3A.706
! CALCULATE THE FLUX RATIO. SBF3A.707
IF (ISOLIR.EQ.IP_SOLAR) THEN SBF3A.708
DO I=0, N_LAYER SBF3A.709
DO L=1, N_PROFILE SBF3A.710
IF (ABS(FLUX_DIRECT_GREY(L, I)).GT.0.0E+00) THEN SBF3A.711
FLUX_RATIO_DIRECT(L, I)=FLUX_RATIO_DIRECT(L, I) SBF3A.712
& *FLUX_DIRECT_BAND(L, I)/FLUX_DIRECT_GREY(L, I) SBF3A.713
ELSE SBF3A.714
FLUX_RATIO_DIRECT(L, I)=1.0E+00 SBF3A.715
ENDIF SBF3A.716
ENDDO SBF3A.717
ENDDO SBF3A.718
ENDIF SBF3A.719
DO I=1, N_AUGMENT SBF3A.720
DO L=1, N_PROFILE SBF3A.721
IF (ABS(FLUX_DIFFUSE_GREY(L, I)).GT.0.0E+00) THEN SBF3A.722
FLUX_RATIO_DIFFUSE(L, I)=FLUX_RATIO_DIFFUSE(L, I) SBF3A.723
& *FLUX_DIFFUSE_BAND(L, I)/FLUX_DIFFUSE_GREY(L, I) SBF3A.724
ELSE SBF3A.725
FLUX_RATIO_DIFFUSE(L, I)=1.0E+00 SBF3A.726
ENDIF SBF3A.727
ENDDO SBF3A.728
ENDDO SBF3A.729
! SBF3A.730
IF (L_CLEAR) THEN SBF3A.731
! CALCULATE THE FLUX RATIOS FOR THE CLEAR FLUXES. SBF3A.732
IF (ISOLIR.EQ.IP_SOLAR) THEN SBF3A.733
DO I=0, N_LAYER SBF3A.734
DO L=1, N_PROFILE SBF3A.735
IF (ABS(FLUX_DIRECT_CLEAR_GREY(L, I)) SBF3A.736
& .GT.0.0E+00) THEN SBF3A.737
FLUX_RATIO_DIRECT_CLEAR(L, I) SBF3A.738
& =FLUX_RATIO_DIRECT_CLEAR(L, I) SBF3A.739
& *FLUX_DIRECT_CLEAR_BAND(L, I) SBF3A.740
& /FLUX_DIRECT_CLEAR_GREY(L, I) SBF3A.741
ELSE SBF3A.742
FLUX_RATIO_DIRECT_CLEAR(L, I)=1.0E+00 SBF3A.743
ENDIF SBF3A.744
ENDDO SBF3A.745
ENDDO SBF3A.746
ENDIF SBF3A.747
! SBF3A.748
DO I=1, N_AUGMENT SBF3A.749
DO L=1, N_PROFILE SBF3A.750
IF (ABS(FLUX_DIFFUSE_CLEAR_GREY(L, I)) SBF3A.751
& .GT.0.0E+00) THEN SBF3A.752
FLUX_RATIO_DIFFUSE_CLEAR(L, I) SBF3A.753
& =FLUX_RATIO_DIFFUSE_CLEAR(L, I) SBF3A.754
& *FLUX_DIFFUSE_CLEAR_BAND(L, I) SBF3A.755
& /FLUX_DIFFUSE_CLEAR_GREY(L, I) SBF3A.756
ELSE SBF3A.757
FLUX_RATIO_DIFFUSE_CLEAR(L, I)=1.0E+00 SBF3A.758
ENDIF SBF3A.759
ENDDO SBF3A.760
ENDDO SBF3A.761
ENDIF SBF3A.762
! SBF3A.763
ENDDO SBF3A.764
! SBF3A.765
! THE OVERALL FLUX IN THE BAND IS CALCULATED FROM THE SBF3A.766
! GREY FLUX AND THE FLUX RATIOS. SBF3A.767
IF (ISOLIR.EQ.IP_SOLAR) THEN SBF3A.768
DO I=0, N_LAYER SBF3A.769
DO L=1, N_PROFILE SBF3A.770
FLUX_DIRECT_BAND(L, I)=FLUX_RATIO_DIRECT(L, I) SBF3A.771
& *FLUX_DIRECT_GREY(L, I) SBF3A.772
ENDDO SBF3A.773
ENDDO SBF3A.774
ENDIF SBF3A.775
DO I=1, N_AUGMENT SBF3A.776
DO L=1, N_PROFILE SBF3A.777
FLUX_DIFFUSE_BAND(L, I)=FLUX_RATIO_DIFFUSE(L, I) SBF3A.778
& *FLUX_DIFFUSE_GREY(L, I) SBF3A.779
ENDDO SBF3A.780
ENDDO SBF3A.781
IF (L_CLEAR) THEN SBF3A.782
IF (ISOLIR.EQ.IP_SOLAR) THEN SBF3A.783
DO I=0, N_LAYER SBF3A.784
DO L=1, N_PROFILE SBF3A.785
FLUX_DIRECT_CLEAR_BAND(L, I) SBF3A.786
& =FLUX_RATIO_DIRECT_CLEAR(L, I) SBF3A.787
& *FLUX_DIRECT_CLEAR_GREY(L, I) SBF3A.788
ENDDO SBF3A.789
ENDDO SBF3A.790
ENDIF SBF3A.791
DO I=1, N_AUGMENT SBF3A.792
DO L=1, N_PROFILE SBF3A.793
FLUX_DIFFUSE_CLEAR_BAND(L, I) SBF3A.794
& =FLUX_RATIO_DIFFUSE_CLEAR(L, I) SBF3A.795
& *FLUX_DIFFUSE_CLEAR_GREY(L, I) SBF3A.796
ENDDO SBF3A.797
ENDDO SBF3A.798
ENDIF SBF3A.799
! SBF3A.800
! SBF3A.801
! CONVERT BACK TO TOTAL FLUXES. SBF3A.802
IF (ISOLIR.EQ.IP_SOLAR) THEN SBF3A.803
IF (L_NET) THEN SBF3A.804
DO I=1, N_AUGMENT SBF3A.805
DO L=1, N_PROFILE SBF3A.806
FLUX_DIFFUSE_BAND(L, I)=FLUX_DIFFUSE_BAND(L, I) SBF3A.807
& +FLUX_DIRECT_BAND(L, I-1) SBF3A.808
ENDDO SBF3A.809
ENDDO SBF3A.810
ELSE SBF3A.811
DO I=1, N_AUGMENT SBF3A.812
DO L=1, N_PROFILE SBF3A.813
FLUX_DIFFUSE_BAND(L, 2*I)=FLUX_DIFFUSE_BAND(L, 2*I) SBF3A.814
& +FLUX_DIRECT_BAND(L, I-1) SBF3A.815
ENDDO SBF3A.816
ENDDO SBF3A.817
ENDIF SBF3A.818
IF (L_CLEAR) THEN SBF3A.819
IF (L_NET) THEN SBF3A.820
DO I=1, N_AUGMENT SBF3A.821
DO L=1, N_PROFILE SBF3A.822
FLUX_DIFFUSE_CLEAR_BAND(L, I) SBF3A.823
& =FLUX_DIFFUSE_CLEAR_BAND(L, I) SBF3A.824
& +FLUX_DIRECT_CLEAR_BAND(L, I-1) SBF3A.825
ENDDO SBF3A.826
ENDDO SBF3A.827
ELSE SBF3A.828
DO I=1, N_AUGMENT SBF3A.829
DO L=1, N_PROFILE SBF3A.830
FLUX_DIFFUSE_CLEAR_BAND(L, 2*I) SBF3A.831
& =FLUX_DIFFUSE_CLEAR_BAND(L, 2*I) SBF3A.832
& +FLUX_DIRECT_CLEAR_BAND(L, I-1) SBF3A.833
ENDDO SBF3A.834
ENDDO SBF3A.835
ENDIF SBF3A.836
ENDIF SBF3A.837
ENDIF SBF3A.838
! SBF3A.839
! SBF3A.840
! SBF3A.841
RETURN SBF3A.842
END SBF3A.843
*ENDIF DEF,A01_3A,OR,DEF,A02_3A SBF3A.844
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.78