*IF DEF,SCMA S_SUBDAT.2
C *****************************COPYRIGHT****************************** S_SUBDAT.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. S_SUBDAT.4
C S_SUBDAT.5
C Use, duplication or disclosure of this code is subject to the S_SUBDAT.6
C restrictions as set forth in the contract. S_SUBDAT.7
C S_SUBDAT.8
C Meteorological Office S_SUBDAT.9
C London Road S_SUBDAT.10
C BRACKNELL S_SUBDAT.11
C Berkshire UK S_SUBDAT.12
C RG12 2SZ S_SUBDAT.13
C S_SUBDAT.14
C If no contract has been raised with this copy of the code, the use, S_SUBDAT.15
C duplication or disclosure of it is strictly prohibited. Permission S_SUBDAT.16
C to do so must first be obtained in writing from the Head of Numerical S_SUBDAT.17
C Modelling at the above address. S_SUBDAT.18
C ******************************COPYRIGHT****************************** S_SUBDAT.19
C S_SUBDAT.20
C Subroutine SUB_DATA S_SUBDAT.21
C Purpose:- To be used in test runs when detailed S_SUBDAT.22
C sub-timestep diagnostics are required after S_SUBDAT.23
C calls to each subroutine or when budget calcs. S_SUBDAT.24
C are required and so called at start and S_SUBDAT.25
C end of meaning period S_SUBDAT.26
C S_SUBDAT.27
C Programmer:- J. LEAN 15/6/91 S_SUBDAT.28
C S_SUBDAT.29
C Modification History: S_SUBDAT.30
C 4.5 07/98 SCM integrated as a standard UM configuration S_SUBDAT.31
C JC Thil. S_SUBDAT.32
C = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = S_SUBDAT.33
C S_SUBDAT.34
Subroutine SUB_DATA( 14S_SUBDAT.35
C ! IN leading dimensions of arrays S_SUBDAT.36
& points, nlevs, nwet S_SUBDAT.37
& ,nfor, nbl_levs, nsoilt_levs, nsoilm_levs, ntrop S_SUBDAT.38
C ! S_SUBDAT.39
& ,title1, istep, ayear, aday, atime_string, rday S_SUBDAT.40
& ,u, v, t, theta, q, qcl, qcf, lca, pstar, t_deep_soil, smc S_SUBDAT.41
& ,canopy, snodep, tstar, zh, z0msea, cca, iccb, icct, smcl) S_SUBDAT.42
S_SUBDAT.43
Implicit none S_SUBDAT.44
C S_SUBDAT.45
C--------------------------------------------------------------------- S_SUBDAT.46
C Arguments S_SUBDAT.47
C--------------------------------------------------------------------- S_SUBDAT.48
C S_SUBDAT.49
Integer S_SUBDAT.50
& points ! IN no of model sites. S_SUBDAT.51
& ,nlevs ! IN no of levels. S_SUBDAT.52
& ,nwet ! IN no of model levels in which Q is S_SUBDAT.53
! set. S_SUBDAT.54
& ,nfor ! IN Number terms for observational S_SUBDAT.55
! forcing S_SUBDAT.56
& ,nbl_levs ! IN Number of Boundary layer levels S_SUBDAT.57
& ,nsoilt_levs ! IN Number of soil temperature S_SUBDAT.58
! levels S_SUBDAT.59
& ,nsoilm_levs ! IN Number of soil moisture levels S_SUBDAT.60
& ,ntrop ! IN Max number of levels in the S_SUBDAT.61
! troposphere S_SUBDAT.62
Character*35 S_SUBDAT.63
& title1 ! Table heading S_SUBDAT.64
Character*8 S_SUBDAT.65
& atime_string ! Actual time at end of timestep S_SUBDAT.66
Integer S_SUBDAT.67
& iccb(points) ! Convective cloud base,top S_SUBDAT.68
& ,icct(points) S_SUBDAT.69
& ,aday ! Actual day number S_SUBDAT.70
& ,ayear ! Actual year number S_SUBDAT.71
& ,rday ! Runday number S_SUBDAT.72
& ,istep ! Timestep number S_SUBDAT.73
Real S_SUBDAT.74
& canopy(points) ! Surface/canopy water (kg m^-2) S_SUBDAT.75
& ,cca(points) ! Convective cloud amount S_SUBDAT.76
& ,lca(points,nwet) ! Layer cloud amount (decimal S_SUBDAT.77
! fraction) S_SUBDAT.78
& ,Pstar(points) ! Surface pressure (Pa) S_SUBDAT.79
& ,Q(points,nwet) ! Specific humidity (kg kg^-1) S_SUBDAT.80
& ,Qcf(points,nwet) ! Specific cloud ice (kg kg^-1) S_SUBDAT.81
& ,Qcl(points,nwet) ! Specific cloud water (kg kg^-1) S_SUBDAT.82
& ,smc(points) ! Soil moisture content (kg m^-2) S_SUBDAT.83
& ,smcl(points,nsoilm_levs) ! Soil moisture inlayers (kg m^-2) S_SUBDAT.84
& ,snodep(points) ! Snow depth (kg m^-2) S_SUBDAT.85
& ,t_deep_soil(points,nsoilt_levs) ! Soil layer temps (K) S_SUBDAT.86
& ,t(points,nlevs) ! Temperature (K) S_SUBDAT.87
& ,theta(points,nlevs) ! Potential temperature (K) S_SUBDAT.88
& ,Tstar(points) ! Surface temp.(K) S_SUBDAT.89
& ,u(points,nlevs) S_SUBDAT.90
& ,v(points,nlevs) ! Zonal,meridional wind (m s^-1) S_SUBDAT.91
& ,zh(points) ! Boundary layer depth (m) S_SUBDAT.92
& ,Z0mSea(points) ! Sea surface roughness length(m) S_SUBDAT.93
C S_SUBDAT.94
C--------------------------------------------------------------------- S_SUBDAT.95
C Local variables S_SUBDAT.96
C--------------------------------------------------------------------- S_SUBDAT.97
C S_SUBDAT.98
Integer S_SUBDAT.99
& element ! Array element number S_SUBDAT.100
& ,lastrow ! Number of elements in the last row S_SUBDAT.101
& ,ndeeprows, ndeepcount ! nbl_levs, nclds, ndeep, nlevs, S_SUBDAT.102
& ,nlevsrows, nlevscount ! nwet, nsoil elements S_SUBDAT.103
& ,nwetrows, nwetcount ! S_SUBDAT.104
& ,ndeep ! No of deep soil layers ie S_SUBDAT.105
! surface layer S_SUBDAT.106
& ,i, l ! Loop counters S_SUBDAT.107
Character*30 c1fmt S_SUBDAT.108
Character*32 c2fmt S_SUBDAT.109
Character*36 ctfmt S_SUBDAT.110
c1fmt = '('' * '', (f8.3,3x))' S_SUBDAT.111
c2fmt = '('' * '', (1pe10.3,1x))' S_SUBDAT.112
ctfmt = '(''0* Variable'', (3x,''level'',i2,1x))' S_SUBDAT.113
C S_SUBDAT.114
C S_SUBDAT.115
C Write out headings S_SUBDAT.116
C S_SUBDAT.117
Write (22,199) S_SUBDAT.118
Write (22,200) rday, istep, title1 S_SUBDAT.119
Write (22,198) ayear, aday, atime_string S_SUBDAT.120
Write (22,201) S_SUBDAT.121
Write (22,202) S_SUBDAT.122
Write (22,201) S_SUBDAT.123
S_SUBDAT.124
C S_SUBDAT.125
C Loop on the sites S_SUBDAT.126
C S_SUBDAT.127
Do l = 1, points S_SUBDAT.128
If (points .gt. 1) Write (22,*) " Site No : ", l S_SUBDAT.129
C S_SUBDAT.130
C Write out variables T theta U and V maximum of 10 S_SUBDAT.131
C variables per row S_SUBDAT.132
C S_SUBDAT.133
If (mod(nlevs, 10) .eq. 0) then S_SUBDAT.134
C S_SUBDAT.135
C Calculate no. of rows and no. of elements in last row S_SUBDAT.136
C S_SUBDAT.137
nlevsrows = int(nlevs/10) S_SUBDAT.138
lastrow = 10 S_SUBDAT.139
else S_SUBDAT.140
nlevsrows = int(nlevs/10) + 1 S_SUBDAT.141
lastrow = mod(nlevs,10) S_SUBDAT.142
endif S_SUBDAT.143
Do nlevscount = 1, nlevsrows S_SUBDAT.144
element = 10 * (nlevscount-1) S_SUBDAT.145
If (nlevscount .lt. nlevsrows) then S_SUBDAT.146
C S_SUBDAT.147
C Write out all complete rows ie of 10 variables per row S_SUBDAT.148
C S_SUBDAT.149
Write (22,203) (element + i,i = 1, 10) S_SUBDAT.150
Write (22,204) (u(l, element + i), i = 1, 10), S_SUBDAT.151
& (v(l, element + i), i = 1, 10), S_SUBDAT.152
& (t(l, element + i), i = 1, 10), S_SUBDAT.153
& (theta(l, element + i), i = 1, 10) S_SUBDAT.154
else S_SUBDAT.155
C S_SUBDAT.156
C Write out last row. Use an internal format statement by S_SUBDAT.157
C creating a character string. This will enable a variable S_SUBDAT.158
C Format to be created eg NF10.6 where N is the no. of S_SUBDAT.159
C elements in the last row which can be written into the S_SUBDAT.160
C Format statement via an internal write statement. S_SUBDAT.161
C S_SUBDAT.162
Write (ctfmt(16:17), '(i2)') lastrow S_SUBDAT.163
Write (22,ctfmt) (element + i, i = 1, lastrow) S_SUBDAT.164
Write (c1fmt(18:19), '(i2)')lastrow S_SUBDAT.165
Write (c1fmt(6:15), '(''U m s^-1 '')') S_SUBDAT.166
Write (22,c1fmt) (u(l, i + element), i = 1, lastrow) S_SUBDAT.167
Write (c1fmt(6:15), '(''V m s^-1 '')') S_SUBDAT.168
Write (22,c1fmt) (v(l, i + element), i = 1, lastrow) S_SUBDAT.169
Write (c1fmt(6:15), '(''T K '')') S_SUBDAT.170
Write (22,c1fmt) (t(l, i + element), i = 1, lastrow) S_SUBDAT.171
Write (c1fmt(6:15), '(''theta K '')') S_SUBDAT.172
Write (22,c1fmt) (theta(l, i + element), i = 1, lastrow) S_SUBDAT.173
endif S_SUBDAT.174
enddo S_SUBDAT.175
Write (22,201) S_SUBDAT.176
Write (22,205) S_SUBDAT.177
Write (22,201) S_SUBDAT.178
C S_SUBDAT.179
C Repeat above section of code for variables on NWET levels S_SUBDAT.180
C Write out variables Q QCL QCF and LCA maximum of 10 S_SUBDAT.181
C variables per row S_SUBDAT.182
C S_SUBDAT.183
If (mod(nwet,10) .eq. 0) then S_SUBDAT.184
C S_SUBDAT.185
C Calculate no. of rows and no. of elements in last row S_SUBDAT.186
C S_SUBDAT.187
nwetrows = int(nwet/10) S_SUBDAT.188
lastrow = 10 S_SUBDAT.189
else S_SUBDAT.190
nwetrows = int(nwet/10) + 1 S_SUBDAT.191
lastrow = mod(nwet,10) S_SUBDAT.192
endif S_SUBDAT.193
Do nwetcount = 1, nwetrows S_SUBDAT.194
element = 10*(nwetcount-1) S_SUBDAT.195
If (nwetcount .lt. nwetrows) then S_SUBDAT.196
C S_SUBDAT.197
C Write out all complete rows ie of 10 variables per row S_SUBDAT.198
C S_SUBDAT.199
Write (22,203)(element + i,i = 1, 10) S_SUBDAT.200
Write (22,206) S_SUBDAT.201
& (q(l, element + i), i = 1, 10), S_SUBDAT.202
& (qcl(l, element + i), i = 1, 10), S_SUBDAT.203
& (qcf(l, element + i), i = 1, 10), S_SUBDAT.204
& (lca(l, element + i), i = 1, 10) S_SUBDAT.205
else S_SUBDAT.206
C S_SUBDAT.207
C Write out last row. Use an internal format statement by S_SUBDAT.208
C creating a character string. This will enable a variable S_SUBDAT.209
C Format to be created eg NF10.6 where N is the no. of S_SUBDAT.210
C elements in the last row which can be written into the S_SUBDAT.211
C Format statement via an internal write statement. S_SUBDAT.212
C S_SUBDAT.213
Write (ctfmt(16:17), '(i2)') lastrow S_SUBDAT.214
Write (22,ctfmt) (element + i, i = 1, lastrow) S_SUBDAT.215
Write (c2fmt(18:19), '(i2)') lastrow S_SUBDAT.216
Write (c2fmt(6:15), '(''Q kg/kg '')') S_SUBDAT.217
Write (22,c2fmt) (q(l, i + element), i = 1, lastrow) S_SUBDAT.218
Write (c2fmt(6:15), '(''QCL kg/kg '')') S_SUBDAT.219
Write (22,c2fmt)(qcl(l, i + element), i = 1, lastrow) S_SUBDAT.220
Write (c2fmt(6:15), '(''QCF kg/kg '')') S_SUBDAT.221
Write (22,c2fmt)(qcf(l, i + element), i = 1, lastrow) S_SUBDAT.222
Write (c2fmt(6:15), '(''LCA '')') S_SUBDAT.223
Write (22,c2fmt)(lca(l, i + element), i = 1, lastrow) S_SUBDAT.224
endif S_SUBDAT.225
enddo S_SUBDAT.226
Write (22,207) S_SUBDAT.227
Write (22,208) cca(l), iccb(l), icct(l) S_SUBDAT.228
Write (22,201) S_SUBDAT.229
Write (22,209) S_SUBDAT.230
Write (22,201) S_SUBDAT.231
ndeep = nsoilt_levs S_SUBDAT.232
C S_SUBDAT.233
C Repeat above section of code for variables on nsoil levels S_SUBDAT.234
C write out variables Tdeep maximum of 10 S_SUBDAT.235
C variables per row S_SUBDAT.236
C S_SUBDAT.237
If (mod(ndeep,10) .eq. 0) then S_SUBDAT.238
C S_SUBDAT.239
C Calculate no. of rows and no. of elements in last row S_SUBDAT.240
C S_SUBDAT.241
ndeeprows = int(ndeep/10) S_SUBDAT.242
lastrow = 10 S_SUBDAT.243
else S_SUBDAT.244
ndeeprows = int(ndeep/10) + 1 S_SUBDAT.245
lastrow = mod(ndeep,10) S_SUBDAT.246
endif S_SUBDAT.247
Do ndeepcount = 1, ndeeprows S_SUBDAT.248
element = 10*(ndeepcount-1) S_SUBDAT.249
if (ndeepcount .lt. ndeeprows) then S_SUBDAT.250
C S_SUBDAT.251
C Write out all complete rows ie of 10 variables per row S_SUBDAT.252
C S_SUBDAT.253
Write (22,203) (element + i + 1/2, i = 1, 10) S_SUBDAT.254
Write (22,210) S_SUBDAT.255
& (t_deep_soil(l, element + i), i = 1, 10) S_SUBDAT.256
else S_SUBDAT.257
C S_SUBDAT.258
C Write out last row. Use an internal format statement by S_SUBDAT.259
C creating a character string. This will enable a variable S_SUBDAT.260
C Format to be created eg NF10.6 where N is the no. of S_SUBDAT.261
C elements in the last row which can be written into the S_SUBDAT.262
C Format statement via an internal write statement. S_SUBDAT.263
C S_SUBDAT.264
Write (ctfmt(16:17), '(i2)') lastrow S_SUBDAT.265
Write (22,ctfmt) (element + i + 1/2, i = 1, lastrow) S_SUBDAT.266
Write (c1fmt(18:19), '(i2)') lastrow S_SUBDAT.267
Write (c1fmt(6:15), '(''Tdeep K '')') S_SUBDAT.268
Write (22,c1fmt) S_SUBDAT.269
& (t_deep_soil(l, i + element), i = 1, lastrow) S_SUBDAT.270
endif S_SUBDAT.271
enddo S_SUBDAT.272
Write (22,211) S_SUBDAT.273
Write (22,212) S_SUBDAT.274
Write (22,213) pstar(l), tstar(l), smc(l), canopy(l), S_SUBDAT.275
& snodep(l), zh(l), Z0mSea(l) S_SUBDAT.276
*IF DEF,A08_5A S_SUBDAT.277
C Multilayer Hydrology or Moses code S_SUBDAT.278
ndeep = nsoilm_levs S_SUBDAT.279
C S_SUBDAT.280
C Repeat above section of code for variables on NSOILM levels S_SUBDAT.281
C Write out variables Tdeep maximum of 10 S_SUBDAT.282
C variables per row S_SUBDAT.283
C S_SUBDAT.284
If (mod(ndeep,10) .eq. 0) then S_SUBDAT.285
C S_SUBDAT.286
C Calculate no. of rows and no. of elements in last row S_SUBDAT.287
C S_SUBDAT.288
ndeeprows = int(ndeep/10) S_SUBDAT.289
lastrow = 10 S_SUBDAT.290
else S_SUBDAT.291
ndeeprows = int(ndeep/10) + 1 S_SUBDAT.292
lastrow = mod(ndeep,10) S_SUBDAT.293
endif S_SUBDAT.294
Do ndeepcount = 1, ndeeprows S_SUBDAT.295
element = 10 * (ndeepcount-1) S_SUBDAT.296
If (ndeepcount .lt. ndeeprows) then S_SUBDAT.297
C S_SUBDAT.298
C Write out all complete rows ie of 10 variables per row S_SUBDAT.299
C S_SUBDAT.300
Write (22,203) (element + i + 1/2, i = 1, 10) S_SUBDAT.301
Write (22,214) S_SUBDAT.302
& (smcl(l, element + i), i = 1, 10) S_SUBDAT.303
else S_SUBDAT.304
C S_SUBDAT.305
C Write out last row. Use an internal format statement by S_SUBDAT.306
C creating a character string. This will enable a variable S_SUBDAT.307
C Format to be created eg NF10.6 where N is the no. of S_SUBDAT.308
C elements in the last row which can be written into the # S_SUBDAT.309
C Format statement via an internal write statement. S_SUBDAT.310
C S_SUBDAT.311
Write (ctfmt(16:17), '(i2)') lastrow S_SUBDAT.312
Write (22,ctfmt) (element + i + 1/2, i = 1, lastrow) S_SUBDAT.313
Write (c1fmt(18:19), '(i2)') lastrow S_SUBDAT.314
Write (c1fmt(6:15), '(''SMCL '')') S_SUBDAT.315
Write (22,c1fmt) (smcl(l, i + element), i = 1, lastrow) S_SUBDAT.316
endif S_SUBDAT.317
enddo ! ndeep S_SUBDAT.318
*ENDIF ! moses or mult hydrology S_SUBDAT.319
enddo ! l S_SUBDAT.320
S_SUBDAT.321
198 Format(' Up to actual year ',i6,', day' i6,', time ', A8) S_SUBDAT.322
200 Format(' Runday',i6' timestep',i5, ' primary variables ',a24) S_SUBDAT.323
201 Format( S_SUBDAT.324
& ' ***********************************************************' S_SUBDAT.325
& '************************************************************' S_SUBDAT.326
& '**') S_SUBDAT.327
199 Format( S_SUBDAT.328
& '1***********************************************************' S_SUBDAT.329
& '************************************************************' S_SUBDAT.330
& '**') S_SUBDAT.331
202 Format(' * Standard model variables',/, S_SUBDAT.332
& ' + __________________________') S_SUBDAT.333
203 Format('0* Variable level',i2,9(4x,'level',i2)) S_SUBDAT.334
204 Format( S_SUBDAT.335
& ' * U m s^-1 ',10(F8.3,3X), /, S_SUBDAT.336
& ' * V m s^-1 ',10(F8.3,3X), /, S_SUBDAT.337
& ' * T K ',10(F8.3,3X), /, S_SUBDAT.338
& ' * theta K ',10(F8.3,3X), /) S_SUBDAT.339
205 Format(' * Rain and cloud variables',/, S_SUBDAT.340
& ' + __________________________') S_SUBDAT.341
206 Format( S_SUBDAT.342
& ' * Q kg/kg ',10(1pe10.3,1x), /, S_SUBDAT.343
& ' * QCL kg/kg ',10(1pe10.3,1x), /, S_SUBDAT.344
& ' * QCF kg/kg ',10(1pe10.3,1x), /, S_SUBDAT.345
& ' * LCA ',10(1pe10.3,1x), /) S_SUBDAT.346
207 Format('0* CCA',7x,'CCB',6x,'CCT') S_SUBDAT.347
208 Format(' ',1pe10.3,i6,3x,i6) S_SUBDAT.348
209 Format(' * Boundary layer and surface variables',/, S_SUBDAT.349
& ' + ______________________________________') S_SUBDAT.350
210 Format(' *Tdeep K ',10(F10.4)) S_SUBDAT.351
211 Format('0* Pstar',5X,'Tstar',6X,'smc',6X,'canopy',4X,'snodep', S_SUBDAT.352
& 6X,'zh',6x,'Z0mSea') S_SUBDAT.353
212 Format(' *',2X,'(Pa)',6X,'(K)',4X,'(kg m^-2)','(kg m^-2)', S_SUBDAT.354
& '(kg m^-2)',3X,'(m)',6X,'(m)') S_SUBDAT.355
213 Format(' ',f10.3,6f10.4) S_SUBDAT.356
214 Format(' *SMCL ',10(F10.4)) S_SUBDAT.357
Return S_SUBDAT.358
End ! Subroutine SUB_DATA S_SUBDAT.359
*ENDIF S_SUBDAT.360