SUBROUTINE R2_LWRAD(IERR 2,9LWRAD3A.23
! Gaseous Mixing Ratios LWRAD3A.24
& , H2O, CO2, O3 LWRAD3A.25
& , CO2_DIM1, CO2_DIM2, CO2_3D, L_CO2_3D ACN2F405.100
& , N2O_MIX_RATIO, CH4_MIX_RATIO ADB2F404.633
& , CFC11_MIX_RATIO, CFC12_MIX_RATIO, CFC113_MIX_RATIO ADB1F405.341
& , HCFC22_MIX_RATIO, HFC125_MIX_RATIO, HFC134A_MIX_RATIO ADB1F405.342
! Thermodynamic Variables LWRAD3A.26
& , TAC, PEXNER, TSTAR, PSTAR, AB, BB, AC, BC LWRAD3A.27
! Options for treating clouds ADB1F402.864
& , L_GLOBAL_CLOUD_TOP, GLOBAL_CLOUD_TOP ADB1F402.865
! Stratiform Cloud Fields LWRAD3A.28
& , L_CLOUD_WATER_PARTITION AYY1F404.376
& , LCA_AREA, LCA_BULK, LCCWC1, LCCWC2 ASK1F405.290
! Convective Cloud Fields LWRAD3A.30
& , CCA, CCCWP, CCB, CCT, L_3D_CCA AJX0F404.20
! Surface Fields LWRAD3A.32
& , LAND, ICE_FRACTION LWRAD3A.33
& , LYING_SNOW ADB1F402.488
! Aerosol Fields LWRAD3A.34
& , L_CLIMAT_AEROSOL, N_LEVELS_BL ADB1F402.489
& , L_USE_SULPC_DIRECT, L_USE_SULPC_INDIRECT ADB1F401.495
& , SULP_DIM1,SULP_DIM2 ADB1F401.496
& , ACCUM_SULPHATE, AITKEN_SULPHATE, DISS_SULPHATE ADB2F404.635
&,L_USE_SOOT_DIRECT, SOOT_DIM1, SOOT_DIM2, FRESH_SOOT, AGED_SOOT ALR3F405.122
! Level of tropopause ADB1F402.490
& , TRINDX ADB1F402.491
! Spectrum LWRAD3A.36
*CALL LWSARG3A 
ADB2F404.636
! Algorithmic Options ADB2F404.637
*CALL LWCARG3A ADB2F404.638
& , PTS ADB2F404.639
! General Diagnostics LWRAD3A.38
& , TOTAL_CLOUD_COVER, L_TOTAL_CLOUD_COVER LWRAD3A.39
& , CLEAR_OLR, L_CLEAR_OLR LWRAD3A.40
& , SURFACE_DOWN_FLUX, L_SURFACE_DOWN_FLUX LWRAD3A.41
& , SURF_DOWN_CLR, L_SURF_DOWN_CLR LWRAD3A.42
& , CLEAR_HR, L_CLEAR_HR LWRAD3A.43
& , NET_FLUX_TROP, L_NET_FLUX_TROP ADB2F404.640
& , DOWN_FLUX_TROP, L_DOWN_FLUX_TROP ADB2F404.641
! Physical Dimensions LWRAD3A.44
& , N_PROFILE, NLEVS, NCLDS LWRAD3A.45
& , NWET, NOZONE, NPD_FIELD LWRAD3A.46
& , NPD_PROFILE, NPD_LAYER, NPD_COLUMN LWRAD3A.47
& , N_CCA_LEV AJX0F404.21
! Output Fields LWRAD3A.57
& , OLR, LWSEA, LWOUT LWRAD3A.58
& ) LWRAD3A.59
! LWRAD3A.60
! LWRAD3A.61
! LWRAD3A.62
IMPLICIT NONE LWRAD3A.63
! LWRAD3A.64
! LWRAD3A.65
! COMDECKS INCLUDED LWRAD3A.66
*CALL C_0_DG_C LWRAD3A.67
*CALL C_G LWRAD3A.68
*CALL C_R_CP LWRAD3A.69
! INTERNAL DIMENSIONS OF THE CODE LWRAD3A.70
*CALL DIMFIX3A LWRAD3A.71
! SPECTRAL REGIONS LWRAD3A.75
*CALL SPCRG3A LWRAD3A.76
! METHODS OF INTEGRATION LWRAD3A.77
*CALL ANGINT3A LWRAD3A.78
! METHODS OF SCATTERING LWRAD3A.79
*CALL SCTMTH3A LWRAD3A.80
! OPTIONS TO THE CODE ALTERABLE IN THE UM ADB2F404.642
*CALL LWOPT3A ADB2F404.643
! OPTIONS TO THE CODE FIXED IN THE UM ADB2F404.644
*CALL LWFIX3A LWRAD3A.82
! NUMERICAL PRECISIONS LWRAD3A.84
*CALL PRMCH3A LWRAD3A.85
*CALL PRECSN3A LWRAD3A.86
! SOLVERS LWRAD3A.87
*CALL SOLVER3A LWRAD3A.88
! PHYSICAL CONSTANTS LWRAD3A.89
*CALL PHYCN03A LWRAD3A.90
! UNIT NUMBERS FOR PRINTED OUTPUT ADB2F404.645
*CALL STDIO3A LWRAD3A.92
! ERROR FLAGS LWRAD3A.93
*CALL ERROR3A LWRAD3A.94
! LWRAD3A.95
! LWRAD3A.96
! DUMMY ARGUMENTS LWRAD3A.97
! LWRAD3A.98
INTEGER !, INTENT(OUT) LWRAD3A.99
& IERR LWRAD3A.100
! ERROR FLAG LWRAD3A.101
! LWRAD3A.102
! DIMENSIONS OF ARRAYS: LWRAD3A.103
INTEGER !, INTENT(IN) LWRAD3A.104
& NPD_FIELD LWRAD3A.105
! FIELD SIZE IN CALLING PROGRAM LWRAD3A.106
& , NPD_PROFILE LWRAD3A.107
! SIZE OF ARRAY OF PROFILES LWRAD3A.108
& , NPD_LAYER LWRAD3A.109
! ARRAY SIZES FOR LAYERS LWRAD3A.110
& , NPD_COLUMN LWRAD3A.111
! NUMBER OF COLUMNS PER POINT LWRAD3A.112
! LWRAD3A.113
! ACTUAL SIZES USED: LWRAD3A.153
INTEGER !, INTENT(IN) LWRAD3A.154
& N_PROFILE LWRAD3A.155
! NUMBER OF PROFILES LWRAD3A.156
& , NWET LWRAD3A.157
! NUMBER OF WET LEVELS LWRAD3A.158
& , NOZONE LWRAD3A.159
! NUMBER OF LEVELS WITH OZONE LWRAD3A.160
& , NLEVS LWRAD3A.161
! NUMBER OF ATMOSPHERIC LAYERS LWRAD3A.162
& , NCLDS LWRAD3A.163
! NUMBER OF CLOUDY LEVELS LWRAD3A.164
& , N_LEVELS_BL ADB1F402.492
! NUMBER OF LEVELS IN THE BOUNDARY LAYER ADB1F402.493
& , N_CCA_LEV AJX0F404.22
! LWRAD3A.165
! SPECTRAL DATA: ADB2F404.646
*CALL LWSPDC3A ADB2F404.647
! ADB2F404.648
! GASEOUS MIXING RATIOS: LWRAD3A.166
REAL !, INTENT(IN) LWRAD3A.167
& H2O(NPD_FIELD, NWET) LWRAD3A.168
! MASS MIXING RATIO OF WATER LWRAD3A.169
& , CO2 LWRAD3A.170
! MASS MIXING RATIO OF CO2 LWRAD3A.171
& , O3(NPD_FIELD, NOZONE) LWRAD3A.172
! MASS MIXING RATIOS OF OZONE LWRAD3A.173
& , N2O_MIX_RATIO ADB2F404.649
! MASS MIXING RATIO OF NITROUS OXIDE ADB2F404.650
& , CH4_MIX_RATIO ADB2F404.651
! MASS MIXING RATIO OF METHANE ADB2F404.652
& , CFC11_MIX_RATIO ADB2F404.653
! MASS MIXING RATIO OF CFC11 ADB2F404.654
& , CFC12_MIX_RATIO ADB2F404.655
! MASS MIXING RATIO OF CFC12 ADB2F404.656
& , CFC113_MIX_RATIO ADB1F405.343
! MASS MIXING RATIO OF CFC113 ADB1F405.344
& , HCFC22_MIX_RATIO ADB1F405.345
! MASS MIXING RATIO OF HCFC22 ADB1F405.346
& , HFC125_MIX_RATIO ADB1F405.347
! MASS MIXING RATIO OF HFC125 ADB1F405.348
& , HFC134A_MIX_RATIO ADB1F405.349
! MASS MIXING RATIO OF HFC134A ADB1F405.350
! LWRAD3A.174
! GENERAL ATMOSPHERIC PROPERTIES: LWRAD3A.175
REAL !, INTENT(IN) LWRAD3A.176
& AB(NLEVS+1) LWRAD3A.177
! A AT BOUNDARIES OF LAYERS LWRAD3A.178
& , BB(NLEVS+1) LWRAD3A.179
! B AT BOUNDARIES OF LAYERS LWRAD3A.180
& , AC(NLEVS) LWRAD3A.181
! A AT CENTRES OF LAYERS LWRAD3A.182
& , BC(NLEVS) LWRAD3A.183
! B AT CENTRES OF LAYERS LWRAD3A.184
& , TAC(NPD_FIELD, NLEVS) LWRAD3A.185
! TEMPERATURES AT CENTRES OF LAYERS LWRAD3A.186
& , PEXNER(NPD_FIELD, NLEVS+1) LWRAD3A.187
! Exner FUNCTION AT BOUNDARIES LWRAD3A.188
! LWRAD3A.189
! OPTIONS FOR TREATING CLOUDS ADB1F402.866
LOGICAL !, INTENT(IN) ADB1F402.867
& L_GLOBAL_CLOUD_TOP ADB1F402.868
! FLAG TO USE A GLOBAL VALUE FOR THE TOPS OF CLOUDS ADB1F402.869
! TO ENSURE REPRODUCIBLE RESULTS ADB1F402.870
INTEGER !, INTENT(IN) ADB1F402.871
& GLOBAL_CLOUD_TOP ADB1F402.872
! GLOBAL TOPMOST CLOUDY LAYER ADB1F402.873
! ADB1F402.874
! PROPERTIES OF STRATIFORM CLOUDS: LWRAD3A.190
LOGICAL !, INTENT(IN) AYY1F404.377
& L_CLOUD_WATER_PARTITION AYY1F404.378
! FLAG TO USE PROGNOSTIC CLOUD ICE CONTENTS AYY1F404.379
REAL !, INTENT(IN) LWRAD3A.191
& LCCWC1(NPD_FIELD, NCLDS+1/(NCLDS+1)) LWRAD3A.192
! LIQUID WATER CONTENTS (THESE ARE NOT USED DIRECTLY IN ADB1F401.498
! THE RADIATION: THE TOTAL CONDENSED WATER CONTENT IS ADB1F401.499
! REPARTITIONED USING FOCWWIL). ADB1F401.500
& , LCCWC2(NPD_FIELD, NCLDS+1/(NCLDS+1)) LWRAD3A.194
! ICE WATER CONTENTS (THESE ARE NOT USED DIRECTLY IN ADB1F401.501
! THE RADIATION: THE TOTAL CONDENSED WATER CONTENT IS ADB1F401.502
! REPARTITIONED USING FOCWWIL). ADB1F401.503
& , LCA_AREA(NPD_FIELD, NCLDS+1/(NCLDS+1)) ASK1F405.291
! AREA FRACTIONS OF LAYER CLOUDS OUTSIDE CONVECTIVE TOWERS ASK1F405.292
& , LCA_BULK(NPD_FIELD, NCLDS+1/(NCLDS+1)) ASK1F405.293
! BULK FRACTIONS OF LAYER CLOUDS OUTSIDE CONVECTIVE TOWERS ASK1F405.294
! LWRAD3A.198
! PROPERTIES OF CONVECTIVE CLOUDS: LWRAD3A.199
INTEGER !, INTENT(IN) LWRAD3A.200
& CCB(NPD_FIELD) LWRAD3A.201
! BASE OF CONVECTIVE CLOUD LWRAD3A.202
& , CCT(NPD_FIELD) LWRAD3A.203
! TOP OF CONVECTIVE CLOUD LWRAD3A.204
REAL !, INTENT(IN) LWRAD3A.205
& CCCWP(NPD_FIELD) LWRAD3A.206
! WATER PATH OF CONVECTIVE CLOUD LWRAD3A.207
& , CCA(NPD_FIELD,N_CCA_LEV) AJX0F404.23
! FRACTION OF GRID-BOX COVERED BY CONVECTIVE CLOUD ADB1F401.504
LOGICAL !, INTENT(IN) AJX0F404.24
& L_3D_CCA AJX0F404.25
! FLAG FOR 3D convective cloud amount AJX0F404.26
! LWRAD3A.210
! AEROSOLS: LWRAD3A.211
LOGICAL !, INTENT(IN) ADB1F401.505
& L_CLIMAT_AEROSOL ADB1F402.494
! FLAG FOR CLIMATOLOGICAL AEROSOL ADB1F402.495
LOGICAL !, INTENT(IN) ADB1F402.496
& L_USE_SULPC_DIRECT ADB1F401.506
! FLAG TO USE SULPHUR CYCLE FOR DIRECT EFFECT ADB1F401.507
& , L_USE_SULPC_INDIRECT ADB1F401.508
! FLAG TO USE SULPHUR CYCLE FOR INDIRECT EFFECT ADB1F401.509
& , L_USE_SOOT_DIRECT ! USE DIRECT RAD. EFFECT OF SOOT AEROSOL ALR3F405.123
INTEGER !,INTENT (IN) ADB1F401.510
& SULP_DIM1,SULP_DIM2 ADB1F401.511
! DIMENSIONS FOR _SULPHATE ARRAYS, (P_FIELD,P_LEVELS or 1,1) ADB1F401.512
& , SOOT_DIM1, SOOT_DIM2 ALR3F405.124
! DIMENSIONS FOR SOOT ARRAYS (P_FIELD,P_LEVELS or 1,1) ALR3F405.125
REAL !, INTENT(IN) LWRAD3A.212
& ACCUM_SULPHATE(SULP_DIM1, SULP_DIM2) ADB1F402.497
! MASS MIXING RATIO OF ACCUMULATION MODE AEROSOL ADB1F401.514
& , AITKEN_SULPHATE(SULP_DIM1, SULP_DIM2) ADB1F402.498
! MASS MIXING RATIO OF AITKEN MODE AEROSOL ADB1F401.516
& , DISS_SULPHATE(SULP_DIM1, SULP_DIM2) AYY1F404.380
! MIXING RATIO OF DISSOLVED SULPHATE AYY1F404.381
&,FRESH_SOOT(SOOT_DIM1,SOOT_DIM2),AGED_SOOT(SOOT_DIM1,SOOT_DIM2) ALR3F405.126
! SOOT MIXING RATIOS ALR3F405.127
! LWRAD3A.215
! CARBON CYCLE: ACN2F405.101
LOGICAL L_CO2_3D ! controls use of 3D co2 field ACN2F405.102
INTEGER !, INTENT(IN) ACN2F405.103
& CO2_DIM1, CO2_DIM2 ACN2F405.104
! DIMENSIONS FOR CO2 ARRAY, (P_FIELD,P_LEVELS or 1,1) ACN2F405.105
REAL !, INTENT(IN) ACN2F405.106
& CO2_3D(CO2_DIM1, CO2_DIM2) ACN2F405.107
! MASS MIXING RATIO OF CARBON DIOXIDE ACN2F405.108
! SURFACE FIELDS: LWRAD3A.216
LOGICAL !, INTENT(IN) LWRAD3A.217
& LAND(NPD_FIELD) LWRAD3A.218
! LAND SEA MASK LWRAD3A.219
REAL !, INTENT(IN) LWRAD3A.220
& PSTAR(NPD_FIELD) LWRAD3A.221
! SURFACE PRESSURES LWRAD3A.222
& , TSTAR(NPD_FIELD) LWRAD3A.223
! SURFACE TEMPERATURES LWRAD3A.224
& , ICE_FRACTION(NPD_FIELD) LWRAD3A.225
! SEA ICE FRACTION LWRAD3A.226
& , LYING_SNOW(NPD_FIELD) ADB1F402.499
! MASS LOADING OF LYING SNOW ADB1F402.500
! LWRAD3A.227
! Level of tropopause ADB1F402.501
INTEGER ADB1F402.502
& TRINDX(NPD_FIELD) ADB1F402.503
! THE LAYER BOUNDARY OF THE TROPOPAUSE ADB1F402.504
! ADB1F402.505
! INCREMENT OF TIME: LWRAD3A.228
REAL !, INTENT(IN) LWRAD3A.229
& PTS LWRAD3A.230
! TIME INCREMENT LWRAD3A.231
! LWRAD3A.232
! LWRAD3A.237
! CALCULATED FLUXES: LWRAD3A.238
REAL !, INTENT(OUT) LWRAD3A.239
& OLR(NPD_FIELD) LWRAD3A.240
! NET OUTGOING RADIATION LWRAD3A.241
& , LWOUT(NPD_FIELD, NLEVS+1) LWRAD3A.242
! NET DOWNWARD FLUXES OR HEATING RATES LWRAD3A.243
& , LWSEA(NPD_FIELD) LWRAD3A.244
! SEA-SURFACE COMPONENTS OF FLUX LWRAD3A.245
! LWRAD3A.246
! LWRAD3A.247
! LWRAD3A.248
! DIAGNOSTICS: LWRAD3A.249
! LWRAD3A.250
! INPUT SWITCHES: LWRAD3A.251
LOGICAL !, INTENT(IN) LWRAD3A.252
& L_TOTAL_CLOUD_COVER LWRAD3A.253
! TOTAL CLOUD AMOUNT DIAGNOSED LWRAD3A.254
& , L_CLEAR_OLR LWRAD3A.255
! CLEAR OLR DIAGNOSED LWRAD3A.256
& , L_SURFACE_DOWN_FLUX LWRAD3A.257
! SURFACE DOWNWARD FLUX DIAGNOSED LWRAD3A.258
& , L_SURF_DOWN_CLR LWRAD3A.259
! SURFACE DOWNWARD CLEAR FLUX DIAG. LWRAD3A.260
& , L_CLEAR_HR LWRAD3A.261
! CALCULATE CLEAR-SKY HEATING RATES LWRAD3A.262
& , L_NET_FLUX_TROP ADB2F404.657
! CALCULATE NET DOWNWARD FLUX AT THE TROPOPAUSE ADB2F404.658
& , L_DOWN_FLUX_TROP ADB2F404.659
! CALCULATE DOWNWARD FLUX AT THE TROPOPAUSE ADB2F404.660
! LWRAD3A.263
! CALCULATED DIAGNOSTICS: LWRAD3A.264
REAL !, INTENT(OUT) LWRAD3A.265
& TOTAL_CLOUD_COVER(NPD_FIELD) LWRAD3A.266
! TOTAL CLOUD COVER LWRAD3A.267
& , CLEAR_OLR(NPD_FIELD) LWRAD3A.268
! CLEAR-SKY OLR LWRAD3A.269
& , SURFACE_DOWN_FLUX(NPD_FIELD) LWRAD3A.270
! DOWNWARD SURFACE FLUX LWRAD3A.271
& , SURF_DOWN_CLR(NPD_FIELD) LWRAD3A.272
! DOWNWARD SURFACE CLEARFLUX LWRAD3A.273
& , CLEAR_HR(NPD_FIELD, NLEVS) LWRAD3A.274
! CLEAR-SKY HEATING RATES LWRAD3A.275
& , NET_FLUX_TROP(NPD_FIELD) ADB2F404.661
! NET DOWNWARD FLUX AT THE TROPOPAUSE ADB2F404.662
& , DOWN_FLUX_TROP(NPD_FIELD) ADB2F404.663
! DOWNWARD FLUX AT THE TROPOPAUSE ADB2F404.664
! LWRAD3A.276
! LWRAD3A.277
! LWRAD3A.278
! LOCAL VARIABLES. LWRAD3A.279
! LWRAD3A.280
INTEGER LWRAD3A.281
& I LWRAD3A.282
! LOOP VARIABLE LWRAD3A.283
& , L LWRAD3A.284
! LOOP VARIABLE LWRAD3A.285
INTEGER LWRAD3A.286
& I_GATHER(NPD_FIELD) LWRAD3A.287
! GATHERING ARRAY LWRAD3A.288
LOGICAL LWRAD3A.289
& L_CLEAR LWRAD3A.290
! CALCULATE CLEAR-SKY FIELDS LWRAD3A.291
! FLAGS FOR PROCESSES ACTUALLY ENABLED. ADB1F401.517
LOGICAL ADB1F401.518
& L_RAYLEIGH ADB1F401.519
! LOCAL FLAG FOR RAYLEIGH SCATTERING ADB1F401.520
& , L_GAS ADB1F401.521
! LOCAL FLAG FOR GASEOUS ABSORPTION ADB1F401.522
& , L_CONTINUUM ADB1F401.523
! LOCAL FLAG FOR CONTINUUM ABSORPTION ADB1F401.524
& , L_DROP ADB1F401.525
! LOCAL FLAG FOR SCATTERING BY DROPLETS ADB1F401.526
& , L_AEROSOL ADB1F401.527
! LOCAL FLAG FOR SCATTERING BY AEROSOLS ADB1F401.528
& , L_AEROSOL_CCN ADB1F401.529
! LOCAL FLAG FOR SCATTERING BY AEROSOLS ADB1F401.530
& , L_ICE ADB1F401.531
! LOCAL FLAG FOR SCATTERING BY ICE CRYSTALS ADB1F401.532
INTEGER LWRAD3A.292
& I_SOLVER_CLEAR LWRAD3A.293
! SOLVER FOR CLEAR-SKY FLUXES LWRAD3A.294
& , I_GAS_OVERLAP(NPD_BAND_LW) ADB2F404.665
! OVERLAPS IN EACH BAND LWRAD3A.296
! LWRAD3A.297
! GENERAL ATMOSPHERIC PROPERTIES: LWRAD3A.298
REAL LWRAD3A.299
& D_MASS(NPD_PROFILE, NPD_LAYER) LWRAD3A.300
! MASS THICKNESSES OF LAYERS LWRAD3A.301
& , P(NPD_PROFILE, 0: NPD_LAYER) LWRAD3A.302
! PRESSURE FIELD LWRAD3A.303
& , T(NPD_PROFILE, 0: NPD_LAYER) LWRAD3A.304
! TEMPERATURE FIELD LWRAD3A.305
& , T_BDY(NPD_PROFILE, 0: NPD_LAYER) LWRAD3A.306
! TEMPERATURE FIELD AT BOUNDARIES LWRAD3A.307
& , GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES_LW) ADB2F404.666
! MASS FRACTIONS OF GASES LWRAD3A.309
! LWRAD3A.310
! SURFACE FIELDS: LWRAD3A.311
INTEGER LWRAD3A.312
& I_SURFACE(NPD_PROFILE) LWRAD3A.313
! TYPE OF SURFACE AT THE FOOT OF EACH PROFILE LWRAD3A.314
REAL !, INTENT(IN) LWRAD3A.315
& ALBEDO_FIELD_DIFF(NPD_PROFILE, NPD_BAND_LW) ADB2F404.667
! DIFFUSE ALBEDOS LWRAD3A.317
& , ALBEDO_FIELD_DIR(NPD_PROFILE, NPD_BAND_LW) ADB2F404.668
! DIRECT ALBEDOS LWRAD3A.319
& , EMISSIVITY_FIELD(NPD_PROFILE, NPD_BAND_LW) ADB2F404.669
! EMISSIVITIES LWRAD3A.321
& , ALBEDO_SEA_DIFF(NPD_PROFILE, NPD_BAND_LW) ADB2F404.670
! DIFFUSE ALBEDO OF OPEN SEA LWRAD3A.323
& , ALBEDO_SEA_DIR(NPD_PROFILE, NPD_BAND_LW) ADB2F404.671
! DIRECT ALBEDO OF OPEN SEA LWRAD3A.325
& , T_SURFACE(NPD_PROFILE) ADB1F401.533
! GATHERED TEMPERATURE OF SURFACE ADB1F401.534
! LWRAD3A.326
! CLOUDY PROPERTIES: LWRAD3A.327
INTEGER LWRAD3A.328
& N_CONDENSED LWRAD3A.329
! NUMBER OF CONDENSED PHASES LWRAD3A.330
& , TYPE_CONDENSED(NPD_CLOUD_COMPONENT) LWRAD3A.331
! TYPES OF CONDENSED COMPONENTS LWRAD3A.332
& , I_CONDENSED_PARAM(NPD_CLOUD_COMPONENT) LWRAD3A.333
! PARAMETRIZATION SCHEMES FOR COMPONENTS LWRAD3A.334
& , N_CLOUD_TOP_GLOBAL ADB1F402.875
! INVERTED GLOBAL TOPMOST CLOUDY LAYER ADB1F402.876
REAL LWRAD3A.335
& CONDENSED_PARAM_LIST(NPD_CLOUD_PARAMETER_LW ADB2F404.672
& , NPD_CLOUD_COMPONENT, NPD_BAND_LW) ADB2F404.673
! PARAMETERS FOR CONDENSED PHASES LWRAD3A.338
& , CONDENSED_DIM_CHAR(NPD_PROFILE, 0: NPD_LAYER ADB2F404.674
& , NPD_CLOUD_COMPONENT) ADB2F404.675
! CHARACTERISTIC DIMENSIONS OF CONDENSED SPECIES ADB2F404.676
& , CONDENSED_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER LWRAD3A.341
& , NPD_CLOUD_COMPONENT) LWRAD3A.342
! MASS FRACTIONS OF LIQUID WATER LWRAD3A.343
& , W_CLOUD(NPD_PROFILE, NPD_LAYER) LWRAD3A.344
! CLOUD AMOUNTS LWRAD3A.345
& , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE) LWRAD3A.346
! CLOUD AMOUNTS LWRAD3A.347
& , CONDENSED_MIN_DIM(NPD_CLOUD_COMPONENT) ADB2F404.677
! MINIMUM DIMENSIONS OF CONDENSED COMPONENTS ADB2F404.678
& , CONDENSED_MAX_DIM(NPD_CLOUD_COMPONENT) ADB2F404.679
! MAXIMUM DIMENSIONS OF CONDENSED COMPONENTS ADB2F404.680
! LWRAD3A.348
! PROPERTIES OF AEROSOLS: LWRAD3A.349
REAL LWRAD3A.350
& AEROSOL_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER LWRAD3A.351
& , NPD_AEROSOL_SPECIES_LW) ADB2F404.681
! MIXING RATIOS OF AEROSOLS LWRAD3A.353
! LWRAD3A.354
! COUPLING FIELDS: ADB1F401.535
INTEGER ADB1F401.536
& N_FRAC_ICE_POINT ADB1F401.537
! NUMBER OF POINTS WITH FRACTIONAL ICE COVER ADB1F401.538
& , I_FRAC_ICE_POINT(NPD_PROFILE) ADB1F401.539
! INDICES OF POINTS WITH FRACTIONAL ICE COVER ADB1F401.540
! ADB1F401.541
! FLUXES: LWRAD3A.355
REAL LWRAD3A.356
& FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER) LWRAD3A.357
! DIRECT FLUX LWRAD3A.358
& , FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER) LWRAD3A.359
! CLEAR-SKY DIRECT FLUX LWRAD3A.360
& , FLUX_NET(NPD_PROFILE, 0: NPD_LAYER) LWRAD3A.361
! DOWNWARD/NET FLUX LWRAD3A.362
& , FLUX_NET_CLEAR(NPD_PROFILE, 0: NPD_LAYER) LWRAD3A.363
! CLEAR-SKY DOWNWARD/NET FLUX LWRAD3A.364
& , FLUX_UP(NPD_PROFILE, 0: NPD_LAYER) LWRAD3A.365
! UPWARD FLUX LWRAD3A.366
& , FLUX_UP_CLEAR(NPD_PROFILE, 0: NPD_LAYER) LWRAD3A.367
! CLEAR-SKY UPWARD FLUX LWRAD3A.368
! LWRAD3A.369
! FIELDS REQUIRED FOR CALL TO RADIATION CODE BUT NOT USED LWRAD3A.370
INTEGER LWRAD3A.371
& N_ORDER_GAUSS LWRAD3A.372
& , I_GAS LWRAD3A.373
LOGICAL LWRAD3A.374
& L_SWITCH_SCATTER(NPD_BAND_LW) ADB2F404.682
REAL LWRAD3A.376
& SEC_0(NPD_PROFILE) LWRAD3A.377
& , SOLAR_CONSTANT(NPD_PROFILE) LWRAD3A.378
! LWRAD3A.379
! LWRAD3A.384
! AUXILIARY VARIABLES: LWRAD3A.385
REAL LWRAD3A.386
& CPBYG LWRAD3A.387
! SPECIFIC HEAT BY GRAVITY LWRAD3A.388
& , DACON LWRAD3A.389
! DIFFERENCE IN A's LWRAD3A.390
& , DBCON LWRAD3A.391
! DIFFERENCE IN B's LWRAD3A.392
& , WEIGHT_BAND(NPD_BAND_LW) ADB2F404.683
! WEIGHTING FACTORS FOR BANDS LWRAD3A.394
& , NULLMMR LWRAD3A.395
! NULL MASS MIXING RATIO LWRAD3A.396
PARAMETER(CPBYG=CP/G) LWRAD3A.397
PARAMETER(NULLMMR=0.0E+00) LWRAD3A.398
! LWRAD3A.399
! DUMMY FIELDS FOR RADIATION CODE LWRAD3A.400
LOGICAL LWRAD3A.401
& L_DUMMY LWRAD3A.402
REAL LWRAD3A.403
& DUMMY ADB2F404.684
! LWRAD3A.405
! LWRAD3A.406
! SUBROUTINES CALLED: LWRAD3A.407
EXTERNAL LWRAD3A.408
& R2_SET_GAS_MIX_RATIO, R2_SET_THERMODYNAMIC LWRAD3A.409
& , R2_SET_AEROSOL_FIELD, R2_SET_CLOUD_FIELD LWRAD3A.410
& , R2_SET_CLOUD_PARAMETRIZATION LWRAD3A.411
& , R2_SET_SURFACE_FIELD_LW, R2_ZERO_1D LWRAD3A.412
& , R2_COMPARE_PROC ADB1F401.542
! LWRAD3A.420
! LWRAD3A.421
! LWRAD3A.422
! LWRAD3A.423
! INITIALIZE THE ERROR FLAG FOR THE RADIATION CODE. LWRAD3A.424
IERR=I_NORMAL LWRAD3A.425
! SET THE LOGICAL FLAG FOR DUMMY DIAGNOSTICS NOT AVAILABLE FROM ADB1F402.506
! THE LOWER CODE IN THE LONG-WAVE TO .FALSE.. ADB1F402.507
L_DUMMY=.FALSE. ADB1F402.508
! LWRAD3A.426
! LWRAD3A.427
! COMPARE PROCESSES IN THE SPECTRAL FILE WITH THOSE ENABLED IN ADB1F401.543
! THE CODE. ADB1F401.544
CALL R2_COMPARE_PROC(IERR, L_PRESENT_LW ADB2F404.685
& , L_RAYLEIGH_LW, L_GAS_LW, L_CONTINUUM_LW ADB1F401.546
& , L_DROP_LW, L_AEROSOL_LW, L_AEROSOL_CCN_LW, L_ICE_LW ADB1F401.547
& , L_USE_SULPC_DIRECT, L_USE_SULPC_INDIRECT ADB1F401.548
& , L_USE_SOOT_DIRECT ALR3F405.128
& , L_CLIMAT_AEROSOL ADB1F402.509
& , L_RAYLEIGH, L_GAS, L_CONTINUUM ADB1F401.549
& , L_DROP, L_AEROSOL, L_AEROSOL_CCN, L_ICE ADB1F401.550
& , NPD_TYPE_LW ADB2F404.686
& ) ADB1F401.552
IF (IERR.NE.I_NORMAL) RETURN ADB1F401.553
! ADB1F405.356
! CHECK THAT A VALID NUMBER HAS BEEN SUPPLIED FOR THE SOLVER. ADB1F405.357
IF ( (I_SOLVER_LW.NE.IP_SOLVER_PENTADIAGONAL).AND. ADB1F405.358
& (I_SOLVER_LW.NE.IP_SOLVER_MIX_11).AND. ADB1F405.359
& (I_SOLVER_LW.NE.IP_SOLVER_MIX_APP_SCAT).AND. ADB1F405.360
& (I_SOLVER_LW.NE.IP_SOLVER_MIX_DIRECT).AND. ADB1F405.361
& (I_SOLVER_LW.NE.IP_SOLVER_HOMOGEN_DIRECT).AND. ADB1F405.362
& (I_SOLVER_LW.NE.IP_SOLVER_TRIPLE).AND. ADB1F405.363
& (I_SOLVER_LW.NE.IP_SOLVER_TRIPLE_APP_SCAT) ADB1F405.364
& ) THEN ADB1F405.365
WRITE(IU_ERR, '(/A, /A)') ADB1F405.366
& '*** ERROR: AN INVALID SOLVER HAS BEEN SELECTED ' ADB1F405.367
& , 'IN THE LONGWAVE REGION.' ADB1F405.368
IERR=I_ERR_FATAL ADB1F405.369
RETURN ADB1F405.370
ENDIF ADB1F405.371
! ADB1F405.372
! ADB1F401.554
! ADB1F401.555
! ADB1F402.510
! THE GATHERING ARRAY IS REQUIRED BY THE SETTING SUBROUTINES (FOR LWRAD3A.428
! COMPATIBILITY WITH THE SHORTWAVE), BUT IS FILLED WITH INTEGERS LWRAD3A.429
! FROM 1 TO N_PROFILE SINCE ALL POINTS WILL BE CONSIDERED. LWRAD3A.430
DO L=1, N_PROFILE LWRAD3A.431
I_GATHER(L)=L LWRAD3A.432
ENDDO LWRAD3A.433
! LWRAD3A.434
! LWRAD3A.435
! SET THE MIXING RATIOS OF GASES. LWRAD3A.436
CALL R2_SET_GAS_MIX_RATIO(IERR LWRAD3A.437
& , N_PROFILE, NLEVS, NWET, NOZONE LWRAD3A.438
& , I_GATHER LWRAD3A.439
& , N_ABSORB_LW, TYPE_ABSORB_LW ADB2F404.687
& , L_N2O_LW, L_CH4_LW, L_CFC11_LW, L_CFC12_LW,. FALSE. ADB2F404.688
& , L_CFC113_LW, L_HCFC22_LW, L_HFC125_LW, L_HFC134A_LW ADB1F405.351
& , H2O, CO2, O3, N2O_MIX_RATIO, CH4_MIX_RATIO LWRAD3A.442
& , CFC11_MIX_RATIO, CFC12_MIX_RATIO, NULLMMR LWRAD3A.443
& , CFC113_MIX_RATIO, HCFC22_MIX_RATIO, HFC125_MIX_RATIO ADB1F405.352
& , HFC134A_MIX_RATIO ADB1F405.353
& , GAS_MIX_RATIO LWRAD3A.444
& , CO2_DIM1, CO2_DIM2, CO2_3D, L_CO2_3D ACN2F405.109
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_SPECIES_LW ADB2F404.689
& ) LWRAD3A.446
IF (IERR.NE.I_NORMAL) RETURN LWRAD3A.447
! LWRAD3A.448
! LWRAD3A.449
! CALCULATE PRESSURES AND TEMPERATURES. ADB1F405.354
CALL R2_SET_THERMODYNAMIC(N_PROFILE, NLEVS, I_GATHER, .TRUE. LWRAD3A.451
& , PSTAR, TSTAR, AB, BB, AC, BC, PEXNER, TAC ADB1F401.556
& , P, T, T_BDY, T_SURFACE, D_MASS ADB1F401.557
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER LWRAD3A.454
& ) LWRAD3A.455
! LWRAD3A.456
! LWRAD3A.457
! SET THE MIXING RATIOS OF AEROSOLS. LWRAD3A.458
IF (L_AEROSOL.OR.L_AEROSOL_CCN) THEN ADB1F401.558
CALL R2_SET_AEROSOL_FIELD(IERR ADB1F402.511
& , N_PROFILE, NLEVS, N_AEROSOL_LW, TYPE_AEROSOL_LW ADB2F404.690
& , I_GATHER LWRAD3A.461
& , L_CLIMAT_AEROSOL, N_LEVELS_BL ADB1F402.513
& , L_USE_SULPC_DIRECT ADB2F404.691
& , SULP_DIM1, SULP_DIM2 ADB1F402.515
& , ACCUM_SULPHATE, AITKEN_SULPHATE ADB1F402.516
&,L_USE_SOOT_DIRECT, SOOT_DIM1, SOOT_DIM2, FRESH_SOOT, AGED_SOOT ALR3F405.129
& , LAND, LYING_SNOW, PSTAR, AB, BB, TRINDX ADB1F402.517
& , AEROSOL_MIX_RATIO ADB1F402.518
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_AEROSOL_SPECIES_LW ADB2F404.692
& ) LWRAD3A.464
ENDIF LWRAD3A.465
! LWRAD3A.466
! LWRAD3A.467
! ASSIGN THE PROPERTIES OF CLOUDS. A DUMMY ARRAY MUST BE PASSED LWRAD3A.468
! FOR THE MICROPHYSICAL DIAGNOSTICS SINCE THEY ARE NOT AVAILABLE LWRAD3A.469
! THROUGH STASH IN THE LONG-WAVE. LWRAD3A.470
! LWRAD3A.471
CALL R2_SET_CLOUD_PARAMETRIZATION(IERR, N_BAND_LW ADB2F404.693
& , I_ST_WATER_LW, I_CNV_WATER_LW, I_ST_ICE_LW, I_CNV_ICE_LW ADB2F404.694
& , L_DROP_TYPE_LW ADB2F404.695
& , I_DROP_PARAMETRIZATION_LW ADB2F404.696
& , DROP_PARAMETER_LIST_LW ADB2F404.697
& , DROP_PARM_MIN_DIM_LW, DROP_PARM_MAX_DIM_LW ADB2F404.698
& , L_ICE_TYPE_LW ADB2F404.699
& , I_ICE_PARAMETRIZATION_LW ADB2F404.700
& , ICE_PARAMETER_LIST_LW ADB2F404.701
& , ICE_PARM_MIN_DIM_LW, ICE_PARM_MAX_DIM_LW ADB2F404.702
& , I_CONDENSED_PARAM, CONDENSED_PARAM_LIST ADB2F404.703
& , CONDENSED_MIN_DIM, CONDENSED_MAX_DIM ADB2F404.704
& , NPD_BAND_LW, NPD_DROP_TYPE_LW ADB2F404.705
& , NPD_ICE_TYPE_LW, NPD_CLOUD_PARAMETER_LW ADB2F404.706
& ) ADB2F404.707
IF (IERR.NE.I_NORMAL) RETURN ADB2F404.708
! ADB2F404.709
CALL R2_SET_CLOUD_FIELD(N_PROFILE, NLEVS, NCLDS LWRAD3A.472
& , I_GATHER LWRAD3A.473
& , P, T, D_MASS LWRAD3A.474
& , CCB, CCT, CCA, CCCWP LWRAD3A.475
& , LCCWC1, LCCWC2, LCA_AREA, LCA_BULK ASK1F405.295
& , L_MICROPHYSICS_LW, L_AEROSOL_CCN AYY1F404.382
& , SULP_DIM1, SULP_DIM2, ACCUM_SULPHATE, DISS_SULPHATE AYY1F404.383
& , L_CLOUD_WATER_PARTITION, LAND AYY1F404.384
& , I_CLOUD_REPRESENTATION_LW, I_CONDENSED_PARAM ADB2F404.710
& , CONDENSED_MIN_DIM, CONDENSED_MAX_DIM ADB2F404.711
& , N_CONDENSED, TYPE_CONDENSED LWRAD3A.479
& , W_CLOUD, FRAC_CLOUD, L_LOCAL_CNV_PARTITION_LW ADB1F405.355
& , CONDENSED_MIX_RATIO, CONDENSED_DIM_CHAR ADB2F404.712
! Microphysical Diagnostics are not available ADB2F404.713
! in this spectral region. ADB2F404.714
& , DUMMY, .FALSE., DUMMY, .FALSE. ADB2F404.715
& , DUMMY, .FALSE., DUMMY, .FALSE. ADB2F404.716
& , DUMMY, .FALSE. ADB2F404.717
& , DUMMY, .FALSE., DUMMY, .FALSE. ADB2F404.718
& , DUMMY, .FALSE., DUMMY, .FALSE. ADB2F404.719
& , NPD_FIELD, NPD_PROFILE, NPD_LAYER, NPD_AEROSOL_SPECIES_LW ADB2F404.720
& , N_CCA_LEV, L_3D_CCA AJX0F404.27
& ) LWRAD3A.486
! LWRAD3A.499
! LWRAD3A.500
CALL R2_SET_SURFACE_FIELD_LW( LWRAD3A.501
& N_PROFILE, N_BAND_LW ADB2F404.721
& , I_SURFACE, I_SPEC_SURFACE_LW ADB2F404.722
& , L_SURFACE_LW ADB2F404.723
& , EMISSIVITY_FIELD, ALBEDO_FIELD_DIR, ALBEDO_FIELD_DIFF LWRAD3A.505
& , ALBEDO_SEA_DIR, ALBEDO_SEA_DIFF LWRAD3A.506
& , N_FRAC_ICE_POINT, I_FRAC_ICE_POINT, ICE_FRACTION ADB1F401.568
& , NPD_PROFILE, NPD_BAND_LW, NPD_SURFACE_LW ADB2F404.724
& ) LWRAD3A.508
! LWRAD3A.509
! SET CLEAR-SKY CALCULATIONS. LWRAD3A.510
L_CLEAR=L_CLEAR_OLR.OR. LWRAD3A.511
& L_SURF_DOWN_CLR.OR. LWRAD3A.512
& L_CLEAR_HR LWRAD3A.513
! LWRAD3A.514
IF (L_CLEAR) THEN LWRAD3A.515
! LWRAD3A.516
! SELECT A CLEAR-SKY SOLVER TO MATCH THE MAIN SOLVER. LWRAD3A.517
IF (I_SOLVER_LW.EQ.IP_SOLVER_PENTADIAGONAL) THEN LWRAD3A.518
I_SOLVER_CLEAR=IP_SOLVER_PENTADIAGONAL LWRAD3A.519
ELSE IF (I_SOLVER_LW.EQ.IP_SOLVER_MIX_11) THEN LWRAD3A.528
I_SOLVER_CLEAR=IP_SOLVER_PENTADIAGONAL LWRAD3A.529
ELSE IF (I_SOLVER_LW.EQ.IP_SOLVER_MIX_APP_SCAT) THEN LWRAD3A.534
I_SOLVER_CLEAR=IP_SOLVER_HOMOGEN_DIRECT ADB1F401.569
ELSE IF (I_SOLVER_LW.EQ.IP_SOLVER_MIX_DIRECT) THEN ADB1F401.570
I_SOLVER_CLEAR=IP_SOLVER_HOMOGEN_DIRECT ADB1F402.519
ELSE IF (I_SOLVER_LW.EQ.IP_SOLVER_TRIPLE) THEN ADB1F402.520
I_SOLVER_CLEAR=IP_SOLVER_HOMOGEN_DIRECT ADB1F402.521
ELSE IF (I_SOLVER_LW.EQ.IP_SOLVER_TRIPLE_APP_SCAT) THEN ADB1F402.522
I_SOLVER_CLEAR=IP_SOLVER_HOMOGEN_DIRECT ADB1F401.571
ENDIF LWRAD3A.538
! LWRAD3A.539
ENDIF LWRAD3A.540
! LWRAD3A.541
! LWRAD3A.542
! SET PROPERTIES OF INDIVIDUAL BANDS. LWRAD3A.543
DO I=1, N_BAND_LW ADB2F404.727
WEIGHT_BAND(I)=1.0E+00 LWRAD3A.545
I_GAS_OVERLAP(I)=I_GAS_OVERLAP_LW LWRAD3A.546
ENDDO LWRAD3A.547
! ADB1F402.877
! INVERT THE TOPMOST CLOUDY LAYER IF USING A GLOBAL VALUE. ADB1F402.878
IF (L_GLOBAL_CLOUD_TOP) THEN ADB1F402.879
N_CLOUD_TOP_GLOBAL=NLEVS+1-GLOBAL_CLOUD_TOP ADB1F402.880
ENDIF ADB1F402.881
! LWRAD3A.548
! LWRAD3A.549
! LWRAD3A.550
CALL FLUX_CALC(IERR LWRAD3A.551
! Logical Flags for Processes LWRAD3A.552
& , L_RAYLEIGH, L_AEROSOL, L_GAS, L_CONTINUUM ADB1F401.572
& , L_CLOUD_LW, L_DROP, L_ICE ADB1F401.573
! Angular Integration LWRAD3A.555
& , I_ANGULAR_INTEGRATION_LW, I_2STREAM_LW, L_2_STREAM_CORRECT_LW LWRAD3A.556
& , L_RESCALE_LW, N_ORDER_GAUSS LWRAD3A.557
! Treatment of Scattering LWRAD3A.558
& , I_SCATTER_METHOD_LW, L_SWITCH_SCATTER LWRAD3A.559
! Options for treating clouds ADB1F402.882
& , L_GLOBAL_CLOUD_TOP, N_CLOUD_TOP_GLOBAL ADB1F402.883
! Options for Solver LWRAD3A.560
& , I_SOLVER_LW ADB1F405.373
! General Spectral Properties LWRAD3A.562
& , N_BAND_LW, 1, N_BAND_LW ADB2F404.728
& , WEIGHT_BAND LWRAD3A.564
! General Atmospheric Properties LWRAD3A.565
& , N_PROFILE, NLEVS LWRAD3A.566
& , L_LAYER_LW, L_CLOUD_LAYER_LW LWRAD3A.567
& , P, T, T_SURFACE, T_BDY, D_MASS ADB1F401.574
! Spectral Region LWRAD3A.569
& , ISOLIR_LW LWRAD3A.570
! Solar Fields LWRAD3A.571
& , SEC_0, SOLAR_CONSTANT, SOLAR_FLUX_BAND_LW ADB2F404.729
& , RAYLEIGH_COEFFICIENT_LW ADB2F404.730
! Infra-red Fields LWRAD3A.574
& , N_DEG_FIT_LW ADB2F404.731
& , THERMAL_COEFFICIENT_LW ADB2F404.732
& , T_REF_PLANCK_LW, L_IR_SOURCE_QUAD_LW ADB2F404.733
! Gaseous Absorption LWRAD3A.578
& , N_ABSORB_LW, I_GAS_OVERLAP, I_GAS ADB2F404.734
& , GAS_MIX_RATIO LWRAD3A.580
& , N_BAND_ABSORB_LW, INDEX_ABSORB_LW ADB2F404.735
& , I_BAND_ESFT_LW ADB2F404.736
& , W_ESFT_LW, K_ESFT_LW ADB2F404.737
& , I_SCALE_ESFT_LW, I_SCALE_FNC_LW ADB2F404.738
& , SCALE_VECTOR_LW ADB2F404.739
& , P_REFERENCE_LW, T_REFERENCE_LW ADB2F404.740
! Doppler Broadening LWRAD3A.587
& , L_DOPPLER_PRESENT_LW ADB2F404.741
& , DOPPLER_CORRECTION_LW ADB2F404.742
! Surface Fields LWRAD3A.590
& , L_SURFACE_LW, I_SURFACE ADB2F404.743
& , I_SPEC_SURFACE_LW ADB2F404.744
& , SURFACE_ALBEDO_LW ADB2F404.745
& , ALBEDO_FIELD_DIFF, ALBEDO_FIELD_DIR LWRAD3A.594
& , N_DIR_ALBEDO_FIT_LW ADB2F404.746
& , DIRECT_ALBEDO_PARM_LW ADB2F404.747
& , EMISSIVITY_GROUND_LW ADB2F404.748
& , EMISSIVITY_FIELD LWRAD3A.598
! Continuum Absorption LWRAD3A.599
& , N_BAND_CONTINUUM_LW ADB2F404.749
& , INDEX_CONTINUUM_LW, INDEX_WATER_LW ADB2F404.750
& , K_CONTINUUM_LW ADB2F404.751
& , I_SCALE_FNC_CONT_LW ADB2F404.752
& , SCALE_CONTINUUM_LW ADB2F404.753
& , P_REF_CONTINUUM_LW ADB2F404.754
& , T_REF_CONTINUUM_LW ADB2F404.755
! Properties of Aerosols LWRAD3A.607
& , N_AEROSOL_LW ADB2F404.756
& , AEROSOL_MIX_RATIO LWRAD3A.609
& , AEROSOL_ABSORPTION_LW ADB2F404.757
& , AEROSOL_SCATTERING_LW ADB2F404.758
& , AEROSOL_ASYMMETRY_LW ADB2F404.759
& , I_AEROSOL_PARAMETRIZATION_LW ADB2F404.760
& , NHUMIDITY_LW ADB2F404.761
& , HUMIDITIES_LW ADB2F404.762
! Properties of Clouds LWRAD3A.616
& , N_CONDENSED, TYPE_CONDENSED LWRAD3A.617
& , I_CLOUD_LW, I_CLOUD_REPRESENTATION_LW, W_CLOUD, FRAC_CLOUD LWRAD3A.618
& , CONDENSED_MIX_RATIO, CONDENSED_DIM_CHAR ADB2F404.763
& , I_CONDENSED_PARAM, CONDENSED_PARAM_LIST LWRAD3A.620
! Fluxes Calculated LWRAD3A.621
& , FLUX_DIRECT, FLUX_NET, FLUX_UP LWRAD3A.622
! Options for Clear-sky Fluxes LWRAD3A.623
& , L_CLEAR, I_SOLVER_CLEAR LWRAD3A.624
! Clear-sky Fluxes Calculated LWRAD3A.625
& , FLUX_DIRECT_CLEAR, FLUX_NET_CLEAR, FLUX_UP_CLEAR LWRAD3A.626
! Arrays specific to the UM LWRAD3A.627
! Arrays for Coupling LWRAD3A.628
& , N_FRAC_ICE_POINT, I_FRAC_ICE_POINT, ICE_FRACTION ADB1F401.575
& , ALBEDO_SEA_DIFF, ALBEDO_SEA_DIR, LWSEA LWRAD3A.629
! Arrays for diagnostics specific to the UM LWRAD3A.630
& , L_DUMMY, DUMMY, DUMMY LWRAD3A.631
& , L_SURFACE_DOWN_FLUX, SURFACE_DOWN_FLUX LWRAD3A.632
& , L_SURF_DOWN_CLR, SURF_DOWN_CLR LWRAD3A.633
& , L_DUMMY, DUMMY LWRAD3A.634
! Dimensions of Arrays LWRAD3A.635
& , NPD_PROFILE, NPD_LAYER, NPD_COLUMN LWRAD3A.636
& , NPD_BAND_LW ADB2F404.764
& , NPD_SPECIES_LW ADB2F404.765
& , NPD_ESFT_TERM_LW, NPD_SCALE_FNC_LW, NPD_SCALE_VARIABLE_LW ADB2F404.766
& , NPD_CONTINUUM_LW ADB2F404.767
& , NPD_AEROSOL_SPECIES_LW, NPD_HUMIDITIES_LW ADB2F404.768
& , NPD_CLOUD_PARAMETER_LW ADB2F404.769
& , NPD_THERMAL_COEFF_LW ADB2F404.770
& , NPD_SURFACE_LW, NPD_ALBEDO_PARM_LW ADB2F404.771
& ) LWRAD3A.647
IF (IERR.NE.I_NORMAL) RETURN LWRAD3A.648
! LWRAD3A.649
! LWRAD3A.650
! LWRAD3A.651
! ASSIGNMENT OF DIAGNOSTICS: LWRAD3A.652
! LWRAD3A.653
! LWRAD3A.654
! OLR: LWRAD3A.655
! LWRAD3A.656
DO L=1, N_PROFILE LWRAD3A.657
OLR(L)=-FLUX_NET(L, 0) LWRAD3A.658
ENDDO LWRAD3A.659
IF (L_CLEAR_OLR) THEN LWRAD3A.660
DO L=1, N_PROFILE LWRAD3A.661
CLEAR_OLR(L)=-FLUX_NET_CLEAR(L, 0) LWRAD3A.662
ENDDO LWRAD3A.663
ENDIF LWRAD3A.664
! LWRAD3A.665
! LWRAD3A.666
! TOTAL CLOUD COVER: LWRAD3A.667
! LWRAD3A.668
IF (L_TOTAL_CLOUD_COVER) THEN LWRAD3A.669
CALL R2_CALC_TOTAL_CLOUD_COVER(N_PROFILE, NLEVS, NCLDS LWRAD3A.670
& , I_CLOUD_LW, W_CLOUD, TOTAL_CLOUD_COVER LWRAD3A.671
& , NPD_PROFILE, NPD_LAYER LWRAD3A.672
& ) LWRAD3A.673
ENDIF LWRAD3A.674
! LWRAD3A.675
! LWRAD3A.676
! NET FLUX AT THE TROPOPAUSE: ADB2F404.772
! ADB2F404.773
IF (L_NET_FLUX_TROP) THEN ADB2F404.774
DO L=1, N_PROFILE ADB2F404.775
NET_FLUX_TROP(L) ADB2F404.776
& =FLUX_NET(L, NLEVS+1-TRINDX(L)) ADB2F404.777
ENDDO ADB2F404.778
ENDIF ADB2F404.779
! ADB2F404.780
! ADB2F404.781
! DOWNWARD FLUX AT THE TROPOPAUSE: ADB2F404.782
! ADB2F404.783
IF (L_DOWN_FLUX_TROP) THEN ADB2F404.784
DO L=1, N_PROFILE ADB1F405.374
DOWN_FLUX_TROP(L) ADB1F405.375
& =FLUX_NET(L, NLEVS+1-TRINDX(L)) ADB1F405.376
& +FLUX_UP(L, NLEVS+1-TRINDX(L)) ADB1F405.377
ENDDO ADB1F405.378
ENDIF ADB2F404.807
! ADB2F404.808
! ADB2F404.809
! ADB2F404.810
! ADB2F404.811
! ADB2F404.812
! OUTPUT ARRAYS: LWRAD3A.677
! LWRAD3A.678
! CONVERT THE FLUXES TO INCREMENTS IN THE HEATING RATE EXCEPT AT ADB1F405.379
! THE SURFACE: THERE, THE NET DOWNWARD FLUX IS ASSIGNED TO LWOUT. ADB1F405.380
DO I=NLEVS, 1, -1 LWRAD3A.681
DACON=(AB(I)-AB(I+1))*CPBYG/PTS LWRAD3A.682
DBCON=(BB(I)-BB(I+1))*CPBYG/PTS LWRAD3A.683
DO L=1, N_PROFILE LWRAD3A.684
LWOUT(L, I+1)=(FLUX_NET(L, NLEVS-I) LWRAD3A.685
& -FLUX_NET(L, NLEVS+1-I))/(DACON+PSTAR(L)*DBCON) LWRAD3A.686
ENDDO LWRAD3A.687
IF (L_CLEAR_HR) THEN LWRAD3A.688
! THE FACTOR OF PTS IS INCLUDED HERE TO YIELD A RATE FROM AN LWRAD3A.689
! INCREMENT. LWRAD3A.690
DO L=1, N_PROFILE LWRAD3A.691
CLEAR_HR(L, I)=(FLUX_NET_CLEAR(L, NLEVS-I) LWRAD3A.692
& -FLUX_NET_CLEAR(L, NLEVS+1-I))/(PTS LWRAD3A.693
& *(DACON+PSTAR(L)*DBCON)) LWRAD3A.694
ENDDO LWRAD3A.695
ENDIF LWRAD3A.696
ENDDO LWRAD3A.697
LWRAD3A.698
DO L=1, N_PROFILE LWRAD3A.699
LWOUT(L, 1)=FLUX_NET(L, NLEVS) LWRAD3A.700
ENDDO LWRAD3A.701
! LWRAD3A.702
! SEPARATE THE CONTRIBUTIONS OVER OPEN SEA AND SEA-ICE. LWRAD3A.703
! LWSEA MUST BE WEIGHTED WITH THE FRACTION OF OPEN SEA. LWRAD3A.704
DO L=1, N_PROFILE LWRAD3A.705
IF (LAND(L)) THEN LWRAD3A.706
LWSEA(L)=0.0 LWRAD3A.707
ELSE IF (ICE_FRACTION(L).LT.TOL_TEST) THEN LWRAD3A.708
LWSEA(L)=LWOUT(L, 1) LWRAD3A.709
LWOUT(L, 1)=0.0 LWRAD3A.710
ELSE LWRAD3A.711
! LWSEA MUST BE SCALED BY THE FRACTION OF OPEN SEA FOR ADB1F401.576
! CONSISTENCY WITH UPPER LEVELS IN THE MODEL. ADB1F401.577
LWSEA(L)=(1.0E+00-ICE_FRACTION(L))*LWSEA(L) ADB1F401.578
LWOUT(L, 1)=LWOUT(L, 1)-LWSEA(L) LWRAD3A.714
ENDIF LWRAD3A.715
ENDDO LWRAD3A.716
! LWRAD3A.717
! LWRAD3A.718
! LWRAD3A.719
RETURN LWRAD3A.720
END LWRAD3A.721
!+ Subroutine to set surface fields. LWRAD3A.722
! LWRAD3A.723
! Purpose: LWRAD3A.724
! The albedos and emissivity of the surface are set. LWRAD3A.725
! LWRAD3A.726
! Method: LWRAD3A.727
! Straightforward. LWRAD3A.728
! LWRAD3A.729
! Current Owner of Code: J. M. Edwards LWRAD3A.730
! LWRAD3A.731
! History: LWRAD3A.732
! Version Date Comment LWRAD3A.733
! 4.0 27-07-95 Original Code LWRAD3A.734
! (J. M. Edwards) LWRAD3A.735
! LWRAD3A.736
! Description of Code: LWRAD3A.737
! FORTRAN 77 with extensions listed in documentation. LWRAD3A.738
! LWRAD3A.739
!- --------------------------------------------------------------------- LWRAD3A.740
SUBROUTINE R2_SET_SURFACE_FIELD_LW( 1LWRAD3A.741
& N_PROFILE, N_BAND LWRAD3A.742
& , I_SURFACE, I_SPEC_SURFACE, L_SURFACE LWRAD3A.743
& , EMISSIVITY_FIELD, ALBEDO_FIELD_DIR, ALBEDO_FIELD_DIFF LWRAD3A.744
& , ALBEDO_SEA_DIFF, ALBEDO_SEA_DIR LWRAD3A.745
& , N_FRAC_ICE_POINT, I_FRAC_ICE_POINT, ICE_FRACTION ADB1F401.579
& , NPD_PROFILE, NPD_BAND_LW, NPD_SURFACE_LW ADB2F404.813
& ) LWRAD3A.747
! LWRAD3A.748
! LWRAD3A.749
! LWRAD3A.750
IMPLICIT NONE LWRAD3A.751
! LWRAD3A.752
! LWRAD3A.753
! COMDECKS INCLUDED LWRAD3A.754
*CALL SRFSP3A LWRAD3A.755
*CALL PRMCH3A ADB1F401.580
*CALL PRECSN3A ADB1F401.581
! LWRAD3A.756
! DUMMY VARIABLES: LWRAD3A.757
! LWRAD3A.758
! DIMENSIONS OF ARRAYS: LWRAD3A.759
INTEGER !, INTENT(IN) LWRAD3A.760
& NPD_PROFILE LWRAD3A.761
! MAXIMUM NUMBER OF ATMOSPHERIC PROFILES LWRAD3A.762
& , NPD_BAND_LW ADB2F404.814
! MAXIMUM NUMBER OF SPECTRAL BANDS LWRAD3A.764
& , NPD_SURFACE_LW ADB2F404.815
! MAXIMUM NUMBER OF SURFACES LWRAD3A.766
! LWRAD3A.767
! ACTUAL SIZES USED: LWRAD3A.768
INTEGER !, INTENT(IN) LWRAD3A.769
& N_PROFILE LWRAD3A.770
! NUMBER OF ATMOSPHERIC PROFILES LWRAD3A.771
& , N_BAND LWRAD3A.772
! NUMBER OF SPECTRAL BANDS LWRAD3A.773
! LWRAD3A.774
! PROPERTIES OF SURFACES LWRAD3A.775
INTEGER !, INTENT(OUT) LWRAD3A.776
& I_SURFACE(NPD_PROFILE) LWRAD3A.777
! TYPES OF SURFACES LWRAD3A.778
& , I_SPEC_SURFACE(NPD_SURFACE_LW) ADB2F404.816
LOGICAL !, INTENT(OUT) LWRAD3A.780
& L_SURFACE(NPD_SURFACE_LW) ADB2F404.817
! FLAGS FOR TYPES OF SURFACES LWRAD3A.782
! LWRAD3A.783
! SURFACE PROPERTIES SET. LWRAD3A.784
REAL !, INTENT(OUT) LWRAD3A.785
& EMISSIVITY_FIELD(NPD_PROFILE, NPD_BAND_LW) ADB2F404.818
! EMISSIVITIES OF SURFACES LWRAD3A.787
& , ALBEDO_FIELD_DIFF(NPD_PROFILE, NPD_BAND_LW) ADB2F404.819
! DIFFUSE ALBEDO OF SURFACE LWRAD3A.789
& , ALBEDO_FIELD_DIR(NPD_PROFILE, NPD_BAND_LW) ADB2F404.820
! DIRECT ALBEDO OF SURFACE LWRAD3A.791
& , ALBEDO_SEA_DIFF(NPD_PROFILE, NPD_BAND_LW) ADB2F404.821
! DIFFUSE ALBEDO OF OPEN SEA LWRAD3A.793
& , ALBEDO_SEA_DIR(NPD_PROFILE, NPD_BAND_LW) ADB2F404.822
! DIRECT ALBEDO OF OPEN SEA LWRAD3A.795
! LWRAD3A.796
! VARIABLES CONCERNED WITH FRACTIONAL SEA ICE ADB1F401.582
REAL !, INTENT(IN) ADB1F401.583
& ICE_FRACTION(NPD_PROFILE) ADB1F401.584
! ADB1F401.585
INTEGER !, INTENT(OUT) ADB1F401.586
& N_FRAC_ICE_POINT ADB1F401.587
! NUMBER OF POINTS WITH FRACTIONAL ICE COVER ADB1F401.588
& , I_FRAC_ICE_POINT(NPD_PROFILE) ADB1F401.589
! INDICES OF POINTS WITH FRACTIONAL ICE COVER ADB1F401.590
! ADB1F401.591
! LWRAD3A.797
! LOCAL VARIABLES. LWRAD3A.798
INTEGER LWRAD3A.799
& I LWRAD3A.800
! LOOP VARIABLE LWRAD3A.801
& , L LWRAD3A.802
! LOOP VARIABLE LWRAD3A.803
REAL ADB1F401.592
& SEARCH_ARRAY(NPD_PROFILE) ADB1F401.593
! ARRAY FOR SEARCHING ADB1F401.594
& , TARGET ADB1F401.595
! TARGET TO SEARCH FOR ADB1F401.596
! LWRAD3A.804
! LWRAD3A.805
! LWRAD3A.806
! OVERRIDE ANY SURFACE PROERTIES READ IN FROM THE SPECTRAL FILE. LWRAD3A.807
DO L=1, N_PROFILE LWRAD3A.808
I_SURFACE(L)=1 LWRAD3A.809
ENDDO LWRAD3A.810
L_SURFACE(1)=.TRUE. LWRAD3A.811
I_SPEC_SURFACE(1)=IP_SURFACE_INTERNAL LWRAD3A.812
! LWRAD3A.813
! SET THE EMISSIVITY FIELD. LWRAD3A.814
DO I=1, N_BAND LWRAD3A.815
DO L=1, N_PROFILE LWRAD3A.816
EMISSIVITY_FIELD(L, I)=1.0E+00 LWRAD3A.817
ENDDO LWRAD3A.818
ENDDO LWRAD3A.819
! LWRAD3A.820
! ZERO THE SURFACE ALBEDOS. LWRAD3A.821
DO I=1, N_BAND LWRAD3A.822
DO L=1, N_PROFILE LWRAD3A.823
ALBEDO_FIELD_DIFF(L, I)=0.0E+00 LWRAD3A.824
ALBEDO_FIELD_DIR(L, I)=0.0E+00 LWRAD3A.825
ALBEDO_SEA_DIFF(L, I)=0.0E+00 LWRAD3A.826
ALBEDO_SEA_DIR(L, I)=0.0E+00 LWRAD3A.827
ENDDO LWRAD3A.828
ENDDO LWRAD3A.829
! ADB1F401.597
! SET THE FRACTIONAL ICE COVERAGE. POINTS ARE REQUIRED WHERE ADB1F401.598
! THE ICE FRACTION IS NEITHER 0 NOR 1. ADB1F401.599
DO L=1, N_PROFILE ADB1F401.600
SEARCH_ARRAY(L)=ICE_FRACTION(L)*(1.0E+00-ICE_FRACTION(L)) ADB1F401.601
ENDDO ADB1F401.602
TARGET=TOL_TEST ADB1F401.603
! GSS2F402.245
N_FRAC_ICE_POINT=0 GSS2F402.246
DO L =1,N_PROFILE GSS2F402.247
IF (SEARCH_ARRAY(L).GT.TARGET) THEN GSS2F402.248
N_FRAC_ICE_POINT =N_FRAC_ICE_POINT+1 GSS2F402.249
I_FRAC_ICE_POINT(N_FRAC_ICE_POINT)=L GSS2F402.250
END IF GSS2F402.251
END DO GSS2F402.252
! LWRAD3A.830
! LWRAD3A.831
! LWRAD3A.832
RETURN LWRAD3A.833
END LWRAD3A.834
*ENDIF DEF,A02_3A LWRAD3A.835