Subroutine PHYSICS( 2,54S_PHYSCS.41
! IN leading dimensions of arrays S_PHYSCS.42
& points, n_cca_lev, nlevs, nwet, nclds, nozone S_PHYSCS.43
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_PHYSCS.44
& ,sulp_dim1, sulp_dim2, ntra, trlev, sal_dim S_PHYSCS.45
& ,nprimvars, sec_day S_PHYSCS.46
! IN S_PHYSCS.47
& ,stepcount, daycount, time_string, year, day, yearno S_PHYSCS.48
& ,daynumber ,local_time, lcal360, ltimer S_PHYSCS.49
& ,lat, long, soil_type, veg_type, layer_depth S_PHYSCS.50
& ,sil_orog_land, ho2r2_orog, z0_orog_land S_PHYSCS.51
& ,di,ice_fract,u_0,v_0 S_PHYSCS.52
& ,time_init, obs, geoforce, ug, vg, f_coriolis S_PHYSCS.53
& ,conv_mode,ppn_mode,lw_mode,sw_mode,bl_mode,hyd_mode,l_rmbl S_PHYSCS.54
& ,l_lspice, l_lspice_bdy, l_bl_lspice, l_mom S_PHYSCS.55
& ,l_mixlen, l_z0_orog S_PHYSCS.56
& ,l_climate_aerosol, l_3d_cca S_PHYSCS.57
& ,l_use_sulpc_direct, l_use_sulpc_indirect, l_sulpc_so2 S_PHYSCS.58
& ,l_sulpc_nh3 S_PHYSCS.59
& ,l_soot, l_use_soot_direct, l_co2_interactive S_PHYSCS.60
& ,l_up_flux_trop_sw, l_down_flux_trop_lw S_PHYSCS.61
& ,l_net_flux_trop_sw, l_net_flux_trop_lw S_PHYSCS.62
& ,l_xscomp, l_sdxs S_PHYSCS.63
& ,flg_up_flx, flg_dwn_flx, flg_entr_up, flg_entr_dwn S_PHYSCS.64
& ,flg_detr_up, flg_detr_dwn, l_ccw S_PHYSCS.65
& ,l_cloud_deep, l_phase_lim, l_murk S_PHYSCS.66
& ,l_tracer, l_cape, l_snow_albedo, l_radheat ,l_ssice_albedo S_PHYSCS.67
& ,sfme, simlt, smlt, slh, sq1p5, st1p5, su10, sv10 S_PHYSCS.68
& ,stf_hf_snow_melt, stf_sub_surf_roff, stf_snomlt_sub_htf S_PHYSCS.69
C Microphysical Flag S_PHYSCS.70
& ,l_microphysics S_PHYSCS.71
& ,test, radcloud_fixed, noforce, land_mask, timestep S_PHYSCS.72
& ,prindump_obs, nout_obs, ntrad, ntrad1, start_diagday S_PHYSCS.73
& ,subdat_step, subdat_step1, swlut, lwlut, exner S_PHYSCS.74
& ,ui, vi, icct_rad, iccb_rad, ccwpin, ccwpin_rad, cca_rad S_PHYSCS.75
& ,qcl_rad_box ,qcf_rad_box, layer_cloud_rad, tracer S_PHYSCS.76
& ,o3, co2start, co2end, co2rate, co2_3d S_PHYSCS.77
& ,o2mmr, n2ommr, ch4mmr, c11mmr, c12mmr S_PHYSCS.78
& ,cfc113mmr, hcfc22mmr, hfc125mmr, hfc134ammr S_PHYSCS.79
& ,alpham,alphac,alphab,dtice S_PHYSCS.80
& ,soot, rgrain S_PHYSCS.81
& ,mparwtr, anvil_factor, tower_factor, ud_factor S_PHYSCS.82
& ,rhcrit ! IN : Critical relative humidities S_PHYSCS.83
! IN : model levels. S_PHYSCS.84
& ,ak, bk ! Coefficients defining S_PHYSCS.85
! hybrid vertical coordinates S_PHYSCS.86
& ,akh,bkh ! AK,BK at lower level interfaces S_PHYSCS.87
! S_PHYSCS.88
& ,delta_ak, delta_bk, factor_rhokh, S_PHYSCS.89
*IF DEF,A01_3A,AND,DEF,A02_3A S_PHYSCS.90
C algorithmic options for S/LRAD3A. S_PHYSCS.91
*CALL SWCAVR3A 
S_PHYSCS.92
& , S_PHYSCS.93
*CALL LWCAVR3A S_PHYSCS.94
C INOUT S_PHYSCS.95
& , S_PHYSCS.96
*ENDIF S_PHYSCS.97
& u, v, t, q, pstar, smc, smcl, canopy, snodep, tstar, tsi S_PHYSCS.98
& ,sthu,sthf S_PHYSCS.99
& ,t_deep_soil, rh, cca, iccb, icct, layer_cloud, qcl, qcf, zh S_PHYSCS.100
& ,z0msea, theta, rhokh, dap1, dap2, dap3, dab1, dab2, dab3 S_PHYSCS.101
& ,so2 ,so4_ait,so4_acc ,so4_dis, aerosol, radheat_rate S_PHYSCS.102
C OUT S_PHYSCS.103
& ,up_flux, dwn_flux, entrain_up, detrain_up, entrain_dwn S_PHYSCS.104
& ,detrain_dwn S_PHYSCS.105
& ,dthbydt, dqbydt, conv_rain, conv_snow, ls_rain, ls_snow S_PHYSCS.106
& ,lsrain3d, lssnow3d S_PHYSCS.107
& ,lscav_so2,lscav_so4ait,lscav_so4acc,lscav_so4dis S_PHYSCS.108
& ,taux, tauy, fqw, ftl, can_evap, soil_evap S_PHYSCS.109
& ,surf_ht_flux, sea_ice_htf, subl_snow, latent_heat, sens_heat S_PHYSCS.110
& ,u10m, v10m, t1p5m, rib, q1p5m, fast_runoff S_PHYSCS.111
& ,sub_surf_roff, hf_snow_melt, snow_melt, throughfall, swout S_PHYSCS.112
& ,swsea, lwout, lwsea, net_rad, osdia, isdia, olr, csolrd S_PHYSCS.113
& ,csosdi, tca, snomlt_surf_htf, snomlt_sub_htf, sice_mlt_htf S_PHYSCS.114
C Extra diagnostics output for MOSES S_PHYSCS.115
& ,gs, leaf_ai, canopy_ht, etran, gpp, npp, resp_p S_PHYSCS.116
& ,photosynth_act_rad, S_PHYSCS.117
! Additional arguments for 7A boundary layer (MOSES II) S_PHYSCS.118
! IN S_PHYSCS.119
& l_phenol,l_triffid,l_neg_tstar, S_PHYSCS.120
& canht_ft,canopy_tile,catch_tile,cs,lai_ft, S_PHYSCS.121
& frac,snow_frac,rad_no_snow,rad_snow,tstar_snow,z0v_tile, S_PHYSCS.122
! INOUT S_PHYSCS.123
& tstar_tile, S_PHYSCS.124
& g_leaf_acc,npp_ft_acc,resp_w_ft_acc,resp_s_acc, S_PHYSCS.125
! OUT S_PHYSCS.126
& ecan_tile,esoil_tile,ftl_tile, S_PHYSCS.127
& g_leaf,gpp_ft,npp_ft,resp_p_ft,resp_s,resp_w_ft, S_PHYSCS.128
& rho_aresist_tile,aresist_tile,resist_b_tile, S_PHYSCS.129
& rib_tile,snow_surf_htf,soil_surf_htf, S_PHYSCS.130
& tile_index,tile_pts,tile_frac S_PHYSCS.131
& ) S_PHYSCS.132
Implicit none S_PHYSCS.133
C S_PHYSCS.134
C--------------------------------------------------------------------- S_PHYSCS.135
C Arguments S_PHYSCS.136
C--------------------------------------------------------------------- S_PHYSCS.137
C S_PHYSCS.138
Integer S_PHYSCS.139
& points ! IN leading dimension of SCM arrays. S_PHYSCS.140
& ,n_cca_lev ! IN No of levels for Convective S_PHYSCS.141
! Cloud Amount. S_PHYSCS.142
& ,nlevs ! IN no of levels. S_PHYSCS.143
& ,nwet ! IN no of model levels in which Q S_PHYSCS.144
! is set. S_PHYSCS.145
& ,nfor ! IN Number terms for observational S_PHYSCS.146
! forcing. S_PHYSCS.147
& ,nbl_levs ! IN Number of Boundary layer levels S_PHYSCS.148
& ,nsoilt_levs ! IN Number of soil temperature S_PHYSCS.149
! levels. S_PHYSCS.150
& ,nsoilm_levs ! IN Number of soil moisture levels S_PHYSCS.151
& ,ntrop ! IN Max number of levels in the S_PHYSCS.152
! troposphere S_PHYSCS.153
& ,sulp_dim1,sulp_dim2 ! IN Dimensions for Sulphate arrays S_PHYSCS.154
& ,ntra ! IN Number of tracer fields S_PHYSCS.155
& ,trlev ! IN Number of model levels on which S_PHYSCS.156
! tracers are included S_PHYSCS.157
& ,nprimvars ! IN minimum no. of S_PHYSCS.158
! variables required to restart S_PHYSCS.159
! from a dump and is equal to S_PHYSCS.160
& ,nclds ! IN No. of levels in which Q is set S_PHYSCS.161
& ,nozone ! IN Number of model levels in which S_PHYSCS.162
! ozone is set. S_PHYSCS.163
& ,sal_dim ! Dimensions of SAL_VIS and SAL_NIR S_PHYSCS.164
! for prognostic snow albedo S_PHYSCS.165
S_PHYSCS.166
Real S_PHYSCS.167
& sec_day ! IN S_PHYSCS.168
& ,mparwtr ! IN Reservoir of convective cloud S_PHYSCS.169
! water left in a layer after S_PHYSCS.170
! conv. precip. S_PHYSCS.171
& ,anvil_factor ! IN Needed for calculation of cloud S_PHYSCS.172
& ,tower_factor ! amount on model levels S_PHYSCS.173
! if L_3D_CCA = .T. S_PHYSCS.174
& ,ud_factor ! IN factor used in calculation of S_PHYSCS.175
! ccwp for radiation if l_ccw is S_PHYSCS.176
! true. S_PHYSCS.177
& ,rhcrit(nwet) ! IN Critical humidity for cloud S_PHYSCS.178
! formation. S_PHYSCS.179
& ,ak(nlevs),BK(nlevs) ! IN Coefficients defining S_PHYSCS.180
! hybrid vertical coordinates S_PHYSCS.181
& ,akh(nlevs+1) ! IN AK,BK at lower level S_PHYSCS.182
& ,bkh(nlevs+1) ! interfaces S_PHYSCS.183
& ,delta_ak(nlevs) ! IN Half level differences S_PHYSCS.184
& ,delta_bk(nlevs) ! S_PHYSCS.185
& ,o3(nlevs) !\ S_PHYSCS.186
& ,co2start ! | IN Values of Ozone and CO2 S_PHYSCS.187
& ,co2end ! | S_PHYSCS.188
& ,co2rate !/ S_PHYSCS.189
& ,co2_3d(points,nlevs) ! IN 3D CO2 mass mixing ratio S_PHYSCS.190
C Mass Mixing Ratios of minor Gases N2O,CH4,CFC11, CFC12 S_PHYSCS.191
C CFC113, HCFC22, HFC125, and HFC134A S_PHYSCS.192
C for 1A and 1C radiation (& 3A) : S_PHYSCS.193
& ,o2mmr ! IN O2 Mass Mixing Ratio (mmr) S_PHYSCS.194
& ,n2ommr ! IN N2O mmr S_PHYSCS.195
& ,ch4mmr ! IN CH4 mmr S_PHYSCS.196
& ,c11mmr ! IN CFC11 mmr S_PHYSCS.197
& ,c12mmr ! IN CFC12 mmr S_PHYSCS.198
& ,cfc113mmr ! IN CFC113 mmr S_PHYSCS.199
& ,hcfc22mmr ! IN HCFC22 mmr S_PHYSCS.200
& ,hfc125mmr ! IN HFC125 mmr S_PHYSCS.201
& ,hfc134ammr ! IN HFC134 mmr S_PHYSCS.202
& ,soot(points) ! IN Snow soot content (mass fraction) S_PHYSCS.203
& ,rgrain(points) ! INOUT Snow grain size (microns) S_PHYSCS.204
C Constants used to determine the albedo of sea-ice: S_PHYSCS.205
C Albedo of sea-ice at melting point (TM) if .not.l_ssice_albedo, or S_PHYSCS.206
C Albedo of snow on sea-ice at melting point (TM) if l_ssice_albedo S_PHYSCS.207
& ,alpham ! "M" for "melting" S_PHYSCS.208
C Albedo of sea-ice at and below TM-DTICE if .not.l_ssice_albedo, or S_PHYSCS.209
C Albedo of snow on sea-ice at and below TM-DTICE if l_ssice_albedo S_PHYSCS.210
& ,alphac ! "C" for "cold" S_PHYSCS.211
C Albedo of snow-free sea-ice if l_ssice_albedo S_PHYSCS.212
& ,alphab ! "B" for "bare" S_PHYSCS.213
C Temperature range in which albedo of sea-ice, if .not.l_ssice_albedo S_PHYSCS.214
C or of snow on sea-ice, if l_ssice_albedo, varies between its limits S_PHYSCS.215
& ,dtice S_PHYSCS.216
S_PHYSCS.217
C S_PHYSCS.218
C Input COMDECKS S_PHYSCS.219
C S_PHYSCS.220
C SCM specific : S_PHYSCS.221
*CALL S_VEGPRM ! Vegetation parameters for land S_PHYSCS.222
! surface scheme. S_PHYSCS.223
*CALL S_SOILPR ! Parameters for land surface scheme S_PHYSCS.224
C others : S_PHYSCS.225
*CALL C_PI ! Pi and conversion factors S_PHYSCS.226
*CALL C_G ! g acceleration due to gravity S_PHYSCS.227
! degrees to radians & vice versa S_PHYSCS.228
*CALL C_LHEAT ! Latent heat of condensation S_PHYSCS.229
! and fusion S_PHYSCS.230
*CALL C_R_CP ! Includes gas constant, S_PHYSCS.231
! specific heat and Kappa S_PHYSCS.232
*CALL C_MDI ! Missing Data indicator S_PHYSCS.233
*CALL CSIGMA ! Stefan-Boltzmann constant S_PHYSCS.234
*CALL CMAXSIZE S_PHYSCS.235
*CALL CCONSTS ! LW nad SW TABLES S_PHYSCS.236
*CALL C_SOILH ! Soil parameters S_PHYSCS.237
*CALL SWSC ! Solar constant to calc. incoming S_PHYSCS.238
! solar radiation at top of S_PHYSCS.239
! atmosphere after SWRAD S_PHYSCS.240
S_PHYSCS.241
C Common blocks of algorithmic options for 3A-radiation. S_PHYSCS.242
*IF DEF,A01_3A,AND,DEF,A02_3A S_PHYSCS.243
*CALL MXSIZE3A ! Set max sizes for E-S radiation. S_PHYSCS.244
*CALL SWSPDL3A ! Allocate space for spectrum. S_PHYSCS.245
*CALL LWSPDL3A ! Allocate space for spectrum. S_PHYSCS.246
*CALL SWSPCM3A ! Put spectrum into a common. S_PHYSCS.247
*CALL LWSPCM3A S_PHYSCS.248
*CALL SWOPT3A ! Edwards-Slingo SW radiation options S_PHYSCS.249
*CALL LWOPT3A ! Edwards-Slingo LW radiation options S_PHYSCS.250
*ENDIF S_PHYSCS.251
*CALL SWNBANDS ! No. of spectral bands in the S_PHYSCS.252
! shortwave S_PHYSCS.253
S_PHYSCS.254
S_PHYSCS.255
S_PHYSCS.256
S_PHYSCS.257
S_PHYSCS.258
! here is what is written about the l_global_cloud_top flag in S_PHYSCS.259
! RAD_CTL; therefore in the case of the scm, it is set to false: S_PHYSCS.260
! To obtain reproducible results independent of the S_PHYSCS.261
! decomposition of the domain used on an MPP machine a global S_PHYSCS.262
! value for the topmost cloudy layer is used. The two polar S_PHYSCS.263
! rows are not searched. The use of a hardwired flag means S_PHYSCS.264
! that the original faster code can be restored by setting S_PHYSCS.265
! l_global_cloud_top to .false. as a modification: the results S_PHYSCS.266
! will then not be independent of the number of segments or S_PHYSCS.267
! the configuration of processors used. This is required if S_PHYSCS.268
! option 3A for the radiation is used in either section. S_PHYSCS.269
Logical l_global_cloud_top S_PHYSCS.270
Data l_global_cloud_top /.false./ S_PHYSCS.271
C l_global_cloud_top is false: any value for global_cloud_top S_PHYSCS.272
C will do. I choose 1. S_PHYSCS.273
Integer global_cloud_top S_PHYSCS.274
Data global_cloud_top /1/ S_PHYSCS.275
S_PHYSCS.276
C S_PHYSCS.277
C--------------------------------------------------------------------- S_PHYSCS.278
C Loop Counters and limits S_PHYSCS.279
C--------------------------------------------------------------------- S_PHYSCS.280
C S_PHYSCS.281
Integer S_PHYSCS.282
& daycount ! IN Counts through days S_PHYSCS.283
& ,i,j,k ! LOC General loop counters S_PHYSCS.284
! array dumpmean S_PHYSCS.285
& ,stepcount ! IN Counts through timesteps S_PHYSCS.286
& ,npdwd_cl_profile ! LOC Number of profiles allowed in S_PHYSCS.287
! workspace for cloud diagnostics S_PHYSCS.288
C S_PHYSCS.289
C--------------------------------------------------------------------- S_PHYSCS.290
C Namelists S_PHYSCS.291
C--------------------------------------------------------------------- S_PHYSCS.292
C S_PHYSCS.293
Integer S_PHYSCS.294
& soil_type(points) ! IN Soil type code 1 to 4 S_PHYSCS.295
& ,veg_type(points) ! IN Vegetation type code S_PHYSCS.296
& ,nout_obs ! IN Unit for output of observational S_PHYSCS.297
! diagnostics S_PHYSCS.298
& ,ntrad ! No. of timesteps between calls to S_PHYSCS.299
! radiation S_PHYSCS.300
& ,ntrad1 ! 1st timestep on which radiation S_PHYSCS.301
! called S_PHYSCS.302
& ,start_diagday ! Day in run for diagnostics S_PHYSCS.303
! (including subtimestep) to start S_PHYSCS.304
& ,subdat_step ! No. of timesteps between production S_PHYSCS.305
! of detailed printed output S_PHYSCS.306
& ,subdat_step1 ! Initial timestep for production of S_PHYSCS.307
! detailed printed output S_PHYSCS.308
Real S_PHYSCS.309
& lat(points) ! IN Lat. of gridpoint chosen read S_PHYSCS.310
! automatically from Climate Dataset S_PHYSCS.311
! if STATS forcing chosen S_PHYSCS.312
& ,long(points) ! IN Long. of gridpoint chosen read S_PHYSCS.313
! automatically from climate Dataset S_PHYSCS.314
! if STATS forcing chosen S_PHYSCS.315
& ,timestep ! IN Model timestep for all physics S_PHYSCS.316
! subroutines except radiation S_PHYSCS.317
& ,time_init ! Initial time in seconds S_PHYSCS.318
Logical S_PHYSCS.319
& land_mask(points) ! T for a land point S_PHYSCS.320
& ,l_rmbl ! IN T to use rapidly mixing boundary S_PHYSCS.321
! scheme in IMPL_CAL S_PHYSCS.322
& ,l_climate_aerosol ! IN New switches for E-S radiation. S_PHYSCS.323
& ,l_cloud_water_partition ! Dummy variable = l_lspice S_PHYSCS.324
& ,l_use_sulpc_direct ! IN S_PHYSCS.325
& ,l_use_sulpc_indirect ! IN S_PHYSCS.326
& ,l_sulpc_so2 ! IN Sulphur Cycle on, tracers to be S_PHYSCS.327
! scavenged S_PHYSCS.328
& ,l_sulpc_nh3 ! IN indicates if NH3 present S_PHYSCS.329
& ,l_soot ! IN Soot included S_PHYSCS.330
& ,l_use_soot_direct ! IN Use direct rad. effect of soot S_PHYSCS.331
! aerosol S_PHYSCS.332
& ,l_co2_interactive ! IN Carbon cycle controls use of 3D S_PHYSCS.333
! co2 field S_PHYSCS.334
& ,l_microphysics ! IN Microphysical Flag S_PHYSCS.335
& ,l_lspice ! IN New cloud/precip microphysics S_PHYSCS.336
& ,l_lspice_bdy ! IN QCF present in lateral S_PHYSCS.337
! boundaries S_PHYSCS.338
& ,l_bl_lspice ! IN S_PHYSCS.339
! TRUE Use scientific treatment of S_PHYSCS.340
! mixed phase precip scheme. S_PHYSCS.341
! FALSE Do not use mixed phase S_PHYSCS.342
! precip considerations S_PHYSCS.343
& ,l_mom ! IN Switch for convective momentum S_PHYSCS.344
! transport. S_PHYSCS.345
& ,l_phenol ! IN Indicates whether phenology in S_PHYSCS.346
! use S_PHYSCS.347
& ,l_triffid ! IN Indicates whether TRIFFID in use. S_PHYSCS.348
& ,l_neg_tstar ! IN Switch for -ve TSTAR error check S_PHYSCS.349
& ,l_xscomp ! IN Switch for allowing compensating S_PHYSCS.350
! cooling and drying of the S_PHYSCS.351
! environment in initiating layer S_PHYSCS.352
& ,l_sdxs ! IN Switch for allowing parcel S_PHYSCS.353
! excess to be set to s.d. of S_PHYSCS.354
! turbulent fluctuations in lowest S_PHYSCS.355
! model layer S_PHYSCS.356
& ,flg_up_flx ! IN Flag for updraught mass flux S_PHYSCS.357
& ,flg_dwn_flx ! IN Flag for downdraght mass flux S_PHYSCS.358
& ,flg_entr_up ! IN Flag for updraught entrainment S_PHYSCS.359
& ,flg_entr_dwn ! IN Flag for downdraught entrainmn S_PHYSCS.360
& ,flg_detr_up ! IN Flag for updraught detrainment S_PHYSCS.361
& ,flg_detr_dwn ! IN Flag for downdraught detrainment S_PHYSCS.362
& ,l_3d_cca ! IN Switch for use of 3d cloud S_PHYSCS.363
! amount S_PHYSCS.364
& ,l_ccw ! IN If .true. then precip not inc. S_PHYSCS.365
! in conv. cloud water path. S_PHYSCS.366
& ,l_cloud_deep ! IN If true limits phase change of S_PHYSCS.367
! precip if lh will take temp to S_PHYSCS.368
! other side of tm. S_PHYSCS.369
& ,l_phase_lim ! IN Switch to determine if phase S_PHYSCS.370
! change of precip is limited to S_PHYSCS.371
! ensure lh does not take temp S_PHYSCS.372
! to other side of tm S_PHYSCS.373
& ,l_murk ! IN Aerosol needs scavenging. S_PHYSCS.374
& ,l_mixlen ! IN Switch for reducing the turbulent S_PHYSCS.375
! mixing length above the top of S_PHYSCS.376
! the boundary layer. S_PHYSCS.377
& ,l_z0_orog ! IN T to use simple orog.roughness S_PHYSCS.378
& ,l_tracer ! IN switch for inclusion of tracers S_PHYSCS.379
& ,l_cape ! IN switch for use of cape closure S_PHYSCS.380
& ,l_radheat ! IN True if RADHEAT_RATE to be S_PHYSCS.381
! calculated. S_PHYSCS.382
& ,local_time ! IN T if diagnostics required S_PHYSCS.383
! for local time rather than GMT S_PHYSCS.384
& ,geoforce ! IN T if geostrophic forcing. S_PHYSCS.385
& ,noforce ! IN T if no large-scale forcing S_PHYSCS.386
! is required S_PHYSCS.387
& ,obs ! IN T if observational forcing used S_PHYSCS.388
& ,prindump_obs ! IN T if observational diagnostics S_PHYSCS.389
! required S_PHYSCS.390
& ,radcloud_fixed ! IN T if cloud required fixed for S_PHYSCS.391
! radiation S_PHYSCS.392
& ,test ! IN T if detailed sub-timestep S_PHYSCS.393
! diagnostics required S_PHYSCS.394
& ,lcal360 ! IN choose 360 day calendar or not ; S_PHYSCS.395
& ,ltimer ! IN mesure elapsed time in UM S_PHYSCS.396
! routines S_PHYSCS.397
! logicals to flag diagnostics S_PHYSCS.398
! in BDY_LAYR and HYDROL :- S_PHYSCS.399
& ,l_snow_albedo ! IN Flag for prognostic snow S_PHYSCS.400
& ,l_ssice_albedo ! IN Flag on the effect of snow on S_PHYSCS.401
! sea-ice albedo. S_PHYSCS.402
& ,sfme ! IN Flag for FME (q.v.). S_PHYSCS.403
& ,simlt ! IN Flag for SICE_MLT_HTF (q.v.) S_PHYSCS.404
& ,smlt ! IN Flag for SICE_MLT_HTF (q.v.) S_PHYSCS.405
& ,slh ! IN Flag for LATENT_HEAT (q.v.) S_PHYSCS.406
& ,sq1p5 ! IN Flag for Q1P5M (q.v.) S_PHYSCS.407
& ,st1p5 ! IN Flag for T1P5M (q.v.) S_PHYSCS.408
& ,su10,sv10 ! IN Flag for U10M & V10M (q.v.) S_PHYSCS.409
& ,stf_hf_snow_melt ! IN Flag for snow melt heat flux S_PHYSCS.410
& ,stf_sub_surf_roff ! IN Flag for sub-surface runoff S_PHYSCS.411
& ,stf_snomlt_sub_htf S_PHYSCS.412
S_PHYSCS.413
C--------------------------------------------------------------------- S_PHYSCS.414
C &PHYSWITCH - switches to switch on/off individual physics S_PHYSCS.415
C routines S_PHYSCS.416
C 0 = Run normally S_PHYSCS.417
C 1 = Run for diagnostics but save dump state S_PHYSCS.418
C 2 = Don't run S_PHYSCS.419
C--------------------------------------------------------------------- S_PHYSCS.420
S_PHYSCS.421
Integer S_PHYSCS.422
& conv_mode ! IN Mode to run convection S_PHYSCS.423
& ,ppn_mode ! IN Mode to run precipitation S_PHYSCS.424
& ,lw_mode ! IN Mode to run longwave S_PHYSCS.425
& ,sw_mode ! IN Mode to run shortwave S_PHYSCS.426
& ,bl_mode ! IN Mode to run boundary layer S_PHYSCS.427
& ,hyd_mode ! IN Mode to run hydrology S_PHYSCS.428
C S_PHYSCS.429
C--------------------------------------------------------------------- S_PHYSCS.430
C Miscellaneous S_PHYSCS.431
C--------------------------------------------------------------------- S_PHYSCS.432
C S_PHYSCS.433
Real S_PHYSCS.434
& rh(points,nwet,2) ! OUT Diagnosed rh as seen by moist S_PHYSCS.435
! physics. S_PHYSCS.436
& ,f_coriolis(points) ! IN 2*omega*sin(latitude) S_PHYSCS.437
& ,qst ! LOC Workspace used to calculate rh S_PHYSCS.438
& ,prh ! LOC Workspace used to calculate rh S_PHYSCS.439
& ,savedump(points,nprimvars) ! LOC Workspace for saving dump S_PHYSCS.440
C S_PHYSCS.441
Integer S_PHYSCS.442
& error ! LOC Error indicator for lsppn, S_PHYSCS.443
! bdy_layr,lscld S_PHYSCS.444
& ,day ! IN day in year S_PHYSCS.445
& ,yearno ! IN year in run S_PHYSCS.446
C S_PHYSCS.447
C S_PHYSCS.448
Character*8 S_PHYSCS.449
& time_string ! IN string containing actual time of S_PHYSCS.450
! day S_PHYSCS.451
c S_PHYSCS.452
C Arguments of PHYSICS subroutines S_PHYSCS.453
C===================================================================== S_PHYSCS.454
C S_PHYSCS.455
C S_PHYSCS.456
C--------------------------------------------------------------------- S_PHYSCS.457
C Primary Model Variables plus T (UMDP No1) S_PHYSCS.458
C--------------------------------------------------------------------- S_PHYSCS.459
C S_PHYSCS.460
Integer S_PHYSCS.461
& iccb(points) ! Convective cloud base and top S_PHYSCS.462
& ,icct(points) ! at levels 1 to nlevs S_PHYSCS.463
S_PHYSCS.464
Real S_PHYSCS.465
& canopy(points) ! Canopy water (Kg m^-2) S_PHYSCS.466
& ,cca(points,n_cca_lev) ! Convective cloud amount S_PHYSCS.467
& ,pstar(points) ! Pressure at earth's surface S_PHYSCS.468
! (pa not hPa) S_PHYSCS.469
& ,q(points,nwet) ! Specific humidity (Kg Kg^-1) S_PHYSCS.470
& ,qcf(points,nwet) ! Cloud ice content (Kg Kg^-1) S_PHYSCS.471
& ,qcl(points,nwet) ! Cloud water content(Kg Kg^-1) S_PHYSCS.472
& ,smc(points) ! Soil moisture content(Kg m^-2) S_PHYSCS.473
& ,smcl(points,nsoilm_levs) ! Soil moisture in layers - S_PHYSCS.474
! multilayer hydrology S_PHYSCS.475
& ,sthf(points,nsoilm_levs) ! INOUT Frozen soil moisture S_PHYSCS.476
! content of each layer as a S_PHYSCS.477
! fraction of saturation. S_PHYSCS.478
& ,sthu(points,nsoilm_levs) ! INOUT Unfrozen soil moisture S_PHYSCS.479
! content of each layer as a S_PHYSCS.480
! fraction of saturation. S_PHYSCS.481
! (Kg m^-2) S_PHYSCS.482
& ,snodep(points) ! Snow depth (Kg m^-2) S_PHYSCS.483
& ,t(points,nlevs) ! Temperature(K) S_PHYSCS.484
& ,t_deep_soil(points,nsoilt_levs) ! Deep soil temperatures (K) S_PHYSCS.485
! top level not included,=surface S_PHYSCS.486
& ,theta(points,nlevs) ! Potential temperature (K) S_PHYSCS.487
& ,tsi(points) ! INOUT Sea-ice surface layer S_PHYSCS.488
! temperature (K) S_PHYSCS.489
& ,tstar(points) ! INOUT Surface temperature (K) S_PHYSCS.490
& ,tstar_rad(points) ! LOC Effective surface radiative S_PHYSCS.491
! temperature (K) (MOSES ii) S_PHYSCS.492
& ,u(points,nlevs) ! Zonal wind (m s^-1) S_PHYSCS.493
& ,v(points,nlevs) ! Meridional wind (m s^-1) S_PHYSCS.494
& ,z0msea(points) ! Sea surface roughness length S_PHYSCS.495
& ,zh(points) ! Height above surface of top S_PHYSCS.496
! of boundary layer (m) S_PHYSCS.497
*IF DEF,A08_1A S_PHYSCS.498
C Standard scheme Global soil parameters S_PHYSCS.499
C layer_depth - soil layer depth as a multiple of layer 1 depth S_PHYSCS.500
& ,layer_depth(nsoilt_levs+1) ! soil layer depth ratios S_PHYSCS.501
*ELSEIF DEF,A08_5A S_PHYSCS.502
C Global soil parameters for MOSES formulation S_PHYSCS.503
C This is not used except as local workspace in RUN_INIT S_PHYSCS.504
& ,layer_depth(nsoilt_levs) ! soil layer depth ratios S_PHYSCS.505
*ENDIF S_PHYSCS.506
& ,sil_orog_land(points) ! Silhouette area of unresolved S_PHYSCS.507
! orography per unit horizontal S_PHYSCS.508
! area on land points only. S_PHYSCS.509
& ,ho2r2_orog(points) ! Standard Deviation of orography S_PHYSCS.510
! equivalent to peak to trough S_PHYSCS.511
! height of unresolved orography S_PHYSCS.512
! divided by 2SQRT(2) on land S_PHYSCS.513
! points only (m) S_PHYSCS.514
& ,z0_orog_land(points) ! Orographic roughness S_PHYSCS.515
! length (m) land pts only S_PHYSCS.516
& ,tracer(points,trlev,ntra) ! Model tracer fields (Kg Kg^-1) S_PHYSCS.517
& ,di(points) ! Equivalent thickness of sea-ice (m) S_PHYSCS.518
& ,ice_fract(points) ! Fraction of grid box covered by S_PHYSCS.519
! sea ice(decimal fraction) S_PHYSCS.520
& ,u_0(points) ! Westerly & easterly component of S_PHYSCS.521
& ,v_0(points) ! surface current (metres per second) S_PHYSCS.522
S_PHYSCS.523
C--------------------------------------------------------------------- S_PHYSCS.524
C Other variables input S_PHYSCS.525
C--------------------------------------------------------------------- S_PHYSCS.526
& ,ui(points,nlevs) ! Initial zonal and meridional S_PHYSCS.527
& ,vi(points,nlevs) ! wind comps. (m s^-1) S_PHYSCS.528
& ,ug(points) ! Geostrophic U velocity (m s^-1) S_PHYSCS.529
& ,vg(points) ! Geostrophic V velocity (m s^-1) S_PHYSCS.530
C--------------------------------------------------------------------- S_PHYSCS.531
C Astronomy S_PHYSCS.532
C--------------------------------------------------------------------- S_PHYSCS.533
C S_PHYSCS.534
Real S_PHYSCS.535
& cos_zenith_angle(points) ! Mean cos (solar zenith angle) S_PHYSCS.536
Real S_PHYSCS.537
& day_fraction(points) ! Sunlit day fraction of timestep S_PHYSCS.538
& ,scs ! Solar constant scaling factor S_PHYSCS.539
& ,sindec ! SIN (solar declination) S_PHYSCS.540
C S_PHYSCS.541
C--------------------------------------------------------------------- S_PHYSCS.542
C Boundary layer S_PHYSCS.543
C--------------------------------------------------------------------- S_PHYSCS.544
C S_PHYSCS.545
Real S_PHYSCS.546
& can_evap(points) ! Mean evaporation from S_PHYSCS.547
! canopy/surface store S_PHYSCS.548
! (Kg m^-2 s^-1). 0 over sea. S_PHYSCS.549
& ,bl_type_1(points) ! Indicator set to 1.0 if stable S_PHYSCS.550
! b.l. diagnosed, 0.0 otherwise. S_PHYSCS.551
& ,bl_type_2(points) ! Indicator set to 1.0 if Sc over S_PHYSCS.552
! stable surface layer diagnosed, S_PHYSCS.553
! 0.0 otherwise. S_PHYSCS.554
& ,bl_type_3(points) ! Indicator set to 1.0 if well S_PHYSCS.555
! mixed b.l. diagnosed, S_PHYSCS.556
! 0.0 otherwise. S_PHYSCS.557
& ,bl_type_4(points) ! Indicator set to 1.0 if S_PHYSCS.558
! decoupled Sc layer (not over S_PHYSCS.559
! cumulus) diagnosed, S_PHYSCS.560
! 0.0 otherwise. S_PHYSCS.561
& ,bl_type_5(points) ! Indicator set to 1.0 if S_PHYSCS.562
! decoupled Sc layer over cumulus S_PHYSCS.563
! diagnosed, 0.0 otherwise. S_PHYSCS.564
& ,bl_type_6(points) ! Indicator set to 1.0 if a S_PHYSCS.565
! cumulus capped b.l. diagnosed, S_PHYSCS.566
! 0.0 otherwise. S_PHYSCS.567
& ,cd(points) S_PHYSCS.568
& ,ch(points) ! Bulk transfer coeffs S_PHYSCS.569
& ,epot(points) ! Potential evaporation-rate S_PHYSCS.570
! (kg/m2/s). S_PHYSCS.571
& ,fsmc(points) ! Soil moisture availability. S_PHYSCS.572
& ,zht(points) ! Height below which there may be S_PHYSCS.573
! turbulent mixing (m). S_PHYSCS.574
& ,exner(points,nlevs+1) ! EXNER function for lower boundary S_PHYSCS.575
! of layer (K) S_PHYSCS.576
& ,e_sea(points) ! Evaporation from sea times leads S_PHYSCS.577
! fraction. Zero over land. S_PHYSCS.578
! (Kg m^-2 s^-1) S_PHYSCS.579
& ,fme(points) ! Wind mixing "power" (W m^-2). S_PHYSCS.580
& ,fqw(points,nbl_levs) ! Moisture flux between layers S_PHYSCS.581
! (Kg m^-2 s^-1) S_PHYSCS.582
! FQW(,1) is total water flux S_PHYSCS.583
! from surface, 'E'. S_PHYSCS.584
& ,ftl(points,nbl_levs) ! FTL(,K) contains net turbulent S_PHYSCS.585
! sensible heat flux into layer S_PHYSCS.586
! K from below; so FTL(,1) is the S_PHYSCS.587
! surface sensible heat, H.(W m^-2) S_PHYSCS.588
& ,h_sea(points) ! Surface sensible heat flux over S_PHYSCS.589
! sea times leads fraction (W m^-2) S_PHYSCS.590
& ,latent_heat(points) ! Surface latent heat flux, +ve S_PHYSCS.591
! upwards (W m^-2) S_PHYSCS.592
& ,q1_sd(points) ! Standard deviation of turbulent S_PHYSCS.593
! fluctuations of layer 1 S_PHYSCS.594
! humidity (Kg Kg^-1). S_PHYSCS.595
& ,q1p5m(points) ! Q at 1.5 m (Kg water per Kg air) S_PHYSCS.596
! S_PHYSCS.597
& ,rhokh(points,nbl_levs) ! Exchange coeffs for moisture. S_PHYSCS.598
! Surface:out of SF_EXCH contains S_PHYSCS.599
! contains only RHOKH. S_PHYSCS.600
! Above surface:out of KMKH cont- S_PHYSCS.601
! ains GAMMA(1)*RHOKH(,1)*RDZ(,1) S_PHYSCS.602
& ,rhokm(points,nbl_levs) ! Exchange coefficients for S_PHYSCS.603
! momentum (on UV-grid, with 1st S_PHYSCS.604
! and last rows undefined (or, at S_PHYSCS.605
! present, set to "missing Data") S_PHYSCS.606
! Surface:out of SF_EXCH contains S_PHYSCS.607
! GAMMA(1)*RHOKH,after IMPL_CAL S_PHYSCS.608
! contains only RHOKH. S_PHYSCS.609
! Above surface:out of KMKH cont S_PHYSCS.610
! ains GAMMA(1)*RHOKH(,1)*RDZ(,1) S_PHYSCS.611
& ,rho_cd_modv1(points) ! 4D VAR diagnostics for BDYLYR3A S_PHYSCS.612
& ,rho_km(points,2:nbl_levs) ! - not used in SCM S_PHYSCS.613
& ,rib(points) ! Bulk Richardson number for lowest S_PHYSCS.614
! layer. S_PHYSCS.615
& ,sea_ice_htf(points) ! Heat flux through sea-ice S_PHYSCS.616
! (w m^-2), +ve downwards). S_PHYSCS.617
& ,sens_heat(points) ! Sensible heat (W m^-2) =FTL(1) S_PHYSCS.618
& ,sice_mlt_htf (points) ! Sea ice top melt latent heat flux S_PHYSCS.619
! (w m^-2) S_PHYSCS.620
& ,snomlt_sub_htf(points) ! Subsurface Snow melt heat flux S_PHYSCS.621
! (Watts m^-2) S_PHYSCS.622
& ,snomlt_surf_htf(points) ! Heat flux required for surface S_PHYSCS.623
! melting of snow (W m^-2). S_PHYSCS.624
& ,soil_evap(points) ! Surface evapotranspiration through S_PHYSCS.625
! a resistance which is not entirely S_PHYSCS.626
! aerodynamic ie. 'soil evaporation'. S_PHYSCS.627
! Always +ve (Kg m^-2 s^-1) S_PHYSCS.628
& ,subl_snow(points) ! Sublimation from lying snow or S_PHYSCS.629
! sea-ice (Kg m^-2 s^-1) S_PHYSCS.630
& ,t1_sd(points) ! Standard deviation of turbulent S_PHYSCS.631
! fluctuations of layer 1 S_PHYSCS.632
! temperature (K). S_PHYSCS.633
& ,t1p5m(points) ! T at 1.5 m (K). S_PHYSCS.634
! gamma(1)*rhokh,after IMPL_CALC S_PHYSCS.635
& ,taux(points,nlevs) ! W'ly component of surface wind S_PHYSCS.636
! stress (N m^-2). On UV-grid; S_PHYSCS.637
! comments as per rhokm. S_PHYSCS.638
& ,tauy(points,nlevs) ! S'ly component of surface wind S_PHYSCS.639
! stress (N m^-2). On UV-grid; S_PHYSCS.640
! comments as per rhokm. S_PHYSCS.641
& ,u10m(points) ! U at 10 m (m s^-1). S_PHYSCS.642
& ,v10m(points) ! V at 10 m (m s^-1). S_PHYSCS.643
& ,vshr(points) ! Magnitude of surface-to-lowest S_PHYSCS.644
! atm level wind shear S_PHYSCS.645
& ,layer_cloud1p5m(points) ! layer cloud at 1.5 metres S_PHYSCS.646
& ,qcf1p5m(points) ! frozen layer cloud at 1.5 metres S_PHYSCS.647
& ,qcl1p5m(points) ! liquid layer cloud at 1.5 metres S_PHYSCS.648
& ,ak1p5m(1) ! value of ak at 1.5 metres S_PHYSCS.649
& ,bk1p5m(1) ! value of bk at 1.5 metres S_PHYSCS.650
S_PHYSCS.651
Data ak1p5m /0.0/ S_PHYSCS.652
Data bk1p5m /1.0/ S_PHYSCS.653
S_PHYSCS.654
Integer S_PHYSCS.655
& trindx(points) ! layer boundary of the tropopause S_PHYSCS.656
& ,nrml(points) ! Number of model layers in the S_PHYSCS.657
! Rapidly Mixing Layer; diagnosed S_PHYSCS.658
! in SF_EXCH & KMKH & BL_IC and used S_PHYSCS.659
! in IMPL_CAL, SF_EVAP and TR_MIX. S_PHYSCS.660
& ,land_index(points) ! land_index(i)=j => the Jth S_PHYSCS.661
! point in field is the Ith S_PHYSCS.662
! land point. S_PHYSCS.663
& ,land_pts ! Number of land points. S_PHYSCS.664
Logical S_PHYSCS.665
& gather ! T if gather to sea-ice points S_PHYSCS.666
! in SF_EXCH. Saves a lot of un- S_PHYSCS.667
! necessary calculations if there S_PHYSCS.668
! are relatively few sea-ice points S_PHYSCS.669
C S_PHYSCS.670
C--------------------------------------------------------------------- S_PHYSCS.671
C MOSES code local variables S_PHYSCS.672
C (most/all?) of which unused by MOSES II. S_PHYSCS.673
C--------------------------------------------------------------------- S_PHYSCS.674
*CALL NSTYPES S_PHYSCS.675
Integer S_PHYSCS.676
& lice_pts ! Number of land ice points. S_PHYSCS.677
& ,soil_pts ! Number of soil points. S_PHYSCS.678
& ,lice_index(points) ! Indices of land ice points on S_PHYSCS.679
! the land grid S_PHYSCS.680
& ,soil_index(points) ! Indices of soil points on the S_PHYSCS.681
Real S_PHYSCS.682
& canopy_ht(points) ! canopy height S_PHYSCS.683
& ,photosynth_act_rad(points) ! Downward shortwave radiation in S_PHYSCS.684
! band 1. Required for hydrology S_PHYSCS.685
! calculations in MOSES S_PHYSCS.686
& ,gs(points) ! Stomatal conductance S_PHYSCS.687
& ,etran(points) ! Transpiration (Kg m^-2 s^-1) S_PHYSCS.688
& ,gpp(points) ! Gross primary productivity S_PHYSCS.689
& ,gpp_ft(points,npft) ! Gross primary productivity S_PHYSCS.690
! on PFTs (kg C/m2/s). S_PHYSCS.691
& ,leaf_ai(points) ! Leaf area index S_PHYSCS.692
& ,npp(points) ! Net primary productivity S_PHYSCS.693
& ,resp_p(points) ! Plant respiration S_PHYSCS.694
! (Kg C m^-2 s^-1) S_PHYSCS.695
& ,resp_p_ft(points,npft) ! Plant respiration on PFTs S_PHYSCS.696
! (kg C/m2/s). S_PHYSCS.697
& ,surf_ht_flux(points) ! Net downward heat flux at surface S_PHYSCS.698
! over land or sea-ice fraction of S_PHYSCS.699
! gridbox (W m^-2) S_PHYSCS.700
& ,ext(points,nsoilt_levs) ! Extraction of water from each soil S_PHYSCS.701
! layer (Kg m^-2 s^-1) S_PHYSCS.702
S_PHYSCS.703
! Additional arguments for 7A boundary layer (MOSES II) S_PHYSCS.704
Integer S_PHYSCS.705
& tile_index(points,ntype) S_PHYSCS.706
! OUT Index of tile points. S_PHYSCS.707
& ,tile_pts(ntype) S_PHYSCS.708
! OUT Number of tile points. S_PHYSCS.709
Real S_PHYSCS.710
& tile_frac(points,ntype) S_PHYSCS.711
! OUT Tile fractions adjusted for S_PHYSCS.712
! snow. 1 to ntype-1: snow-free S_PHYSCS.713
! fraction. ntype:land-ice plus S_PHYSCS.714
! snow fraction. S_PHYSCS.715
& ,aresist_tile(points,ntype) S_PHYSCS.716
! OUT 1/(CD_STD*VSHR) on land tiles S_PHYSCS.717
& ,canht_ft(points,npft) S_PHYSCS.718
! IN Canopy height (m) S_PHYSCS.719
& ,canopy_tile(points,ntype-1) S_PHYSCS.720
! IN Surface/canopy water for S_PHYSCS.721
! snow-free land tiles (Kg.m^-2) S_PHYSCS.722
& ,catch_tile(points,ntype-1) S_PHYSCS.723
! IN Surface/canopy water capacity of S_PHYSCS.724
! snow-free land tiles (Kg.m^-2) S_PHYSCS.725
& ,cs(points) S_PHYSCS.726
! IN Soil carbon (Kg C . m^-2). S_PHYSCS.727
& ,ecan_tile(points,ntype-1) S_PHYSCS.728
! OUT ECAN for snow-free land tiles S_PHYSCS.729
& ,esoil_tile(points,ntype-1) S_PHYSCS.730
! OUT ES for snow-free land tiles S_PHYSCS.731
& ,frac(points,ntype) S_PHYSCS.732
! IN Tile fracs excluding snow cover S_PHYSCS.733
& ,ftl_tile(points,ntype) S_PHYSCS.734
! OUT Surface ftl for land tiles S_PHYSCS.735
& ,g_leaf(points,npft) S_PHYSCS.736
! OUT Leaf turnover rate (yr^-1). S_PHYSCS.737
& ,g_leaf_acc(points,npft) S_PHYSCS.738
! INOUT Accumulated g_leaf S_PHYSCS.739
& ,lai_ft(points,npft) S_PHYSCS.740
! IN Leaf area index S_PHYSCS.741
& ,npp_ft(points,npft) S_PHYSCS.742
! OUT Net primary productivity S_PHYSCS.743
! (Kg C . m^-2 . s^-1). S_PHYSCS.744
& ,npp_ft_acc(points,npft) S_PHYSCS.745
! INOUT Accumulated npp_ft S_PHYSCS.746
& ,rad_no_snow(points) S_PHYSCS.747
! OUT Surface net radiation, S_PHYSCS.748
! snow-free fraction of gridbox. S_PHYSCS.749
& ,rad_snow(points) S_PHYSCS.750
! OUT Surface net radiation, snow- S_PHYSCS.751
! covered fraction of gridbox. S_PHYSCS.752
& ,resist_b_tile(points,ntype) S_PHYSCS.753
! OUT (1/CH-1/CD_STD)/VSHR on S_PHYSCS.754
! land tiles S_PHYSCS.755
& ,resp_s(points) S_PHYSCS.756
! OUT Soil respiration S_PHYSCS.757
! (Kg C m^-2 s^-1). S_PHYSCS.758
& ,resp_s_acc(points) S_PHYSCS.759
! INOUT Accumulated RESP_S S_PHYSCS.760
& ,resp_w_ft(points,npft) S_PHYSCS.761
! OUT Wood maintenance respiration S_PHYSCS.762
! (Kg C m^-2 s^-1). S_PHYSCS.763
& ,resp_w_ft_acc(points,npft) S_PHYSCS.764
! INOUT Accumulated resp_w_ft S_PHYSCS.765
& ,rho_aresist_tile(points,ntype) S_PHYSCS.766
! OUT rhostar*cd_std*vshr on S_PHYSCS.767
! land tiles S_PHYSCS.768
& ,rib_tile(points,ntype) S_PHYSCS.769
! OUT RIB for land tiles. S_PHYSCS.770
& ,snow_frac(points) S_PHYSCS.771
! OUT Fraction of snow cover. S_PHYSCS.772
& ,snow_surf_htf(points) S_PHYSCS.773
! OUT Net downward heat flux at S_PHYSCS.774
! snow surface (W m^-2). S_PHYSCS.775
& ,soil_surf_htf(points) S_PHYSCS.776
! OUT Net downward heat flux at S_PHYSCS.777
! snow-free land surface (W m^-2). S_PHYSCS.778
& ,tstar_snow(points) S_PHYSCS.779
! OUT Snow surface layer temp. (K). S_PHYSCS.780
& ,tstar_tile(points,ntype) S_PHYSCS.781
! INOUT Surface tile temperature S_PHYSCS.782
& ,z0v_tile(points,ntype) S_PHYSCS.783
! IN Tile roughness lengths (m). S_PHYSCS.784
S_PHYSCS.785
C--------------------------------------------------------------------- S_PHYSCS.786
C Dummy variables used in Sulphur cycle S_PHYSCS.787
C--------------------------------------------------------------------- S_PHYSCS.788
Real S_PHYSCS.789
& rho_aresist(points) ! Dummy used for SCycle S_PHYSCS.790
& ,aresist(points) ! Dummy used for SCycle S_PHYSCS.791
& ,resist_b(points) ! Dummy used for SCycle S_PHYSCS.792
C New arrays for Sulphur cycle but SULPHUR cycle is switched off S_PHYSCS.793
C and no initialisation is done at present S_PHYSCS.794
C (see RAD_CTL1 when it is to be done properly). S_PHYSCS.795
& ,accum_sulphate (sulp_dim1,sulp_dim2) S_PHYSCS.796
& ,aitken_sulphate(sulp_dim1,sulp_dim2) ! Sulphate amounts S_PHYSCS.797
& ,diss_sulphate (sulp_dim1,sulp_dim2) ! Sulphate S_PHYSCS.798
C--------------------------------------------------------------------- S_PHYSCS.799
C Dummy variables used for soot aerosols. S_PHYSCS.800
C--------------------------------------------------------------------- S_PHYSCS.801
& ,fresh_soot(points,nlevs) S_PHYSCS.802
& ,aged_soot(points,nlevs) ! soot mixing ratios S_PHYSCS.803
C S_PHYSCS.804
C--------------------------------------------------------------------- S_PHYSCS.805
C Dummy sulphur cycle declarations for large scale precip. S_PHYSCS.806
C--------------------------------------------------------------------- S_PHYSCS.807
C Sulphur cycle : not implemented (yet) in the SCM and must be S_PHYSCS.808
C switched off, but arguments for GLUE_LSPP must be declared. S_PHYSCS.809
Real S_PHYSCS.810
& so2(points,nwet) ! INOUT S_PHYSCS.811
& ,nh3(points,nwet) ! INOUT Sulphur Cycle tracers for S_PHYSCS.812
& ,so4_ait(points,nwet) ! INOUT wet scavenging. S_PHYSCS.813
& ,so4_acc(points,nwet) ! INOUT S_PHYSCS.814
& ,so4_dis(points,nwet) ! INOUT S_PHYSCS.815
& ,lscav_so2(points) ! OUT S_PHYSCS.816
& ,lscav_nh3(points) ! OUT Column totals of scavenged S_PHYSCS.817
& ,lscav_so4ait(points) ! OUT S Cycle tracers. S_PHYSCS.818
& ,lscav_so4acc(points) ! OUT S_PHYSCS.819
& ,lscav_so4dis(points) ! OUT S_PHYSCS.820
& ,lscav_agedsoot(points) ! INOUT S_PHYSCS.821
& ,aerosol(points,nwet) ! INOUT Aerosol values ; only used S_PHYSCS.822
! if L_MURK=.true. ; default .false. S_PHYSCS.823
S_PHYSCS.824
C S_PHYSCS.825
C--------------------------------------------------------------------- S_PHYSCS.826
C Convection S_PHYSCS.827
C--------------------------------------------------------------------- S_PHYSCS.828
C S_PHYSCS.829
Real S_PHYSCS.830
& iccbpxcca(points) ! P-lev. of conv. cld base x CCA S_PHYSCS.831
& ,icctpxcca(points) ! P-lev. of conv. cld top x CCA S_PHYSCS.832
& ,gbmccwp(points) ! gridbox mean CCWP S_PHYSCS.833
& ,gbmccw(points,nwet) ! gridbox mean CCW S_PHYSCS.834
& ,cape_out(points) ! Saved values of convective S_PHYSCS.835
! available potential energy S_PHYSCS.836
! for diagnostic output (J Kg^-1) S_PHYSCS.837
& ,up_flux(points,nlevs) ! OUT updraught mass flux S_PHYSCS.838
& ,dwn_flux(points,nlevs) ! OUT downdraught mass flux S_PHYSCS.839
& ,entrain_up(points,nlevs) ! OUT fractioal entrainment S_PHYSCS.840
! rate updraughts. S_PHYSCS.841
& ,detrain_up(points,nlevs) ! OUT fractional detrainmen rate S_PHYSCS.842
! updraughts S_PHYSCS.843
& ,entrain_dwn(points,nlevs) ! OUT fractional detrainment rate S_PHYSCS.844
! downdraughts S_PHYSCS.845
& ,detrain_dwn(points,nlevs) ! OUT fractional detrainment rate S_PHYSCS.846
& ,ccwpin(points) ! Condensed water path Kg m^-2 S_PHYSCS.847
& ,ccw(points,nlevs) ! Convective cloud water o/p by S_PHYSCS.848
! CONVEC2A as a diagnostic. S_PHYSCS.849
& ,conv_rain(points) ! Convective rainfall (Kg m^-2 s^-1) S_PHYSCS.850
& ,conv_snow(points) ! Convective snowfall (Kg m^-2 s^-1) S_PHYSCS.851
& ,dthbydt(points,nwet) ! Increments to potential temperature S_PHYSCS.852
! due to convection (K s^-1) S_PHYSCS.853
& ,dqbydt(points,nwet) ! Increments to mixing ratio due to S_PHYSCS.854
! convection (Kg Kg^-1 s^-1) S_PHYSCS.855
& ,dubydt(points,nlevs) ! OUT increments to U due to S_PHYSCS.856
! convective momentum transport S_PHYSCS.857
! (m s^-2) S_PHYSCS.858
& ,dvbydt(points,nlevs) ! OUT increments to V due to S_PHYSCS.859
! convective momentum transport S_PHYSCS.860
! (m s^-2) S_PHYSCS.861
& ,dthud(points,nwet) ! Increments to potential S_PHYSCS.862
! temperature due to convective S_PHYSCS.863
! updraught (K s^-1) S_PHYSCS.864
& ,dthdd(points,nwet) ! Increments to potential temp S_PHYSCS.865
! due to convective downdraught S_PHYSCS.866
! (k s^-1) S_PHYSCS.867
& ,dqud(points,nwet) ! Increment to mixing ratio due S_PHYSCS.868
! to convective updraught S_PHYSCS.869
! (kg Kg^-1 s^-1) S_PHYSCS.870
& ,dqdd(points,nwet) ! Increment to mixing ratio due S_PHYSCS.871
! to convective downdraught S_PHYSCS.872
! (kg Kg^-1 s^-1) S_PHYSCS.873
& ,ls_grid_qc(points,nwet) ! Gridbox mean cloud condensate S_PHYSCS.874
! at processed levels Kg Kg^-1 air) S_PHYSCS.875
& ,ls_bs(points,nwet) ! Maximum moisture fluctuation S_PHYSCS.876
! /6*sigma at proccessed levels S_PHYSCS.877
! (Kg Kg^-1 air) S_PHYSCS.878
C S_PHYSCS.879
C--------------------------------------------------------------------- S_PHYSCS.880
C Clouds S_PHYSCS.881
C--------------------------------------------------------------------- S_PHYSCS.882
C S_PHYSCS.883
Real S_PHYSCS.884
& layer_cloud(points,nwet) ! Layer cloud amount (decimal S_PHYSCS.885
! fraction) S_PHYSCS.886
& ,ccasave(points) ! Convective cloud amount S_PHYSCS.887
& ,rccb(points) ! Real cloud base S_PHYSCS.888
& ,rcct(points) ! Real cloud top S_PHYSCS.889
& ,lcca(points) ! Lowest conv.cloud amount (%) S_PHYSCS.890
& ,lcclwp(points) ! Condensed water path (Kg m^-2) S_PHYSCS.891
! for lowest conv.cloud S_PHYSCS.892
& ,rhcpt(points,nlevs) ! Critical relative humidity at all S_PHYSCS.893
! points : dummy for the SCM, as S_PHYSCS.894
! it is normally determined S_PHYSCS.895
! interactively in the UM by S_PHYSCS.896
! a call to RHCRIT_CALC. S_PHYSCS.897
S_PHYSCS.898
Integer S_PHYSCS.899
& lcbase(points) ! Lowest conv.cloud base level S_PHYSCS.900
& ,lctop(points) ! Lowest conv.cloud top level S_PHYSCS.901
S_PHYSCS.902
Logical S_PHYSCS.903
& l_rhcpt ! Indicates whether RHcrit S_PHYSCS.904
! parametrization is on. S_PHYSCS.905
! Always .false. in the SCM S_PHYSCS.906
! as the parametrisation relies S_PHYSCS.907
! on the neighboring points. S_PHYSCS.908
Data l_rhcpt / .false. / S_PHYSCS.909
S_PHYSCS.910
C S_PHYSCS.911
C--------------------------------------------------------------------- S_PHYSCS.912
C Radiation S_PHYSCS.913
C--------------------------------------------------------------------- S_PHYSCS.914
C S_PHYSCS.915
Integer S_PHYSCS.916
& daynumber ! Day in the year (default=1) S_PHYSCS.917
& ,previous_time(7) ! Year, day etc. for previous timestep S_PHYSCS.918
& ,year ! Year S_PHYSCS.919
& ,list(points) ! List of the daylight_points sunlit S_PHYSCS.920
! points S_PHYSCS.921
& ,icode ! Error code returned by R2_SWRAD S_PHYSCS.922
& ,min_trop ! Limits on where the tropopause may S_PHYSCS.923
& ,max_trop ! be deemed to be S_PHYSCS.924
& ,daylight_points ! No. of sunlit points S_PHYSCS.925
C S_PHYSCS.926
Character*3 S_PHYSCS.927
& sw_version ! SW version to pass in to ftsa S_PHYSCS.928
! at 4.0 instead of MASKDEP S_PHYSCS.929
Logical S_PHYSCS.930
& ccaarb(nbands) ! If CCA R/F are wanted for which S_PHYSCS.931
& ,ccaafb(nbands) ! levels and which bands? S_PHYSCS.932
& ,ccaaro, ccaafo ! Are CCAAR & CCAAF required? S_PHYSCS.933
& ,ccaswo ! Is CCASW required? S_PHYSCS.934
& ,clear_hr_sw_l ! Are clear sky heating rates S_PHYSCS.935
! required? S_PHYSCS.936
& ,clear_hr_lw_l ! Are clear sky heating rates S_PHYSCS.937
! required? S_PHYSCS.938
& ,l_net_flux_trop_LW ! Calculate net downward flux at the S_PHYSCS.939
! tropopause S_PHYSCS.940
& ,l_net_flux_trop_SW ! Calculate net downward flux at the S_PHYSCS.941
! tropopause S_PHYSCS.942
& ,l_up_flux_trop_SW ! Calculate upward flux at the S_PHYSCS.943
! tropopause S_PHYSCS.944
& ,l_down_flux_trop_LW ! Calculate downward flux at the S_PHYSCS.945
! tropopause S_PHYSCS.946
& ,creffo ! Is CREFF required? S_PHYSCS.947
& ,csolon ! Is CSOLRD required? S_PHYSCS.948
& ,csoson ! Is CSOSDI required? S_PHYSCS.949
& ,csssdo, csssuo ! Are CSSSD & CSSSU required? S_PHYSCS.950
& ,cssdon ! Is CSSFDN required? S_PHYSCS.951
& ,cvamto ! Is CVAMT required S_PHYSCS.952
& ,lca3on ! Is LCA3L required? S_PHYSCS.953
& ,lcaafo ! Is LCAAF required? S_PHYSCS.954
& ,lcaarl(nclds) ! If L/C R/F are wanted S_PHYSCS.955
& ,lcaarb(nbands) ! for which levels and S_PHYSCS.956
& ,lcaafl(nclds) ! which bands? S_PHYSCS.957
& ,lcaafb(nbands) S_PHYSCS.958
& ,lcaaro ! Is LCAAR required? S_PHYSCS.959
& ,lcaswo ! Is LCASW required? S_PHYSCS.960
& ,lcld3 ! Is layer cloud to be combined into S_PHYSCS.961
! 3 layers? S_PHYSCS.962
& ,lwp_stratl ! Is LWP_STRAT required? S_PHYSCS.963
& ,nss1on ! Is net SW rad in band 1 required? S_PHYSCS.964
& ,re_stratl ! Is RE_STRAT required? S_PHYSCS.965
& ,oson ! Is OSDIA required? S_PHYSCS.966
& ,re_convl ! Is effective radius*weight for S_PHYSCS.967
! convective cloud required? S_PHYSCS.968
& ,sfdnon ! Is SFDN rquired? S_PHYSCS.969
S_PHYSCS.970
& ,tcaon ! IN Is TCA required? S_PHYSCS.971
& ,tcaswo ! Is TCASW required ? S_PHYSCS.972
& ,tdsson ! Is TDSS rquired? S_PHYSCS.973
& ,wgt_convl ! Is weight of convective cloud S_PHYSCS.974
& ,wgt_stratl ! stratiform cloud amount for SWRAD S_PHYSCS.975
! required? S_PHYSCS.976
& ,weighted_re_flag ! Calculate observed effective S_PHYSCS.977
! radius? S_PHYSCS.978
& ,sum_weight_re_flag ! Calculate sum of weights for S_PHYSCS.979
! effective radius S_PHYSCS.980
& ,ntot_diag_flag ! Diagnose droplet S_PHYSCS.981
! concentration*weight S_PHYSCS.982
& ,strat_lwc_diag_flag ! Diagnose stratiform lwc*weight S_PHYSCS.983
& ,so4_ccn_diag_flag ! Diagnose so4 ccn mass conc* S_PHYSCS.984
! cond. samp. weight S_PHYSCS.985
& ,cond_samp_wgt_flag ! Diagnose conditional sampling S_PHYSCS.986
! weight S_PHYSCS.987
S_PHYSCS.988
Integer rad_array_size ! array size for SWRAD3A to avoid S_PHYSCS.989
Parameter (rad_array_size=1) ! memory conflict :- S_PHYSCS.990
! set to 1 for SCM S_PHYSCS.991
S_PHYSCS.992
Real S_PHYSCS.993
& ccaar(points,nclds) ! Convective Cloud Amount * S_PHYSCS.994
& ,ccaaf(points,nclds) ! Albedo to diRect and diFfuse light S_PHYSCS.995
! (set to zero at night points) S_PHYSCS.996
& ,ccasw(points) ! Convective cloud amount S_PHYSCS.997
& ,clear_hr_sw(points,nlevs) ! Clear sky heating rates in SW S_PHYSCS.998
! (zero at night points) S_PHYSCS.999
& ,clear_hr_lw(points,nlevs) ! Clear sky heating rates in LW S_PHYSCS.1000
! (zero at night points) S_PHYSCS.1001
& ,net_flux_trop_lw(points) S_PHYSCS.1002
! Net downward flux at the tropopause S_PHYSCS.1003
& ,net_flux_trop_sw(points) S_PHYSCS.1004
! net downward flux at the tropopause S_PHYSCS.1005
& ,up_flux_trop_sw(points) ! Upward flux at the tropopause S_PHYSCS.1006
& ,down_flux_trop_lw(points) ! Downward flux at the tropopause S_PHYSCS.1007
& ,co2mmr ! CO2 mass mixing ratio S_PHYSCS.1008
& ,creff(points) ! Convective cloud rE * cld amount S_PHYSCS.1009
& ,csolrd(points) ! Clear-sky OLR (W m^-2) S_PHYSCS.1010
& ,csosdi(points) ! Clear-sky outgoing solar (W m^-2) S_PHYSCS.1011
! at TOA S_PHYSCS.1012
& ,cssfdn(points) ! Clear surface flux down diagnostic S_PHYSCS.1013
! (w m^-2) S_PHYSCS.1014
& ,csssd(points) ! Clear-sky total downward & S_PHYSCS.1015
& ,csssu(points) ! upward SW flux at the surface S_PHYSCS.1016
& ,cvamt(points) ! Convective cloud amount in SWRAD S_PHYSCS.1017
& ,isdia(points) ! Diagnosed incoming solar at TOA S_PHYSCS.1018
! (w m^-2) S_PHYSCS.1019
& ,lca3l(points,nclds) ! Diagnostic of layer cloud amount S_PHYSCS.1020
& ,lcaar(points,nclds) ! Layer Cloud Amount * S_PHYSCS.1021
& ,lcaaf(points,nclds) ! Albedo to diRect and diFfuse light S_PHYSCS.1022
! (set to zero at night points) S_PHYSCS.1023
& ,lcasw(points,nclds) ! Layer Cloud Amount in SW (zero at S_PHYSCS.1024
! night points) S_PHYSCS.1025
& ,longrad(points) ! Longitude in radians S_PHYSCS.1026
& ,lwlut(len_lw_tables) ! Long wave look-up table S_PHYSCS.1027
& ,lwout(points,nlevs+1) ! Longwave atmospheric heating S_PHYSCS.1028
! rates in levels 2,nlevs+1 S_PHYSCS.1029
! (K/timestep). NET LW flux S_PHYSCS.1030
! in level 1 S_PHYSCS.1031
! If sea point LWOUT(1) contains S_PHYSCS.1032
! net longwave flux over land S_PHYSCS.1033
! portion (land or land ice) and S_PHYSCS.1034
! LWSEA that flux over sea S_PHYSCS.1035
! portion S_PHYSCS.1036
& ,lwp_strat(points,nclds) ! Lyr cld CWP for 3-cld scheme S_PHYSCS.1037
& ,lwsea(points) ! Net longwave flux over sea S_PHYSCS.1038
! portion of grid box if S_PHYSCS.1039
! sea point (W m^-2) S_PHYSCS.1040
& ,net_rad(points) ! Net radiation at surface S_PHYSCS.1041
! (w m^-2 positive downwards). S_PHYSCS.1042
& ,nsssb1(points) ! Net downward SW flux at sea S_PHYSCS.1043
! surface in band 1 (W m^-2) S_PHYSCS.1044
& ,ntswin(points) ! Net short-wave absorption S_PHYSCS.1045
! by planet (W m^-2) S_PHYSCS.1046
& ,olr(points) ! Outgoing LW radiation at TOA S_PHYSCS.1047
! (W m^-2) S_PHYSCS.1048
& ,osdia(points) ! Diagnosed actual outgoing S_PHYSCS.1049
! solar at TOA S_PHYSCS.1050
& ,radtime ! LOC Radiation timestep (s) S_PHYSCS.1051
& ,re_conv(points,nclds) ! Effective radius*weight for S_PHYSCS.1052
& ,re_strat(points,nclds) ! stratiform cloud rE * cld amount S_PHYSCS.1053
! convective cloud S_PHYSCS.1054
& ,land_and_ice_albedo(points) ! Surface albedo for land and ice S_PHYSCS.1055
& ,open_sea_albedo(points,1,2) ! Surface albedo for open sea S_PHYSCS.1056
& ,sal_vis(sal_dim,2) ! Visible albedo for land S_PHYSCS.1057
& ,sal_nir(sal_dim,2) ! Near-IR albedo for land S_PHYSCS.1058
& ,sfdn(points) ! Surface flux down diagnostic S_PHYSCS.1059
! (W m^-2) S_PHYSCS.1060
& ,sinlat(points) ! sin latitude S_PHYSCS.1061
& ,start_rad ! Start time for radiation S_PHYSCS.1062
& ,swlut(len_sw_tables) ! Short wave look-up table S_PHYSCS.1063
! Set by SWLKIN S_PHYSCS.1064
& ,swout(points,nlevs+1) ! Shortwave atmospheric heating S_PHYSCS.1065
! rates in levels 2,nlevs+1 S_PHYSCS.1066
! (K/timestep). NET SW flux S_PHYSCS.1067
! in level 1 - actual values for S_PHYSCS.1068
! the current physics timestep S_PHYSCS.1069
& ,radincs(points,nlevs+2) ! As SWOUT, but not multiplied S_PHYSCS.1070
! by COS_ZENITH_ANGLE - RADINCS is S_PHYSCS.1071
! re-calculated only on radiation S_PHYSCS.1072
! timesteps and SWOUT updated from S_PHYSCS.1073
! it each physics timestep S_PHYSCS.1074
& ,swsea(points) ! Net shortwave flux over sea S_PHYSCS.1075
! portion of grid box if S_PHYSCS.1076
! sea point (W m^-2) S_PHYSCS.1077
& ,radheat_rate(points,nbl_levs) ! OUT Radiative heating rates : S_PHYSCS.1078
! not used in A03_3A, A03_5A, A03_5B, S_PHYSCS.1079
! A03_7A, but used for A03_6A S_PHYSCS.1080
& ,tca(points) ! OUT Total cloud amount S_PHYSCS.1081
! (decimal fraction) S_PHYSCS.1082
& ,tcasw(points) ! Total cloud amount in SW S_PHYSCS.1083
! (ie fraction of grid-box S_PHYSCS.1084
! with cloud at some level) S_PHYSCS.1085
& ,tdss(points) ! Total downward SW flux at S_PHYSCS.1086
! surface (multiply-reflected S_PHYSCS.1087
! light being multiply counted) S_PHYSCS.1088
& ,wgt_conv(points,nclds) ! Weight of convective cloud S_PHYSCS.1089
& ,wgt_strat(points,nclds) ! stratiform cloud amount for SWRAD S_PHYSCS.1090
& ,weighted_re(points) ! Weighted sum of effective radii S_PHYSCS.1091
& ,sum_weight_re(points) ! Sum of weights for effective radius S_PHYSCS.1092
& ,ntot_diag(points, nclds) ! Droplet concentration*weight S_PHYSCS.1093
& ,strat_lwc_diag(points, nclds) ! Stratiform lwc*weight S_PHYSCS.1094
& ,so4_ccn_diag(points, nclds) ! SO4 ccn mass conc*cond. S_PHYSCS.1095
! samp. weight S_PHYSCS.1096
& ,cond_samp_wgt(points, nclds) ! Conditional sampling weight S_PHYSCS.1097
C S_PHYSCS.1098
! Data ccwpin /1.0/ S_PHYSCS.1099
S_PHYSCS.1100
Data ccaarb /nbands*.false./ S_PHYSCS.1101
Data ccaafb /nbands*.false./ S_PHYSCS.1102
Data lcaarb /nbands*.false./ S_PHYSCS.1103
Data lcaafb /nbands*.false./ S_PHYSCS.1104
Data ccaaro, ccaafo, ccaswo/ 3*.false./ S_PHYSCS.1105
Data csolon, csoson/ 2*.true./ S_PHYSCS.1106
Data csssdo, csssuo, cssdon/3*.false./ S_PHYSCS.1107
Data lca3on, lcaafo/ 2*.false./ S_PHYSCS.1108
S_PHYSCS.1109
S_PHYSCS.1110
*IF DEF,A03_5A S_PHYSCS.1111
C For MOSES code nss1on needs to be set for photsynthesis to work S_PHYSCS.1112
Data lcaaro, lcaswo, sfdnon, nss1on/ 3*.false.,.true./ S_PHYSCS.1113
*ELSE S_PHYSCS.1114
Data lcaaro, lcaswo, sfdnon, nss1on/ 4*.false./ S_PHYSCS.1115
*ENDIF S_PHYSCS.1116
Data oson, tcaon, tcaswo, tdsson/ 4*.true./ S_PHYSCS.1117
Data creffo,re_stratl,cvamto,wgt_stratl,lwp_stratl/5*.false./ S_PHYSCS.1118
Data clear_hr_sw_l,clear_hr_lw_l, re_convl, wgt_convl/4*.false./ S_PHYSCS.1119
Data S_PHYSCS.1120
& weighted_re_flag S_PHYSCS.1121
& ,sum_weight_re_flag S_PHYSCS.1122
& ,ntot_diag_flag S_PHYSCS.1123
& ,strat_lwc_diag_flag S_PHYSCS.1124
& ,so4_ccn_diag_flag S_PHYSCS.1125
& ,cond_samp_wgt_flag S_PHYSCS.1126
& / 6 * .false./ S_PHYSCS.1127
S_PHYSCS.1128
*IF DEF,A01_2A S_PHYSCS.1129
Parameter (lcld3 = .true.) S_PHYSCS.1130
*ELSE S_PHYSCS.1131
Parameter (lcld3 = .false.) S_PHYSCS.1132
*ENDIF S_PHYSCS.1133
C S_PHYSCS.1134
C-------------------------------------------------------------------- S_PHYSCS.1135
C Cloud variable values if clouds to be fixed for radiation S_PHYSCS.1136
C-------------------------------------------------------------------- S_PHYSCS.1137
C S_PHYSCS.1138
Integer S_PHYSCS.1139
& iccb_rad(points) ! Model level of base of convective S_PHYSCS.1140
! cloud S_PHYSCS.1141
& ,icct_rad(points) ! Model level of top of convective S_PHYSCS.1142
! cloud S_PHYSCS.1143
S_PHYSCS.1144
Real S_PHYSCS.1145
& cca_rad(points) ! Convective cloud amount (fraction) S_PHYSCS.1146
& ,layer_cloud_rad(points,nwet) ! Layer cloud amount (fraction) S_PHYSCS.1147
& ,qcl_rad_box(points,nwet) ! Total cloud water and ice content S_PHYSCS.1148
! over whole box as QCL and QCF are S_PHYSCS.1149
! normally calculated by LSCLD over S_PHYSCS.1150
! whole box. S_PHYSCS.1151
& ,qcf_rad_box(points,nwet) ! Set to zero as SWRAD and LWRAD S_PHYSCS.1152
! expect water and ice content S_PHYSCS.1153
! separate as calculated by LSCLD S_PHYSCS.1154
& ,ccwpin_rad(points) ! convective water path over cloud S_PHYSCS.1155
! only (Kg m^-2) S_PHYSCS.1156
C S_PHYSCS.1157
C--------------------------------------------------------------------- S_PHYSCS.1158
C Surface quantities S_PHYSCS.1159
C--------------------------------------------------------------------- S_PHYSCS.1160
C S_PHYSCS.1161
Real S_PHYSCS.1162
& bs(points) ! For HYDROL,eqn P253.4. UMDP No. 5 S_PHYSCS.1163
! values Internal Note No. 81. S_PHYSCS.1164
& ,fast_runoff(points) ! Surface runoff (Kg m^-2 s^-1) S_PHYSCS.1165
& ,infil(points) ! Infiltration rate (Kg m^-2 s^-1) S_PHYSCS.1166
& ,hf_snow_melt(points) ! Snowmelt heat flux (W m^-2) S_PHYSCS.1167
& ,snow_melt(points) ! Snowmelt (Kg m^-2 s^-1) S_PHYSCS.1168
& ,sub_surf_roff(points) ! Subsurface runoff (Kg m^-2 s^-1) S_PHYSCS.1169
& ,throughfall(points) ! Throughfall (Kg m^-2 s^-1) S_PHYSCS.1170
& ,b_exp_nsite(points) ! Nsite Eagleson's exponent S_PHYSCS.1171
& ,hcap_nsite(points) ! Nsite soil heat capacity S_PHYSCS.1172
& ,hcon_nsite(points) ! Nsite soil thermal conductivity S_PHYSCS.1173
& ,satcon_nsite(points) ! Nsite saturated hydrological S_PHYSCS.1174
! conductivity S_PHYSCS.1175
& ,sathh_nsite(points) ! Nsite Dummy for use in Single S_PHYSCS.1176
! layer hydrology S_PHYSCS.1177
& ,v_sat_nsite(points) ! Nsite volumetric soil moisture S_PHYSCS.1178
! content at saturation S_PHYSCS.1179
& ,v_wilt_nsite(points) ! Nsite volumetric soil moisture S_PHYSCS.1180
! content at wilting point S_PHYSCS.1181
& ,v_crit_nsite(points) ! Nsite volumetric soil moisture S_PHYSCS.1182
& ,albsnc_nsite(points) ! Cold deep snow-covered albedo S_PHYSCS.1183
& ,albsnf_nsite(points) ! Snow free albedo S_PHYSCS.1184
& ,catch_nsite(points) ! Surface/canopy water capacity S_PHYSCS.1185
! (Kg m^-2) S_PHYSCS.1186
& ,resist_nsite(points) ! Stomatal resistance to evaporation S_PHYSCS.1187
! (s m^-1) S_PHYSCS.1188
& ,rootdep_nsite(points) ! Root depth (metres) S_PHYSCS.1189
& ,z0_nsite(points) ! Vegetative roughness length (metres) S_PHYSCS.1190
& ,veg_frac_nsite(points) ! Vegetation fraction used in S_PHYSCS.1191
! calculation of infiltration rate S_PHYSCS.1192
& ,infil_fac_nsite(points) ! Infiltration enhancement factor S_PHYSCS.1193
! used in calculation of S_PHYSCS.1194
! infiltration rate. S_PHYSCS.1195
& ,canht_nsite(points) ! Height of the vegetation canopy (m) S_PHYSCS.1196
& ,lai_nsite(points) ! Leaf area index of vegetation canopy S_PHYSCS.1197
! content at the critical point C S_PHYSCS.1198
S_PHYSCS.1199
C S_PHYSCS.1200
C--------------------------------------------------------------------- S_PHYSCS.1201
C Water S_PHYSCS.1202
C--------------------------------------------------------------------- S_PHYSCS.1203
C S_PHYSCS.1204
& ,cw_sea ! Cloud liquid water content over sea S_PHYSCS.1205
! for efficient conversion to ppn S_PHYSCS.1206
& ,cw_land ! Cloud liquid water content over S_PHYSCS.1207
! land for efficient conversion to S_PHYSCS.1208
! ppn S_PHYSCS.1209
Data cw_sea, cw_land /2.0e-4, 8.0e-4/ S_PHYSCS.1210
Real S_PHYSCS.1211
& ls_rain(points) ! OUT Large scale rainfall rate S_PHYSCS.1212
! (Kg m^-2) S_PHYSCS.1213
& ,ls_snow(points) ! OUT Large scale snowfall rate S_PHYSCS.1214
! (Kg m^-2 s^-1) S_PHYSCS.1215
& ,lsrain3d(points,nwet) ! OUT Rain rate out of each level S_PHYSCS.1216
& ,lssnow3d(points,nwet) ! OUT Snow rate out of each level S_PHYSCS.1217
S_PHYSCS.1218
C S_PHYSCS.1219
C--------------------------------------------------------------------- S_PHYSCS.1220
C Basic coefficients S_PHYSCS.1221
C--------------------------------------------------------------------- S_PHYSCS.1222
C S_PHYSCS.1223
C--------------------------------------------------------------------- S_PHYSCS.1224
C Variables for diagnostic output for observational forcing S_PHYSCS.1225
C--------------------------------------------------------------------- S_PHYSCS.1226
Real S_PHYSCS.1227
& dap1(points,36,nlevs) ! instantaneous profiles S_PHYSCS.1228
& ,dap2(points,36,nlevs) ! mean profiles S_PHYSCS.1229
& ,dap3(points,36,NFOR-1,nlevs) ! mean profiles - timeseries S_PHYSCS.1230
& ,dab1(points,44) ! instantaneous budgets S_PHYSCS.1231
& ,dab2(points,44) ! mean budgets S_PHYSCS.1232
& ,dab3(points,44,NFOR-1) ! mean budgets - timeseries S_PHYSCS.1233
& ,dtbydt(points,nlevs) ! dT/dt - convection S_PHYSCS.1234
& ,dtdd(points,nlevs) ! dT/dt - convection - ud S_PHYSCS.1235
& ,dtud(points,nlevs) ! dT/dt - convection - dd S_PHYSCS.1236
& ,factor_rhokh(points) ! used to specify surface flux S_PHYSCS.1237
! from observation S_PHYSCS.1238
& ,press(points,nlevs) ! pressure at level S_PHYSCS.1239
& ,qs(points,nwet) ! saturation mixing ratio (Kg Kg^-1). S_PHYSCS.1240
& ,qtmp(points,nwet) ! temporary workspace to store S_PHYSCS.1241
& ,qcltmp(points,nwet) ! Q, T, QCL, QCF before physic S_PHYSCS.1242
& ,qcftmp(points,nwet) ! " " " S_PHYSCS.1243
& ,ttmp(points,nlevs) ! " " " S_PHYSCS.1244
S_PHYSCS.1245
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1246
C Set dummy arrays to zero (in doubt...) S_PHYSCS.1247
Do i = 1, points S_PHYSCS.1248
Do k = 1, nlevs S_PHYSCS.1249
fresh_soot(i,k) = 0 S_PHYSCS.1250
aged_soot(i,k) = 0 S_PHYSCS.1251
enddo S_PHYSCS.1252
enddo S_PHYSCS.1253
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1254
! The following comes from the RAD_CTL routine ---> ie I comply S_PHYSCS.1255
! to it: S_PHYSCS.1256
! Partitioning of ice and water cloud needs to be consistent with S_PHYSCS.1257
! the large-scale precipitation scheme (Section 4) used. For new S_PHYSCS.1258
! precipitation microphysics scheme (A04_3A) use input qCL and qCF S_PHYSCS.1259
! directly: for earlier schemes partition (qCL+qCF) using FOCWWIL. S_PHYSCS.1260
! A. C. Bushell 12/ 3/ 1997 S_PHYSCS.1261
! S_PHYSCS.1262
l_cloud_water_partition = l_lspice S_PHYSCS.1263
S_PHYSCS.1264
C S_PHYSCS.1265
Do i = 1 , nclds S_PHYSCS.1266
lcaafl(i) = .false. S_PHYSCS.1267
lcaarl(i) = .false. S_PHYSCS.1268
enddo S_PHYSCS.1269
C S_PHYSCS.1270
S_PHYSCS.1271
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1272
C Initialise output arrays to zero S_PHYSCS.1273
S_PHYSCS.1274
Do i = 1, points S_PHYSCS.1275
net_rad(i) = 0.0 S_PHYSCS.1276
rad_no_snow(i) = 0.0 S_PHYSCS.1277
rad_snow(i) = 0.0 S_PHYSCS.1278
photosynth_act_rad(i) = 0.0 S_PHYSCS.1279
lcca(i) = 0.0 S_PHYSCS.1280
lcclwp(i) = 0.0 S_PHYSCS.1281
enddo S_PHYSCS.1282
Do i = 1, points S_PHYSCS.1283
Do k = 1, nlevs+2 S_PHYSCS.1284
radincs(i,k) = 0.0 S_PHYSCS.1285
enddo S_PHYSCS.1286
enddo S_PHYSCS.1287
C S_PHYSCS.1288
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1289
C Define nsite surface characteristics S_PHYSCS.1290
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1291
C S_PHYSCS.1292
C Nsite soil parameters S_PHYSCS.1293
C S_PHYSCS.1294
Do i = 1, points S_PHYSCS.1295
b_exp_nsite(i)=b_exp(soil_type(i)) S_PHYSCS.1296
hcap_nsite(i)=hcap(soil_type(i)) S_PHYSCS.1297
hcon_nsite(i)=hcon(soil_type(i)) S_PHYSCS.1298
satcon_nsite(i)=satcon(soil_type(i)) S_PHYSCS.1299
sathh_nsite(i)=sathh(soil_type(i)) S_PHYSCS.1300
v_sat_nsite(i)=v_sat(soil_type(i)) S_PHYSCS.1301
v_wilt_nsite(i)=v_wilt(soil_type(i)) S_PHYSCS.1302
v_crit_nsite(i)=v_crit(soil_type(i)) S_PHYSCS.1303
enddo S_PHYSCS.1304
C S_PHYSCS.1305
C Nsite vegetation parameters S_PHYSCS.1306
C S_PHYSCS.1307
Do i = 1, points S_PHYSCS.1308
albsnc_nsite(i)=albsnc(veg_type(i)) S_PHYSCS.1309
albsnf_nsite(i)=albsnf(veg_type(i)) S_PHYSCS.1310
catch_nsite(i)=catch(veg_type(i)) S_PHYSCS.1311
resist_nsite(i)=resist(veg_type(i)) S_PHYSCS.1312
rootdep_nsite(i)=rootdep(veg_type(i)) S_PHYSCS.1313
z0_nsite(i)=z0(veg_type(i)) S_PHYSCS.1314
veg_frac_nsite(i)=veg_frac(veg_type(i)) S_PHYSCS.1315
infil_fac_nsite(i)=infil_fac(veg_type(i)) S_PHYSCS.1316
canht_nsite(i)=canht(veg_type(i)) S_PHYSCS.1317
lai_nsite(i)=lai(veg_type(i)) S_PHYSCS.1318
enddo S_PHYSCS.1319
C S_PHYSCS.1320
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1321
C For Observational forcing run, save the initial QCL, QCF S_PHYSCS.1322
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1323
C S_PHYSCS.1324
If (obs) then S_PHYSCS.1325
Do i = 1, points S_PHYSCS.1326
Do k = 1, nwet S_PHYSCS.1327
qcltmp(i,k) = qcl(i,k) S_PHYSCS.1328
qcftmp(i,k) = qcf(i,k) S_PHYSCS.1329
enddo S_PHYSCS.1330
enddo S_PHYSCS.1331
endif S_PHYSCS.1332
C S_PHYSCS.1333
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1334
C If Geostrophic forcing is chosen S_PHYSCS.1335
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1336
C S_PHYSCS.1337
If (geoforce) then S_PHYSCS.1338
Do i = 1, points S_PHYSCS.1339
Do k = 1,nlevs S_PHYSCS.1340
u(i,k) = u(i,k) + f_coriolis(i) * (vg(i)-v(i,k))*timestep S_PHYSCS.1341
v(i,k) = v(i,k) - f_coriolis(i) * (ug(i)-u(i,k))*timestep S_PHYSCS.1342
enddo S_PHYSCS.1343
enddo S_PHYSCS.1344
endif S_PHYSCS.1345
c S_PHYSCS.1346
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1347
C Large scale cloud (P292) S_PHYSCS.1348
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1349
C S_PHYSCS.1350
C Convert T to ice/liquid water temperature,and Q to total water S_PHYSCS.1351
C content for INPUT to LS_CLD. They will have their usual values S_PHYSCS.1352
C of temperature and specific humidty on OUTPUT. S_PHYSCS.1353
C See Unified Model Documentation Paper No. 29, eqns P292.1 and S_PHYSCS.1354
C P292.2. S_PHYSCS.1355
C S_PHYSCS.1356
Do i = 1, points S_PHYSCS.1357
Do k = 1, nwet S_PHYSCS.1358
t(i,k) = t(i,k) - (lc/cp)*qcl(i,k) - ((lc+lf)/cp) * qcf(i,k) S_PHYSCS.1359
q(i,k) = q(i,k) + qcl(i,k) + qcf(i,k) S_PHYSCS.1360
enddo S_PHYSCS.1361
enddo S_PHYSCS.1362
Call GLUE_CLD( S_PHYSCS.1363
& ak,bk,pstar,rhcrit,nwet,rhcpt, S_PHYSCS.1364
& points,points, S_PHYSCS.1365
& t,layer_cloud,q,qcf,qcl, S_PHYSCS.1366
& ls_grid_qc,ls_bs, S_PHYSCS.1367
& error) S_PHYSCS.1368
C S_PHYSCS.1369
C--------------------------------------------------------------------- S_PHYSCS.1370
C Check for error in argument list S_PHYSCS.1371
C--------------------------------------------------------------------- S_PHYSCS.1372
C S_PHYSCS.1373
Call ERRONEOUS(error,' GLUE_CLD ') S_PHYSCS.1374
If (error .gt. 0) Stop S_PHYSCS.1375
C S_PHYSCS.1376
C--------------------------------------------------------------------- S_PHYSCS.1377
C Convert temperature to potential temperature S_PHYSCS.1378
C--------------------------------------------------------------------- S_PHYSCS.1379
C S_PHYSCS.1380
Call THETA_CALC(theta,t,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.1381
C S_PHYSCS.1382
C S_PHYSCS.1383
C--------------------------------------------------------------------- S_PHYSCS.1384
C Store diagnostics if observational forcing S_PHYSCS.1385
C--------------------------------------------------------------------- S_PHYSCS.1386
C S_PHYSCS.1387
If (prindump_obs) then S_PHYSCS.1388
Do i = 1, points S_PHYSCS.1389
Do k = 1, nwet S_PHYSCS.1390
dap1(i,19,k) = S_PHYSCS.1391
& ( (lc/cp) * (qcl(i,k)-qcltmp(i,k)) S_PHYSCS.1392
& + ((lc+lf)/cp)*(qcf(i,k)-qcftmp(i,k)) ) S_PHYSCS.1393
& / timestep S_PHYSCS.1394
dap1(i,29,k) = S_PHYSCS.1395
& (qcl(i,k) + qcf(i,k) - qcltmp(i,k) - qcftmp(i,k)) S_PHYSCS.1396
& * 1000.0 / timestep S_PHYSCS.1397
enddo S_PHYSCS.1398
enddo S_PHYSCS.1399
endif S_PHYSCS.1400
c S_PHYSCS.1401
C--------------------------------------------------------------------- S_PHYSCS.1402
C Convert temperature to potential temperature S_PHYSCS.1403
C--------------------------------------------------------------------- S_PHYSCS.1404
C S_PHYSCS.1405
Call THETA_CALC(theta,t,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.1406
C S_PHYSCS.1407
C--------------------------------------------------------------------- S_PHYSCS.1408
C Write out sub-timestep diagnostics S_PHYSCS.1409
C--------------------------------------------------------------------- S_PHYSCS.1410
C S_PHYSCS.1411
If (test .and. daycount .ge. start_diagday) then S_PHYSCS.1412
If (stepcount .ge. subdat_step1 S_PHYSCS.1413
& .and. mod(stepcount-subdat_step1, subdat_step) .eq. 0) S_PHYSCS.1414
& Call SUB_DATA( S_PHYSCS.1415
& points, nlevs, nwet S_PHYSCS.1416
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_PHYSCS.1417
& ,' After cld, before astronmy ' S_PHYSCS.1418
& ,stepcount,yearno,day,time_string,daycount,u,v,t, S_PHYSCS.1419
& theta,q,qcl,qcf,layer_cloud,pstar,t_deep_soil,smc, S_PHYSCS.1420
& canopy,snodep,tstar,zh, S_PHYSCS.1421
& z0msea,cca,iccb,icct,smcl) S_PHYSCS.1422
endif S_PHYSCS.1423
C S_PHYSCS.1424
C--------------------------------------------------------------------- S_PHYSCS.1425
C Calculate the CO2 mass mixing ratio using the rate of change S_PHYSCS.1426
C (per year) S_PHYSCS.1427
C--------------------------------------------------------------------- S_PHYSCS.1428
C S_PHYSCS.1429
If (lcal360) then S_PHYSCS.1430
co2mmr = co2start + co2rate S_PHYSCS.1431
& * ((daycount-1)*86400 + (stepcount-1)*timestep) S_PHYSCS.1432
& / 360*86400 S_PHYSCS.1433
else S_PHYSCS.1434
co2mmr = co2start + co2rate S_PHYSCS.1435
& * ((daycount-1)*86400 + (stepcount-1)*timestep) S_PHYSCS.1436
& / 365*86400 S_PHYSCS.1437
endif S_PHYSCS.1438
If (co2mmr .gt. co2end) co2mmr = co2end S_PHYSCS.1439
S_PHYSCS.1440
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1441
C ASTRONOMY (P233) S_PHYSCS.1442
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1443
C S_PHYSCS.1444
If (stepcount .eq. ntrad1) then S_PHYSCS.1445
start_rad = time_init S_PHYSCS.1446
else S_PHYSCS.1447
start_rad = time_init + (stepcount-1) * timestep S_PHYSCS.1448
start_rad = mod(start_rad, 86400.0) S_PHYSCS.1449
endif S_PHYSCS.1450
radtime = timestep * ntrad S_PHYSCS.1451
C S_PHYSCS.1452
C--------------------------------------------------------------------- S_PHYSCS.1453
C Set longitude to zero so that diagnostics apply to local time S_PHYSCS.1454
C rather than GMT S_PHYSCS.1455
C--------------------------------------------------------------------- S_PHYSCS.1456
C S_PHYSCS.1457
Do i = 1, points S_PHYSCS.1458
If (local_time) then S_PHYSCS.1459
longrad(i) = 0.0 S_PHYSCS.1460
else S_PHYSCS.1461
longrad(i) = pi_over_180 * long(i) S_PHYSCS.1462
endif S_PHYSCS.1463
enddo S_PHYSCS.1464
C--------------------------------------------------------------------- S_PHYSCS.1465
C Calculate Sine of LAT, converting LAT to radians first. S_PHYSCS.1466
C--------------------------------------------------------------------- S_PHYSCS.1467
C S_PHYSCS.1468
Do i = 1, points S_PHYSCS.1469
sinlat(i) = sin(lat(i) * pi_over_180) S_PHYSCS.1470
enddo S_PHYSCS.1471
C S_PHYSCS.1472
C--------------------------------------------------------------------- S_PHYSCS.1473
C Solar Position now calculated from previous timestep time S_PHYSCS.1474
C--------------------------------------------------------------------- S_PHYSCS.1475
C S_PHYSCS.1476
If (stepcount .gt. 1) then S_PHYSCS.1477
previous_time(7) = daynumber S_PHYSCS.1478
previous_time(1) = year S_PHYSCS.1479
else S_PHYSCS.1480
previous_time(7) = daynumber-1 S_PHYSCS.1481
previous_time(1) = year S_PHYSCS.1482
If (previous_time(7) .eq. 0) then S_PHYSCS.1483
If (lcal360) then S_PHYSCS.1484
previous_time(7) = 360 S_PHYSCS.1485
else S_PHYSCS.1486
previous_time(7) = 365 S_PHYSCS.1487
endif S_PHYSCS.1488
previous_time(1) = year-1 S_PHYSCS.1489
endif S_PHYSCS.1490
endif ! stepcount S_PHYSCS.1491
S_PHYSCS.1492
Call solpos (previous_time(7), previous_time(1), S_PHYSCS.1493
& sindec, scs, lcal360) S_PHYSCS.1494
Call solang ( S_PHYSCS.1495
C input constants S_PHYSCS.1496
& sindec, start_rad, radtime, S_PHYSCS.1497
C row and column dependent constants S_PHYSCS.1498
& sinlat, longrad, S_PHYSCS.1499
C size variables S_PHYSCS.1500
& points, S_PHYSCS.1501
C output fields S_PHYSCS.1502
& day_fraction, cos_zenith_angle) S_PHYSCS.1503
S_PHYSCS.1504
C S_PHYSCS.1505
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1506
C Call radiation every ntrad timesteps S_PHYSCS.1507
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1508
If (stepcount .ge. ntrad1 S_PHYSCS.1509
& .and. mod(stepcount-ntrad1,ntrad) .eq. 0) then S_PHYSCS.1510
S_PHYSCS.1511
If (test .and. daycount .ge. start_diagday) then S_PHYSCS.1512
If (stepcount .ge. subdat_step1 S_PHYSCS.1513
& .and. mod(stepcount-subdat_step1, subdat_step) .eq. 0) S_PHYSCS.1514
& Call SUB_DATA( S_PHYSCS.1515
& points, nlevs, nwet S_PHYSCS.1516
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_PHYSCS.1517
& ,' After astronmy, before swrad ' S_PHYSCS.1518
& ,stepcount,yearno,day,time_string,daycount,u,v,t, S_PHYSCS.1519
& theta,q,qcl,qcf,layer_cloud, S_PHYSCS.1520
& pstar,t_deep_soil,smc,canopy,snodep,tstar,zh, S_PHYSCS.1521
& z0msea,cca,iccb,icct,smcl) S_PHYSCS.1522
endif S_PHYSCS.1523
C S_PHYSCS.1524
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1525
C SHORTWAVE RADIATION (P234) S_PHYSCS.1526
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1527
C S_PHYSCS.1528
C S_PHYSCS.1529
C sw_mode determines actions for short wave scheme S_PHYSCS.1530
C 0 = Run normally S_PHYSCS.1531
C 1 = Run for diagnostics but save dump state S_PHYSCS.1532
C 2 = Don't run S_PHYSCS.1533
C S_PHYSCS.1534
If (sw_mode .eq. 1) then S_PHYSCS.1535
Do i = 1, points S_PHYSCS.1536
Do k = 1, nprimvars S_PHYSCS.1537
savedump(i,k) = 0.0 S_PHYSCS.1538
enddo S_PHYSCS.1539
enddo S_PHYSCS.1540
Call RESTART_DUMP( S_PHYSCS.1541
! IN dimensions of main arrays S_PHYSCS.1542
& points, nlevs, nwet, nprimvars, S_PHYSCS.1543
& nbl_levs, nsoilt_levs, nsoilm_levs, S_PHYSCS.1544
! S_PHYSCS.1545
& savedump,u,v,t,theta,q,qcl,qcf,layer_cloud, S_PHYSCS.1546
& pstar,t_deep_soil,smc,canopy, S_PHYSCS.1547
& snodep,tstar,zh,z0msea, S_PHYSCS.1548
& cca,iccb,icct,smcl) S_PHYSCS.1549
endif S_PHYSCS.1550
S_PHYSCS.1551
C SWrad is to run S_PHYSCS.1552
C S_PHYSCS.1553
If (sw_mode .eq. 0 .or. sw_mode .eq. 1) then S_PHYSCS.1554
S_PHYSCS.1555
*IF DEF,A03_7A S_PHYSCS.1556
C--------------------------------------------------------------------- S_PHYSCS.1557
C Diagnose fractional snow cover for MOSES II S_PHYSCS.1558
C--------------------------------------------------------------------- S_PHYSCS.1559
Do i = 1, points S_PHYSCS.1560
snow_frac(i) = 0. S_PHYSCS.1561
tstar_snow(i) = tstar_tile(i,ntype) S_PHYSCS.1562
If (sndep(i) .gt. 0.) then S_PHYSCS.1563
snow_frac(i) = S_PHYSCS.1564
& min(1. , snodep(i) / (rho_snow*deff_snow)) S_PHYSCS.1565
snow_frac(i) = max(snow_frac(i), 1e-3) S_PHYSCS.1566
endif S_PHYSCS.1567
enddo S_PHYSCS.1568
*ELSE S_PHYSCS.1569
C--------------------------------------------------------------------- S_PHYSCS.1570
C Diagnose fractional snow cover Without MOSES II S_PHYSCS.1571
C--------------------------------------------------------------------- S_PHYSCS.1572
Do i = 1, points S_PHYSCS.1573
snow_frac(i) = 1. S_PHYSCS.1574
tstar_snow(i) = tstar(i) S_PHYSCS.1575
enddo S_PHYSCS.1576
*ENDIF S_PHYSCS.1577
S_PHYSCS.1578
*IF DEF,A01_3A S_PHYSCS.1579
SW_VERSION='03A' S_PHYSCS.1580
*ELSE S_PHYSCS.1581
SW_VERSION='01A' S_PHYSCS.1582
*ENDIF S_PHYSCS.1583
S_PHYSCS.1584
Call ftsa ( S_PHYSCS.1585
& land_mask, ice_fract, tstar, tstar_snow, snow_frac, S_PHYSCS.1586
& albsnf_nsite,albsnc_nsite, cos_zenith_angle, S_PHYSCS.1587
& snodep, rgrain, soot, S_PHYSCS.1588
& alpham, alphac, alphab, dtice, l_ssice_albedo, S_PHYSCS.1589
& sw_version, S_PHYSCS.1590
& points, points, l_snow_albedo, sal_dim, sal_vis, sal_nir, S_PHYSCS.1591
& land_and_ice_albedo, open_sea_albedo) S_PHYSCS.1592
S_PHYSCS.1593
C Index on the lit points. Cf RAD_CTL1 on how to properly S_PHYSCS.1594
C fill 'list'. The lines below should do for the time being. S_PHYSCS.1595
C Also, determines the number of lit points (daylight_points). S_PHYSCS.1596
daylight_points = 0 S_PHYSCS.1597
Do i = 1, points S_PHYSCS.1598
If (day_fraction(i) .gt. 0.) then S_PHYSCS.1599
daylight_points = daylight_points + 1 S_PHYSCS.1600
list(daylight_points) = i S_PHYSCS.1601
endif S_PHYSCS.1602
enddo S_PHYSCS.1603
S_PHYSCS.1604
*IF DEF,A01_3A,OR,DEF,A02_3A S_PHYSCS.1605
CL 0.3 Find tropopause index, needed if climatological aerosols are S_PHYSCS.1606
CL to be used, to decide where the tropospheric aerosol stops and S_PHYSCS.1607
CL the stratospheric starts. The IF test may be over-ridden if S_PHYSCS.1608
CL it is wanted for other purposes (e.g. diagnosing tropopause S_PHYSCS.1609
CL fluxes). S_PHYSCS.1610
S_PHYSCS.1611
If (l_climate_aerosol) then S_PHYSCS.1612
C Find the lowest layer boundaries above eta=.7 & .05, to S_PHYSCS.1613
C use as limits for the tropopause. S_PHYSCS.1614
C (The latter is the same constant as used within TROPIN, S_PHYSCS.1615
C but applied half a level more restrictively, and in terms S_PHYSCS.1616
C of eta rather than pressure/PREF - in practice this will S_PHYSCS.1617
C make no difference for standard levels as they will be S_PHYSCS.1618
C pure pressure levels there. The former is apparently S_PHYSCS.1619
C more generous, but is necessary to find a tropopause S_PHYSCS.1620
C around 40 kPa with surface pressure less than 60 kPa, S_PHYSCS.1621
C as is perfectly plausible in the Antarctic winter.) S_PHYSCS.1622
Do k = nlevs, 1, -1 S_PHYSCS.1623
If ( akh(k)/pref+bkh(k) .lt. .7 ) min_trop = k S_PHYSCS.1624
If ( akh(k)/pref+bkh(k) .lt. .05 ) max_trop = k S_PHYSCS.1625
enddo S_PHYSCS.1626
Call tropin (pstar, theta, exner, S_PHYSCS.1627
& trindx, points, points, points, nlevs, S_PHYSCS.1628
& min_trop, max_trop, akh, bkh, S_PHYSCS.1629
*IF DEF,GLOBAL,AND,-DEF,MPP S_PHYSCS.1630
& .true. ) S_PHYSCS.1631
*ELSE S_PHYSCS.1632
& .false. ) S_PHYSCS.1633
*ENDIF S_PHYSCS.1634
endif S_PHYSCS.1635
*ENDIF S_PHYSCS.1636
C S_PHYSCS.1637
C--------------------------------------------------------------------- S_PHYSCS.1638
C If gridpoint is not lit or sun has not risen do not call S_PHYSCS.1639
C SWRAD and hence set all SW diagnostics to zero S_PHYSCS.1640
C--------------------------------------------------------------------- S_PHYSCS.1641
C S_PHYSCS.1642
S_PHYSCS.1643
If (daylight_points .eq. 0) then S_PHYSCS.1644
Do i = 1, points S_PHYSCS.1645
Do k = 1, nclds S_PHYSCS.1646
ccaaf(i,k) = 0.0 S_PHYSCS.1647
ccaar(i,k) = 0.0 S_PHYSCS.1648
lca3l(i,k) = 0.0 S_PHYSCS.1649
lcaaf(i,k) = 0.0 S_PHYSCS.1650
lcaar(i,k) = 0.0 S_PHYSCS.1651
lcasw(i,k) = 0.0 S_PHYSCS.1652
enddo S_PHYSCS.1653
ccasw(i) = 0.0 S_PHYSCS.1654
csosdi(i) = 0.0 S_PHYSCS.1655
csssd(i) = 0.0 S_PHYSCS.1656
csssu(i) = 0.0 S_PHYSCS.1657
nsssb1(i) = 0.0 S_PHYSCS.1658
ntswin(i) = 0.0 S_PHYSCS.1659
osdia(i) = 0.0 S_PHYSCS.1660
swsea(i) = 0.0 S_PHYSCS.1661
tcasw(i) = 0.0 S_PHYSCS.1662
tdss(i) = 0.0 S_PHYSCS.1663
Do k = 1, nlevs+2 ! extra level is net surf SW S_PHYSCS.1664
! in band 1 S_PHYSCS.1665
radincs(i,k) = 0. S_PHYSCS.1666
enddo S_PHYSCS.1667
enddo S_PHYSCS.1668
S_PHYSCS.1669
else ! SW rad runs S_PHYSCS.1670
C S_PHYSCS.1671
C If the user does not require fixed cloud for radition, S_PHYSCS.1672
C pick up the values calculated by CONVECTION. S_PHYSCS.1673
C S_PHYSCS.1674
if (.not. radcloud_fixed) then S_PHYSCS.1675
Do i = 1, points S_PHYSCS.1676
cca_rad(i) = cca(i,1) S_PHYSCS.1677
iccb_rad(i) = iccb(i) S_PHYSCS.1678
icct_rad(i) = icct(i) S_PHYSCS.1679
ccwpin_rad(i) = ccwpin(i) S_PHYSCS.1680
Do k = 1, nwet S_PHYSCS.1681
layer_cloud_rad(i,k) = layer_cloud(i,k) S_PHYSCS.1682
qcl_rad_box(i,k) = qcl(i,k) S_PHYSCS.1683
qcf_rad_box(i,k) = qcf(i,k) S_PHYSCS.1684
enddo S_PHYSCS.1685
enddo S_PHYSCS.1686
endif S_PHYSCS.1687
S_PHYSCS.1688
S_PHYSCS.1689
C Number of profiles allowed in workspace for cloud S_PHYSCS.1690
C diagnostics S_PHYSCS.1691
npdwd_cl_profile = points S_PHYSCS.1692
S_PHYSCS.1693
*IF DEF,A01_3A S_PHYSCS.1694
C S_PHYSCS.1695
C Call Edwards-Slingo Radiation code - routine found in UM S_PHYSCS.1696
C deck SWRAD3A.dk S_PHYSCS.1697
C S_PHYSCS.1698
Call R2_SWRAD(icode, S_PHYSCS.1699
C Mixing Ratios S_PHYSCS.1700
& q, co2mmr, o3, o2mmr, S_PHYSCS.1701
& points, nlevs, co2_3d, l_co2_interactive, S_PHYSCS.1702
C Pressure Fields S_PHYSCS.1703
& pstar, akh, bkh, ak, bk, S_PHYSCS.1704
C Temperatures S_PHYSCS.1705
& t, S_PHYSCS.1706
C Options for treating clouds S_PHYSCS.1707
& l_global_cloud_top, global_cloud_top, S_PHYSCS.1708
C Stratiform Cloud Fields S_PHYSCS.1709
& l_cloud_water_partition, S_PHYSCS.1710
& layer_cloud_rad, layer_cloud_rad, ! area=bulk for scm ? S_PHYSCS.1711
! (ask for advice to hadsk) S_PHYSCS.1712
& qcf_rad_box, qcl_rad_box, S_PHYSCS.1713
C Convective Cloud Fields S_PHYSCS.1714
& cca_rad,ccwpin_rad,iccb_rad, icct_rad, l_3d_cca, S_PHYSCS.1715
C Surface Fields S_PHYSCS.1716
& sal_vis, sal_nir, S_PHYSCS.1717
& land_and_ice_albedo, open_sea_albedo, ice_fract, S_PHYSCS.1718
& land_mask, snodep, S_PHYSCS.1719
C Prognostic snow albedo flag S_PHYSCS.1720
& l_snow_albedo, sal_dim, S_PHYSCS.1721
C Solar Fields S_PHYSCS.1722
& cos_zenith_angle, day_fraction, list, scs, S_PHYSCS.1723
C Aerosol Fields S_PHYSCS.1724
& l_climate_aerosol, nbl_levs, S_PHYSCS.1725
& l_use_sulpc_direct, l_use_sulpc_indirect, S_PHYSCS.1726
& sulp_dim1, sulp_dim2, S_PHYSCS.1727
C those arguments are not initialized until now ! S_PHYSCS.1728
& accum_sulphate, aitken_sulphate, diss_sulphate, S_PHYSCS.1729
& l_use_soot_direct, points, nlevs, fresh_soot, aged_soot, S_PHYSCS.1730
C Level of tropopause S_PHYSCS.1731
& trindx S_PHYSCS.1732
C Spectrum S_PHYSCS.1733
*CALL SWSARG3A S_PHYSCS.1734
& , ! Algorithmic Options S_PHYSCS.1735
*CALL SWCAVR3A S_PHYSCS.1736
& ,timestep, S_PHYSCS.1737
C General Diagnostics S_PHYSCS.1738
& osdia,oson, S_PHYSCS.1739
& csosdi,csoson, S_PHYSCS.1740
& nsssb1,nss1on, S_PHYSCS.1741
& tdss,tdsson, S_PHYSCS.1742
& csssd,csssdo, S_PHYSCS.1743
& csssu,csssuo, S_PHYSCS.1744
& lcasw,lcaswo, S_PHYSCS.1745
& ccasw,ccaswo, S_PHYSCS.1746
& tcasw,tcaswo, S_PHYSCS.1747
& clear_hr_sw,clear_hr_sw_l, S_PHYSCS.1748
& net_flux_trop_sw, l_net_flux_trop_sw, S_PHYSCS.1749
& up_flux_trop_sw, l_up_flux_trop_sw, S_PHYSCS.1750
C Microphysical Flag S_PHYSCS.1751
& l_microphysics, S_PHYSCS.1752
S_PHYSCS.1753
C Microphysical Diagnostics S_PHYSCS.1754
& re_conv, re_convl, S_PHYSCS.1755
& re_strat, re_stratl, S_PHYSCS.1756
& wgt_conv, wgt_convl, S_PHYSCS.1757
& wgt_strat, wgt_stratl, S_PHYSCS.1758
& lwp_strat, lwp_stratl, S_PHYSCS.1759
& weighted_re, weighted_re_flag, S_PHYSCS.1760
& sum_weight_re, sum_weight_re_flag, S_PHYSCS.1761
& ntot_diag, ntot_diag_flag, S_PHYSCS.1762
& strat_lwc_diag, strat_lwc_diag_flag, S_PHYSCS.1763
& so4_ccn_diag, so4_ccn_diag_flag, S_PHYSCS.1764
& cond_samp_wgt, cond_samp_wgt_flag, S_PHYSCS.1765
c Physical Dimensions S_PHYSCS.1766
& daylight_points, points, S_PHYSCS.1767
& nlevs, nclds, nwet, nozone, S_PHYSCS.1768
& points, rad_array_size, nlevs, points, S_PHYSCS.1769
& n_cca_lev, S_PHYSCS.1770
C Working Dimensions for Diagnostics S_PHYSCS.1771
& npdwd_cl_profile, S_PHYSCS.1772
C Output S_PHYSCS.1773
& ntswin,swsea,radincs) S_PHYSCS.1774
*ELSE S_PHYSCS.1775
Call SWRAD ( S_PHYSCS.1776
C Primary data inputs S_PHYSCS.1777
& q, co2mmr, o3, pstar,akh,bkh,layer_cloud_rad, S_PHYSCS.1778
& qcf_rad_box, qcl_rad_box, cca_rad, ccwpin_rad, S_PHYSCS.1779
& iccb_rad, S_PHYSCS.1780
& icct_rad, S_PHYSCS.1781
& land_and_ice_albedo, open_sea_albedo, S_PHYSCS.1782
& ice_fract,cos_zenith_angle, S_PHYSCS.1783
& day_fraction,land_mask, S_PHYSCS.1784
& list, S_PHYSCS.1785
& t, scs, S_PHYSCS.1786
C Size and control variables S_PHYSCS.1787
& swlut, timestep, S_PHYSCS.1788
& osdia, oson, S_PHYSCS.1789
& csosdi, csoson, S_PHYSCS.1790
& nsssb1,nss1on, S_PHYSCS.1791
& tdss,tdsson,csssd,csssdo,csssu,csssuo,lcasw, S_PHYSCS.1792
& lcaswo,ccasw,ccaswo,lcaar, S_PHYSCS.1793
& lcaaro,lcaarl,lcaarb, S_PHYSCS.1794
& lcaaf,lcaafo,lcaafl,lcaafb, S_PHYSCS.1795
& ccaar,ccaaro,ccaarb, S_PHYSCS.1796
& ccaaf,ccaafo,ccaafb,tcasw,tcaswo, S_PHYSCS.1797
& creff,creffo,re_strat,re_stratl,cvamt,cvamto, S_PHYSCS.1798
& wgt_strat,wgt_stratl,lwp_strat,lwp_stratl, S_PHYSCS.1799
& l_microphysics, S_PHYSCS.1800
& lca3l, lca3on, lcld3, S_PHYSCS.1801
& l_cloud_water_partition, S_PHYSCS.1802
& daylight_points, daylight_points, nlevs, nclds, nwet, S_PHYSCS.1803
& nozone, points, S_PHYSCS.1804
C Output Data S_PHYSCS.1805
& ntswin, swsea, radincs) S_PHYSCS.1806
*ENDIF S_PHYSCS.1807
endif ! (daylight_points .eq. 0) S_PHYSCS.1808
C S_PHYSCS.1809
C--------------------------------------------------------------------- S_PHYSCS.1810
C Calculate ISDIA (the incoming solar radiation at the top of S_PHYSCS.1811
C the atmosphere) every radiation timestep. (OSDIA every S_PHYSCS.1812
C radiation timestep is passed out) For diagnostics. S_PHYSCS.1813
C--------------------------------------------------------------------- S_PHYSCS.1814
C S_PHYSCS.1815
Do i = 1, points S_PHYSCS.1816
isdia(i) = sc * scs * cos_zenith_angle(i) S_PHYSCS.1817
enddo S_PHYSCS.1818
C S_PHYSCS.1819
C--------------------------------------------------------------------- S_PHYSCS.1820
C Convert temperature to potential temperature S_PHYSCS.1821
C--------------------------------------------------------------------- S_PHYSCS.1822
C S_PHYSCS.1823
Call theta_calc(theta,t,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.1824
S_PHYSCS.1825
endif ! sw_mode eq 0 or 1 S_PHYSCS.1826
S_PHYSCS.1827
If (sw_mode .eq. 1) then S_PHYSCS.1828
Call DUMPINIT( S_PHYSCS.1829
! IN dimension of dump array. S_PHYSCS.1830
& points,nprimvars, nlevs, nwet, S_PHYSCS.1831
& nbl_levs, nsoilt_levs, nsoilm_levs, ntrop, S_PHYSCS.1832
! S_PHYSCS.1833
& savedump,u,v,t,theta,q,qcl,qcf,layer_cloud, S_PHYSCS.1834
& pstar,t_deep_soil,smc,canopy,snodep, S_PHYSCS.1835
& tstar,zh,z0msea,cca,rccb,rcct,smcl) S_PHYSCS.1836
endif ! SW_MODE EQ 0 S_PHYSCS.1837
S_PHYSCS.1838
If (test .and. daycount .ge. start_diagday) then S_PHYSCS.1839
if (stepcount .ge. subdat_step1 S_PHYSCS.1840
& .and. mod(stepcount-subdat_step1,subdat_step) .eq. 0) S_PHYSCS.1841
& Call SUB_DATA( S_PHYSCS.1842
& points, nlevs, nwet S_PHYSCS.1843
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_PHYSCS.1844
& ,' After swrad, before lwrad ' S_PHYSCS.1845
& ,stepcount,yearno,day,time_string,daycount,u,v,t, S_PHYSCS.1846
& theta,q,qcl,qcf,layer_cloud,pstar,t_deep_soil,smc, S_PHYSCS.1847
& canopy,snodep,tstar,zh, S_PHYSCS.1848
& z0msea,cca,iccb,icct,smcl) S_PHYSCS.1849
endif S_PHYSCS.1850
S_PHYSCS.1851
C S_PHYSCS.1852
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1853
C LONGWAVE RADIATION - FLUXES POSITIVE DOWNWARDS (P232) S_PHYSCS.1854
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.1855
C S_PHYSCS.1856
C S_PHYSCS.1857
C lw_mode determines actions for long wave scheme S_PHYSCS.1858
C 0 = Run normally S_PHYSCS.1859
C 1 = Run for diagnostics but save dump state S_PHYSCS.1860
C 2 = Don't run S_PHYSCS.1861
C S_PHYSCS.1862
If (lw_mode .eq. 1) then S_PHYSCS.1863
Do i = 1, points S_PHYSCS.1864
Do k = 1, nprimvars S_PHYSCS.1865
savedump(i,k)=0.0 S_PHYSCS.1866
enddo S_PHYSCS.1867
enddo S_PHYSCS.1868
Call RESTART_DUMP( S_PHYSCS.1869
! IN dimensions of main arrays S_PHYSCS.1870
& points,nlevs, nwet, nprimvars, S_PHYSCS.1871
& nbl_levs, nsoilt_levs, nsoilm_levs, S_PHYSCS.1872
! S_PHYSCS.1873
& savedump,u,v,t,theta,q,qcl,qcf,layer_cloud, S_PHYSCS.1874
& pstar,t_deep_soil,smc,canopy, S_PHYSCS.1875
& snodep,tstar,zh,z0msea, S_PHYSCS.1876
& cca,iccb,icct,smcl) S_PHYSCS.1877
endif S_PHYSCS.1878
S_PHYSCS.1879
C Run LW radiation S_PHYSCS.1880
C S_PHYSCS.1881
If (lw_mode .eq. 0 .or. lw_mode .eq. 1) then S_PHYSCS.1882
Do i = 1, points S_PHYSCS.1883
If (.not. radcloud_fixed) then S_PHYSCS.1884
cca_rad(i) = cca(i,1) S_PHYSCS.1885
iccb_rad(i) = iccb(i) S_PHYSCS.1886
icct_rad(i) = icct(i) S_PHYSCS.1887
ccwpin_rad(i) = ccwpin(i) S_PHYSCS.1888
Do k = 1, nwet S_PHYSCS.1889
layer_cloud_rad(i,k) = layer_cloud(i,k) S_PHYSCS.1890
qcl_rad_box(i,k) = qcl(i,k) S_PHYSCS.1891
qcf_rad_box(i,k) = qcf(i,k) S_PHYSCS.1892
enddo S_PHYSCS.1893
endif S_PHYSCS.1894
enddo S_PHYSCS.1895
S_PHYSCS.1896
C Effective surface radiative temperature S_PHYSCS.1897
*IF DEF,A03_7A S_PHYSCS.1898
Do i = 1, points S_PHYSCS.1899
tstar_rad(i) = snow_frac(i) * jtstar_tile(i,ntype)**4 S_PHYSCS.1900
enddo S_PHYSCS.1901
Do n = 1, ntype-1 S_PHYSCS.1902
Do i = 1 , points S_PHYSCS.1903
tstar_rad(i) = S_PHYSCS.1904
& tstar_rad(i) S_PHYSCS.1905
& + (1. - snow_frac(i)) * frac(i,n)*tstar_tile(i,n)**4 S_PHYSCS.1906
enddo S_PHYSCS.1907
enddo S_PHYSCS.1908
Do i = 1, points S_PHYSCS.1909
tstar_rad(i) = tstar_rad(i)**0.25 S_PHYSCS.1910
enddo S_PHYSCS.1911
*ELSE S_PHYSCS.1912
Do i = 1, points S_PHYSCS.1913
tstar_rad(i) = tstar(i) S_PHYSCS.1914
enddo S_PHYSCS.1915
*ENDIF S_PHYSCS.1916
S_PHYSCS.1917
*IF DEF,A02_3A S_PHYSCS.1918
Call R2_LWRAD (ICODE, S_PHYSCS.1919
C Gaseous Mixing Ratios S_PHYSCS.1920
& q, co2mmr, o3, S_PHYSCS.1921
& points, nlevs, co2_3d, l_co2_interactive, S_PHYSCS.1922
& n2ommr, ch4mmr, S_PHYSCS.1923
& c11mmr, c12mmr,cfc113mmr, S_PHYSCS.1924
& hcfc22mmr, hfc125mmr, hfc134ammr, S_PHYSCS.1925
C Thermodynamic Variables S_PHYSCS.1926
& t, exner, tstar_rad, pstar, akh, bkh, ak, bk, S_PHYSCS.1927
C Options for treating clouds S_PHYSCS.1928
& l_global_cloud_top, global_cloud_top, S_PHYSCS.1929
C Stratiform Cloud Fields S_PHYSCS.1930
& l_cloud_water_partition, S_PHYSCS.1931
& layer_cloud_rad, layer_cloud_rad, ! area=bulk for SCM ? S_PHYSCS.1932
! (ask for advice from hadsk) S_PHYSCS.1933
& qcf_rad_box, qcl_rad_box, S_PHYSCS.1934
C Convective Cloud Fields S_PHYSCS.1935
& cca_rad, ccwpin_rad, iccb_rad, icct_rad, l_3d_cca, S_PHYSCS.1936
C Surface Fields S_PHYSCS.1937
& land_mask,ice_fract, S_PHYSCS.1938
& snodep, S_PHYSCS.1939
C Aerosol Fields S_PHYSCS.1940
& l_climate_aerosol, nbl_levs, S_PHYSCS.1941
& l_use_sulpc_direct, l_use_sulpc_indirect, S_PHYSCS.1942
& sulp_dim1, sulp_dim2, S_PHYSCS.1943
C Those arguments are not initialized until now! S_PHYSCS.1944
& accum_sulphate, aitken_sulphate, diss_sulphate, S_PHYSCS.1945
& l_use_soot_direct, points, nlevs, fresh_soot, aged_soot, S_PHYSCS.1946
C Level of tropopause S_PHYSCS.1947
& trindx S_PHYSCS.1948
C S_PHYSCS.1949
C Spectrum S_PHYSCS.1950
*CALL LWSARG3A S_PHYSCS.1951
& , ! Algorithmic Options S_PHYSCS.1952
*CALL LWCAVR3A S_PHYSCS.1953
C General Diagnostics S_PHYSCS.1954
& ,timestep, S_PHYSCS.1955
& tca, tcaon, S_PHYSCS.1956
& csolrd, csolon, S_PHYSCS.1957
& sfdn, sfdnon, S_PHYSCS.1958
& cssfdn, cssdon, S_PHYSCS.1959
& clear_hr_lw, clear_hr_lw_l, S_PHYSCS.1960
& net_flux_trop_lw, l_net_flux_trop_lw, S_PHYSCS.1961
& down_flux_trop_lw, l_down_flux_trop_lw, S_PHYSCS.1962
C Physical Dimensions S_PHYSCS.1963
& points,nlevs,nclds, S_PHYSCS.1964
& nwet, nozone,points, S_PHYSCS.1965
& rad_array_size,nlevs,points, S_PHYSCS.1966
& n_cca_lev, S_PHYSCS.1967
C Output Fields S_PHYSCS.1968
& olr,lwsea, lwout) S_PHYSCS.1969
*ELSE S_PHYSCS.1970
Call LWRAD (q, co2mmr, o3, S_PHYSCS.1971
& n2ommr, ch4mmr, c11mmr, c12mmr, S_PHYSCS.1972
& t, exner, tstar_rad, pstar, akh, S_PHYSCS.1973
& bkh,ak, bk,ice_fract,layer_cloud_rad, S_PHYSCS.1974
& qcf_rad_box, qcl_rad_box, cca_rad, ccwpin_rad, S_PHYSCS.1975
& iccb_rad,icct_rad,land_mask,timestep,lwlut, S_PHYSCS.1976
& tca, tcaon,csolrd, csolon, sfdn, S_PHYSCS.1977
& sfdnon,cssfdn, cssdon, S_PHYSCS.1978
& l_cloud_water_partition, S_PHYSCS.1979
& points, nlevs, nclds, S_PHYSCS.1980
& nwet, nozone,points, S_PHYSCS.1981
& olr, lwsea, lwout) S_PHYSCS.1982
C S_PHYSCS.1983
*ENDIF S_PHYSCS.1984
endif ! lw_mode S_PHYSCS.1985
S_PHYSCS.1986
C If LWRAD is run for diagnostics only, save the prognostics. S_PHYSCS.1987
S_PHYSCS.1988
If (lw_mode .eq. 1) then S_PHYSCS.1989
Call DUMPINIT( S_PHYSCS.1990
! IN dimension of dump array. S_PHYSCS.1991
& points, nprimvars, nlevs, nwet, S_PHYSCS.1992
& nbl_levs, nsoilt_levs, nsoilm_levs, ntrop, S_PHYSCS.1993
! S_PHYSCS.1994
& savedump,u,v,t,theta,q,qcl,qcf,layer_cloud, S_PHYSCS.1995
& pstar,t_deep_soil,smc,canopy,snodep, S_PHYSCS.1996
& tstar,zh,z0msea,cca,rccb,rcct,smcl) S_PHYSCS.1997
endif S_PHYSCS.1998
endif ! NTRAD1 S_PHYSCS.1999
C S_PHYSCS.2000
C--------------------------------------------------------------------- S_PHYSCS.2001
C Now find COS_ZENITH_ANGLE & LIT for the current physics S_PHYSCS.2002
C timestep and use them to find the current SW heating rates & S_PHYSCS.2003
C surface flux: S_PHYSCS.2004
C--------------------------------------------------------------------- S_PHYSCS.2005
C S_PHYSCS.2006
start_rad = time_init + (stepcount-1) * timestep S_PHYSCS.2007
start_rad = mod(start_rad,86400.0) S_PHYSCS.2008
C S_PHYSCS.2009
Call solang ( S_PHYSCS.2010
C input constants S_PHYSCS.2011
& sindec, start_rad, timestep, S_PHYSCS.2012
C row and column dependent constants S_PHYSCS.2013
& sinlat, longrad, S_PHYSCS.2014
C size variables S_PHYSCS.2015
& points, S_PHYSCS.2016
C output fields S_PHYSCS.2017
& day_fraction, cos_zenith_angle) S_PHYSCS.2018
C S_PHYSCS.2019
S_PHYSCS.2020
Do i = 1, points S_PHYSCS.2021
cos_zenith_angle(i)= cos_zenith_angle(i) * day_fraction(i) S_PHYSCS.2022
enddo S_PHYSCS.2023
Do k = 1, nlevs S_PHYSCS.2024
Do i = 1, points S_PHYSCS.2025
swout(i,k) = radincs(i,k) * cos_zenith_angle(i) S_PHYSCS.2026
enddo S_PHYSCS.2027
enddo S_PHYSCS.2028
S_PHYSCS.2029
C Calculate the SW heating rates for layers 1 to nbl_levs S_PHYSCS.2030
C for A03_6A S_PHYSCS.2031
C & Add LW heating rates for layers 1 to nbl_levs for output S_PHYSCS.2032
C for A03_6A S_PHYSCS.2033
If (l_radheat) then S_PHYSCS.2034
Do k = 1, nbl_levs S_PHYSCS.2035
Do i = 1, points S_PHYSCS.2036
radheat_rate(i,k) = S_PHYSCS.2037
& (radincs(i,k) * cos_zenith_angle(i) + lwout(i,k)) S_PHYSCS.2038
& / timestep S_PHYSCS.2039
enddo S_PHYSCS.2040
enddo S_PHYSCS.2041
else ! avoid to have undefined values S_PHYSCS.2042
Do k = 1, nbl_levs S_PHYSCS.2043
Do i = 1, points S_PHYSCS.2044
radheat_rate(i,k) = 0.0 S_PHYSCS.2045
enddo S_PHYSCS.2046
enddo S_PHYSCS.2047
endif S_PHYSCS.2048
S_PHYSCS.2049
C Set up net down surface SW radiation flux for snow-free and S_PHYSCS.2050
C snow-covered fractions of gridboxes (MOSES II) & S_PHYSCS.2051
C Set up total net down surface radiation flux for snow-free and S_PHYSCS.2052
C snow-covered fractions of gridboxes S_PHYSCS.2053
*IF DEF,A03_7A S_PHYSCS.2054
Do i = 1, points S_PHYSCS.2055
If ( land_and_ice_albedo(i,1) .lt. 1. ) S_PHYSCS.2056
& rad_no_snow(i) = S_PHYSCS.2057
& (1. - albsnf_nsite(i)) * swout(i,1) S_PHYSCS.2058
& / (1. - land_and_ice_albedo(i,1)) S_PHYSCS.2059
& + lwout(i,1) + sbcon * tstar_rad(i)**4 S_PHYSCS.2060
Do n = 1, ntype-1 S_PHYSCS.2061
rad_no_snow(i) = rad_no_snow(i) - S_PHYSCS.2062
& frac(i,n)*sbcon*tstar_tile(i,n))**4 S_PHYSCS.2063
enddo S_PHYSCS.2064
enddo S_PHYSCS.2065
if ( snow_frac(i) .gt. 0. ) S_PHYSCS.2066
& rad_snow(i) = S_PHYSCS.2067
& ( swout(i,1) - (1. - snow_frac(i))*rad_no_snow(i) ) S_PHYSCS.2068
& / snow_frac(i) S_PHYSCS.2069
& - snow_frac(i) * sbcon *tstar_tile(i,ntype)**4 S_PHYSCS.2070
enddo S_PHYSCS.2071
*ENDIF S_PHYSCS.2072
S_PHYSCS.2073
C S_PHYSCS.2074
C Calculate photosynth_act_rad every physics timestep used by S_PHYSCS.2075
C MOSES in the boundary layer S_PHYSCS.2076
C S_PHYSCS.2077
If (l_snow_albedo) then S_PHYSCS.2078
Do i = 1, points S_PHYSCS.2079
photosynth_act_rad(i) = radincs(i,nlevs+2) * S_PHYSCS.2080
& cos_zenith_angle(i) S_PHYSCS.2081
enddo S_PHYSCS.2082
endif S_PHYSCS.2083
C S_PHYSCS.2084
C--------------------------------------------------------------------- S_PHYSCS.2085
C Add SW and LW heating increments to temp if SWRAD or LWRAD are S_PHYSCS.2086
C run fully. S_PHYSCS.2087
C--------------------------------------------------------------------- S_PHYSCS.2088
C S_PHYSCS.2089
Do i = 1, points S_PHYSCS.2090
If (sw_mode .eq. 0 .and. lw_mode .eq. 0) then S_PHYSCS.2091
Do k = 1, nlevs S_PHYSCS.2092
t(i,k) = t(i,k) + swout(i,k+1) S_PHYSCS.2093
t(i,k) = t(i,k) + lwout(i,k+1) S_PHYSCS.2094
enddo S_PHYSCS.2095
elseif (sw_mode .eq. 0) then S_PHYSCS.2096
Do k = 1, nlevs S_PHYSCS.2097
t(i,k) = t(i,k) + swout(i,k+1) S_PHYSCS.2098
enddo S_PHYSCS.2099
elseif (lw_mode .eq. 0) then S_PHYSCS.2100
Do k = 1, nlevs S_PHYSCS.2101
t(i,k) = t(i,k)+ lwout(i,k+1) S_PHYSCS.2102
enddo S_PHYSCS.2103
endif S_PHYSCS.2104
enddo S_PHYSCS.2105
S_PHYSCS.2106
C S_PHYSCS.2107
C--------------------------------------------------------------------- S_PHYSCS.2108
C Compute net surface radiation S_PHYSCS.2109
C--------------------------------------------------------------------- S_PHYSCS.2110
C S_PHYSCS.2111
Do i = 1, points S_PHYSCS.2112
If (land_mask(i)) then S_PHYSCS.2113
net_rad(i) = lwout(i,1) + swout(i,1) S_PHYSCS.2114
else S_PHYSCS.2115
net_rad(i) = lwsea(i) - swsea(i) S_PHYSCS.2116
endif S_PHYSCS.2117
enddo S_PHYSCS.2118
C S_PHYSCS.2119
C--------------------------------------------------------------------- S_PHYSCS.2120
C Store diagnostics if observational forcing S_PHYSCS.2121
C--------------------------------------------------------------------- S_PHYSCS.2122
C S_PHYSCS.2123
If (prindump_obs) then S_PHYSCS.2124
Do i = 1, points S_PHYSCS.2125
Do k = 1, nlevs S_PHYSCS.2126
dap1(i,12,k) = dap1(i,12,k) + swout(i,k+1)/timestep S_PHYSCS.2127
dap1(i,22,k) = dap1(i,22,k) + lwout(i,k+1)/timestep S_PHYSCS.2128
enddo S_PHYSCS.2129
enddo S_PHYSCS.2130
endif S_PHYSCS.2131
C S_PHYSCS.2132
C--------------------------------------------------------------------- S_PHYSCS.2133
C Convert temperature to potential temperature S_PHYSCS.2134
C Put T and Q in temporary store if observational forcing used S_PHYSCS.2135
C--------------------------------------------------------------------- S_PHYSCS.2136
C S_PHYSCS.2137
Call theta_calc(theta,t,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.2138
If (obs) then S_PHYSCS.2139
Do k = 1, nlevs S_PHYSCS.2140
Do i = 1, points S_PHYSCS.2141
ttmp(i,k) = t(i,k) S_PHYSCS.2142
enddo S_PHYSCS.2143
enddo S_PHYSCS.2144
Do k = 1, nwet S_PHYSCS.2145
Do i = 1, points S_PHYSCS.2146
qtmp(i,k) = q(i,k) S_PHYSCS.2147
enddo S_PHYSCS.2148
enddo S_PHYSCS.2149
endif ! obs S_PHYSCS.2150
S_PHYSCS.2151
C S_PHYSCS.2152
C--------------------------------------------------------------------- S_PHYSCS.2153
C Write out sub-timestep diagnostics S_PHYSCS.2154
C--------------------------------------------------------------------- S_PHYSCS.2155
C S_PHYSCS.2156
If (test .and. daycount .ge. start_diagday) then S_PHYSCS.2157
If (stepcount .ge. subdat_step1 S_PHYSCS.2158
& .and. mod(stepcount-subdat_step1,subdat_step) .eq. 0) S_PHYSCS.2159
& Call SUB_DATA( S_PHYSCS.2160
& points, nlevs, nwet S_PHYSCS.2161
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_PHYSCS.2162
& ,' After lwrad, before bdy ' S_PHYSCS.2163
& ,stepcount,yearno,day,time_string,daycount,u,v,t, S_PHYSCS.2164
& theta,q,qcl,qcf,layer_cloud,pstar,t_deep_soil,smc, S_PHYSCS.2165
& canopy,snodep,tstar,zh, S_PHYSCS.2166
& z0msea,cca,iccb,icct,smcl) S_PHYSCS.2167
endif S_PHYSCS.2168
C S_PHYSCS.2169
S_PHYSCS.2170
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2171
C Boundary layer S_PHYSCS.2172
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2173
C S_PHYSCS.2174
C bl_mode determines actions for boundary layer scheme S_PHYSCS.2175
C 0 = Run normally S_PHYSCS.2176
C 1 = Run for diagnostics but save dump state S_PHYSCS.2177
C 2 = Don't run S_PHYSCS.2178
C S_PHYSCS.2179
If (bl_mode .eq. 1) then S_PHYSCS.2180
Do k = 1, nprimvars S_PHYSCS.2181
Do i = 1, points S_PHYSCS.2182
savedump(i,k) = 0.0 S_PHYSCS.2183
enddo S_PHYSCS.2184
enddo S_PHYSCS.2185
S_PHYSCS.2186
S_PHYSCS.2187
Call RESTART_DUMP( S_PHYSCS.2188
! IN dimensions of main arrays S_PHYSCS.2189
& points, nlevs, nwet, nprimvars, S_PHYSCS.2190
& nbl_levs, nsoilt_levs, nsoilm_levs, S_PHYSCS.2191
! S_PHYSCS.2192
& savedump,u,v,t,theta,q,qcl,qcf,layer_cloud, S_PHYSCS.2193
& pstar,t_deep_soil,smc,canopy, S_PHYSCS.2194
& snodep,tstar,zh,z0msea, S_PHYSCS.2195
& cca,iccb,icct,smcl) S_PHYSCS.2196
endif S_PHYSCS.2197
S_PHYSCS.2198
If (bl_mode .eq. 0 .or. bl_mode .eq. 1) then S_PHYSCS.2199
C S_PHYSCS.2200
C--------------------------------------------------------------------- S_PHYSCS.2201
C Set up indices used in BL S_PHYSCS.2202
C--------------------------------------------------------------------- S_PHYSCS.2203
C S_PHYSCS.2204
land_pts = 0 S_PHYSCS.2205
Do i = 1, points S_PHYSCS.2206
C Test on soil moisture concentration at saturation S_PHYSCS.2207
If (land_mask(i)) ! land points S_PHYSCS.2208
& then S_PHYSCS.2209
land_pts = land_pts + 1 S_PHYSCS.2210
land_index(land_pts) = i S_PHYSCS.2211
endif S_PHYSCS.2212
enddo S_PHYSCS.2213
C S_PHYSCS.2214
gather = .false. ! no need to gather sea-ice points S_PHYSCS.2215
C S_PHYSCS.2216
Call BL_INTCT( S_PHYSCS.2217
! IN values defining field dimensions and subset to be processed : S_PHYSCS.2218
& points,points,land_pts,land_pts,npft S_PHYSCS.2219
& ,1,1,1,points S_PHYSCS.2220
! IN values defining vertical grid of model atmosphere : S_PHYSCS.2221
& ,nbl_levs,nlevs,ak,bk,akh,bkh,delta_ak,delta_bk S_PHYSCS.2222
& ,exner S_PHYSCS.2223
! IN soil/vegetation/land surface Data : S_PHYSCS.2224
& ,land_mask,gather,land_index S_PHYSCS.2225
& ,nsoilt_levs,nsoilm_levs S_PHYSCS.2226
& ,canht_nsite,canopy,catch_nsite,hcap_nsite S_PHYSCS.2227
& ,hcon_nsite,lai_nsite,layer_depth S_PHYSCS.2228
& ,snodep,resist_nsite,rootdep_nsite,smc S_PHYSCS.2229
& ,v_crit_nsite,v_sat_nsite,v_wilt_nsite S_PHYSCS.2230
& ,veg_frac_nsite,z0_nsite,sil_orog_land,l_z0_orog S_PHYSCS.2231
& ,ho2r2_orog S_PHYSCS.2232
! IN sea/sea-ice Data : S_PHYSCS.2233
& ,di,ice_fract,u_0,v_0 S_PHYSCS.2234
! IN cloud Data : S_PHYSCS.2235
& ,layer_cloud,qcf,qcl S_PHYSCS.2236
& ,cca,iccb,icct S_PHYSCS.2237
! IN everything not covered so far : S_PHYSCS.2238
& ,radheat_rate, points S_PHYSCS.2239
& ,co2mmr,photosynth_act_rad,pstar,net_rad S_PHYSCS.2240
& ,timestep,l_rmbl,l_bl_lspice,l_mom,l_mixlen S_PHYSCS.2241
! INOUT data : S_PHYSCS.2242
& ,gs,q,sthf,sthu,t,t_deep_soil,tsi,tstar,u,v,z0msea S_PHYSCS.2243
! OUT diagnostic not requiring STASH flags : S_PHYSCS.2244
& ,cd,ch,e_sea,etran,fqw,ftl,gpp,h_sea S_PHYSCS.2245
& ,npp,resp_p,rhokh,rhokm,rib,sea_ice_htf S_PHYSCS.2246
& ,taux,tauy,vshr,zht S_PHYSCS.2247
& ,epot,fsmc S_PHYSCS.2248
! OUT diagnostic requiring STASH flags : S_PHYSCS.2249
& ,fme,sice_mlt_htf,snomlt_surf_htf,latent_heat S_PHYSCS.2250
& ,q1p5m,t1p5m,u10m,v10m S_PHYSCS.2251
! (IN) STASH flags :- S_PHYSCS.2252
& ,sfme,simlt,smlt,slh,sq1p5,st1p5,su10,sv10 S_PHYSCS.2253
! OUT Data required for tracer mixing : S_PHYSCS.2254
& ,rho_aresist,aresist,resist_b S_PHYSCS.2255
& ,nrml S_PHYSCS.2256
! OUT Data required for 4D_VAR : S_PHYSCS.2257
& ,rho_cd_modv1,rho_km S_PHYSCS.2258
! OUT data required elsewhere in UM system : S_PHYSCS.2259
& ,bl_type_1,bl_type_2,bl_type_3,bl_type_4,bl_type_5,bl_type_6 S_PHYSCS.2260
& ,can_evap,subl_snow,soil_evap,ext,snow_melt S_PHYSCS.2261
& ,surf_ht_flux,zh,t1_sd,q1_sd,error, S_PHYSCS.2262
! Additional arguments for 7A boundary layer (MOSES II) S_PHYSCS.2263
! IN S_PHYSCS.2264
& l_phenol,l_triffid,l_neg_tstar, S_PHYSCS.2265
& canht_ft,canopy_tile,catch_tile,cs,lai_ft, S_PHYSCS.2266
& frac,snow_frac,rad_no_snow,rad_snow,tstar_snow,z0v_tile, S_PHYSCS.2267
& co2_3d,points,l_co2_interactive, S_PHYSCS.2268
! INOUT S_PHYSCS.2269
& tstar_tile, S_PHYSCS.2270
& g_leaf_acc,npp_ft_acc,resp_w_ft_acc,resp_s_acc, S_PHYSCS.2271
! OUT S_PHYSCS.2272
& ecan_tile,esoil_tile,ftl_tile, S_PHYSCS.2273
& g_leaf,gpp_ft,npp_ft,resp_p_ft,resp_s,resp_w_ft, S_PHYSCS.2274
& rho_aresist_tile,aresist_tile,resist_b_tile, S_PHYSCS.2275
& rib_tile,snow_surf_htf,soil_surf_htf, S_PHYSCS.2276
& tile_index,tile_pts,tile_frac S_PHYSCS.2277
! LOGICAL LTIMER S_PHYSCS.2278
& ,ltimer S_PHYSCS.2279
& ,factor_rhokh,OBS S_PHYSCS.2280
& ) S_PHYSCS.2281
endif ! bl_mode = 0 or 1 S_PHYSCS.2282
S_PHYSCS.2283
! If the mixed phase precipitation scheme is used then T and Q are S_PHYSCS.2284
! required to contain T liquid and Q(vapour+liquid) but at this stage S_PHYSCS.2285
! will actually contain T liquid ice and Q(vapour+liquid+ice) if S_PHYSCS.2286
! L_BL_LSPICE is false. S_PHYSCS.2287
If (l_lspice .and. (.not. l_bl_lspice)) then S_PHYSCS.2288
! T and Q do not contain the correct values if L_BL_LSPICE is false S_PHYSCS.2289
! and the mixed phase precipitation scheme is selected. Correct them S_PHYSCS.2290
! so that T(liquid+ice) becomes T(liquid) and S_PHYSCS.2291
! Q(vapour+liquid+ice) becomes Q(vapour+liquid). S_PHYSCS.2292
Call bl_lsp(points,points,points,1,nbl_levs,qcf,q,T) S_PHYSCS.2293
endif S_PHYSCS.2294
! S_PHYSCS.2295
S_PHYSCS.2296
S_PHYSCS.2297
S_PHYSCS.2298
C Store CANHT and LAI as diagnostics S_PHYSCS.2299
Do i = 1, points S_PHYSCS.2300
canopy_ht(i) = canht_nsite(i) S_PHYSCS.2301
leaf_ai(i) = lai_nsite(i) S_PHYSCS.2302
enddo S_PHYSCS.2303
C S_PHYSCS.2304
C If there is no large-scale forcing reset U and V to S_PHYSCS.2305
C initial values S_PHYSCS.2306
C S_PHYSCS.2307
If (noforce) then S_PHYSCS.2308
Do k = 1, nlevs S_PHYSCS.2309
Do i = 1, points S_PHYSCS.2310
u(i,k) = ui(i,k) S_PHYSCS.2311
v(i,k) = vi(i,k) S_PHYSCS.2312
enddo S_PHYSCS.2313
enddo S_PHYSCS.2314
endif S_PHYSCS.2315
Do i = 1, points S_PHYSCS.2316
sens_heat(i) = ftl(i,1) S_PHYSCS.2317
enddo S_PHYSCS.2318
C S_PHYSCS.2319
C--------------------------------------------------------------------- S_PHYSCS.2320
C Check for error in argument list S_PHYSCS.2321
C--------------------------------------------------------------------- S_PHYSCS.2322
C S_PHYSCS.2323
Call erroneous(error,' bdy_layr ') S_PHYSCS.2324
If (error .gt. 0) Stop S_PHYSCS.2325
C S_PHYSCS.2326
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2327
C Call LS_CLD again, now to convert TL1P5M and QW1P5M from S_PHYSCS.2328
C BDY_LAYR to T and Q respectively. S_PHYSCS.2329
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2330
C S_PHYSCS.2331
Call GLUE_CLD( S_PHYSCS.2332
& ak1p5m,bk1p5m,pstar,rhcrit,1,rhcpt,points,points, S_PHYSCS.2333
& t1p5m,layer_cloud1p5m,q1p5m,qcf1p5m,qcl1p5m, S_PHYSCS.2334
& ls_grid_qc,ls_bs, S_PHYSCS.2335
& error) S_PHYSCS.2336
S_PHYSCS.2337
C S_PHYSCS.2338
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2339
C Call LS_CLD again, now to convert tl and qw from BDY_LAYR S_PHYSCS.2340
C to t and q respectively S_PHYSCS.2341
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2342
C S_PHYSCS.2343
Call GLUE_CLD( S_PHYSCS.2344
& ak,bk,pstar,rhcrit,nbl_levs,rhcpt,points,points, S_PHYSCS.2345
& t,layer_cloud,q,qcf,qcl, S_PHYSCS.2346
& ls_grid_qc,ls_bs, S_PHYSCS.2347
& error) S_PHYSCS.2348
C S_PHYSCS.2349
C--------------------------------------------------------------------- S_PHYSCS.2350
C Convert temperature to theta S_PHYSCS.2351
C--------------------------------------------------------------------- S_PHYSCS.2352
Call theta_calc(theta,t,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.2353
C S_PHYSCS.2354
C Write out sub-timestep diagnostics S_PHYSCS.2355
C--------------------------------------------------------------------- S_PHYSCS.2356
C S_PHYSCS.2357
S_PHYSCS.2358
If (test .and. daycount .ge. start_diagday) then S_PHYSCS.2359
If (stepcount .ge. subdat_step1 S_PHYSCS.2360
& .and. mod(stepcount-subdat_step1,subdat_step) .eq. 0) S_PHYSCS.2361
& Call SUB_DATA( S_PHYSCS.2362
& points, nlevs, nwet S_PHYSCS.2363
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_PHYSCS.2364
& ,' After bdy,before ls_ppn ' S_PHYSCS.2365
& ,stepcount,yearno,day,time_string,daycount,u,v,t, S_PHYSCS.2366
& theta,q,qcl,qcf,layer_cloud,pstar,t_deep_soil,smc, S_PHYSCS.2367
& canopy,snodep,tstar,zh, S_PHYSCS.2368
& z0msea,cca,iccb,icct,smcl) S_PHYSCS.2369
endif S_PHYSCS.2370
C--------------------------------------------------------------------- S_PHYSCS.2371
C Store diagnostics for OBS S_PHYSCS.2372
C--------------------------------------------------------------------- S_PHYSCS.2373
C S_PHYSCS.2374
If (prindump_obs) then S_PHYSCS.2375
c S_PHYSCS.2376
Do i = 1, points S_PHYSCS.2377
Do k = 1, nlevs S_PHYSCS.2378
press(i,k) = ak(k) + bk(k)*pstar(i) S_PHYSCS.2379
enddo S_PHYSCS.2380
Do k = 1, nwet S_PHYSCS.2381
Call qsat(qs(i,k), t(i,k), press(i,k), 1) S_PHYSCS.2382
dap1(i,9,k) = dap1(i,9,k) + q(i,k) / qs(i,k) S_PHYSCS.2383
dap1(i,14,k) = qcl(i,k) * 1000.0 S_PHYSCS.2384
dap1(i,15,k) = qcf(i,k) * 1000.0 S_PHYSCS.2385
dap1(i,16,k) = layer_cloud(i,k) S_PHYSCS.2386
dap1(i,21,k) = dap1(i,21,k) S_PHYSCS.2387
& + ((q(i,k)-qtmp(i,k))*1000.0) / timestep S_PHYSCS.2388
qtmp(i,k) = q(i,k) S_PHYSCS.2389
enddo S_PHYSCS.2390
C S_PHYSCS.2391
Do k = 1, nlevs S_PHYSCS.2392
dap1(i,11,k) = dap1(i,11,k) + (t(i,k)-ttmp(i,k))/timestep S_PHYSCS.2393
ttmp(i,k)= t(i,k) S_PHYSCS.2394
enddo S_PHYSCS.2395
enddo S_PHYSCS.2396
endif ! PRINDUMP_OBS S_PHYSCS.2397
S_PHYSCS.2398
If (bl_mode .eq. 1) then S_PHYSCS.2399
Call dumpinit( S_PHYSCS.2400
! in dimension of dump array. S_PHYSCS.2401
& points, nprimvars, nlevs, nwet, S_PHYSCS.2402
& nbl_levs, nsoilt_levs, nsoilm_levs, ntrop, S_PHYSCS.2403
! S_PHYSCS.2404
& savedump,u,v,t,theta,q,qcl,qcf,layer_cloud, S_PHYSCS.2405
& pstar,t_deep_soil,smc,canopy,snodep, S_PHYSCS.2406
& tstar,zh,z0msea,cca,rccb,rcct,smcl) S_PHYSCS.2407
endif S_PHYSCS.2408
C S_PHYSCS.2409
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2410
C Large scale precipitation S_PHYSCS.2411
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2412
C S_PHYSCS.2413
C S_PHYSCS.2414
C ppn_mode determines actions for precipitation scheme S_PHYSCS.2415
C 0 = Run normally S_PHYSCS.2416
C 1 = Run for diagnostics but save dump state S_PHYSCS.2417
C 2 = Don't run S_PHYSCS.2418
C S_PHYSCS.2419
If (ppn_mode .eq. 1) then S_PHYSCS.2420
Do k = 1, nprimvars S_PHYSCS.2421
Do i = 1, points S_PHYSCS.2422
savedump(i,k) = 0.0 S_PHYSCS.2423
enddo S_PHYSCS.2424
enddo S_PHYSCS.2425
Call RESTART_DUMP( S_PHYSCS.2426
! IN dimensions of main arrays S_PHYSCS.2427
& points, nlevs, nwet, nprimvars, S_PHYSCS.2428
& nbl_levs, nsoilt_levs, nsoilm_levs, S_PHYSCS.2429
! S_PHYSCS.2430
& savedump,u,v,t,theta,q,qcl,qcf,layer_cloud, S_PHYSCS.2431
& pstar,t_deep_soil,smc,canopy, S_PHYSCS.2432
& snodep,tstar,zh,z0msea, S_PHYSCS.2433
& cca,iccb,icct,smcl) S_PHYSCS.2434
endif S_PHYSCS.2435
S_PHYSCS.2436
If (ppn_mode .eq. 0 .or. ppn_mode .eq. 1) then S_PHYSCS.2437
S_PHYSCS.2438
Call GLUE_LSPP( S_PHYSCS.2439
& ak,bk,layer_cloud,delta_ak,delta_bk,pstar,timestep S_PHYSCS.2440
& ,land_mask,cw_sea,cw_land S_PHYSCS.2441
& ,ls_grid_qc,ls_bs S_PHYSCS.2442
& ,rhcrit, rhcpt, l_rhcpt S_PHYSCS.2443
& ,nwet,points S_PHYSCS.2444
& ,points,1,points,1,nbl_levs,q,qcf,qcl,t S_PHYSCS.2445
& ,so2,l_sulpc_so2 S_PHYSCS.2446
& ,nh3,l_sulpc_nh3 S_PHYSCS.2447
& ,so4_ait,so4_acc,so4_dis S_PHYSCS.2448
& ,aged_soot ! inout S_PHYSCS.2449
& ,l_soot S_PHYSCS.2450
& ,aerosol, l_murk, ls_rain, ls_snow, lsrain3d, lssnow3d S_PHYSCS.2451
& ,lscav_so2,lscav_so4ait,lscav_so4acc,lscav_so4dis S_PHYSCS.2452
& ,lscav_nh3 S_PHYSCS.2453
& ,lscav_agedsoot ! inout S_PHYSCS.2454
& ,error S_PHYSCS.2455
& ) S_PHYSCS.2456
c S_PHYSCS.2457
endif S_PHYSCS.2458
If (ppn_mode .eq. 1) then S_PHYSCS.2459
Call DUMPINIT( S_PHYSCS.2460
! IN dimension of dump array. S_PHYSCS.2461
& points,nprimvars, nlevs, nwet, S_PHYSCS.2462
& nbl_levs, nsoilt_levs, nsoilm_levs, ntrop, S_PHYSCS.2463
! S_PHYSCS.2464
& savedump,u,v,t,theta,q,qcl,qcf,layer_cloud, S_PHYSCS.2465
& pstar,t_deep_soil,smc,canopy,snodep, S_PHYSCS.2466
& tstar,zh,z0msea,cca,rccb,rcct,smcl) S_PHYSCS.2467
endif S_PHYSCS.2468
C--------------------------------------------------------------------- S_PHYSCS.2469
C Check for error in argument list S_PHYSCS.2470
C--------------------------------------------------------------------- S_PHYSCS.2471
C S_PHYSCS.2472
Call erroneous(error,' ls_ppn ') S_PHYSCS.2473
If (error .gt. 0) Stop S_PHYSCS.2474
C S_PHYSCS.2475
C--------------------------------------------------------------------- S_PHYSCS.2476
C Convert temperature to potential temperature S_PHYSCS.2477
C--------------------------------------------------------------------- S_PHYSCS.2478
C S_PHYSCS.2479
Call theta_calc(theta,t,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.2480
C S_PHYSCS.2481
C--------------------------------------------------------------------- S_PHYSCS.2482
C Write out sub-timestep diagnostics S_PHYSCS.2483
C--------------------------------------------------------------------- S_PHYSCS.2484
C S_PHYSCS.2485
S_PHYSCS.2486
If (test .and. daycount .ge. start_diagday) then S_PHYSCS.2487
If (stepcount .ge. subdat_step1 S_PHYSCS.2488
& .and. mod(stepcount-subdat_step1, subdat_step) .eq. 0) S_PHYSCS.2489
& Call SUB_DATA( S_PHYSCS.2490
& points, nlevs, nwet S_PHYSCS.2491
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_PHYSCS.2492
& ,' After lsp, before convect ' S_PHYSCS.2493
& ,stepcount,yearno,day,time_string,daycount,u,v,t, S_PHYSCS.2494
& theta,q,qcl,qcf,layer_cloud,pstar,t_deep_soil,smc, S_PHYSCS.2495
& canopy,snodep,tstar,zh, S_PHYSCS.2496
& z0msea,cca,iccb,icct,smcl) S_PHYSCS.2497
endif S_PHYSCS.2498
C S_PHYSCS.2499
C--------------------------------------------------------------------- S_PHYSCS.2500
C Store diagnostics for OBS S_PHYSCS.2501
C--------------------------------------------------------------------- S_PHYSCS.2502
C S_PHYSCS.2503
If (prindump_obs) then S_PHYSCS.2504
Do i = 1, points S_PHYSCS.2505
Do k = 1, nlevs S_PHYSCS.2506
dap1(i,30,k) = dap1(i,30,k) + (t(i,k)-ttmp(i,k))/timestep S_PHYSCS.2507
dap1(i,7,k) = dap1(k,7,i) + t(i,k) S_PHYSCS.2508
enddo S_PHYSCS.2509
Do k = 1, nwet S_PHYSCS.2510
dap1(i,31,k) = dap1(i,31,k) S_PHYSCS.2511
& + ((q(i,k)-qtmp(i,k))*1000.0) / timestep S_PHYSCS.2512
dap1(i,8,k) = dap1(i,8,k) + q(i,k)*1000.0 S_PHYSCS.2513
enddo S_PHYSCS.2514
enddo S_PHYSCS.2515
endif ! prindump_obs S_PHYSCS.2516
If (obs) then S_PHYSCS.2517
Do i = 1, points S_PHYSCS.2518
Do k = 1, nlevs S_PHYSCS.2519
ttmp(i,k) = t(i,k) S_PHYSCS.2520
enddo S_PHYSCS.2521
Do k = 1, nwet S_PHYSCS.2522
qtmp(i,k) = q(i,k) S_PHYSCS.2523
enddo S_PHYSCS.2524
enddo S_PHYSCS.2525
endif ! obs S_PHYSCS.2526
C S_PHYSCS.2527
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2528
C Convection S_PHYSCS.2529
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2530
C S_PHYSCS.2531
C S_PHYSCS.2532
C conv_mode determines actions for convection scheme S_PHYSCS.2533
C 0 = Run normally S_PHYSCS.2534
C 1 = Run for diagnostics every S_PHYSCS.2535
C radiation timestep but save dump state S_PHYSCS.2536
C (except CCA,ICCB and ICCT) S_PHYSCS.2537
C 2 = Don't run S_PHYSCS.2538
C S_PHYSCS.2539
If (conv_mode .eq. 1 .and. stepcount.ge.ntrad1 S_PHYSCS.2540
& .and. mod(stepcount-ntrad1,ntrad) .eq. 0) then S_PHYSCS.2541
S_PHYSCS.2542
Do i = 1, points S_PHYSCS.2543
Do k = 1, nprimvars S_PHYSCS.2544
savedump(i,k) = 0.0 S_PHYSCS.2545
enddo S_PHYSCS.2546
enddo S_PHYSCS.2547
Call RESTART_DUMP( S_PHYSCS.2548
! IN dimensions of main arrays S_PHYSCS.2549
& points, nlevs, nwet, nprimvars, S_PHYSCS.2550
& nbl_levs, nsoilt_levs, nsoilm_levs, S_PHYSCS.2551
! S_PHYSCS.2552
& savedump, u, v, t, theta, q, qcl, qcf, layer_cloud, S_PHYSCS.2553
& pstar, t_deep_soil, smc, canopy, S_PHYSCS.2554
& snodep, tstar, zh, z0msea, S_PHYSCS.2555
& cca, iccb, icct, smcl) S_PHYSCS.2556
endif S_PHYSCS.2557
S_PHYSCS.2558
If (conv_mode .eq. 0 S_PHYSCS.2559
& .or. (conv_mode .eq. 1 .and. stepcount .ge. ntrad1 S_PHYSCS.2560
& .and .mod(stepcount-ntrad1,ntrad) .eq. 0 ) ) then S_PHYSCS.2561
S_PHYSCS.2562
Call GLUE_CONV ( S_PHYSCS.2563
& points, points, nwet, nbl_levs S_PHYSCS.2564
& ,theta, q, pstar, land_mask, u, v, tracer S_PHYSCS.2565
& ,dthbydt, dqbydt, dubydt, dvbydt S_PHYSCS.2566
& ,conv_rain, conv_snow S_PHYSCS.2567
& ,cca, iccb, icct, ccwpin, ccw S_PHYSCS.2568
& ,iccbpxcca, icctpxcca, gbmccwp, gbmccw S_PHYSCS.2569
& ,lcbase, lctop, lcca, lcclwp, cape_out S_PHYSCS.2570
& ,exner, ak, bk, akh, bkh, delta_ak, delta_bk S_PHYSCS.2571
& ,timestep, t1_sd, q1_sd S_PHYSCS.2572
& ,l_mom, l_tracer, l_cape ,ntra, trlev ,l_xscomp S_PHYSCS.2573
& ,l_sdxs S_PHYSCS.2574
C For Observational forcing S_PHYSCS.2575
& ,dthud, dthdd, dqud, dqdd S_PHYSCS.2576
& ,n_cca_lev, l_3d_cca, l_ccw, mparwtr S_PHYSCS.2577
& ,anvil_factor, tower_factor, ud_factor, l_cloud_deep S_PHYSCS.2578
& ,l_phase_lim, up_flux, flg_up_flx, dwn_flux, flg_dwn_flx S_PHYSCS.2579
& ,entrain_up, flg_entr_up, detrain_up, flg_detr_up S_PHYSCS.2580
& ,entrain_dwn, flg_entr_dwn, detrain_dwn, flg_detr_dwn S_PHYSCS.2581
& ) S_PHYSCS.2582
S_PHYSCS.2583
C S_PHYSCS.2584
C--------------------------------------------------------------------- S_PHYSCS.2585
C Convert potential temperature to temperature S_PHYSCS.2586
C Convert output diagnostics if observational forcing S_PHYSCS.2587
C--------------------------------------------------------------------- S_PHYSCS.2588
C S_PHYSCS.2589
elseif (conv_mode .eq. 2) then S_PHYSCS.2590
S_PHYSCS.2591
Do k = 1, points S_PHYSCS.2592
cca(k,1) = 0 S_PHYSCS.2593
iccb(k) = 0 S_PHYSCS.2594
icct(k) = 0 S_PHYSCS.2595
enddo S_PHYSCS.2596
endif S_PHYSCS.2597
If (conv_mode .eq. 1 S_PHYSCS.2598
& .and. stepcount .ge. ntrad1 S_PHYSCS.2599
& .and. mod(stepcount-ntrad1,ntrad) .eq. 0) then S_PHYSCS.2600
Do i = 1, points S_PHYSCS.2601
ccasave(i) = cca(i,1) S_PHYSCS.2602
enddo S_PHYSCS.2603
Call DUMPINIT( S_PHYSCS.2604
! IN dimension of dump array. S_PHYSCS.2605
& points, nprimvars, nlevs, nwet, S_PHYSCS.2606
& nbl_levs, nsoilt_levs, nsoilm_levs, ntrop, S_PHYSCS.2607
! S_PHYSCS.2608
& savedump, u, v, t, theta, q, qcl, qcf, layer_cloud, S_PHYSCS.2609
& pstar, t_deep_soil, smc, canopy, snodep, S_PHYSCS.2610
& tstar, zh, z0msea, cca, rccb, rcct, smcl) S_PHYSCS.2611
Do i = 1, points S_PHYSCS.2612
rccb(i) = Real(iccb(i)) S_PHYSCS.2613
rcct(i) = Real(icct(i)) S_PHYSCS.2614
cca(i,1) = ccasave(i) S_PHYSCS.2615
enddo S_PHYSCS.2616
endif S_PHYSCS.2617
S_PHYSCS.2618
Call T_CALC(theta,t,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.2619
If (prindump_obs) then S_PHYSCS.2620
Call T_CALC(dthbydt,dtbydt,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.2621
Call T_CALC(dthud,dtud,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.2622
Call T_CALC(dthdd,dtdd,exner,pstar,akh,bkh,nlevs,points) S_PHYSCS.2623
endif S_PHYSCS.2624
C--------------------------------------------------------------------- S_PHYSCS.2625
C Write out sub-timestep diagnostics S_PHYSCS.2626
C--------------------------------------------------------------------- S_PHYSCS.2627
C S_PHYSCS.2628
If (test .and. daycount .ge. start_diagday) then S_PHYSCS.2629
If (stepcount .ge. subdat_step1 S_PHYSCS.2630
& .and. mod(stepcount-subdat_step1 ,subdat_step) .eq. 0) S_PHYSCS.2631
& Call SUB_DATA( S_PHYSCS.2632
& points, nlevs, nwet S_PHYSCS.2633
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_PHYSCS.2634
& ,' After convect, before hydr ' S_PHYSCS.2635
& ,stepcount,yearno,day,time_string,daycount,u,v,t, S_PHYSCS.2636
& theta,q,qcl,qcf,layer_cloud,pstar,t_deep_soil,smc, S_PHYSCS.2637
& canopy,snodep,tstar,zh, S_PHYSCS.2638
& z0msea,cca,iccb,icct,smcl) S_PHYSCS.2639
endif S_PHYSCS.2640
C S_PHYSCS.2641
C--------------------------------------------------------------------- S_PHYSCS.2642
C Fill diagnostic array and change units to K/day and g/Kg/day S_PHYSCS.2643
C from units of K/second and g/Kg/sec S_PHYSCS.2644
C--------------------------------------------------------------------- S_PHYSCS.2645
C S_PHYSCS.2646
If (prindump_obs) then S_PHYSCS.2647
Call DIAG2(points, nbl_levs, iccb, icct, cca, latent_heat S_PHYSCS.2648
& ,sens_heat, lwsea, swsea, e_sea, conv_rain, S_PHYSCS.2649
& conv_snow, ls_rain, ls_snow, S_PHYSCS.2650
& rhokh(1,1), nout_obs) S_PHYSCS.2651
Do i = 1, points S_PHYSCS.2652
Do k = 1, nlevs S_PHYSCS.2653
dap1(i,13,k) = dap1(i,13,k) + (t(i,k)-ttmp(i,k))/timestep S_PHYSCS.2654
dap1(i,33,k) = dtud(i,k) S_PHYSCS.2655
dap1(i,34,k) = dtdd(i,k) S_PHYSCS.2656
enddo S_PHYSCS.2657
Do k = 1, nwet S_PHYSCS.2658
dap1(i,23,k) = dap1(i,23,k) S_PHYSCS.2659
& + ((q(i,k)-qtmp(i,k))*1000.0) / timestep S_PHYSCS.2660
dap1(i,35,k) = dqud(i,k) * 1000.0 S_PHYSCS.2661
dap1(i,36,k) = dqdd(i,k) * 1000.0 S_PHYSCS.2662
enddo S_PHYSCS.2663
Do j = 10, 13 S_PHYSCS.2664
Do k = 1, nlevs S_PHYSCS.2665
dap1(i,j,k) = dap1(i,j,k) * sec_day S_PHYSCS.2666
enddo S_PHYSCS.2667
enddo S_PHYSCS.2668
Do j = 19, 36 S_PHYSCS.2669
Do k = 1, nlevs S_PHYSCS.2670
dap1(i,j,k) = dap1(i,j,k) * sec_day S_PHYSCS.2671
enddo S_PHYSCS.2672
enddo S_PHYSCS.2673
enddo S_PHYSCS.2674
endif ! PRINDUMP_OBS S_PHYSCS.2675
C S_PHYSCS.2676
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2677
C Hydrology (P25) S_PHYSCS.2678
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_PHYSCS.2679
C S_PHYSCS.2680
C hyd_mode determines actions for boundary layer scheme S_PHYSCS.2681
C 0 = Run normally S_PHYSCS.2682
C 1 = Run for diagnostics but save dump state S_PHYSCS.2683
C 2 = Don't run S_PHYSCS.2684
C S_PHYSCS.2685
If (hyd_mode .eq. 1) then S_PHYSCS.2686
Do i = 1, points S_PHYSCS.2687
Do k = 1, nprimvars S_PHYSCS.2688
savedump(i,k) = 0.0 S_PHYSCS.2689
enddo S_PHYSCS.2690
enddo S_PHYSCS.2691
Call RESTART_DUMP( S_PHYSCS.2692
! IN dimensions of main arrays S_PHYSCS.2693
& points,nlevs, nwet, nprimvars, S_PHYSCS.2694
& nbl_levs, nsoilt_levs, nsoilm_levs, S_PHYSCS.2695
! S_PHYSCS.2696
& savedump, u, v, t, theta, q, qcl, qcf, layer_cloud, S_PHYSCS.2697
& pstar, t_deep_soil, smc, canopy, S_PHYSCS.2698
& snodep, tstar, zh, z0msea, S_PHYSCS.2699
& cca, iccb, icct, smcl) S_PHYSCS.2700
endif S_PHYSCS.2701
S_PHYSCS.2702
If (hyd_mode .eq. 0 .or. hyd_mode .eq. 1) then S_PHYSCS.2703
*IF DEF,A08_5A S_PHYSCS.2704
C S_PHYSCS.2705
C--------------------------------------------------------------------- S_PHYSCS.2706
C Set up indices used in surface hydrology routines for MOSES S_PHYSCS.2707
C--------------------------------------------------------------------- S_PHYSCS.2708
C S_PHYSCS.2709
soil_pts = 0 S_PHYSCS.2710
lice_pts = 0 S_PHYSCS.2711
Do i = 1, points S_PHYSCS.2712
soil_index(i) = imdi S_PHYSCS.2713
lice_index(i) = imdi S_PHYSCS.2714
enddo S_PHYSCS.2715
Do i = 1, points S_PHYSCS.2716
C Test on soil moisture concentration at saturation S_PHYSCS.2717
If ((land_mask(i)) ! soil points S_PHYSCS.2718
& .and. (v_sat(soil_type(i)) .ne. 0.0)) then S_PHYSCS.2719
soil_pts = soil_pts + 1 S_PHYSCS.2720
soil_index(soil_pts) = i S_PHYSCS.2721
elseif ((land_mask(i)) ! land-ice points. S_PHYSCS.2722
& .and . (v_sat(soil_type(i)) .eq. 0.0)) then S_PHYSCS.2723
lice_pts = lice_pts + 1 S_PHYSCS.2724
lice_index(lice_pts) = i S_PHYSCS.2725
endif S_PHYSCS.2726
enddo S_PHYSCS.2727
*ENDIF S_PHYSCS.2728
C Calculate BS according to eqn P253.4 UMDP No 25, values from S_PHYSCS.2729
C I.N. 81 S_PHYSCS.2730
Do i = 1, points S_PHYSCS.2731
If (land_mask(i)) then S_PHYSCS.2732
C New UM calc for INFIL-: S_PHYSCS.2733
infil(i) = satcon(soil_type(i)) * infil_fac(veg_type(i)) S_PHYSCS.2734
C S_PHYSCS.2735
C Single Layer Hydrology S_PHYSCS.2736
C S_PHYSCS.2737
bs(i)= satcon(soil_type(i)) S_PHYSCS.2738
& / (v_sat(soil_type(i))-v_wilt(soil_type(i))) S_PHYSCS.2739
& ** b_exp(soil_type(i)) S_PHYSCS.2740
endif S_PHYSCS.2741
enddo S_PHYSCS.2742
Call HYD_INTCTL( S_PHYSCS.2743
& points, lice_pts, lice_index, nsoilt_levs, nsoilm_levs, S_PHYSCS.2744
& soil_pts, soil_index, S_PHYSCS.2745
& b_exp_nsite, catch_nsite, can_evap, S_PHYSCS.2746
& conv_rain, conv_snow, ext, S_PHYSCS.2747
& hcap_nsite, hcon_nsite, infil_fac_nsite, S_PHYSCS.2748
& layer_depth, ls_rain, ls_snow, S_PHYSCS.2749
& rootdep_nsite, satcon_nsite, sathh_nsite, S_PHYSCS.2750
& subl_snow, bs, soil_evap, surf_ht_flux, S_PHYSCS.2751
& veg_frac, v_sat_nsite, v_wilt_nsite ,timestep, S_PHYSCS.2752
& canopy, rgrain, l_snow_albedo, snodep, sthf, sthu, S_PHYSCS.2753
& tstar, t_deep_soil, S_PHYSCS.2754
& infil, stf_hf_snow_melt, S_PHYSCS.2755
& hf_snow_melt, smc, smcl, S_PHYSCS.2756
& snow_melt, stf_snomlt_sub_htf, S_PHYSCS.2757
& snomlt_sub_htf, S_PHYSCS.2758
& stf_sub_surf_roff, sub_surf_roff, fast_runoff, S_PHYSCS.2759
& throughfall, S_PHYSCS.2760
C Additional arguments for 7A hydrology (MOSES II) S_PHYSCS.2761
& tile_pts, tile_index, S_PHYSCS.2762
& catch_tile, ecan_tile, S_PHYSCS.2763
& frac, snow_frac, soil_surf_htf, snow_surf_htf, tstar_tile, S_PHYSCS.2764
& canopy_tile, tstar_snow, S_PHYSCS.2765
C S_PHYSCS.2766
& ltimer) S_PHYSCS.2767
S_PHYSCS.2768
endif ! hyd_mode = 0 or 1 S_PHYSCS.2769
C S_PHYSCS.2770
C--------------------------------------------------------------------- S_PHYSCS.2771
C Write out sub-timestep diagnostics S_PHYSCS.2772
C--------------------------------------------------------------------- S_PHYSCS.2773
C S_PHYSCS.2774
If (test .and. daycount .ge. start_diagday) then S_PHYSCS.2775
If (stepcount .ge. subdat_step1 S_PHYSCS.2776
& .and. mod(stepcount-subdat_step1, subdat_step) .eq. 0) S_PHYSCS.2777
& Call SUB_DATA( S_PHYSCS.2778
& points, nlevs, nwet S_PHYSCS.2779
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_PHYSCS.2780
& , ' After hydrology ' S_PHYSCS.2781
& , stepcount, yearno, day, time_string, daycount, u, v, t, S_PHYSCS.2782
& theta, q, qcl, qcf, layer_cloud, S_PHYSCS.2783
& pstar, t_deep_soil, smc, canopy, snodep, tstar, zh, S_PHYSCS.2784
& z0msea, cca, iccb, icct, smcl) S_PHYSCS.2785
endif S_PHYSCS.2786
C S_PHYSCS.2787
If (hyd_mode .eq. 1) then S_PHYSCS.2788
Call DUMPINIT( S_PHYSCS.2789
C ! IN dimension of dump array. S_PHYSCS.2790
& points, nprimvars, nlevs, nwet, S_PHYSCS.2791
& nbl_levs, nsoilt_levs, nsoilm_levs, ntrop, S_PHYSCS.2792
C ! S_PHYSCS.2793
& savedump, u, v, t, theta, q, qcl, qcf, layer_cloud, S_PHYSCS.2794
& pstar, t_deep_soil, smc, canopy, snodep, S_PHYSCS.2795
& tstar, zh, z0msea, cca, rccb, rcct, smcl) S_PHYSCS.2796
endif S_PHYSCS.2797
C S_PHYSCS.2798
C Calculate RH diagnostic S_PHYSCS.2799
C S_PHYSCS.2800
Do i = 1, points S_PHYSCS.2801
Do k = 1, nwet S_PHYSCS.2802
prh = ak(k) + bk(k) * pstar(i) S_PHYSCS.2803
Call qsat (qst, t(i,k), prh, 1) S_PHYSCS.2804
rh(i,k,1) = q(i,k) / qst S_PHYSCS.2805
Call qsat_wat (qst, t(i,k), prh, 1) S_PHYSCS.2806
rh(i,k,2) = q(i,k) / qst S_PHYSCS.2807
enddo S_PHYSCS.2808
enddo S_PHYSCS.2809
C S_PHYSCS.2810
Return S_PHYSCS.2811
End S_PHYSCS.2812
*ENDIF S_PHYSCS.2813