Subroutine INITSTAT( 1,19S_INSTAT.34
& points, nlevs, nwet, ntrop, S_INSTAT.35
& andayy, dayno, q, t, lat, long, S_INSTAT.36
& pstari, pstara, pstarb, alfada, alfadb, tbara, tbarb, S_INSTAT.37
& tsda, tsdb, tgrada, tgradb, dbara, dbarb, dgrada, dgradb, S_INSTAT.38
& vnbara, vnbarb, vnsda, vnsdb, vpbara, vpbarb, wbara, wbarb, S_INSTAT.39
& wsda, wsdb, atime, btime, ak, bk) S_INSTAT.40
S_INSTAT.41
Implicit none S_INSTAT.42
S_INSTAT.43
Integer S_INSTAT.44
& points ! IN no of model columns S_INSTAT.45
& ,nlevs ! IN no of levels S_INSTAT.46
& ,nwet ! IN Number of model levels in which S_INSTAT.47
! Q is set. S_INSTAT.48
& ,ntrop ! IN Max number of levels in the S_INSTAT.49
! troposphere S_INSTAT.50
S_INSTAT.51
*CALL C_PI 
S_INSTAT.52
C S_INSTAT.53
C--------------------------------------------------------------------- S_INSTAT.54
C Arguments S_INSTAT.55
C--------------------------------------------------------------------- S_INSTAT.56
C S_INSTAT.57
Real S_INSTAT.58
& andayy ! IN No. of days in 1 year S_INSTAT.59
Integer S_INSTAT.60
& dayno ! IN Day number relative to winter S_INSTAT.61
! solstice S_INSTAT.62
Real S_INSTAT.63
& alfada(points) ! OUT Amplitude and mean of S_INSTAT.64
& ,alfadb(points) ! seasonal variation of tuning S_INSTAT.65
& ,ak(nlevs) ! factor Coefficient defining S_INSTAT.66
! hybrid vertical coordinate S_INSTAT.67
& ,atime,btime ! OUT Constants for calculating S_INSTAT.68
! annual cycle used in eqn 2.33 S_INSTAT.69
! in SCM doc. S_INSTAT.70
& ,bk(nlevs) ! Coefficient defining hybrid S_INSTAT.71
! vertical coordinate S_INSTAT.72
& ,dbara(points,nwet) ! OUT Amplitude and mean of seasonal S_INSTAT.73
& ,dbarb(points,nwet) ! variation of mean dew pt. S_INSTAT.74
! depression (K) S_INSTAT.75
& ,dgrada(points,nwet) ! OUT Amplitude and mean of seasonal S_INSTAT.76
& ,dgradb(points,nwet) ! variation of gradient of S_INSTAT.77
! dew pt. depression (K/km) S_INSTAT.78
& ,lat0 ! Dummy for I/Os S_INSTAT.79
& ,lat(points) ! OUT Latitude and longitude of S_INSTAT.80
& ,long(points) ! gridpoint S_INSTAT.81
& ,long0 ! Dummy for I/Os S_INSTAT.82
& ,pstara(points) ! OUT Amplitude and mean of seasonal S_INSTAT.83
& ,pstarb(points) ! variation of surface pressure (Pa) S_INSTAT.84
& ,q(points,nwet) ! INOUT Specific humidity (Kg Kg**-1) S_INSTAT.85
& ,t(points,nlevs) ! INOUT Temps(K) S_INSTAT.86
& ,tbara(points,nlevs) ! OUT Amplitude and mean of seasonal S_INSTAT.87
& ,tbarb(points,nlevs) ! variation of mean temo. (K) S_INSTAT.88
& ,tgrada(points,nlevs) ! OUT Amplitude and mean of seasonal S_INSTAT.89
& ,tgradb(points,nlevs) ! variation of temp. gradient S_INSTAT.90
! (K km**-1) S_INSTAT.91
& ,tsda(points,nlevs) ! OUT Amplitude and mean of seasonal S_INSTAT.92
& ,tsdb(points,nlevs) ! variation of SD of temp. (K) S_INSTAT.93
& ,tstara(points) ! OUT Amplitude and mean of seasonal S_INSTAT.94
& ,tstarb(points) ! variation of surface temp. (K) S_INSTAT.95
& ,vnbara(points,nlevs) ! OUT Amplitude and mean of seasonal S_INSTAT.96
& ,vnbarb(points,nlevs) ! variation of velocity VN S_INSTAT.97
! (m s**-1) S_INSTAT.98
& ,vnsda(points,nlevs) ! OUT Amplitude and mean of seasonal S_INSTAT.99
& ,vnsdb(points,nlevs) ! variation of SD of velocity VN S_INSTAT.100
! (m s**-1) S_INSTAT.101
& ,vpbara(points,nlevs) ! OUT Amplitude and mean of seasonal S_INSTAT.102
& ,vpbarb(points,nlevs) ! variation of velocity VP S_INSTAT.103
! (m s**-1) S_INSTAT.104
& ,wbara(points,ntrop) ! OUT Amplitude and mean of seasonal S_INSTAT.105
& ,wbarb(points,ntrop) ! variation of vert. vel. S_INSTAT.106
! ( mb s**-1) S_INSTAT.107
& ,wsda(points,ntrop) ! OUT Amplitude and mean of seasonal S_INSTAT.108
& ,wsdb(points,ntrop) ! variation of SD of vert. vel. S_INSTAT.109
! (mb s**-1) S_INSTAT.110
C S_INSTAT.111
C--------------------------------------------------------------------- S_INSTAT.112
C Local variables S_INSTAT.113
C--------------------------------------------------------------------- S_INSTAT.114
C S_INSTAT.115
C Variables for printout of climate dataset S_INSTAT.116
C S_INSTAT.117
Character*29 S_INSTAT.118
& cfmt ! Format statement for each row S_INSTAT.119
! of variables S_INSTAT.120
Character*34 S_INSTAT.121
& ctfmt ! Format statement for title S_INSTAT.122
! of each row S_INSTAT.123
Integer S_INSTAT.124
& element ! Array element no. S_INSTAT.125
& ,lastrow ! No. of elements in last row S_INSTAT.126
& ,nlevsrows, nlevscount ! No. of rows and Do Loop counter S_INSTAT.127
& ,ntroprows, ntropcount ! elements S_INSTAT.128
& ,nwetrows, nwetcount ! elements S_INSTAT.129
C S_INSTAT.130
Integer S_INSTAT.131
& i, k, l ! Loop counter S_INSTAT.132
Real S_INSTAT.133
& alfad0 ! Dummy for I/Os S_INSTAT.134
& ,alfad1(points) S_INSTAT.135
& ,alfad2(points) ! Tuning factor for Jan and July S_INSTAT.136
& ,daynew ! Function to calculate SIN arg S_INSTAT.137
! (eqn. 2.33 in SCM doc.) S_INSTAT.138
& ,daysol1,daysol2 ! No. of days after winter S_INSTAT.139
& ,dbar0(nwet) ! dummy var for I/Os S_INSTAT.140
& ,dbar1(points,nwet) ! Mean dew pt. depressions S_INSTAT.141
& ,dbar2(points,nwet) ! for Jan. and July (K) S_INSTAT.142
& ,dewpt(points,nwet,2) ! Dew point (K) S_INSTAT.143
& ,dgrad0(nwet) ! Dummy var for I/Os S_INSTAT.144
& ,dgrad1(points,nwet) ! Gradient dew pt. depressions S_INSTAT.145
& ,dgrad2(points,nwet) ! for Jan. and July (K km**-1) S_INSTAT.146
& ,press(points,nlevs) ! Pressure for sigma levels (Pa) S_INSTAT.147
& ,pstar0 ! Dummy for I/Os S_INSTAT.148
& ,pstar1(points) ! Surface pressure for S_INSTAT.149
& ,pstar2(points) ! Jan. and July (Pa) S_INSTAT.150
& ,pstari(points) ! Initial surface pressure (Pa) S_INSTAT.151
& ,qi(points,nwet) ! Initial specific humidity S_INSTAT.152
! (Kg Kg**-1) S_INSTAT.153
& ,rpress(points,nlevs) ! Reciprocal pressure S_INSTAT.154
! ((HPa or mb)**-1) S_INSTAT.155
& ,tbar0(nlevs) ! dummy var fo I/Os S_INSTAT.156
& ,tbar1(points,nlevs) ! Mean temp. for Jan. and July S_INSTAT.157
& ,tbar2(points,nlevs) ! (K) S_INSTAT.158
& ,tgrad0(nlevs) ! Dummy var for I/Os S_INSTAT.159
& ,tgrad1(points,nlevs) ! Gradient temp. S_INSTAT.160
& ,tgrad2(points,nlevs) ! for Jan. and July (K km**-1) S_INSTAT.161
& ,ti(points,nlevs) ! Initial temps. (K) S_INSTAT.162
& ,tsd0(nlevs) ! dummy var fo I/Os S_INSTAT.163
& ,tsd1(points,nlevs) ! SD of temp. for Jan. and July S_INSTAT.164
& ,tsd2(points,nlevs) ! (K) S_INSTAT.165
& ,tstar0 ! Dummy for I/Os S_INSTAT.166
& ,tstar1(points) ! Surface temperature for S_INSTAT.167
& ,tstar2(points) ! Jan and July (K) S_INSTAT.168
& ,vnbar0(nlevs) ! Dummy var for I/Os S_INSTAT.169
& ,vnbar1(points,nlevs) ! Mean horizontal velocity VN S_INSTAT.170
& ,vnbar2(points,nlevs) ! for Jan. and July (m s**-1) S_INSTAT.171
& ,vnsd0(nlevs) ! Dummy for I/Os S_INSTAT.172
& ,vnsd1(points,nlevs) ! SD horizontal velocity VN S_INSTAT.173
& ,vnsd2(points,nlevs) ! for Jan. and July (m s**-1) S_INSTAT.174
& ,vpbar0(nlevs) ! Dummy var for I/O. S_INSTAT.175
& ,vpbar1(points,nlevs) ! Mean horizontal velocity VP S_INSTAT.176
& ,vpbar2(points,nlevs) ! for Jan. and July (m s**-1) S_INSTAT.177
& ,wbar0(ntrop) ! Dummy for I/Os S_INSTAT.178
& ,wbar1(points,ntrop) ! Mean vertical velocity S_INSTAT.179
& ,wbar2(points,ntrop) ! for Jan and July (mb s**-1) S_INSTAT.180
& ,wsd0(ntrop) ! Dummy for I/Os S_INSTAT.181
& ,wsd1(points,ntrop) ! SD vertical velocity S_INSTAT.182
& ,wsd2(points,ntrop) ! for Jan and July (mb s**-1) S_INSTAT.183
& ,xt ! Argument of SIN distribution S_INSTAT.184
! eqn. 2.33 S_INSTAT.185
C S_INSTAT.186
C Read climate stats for January and July S_INSTAT.187
C S_INSTAT.188
C Each column is read in a set of dummy variables, S_INSTAT.189
C then, the values are copied accross to the real S_INSTAT.190
C arrays. This is to ensure conistency between S_INSTAT.191
C one column and multicolumns runs, even though it creates S_INSTAT.192
C redundancy S_INSTAT.193
Do l = 1, points S_INSTAT.194
Read (25,204) lat0, long0, pstar0, tstar0, alfad0 S_INSTAT.195
Read (25,202) tbar0, tsd0, dbar0 S_INSTAT.196
Read (25,203) tgrad0, dgrad0 S_INSTAT.197
Read (25,202) vnbar0, vpbar0, vnsd0 S_INSTAT.198
Read (25,201) wbar0, wsd0 S_INSTAT.199
Read (25,205) daysol1 S_INSTAT.200
lat(l) = lat0 S_INSTAT.201
long(l) = long0 S_INSTAT.202
pstar1(l) = pstar0 S_INSTAT.203
tstar1(l) = tstar0 S_INSTAT.204
alfad1(l) = alfad0 S_INSTAT.205
Do k = 1, nlevs S_INSTAT.206
tbar1(l,k) = tbar0(k) S_INSTAT.207
tsd1(l,k) = tsd0(k) S_INSTAT.208
tgrad1(l,k) = tgrad0(k) S_INSTAT.209
vnbar1(l,k) = vnbar0(k) S_INSTAT.210
vpbar1(l,k) = vpbar0(k) S_INSTAT.211
vnsd1(l,k) = vnsd0(k) S_INSTAT.212
enddo S_INSTAT.213
Do k = 1, nwet S_INSTAT.214
dbar1(l,k) = dbar0(k) S_INSTAT.215
dgrad1(l,k) = dgrad0(k) S_INSTAT.216
enddo S_INSTAT.217
Do k = 1, ntrop S_INSTAT.218
wbar1(l,k) = wbar0(k) S_INSTAT.219
wsd1(l,k) = wsd0(k) S_INSTAT.220
enddo S_INSTAT.221
S_INSTAT.222
Read (26,204) lat0, long0, pstar0, tstar0, alfad0 S_INSTAT.223
Read (26,202) tbar0, tsd0, dbar0 S_INSTAT.224
Read (26,203) tgrad0, dgrad0 S_INSTAT.225
Read (26,202) vnbar0, vpbar0, vnsd0 S_INSTAT.226
Read (26,201) wbar0, wsd0 S_INSTAT.227
Read (26,205) daysol2 S_INSTAT.228
lat(l) = lat0 S_INSTAT.229
long(l) = long0 S_INSTAT.230
pstar2(l) = pstar0 S_INSTAT.231
tstar2(l) = tstar0 S_INSTAT.232
alfad2(l) = alfad0 S_INSTAT.233
Do k = 1, nlevs S_INSTAT.234
tbar2(l,k) = tbar0(k) S_INSTAT.235
tsd2(l,k) = tsd0(k) S_INSTAT.236
tgrad2(l,k) = tgrad0(k) S_INSTAT.237
vnbar2(l,k) = vnbar0(k) S_INSTAT.238
vpbar2(l,k) = vpbar0(k) S_INSTAT.239
vnsd2(l,k) = vnsd0(k) S_INSTAT.240
enddo S_INSTAT.241
Do k = 1, nwet S_INSTAT.242
dbar2(l,k) = dbar0(k) S_INSTAT.243
dgrad2(l,k) = dgrad0(k) S_INSTAT.244
enddo S_INSTAT.245
Do k = 1, ntrop S_INSTAT.246
wbar2(l,k) = wbar0(k) S_INSTAT.247
wsd2(l,k) = wsd0(k) S_INSTAT.248
enddo S_INSTAT.249
S_INSTAT.250
enddo ! l S_INSTAT.251
c S_INSTAT.252
c Calculate amplitude and mean of annual sinusoidal distribution S_INSTAT.253
c Eqs 10 and 11 S_INSTAT.254
c S_INSTAT.255
Call ABNEW( tstar1, tstar2, tstara, tstarb, points, 1) S_INSTAT.256
Call ABNEW( pstar1, pstar2, pstara, pstarb, points, 1) S_INSTAT.257
Call ABNEW( alfad1, alfad2, alfada, alfadb, points, 1) S_INSTAT.258
Call ABNEW( tbar1, tbar2, tbara, tbarb, points, nlevs) S_INSTAT.259
Call ABNEW( tsd1, tsd2, tsda, tsdb, points, nlevs) S_INSTAT.260
Call ABNEW( tgrad1, tgrad2, tgrada, tgradb, points, nlevs) S_INSTAT.261
Call ABNEW( dbar1, dbar2, dbara, dbarb, points, nwet) S_INSTAT.262
Call ABNEW( dgrad1, dgrad2, dgrada, dgradb, points, nwet) S_INSTAT.263
Call ABNEW( vnbar1, vnbar2, vnbara, vnbarb, points, nlevs) S_INSTAT.264
Call ABNEW( vnsd1, vnsd2, vnsda, vnsdb, points, nlevs) S_INSTAT.265
Call ABNEW( vpbar1, vpbar2, vpbara, vpbarb, points, nlevs) S_INSTAT.266
Call ABNEW( wbar1, wbar2, wbara, wbarb, points, ntrop) S_INSTAT.267
Call ABNEW( wsd1, wsd2, wsda, wsdb, points, ntrop) S_INSTAT.268
C S_INSTAT.269
C Calculate constants for annual cycle used in eqn. 12 S_INSTAT.270
C S_INSTAT.271
atime = 2. * pi / andayy S_INSTAT.272
btime = pi * (.5-2.*daysol1) S_INSTAT.273
C S_INSTAT.274
C Calculate argument of sinusoidal distribution (eqn. 12) S_INSTAT.275
C S_INSTAT.276
xt = DAYNEW (atime, btime, dayno) S_INSTAT.277
C S_INSTAT.278
C Calculate sinusoidal distribution (eqn. 12) S_INSTAT.279
C S_INSTAT.280
Call XNEW(pstari, pstara, pstarb, points, 1, xt) S_INSTAT.281
Call XNEW(ti, tbara, tbarb, points, nlevs, xt) S_INSTAT.282
Call XNEW(q, dbara, dbarb, points, nwet, xt) S_INSTAT.283
C S_INSTAT.284
C Calculate default initial profile for Q S_INSTAT.285
C S_INSTAT.286
Call PNEW(nlevs, press, rpress, points, nwet, pstari, ak, bk) S_INSTAT.287
Do k = 1, nwet S_INSTAT.288
Do i = 1, points S_INSTAT.289
dewpt(i,k,1) = ti(i,k) - q(i,k) S_INSTAT.290
enddo S_INSTAT.291
enddo S_INSTAT.292
Call QSAT(qi, dewpt(1,1,1), press, (points*nwet)) S_INSTAT.293
Do k = 1, nlevs S_INSTAT.294
Do i = 1, points S_INSTAT.295
t(i,k) = ti(i,k) S_INSTAT.296
enddo S_INSTAT.297
enddo S_INSTAT.298
Do k = 1, nwet S_INSTAT.299
Do i = 1, points S_INSTAT.300
q(i,k) = qi(i,k) S_INSTAT.301
enddo S_INSTAT.302
enddo ! i S_INSTAT.303
C S_INSTAT.304
C********************************************************************* S_INSTAT.305
C Print out climate datasets for January and July as read in S_INSTAT.306
C This section of code is very long but is necessary for S_INSTAT.307
C flexiblity ie to cope with any number of levels S_INSTAT.308
C********************************************************************* S_INSTAT.309
C S_INSTAT.310
daysol1 = daysol1 * andayy S_INSTAT.311
daysol2 = daysol2 * andayy S_INSTAT.312
S_INSTAT.313
Do l = 1 , points S_INSTAT.314
C Transfer the arrays back to their 1D versions: S_INSTAT.315
lat0 = lat(l) S_INSTAT.316
long0 = long(l) S_INSTAT.317
pstar0 = pstar1(l) S_INSTAT.318
tstar0 = tstar1(l) S_INSTAT.319
alfad0 = alfad1(l) S_INSTAT.320
Do k = 1, nlevs S_INSTAT.321
tbar0(k) = tbar1(l,k) S_INSTAT.322
tsd0(k) = tsd1(l,k) S_INSTAT.323
tgrad0(k) = tgrad1(l,k) S_INSTAT.324
vnbar0(k) = vnbar1(l,k) S_INSTAT.325
vpbar0(k) = vpbar1(l,k) S_INSTAT.326
vnsd0(k) = vnsd1(l,k) S_INSTAT.327
enddo S_INSTAT.328
Do k = 1, nwet S_INSTAT.329
dbar0(k)= dbar1(l,k) S_INSTAT.330
dgrad0(k)= dgrad1(l,k) S_INSTAT.331
enddo S_INSTAT.332
Do k = 1, ntrop S_INSTAT.333
wbar0(k)= wbar1(l,k) S_INSTAT.334
wsd0(k)= wsd1(l,k) S_INSTAT.335
enddo S_INSTAT.336
S_INSTAT.337
if (points .gt. 1) Write (11,*) 'Column no ', l S_INSTAT.338
Write (11,301) lat0, long0 S_INSTAT.339
Write (11,302) pstar0, tstar0, alfad0, daysol1 S_INSTAT.340
C S_INSTAT.341
C Set format statements S_INSTAT.342
C S_INSTAT.343
cfmt = '('' '', (1pe10.3,1x))' S_INSTAT.344
ctfmt = '(''0 '', (3x,''level'',i2,1x))' S_INSTAT.345
C S_INSTAT.346
C Calculate no. of rows and no. of elements in last row for S_INSTAT.347
C variables with nlevs S_INSTAT.348
C S_INSTAT.349
If ( mod(nlevs,10) .eq. 0) then S_INSTAT.350
nlevsrows = int(nlevs/10) S_INSTAT.351
lastrow = 10 S_INSTAT.352
else S_INSTAT.353
nlevsrows = int(nlevs/10) + 1 S_INSTAT.354
lastrow = mod(nlevs,10) S_INSTAT.355
endif S_INSTAT.356
Do nlevscount = 1, nlevsrows S_INSTAT.357
element = 10 * (nlevscount-1) S_INSTAT.358
If (nlevscount .lt. nlevsrows) then S_INSTAT.359
c S_INSTAT.360
c Write out all complete rows ie of 10 variables per row S_INSTAT.361
C S_INSTAT.362
Write (11,303) (element+i, i = 1, 10) S_INSTAT.363
Write (11,304) (tbar0(element+i), i = 1, 10), S_INSTAT.364
& (tsd0(element+i), i = 1, 10), S_INSTAT.365
& (tgrad0(element+i), i = 1, 10), S_INSTAT.366
& (vnbar0(element+i), i = 1, 10), S_INSTAT.367
& (vpbar0(element+i), i = 1, 10), S_INSTAT.368
& (vnsd0(element+i), i = 1, 10) S_INSTAT.369
else S_INSTAT.370
C S_INSTAT.371
C Write out last row. Use an internal format statement by S_INSTAT.372
C creating a character string. This will enable a variable S_INSTAT.373
C format to be created eg NF10.6 where N is the no. of S_INSTAT.374
C elements in the last row which can be written into the S_INSTAT.375
C format statement via an internal write statement. S_INSTAT.376
C S_INSTAT.377
Write (ctfmt(14:15),'(i2)')lastrow S_INSTAT.378
Write(11,ctfmt)(element+i,i= 1, lastrow) S_INSTAT.379
Write(cfmt(15:16),'(i2)')lastrow S_INSTAT.380
Write(cfmt(4:12),'(''tmn k '')') S_INSTAT.381
Write(11,cfmt)(tbar0(i+element),i= 1, lastrow) S_INSTAT.382
Write(cfmt(4:12),'(''tsd k '')') S_INSTAT.383
Write(11,cfmt)(tsd0(i+element),i= 1, lastrow) S_INSTAT.384
Write(cfmt(4:12),'(''tgrd k/km'')') S_INSTAT.385
Write(11,cfmt)(tgrad0(i+element),i= 1, lastrow) S_INSTAT.386
Write(cfmt(4:12),'(''vnmn m/s '')') S_INSTAT.387
Write(11,cfmt)(vnbar0(i+element),i= 1, lastrow) S_INSTAT.388
Write(cfmt(4:12),'(''vpmn m/s '')') S_INSTAT.389
Write(11,cfmt)(vpbar0(i+element),i= 1, lastrow) S_INSTAT.390
Write(cfmt(4:12),'(''vnsd m/s '')') S_INSTAT.391
Write(11,cfmt)(vnsd0(i+element),i= 1, lastrow) S_INSTAT.392
endif S_INSTAT.393
enddo S_INSTAT.394
C S_INSTAT.395
C Calculate no. of rows and no. of elements in last row for S_INSTAT.396
C variables with NWET S_INSTAT.397
C S_INSTAT.398
If ( mod(nwet,10) .eq. 0) then S_INSTAT.399
nwetrows = int(nwet/10) S_INSTAT.400
lastrow = 10 S_INSTAT.401
else S_INSTAT.402
nwetrows = int(nwet/10) + 1 S_INSTAT.403
lastrow = mod(nwet,10) S_INSTAT.404
endif S_INSTAT.405
Do nwetcount = 1, nwetrows S_INSTAT.406
element = 10*(nwetcount-1) S_INSTAT.407
If (nwetcount .lt. nwetrows) then S_INSTAT.408
C S_INSTAT.409
C Write out all complete rows ie of 10 variables per row S_INSTAT.410
C S_INSTAT.411
Write (11,303) (element+i,i = 1, 10) S_INSTAT.412
Write (11,305) (dbar0(element+i),i = 1, 10), S_INSTAT.413
& (dgrad0(element+i),i = 1, 10) S_INSTAT.414
else S_INSTAT.415
C S_INSTAT.416
C Write out last row. Use an internal format statement by S_INSTAT.417
C creating a character string. This will enable a variable S_INSTAT.418
C format to be created eg NF10.6 where N is the no. of S_INSTAT.419
C elements in the last row which can be written into the S_INSTAT.420
C format statement via an internal write statement. S_INSTAT.421
C S_INSTAT.422
Write (ctfmt(14:15),'(i2)') lastrow S_INSTAT.423
Write (11,ctfmt) (element+i, i = 1, lastrow) S_INSTAT.424
Write (cfmt(15:16),'(i2)') lastrow S_INSTAT.425
Write (cfmt(4:12),'(''dmn k '')') S_INSTAT.426
Write (11,cfmt) (dbar0(i+element), i = 1, lastrow) S_INSTAT.427
Write (cfmt(4:12),'(''dgrd k/km'')') S_INSTAT.428
Write (11,cfmt) (dgrad0(i+element), i = 1, lastrow) S_INSTAT.429
endif S_INSTAT.430
enddo S_INSTAT.431
C S_INSTAT.432
C Calculate no. of rows and no. of elements in last row for S_INSTAT.433
C variables with NTROP S_INSTAT.434
C S_INSTAT.435
If ( mod(ntrop,10) .eq. 0) then S_INSTAT.436
ntroprows = int(ntrop/10) S_INSTAT.437
lastrow = 10 S_INSTAT.438
else S_INSTAT.439
ntroprows = int(ntrop/10) + 1 S_INSTAT.440
lastrow = mod(ntrop,10) S_INSTAT.441
endif S_INSTAT.442
do ntropcount = 1,ntroprows S_INSTAT.443
element = 10 * (ntropcount-1) S_INSTAT.444
if ( ntropcount .lt. ntroprows) then S_INSTAT.445
c S_INSTAT.446
C Write out all complete rows ie of 10 variables per row S_INSTAT.447
C S_INSTAT.448
Write (11,303) (element+i,i=1,10) S_INSTAT.449
Write (11,306) (wbar0(element+i), i = 1, 10), S_INSTAT.450
& (wsd0(element+i),i=1,10) S_INSTAT.451
else S_INSTAT.452
C S_INSTAT.453
C Write out last row. Use an internal format statement by S_INSTAT.454
C creating a character string. This will enable a variable S_INSTAT.455
C format to be created eg NF10.6 where N is the no. of S_INSTAT.456
C elements in the last row which can be written into the S_INSTAT.457
C format statement via an internal write statement. S_INSTAT.458
C S_INSTAT.459
Write (ctfmt(14:15),'(i2)') lastrow S_INSTAT.460
Write (11,ctfmt) (element+i, i = 1, lastrow) S_INSTAT.461
Write (cfmt(15:16),'(i2)') lastrow S_INSTAT.462
Write (cfmt(4:12),'(''wmn mb/s '')') S_INSTAT.463
Write (11,cfmt) (wbar0(i+element), i = 1, lastrow) S_INSTAT.464
Write (cfmt(4:12),'(''wsd mb/s '')') S_INSTAT.465
Write (11,cfmt) (wsd0(i+element), i = 1, lastrow) S_INSTAT.466
endif S_INSTAT.467
enddo S_INSTAT.468
S_INSTAT.469
C Transfer the arrays back to their 1D versions: S_INSTAT.470
lat0 = lat(l) S_INSTAT.471
long0 = long(l) S_INSTAT.472
pstar0 = pstar2(l) S_INSTAT.473
tstar0 = tstar2(l) S_INSTAT.474
alfad0 = alfad2(l) S_INSTAT.475
Do k = 1, nlevs S_INSTAT.476
tbar0(k) = tbar2(l,k) S_INSTAT.477
tsd0(k) = tsd2(l,k) S_INSTAT.478
tgrad0(k) = tgrad2(l,k) S_INSTAT.479
vnbar0(k) = vnbar2(l,k) S_INSTAT.480
vpbar0(k) = vpbar2(l,k) S_INSTAT.481
vnsd0(k) = vnsd2(l,k) S_INSTAT.482
enddo S_INSTAT.483
Do k = 1, nwet S_INSTAT.484
dbar0(k)= dbar2(l,k) S_INSTAT.485
dgrad0(k)= dgrad2(l,k) S_INSTAT.486
enddo S_INSTAT.487
Do k = 1, ntrop S_INSTAT.488
wbar0(k)= wbar2(l,k) S_INSTAT.489
wsd0(k)= wsd2(l,k) S_INSTAT.490
enddo S_INSTAT.491
S_INSTAT.492
S_INSTAT.493
Write (11,307) lat0, long0 S_INSTAT.494
Write (11,302) pstar0, tstar0, alfad0, daysol2 S_INSTAT.495
C S_INSTAT.496
C Calculate no. of rows and no. of elements in last row for S_INSTAT.497
C variables with nlevs S_INSTAT.498
C S_INSTAT.499
If ( mod(nlevs,10).eq.0) then S_INSTAT.500
nlevsrows = int(nlevs/10) S_INSTAT.501
lastrow = 10 S_INSTAT.502
else S_INSTAT.503
nlevsrows = int(nlevs/10) + 1 S_INSTAT.504
lastrow = mod(nlevs,10) S_INSTAT.505
endif S_INSTAT.506
Do nlevscount = 1, nlevsrows S_INSTAT.507
element = 10*(nlevscount-1) S_INSTAT.508
if (nlevscount .lt. nlevsrows) then S_INSTAT.509
C S_INSTAT.510
C Write out all complete rows ie of 10 variables per row S_INSTAT.511
C S_INSTAT.512
Write (11,303) (element+i, i = 1, 10) S_INSTAT.513
Write (11,304) (tbar0(element+i),i = 1, 10), S_INSTAT.514
& (tsd0(element+i),i = 1, 10), S_INSTAT.515
& (tgrad0(element+i),i = 1, 10), S_INSTAT.516
& (vnbar0(element+i),i = 1, 10), S_INSTAT.517
& (vpbar0(element+i),i = 1, 10), S_INSTAT.518
& (vnsd0(element+i),i = 1, 10) S_INSTAT.519
else S_INSTAT.520
C S_INSTAT.521
C Write out last row. Use an internal format statement by S_INSTAT.522
C a character string. This will enable a variable format S_INSTAT.523
C to be created eg NF10.6 where N is the no. of elements in S_INSTAT.524
C the last row which can be written into the format S_INSTAT.525
C statement via an internal write statement. S_INSTAT.526
C S_INSTAT.527
Write (ctfmt(14:15),'(i2)') lastrow S_INSTAT.528
Write (11,ctfmt) (element+i,i = 1, lastrow) S_INSTAT.529
Write (cfmt(15:16),'(i2)') lastrow S_INSTAT.530
Write (cfmt(4:12),'(''tmn k '')') S_INSTAT.531
Write (11,cfmt) (tbar0(i+element), i = 1, lastrow) S_INSTAT.532
Write (cfmt(4:12),'(''tsd k '')') S_INSTAT.533
Write (11,cfmt) (tsd0(i+element),i = 1, lastrow) S_INSTAT.534
Write (cfmt(4:12),'(''tgrd k/km'')') S_INSTAT.535
Write (11,cfmt) (tgrad0(i+element),i = 1, lastrow) S_INSTAT.536
Write (cfmt(4:12),'(''vnmn m/s '')') S_INSTAT.537
Write (11,cfmt) (vnbar0(i+element),i = 1, lastrow) S_INSTAT.538
Write (cfmt(4:12),'(''vpmn m/s '')') S_INSTAT.539
Write (11,cfmt) (vpbar0(i+element),i = 1, lastrow) S_INSTAT.540
Write (cfmt(4:12),'(''vnsd m/s '')') S_INSTAT.541
Write (11,cfmt) (vnsd0(i+element),i = 1, lastrow) S_INSTAT.542
endif S_INSTAT.543
enddo S_INSTAT.544
C S_INSTAT.545
C Calculate no. of rows and no. of elements in last row for S_INSTAT.546
C variables with nwet S_INSTAT.547
C S_INSTAT.548
If ( mod(nwet,10) .eq. 0) then S_INSTAT.549
nwetrows = int(nwet/10) S_INSTAT.550
lastrow = 10 S_INSTAT.551
else S_INSTAT.552
nwetrows = int(nwet/10) + 1 S_INSTAT.553
lastrow = mod(nwet,10) S_INSTAT.554
endif S_INSTAT.555
Do nwetcount = 1, nwetrows S_INSTAT.556
element = 10 * (nwetcount-1) S_INSTAT.557
If (nwetcount .lt. nwetrows) then S_INSTAT.558
C S_INSTAT.559
C Write out all complete rows ie of 10 variables per row S_INSTAT.560
C S_INSTAT.561
Write (11,303) (element+i,i = 1, 10) S_INSTAT.562
Write (11,305) (dbar0(element+i),i = 1, 10), S_INSTAT.563
& (dgrad0(element+i),i = 1, 10) S_INSTAT.564
else S_INSTAT.565
C S_INSTAT.566
C Write out last row. Use an internal format statement by S_INSTAT.567
C creating a character string. This will enable a variable S_INSTAT.568
C format to be created eg NF10.6 where N is the no. of S_INSTAT.569
C elements in the last row which can be written into the S_INSTAT.570
C format statement via an internal write statement. S_INSTAT.571
C S_INSTAT.572
Write (ctfmt(14:15),'(i2)') lastrow S_INSTAT.573
Write (11,ctfmt) (element+i,i = 1, lastrow) S_INSTAT.574
Write (cfmt(15:16),'(i2)') lastrow S_INSTAT.575
Write (cfmt(4:12),'(''dmn k/km '')') S_INSTAT.576
Write (11,cfmt) (dbar0(i+element),i = 1, lastrow) S_INSTAT.577
Write (cfmt(4:12),'(''dgrd k/km'')') S_INSTAT.578
Write (11,cfmt) (dgrad0(i+element),i = 1, lastrow) S_INSTAT.579
endif S_INSTAT.580
enddo S_INSTAT.581
C S_INSTAT.582
C Calculate no. of rows and no. of elements in last row for S_INSTAT.583
c variables with ntrop S_INSTAT.584
C S_INSTAT.585
If ( mod(ntrop,10).eq.0) then S_INSTAT.586
ntroprows = int(ntrop/10) S_INSTAT.587
lastrow = 10 S_INSTAT.588
else S_INSTAT.589
ntroprows = int(ntrop/10) + 1 S_INSTAT.590
lastrow = mod(ntrop,10) S_INSTAT.591
endif S_INSTAT.592
Do ntropcount = 1, ntroprows S_INSTAT.593
element = 10*(ntropcount-1) S_INSTAT.594
If (ntropcount .lt. ntroprows) then S_INSTAT.595
c S_INSTAT.596
c Write out all complete rows ie of 10 variables per row S_INSTAT.597
C S_INSTAT.598
Write (11,303) (element+i, i = 1, 10) S_INSTAT.599
Write (11,306) (wbar0(element+i), i = 1, 10), S_INSTAT.600
& (wsd0(element+i),i = 1, 10) S_INSTAT.601
else S_INSTAT.602
c S_INSTAT.603
c Write out last row. Use an internal format statement by S_INSTAT.604
C creating a character string. This will enable a variable S_INSTAT.605
C formatC to be created eg NF10.6 where N is the no. of S_INSTAT.606
C elements in the last row which can be written into the S_INSTAT.607
C format statement via an internal write statement. S_INSTAT.608
C S_INSTAT.609
Write (ctfmt(14:15),'(i2)') lastrow S_INSTAT.610
Write (11,ctfmt)(element+i, i = 1, lastrow) S_INSTAT.611
Write (cfmt(15:16),'(i2)') lastrow S_INSTAT.612
Write (cfmt(4:12),'(''wmn mb/s '')') S_INSTAT.613
Write (11,cfmt)(wbar0(i+element), i = 1, lastrow) S_INSTAT.614
Write (cfmt(4:12),'(''wsd mb/s '')') S_INSTAT.615
Write (11,cfmt)(wsd0(i+element), i = 1, lastrow) S_INSTAT.616
endif S_INSTAT.617
enddo S_INSTAT.618
enddo ! l S_INSTAT.619
C S_INSTAT.620
C S_INSTAT.621
201 Format(6e8.2) S_INSTAT.622
202 Format(10f7.2) S_INSTAT.623
203 Format(5e8.2) S_INSTAT.624
204 Format(2f7.2,f7.1,2f7.2) S_INSTAT.625
205 Format(f7.6) S_INSTAT.626
301 Format('0Climate forcing data for july' S_INSTAT.627
& ,/,' ________________________________' S_INSTAT.628
& ,/,' lat=',f7.2,' long=',f7.2) S_INSTAT.629
302 Format(' pstar (Pa) ',f10.2,' tstar (K) ',f7.2/, S_INSTAT.630
& ' tuning factor ' ,f7.2,/, S_INSTAT.631
& ' dayno. relative to winter solstice ',f7.2) S_INSTAT.632
303 Format('0 level',i2,9(4x,'level',i2)) S_INSTAT.633
304 Format( S_INSTAT.634
& ' tmn K ',10(1pe10.3,1x)/,' tsd K ',10(1pe10.3,1X)/, S_INSTAT.635
& ' tgrd K/km',10(1pe10.3,1x)/, S_INSTAT.636
& ' vnmn m/s ',10(1pe10.3,1x)/,' vpmn m/s ',10(1pe10.3,1x)/, S_INSTAT.637
& ' vnsd m/s ',10(1pe10.3,1x)) S_INSTAT.638
305 Format( S_INSTAT.639
& ' dmn K ',10(1pe10.3,1x)/,' dgrd K/km',10(1pe10.3,1x)/) S_INSTAT.640
306 Format( S_INSTAT.641
& ' wbar mb/s',10(1pe10.3,1x)/,' wsd mb/s ',10(1pe10.3,1x)/) S_INSTAT.642
307 Format('1Climate forcing data for january' S_INSTAT.643
& ,/,' ________________________________' S_INSTAT.644
& ,/,' lat=',f7.2,' long=',f7.2) S_INSTAT.645
Return S_INSTAT.646
End ! Subroutine INITSTAT S_INSTAT.647
C S_INSTAT.648
*ENDIF S_INSTAT.649