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