SUBROUTINE TRIPLE_COLUMN(IERR 1,7TRPCLM3A.42
! Atmospheric Properties TRPCLM3A.43
& , N_PROFILE, N_LAYER TRPCLM3A.44
! Two-stream Scheme TRPCLM3A.45
& , I_2STREAM TRPCLM3A.46
! Corrections to Two-stream Equations TRPCLM3A.47
& , L_2_STREAM_CORRECT, PLANCK_SOURCE, GROUND_EMISSION TRPCLM3A.48
! Options for Solver TRPCLM3A.49
& , I_SOLVER, L_NET ADB1F405.984
! Options for Equivalent Extinction TRPCLM3A.51
& , L_SCALE_SOLAR, ADJUST_SOLAR_KE TRPCLM3A.52
! Spectral Region TRPCLM3A.53
& , ISOLIR TRPCLM3A.54
! Infra-red Properties TRPCLM3A.55
& , DIFF_PLANCK TRPCLM3A.56
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_2 TRPCLM3A.57
! Conditions at TOA TRPCLM3A.58
& , FLUX_INC_DOWN, FLUX_INC_DIRECT, SEC_0 TRPCLM3A.59
! Conditions at Surface TRPCLM3A.60
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND TRPCLM3A.61
! Clear-sky Single Scattering Properties TRPCLM3A.62
& , TAU_FREE, OMEGA_FREE, ASYMMETRY_FREE TRPCLM3A.63
! Cloud Geometry TRPCLM3A.64
& , N_CLOUD_TOP TRPCLM3A.65
& , N_CLOUD_TYPE, FRAC_CLOUD TRPCLM3A.66
& , I_REGION_CLOUD, FRAC_REGION TRPCLM3A.67
& , W_FREE, W_CLOUD ADB1F405.985
& , CLOUD_OVERLAP TRPCLM3A.70
! Cloudy Optical Properties TRPCLM3A.71
& , TAU_CLOUD, OMEGA_CLOUD, ASYMMETRY_CLOUD TRPCLM3A.72
! Fluxes Calculated TRPCLM3A.73
& , FLUX_DIRECT, FLUX_TOTAL TRPCLM3A.74
! Flags for Clear-sky Calculations TRPCLM3A.75
& , L_CLEAR, I_SOLVER_CLEAR TRPCLM3A.76
! Clear-sky Fluxes Calculated TRPCLM3A.77
& , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR TRPCLM3A.78
! Dimensions of Arrays TRPCLM3A.79
& , NPD_PROFILE, NPD_LAYER TRPCLM3A.80
& ) TRPCLM3A.81
! TRPCLM3A.82
! TRPCLM3A.83
! TRPCLM3A.84
IMPLICIT NONE TRPCLM3A.85
! TRPCLM3A.86
! TRPCLM3A.87
! SIZES OF DUMMY ARRAYS. TRPCLM3A.88
INTEGER !, INTENT(IN) TRPCLM3A.89
& NPD_PROFILE TRPCLM3A.90
! MAXIMUM NUMBER OF PROFILES TRPCLM3A.91
& , NPD_LAYER TRPCLM3A.92
! MAXIMUM NUMBER OF LAYERS TRPCLM3A.93
! TRPCLM3A.94
! INCLUDE COMDECKS. TRPCLM3A.95
*CALL STDIO3A 
TRPCLM3A.96
*CALL DIMFIX3A TRPCLM3A.97
*CALL ERROR3A TRPCLM3A.98
*CALL PRMCH3A TRPCLM3A.99
*CALL PRECSN3A TRPCLM3A.100
*CALL SPCRG3A TRPCLM3A.101
*CALL SOLVER3A TRPCLM3A.102
*CALL CLCFPT3A TRPCLM3A.103
*CALL CLDREG3A TRPCLM3A.104
! TRPCLM3A.105
! DUMMY VARIABLES. TRPCLM3A.106
INTEGER !, INTENT(IN) TRPCLM3A.107
& N_PROFILE TRPCLM3A.108
! NUMBER OF PROFILES TRPCLM3A.109
& , N_LAYER TRPCLM3A.110
! NUMBER OF LAYERS TRPCLM3A.111
& , N_CLOUD_TOP TRPCLM3A.112
! TOP CLOUDY LAYER TRPCLM3A.113
& , N_CLOUD_TYPE TRPCLM3A.114
! NUMBER OF TYPES OF CLOUDS TRPCLM3A.115
& , ISOLIR TRPCLM3A.124
! SPECTRAL REGION TRPCLM3A.125
& , I_2STREAM TRPCLM3A.126
! TWO-STREAM SCHEME TRPCLM3A.127
& , I_SOLVER TRPCLM3A.128
! SOLVER USED TRPCLM3A.129
& , I_SOLVER_CLEAR TRPCLM3A.132
! SOLVER FOR CLEAR-SKY FLUXES TRPCLM3A.133
INTEGER !, INTENT(OUT) TRPCLM3A.134
& IERR TRPCLM3A.135
! ERROR FLAG TRPCLM3A.136
LOGICAL !, INTENT(IN) TRPCLM3A.137
& L_NET TRPCLM3A.138
! CALCULATE NET FLUXES TRPCLM3A.139
& , L_CLEAR TRPCLM3A.140
! CALCULATE CLEAR-SKY FLUXES TRPCLM3A.141
& , L_SCALE_SOLAR TRPCLM3A.142
! FLAG TO SCALE SOLAR TRPCLM3A.143
& , L_IR_SOURCE_QUAD TRPCLM3A.144
! USE QUADRATIC SOURCE TERM TRPCLM3A.145
& , L_2_STREAM_CORRECT TRPCLM3A.146
! EDGE CORRECTION TO 2-STREAM TRPCLM3A.147
! TRPCLM3A.148
! OPTICAL PROPERTIES: TRPCLM3A.149
REAL !, INTENT(IN) TRPCLM3A.150
& TAU_FREE(NPD_PROFILE, NPD_LAYER) TRPCLM3A.151
! FREE OPTICAL DEPTH TRPCLM3A.152
& , OMEGA_FREE(NPD_PROFILE, NPD_LAYER) TRPCLM3A.153
! FREE ALBEDO OF SINGLE SCATTERING TRPCLM3A.154
& , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER) TRPCLM3A.155
! CLEAR-SKY ASYMMETRY TRPCLM3A.156
& , TAU_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) TRPCLM3A.157
! CLOUDY OPTICAL DEPTH TRPCLM3A.158
& , OMEGA_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) TRPCLM3A.159
! CLOUDY ALBEDO OF SINGLE SCATTERING TRPCLM3A.160
& , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) TRPCLM3A.161
! CLOUDY ASYMMETRY TRPCLM3A.162
! TRPCLM3A.163
! CLOUD GEOMETRY: TRPCLM3A.164
INTEGER !, INTENT(IN) TRPCLM3A.165
& I_REGION_CLOUD(NPD_CLOUD_TYPE) TRPCLM3A.166
! REGIONS IN WHICH TYPES OF CLOUDS FALL TRPCLM3A.167
REAL !, INTENT(IN) TRPCLM3A.168
& W_CLOUD(NPD_PROFILE, NPD_LAYER) TRPCLM3A.169
! CLOUDY FRACTIONS IN EACH LAYER TRPCLM3A.170
& , W_FREE(NPD_PROFILE, NPD_LAYER) TRPCLM3A.171
! CLEAR SKY FRACTIONS IN EACH LAYER TRPCLM3A.172
& , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) TRPCLM3A.173
! FRACTIONS OF DIFFERENT TYPES OF CLOUD TRPCLM3A.174
& , CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF) TRPCLM3A.175
! ENERGY TRANSFER COEFFICIENTS TRPCLM3A.176
& , FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION) TRPCLM3A.177
! FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION TRPCLM3A.178
REAL !, INTENT(IN) TRPCLM3A.179
& SEC_0(NPD_PROFILE) TRPCLM3A.180
! SECANT OF SOLAR ZENITH ANGLE TRPCLM3A.181
& , ALBEDO_SURFACE_DIFF(NPD_PROFILE) TRPCLM3A.182
! DIFFUSE ALBEDO TRPCLM3A.183
& , ALBEDO_SURFACE_DIR(NPD_PROFILE) TRPCLM3A.184
! DIRECT ALBEDO TRPCLM3A.185
& , FLUX_INC_DOWN(NPD_PROFILE) TRPCLM3A.186
! INCIDENT TOTAL FLUX TRPCLM3A.187
& , FLUX_INC_DIRECT(NPD_PROFILE) TRPCLM3A.188
! INCIDENT DIRECT FLUX TRPCLM3A.189
& , DIFF_PLANCK(NPD_PROFILE, NPD_LAYER) TRPCLM3A.190
! CHANGE IN PLANCK FUNCTION TRPCLM3A.191
& , SOURCE_GROUND(NPD_PROFILE) TRPCLM3A.192
! FLUX FROM SURFACE TRPCLM3A.193
& , ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER) TRPCLM3A.194
! ADJUSTMENT OF SOLAR BEAM WITH EQUIVALENT EXTINCTION TRPCLM3A.195
& , DIFF_PLANCK_2(NPD_PROFILE, NPD_LAYER) TRPCLM3A.196
! 2x2ND DIFFERENCE OF PLANCKIAN TRPCLM3A.197
& , PLANCK_SOURCE(NPD_PROFILE, 0: NPD_LAYER) TRPCLM3A.198
! PLANCKIAN SOURCE FUNCTION TRPCLM3A.199
& , GROUND_EMISSION(NPD_PROFILE) TRPCLM3A.200
! TOTAL FLUX EMITTED FROM GROUND TRPCLM3A.201
! TRPCLM3A.202
! FLUXES CALCULATED TRPCLM3A.203
REAL !, INTENT(OUT) TRPCLM3A.204
& FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER) TRPCLM3A.205
! DIRECT FLUX TRPCLM3A.206
& , FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2) TRPCLM3A.207
! LONG FLUX VECTOR TRPCLM3A.208
& , FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER) TRPCLM3A.209
! CLEAR DIRECT FLUX TRPCLM3A.210
& , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2) TRPCLM3A.211
! CLEAR TOTAL FLUX TRPCLM3A.212
! TRPCLM3A.213
! TRPCLM3A.214
! TRPCLM3A.215
! LOCAL VARIABALES. TRPCLM3A.216
INTEGER TRPCLM3A.217
& N_SOURCE_COEFF TRPCLM3A.218
! NUMBER OF SOURCE COEFFICIENTS TRPCLM3A.219
& , N_REGION TRPCLM3A.220
! NUMBER OF REGIONS TRPCLM3A.221
& , I TRPCLM3A.222
! LOOP VARIABLE TRPCLM3A.223
& , L TRPCLM3A.224
! LOOP VARIABLE TRPCLM3A.225
& , K TRPCLM3A.226
! LOOP VARIABLE TRPCLM3A.227
& , N_TOP TRPCLM3A.228
! TOP-MOST LAYER FOR CALCULATION TRPCLM3A.229
! TRPCLM3A.230
! TRPCLM3A.231
! CLEAR-SKY COEFFICIENTS: TRPCLM3A.232
REAL TRPCLM3A.233
& TRANS(NPD_PROFILE, NPD_LAYER, NPD_REGION) TRPCLM3A.234
! TRANSMISSION COEFFICIENTS TRPCLM3A.235
& , REFLECT(NPD_PROFILE, NPD_LAYER, NPD_REGION) TRPCLM3A.236
! REFLECTION COEFFICIENTS TRPCLM3A.237
& , TRANS_0(NPD_PROFILE, NPD_LAYER, NPD_REGION) TRPCLM3A.238
! DIRECT TRANSMISSION COEFFICIENTS TRPCLM3A.239
& , SOURCE_COEFF(NPD_PROFILE, NPD_LAYER TRPCLM3A.240
& , NPD_SOURCE_COEFF, NPD_REGION) TRPCLM3A.241
! SOURCE COEFFICIENTS TRPCLM3A.242
& , S_DOWN(NPD_PROFILE, NPD_LAYER, NPD_REGION) TRPCLM3A.243
! FREE DOWNWARD SOURCE TRPCLM3A.244
& , S_UP(NPD_PROFILE, NPD_LAYER, NPD_REGION) TRPCLM3A.245
! FREE UPWARD SOURCE TRPCLM3A.246
& , S_DOWN_CLEAR(NPD_PROFILE, NPD_LAYER) TRPCLM3A.247
! CLEAR DOWNWARD SOURCE TRPCLM3A.248
& , S_UP_CLEAR(NPD_PROFILE, NPD_LAYER) TRPCLM3A.249
! CLEAR UPWARD SOURCE TRPCLM3A.250
! TRPCLM3A.251
! SOURCE FUNCTIONS AT THE CROUND TRPCLM3A.252
REAL TRPCLM3A.253
& SOURCE_FLUX_GROUND(NPD_PROFILE, NPD_REGION) TRPCLM3A.254
! SOURCE OF FLUX FROM GROUND TRPCLM3A.255
& , FLUX_DIRECT_GROUND(NPD_PROFILE, NPD_REGION) TRPCLM3A.256
! DIRECT FLUX AT GROUND IN EACH REGION TRPCLM3A.257
! TRPCLM3A.258
! TRPCLM3A.259
! FUNCTIONS CALLED: TRPCLM3A.260
INTEGER TRPCLM3A.261
& SET_N_SOURCE_COEFF TRPCLM3A.262
! FUNCTION TO SET NUMBER OF SOURCE COEFFICIENTS TRPCLM3A.263
! TRPCLM3A.264
! SUBROUTINES CALLED: TRPCLM3A.265
EXTERNAL TRPCLM3A.266
& TWO_COEFF_REGION, IR_SOURCE, TRIPLE_SOLAR_SOURCE ADB1F405.986
& , SOLVER_TRIPLE, SOLVER_TRIPLE_APP_SCAT ADB1F405.987
& , CLEAR_SUPPLEMENT TRPCLM3A.270
! TRPCLM3A.271
! TRPCLM3A.272
! SET THE NUMBER OF REGIONS FOR POSSIBLE FUTURE EXPANSION. TRPCLM3A.273
N_REGION=3 TRPCLM3A.274
! TRPCLM3A.275
! TRPCLM3A.276
! SET THE NUMBER OF SOURCE COEFFICIENTS FOR THE APPROXIMATION TRPCLM3A.277
N_SOURCE_COEFF=SET_N_SOURCE_COEFF(ISOLIR, L_IR_SOURCE_QUAD) TRPCLM3A.278
! TRPCLM3A.279
! TRPCLM3A.280
CALL TWO_COEFF_REGION(IERR TRPCLM3A.281
& , N_PROFILE, N_LAYER, N_CLOUD_TOP TRPCLM3A.282
& , I_2STREAM, L_IR_SOURCE_QUAD, N_SOURCE_COEFF TRPCLM3A.283
& , N_CLOUD_TYPE, FRAC_CLOUD TRPCLM3A.284
& , I_REGION_CLOUD, FRAC_REGION TRPCLM3A.285
& , ASYMMETRY_FREE, OMEGA_FREE, TAU_FREE TRPCLM3A.286
& , ASYMMETRY_CLOUD, OMEGA_CLOUD, TAU_CLOUD TRPCLM3A.287
& , ISOLIR, SEC_0 TRPCLM3A.288
& , TRANS, REFLECT, TRANS_0, SOURCE_COEFF TRPCLM3A.289
& , NPD_PROFILE, NPD_LAYER TRPCLM3A.290
& ) TRPCLM3A.291
IF (IERR.NE.I_NORMAL) RETURN TRPCLM3A.292
! TRPCLM3A.293
! TRPCLM3A.294
IF (ISOLIR.EQ.IP_INFRA_RED) THEN TRPCLM3A.295
! TRPCLM3A.296
! EDGE CORRECTIONS FOR THE TWO-STREAM EQUATIONS DO NOT TRPCLM3A.297
! REALLY FIT WITH THIS METHOD OF TREATING CLOUDS. OPTICAL TRPCLM3A.298
! DEPTHS AND TRANSMISSIONS MUST BE PASSED TO THE SUBROUTINE TRPCLM3A.299
! TO FILL THE ARGUMENT LIST, BUT IT IS NOT INTENDED THAT TRPCLM3A.300
! THESE ARRAYS WILL BE USED. TRPCLM3A.301
! TRPCLM3A.302
DO K=1, N_REGION TRPCLM3A.303
IF (K.EQ.IP_REGION_CLEAR) THEN TRPCLM3A.304
N_TOP=1 TRPCLM3A.305
ELSE TRPCLM3A.306
N_TOP=N_CLOUD_TOP TRPCLM3A.307
ENDIF TRPCLM3A.308
! TRPCLM3A.309
CALL IR_SOURCE(N_PROFILE, N_TOP, N_LAYER TRPCLM3A.310
& , SOURCE_COEFF(1, 1, 1, K), DIFF_PLANCK TRPCLM3A.311
& , L_IR_SOURCE_QUAD, DIFF_PLANCK_2 TRPCLM3A.312
& , L_2_STREAM_CORRECT, PLANCK_SOURCE TRPCLM3A.313
& , GROUND_EMISSION, N_LAYER TRPCLM3A.314
& , TAU_FREE, TRANS TRPCLM3A.315
& , S_DOWN(1, 1, K), S_UP(1, 1, K) TRPCLM3A.316
& , NPD_PROFILE, NPD_LAYER TRPCLM3A.317
& ) TRPCLM3A.318
ENDDO TRPCLM3A.319
! TRPCLM3A.320
! TRPCLM3A.321
! WEIGHT THE SOURCE FUNCTIONS BY THE AREA FRACTIONS, BUT TRPCLM3A.322
! SAVE THE CLEAR-SKY FRACTIONS FOR DIAGNOSTIC USE IF TRPCLM3A.323
! REQUIRED. TRPCLM3A.324
IF (L_CLEAR) THEN TRPCLM3A.325
DO I=1, N_LAYER TRPCLM3A.326
DO L=1, N_PROFILE TRPCLM3A.327
S_DOWN_CLEAR(L, I)=S_DOWN(L, I, IP_REGION_CLEAR) TRPCLM3A.328
S_UP_CLEAR(L, I)=S_UP(L, I, IP_REGION_CLEAR) TRPCLM3A.329
ENDDO TRPCLM3A.330
ENDDO TRPCLM3A.331
ENDIF TRPCLM3A.332
DO I=N_CLOUD_TOP, N_LAYER TRPCLM3A.333
DO L=1, N_PROFILE TRPCLM3A.334
S_DOWN(L, I, IP_REGION_CLEAR) TRPCLM3A.335
& =W_FREE(L, I)*S_DOWN(L, I, IP_REGION_CLEAR) TRPCLM3A.336
S_UP(L, I, IP_REGION_CLEAR) TRPCLM3A.337
& =W_FREE(L, I)*S_UP(L, I, IP_REGION_CLEAR) TRPCLM3A.338
S_DOWN(L, I, IP_REGION_STRAT) TRPCLM3A.339
& =W_CLOUD(L, I) TRPCLM3A.340
& *FRAC_REGION(L, I, IP_REGION_STRAT) TRPCLM3A.341
& *S_DOWN(L, I, IP_REGION_STRAT) TRPCLM3A.342
S_UP(L, I, IP_REGION_STRAT) TRPCLM3A.343
& =W_CLOUD(L, I) TRPCLM3A.344
& *FRAC_REGION(L, I, IP_REGION_STRAT) TRPCLM3A.345
& *S_UP(L, I, IP_REGION_STRAT) TRPCLM3A.346
S_DOWN(L, I, IP_REGION_CONV) TRPCLM3A.347
& =W_CLOUD(L, I) TRPCLM3A.348
& *FRAC_REGION(L, I, IP_REGION_CONV) TRPCLM3A.349
& *S_DOWN(L, I, IP_REGION_CONV) TRPCLM3A.350
S_UP(L, I, IP_REGION_CONV) TRPCLM3A.351
& =W_CLOUD(L, I) TRPCLM3A.352
& *FRAC_REGION(L, I, IP_REGION_CONV) TRPCLM3A.353
& *S_UP(L, I, IP_REGION_CONV) TRPCLM3A.354
ENDDO TRPCLM3A.355
ENDDO TRPCLM3A.356
! TRPCLM3A.357
ENDIF TRPCLM3A.358
! TRPCLM3A.359
! TRPCLM3A.360
! CALCULATE THE APPROPRIATE SOURCE TERMS FOR THE SOLAR: CLOUDY TRPCLM3A.361
! AND CLEAR PROPERTIES ARE BOTH NEEDED HERE. TRPCLM3A.362
! TRPCLM3A.363
IF (ISOLIR.EQ.IP_SOLAR) THEN TRPCLM3A.364
! TRPCLM3A.365
CALL TRIPLE_SOLAR_SOURCE(N_PROFILE, N_LAYER, N_CLOUD_TOP TRPCLM3A.366
& , FLUX_INC_DIRECT TRPCLM3A.367
& , L_SCALE_SOLAR, ADJUST_SOLAR_KE TRPCLM3A.368
& , TRANS_0, SOURCE_COEFF TRPCLM3A.369
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V11) TRPCLM3A.370
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V12) TRPCLM3A.371
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V13) TRPCLM3A.372
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V21) TRPCLM3A.373
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V22) TRPCLM3A.374
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V23) TRPCLM3A.375
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V31) TRPCLM3A.376
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V32) TRPCLM3A.377
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V33) TRPCLM3A.378
& , FLUX_DIRECT, FLUX_DIRECT_GROUND TRPCLM3A.379
& , S_UP, S_DOWN TRPCLM3A.380
& , NPD_PROFILE, NPD_LAYER TRPCLM3A.381
& ) TRPCLM3A.382
ENDIF TRPCLM3A.383
! TRPCLM3A.384
! SET THE PARTITIONED SOURCE FUNCTIONS AT THE GROUND. TRPCLM3A.385
IF (ISOLIR.EQ.IP_SOLAR) THEN TRPCLM3A.386
DO L=1, N_PROFILE TRPCLM3A.387
SOURCE_FLUX_GROUND(L, IP_REGION_CLEAR) TRPCLM3A.388
& =(ALBEDO_SURFACE_DIR(L)-ALBEDO_SURFACE_DIFF(L)) TRPCLM3A.389
& *FLUX_DIRECT_GROUND(L, IP_REGION_CLEAR) TRPCLM3A.390
SOURCE_FLUX_GROUND(L, IP_REGION_STRAT) TRPCLM3A.391
& =(ALBEDO_SURFACE_DIR(L)-ALBEDO_SURFACE_DIFF(L)) TRPCLM3A.392
& *FLUX_DIRECT_GROUND(L, IP_REGION_STRAT) TRPCLM3A.393
SOURCE_FLUX_GROUND(L, IP_REGION_CONV) TRPCLM3A.394
& =(ALBEDO_SURFACE_DIR(L)-ALBEDO_SURFACE_DIFF(L)) TRPCLM3A.395
& *FLUX_DIRECT_GROUND(L, IP_REGION_CONV) TRPCLM3A.396
ENDDO TRPCLM3A.397
ELSE TRPCLM3A.398
DO L=1, N_PROFILE TRPCLM3A.399
SOURCE_FLUX_GROUND(L, IP_REGION_CLEAR) TRPCLM3A.400
& =CLOUD_OVERLAP(L, N_LAYER, IP_CLOVLP_U11) TRPCLM3A.401
& *SOURCE_GROUND(L) TRPCLM3A.402
SOURCE_FLUX_GROUND(L, IP_REGION_STRAT) TRPCLM3A.403
& =CLOUD_OVERLAP(L, N_LAYER, IP_CLOVLP_U21) TRPCLM3A.404
& *SOURCE_GROUND(L) TRPCLM3A.405
SOURCE_FLUX_GROUND(L, IP_REGION_CONV) TRPCLM3A.406
& =CLOUD_OVERLAP(L, N_LAYER, IP_CLOVLP_U31) TRPCLM3A.407
& *SOURCE_GROUND(L) TRPCLM3A.408
ENDDO TRPCLM3A.409
ENDIF TRPCLM3A.410
! TRPCLM3A.411
! TRPCLM3A.412
! TRPCLM3A.413
IF (I_SOLVER.EQ.IP_SOLVER_TRIPLE) THEN TRPCLM3A.414
! TRPCLM3A.415
CALL SOLVER_TRIPLE(N_PROFILE, N_LAYER, N_CLOUD_TOP TRPCLM3A.416
& , TRANS(1, 1, IP_REGION_CLEAR) TRPCLM3A.417
& , REFLECT(1, 1, IP_REGION_CLEAR) TRPCLM3A.418
& , S_DOWN(1, 1, IP_REGION_CLEAR) TRPCLM3A.419
& , S_UP(1, 1, IP_REGION_CLEAR) TRPCLM3A.420
& , TRANS(1, 1, IP_REGION_STRAT) TRPCLM3A.421
& , REFLECT(1, 1, IP_REGION_STRAT) TRPCLM3A.422
& , S_DOWN(1, 1, IP_REGION_STRAT) TRPCLM3A.423
& , S_UP(1, 1, IP_REGION_STRAT) TRPCLM3A.424
& , TRANS(1, 1, IP_REGION_CONV) TRPCLM3A.425
& , REFLECT(1, 1, IP_REGION_CONV) TRPCLM3A.426
& , S_DOWN(1, 1, IP_REGION_CONV) TRPCLM3A.427
& , S_UP(1, 1, IP_REGION_CONV) TRPCLM3A.428
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V11) TRPCLM3A.429
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V12) TRPCLM3A.430
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V13) TRPCLM3A.431
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V21) TRPCLM3A.432
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V22) TRPCLM3A.433
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V23) TRPCLM3A.434
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V31) TRPCLM3A.435
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V32) TRPCLM3A.436
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V33) TRPCLM3A.437
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U11) TRPCLM3A.438
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U12) TRPCLM3A.439
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U13) TRPCLM3A.440
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U21) TRPCLM3A.441
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U22) TRPCLM3A.442
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U23) TRPCLM3A.443
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U31) TRPCLM3A.444
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U32) TRPCLM3A.445
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U33) TRPCLM3A.446
& , L_NET TRPCLM3A.447
& , FLUX_INC_DOWN TRPCLM3A.448
& , SOURCE_FLUX_GROUND(1, IP_REGION_CLEAR) TRPCLM3A.449
& , SOURCE_FLUX_GROUND(1, IP_REGION_STRAT) TRPCLM3A.450
& , SOURCE_FLUX_GROUND(1, IP_REGION_CONV) TRPCLM3A.451
& , ALBEDO_SURFACE_DIFF TRPCLM3A.452
& , FLUX_TOTAL TRPCLM3A.453
& , NPD_PROFILE, NPD_LAYER TRPCLM3A.454
& ) TRPCLM3A.455
! TRPCLM3A.456
ELSE IF (I_SOLVER.EQ.IP_SOLVER_TRIPLE_APP_SCAT) THEN TRPCLM3A.457
! TRPCLM3A.458
CALL SOLVER_TRIPLE_APP_SCAT(N_PROFILE, N_LAYER, N_CLOUD_TOP TRPCLM3A.459
& , TRANS(1, 1, IP_REGION_CLEAR) TRPCLM3A.460
& , REFLECT(1, 1, IP_REGION_CLEAR) TRPCLM3A.461
& , S_DOWN(1, 1, IP_REGION_CLEAR) TRPCLM3A.462
& , S_UP(1, 1, IP_REGION_CLEAR) TRPCLM3A.463
& , TRANS(1, 1, IP_REGION_STRAT) TRPCLM3A.464
& , REFLECT(1, 1, IP_REGION_STRAT) TRPCLM3A.465
& , S_DOWN(1, 1, IP_REGION_STRAT) TRPCLM3A.466
& , S_UP(1, 1, IP_REGION_STRAT) TRPCLM3A.467
& , TRANS(1, 1, IP_REGION_CONV) TRPCLM3A.468
& , REFLECT(1, 1, IP_REGION_CONV) TRPCLM3A.469
& , S_DOWN(1, 1, IP_REGION_CONV) TRPCLM3A.470
& , S_UP(1, 1, IP_REGION_CONV) TRPCLM3A.471
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V11) TRPCLM3A.472
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V12) TRPCLM3A.473
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V13) TRPCLM3A.474
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V21) TRPCLM3A.475
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V22) TRPCLM3A.476
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V23) TRPCLM3A.477
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V31) TRPCLM3A.478
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V32) TRPCLM3A.479
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_V33) TRPCLM3A.480
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U11) TRPCLM3A.481
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U12) TRPCLM3A.482
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U13) TRPCLM3A.483
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U21) TRPCLM3A.484
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U22) TRPCLM3A.485
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U23) TRPCLM3A.486
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U31) TRPCLM3A.487
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U32) TRPCLM3A.488
& , CLOUD_OVERLAP(1, 0, IP_CLOVLP_U33) TRPCLM3A.489
& , L_NET TRPCLM3A.490
& , FLUX_INC_DOWN TRPCLM3A.491
& , SOURCE_FLUX_GROUND(1, IP_REGION_CLEAR) TRPCLM3A.492
& , SOURCE_FLUX_GROUND(1, IP_REGION_STRAT) TRPCLM3A.493
& , SOURCE_FLUX_GROUND(1, IP_REGION_CONV) TRPCLM3A.494
& , ALBEDO_SURFACE_DIFF TRPCLM3A.495
& , FLUX_TOTAL TRPCLM3A.496
& , NPD_PROFILE, NPD_LAYER TRPCLM3A.497
& ) TRPCLM3A.498
! TRPCLM3A.499
ELSE TRPCLM3A.500
! TRPCLM3A.501
WRITE(IU_ERR, '(/A)') TRPCLM3A.502
& '***ERROR: THE SOLVER SPECIFIED IS NOT VALID HERE.' TRPCLM3A.503
IERR=I_ERR_FATAL TRPCLM3A.504
RETURN TRPCLM3A.505
! TRPCLM3A.506
ENDIF TRPCLM3A.507
! TRPCLM3A.508
! TRPCLM3A.509
! TRPCLM3A.510
IF (L_CLEAR) THEN TRPCLM3A.511
! TRPCLM3A.512
CALL CLEAR_SUPPLEMENT(IERR, N_PROFILE, N_LAYER, I_SOLVER_CLEAR TRPCLM3A.513
& , TRANS(1, 1, IP_REGION_CLEAR) TRPCLM3A.514
& , REFLECT(1, 1, IP_REGION_CLEAR) TRPCLM3A.515
& , TRANS_0(1, 1, IP_REGION_CLEAR) TRPCLM3A.516
& , SOURCE_COEFF(1, 1, 1, IP_REGION_CLEAR) TRPCLM3A.517
& , ISOLIR, FLUX_INC_DIRECT, FLUX_INC_DOWN TRPCLM3A.518
& , S_DOWN_CLEAR, S_UP_CLEAR TRPCLM3A.519
& , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR TRPCLM3A.520
& , SOURCE_GROUND TRPCLM3A.521
& , L_SCALE_SOLAR, ADJUST_SOLAR_KE TRPCLM3A.522
& , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR TRPCLM3A.523
& , NPD_PROFILE, NPD_LAYER TRPCLM3A.524
& ) TRPCLM3A.525
ENDIF TRPCLM3A.526
! TRPCLM3A.527
! TRPCLM3A.528
! TRPCLM3A.529
RETURN TRPCLM3A.530
END TRPCLM3A.531
*ENDIF DEF,A01_3A,OR,DEF,A02_3A TRPCLM3A.532
*ENDIF DEF,A70_1A,OR,DEF,A70_1B APB4F405.126