*IF DEF,SCMA S_FORCNG.2
C *****************************COPYRIGHT****************************** S_FORCNG.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. S_FORCNG.4
C S_FORCNG.5
C Use, duplication or disclosure of this code is subject to the S_FORCNG.6
C restrictions as set forth in the contract. S_FORCNG.7
C S_FORCNG.8
C Meteorological Office S_FORCNG.9
C London Road S_FORCNG.10
C BRACKNELL S_FORCNG.11
C Berkshire UK S_FORCNG.12
C RG12 2SZ S_FORCNG.13
C S_FORCNG.14
C If no contract has been raised with this copy of the code, the use, S_FORCNG.15
C duplication or disclosure of it is strictly prohibited. Permission S_FORCNG.16
C to do so must first be obtained in writing from the Head of Numerical S_FORCNG.17
C Modelling at the above address. S_FORCNG.18
C ******************************COPYRIGHT****************************** S_FORCNG.19
C S_FORCNG.20
C-----Subroutine FORCING S_FORCNG.21
C S_FORCNG.22
C Purpose: Called by SCMMAIN (Single Column Model main routine) S_FORCNG.23
C to apply the appropriate Forcing (code was previously S_FORCNG.24
C in the main Calling routine SCMMAIN ). S_FORCNG.25
C S_FORCNG.26
C Code Description: S_FORCNG.27
C Language - FORTRAN 77 S_FORCNG.28
C S_FORCNG.29
C Author: C. Bunton S_FORCNG.30
C S_FORCNG.31
C Modification History: S_FORCNG.32
C Version Date Change S_FORCNG.33
C 4.5 07/98 SCM integrated as a standard UM configuration S_FORCNG.34
C JC Thil. S_FORCNG.35
C S_FORCNG.36
C Documentation: Single Column Model Guide - J. Lean S_FORCNG.37
C===================================================================== S_FORCNG.38
C Options to set initial profiles S_FORCNG.39
C===================================================================== S_FORCNG.40
C (i) Observational large scale forcing (OBS=TRUE of namelist LOGIC) S_FORCNG.41
C Initial data is then from namelist INPROF S_FORCNG.42
C (ii) Statistical large scale forcing (STATS=TRUE of namelist LOGIC) S_FORCNG.43
C Initial data can either be derived from climate datasets S_FORCNG.44
C using subroutine INITSTAT or set from namelist S_FORCNG.45
C INPROF (set ALTDAT=TRUE in namelist LOGIC) S_FORCNG.46
C (iii) No large-scale forcing initial data is set fron namelist S_FORCNG.47
C INPROF S_FORCNG.48
C (iv) Continuation from previous run stored on tape S_FORCNG.49
C (Set TAPEIN=TRUE in namelist LOGIC). All other initial data S_FORCNG.50
C is overwritten S_FORCNG.51
C===================================================================== S_FORCNG.52
C--------------------------------------------------------------------- S_FORCNG.53
Subroutine FORCING( 1,1S_FORCNG.54
C ! IN leading dimensions of arrays S_FORCNG.55
& points, nlevs, nwet S_FORCNG.56
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_FORCNG.57
C ! IN S_FORCNG.58
& ,sec_day S_FORCNG.59
C ! S_FORCNG.60
& ,stats, obs, prindump_obs, prinstat, S_FORCNG.61
& dayno_wint, daycount, daysteps, stepcount, S_FORCNG.62
& timestep, ichgf, S_FORCNG.63
& ad, at, avn, aw, cdbar, cdsd, ctbar, ctsd, S_FORCNG.64
& cvnbar, cvnsd, cwbar, cwsd, dbar, dsd, ddash, S_FORCNG.65
& deltan, p, rp, S_FORCNG.66
& px, py, tbar, tdash, tsd, vnbar, vnsd, vpbar, S_FORCNG.67
& wbar, wsd, S_FORCNG.68
C ! INOUT S_FORCNG.69
& t, q, u, v, qr, tr, vnr, vpr, wr, S_FORCNG.70
& flux_h, flux_e, tls, qls, uls, vls, S_FORCNG.71
& ch_flux_h, ch_flux_e, ch_tls, ch_qls, S_FORCNG.72
& ch_uls, ch_vls, S_FORCNG.73
C ! OUT S_FORCNG.74
& dap1, dab1, t_init, q_init, ilscnt, rhokh, S_FORCNG.75
& factor_rhokh, iv, ntab, iy, idum S_FORCNG.76
& ) S_FORCNG.77
C S_FORCNG.78
Implicit none S_FORCNG.79
C S_FORCNG.80
C--------------------------------------------------------------------- S_FORCNG.81
C Arguments S_FORCNG.82
C--------------------------------------------------------------------- S_FORCNG.83
C S_FORCNG.84
Integer S_FORCNG.85
& points ! IN leading dimension of SCM arrays. S_FORCNG.86
& ,nlevs ! IN no of levels. S_FORCNG.87
& ,nwet ! IN no of model levels in which Q is S_FORCNG.88
& ,nfor ! IN Number terms for observational S_FORCNG.89
! forcing S_FORCNG.90
& ,nbl_levs ! IN Number of Boundary layer levels S_FORCNG.91
& ,nsoilt_levs ! IN Number of soil temp levels S_FORCNG.92
& ,nsoilm_levs ! IN Number of soil moisture levels S_FORCNG.93
& ,ntrop ! IN Max number of levels in the S_FORCNG.94
! troposphere S_FORCNG.95
Real S_FORCNG.96
& sec_day S_FORCNG.97
S_FORCNG.98
Integer S_FORCNG.99
& daycount ! IN Daynumber (1 represents S_FORCNG.100
! 1st january) S_FORCNG.101
& ,dayno_wint ! IN Daynumber relative to winter S_FORCNG.102
! solstice S_FORCNG.103
& ,daysteps ! IN No. of timesteps in 1 day S_FORCNG.104
& ,ichgf ! IN No. of timesteps between change S_FORCNG.105
! in observational forcing S_FORCNG.106
& ,ilscnt ! INOUT Counts for observational S_FORCNG.107
! forcing S_FORCNG.108
& ,ntab ! IN Dimension of array used in S_FORCNG.109
! random generator S_FORCNG.110
& ,iv(ntab),iy,idum ! IN state of number generator saved S_FORCNG.111
! on tape for continuation run S_FORCNG.112
& ,stepcount ! IN Timestep counter S_FORCNG.113
Logical S_FORCNG.114
& obs S_FORCNG.115
& ,prindump_obs ! T if printout of obs. results S_FORCNG.116
! required S_FORCNG.117
& ,prinstat ! T if printout of increments S_FORCNG.118
! due to statistical forcing S_FORCNG.119
! required each timestep S_FORCNG.120
& ,stats S_FORCNG.121
Real S_FORCNG.122
& ad(points,nwet-1) ! IN term a of equation 2.22 for dew S_FORCNG.123
& ,at(points,nlevs-1) ! pt depression and temp. S_FORCNG.124
& ,avn(points,nlevs-1) ! IN term a of equation 2.22 for S_FORCNG.125
& ,aw(points,ntrop-1) ! horiz. and vertical velocities S_FORCNG.126
& ,cdbar(points,nwet) ! Mean and SD of random variable S_FORCNG.127
& ,cdsd(points,nwet) ! for dew point depression S_FORCNG.128
& ,ctbar(points,nlevs) ! IN Mean and SD of random variable S_FORCNG.129
& ,ctsd(points,nlevs) ! for temp. S_FORCNG.130
& ,cvnbar(points,nlevs) ! IN Mean and SD of random variable S_FORCNG.131
& ,cvnsd(points,nlevs) ! for velocity VN S_FORCNG.132
& ,cwbar(points,ntrop) ! IN Mean and SD of random variable S_FORCNG.133
& ,cwsd(points,ntrop) ! for vertical velocity S_FORCNG.134
& ,dab1(points,44) ! OUT Observational diagnostics S_FORCNG.135
& ,dap1(points,36,nlevs) ! OUT Observational diagnostics S_FORCNG.136
& ,dbar(points,nwet) ! IN Mean and SD dewpoint S_FORCNG.137
& ,dsd(points,nwet) ! depression at daycount days S_FORCNG.138
! from winter solstice (K) S_FORCNG.139
& ,ddash(points,nwet) ! IN Dew pt. corrections S_FORCNG.140
& ,deltan(points) ! IN Radius of area (m) S_FORCNG.141
& ,factor_rhokh(points) S_FORCNG.142
& ,flux_h(points,nfor) ! INOUT S_FORCNG.143
& ,ch_flux_h(points,nfor-1) ! IN Change per sec in FLUX_H S_FORCNG.144
& ,flux_e(points,nfor) ! INOUT S_FORCNG.145
& ,ch_flux_e(points,nfor-1) ! IN Change per sec in FLUX_E S_FORCNG.146
& ,p(points,nlevs) ! IN Pressure coordinates (Pa) S_FORCNG.147
& ,px(points,ntrop) ! IN Reciprocal log functions for S_FORCNG.148
& ,py(points,ntrop-1) ! calc. of vert. advection S_FORCNG.149
! used in eqns 2.12 and 2.13 S_FORCNG.150
& ,q(points,nwet) ! INOUT Specific humidity (kg kg^-1) S_FORCNG.151
& ,q_init(points,nwet) ! OUT Initial specific humidity S_FORCNG.152
! (kg kg^-1) S_FORCNG.153
& ,qr(points,nwet,2) ! INOUT Randomly sampled humidity S_FORCNG.154
! (kg kg^-1) S_FORCNG.155
& ,rhokh(points,nbl_levs) S_FORCNG.156
& ,rp(points,nlevs) ! IN Reciprocal pressure for sigma S_FORCNG.157
! levels (HPa or mb ^-1) S_FORCNG.158
& ,t(points,nlevs) ! INOUT Temp (K) S_FORCNG.159
& ,t_init(points,nlevs) ! OUT Initial temp (K) S_FORCNG.160
& ,tbar(points,nlevs) ! IN Mean and SD temperature at S_FORCNG.161
! daycount days from S_FORCNG.162
! winter solstice (K) S_FORCNG.163
& ,tdash(points,nlevs) ! IN Temp. corrections (K) S_FORCNG.164
& ,timestep ! IN model timestep (s) S_FORCNG.165
& ,tls(points,nfor,nlevs) ! INOUT Temp increment due to S_FORCNG.166
! large-scale horizontal and S_FORCNG.167
! vertical advection S_FORCNG.168
! (K s^-1 day^-1) S_FORCNG.169
& ,ch_tls(points,nfor-1,nlevs) ! IN Change per sec in Temp incre S_FORCNG.170
& ,qls(points,nfor,nwet) ! Specific humidity increment S_FORCNG.171
! due to large-scale horizontal S_FORCNG.172
! and vertical advection S_FORCNG.173
! (kg kg^-1 s^-1 day^-1) S_FORCNG.174
& ,ch_qls(points,nfor-1,nwet) ! IN change per sec in Spec humid S_FORCNG.175
! increment S_FORCNG.176
& ,uls(points,nfor,nlevs) ! Zonal and meridional wind S_FORCNG.177
& ,vls(points,nfor,nlevs) ! increment due to large-scale S_FORCNG.178
! horizontal and vertical S_FORCNG.179
& ,ch_uls(points,nfor-1,nlevs) ! IN change per sec in Zonal and S_FORCNG.180
& ,ch_vls(points,nfor-1,nlevs) ! merid wind S_FORCNG.181
& ,tsd(points,nlevs) ! IN SD of temp. at daycount days S_FORCNG.182
! from winter solstice (K) S_FORCNG.183
& ,tr(points,nlevs,2) ! INOUT Randomly sampled temp. (K) S_FORCNG.184
& ,u(points,nlevs) ! OUT Zonal and meridional winds S_FORCNG.185
& ,v(points,nlevs) ! (m s^-1) S_FORCNG.186
& ,vnbar(points,nlevs) ! IN Mean and SD velocity VN at S_FORCNG.187
! daycount days from S_FORCNG.188
! winter solstice (m s^-1) S_FORCNG.189
& ,vnr(points,nlevs,2) ! INOUT Randomly sampled horizontal S_FORCNG.190
! velocity (m s^-1) S_FORCNG.191
& ,vnsd(points,nlevs) ! IN Mean and SD velocity VN at S_FORCNG.192
! daycount days from S_FORCNG.193
! winter solstice (m s^-1) S_FORCNG.194
& ,vpbar(points,nlevs) ! IN Mean velocity VP at S_FORCNG.195
! daycount days from S_FORCNG.196
! winter solstice (m s^-1) S_FORCNG.197
& ,vpr(points,nlevs,2) ! INOUT Randomly sampled horizontal S_FORCNG.198
! velocity (m s^-1) S_FORCNG.199
& ,wbar(points,ntrop) ! IN Mean and SD vertical S_FORCNG.200
& ,wsd(points,ntrop) ! velocity at daycount days S_FORCNG.201
! from winter solstice (mb s^-1) S_FORCNG.202
& ,wr(points,ntrop,2) ! INOUT Randomly sampled vertical S_FORCNG.203
! velocity (mb s^-1) S_FORCNG.204
C--------------------------------------------------------------------- S_FORCNG.205
C Local variables S_FORCNG.206
C--------------------------------------------------------------------- S_FORCNG.207
Integer S_FORCNG.208
& i, j, l S_FORCNG.209
Real S_FORCNG.210
& tstpfd S_FORCNG.211
C S_FORCNG.212
C--------------------------------------------------------------------- S_FORCNG.213
C Control variable S_FORCNG.214
C--------------------------------------------------------------------- S_FORCNG.215
tstpfd = timestep / sec_day S_FORCNG.216
C S_FORCNG.217
C--------------------------------------------------------------------- S_FORCNG.218
C Set instantaneous profiles and budgets to zero for OBS forcing S_FORCNG.219
C--------------------------------------------------------------------- S_FORCNG.220
C S_FORCNG.221
If (obs) then S_FORCNG.222
Do i = 1, nlevs S_FORCNG.223
Do l = 1, points S_FORCNG.224
t_init(l,i) = t(l,i) S_FORCNG.225
enddo S_FORCNG.226
enddo ! i S_FORCNG.227
Do i = 1, nwet S_FORCNG.228
Do l = 1, points S_FORCNG.229
q_init(l,i) = q(l,i) S_FORCNG.230
enddo S_FORCNG.231
enddo ! i S_FORCNG.232
If (prindump_obs) then S_FORCNG.233
Do i = 1, nlevs S_FORCNG.234
Do j = 1, 36 S_FORCNG.235
Do l = 1, points S_FORCNG.236
dap1(l,j,i) = 0.0 S_FORCNG.237
enddo S_FORCNG.238
enddo ! j S_FORCNG.239
enddo ! i S_FORCNG.240
Do j = 1, 44 S_FORCNG.241
Do l = 1, points S_FORCNG.242
dab1(l,j) = 0.0 S_FORCNG.243
enddo S_FORCNG.244
enddo ! j S_FORCNG.245
endif ! prindump_obs S_FORCNG.246
endif ! OBS S_FORCNG.247
C S_FORCNG.248
C--------------------------------------------------------------------- S_FORCNG.249
C If statistical forcing required:- S_FORCNG.250
C Set up 2 profiles. 1 for start of day plus 1 for start of S_FORCNG.251
C following day and linearly interpolate between 2 values for S_FORCNG.252
C all forcing variables. Increments to T and Q added and U S_FORCNG.253
C and V calculated S_FORCNG.254
C--------------------------------------------------------------------- S_FORCNG.255
C S_FORCNG.256
If (stats) then S_FORCNG.257
Call STATSTEP
( S_FORCNG.258
C ! IN S_FORCNG.259
& points, nlevs, nwet, ntrop, S_FORCNG.260
C ! S_FORCNG.261
& deltan, px, py, daysteps, stepcount, dayno_wint, S_FORCNG.262
& tr, vnr, vpr, qr, wr, tbar, tsd, tdash, S_FORCNG.263
& dbar, dsd, ddash, vnbar, vpbar, S_FORCNG.264
& vnsd, wbar, wsd, ctbar, S_FORCNG.265
& ctsd, at, cdbar, cdsd, ad, cvnbar, cvnsd, avn, S_FORCNG.266
& cwbar, cwsd, aw, p, rp, u, v, t, q, prinstat, S_FORCNG.267
& daycount, timestep, iv, ntab, iy, idum) S_FORCNG.268
elseif (obs) then S_FORCNG.269
C S_FORCNG.270
C--------------------------------------------------------------------- S_FORCNG.271
C Select forcing value for time of day S_FORCNG.272
C--------------------------------------------------------------------- S_FORCNG.273
C S_FORCNG.274
If (mod((daycount-1) * int(sec_day) S_FORCNG.275
& + (stepcount-1) * int(timestep) S_FORCNG.276
& , ichgf * int(timestep)) .eq. 0) S_FORCNG.277
& ilscnt = ilscnt + 1 S_FORCNG.278
If (ilscnt .eq. 0) ilscnt = 1 S_FORCNG.279
If (ilscnt .ge. nfor) ilscnt = 1 S_FORCNG.280
C S_FORCNG.281
C--------------------------------------------------------------------- S_FORCNG.282
C tls(nfor,k) etc contains present value of forcing S_FORCNG.283
C--------------------------------------------------------------------- S_FORCNG.284
C S_FORCNG.285
Do l = 1, points S_FORCNG.286
flux_h(l,nfor) = flux_h(l,nfor) S_FORCNG.287
& + ch_flux_h(l,ilscnt) * timestep S_FORCNG.288
flux_e(l,nfor) = flux_e(l,nfor) S_FORCNG.289
& + ch_flux_e(l,ilscnt) * timestep S_FORCNG.290
rhokh(l,1) = flux_h(l,nfor) S_FORCNG.291
factor_rhokh(l) = flux_e(l,nfor) S_FORCNG.292
Do i = 1, nlevs S_FORCNG.293
tls(l,nfor,i) = tls(l,nfor,i) S_FORCNG.294
& + ch_tls(l,ilscnt,i) * timestep S_FORCNG.295
uls(l,nfor,i) = uls(l,nfor,i) S_FORCNG.296
& + ch_uls(l,ilscnt,i) * timestep S_FORCNG.297
vls(l,nfor,i) = vls(l,nfor,i) S_FORCNG.298
& + ch_vls(l,ilscnt,i) * timestep S_FORCNG.299
t(l,i) = t(l,i) + tls(l,nfor,i) * tstpfd S_FORCNG.300
u(l,i) = u(l,i) + uls(l,nfor,i) * tstpfd S_FORCNG.301
v(l,i) = v(l,i) + vls(l,nfor,i) * tstpfd S_FORCNG.302
enddo ! i S_FORCNG.303
Do i = 1, nwet S_FORCNG.304
qls(l,nfor,i) = qls(l,nfor,i) S_FORCNG.305
& + ch_qls(l,ilscnt,i) * timestep S_FORCNG.306
q(l,i) = q(l,i) + qls(l,nfor,i) * tstpfd S_FORCNG.307
enddo ! i S_FORCNG.308
S_FORCNG.309
If (prindump_obs) then S_FORCNG.310
Do i = 1, nlevs S_FORCNG.311
dap1(l,10,i) = tls(l,nfor,i) / sec_day S_FORCNG.312
enddo ! i S_FORCNG.313
Do i = 1, nwet S_FORCNG.314
dap1(l,20,i) = qls(l,nfor,i) * 1000.0 / sec_day S_FORCNG.315
enddo ! i S_FORCNG.316
endif S_FORCNG.317
enddo S_FORCNG.318
endif ! stats or obs S_FORCNG.319
Return S_FORCNG.320
End ! Subroutine FORCING S_FORCNG.321
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_FORCNG.322
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ S_FORCNG.323
*ENDIF S_FORCNG.324