Subroutine RUN_INIT( 1,18S_RUNINI.55
C IN leading dimensions of arrays S_RUNINI.56
& points, nlevs, nwet S_RUNINI.57
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_RUNINI.58
C IN dimension of dump array. S_RUNINI.59
& ,nprimvars S_RUNINI.60
C S_RUNINI.61
& ,stats, obs, prindump_obs, noforce, altdat S_RUNINI.62
& ,land_mask, altsoil, tapein, tapeout S_RUNINI.63
& ,l_climat_aerosol, l_use_sulpc_direct, ltimer S_RUNINI.64
& ,l_ch4, l_n2o, l_cfc11, l_cfc12 S_RUNINI.65
& ,l_cfc113, l_hcfc22, l_hfc125, l_hfc134a S_RUNINI.66
& ,l_o2 S_RUNINI.67
& ,l_use_soot_direct S_RUNINI.68
& ,init_m_smcl,init_m_fsmc,init_m_sth S_RUNINI.69
& ,smcli,fsmc,sth S_RUNINI.70
& ,geoforce, geoinit, ug, vg S_RUNINI.71
& ,year_init, dayno_init, lcal360, ichgf, timestep, ndayin S_RUNINI.72
& ,resdump_days, soil_type, veg_type, layer_depth S_RUNINI.73
& ,pstari, smci, canopyi, snodepi, tstari, t_deep_soili S_RUNINI.74
& ,z0mseai, ui, vi, ti, qi, ccai, iccbi, iccti S_RUNINI.75
& ,time_init, tconst, dtday, dtyear, tapeday_init S_RUNINI.76
& ,exname_in, exname_out, runno_in, runno_out, theta S_RUNINI.77
& ,u, v, t, q, flux_h, flux_e, uls, vls, tls, qls, exner S_RUNINI.78
& ,ch_flux_h, ch_flux_e, ch_uls, ch_vls, ch_tls, ch_qls S_RUNINI.79
& ,dap1, dap2, dap3, dab1, dab2, dab3, deltap ,pstar S_RUNINI.80
& ,smc, smcl, canopy, snodep, tstar, tsi, t_deep_soil S_RUNINI.81
& ,sthu,sthf,gs S_RUNINI.82
& ,z0msea, zh, cca, iccb, icct, layer_cloud, qcf, qcl S_RUNINI.83
& ,dayno_wint, alfada, alfadb, atime, btime, lat, long S_RUNINI.84
& ,dbara, dbarb, dgrada, dgradb, pstara, pstarb S_RUNINI.85
& ,tbara, tbarb, tgrada, tgradb, tsda, tsdb S_RUNINI.86
& ,vnbara, vnbarb, vnsda, vnsdb S_RUNINI.87
& ,vpbara, vpbarb, wbara, wbarb, wsda, wsdb S_RUNINI.88
& ,iv, ntab, iy, idum, iseed, resdump S_RUNINI.89
& ,rhcrit ! IN Critical relative humidities S_RUNINI.90
! IN model levels. S_RUNINI.91
& ,ak, bk ! IN Coefficients defining S_RUNINI.92
! hybrid vertical coordinates S_RUNINI.93
& ,akh,bkh ! IN AK,BK at lower level interfaces S_RUNINI.94
! S_RUNINI.95
& ,delta_ak, delta_bk S_RUNINI.96
& ,lwlut, swlut ) S_RUNINI.97
Implicit none S_RUNINI.98
S_RUNINI.99
Integer S_RUNINI.100
& points ! IN leading dimension of SCM arrays. S_RUNINI.101
& ,nlevs ! IN no of levels. S_RUNINI.102
& ,nwet ! IN no of model levels in which Q is S_RUNINI.103
! set. S_RUNINI.104
& ,nfor ! IN Number terms for observational S_RUNINI.105
! forcing S_RUNINI.106
& ,nbl_levs ! IN Number of Boundary layer levels S_RUNINI.107
& ,nsoilt_levs ! IN Number of soil temperature S_RUNINI.108
! levels S_RUNINI.109
& ,nsoilm_levs ! IN Number of soil moisture levels S_RUNINI.110
& ,ntrop ! IN Max number of levels in the S_RUNINI.111
! troposphere S_RUNINI.112
& ,nprimvars ! IN minimum no. of variables S_RUNINI.113
! required to restart from a dump. S_RUNINI.114
S_RUNINI.115
C S_RUNINI.116
C Comdecks S_RUNINI.117
C S_RUNINI.118
C SCM specific : S_RUNINI.119
*CALL S_VEGPRM 
! Vegetation parameters for land S_RUNINI.120
! surface scheme. S_RUNINI.121
*CALL S_SOILPR ! Soil Parameters for land surface S_RUNINI.122
C Others : S_RUNINI.123
*CALL C_DENSTY S_RUNINI.124
*CALL CMAXSIZE S_RUNINI.125
*CALL CCONSTS ! Radiation LW nad SW spectral tables S_RUNINI.126
*CALL SOIL_THICK ! Actual soil layer thicknesses(MOSES) S_RUNINI.127
*CALL C_SOILH ! Various soil parameters S_RUNINI.128
*CALL C_OMEGA ! Comdecks for coriolis parameter S_RUNINI.129
*CALL C_PI S_RUNINI.130
S_RUNINI.131
S_RUNINI.132
S_RUNINI.133
C S_RUNINI.134
C--------------------------------------------------------------------- S_RUNINI.135
C Primary Model Variables plus T (UMDP No1) S_RUNINI.136
C--------------------------------------------------------------------- S_RUNINI.137
C S_RUNINI.138
Integer S_RUNINI.139
& iccb(points) ! Convective cloud base and top S_RUNINI.140
& ,icct(points) ! at levels 1 to nlevs S_RUNINI.141
Real S_RUNINI.142
& canopy(points) ! Canopy water (Kg m^-2) S_RUNINI.143
& ,cca(points) ! Convective cloud amount S_RUNINI.144
& ,gs(points) ! Stomatal conductance S_RUNINI.145
& ,pstar(points) ! Pressure at earth's surface S_RUNINI.146
! (Pa not hPa) S_RUNINI.147
& ,q(points,nwet) ! Specific humidity (Kg Kg^-1) S_RUNINI.148
& ,qcf(points,nwet) ! Cloud ice content (Kg Kg^-1) S_RUNINI.149
& ,qcl(points,nwet) ! Cloud water content(Kg Kg^-1) S_RUNINI.150
& ,rccb(points) ! Convective cloud base and top S_RUNINI.151
& ,rcct(points) S_RUNINI.152
! at levels 1 to NLEVS S_RUNINI.153
! real values for DUMP purposes S_RUNINI.154
& ,smc(points) ! Soil moisture content(Kg m^-2) S_RUNINI.155
& ,smcl(points,nsoilm_levs) S_RUNINI.156
! Soil moisture content in layers S_RUNINI.157
! (Kg m^-2) S_RUNINI.158
& ,sthf(points,nsoilm_levs) S_RUNINI.159
! INOUT Frozen soil moisture S_RUNINI.160
! content of each layer as a S_RUNINI.161
! fraction of saturation. S_RUNINI.162
& ,sthu(points,nsoilm_levs) S_RUNINI.163
! INOUT Unfrozen soil moisture S_RUNINI.164
! content of each layer as a fraction S_RUNINI.165
! of saturation. (Kg m^-2) S_RUNINI.166
& ,snodep(points) ! Snow depth (Kg m^-2) S_RUNINI.167
& ,t(points,nlevs) ! Temperature(K) S_RUNINI.168
& ,t_deep_soil(points,nsoilt_levs) S_RUNINI.169
! Deep soil temperatures (K) S_RUNINI.170
! top level not included,=surface S_RUNINI.171
& ,theta(points,nlevs) ! Potential temperature (K) S_RUNINI.172
& ,tsi(points) ! Temperature of sea-ice S_RUNINI.173
& ,tstar(points) ! Surface temperature (K) S_RUNINI.174
& ,u(points,nlevs) S_RUNINI.175
& ,v(points,nlevs) ! Zonal,Meridional wind (m s^-1) S_RUNINI.176
& ,z0msea(points) ! Sea surface roughness length S_RUNINI.177
& ,zh(points) ! Height above surface of top S_RUNINI.178
! of boundary layer (m) S_RUNINI.179
& ,layer_cloud(points,nwet) S_RUNINI.180
! layer cloud amount (decimal S_RUNINI.181
! fraction) S_RUNINI.182
& ,lwlut(len_lw_tables) ! LW tables S_RUNINI.183
& ,swlut(len_sw_tables) ! SW tables S_RUNINI.184
S_RUNINI.185
Integer S_RUNINI.186
& year_init ! IN Initial year S_RUNINI.187
& ,dayno_init ! IN Initial day in year S_RUNINI.188
& ,tapeday_init ! IN Initial day for tape input S_RUNINI.189
! ie last day on tape + 1 S_RUNINI.190
S_RUNINI.191
Logical S_RUNINI.192
& lcal360 ! IN ? 360 days year ? S_RUNINI.193
S_RUNINI.194
S_RUNINI.195
C S_RUNINI.196
C--------------------------------------------------------------------- S_RUNINI.197
C Tape information S_RUNINI.198
C--------------------------------------------------------------------- S_RUNINI.199
C S_RUNINI.200
Integer S_RUNINI.201
& runno ! Run no. of expt on tape S_RUNINI.202
& ,tapeday ! Tape year day S_RUNINI.203
& ,tapedump_no ! No. of dumps on tape S_RUNINI.204
Character*8 S_RUNINI.205
& exname ! Name of expt. on tape S_RUNINI.206
Real S_RUNINI.207
& resdump(points,nprimvars) S_RUNINI.208
! DUMP array of restart variables S_RUNINI.209
C S_RUNINI.210
Real S_RUNINI.211
& dtday(points) ! Amplitudes of daily soil temp. cycle S_RUNINI.212
! used to calculate initial soil S_RUNINI.213
! temperature profile S_RUNINI.214
& ,dtyear(points) ! Amplitudes of annual soil temp. S_RUNINI.215
! cycle used to calculate initial S_RUNINI.216
! soil temperature profile S_RUNINI.217
& ,lat(points) ! Lat. of gridpoint chosen S_RUNINI.218
! Read automatically from climate S_RUNINI.219
! dataset if STATS forcing chosen S_RUNINI.220
& ,long(points) ! Long. of gridpoint chosen S_RUNINI.221
! Read automatically from climate S_RUNINI.222
! dataset if STATS forcing chosen S_RUNINI.223
& ,tconst(points) ! Annual mean surface temp. S_RUNINI.224
& ,time_init ! Initial time in seconds S_RUNINI.225
& ,andayy ! LOC No. of days in 1 year. S_RUNINI.226
! (for one year effects) S_RUNINI.227
& ,flux_e(points,nfor) S_RUNINI.228
& ,flux_h(points,nfor) ! S_RUNINI.229
& ,ch_flux_e(points,nfor-1) ! Change per sec in FLUX_E,FLUX_H S_RUNINI.230
& ,ch_flux_h(points,nfor-1) S_RUNINI.231
& ,tls(points,nfor,nlevs) S_RUNINI.232
! Temp increment due to large-scale S_RUNINI.233
! horizontal and vertical advection S_RUNINI.234
! (K s^-1 day^-1) S_RUNINI.235
& ,ch_tls(points,nfor-1,nlevs) S_RUNINI.236
! Change per sec in Temp increment S_RUNINI.237
& ,qls(points,nfor,nwet) ! Specific humidity increment S_RUNINI.238
! due to large-scale horizontal S_RUNINI.239
! and vertical advection S_RUNINI.240
! (Kg Kg^-1 s^-1 day^-1) S_RUNINI.241
& ,ch_qls(points,nfor-1,nwet) S_RUNINI.242
! Change per sec in Specific humidity S_RUNINI.243
& ,uls(points,nfor,nlevs) ! Zonal and meridional wind S_RUNINI.244
& ,vls(points,nfor,nlevs) ! increment due to large-scale S_RUNINI.245
! horizontal and vertical S_RUNINI.246
! advection (m s^-1 day^-1) S_RUNINI.247
& ,ch_uls(points,nfor-1,nlevs) S_RUNINI.248
! Change per sec in Zonal and merid S_RUNINI.249
& ,ch_vls(points,nfor-1,nlevs) ! wind increm. S_RUNINI.250
C S_RUNINI.251
C S_RUNINI.252
C &INDATA S_RUNINI.253
C S_RUNINI.254
Integer S_RUNINI.255
& soil_type(points) ! Soil type code 1 to 4 S_RUNINI.256
! 1 Ice S_RUNINI.257
! 2 Fine S_RUNINI.258
! 3 Medium S_RUNINI.259
! 4 Coarse S_RUNINI.260
& ,veg_type(points) ! Vegetation type code S_RUNINI.261
! 1 Equitorial rainforest S_RUNINI.262
! 2 Pasture and trees S_RUNINI.263
! 3 Coniferous forest S_RUNINI.264
! 4 Tropical savannah S_RUNINI.265
! 5 Pasture S_RUNINI.266
! 6 Arable S_RUNINI.267
! 7 Tundra S_RUNINI.268
! 8 Semi-desert and trees S_RUNINI.269
! 9 Desert S_RUNINI.270
C S_RUNINI.271
C &INGEOFOR S_RUNINI.272
C S_RUNINI.273
Real S_RUNINI.274
& UG(points) ! Geostrophic U velocity (m s^-1) S_RUNINI.275
& ,VG(points) ! Geostrophic V velocity (m s^-1) S_RUNINI.276
C & ,TG(nlevs) ! Initial Temp. profile for Geo. force S_RUNINI.277
C & ,QG(nwet) ! Initial Moisture profile for S_RUNINI.278
! Geo. force S_RUNINI.279
C S_RUNINI.280
C &INPROF S_RUNINI.281
C S_RUNINI.282
Integer S_RUNINI.283
& iccbi(points) ! Convective cloud base S_RUNINI.284
& ,iccti(points) ! and top (model levels) S_RUNINI.285
Real S_RUNINI.286
& canopyi(points) ! Initial canopy water (Kg m^-2) S_RUNINI.287
& ,ccai(points) ! Convective cloud amnt. S_RUNINI.288
! (decimal fraction) S_RUNINI.289
& ,pstari(points) ! Initial surface pressure (Pa) S_RUNINI.290
& ,qi(points,nwet) ! Initial specific humidity S_RUNINI.291
! (Kg Kg^-1) S_RUNINI.292
& ,smci(points) ! Initial soil moisture content S_RUNINI.293
! (Kg m^-2) S_RUNINI.294
& ,snodepi(points) ! Initial snow depth (Kg m^-2) S_RUNINI.295
& ,t_deep_soili(points,nsoilt_levs) S_RUNINI.296
! Initial deep soil temps. (K) S_RUNINI.297
& ,ti(points,nlevs) ! Initial temp. profile (K) S_RUNINI.298
& ,tstari(points) ! Initial surface temp. (K) S_RUNINI.299
& ,ui(points,nlevs) ! Initial zonal and meridional S_RUNINI.300
& ,vi(points,nlevs) ! wind comps. (m s^-1) S_RUNINI.301
& ,z0mseai(points) ! Initial sea surface roughness S_RUNINI.302
! length (m) S_RUNINI.303
*IF DEF,A08_1A S_RUNINI.304
C Standard scheme Global soil parameters S_RUNINI.305
C layer_depth - soil layer depth as a multiple of layer 1 depth S_RUNINI.306
& ,layer_depth(nsoilt_levs+1) ! soil layer depth ratios S_RUNINI.307
*ELSEIF DEF,A08_5A S_RUNINI.308
C Global soil parameters for MOSES formulation S_RUNINI.309
C This is not used except as local workspace in RUN_INIT S_RUNINI.310
& ,layer_depth(nsoilt_levs) ! soil layer depth ratios S_RUNINI.311
*ENDIF S_RUNINI.312
S_RUNINI.313
C S_RUNINI.314
C &INMOSES S_RUNINI.315
C S_RUNINI.316
Real S_RUNINI.317
& fsmc(points) ! Soil moisture stress to initialise S_RUNINI.318
! SMCL S_RUNINI.319
& ,smcli(points,nsoilm_levs) S_RUNINI.320
! Initial values for SMCL (Kg m^-2) S_RUNINI.321
& ,sth(points,nsoilm_levs) ! Total soil moisture in layers as a S_RUNINI.322
! fraction of saturation S_RUNINI.323
Logical S_RUNINI.324
& init_m_smcl ! T if MOSES to be initialised by S_RUNINI.325
! input of SMCL S_RUNINI.326
& ,init_m_fsmc ! T if MOSES to be initialised by S_RUNINI.327
! input of FSMC S_RUNINI.328
& ,init_m_sth ! T if MOSES to be initialised by S_RUNINI.329
! input of STH S_RUNINI.330
C S_RUNINI.331
C S_RUNINI.332
C &LOGIC S_RUNINI.333
C S_RUNINI.334
Logical S_RUNINI.335
& altdat ! T if alternative initial profiles of S_RUNINI.336
! T,Q,U and V are to be input S_RUNINI.337
& ,altsoil ! T if initial soil temperature S_RUNINI.338
! profile is to be input rather S_RUNINI.339
! than calculated from INITSOIL S_RUNINI.340
& ,geoforce ! T if geostrophic forcing. S_RUNINI.341
& ,geoinit ! T if initialising dump to S_RUNINI.342
! geostrophic. S_RUNINI.343
& ,land_mask(points) ! T for a land point S_RUNINI.344
& ,noforce ! T if no large-scale forcing S_RUNINI.345
! is required S_RUNINI.346
& ,obs ! T if observational S_RUNINI.347
! large-scale forcing used S_RUNINI.348
& ,prindump_obs ! T if printout of observational S_RUNINI.349
! diagnostics required every S_RUNINI.350
! OBS_PRINT timesteps S_RUNINI.351
& ,stats ! T if statistical large-scale S_RUNINI.352
! forcing used S_RUNINI.353
& ,tapein ! T if initial data is to be read S_RUNINI.354
! from previous run stored on tape S_RUNINI.355
& ,tapeout ! T if restart information plus S_RUNINI.356
! diagnostic output to be stored on S_RUNINI.357
! tape S_RUNINI.358
& ,l_climat_aerosol S_RUNINI.359
& ,l_use_sulpc_direct S_RUNINI.360
& ,ltimer S_RUNINI.361
& ,l_ch4, l_n2o, l_cfc11, l_cfc12 S_RUNINI.362
& ,l_cfc113, l_hcfc22, l_hfc125, l_hfc134a S_RUNINI.363
& ,l_o2 S_RUNINI.364
& ,l_use_soot_direct ! Flag to use sulphur cycle for S_RUNINI.365
! direct effect S_RUNINI.366
C S_RUNINI.367
C &RUNDATA S_RUNINI.368
C S_RUNINI.369
Character*8 S_RUNINI.370
& exname_in ! Name of expt. to be read from S_RUNINI.371
! previous run stored on tape up to 6 S_RUNINI.372
! characters S_RUNINI.373
& ,exname_out ! Name of expt. to be written to tape S_RUNINI.374
! up to 6 characters S_RUNINI.375
Integer S_RUNINI.376
& ndayin ! No. of days in integration S_RUNINI.377
& ,resdump_days ! frequency of dumps for restart S_RUNINI.378
& ,runno_in ! Number of run to be read from S_RUNINI.379
! previous run stored on tape S_RUNINI.380
& ,runno_out ! Number of run to be written to tape S_RUNINI.381
Real S_RUNINI.382
& timestep ! Model timestep for all physics S_RUNINI.383
! subroutines except radiation S_RUNINI.384
C S_RUNINI.385
C--------------------------------------------------------------------- S_RUNINI.386
C Large scale observational forcing S_RUNINI.387
C--------------------------------------------------------------------- S_RUNINI.388
C S_RUNINI.389
C Variables for diagnostic output for observational forcing S_RUNINI.390
C S_RUNINI.391
Real S_RUNINI.392
& dap1(points,36,nlevs) S_RUNINI.393
& ,dap2(points,36,nlevs) S_RUNINI.394
& ,dap3(points,36,nfor-1,nlevs) S_RUNINI.395
& ,dab1(points,44) S_RUNINI.396
& ,dab2(points,44) S_RUNINI.397
& ,dab3(points,44,nfor-1) S_RUNINI.398
& ,deltap(points,nlevs) ! OUT Layer thickness (Pa) S_RUNINI.399
C S_RUNINI.400
C--------------------------------------------------------------------- S_RUNINI.401
C Large scale statistical forcing S_RUNINI.402
C--------------------------------------------------------------------- S_RUNINI.403
C S_RUNINI.404
C Random generator variables S_RUNINI.405
C S_RUNINI.406
Integer S_RUNINI.407
& ntab ! IN Dimension of array used in random S_RUNINI.408
! generator. S_RUNINI.409
& ,iv(ntab),iy,idum ! On exit contains info on generator S_RUNINI.410
& ,iseed ! Seed for random number generator S_RUNINI.411
S_RUNINI.412
Integer S_RUNINI.413
& dayno_wint ! Day number relative to winter S_RUNINI.414
! solstice S_RUNINI.415
& ,ichgf ! No. of timesteps between change in S_RUNINI.416
! observational forcing S_RUNINI.417
Real S_RUNINI.418
& alfada(points) ! Amplitude and mean of seasonal S_RUNINI.419
& ,alfadb(points) ! variation of tuning factor S_RUNINI.420
& ,atime,btime ! Constants for calculating annual S_RUNINI.421
! cycle S_RUNINI.422
& ,dbara(points,nwet) ! Amplitude and mean of seasonal S_RUNINI.423
& ,dbarb(points,nwet) ! variation of mean dew pt. S_RUNINI.424
! depression (K) S_RUNINI.425
& ,dgrada(points,nwet) ! Amplitude and mean of seasonal S_RUNINI.426
& ,dgradb(points,nwet) ! variation of dew pt. depression S_RUNINI.427
! gradient (K km^-1) S_RUNINI.428
& ,pstara(points) ! Amplitude and mean of seasonal S_RUNINI.429
& ,pstarb(points) ! variation of surface pressure (Pa) S_RUNINI.430
& ,tbara(points,nlevs) ! Amplitude and mean of seasonal S_RUNINI.431
& ,tbarb(points,nlevs) ! variation of temp. (K) S_RUNINI.432
& ,tgrada(points,nlevs) ! Amplitude and mean of seasonal S_RUNINI.433
& ,tgradb(points,nlevs) ! variation of temp. gradient S_RUNINI.434
! (K Km^-1) S_RUNINI.435
& ,tsda(points,nlevs) ! Amplitude and mean of seasonal S_RUNINI.436
& ,tsdb(points,nlevs) ! variation of SD of temp. (K) S_RUNINI.437
& ,vnbara(points,nlevs) ! Amplitude and mean of seasonal S_RUNINI.438
& ,vnbarb(points,nlevs) ! variation of velocity VN (m s^-1) S_RUNINI.439
& ,vnsda(points,nlevs) ! Amplitude and mean of seasonal S_RUNINI.440
& ,vnsdb(points,nlevs) ! variation of SD of velocity VN S_RUNINI.441
! (m s^-1) S_RUNINI.442
& ,vpbara(points,nlevs) ! Amplitude and mean of seasonal S_RUNINI.443
& ,vpbarb(points,nlevs) ! variation of velocity VP (m s^-1) S_RUNINI.444
& ,wbara(points,ntrop) ! Amplitude and mean of seasonal S_RUNINI.445
& ,wbarb(points,ntrop) ! variation of SD of vert. vel. S_RUNINI.446
! (mb or HPa s^-1) S_RUNINI.447
& ,wsda(points,ntrop) ! Amplitude and mean of seasonal S_RUNINI.448
& ,wsdb(points,ntrop) ! variation of SD of vert. vel. S_RUNINI.449
! (mb s^-1) S_RUNINI.450
! roughness length (m) S_RUNINI.451
S_RUNINI.452
C S_RUNINI.453
Real rhcrit(nwet) ! Critical humidity for cloud S_RUNINI.454
! formation. S_RUNINI.455
Real S_RUNINI.456
& ak(nlevs) ! Coefficients defining S_RUNINI.457
& ,bk(nlevs) ! hybrid vertical coordinates S_RUNINI.458
& ,akh(nlevs+1) ! AK,BK at lower level interfaces S_RUNINI.459
& ,bkh(nlevs+1) S_RUNINI.460
& ,delta_ak(nlevs) ! Half level differences S_RUNINI.461
& ,delta_bk(nlevs) S_RUNINI.462
& ,exner(points,nlevs+1) ! EXNER function for S_RUNINI.463
! lower boundary of layer (K) S_RUNINI.464
S_RUNINI.465
C--------------------------------------------------------------------- S_RUNINI.466
C Local S_RUNINI.467
C--------------------------------------------------------------------- S_RUNINI.468
C S_RUNINI.469
Integer S_RUNINI.470
& i, j, k, l, jlev ! Loop counters S_RUNINI.471
& ,icode ! error code S_RUNINI.472
& ,nresdump ! no. of restart dumps S_RUNINI.473
& ,soil_index(points) ! Index on land points S_RUNINI.474
& ,temp_basis_days ! for computation of andayy S_RUNINI.475
& ,temp_basis_secs S_RUNINI.476
& ,andayy1, andayy2 ! To calculate andday using time2sec S_RUNINI.477
& ,dummy S_RUNINI.478
Character*80 cmessage ! error message S_RUNINI.479
S_RUNINI.480
Real S_RUNINI.481
& fsmc_limit ! limit for soil moisture init. FSMC S_RUNINI.482
& ,dzsoil_n(points,nsoilm_levs) ! Thickness of soil layers (m). S_RUNINI.483
& ,hcap_t(points) ! heat capacity for top layer S_RUNINI.484
& ,hcon_t(points) ! heat conductivity for top layer S_RUNINI.485
& ,omega_t(points) ! wave factor for calc. of T_DEEP_SOIL S_RUNINI.486
& ,sthf_t(points) ! frozen soil moisture fraction S_RUNINI.487
& ,sthu_t(points) ! unfrozen soil moisture fraction S_RUNINI.488
& ,tsoil_init(points,nsoilt_levs+1) ! Initial soil temperatures S_RUNINI.489
! including surface S_RUNINI.490
& ,t_deep_soil_t(points) ! deep soil temp.top layer S_RUNINI.491
& ,b_exp_nsite(points) ! Nsite Eagleson's exponent S_RUNINI.492
& ,hcap_nsite(points) ! Nsite soil heat capacity S_RUNINI.493
& ,hcon_nsite(points) ! Nsite soil thermal conductivity S_RUNINI.494
& ,satcon_nsite(points) ! Nsite saturated hydrological S_RUNINI.495
! conductivity S_RUNINI.496
& ,sathh_nsite(points) ! Nsite Dummy for use in Single S_RUNINI.497
! layer hydrology S_RUNINI.498
& ,v_sat_nsite(points) ! Nsite volumetric soil moisture S_RUNINI.499
! content at saturation S_RUNINI.500
& ,v_wilt_nsite(points) ! Nsite volumetric soil moisture S_RUNINI.501
! content at wilting point S_RUNINI.502
& ,v_crit_nsite(points) ! Nsite volumetric soil moisture S_RUNINI.503
! content at the critical point S_RUNINI.504
S_RUNINI.505
S_RUNINI.506
C S_RUNINI.507
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_RUNINI.508
C Define nsite soil parameters and Initialise SWNOCZ S_RUNINI.509
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_RUNINI.510
C S_RUNINI.511
Do i = 1, points S_RUNINI.512
b_exp_nsite(i) = b_exp(soil_type(i)) S_RUNINI.513
hcap_nsite(i) = hcap(soil_type(i)) S_RUNINI.514
hcon_nsite(i) = hcon(soil_type(i)) S_RUNINI.515
satcon_nsite(i) = satcon(soil_type(i)) S_RUNINI.516
sathh_nsite(i) = sathh(soil_type(i)) S_RUNINI.517
v_sat_nsite(i) = v_sat(soil_type(i)) S_RUNINI.518
v_wilt_nsite(i) = v_wilt(soil_type(i)) S_RUNINI.519
v_crit_nsite(i) = v_crit(soil_type(i)) S_RUNINI.520
enddo S_RUNINI.521
C S_RUNINI.522
do i = 1, points S_RUNINI.523
do k = 1, nsoilt_levs S_RUNINI.524
dzsoil_n(i,k) = dzsoil(k) S_RUNINI.525
enddo S_RUNINI.526
enddo S_RUNINI.527
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! S_RUNINI.528
S_RUNINI.529
C S_RUNINI.530
C--------------------------------------------------------------------- S_RUNINI.531
C Calculate number of days in year S_RUNINI.532
C--------------------------------------------------------------------- S_RUNINI.533
C S_RUNINI.534
Call time2sec(year_init, 1,1,0,0,0,0,0 S_RUNINI.535
& ,andayy1, dummy, lcal360) S_RUNINI.536
Call time2sec(year_init+1,1,1,0,0,0,0,0 S_RUNINI.537
& ,andayy2, dummy, lcal360) S_RUNINI.538
andayy = andayy2 - andayy1 S_RUNINI.539
C S_RUNINI.540
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! S_RUNINI.541
If (stats) then S_RUNINI.542
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! S_RUNINI.543
C--------------------------------------------------------------------- S_RUNINI.544
C Calculate day number relative to winter solstice (ie day 351) S_RUNINI.545
C--------------------------------------------------------------------- S_RUNINI.546
C S_RUNINI.547
If (dayno_init .lt. 351) then S_RUNINI.548
dayno_wint = dayno_init + 9 S_RUNINI.549
else S_RUNINI.550
dayno_wint = dayno_init - 351 S_RUNINI.551
endif S_RUNINI.552
C S_RUNINI.553
C--------------------------------------------------------------------- S_RUNINI.554
C Derive initial data from climate datasets S_RUNINI.555
C--------------------------------------------------------------------- S_RUNINI.556
C S_RUNINI.557
Call INITSTAT( S_RUNINI.558
& points, nlevs, nwet, ntrop, S_RUNINI.559
& andayy, dayno_wint, q, t, lat, long, S_RUNINI.560
& pstari, pstara, pstarb, alfada, alfadb, tbara, tbarb, S_RUNINI.561
& tsda, tsdb, tgrada, tgradb, dbara, dbarb, S_RUNINI.562
& dgrada, dgradb, vnbara, vnbarb, vnsda, vnsdb, S_RUNINI.563
& vpbara, vpbarb, wbara, wbarb, S_RUNINI.564
& wsda, wsdb, atime, btime, ak, bk) S_RUNINI.565
C S_RUNINI.566
C--------------------------------------------------------------------- S_RUNINI.567
C Initialise random generator S_RUNINI.568
C--------------------------------------------------------------------- S_RUNINI.569
C S_RUNINI.570
Call G05CBE(iseed) S_RUNINI.571
endif ! stats S_RUNINI.572
C S_RUNINI.573
C--------------------------------------------------------------------- S_RUNINI.574
C Set initial data from &INPROF S_RUNINI.575
C--------------------------------------------------------------------- S_RUNINI.576
C S_RUNINI.577
Do i = 1, points S_RUNINI.578
If (obs .or. noforce .or. geoforce) then S_RUNINI.579
Do k = 1, nlevs S_RUNINI.580
u(i,k) = ui(i,k) S_RUNINI.581
v(i,k) = vi(i,k) S_RUNINI.582
t(i,k) = ti(i,k) S_RUNINI.583
enddo S_RUNINI.584
Do k = 1, nwet S_RUNINI.585
q(i,k) = qi(i,k) S_RUNINI.586
enddo S_RUNINI.587
endif ! (obs .or. noforce) S_RUNINI.588
If (stats .and. altdat) then S_RUNINI.589
Do k = 1, nlevs S_RUNINI.590
t(i,k) = ti(i,k) S_RUNINI.591
enddo S_RUNINI.592
Do k = 1, nwet S_RUNINI.593
q(i,k) = qi(i,k) S_RUNINI.594
enddo S_RUNINI.595
endif ! (stats .and. altdat) S_RUNINI.596
If (geoforce .and. geoinit) then S_RUNINI.597
Do k = 1, nlevs S_RUNINI.598
u(i,k) = ug(i) S_RUNINI.599
v(i,k) = vg(i) S_RUNINI.600
enddo S_RUNINI.601
endif ! geoforce and geoinit S_RUNINI.602
enddo ! i S_RUNINI.603
C S_RUNINI.604
C--------------------------------------------------------------------- S_RUNINI.605
C Calculate rates of change for large scale observational forcing S_RUNINI.606
C--------------------------------------------------------------------- S_RUNINI.607
C S_RUNINI.608
If (obs) then S_RUNINI.609
Do i = 1, points S_RUNINI.610
Do j = 1, (nfor-1) S_RUNINI.611
ch_flux_h(i,j) = (flux_h(i,j+1) - flux_h(i,j)) S_RUNINI.612
& / (ichgf * timestep) S_RUNINI.613
ch_flux_e(i,j) = (flux_e(i,j+1) - flux_e(i,j)) S_RUNINI.614
& / (ichgf * timestep) S_RUNINI.615
Do k = 1, nlevs S_RUNINI.616
ch_tls(i,j,k) = (tls(i,j+1,k) - tls(i,j,k)) S_RUNINI.617
& / (ichgf * timestep) S_RUNINI.618
ch_uls(i,j,k) = (uls(i,j+1,k) - uls(i,j,k)) S_RUNINI.619
& / (ichgf * timestep) S_RUNINI.620
ch_vls(i,j,k) = (vls(i,j+1,k) - vls(i,j,k)) S_RUNINI.621
& / (ichgf * timestep) S_RUNINI.622
enddo ! k S_RUNINI.623
enddo ! j S_RUNINI.624
Do j = 1, (nfor-1) S_RUNINI.625
Do k = 1, nwet S_RUNINI.626
ch_qls(i,j,k) = (qls(i,j+1,k) - qls(i,j,k)) S_RUNINI.627
& / (ichgf * timestep) S_RUNINI.628
enddo ! k S_RUNINI.629
enddo ! j S_RUNINI.630
enddo ! i S_RUNINI.631
endif S_RUNINI.632
c S_RUNINI.633
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! S_RUNINI.634
If (tapein) then S_RUNINI.635
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! S_RUNINI.636
C S_RUNINI.637
C--------------------------------------------------------------------- S_RUNINI.638
C Read tape data if required to carry on from previous run S_RUNINI.639
C--------------------------------------------------------------------- S_RUNINI.640
C S_RUNINI.641
Read (50) exname,runno,tapedump_no S_RUNINI.642
Write (6,205)exname,runno,tapedump_no S_RUNINI.643
205 Format S_RUNINI.644
& (' from tape header'/,' expt. name is ' S_RUNINI.645
& ,a6,/,' run no. is ',i4, S_RUNINI.646
& /,' no. of dumps on tape are ',i4) S_RUNINI.647
c S_RUNINI.648
C--------------------------------------------------------------------- S_RUNINI.649
C Check for correct data set S_RUNINI.650
C--------------------------------------------------------------------- S_RUNINI.651
C S_RUNINI.652
If (exname .eq. exname_in .and. runno .eq. runno_in) then S_RUNINI.653
C S_RUNINI.654
C--------------------------------------------------------------------- S_RUNINI.655
C Look for correct day - tapeday_init input in namelist S_RUNINI.656
C INDATA. S_RUNINI.657
C--------------------------------------------------------------------- S_RUNINI.658
C S_RUNINI.659
Do i = 1, tapedump_no S_RUNINI.660
If (stats) then S_RUNINI.661
Read (50) tapeday, resdump, iv, iy, idum S_RUNINI.662
elseif (obs) then S_RUNINI.663
Read (50) tapeday, resdump S_RUNINI.664
endif S_RUNINI.665
Write (6,200) tapeday, tapeday_init S_RUNINI.666
200 Format (' tape year day= ',i4,' start year day= ',i4) S_RUNINI.667
If (tapeday .eq. (tapeday_init-1) ) goto 999 S_RUNINI.668
C S_RUNINI.669
C If the end of the tape is reached and the specified day S_RUNINI.670
C tapeday_init not found o/p error message and stop run. S_RUNINI.671
C S_RUNINI.672
If (i .eq. tapedump_no) then S_RUNINI.673
Write (6,201) exname, runno S_RUNINI.674
201 Format S_RUNINI.675
& (' initial day not found on data set m20.',a6, S_RUNINI.676
& '.run',i3/) S_RUNINI.677
Stop S_RUNINI.678
endif S_RUNINI.679
enddo S_RUNINI.680
999 close (50) S_RUNINI.681
C S_RUNINI.682
C--------------------------------------------------------------------- S_RUNINI.683
C Read initial data from tape in DUMP format. S_RUNINI.684
C--------------------------------------------------------------------- S_RUNINI.685
C S_RUNINI.686
Call dumpinit( S_RUNINI.687
& points, nprimvars, nlevs, nwet, S_RUNINI.688
C S_RUNINI.689
& resdump, u, v, t, theta, q, qcl, qcf, layer_cloud, S_RUNINI.690
& pstar, t_deep_soil, smc, canopy, snodep, S_RUNINI.691
& tstar, zh, z0msea, S_RUNINI.692
& cca, rccb, rcct, smcl) S_RUNINI.693
C S_RUNINI.694
C Sometimes (when initial wind in dump is arbitrary) we want S_RUNINI.695
C to reset the wind to geostrophic. To do this set geoinit to S_RUNINI.696
C true in logic namelist S_RUNINI.697
C S_RUNINI.698
Do i = 1, points S_RUNINI.699
If (geoinit .and. geoforce) then S_RUNINI.700
Do k = 1, nlevs S_RUNINI.701
u(i,k) = ug(i) S_RUNINI.702
v(i,k) = vg(i) S_RUNINI.703
enddo S_RUNINI.704
endif S_RUNINI.705
iccb(i) = int(rccb(i)) S_RUNINI.706
icct(i) = int(rcct(i)) S_RUNINI.707
tsi(i) = tstar(i) S_RUNINI.708
enddo S_RUNINI.709
C S_RUNINI.710
C--------------------------------------------------------------------- S_RUNINI.711
C G05CGE restores the state of the basic generator S_RUNINI.712
C routine G05DDE following the call to G05CFE at the end of S_RUNINI.713
C each day. S_RUNINI.714
C--------------------------------------------------------------------- S_RUNINI.715
C S_RUNINI.716
Call G05CGE(idum,iv,iy) S_RUNINI.717
else S_RUNINI.718
Write (6,203) exname_in, runno_in S_RUNINI.719
203 Format (' initial data set m20',a6,'.run',i3,' not found'/) S_RUNINI.720
Stop S_RUNINI.721
endif ! (exname .eq. exname_in S_RUNINI.722
! .and. runno .eq. runno_in) S_RUNINI.723
S_RUNINI.724
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! S_RUNINI.725
else ! not tapein S_RUNINI.726
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! S_RUNINI.727
C Set initial values if no tape data to be used S_RUNINI.728
C--------------------------------------------------------------------- S_RUNINI.729
C S_RUNINI.730
Do i = 1, points S_RUNINI.731
pstar(i) = pstari(i) S_RUNINI.732
tstar(i) = tstari(i) S_RUNINI.733
tsi(i) = tstar(i) S_RUNINI.734
If (land_mask(i)) then S_RUNINI.735
canopy(i) = canopyi(i) S_RUNINI.736
snodep(i) = snodepi(i) S_RUNINI.737
smc(i) = smci(i) S_RUNINI.738
Do k = 1, nsoilt_levs S_RUNINI.739
t_deep_soil(i,k) = t_deep_soili(i,k) S_RUNINI.740
smcl(i,k) = smcli(i,k) S_RUNINI.741
enddo ! nsoilm_levs S_RUNINI.742
else S_RUNINI.743
smc(i) = 0.0 S_RUNINI.744
canopy(i) = 0.0 S_RUNINI.745
snodep(i) = 0.0 S_RUNINI.746
Do k = 1, nsoilt_levs S_RUNINI.747
t_deep_soil(i,k) = 0.0 S_RUNINI.748
enddo ! nsoilt_levs S_RUNINI.749
Do k = 1, nsoilm_levs S_RUNINI.750
smcl(i,k) = 0.0 S_RUNINI.751
enddo ! nsoilm_levs S_RUNINI.752
endif ! land_mask S_RUNINI.753
S_RUNINI.754
zh(i) = 500 ! Not neccessary but initialise for S_RUNINI.755
! consistency. S_RUNINI.756
z0msea(i) = z0mseai(i) S_RUNINI.757
cca(i) = ccai(i) S_RUNINI.758
iccb(i) = iccbi(i) S_RUNINI.759
icct(i) = iccti(i) S_RUNINI.760
enddo ! i S_RUNINI.761
S_RUNINI.762
Do i = 1, points S_RUNINI.763
If (land_mask(i)) then S_RUNINI.764
C--------------------------------------------------------------------- S_RUNINI.765
C Initialise the soil moisture in layers and in the root S_RUNINI.766
C zone (SMC) S_RUNINI.767
C--------------------------------------------------------------------- S_RUNINI.768
S_RUNINI.769
*IF DEF,A08_5A S_RUNINI.770
C MOSES S_RUNINI.771
C If soil moisture is to be initialised by soil stress S_RUNINI.772
C factor FSMC S_RUNINI.773
C S_RUNINI.774
If (init_m_fsmc) then S_RUNINI.775
fsmc_limit = (v_sat_nsite(i) - v_wilt_nsite(i)) S_RUNINI.776
& / (v_crit_nsite(i) - v_wilt_nsite(i)) S_RUNINI.777
If (fsmc(i) .gt. fsmc_limit) then S_RUNINI.778
Print *, S_RUNINI.779
& ' Soil moisture stress factor fsmc in namelist ', S_RUNINI.780
& 'too big - should be ', S_RUNINI.781
& 'le - (v_sat-v_wilt)/(v_crit-v_wilt)' S_RUNINI.782
Stop S_RUNINI.783
endif S_RUNINI.784
Do k = 1, nsoilm_levs S_RUNINI.785
smcl(i,k) = rho_water * dzsoil(k) S_RUNINI.786
& * ( fsmc(i) * v_crit_nsite(i) S_RUNINI.787
& + (1-fsmc(i)) * v_wilt_nsite(i) ) S_RUNINI.788
If (smcl(i,k) .lt. 0.0) then S_RUNINI.789
Print *, S_RUNINI.790
& ' Soil moisture stress factor fsmc in', S_RUNINI.791
& 'namelist too small - should be ', S_RUNINI.792
& 'ge - v_wilt/(v_crit-v_wilt)' S_RUNINI.793
Stop S_RUNINI.794
endif S_RUNINI.795
enddo S_RUNINI.796
c S_RUNINI.797
C If soil moisture is to be initialised by total soil S_RUNINI.798
C moisture as a fraction of saturation STH. S_RUNINI.799
C S_RUNINI.800
elseif (init_m_sth) then S_RUNINI.801
S_RUNINI.802
Do k = 1, nsoilm_levs S_RUNINI.803
If (sth(i,k) .lt. 0.0. or. sth(i,k) .gt. 1.0) then S_RUNINI.804
Print *, S_RUNINI.805
& ' STH values should be ge 0.0 and le 1.0) ' S_RUNINI.806
Stop S_RUNINI.807
endif S_RUNINI.808
smcl(i,k) = sth(i,k) * rho_water * dzsoil(k) S_RUNINI.809
& * v_sat_nsite(i) S_RUNINI.810
enddo S_RUNINI.811
endif ! init_m_fsmc S_RUNINI.812
S_RUNINI.813
*ELSEIF DEF,A08_1A S_RUNINI.814
C For single layer hydrology set smcl(1)=smc S_RUNINI.815
C (nsoilm_levs=1) S_RUNINI.816
C S_RUNINI.817
S_RUNINI.818
smcl(i,1) = smc(i) S_RUNINI.819
S_RUNINI.820
*ENDIF S_RUNINI.821
S_RUNINI.822
S_RUNINI.823
endif ! land_mask(i) S_RUNINI.824
enddo ! i S_RUNINI.825
C S_RUNINI.826
C--------------------------------------------------------------------- S_RUNINI.827
C Initialise soil temperatures including surface. S_RUNINI.828
C--------------------------------------------------------------------- S_RUNINI.829
C S_RUNINI.830
If (.not. altsoil) then S_RUNINI.831
S_RUNINI.832
*IF DEF,A08_5A S_RUNINI.833
C MOSES initialisation S_RUNINI.834
S_RUNINI.835
C Calc. heat conductivity HCON_T and heat capacity S_RUNINI.836
C HCAP_T for the top layer. S_RUNINI.837
C Assume top soil layer is unfrozen and T_DEEP_SOIL=280 S_RUNINI.838
C (just above freezing) S_RUNINI.839
S_RUNINI.840
Do i = 1, points S_RUNINI.841
If (land_mask(i)) then S_RUNINI.842
sthu_t(i) = smcl(i,1) S_RUNINI.843
& / (rho_water* dzsoil(1) * v_sat_nsite(i)) S_RUNINI.844
sthf_t(i) = 0.0 S_RUNINI.845
t_deep_soil_t(i) = 280.0 S_RUNINI.846
endif S_RUNINI.847
enddo S_RUNINI.848
Call HEAT_CON (points, hcon_nsite, sthu_t, sthf_t, S_RUNINI.849
& v_sat_nsite, hcon_t, ltimer) S_RUNINI.850
S_RUNINI.851
C initialize soil index S_RUNINI.852
j = 0 S_RUNINI.853
Do i = 1, points S_RUNINI.854
If (land_mask(i)) then S_RUNINI.855
j = j + 1 S_RUNINI.856
soil_index(i) = i S_RUNINI.857
endif S_RUNINI.858
enddo S_RUNINI.859
Call HEAT_CAP (points, j, soil_index, b_exp_nsite, S_RUNINI.860
& dzsoil(1), hcap_nsite, sathh_nsite, smcl, sthf_t, S_RUNINI.861
& t_deep_soil_t, v_sat_nsite, hcap_t, ltimer) S_RUNINI.862
S_RUNINI.863
S_RUNINI.864
Do i = 1, points S_RUNINI.865
C Calculate omega_t for the top layer and use for S_RUNINI.866
C initialisation of deep soil temps. S_RUNINI.867
omega_t(i) = 2.0 * hcon_t(i) / (hcap_t(i) * dzsoil(1)**2) S_RUNINI.868
C nsoilt deep soil temps. calculated using layer depths S_RUNINI.869
C and top one also used for tstar S_RUNINI.870
enddo ! i S_RUNINI.871
Do k = 1, nsoilt_levs S_RUNINI.872
layer_depth(k) = dzsoil(k) / dzsoil(1) S_RUNINI.873
enddo ! k S_RUNINI.874
C NSOILT deep soil temps. calculated using layer S_RUNINI.875
C depths and top one also used for TSTAR. S_RUNINI.876
S_RUNINI.877
Call INITSOIL(points, land_mask, omega_t, layer_depth, S_RUNINI.878
& nsoilt_levs, S_RUNINI.879
& tconst, andayy, dtday, dtyear, time_init, S_RUNINI.880
& dayno_wint, tsoil_init) S_RUNINI.881
Do i = 1, points S_RUNINI.882
tstar(i) = tsoil_init(i,1) S_RUNINI.883
Do k = 1, nsoilt_levs S_RUNINI.884
t_deep_soil(i,k) = tsoil_init(i,k) S_RUNINI.885
enddo S_RUNINI.886
enddo S_RUNINI.887
S_RUNINI.888
*ELSEIF DEF,A08_1A S_RUNINI.889
C Standard single or multilayer hydrology S_RUNINI.890
C nsoilt_levs+1 calculated using layer depths and (1) S_RUNINI.891
C used for tstar. S_RUNINI.892
C Use the omega_1 value from comdeck c_soilh S_RUNINI.893
S_RUNINI.894
Do i = 1, points S_RUNINI.895
omega_t(i) = omega1 S_RUNINI.896
enddo S_RUNINI.897
Call INITSOIL(points, land_mask, omega_t, layer_depth, S_RUNINI.898
& nsoilt_levs+1, S_RUNINI.899
& tconst, andayy, dtday, dtyear, time_init, S_RUNINI.900
& dayno_wint, tsoil_init) S_RUNINI.901
Do i = 1, points S_RUNINI.902
tstar(i) = tsoil_init(i,1) S_RUNINI.903
Do k = 1, nsoilt_levs S_RUNINI.904
t_deep_soil(i,k) = tsoil_init(i,k+1) S_RUNINI.905
enddo S_RUNINI.906
enddo S_RUNINI.907
S_RUNINI.908
*ENDIF S_RUNINI.909
endif ! .not. altsoil S_RUNINI.910
S_RUNINI.911
endif ! tapein S_RUNINI.912
C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! S_RUNINI.913
*IF DEF,A08_5A S_RUNINI.914
C--------------------------------------------------------------------- S_RUNINI.915
C Initialise the stomatol conductance for MOSES. S_RUNINI.916
C--------------------------------------------------------------------- S_RUNINI.917
C--------------------------------------------------------------------- S_RUNINI.918
C Initialise the frozen and unfrozen soil moisture for MOSES S_RUNINI.919
C--------------------------------------------------------------------- S_RUNINI.920
Call FREEZE_SOIL (points, nsoilm_levs, S_RUNINI.921
& b_exp_nsite, dzsoil, sathh_nsite, S_RUNINI.922
& smcl, t_deep_soil, v_sat_nsite, sthu, sthf) S_RUNINI.923
*ENDIF S_RUNINI.924
S_RUNINI.925
C S_RUNINI.926
C--------------------------------------------------------------------- S_RUNINI.927
C Calculate EXNER function based on initial PSTAR S_RUNINI.928
C--------------------------------------------------------------------- S_RUNINI.929
C S_RUNINI.930
Call EXNER_CALC(points, nlevs, akh, bkh, pstar, exner) S_RUNINI.931
C S_RUNINI.932
C--------------------------------------------------------------------- S_RUNINI.933
C Calculate DELTA_AKs and DELTA_BKs S_RUNINI.934
C--------------------------------------------------------------------- S_RUNINI.935
C S_RUNINI.936
Do k = 1, nlevs S_RUNINI.937
delta_ak(k) = akh(k+1) - akh(k) S_RUNINI.938
delta_bk(k) = bkh(k+1) - bkh(k) S_RUNINI.939
enddo S_RUNINI.940
C--------------------------------------------------------------------- S_RUNINI.941
C Initialise cloud water (QCL,QCF) S_RUNINI.942
C--------------------------------------------------------------------- S_RUNINI.943
C S_RUNINI.944
If (.not. tapein) then S_RUNINI.945
Do jlev = 1, nwet S_RUNINI.946
Call INITQLCF S_RUNINI.947
& (ak,bk,rhcrit,pstar,q(1,jlev),t(1,jlev),nlevs, S_RUNINI.948
& points,layer_cloud(1,jlev), S_RUNINI.949
& qcf(1,jlev),qcl(1,jlev),nbl_levs,jlev) S_RUNINI.950
enddo S_RUNINI.951
S_RUNINI.952
c S_RUNINI.953
c--------------------------------------------------------------------- S_RUNINI.954
c Convert temperature to potential temperature S_RUNINI.955
c--------------------------------------------------------------------- S_RUNINI.956
c S_RUNINI.957
Call THETA_CALC(theta, t, exner, pstar, akh, bkh, S_RUNINI.958
& nlevs, points) S_RUNINI.959
endif S_RUNINI.960
C S_RUNINI.961
C--------------------------------------------------------------------- S_RUNINI.962
C Zero diagnostics for observational forcing S_RUNINI.963
C--------------------------------------------------------------------- S_RUNINI.964
C S_RUNINI.965
If (obs .and. prindump_obs) then S_RUNINI.966
Do i = 1, points S_RUNINI.967
Do k = 1, nlevs S_RUNINI.968
Do j = 1, 36 S_RUNINI.969
dap1(i,j,k) = 0.0 S_RUNINI.970
dap2(i,j,k) = 0.0 S_RUNINI.971
Do l = 1, nfor-1 S_RUNINI.972
dap3(i,j,k,l) = 0.0 S_RUNINI.973
enddo S_RUNINI.974
enddo S_RUNINI.975
enddo S_RUNINI.976
Do j = 1, 44 S_RUNINI.977
dab1(i,j) = 0.0 S_RUNINI.978
dab2(i,j) = 0.0 S_RUNINI.979
Do k = 1, nfor-1 S_RUNINI.980
dab3(i,j,k) = 0.0 S_RUNINI.981
enddo S_RUNINI.982
enddo S_RUNINI.983
Do k = 1, nlevs S_RUNINI.984
deltap(i,k) = -delta_ak(k) - delta_bk(k) * pstar(i) S_RUNINI.985
enddo S_RUNINI.986
enddo ! i S_RUNINI.987
endif ! obs S_RUNINI.988
S_RUNINI.989
C S_RUNINI.990
C--------------------------------------------------------------------- S_RUNINI.991
C Radiation - LWLKIN in UM code deck LWTRAN, SWLKIN in UM code S_RUNINI.992
C SWTRAN. S_RUNINI.993
C Initialise the LW and SW spectral band tables - standard S_RUNINI.994
C Radiation code. S_RUNINI.995
C For Edwards-Slingo radiation code 3A use R2_LW_SPECIN and S_RUNINI.996
C R2_SW_SPECIN . S_RUNINI.997
C (in deck SPIN3A) to pick up the spectral files from units 57 S_RUNINI.998
C (SW) and 80 (LW). S_RUNINI.999
C--------------------------------------------------------------------- S_RUNINI.1000
C Longwave S_RUNINI.1001
*IF DEF,A02_3A S_RUNINI.1002
icode = 0 S_RUNINI.1003
Call r2_lw_specin(icode, cmessage S_RUNINI.1004
& , l_ch4, l_n2o, l_cfc11, l_cfc12 S_RUNINI.1005
& , l_cfc113, l_hcfc22, l_hfc125, l_hfc134a S_RUNINI.1006
& , l_climat_aerosol, l_use_sulpc_direct S_RUNINI.1007
& , l_use_soot_direct S_RUNINI.1008
& ) S_RUNINI.1009
If (icode.ne.0) then S_RUNINI.1010
Print *, cmessage S_RUNINI.1011
stop S_RUNINI.1012
endif S_RUNINI.1013
*ELSE S_RUNINI.1014
Call LWLKIN (lwlut) S_RUNINI.1015
*ENDIF S_RUNINI.1016
C Shortwave S_RUNINI.1017
*IF DEF,A01_3A S_RUNINI.1018
icode = 0 S_RUNINI.1019
Call r2_sw_specin(icode, cmessage S_RUNINI.1020
& , l_o2 S_RUNINI.1021
& , l_climat_aerosol, l_use_sulpc_direct S_RUNINI.1022
& , l_use_soot_direct S_RUNINI.1023
& ) S_RUNINI.1024
If (icode.ne.0) then S_RUNINI.1025
Print *, cmessage S_RUNINI.1026
Stop S_RUNINI.1027
endif S_RUNINI.1028
*ELSE S_RUNINI.1029
Call SWLKIN (swlut) S_RUNINI.1030
*ENDIF S_RUNINI.1031
C S_RUNINI.1032
C--------------------------------------------------------------------- S_RUNINI.1033
C Write restart dump information to tape S_RUNINI.1034
C--------------------------------------------------------------------- S_RUNINI.1035
C S_RUNINI.1036
If (tapeout) then S_RUNINI.1037
nresdump = int( ndayin / resdump_days) S_RUNINI.1038
If (mod(ndayin, resdump_days) .ne. 0) nresdump = nresdump + 1 S_RUNINI.1039
Write (55) exname_out,runno_out,nresdump S_RUNINI.1040
endif S_RUNINI.1041
S_RUNINI.1042
Return S_RUNINI.1043
End S_RUNINI.1044
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_RUNINI.1045
*ENDIF S_RUNINI.1046