Subroutine OBS_DUMP(points, dap1, dap2, dap3, dab1, dab2, dab3, 1,45S_OBDIAG.31
& ndim, ndimq, deltap, ti, qi, t_init, q_init, t, q, daycount, S_OBDIAG.32
& stepcount, timestep, time_string, printo, conv_rain, S_OBDIAG.33
& conv_snow, ichgf, iwcavg, nout, nout2, nout3) S_OBDIAG.34
C S_OBDIAG.35
Implicit none S_OBDIAG.36
C S_OBDIAG.37
*CALL C_LHEAT 
S_OBDIAG.38
*CALL C_R_CP S_OBDIAG.39
*CALL C_G S_OBDIAG.40
C S_OBDIAG.41
Integer S_OBDIAG.42
& points, k S_OBDIAG.43
& ,daycount, stepcount S_OBDIAG.44
& ,ichgf, iwcavg S_OBDIAG.45
& ,i, ia1, kl, jl S_OBDIAG.46
& ,ndim, ndimq, nout, nout2, nout3 S_OBDIAG.47
C S_OBDIAG.48
Real S_OBDIAG.49
& dap1(points, 36, ndim) S_OBDIAG.50
& ,dap2(points, 36, ndim) S_OBDIAG.51
& ,dap3(points, 36, 8, ndim) S_OBDIAG.52
& ,dab1(points, 44) S_OBDIAG.53
& ,dab2(points, 44) S_OBDIAG.54
& ,dab3(points, 44, 8) S_OBDIAG.55
c S_OBDIAG.56
c S_OBDIAG.57
Real S_OBDIAG.58
& ti(points, ndim), qi(points, ndimq) S_OBDIAG.59
& ,t_init(points, ndim), q_init(points, ndimq) S_OBDIAG.60
& ,t(points, ndim), q(points, ndimq) S_OBDIAG.61
& ,deltap(ndim) S_OBDIAG.62
& ,timestep S_OBDIAG.63
& ,conv_rain(points), conv_snow(points) S_OBDIAG.64
c S_OBDIAG.65
& ,pdel1(ndim), pdel2(ndim) S_OBDIAG.66
& ,ptime1, ptime2, ptime3 S_OBDIAG.67
c S_OBDIAG.68
Logical printo, spinup S_OBDIAG.69
c S_OBDIAG.70
Character*8 S_OBDIAG.71
& time_string S_OBDIAG.72
C S_OBDIAG.73
C S_OBDIAG.74
C--------------------------------------------------------------------- S_OBDIAG.75
C Form budgets of thermodynamic quantities S_OBDIAG.76
C--------------------------------------------------------------------- S_OBDIAG.77
C S_OBDIAG.78
Do k = 1, points S_OBDIAG.79
If (k .gt. 1) Write (nout, *) "Site No ", k S_OBDIAG.80
Do i = 1, ndim S_OBDIAG.81
pdel1(i) = deltap(i)/(g * 86400.0) S_OBDIAG.82
pdel2(i) = pdel1(i)/1000.0 S_OBDIAG.83
enddo S_OBDIAG.84
C----- Thermodynamic profiles S_OBDIAG.85
Do i = 1, ndim S_OBDIAG.86
dab1(k, 1) = dab1(k, 1) S_OBDIAG.87
& + Cp * dap1(k, 7, I) * pdel1(I) * 86400.0 S_OBDIAG.88
enddo S_OBDIAG.89
Do i = 1, ndimq S_OBDIAG.90
dab1(k, 2) = dab1(k, 2) S_OBDIAG.91
& + Lc * dap1(k, 8, i) * pdel2(i) * 86400.0 S_OBDIAG.92
enddo S_OBDIAG.93
C----- Sensible heat budget S_OBDIAG.94
Do i = 1, ndim S_OBDIAG.95
dab1(k, 3) = dab1(k, 3) + Cp * dap1(k, 10, i) * pdel1(i) S_OBDIAG.96
dab1(k, 4) = dab1(k, 4) + Cp * dap1(k, 11, i) * pdel1(i) S_OBDIAG.97
dab1(k, 5) = dab1(k, 5) S_OBDIAG.98
& + Cp * (dap1(k, 22, i) + dap1(k, 12, i)) * pdel1(i) S_OBDIAG.99
dab1(k, 6) = dab1(k, 6) + Cp * dap1(k, 30, i) * pdel1(i) S_OBDIAG.100
dab1(k, 7) = dab1(k, 7) + Cp * dap1(k, 13, i) * pdel1(i) S_OBDIAG.101
dab1(k, 41) = dab1(k, 41) + Cp * dap1(k, 33, i) * pdel1(i) S_OBDIAG.102
dab1(k, 42) = dab1(k, 42) + Cp * dap1(k, 34, i) * pdel1(i) S_OBDIAG.103
dab1(k, 11) = dab1(k, 11) + Cp * dap1(k, 17, i) * pdel1(i) S_OBDIAG.104
dab1(k, 12) = dab1(k, 12) + Cp * dap1(k, 18, i) * pdel1(i) S_OBDIAG.105
enddo S_OBDIAG.106
Do i = 1, ndimq S_OBDIAG.107
dab1(k, 8) = dab1(k, 8) + Cp * dap1(k, 14, I) * pdel1(I) S_OBDIAG.108
dab1(k, 9) = dab1(k, 9) + Cp * dap1(k, 15, I) * pdel1(I) S_OBDIAG.109
dab1(k, 10) = dab1(k, 10) + Cp * dap1(k, 16, I) * pdel1(I) S_OBDIAG.110
dab1(k, 13) = dab1(k, 13) + Cp * dap1(k, 19, I) * pdel1(I) S_OBDIAG.111
enddo S_OBDIAG.112
S_OBDIAG.113
C----- Latent heat budget S_OBDIAG.114
S_OBDIAG.115
Do i = 1, ndim S_OBDIAG.116
dab1(k, 14) = dab1(k, 14) + Lc * dap1(k, 20, i) * pdel2(i) S_OBDIAG.117
dab1(k, 18) = dab1(k, 18) + Lc * dap1(k, 24, i) * pdel2(i) S_OBDIAG.118
dab1(k, 19) = dab1(k, 19) + Lc * dap1(k, 25, i) * pdel2(i) S_OBDIAG.119
dab1(k, 20) = dab1(k, 20) + Lc * dap1(k, 26, i) * pdel2(i) S_OBDIAG.120
dab1(k, 21) = dab1(k, 21) + Lc * dap1(k, 27, i) * pdel2(i) S_OBDIAG.121
enddo S_OBDIAG.122
Do i = 1, ndimq S_OBDIAG.123
dab1(k, 15) = dab1(k, 15) + Lc * dap1(k, 21, i) * pdel2(i) S_OBDIAG.124
dab1(k, 16) = dab1(k, 16) + Lc * dap1(k, 31, i) * pdel2(i) S_OBDIAG.125
dab1(k, 17) = dab1(k, 17) + Lc * dap1(k, 23, i) * pdel2(i) S_OBDIAG.126
dab1(k, 43) = dab1(k, 43) + Lc * dap1(k, 35, i) * pdel2(i) S_OBDIAG.127
dab1(k, 44) = dab1(k, 44) + Lc * dap1(k, 36, i) * pdel2(i) S_OBDIAG.128
dab1(k, 22) = dab1(k, 22) + Lc * dap1(k, 29, i) * pdel2(i) S_OBDIAG.129
enddo S_OBDIAG.130
C----- S_OBDIAG.131
C----- Budgets of temperature and moisture S_OBDIAG.132
C----- S_OBDIAG.133
Do i = 1, ndim S_OBDIAG.134
dab1(k, 33) = dab1(k, 33) S_OBDIAG.135
& + t_init(k, i) * Cp * pdel1(i) * 86400.0 S_OBDIAG.136
dab1(k, 35) = dab1(k, 35) S_OBDIAG.137
& + t(k, i) * Cp * pdel2(i) * 86400.0 * 1000.0 S_OBDIAG.138
enddo S_OBDIAG.139
do i = 1, ndimq S_OBDIAG.140
dab1(k, 34) = dab1(k, 34) S_OBDIAG.141
& + q_init(k, i) * Lc * pdel1(i) * 86400.0 S_OBDIAG.142
dab1(k, 36) = dab1(k, 36) S_OBDIAG.143
& + q(k, i) * Lc * pdel2(i) * 86400.0 * 1000.0 S_OBDIAG.144
enddo S_OBDIAG.145
C----- S_OBDIAG.146
C----- Form time derivatives of temperature and moisture S_OBDIAG.147
C----- and put rain and snow fall in correct units S_OBDIAG.148
C----- S_OBDIAG.149
dab1(k, 37) = (dab1(k, 35)-dab1(k, 33))/timestep S_OBDIAG.150
dab1(k, 38) = (dab1(k, 36)-dab1(k, 34))/timestep S_OBDIAG.151
dab1(k, 23) = dab1(k, 23) + conv_rain(k) * Lc S_OBDIAG.152
dab1(k, 24) = dab1(k, 24) + conv_snow(k) * (Lc + Lf) S_OBDIAG.153
C S_OBDIAG.154
C Print diagnostics S_OBDIAG.155
C S_OBDIAG.156
If (printo) then S_OBDIAG.157
Write (nout, 2000) daycount, stepcount, time_string S_OBDIAG.158
2000 Format(' Instant budget'/ S_OBDIAG.159
& ' day in run = ', i3, ' timestep = ', i3 S_OBDIAG.160
& ' actual time = ', a8/ S_OBDIAG.161
& ' environmental parameters during call to convection'/) S_OBDIAG.162
Write (nout, 2001) S_OBDIAG.163
2001 Format(' K', 4X, 'TE', 8X, 'QE', 6X, 'RHE', 5X, 'QCL', S_OBDIAG.164
& 5X, 'QCF', 5X, 'FR_CL', 5X, 'M_F') S_OBDIAG.165
Do i = ndim, 1, -1 S_OBDIAG.166
Write (nout, 2003) S_OBDIAG.167
& i, dap1(k,7, i), dap1(k,8, i), dap1(k,9, i), S_OBDIAG.168
& dap1(k,14, i), dap1(k,15, i), dap1(k,16, i), S_OBDIAG.169
& dap1(k,1, i) S_OBDIAG.170
enddo S_OBDIAG.171
2003 Format(i3, 1x, f8.2, 2x, f7.2, 1x, f7.2, 1x, f7.2, 1x, S_OBDIAG.172
& f7.2, 1x, f7.2, 1x, f7.2) S_OBDIAG.173
Write (nout, 2004) S_OBDIAG.174
2004 Format(/' Sensible heat--profiles'/ S_OBDIAG.175
& ' units--K/Day'/) S_OBDIAG.176
Write (nout, 2005) S_OBDIAG.177
2005 Format(' K', 6X, 'LS', 6X, 'RAD_SW', 3X, 'RAD_LW', 4X, S_OBDIAG.178
& 'BL', 7X, 'LSR', 7X, 'LSC', 7X, 'Q1'/) S_OBDIAG.179
Do i = ndim, 1, -1 S_OBDIAG.180
Write (nout, 2007) S_OBDIAG.181
& i, dap1(k, 10, i), dap1(k, 12, i), dap1(k, 22, i), S_OBDIAG.182
& dap1(k, 11, i), dap1(k, 30, i), dap1(k, 19, i), S_OBDIAG.183
& dap1(k, 13, i) S_OBDIAG.184
enddo S_OBDIAG.185
2007 Format(i3, 2x, 7(f7.1, 2x)) S_OBDIAG.186
Write (nout, 2115) S_OBDIAG.187
2115 Format(' K', 6x, ' Q1UD', 7x, 'Q1DD'/) S_OBDIAG.188
Do i = ndim, 1, -1 S_OBDIAG.189
Write (nout, 2117) i, dap1(k, 33, i), dap1(k, 34, i) S_OBDIAG.190
enddo S_OBDIAG.191
2117 Format(i3, 2x, 2(f7.1, 2x)) S_OBDIAG.192
Write (nout, 2008) S_OBDIAG.193
2008 Format(/' Latent heat--profiles'/ S_OBDIAG.194
& ' units--G/Kg/Day'/) S_OBDIAG.195
Write (nout, 2009) S_OBDIAG.196
2009 Format(' K', 6X, 'LS', 6X, 'RAD_SW', 3X, 'RAD_LW', 4X, S_OBDIAG.197
& 'BL', 7X, 'LSR', 7X, 'LSC', 7X, 'Q2'/) S_OBDIAG.198
Do i = ndim, 1, -1 S_OBDIAG.199
Write (nout, 2011) S_OBDIAG.200
& i, dap1(k, 20, i), dap1(k, 32, i), dap1(k, 32, i), S_OBDIAG.201
& dap1(k, 21, i), dap1(k, 31, i), -dap1(k, 29, i), S_OBDIAG.202
& dap1(k, 23, i) S_OBDIAG.203
enddo S_OBDIAG.204
2011 Format(i3, 2x, 7(f7.1, 2x)) S_OBDIAG.205
Write (nout, 2119) S_OBDIAG.206
2119 Format(' K', 6X, ' Q2UD', 7X, 'Q2DD'/) S_OBDIAG.207
Do i = ndim, 1, -1 S_OBDIAG.208
Write (nout, 2117) i, dap1(k, 35, i), dap1(k, 36, i) S_OBDIAG.209
enddo S_OBDIAG.210
C----- S_OBDIAG.211
C----- Print out budgets S_OBDIAG.212
C----- S_OBDIAG.213
Write (nout, 2012) S_OBDIAG.214
2012 Format(/' Sensible heat--budget'/ S_OBDIAG.215
& ' units--W/m * m'// S_OBDIAG.216
& 2X, 'TI (J/M * M)', 2X, ' TF (J/M * M)', 3X, 'DT/DT', S_OBDIAG.217
& 6X, 'Q1', S_OBDIAG.218
& 6X, 'RAIN', 5X, 'SNOW', 5X, 'LS', 8X, 'RAD', 5X, 'SURF', S_OBDIAG.219
& 5X, 'LSR', 5X, 'LSC', 6X, 'ERROR') S_OBDIAG.220
Write (nout, 2013) dab1(k, 33), dab1(k, 35), dab1(k, 37), S_OBDIAG.221
& dab1(k, 7), dab1(k, 23), S_OBDIAG.222
& dab1(k, 24), dab1(k, 3), dab1(k, 5), dab1(k, 4), S_OBDIAG.223
& dab1(k, 6), dab1(k, 13), S_OBDIAG.224
& (dab1(k, 37)-dab1(k, 3)-dab1(k, 7)-dab1(k, 4) S_OBDIAG.225
& -dab1(k, 5)-dab1(k, 6)-dab1(k, 13)) S_OBDIAG.226
2013 Format(E12.3, 2X, E12.3, 2X, 9(F7.1, 2X)/) S_OBDIAG.227
Write (nout, 2112) S_OBDIAG.228
2112 Format(2X, 'Q1UD', 6X, 'Q1DD') S_OBDIAG.229
Write (nout, 2113) dab1(k, 41), dab1(k, 42) S_OBDIAG.230
2113 Format(2(E12.5, 2X)/) S_OBDIAG.231
Write (nout, 2014) S_OBDIAG.232
2014 Format(/' Latent heat--budgets'/ S_OBDIAG.233
& ' Units--W m^-2 '// S_OBDIAG.234
& 2X, 'QI (J m^-2 )', 2X, ' QF (J m^-2 )', 3X, 'DQ/DT', S_OBDIAG.235
& 6X, 'Q2', S_OBDIAG.236
& 6X, 'RAIN', 5X, 'SNOW', 5X, 'LS', 16X, 'SURF', 5X, 'LSR', S_OBDIAG.237
& 5X, 'LSC', S_OBDIAG.238
& 6X, 'ERROR') S_OBDIAG.239
Write (nout, 2015) dab1(k, 34), dab1(k, 36), dab1(k, 38), S_OBDIAG.240
& dab1(k, 17), S_OBDIAG.241
& -dab1(k, 23), -dab1(k, 24), dab1(k, 14), dab1(k, 15), S_OBDIAG.242
& dab1(k, 16), -dab1(k, 22), S_OBDIAG.243
& (dab1(k, 38) + dab1(k, 22)-dab1(k, 14)-dab1(k, 17) S_OBDIAG.244
& -dab1(k, 16)-dab1(k, 15)) S_OBDIAG.245
2015 Format(e12.3, 2x, e12.3, 2x, 5(f7.1, 2x), 8x, 3(f7.1, 2x)) S_OBDIAG.246
Write (nout, 2114) S_OBDIAG.247
2114 Format(2X, 'Q2UD', 6X, 'Q2DD') S_OBDIAG.248
Write (nout, 2113) dab1(k, 43), dab1(k, 44) S_OBDIAG.249
endif S_OBDIAG.250
C----- S_OBDIAG.251
S_OBDIAG.252
C----- S_OBDIAG.253
C----- Put data into longer average arrays S_OBDIAG.254
C----- S_OBDIAG.255
Do i = 1, 36 S_OBDIAG.256
dab2(k, i) = dab2(k, i) + dab1(k, i) S_OBDIAG.257
Do ia1 = 1, ndim S_OBDIAG.258
dap2(k, i, ia1) = dap2(k, i, ia1) + dap1(k, i, ia1) S_OBDIAG.259
enddo S_OBDIAG.260
enddo S_OBDIAG.261
Do i = 37, 44 S_OBDIAG.262
dab2(k, i) = dab2(k, i) + dab1(k, i) S_OBDIAG.263
enddo S_OBDIAG.264
C S_OBDIAG.265
C S_OBDIAG.266
C----- S_OBDIAG.267
C----- Complete longer average, and zero arrays S_OBDIAG.268
C----- S_OBDIAG.269
If (mod((daycount-1) * 86400/int(timestep) + stepcount, ichgf) S_OBDIAG.270
& .eq. 0 S_OBDIAG.271
& .and. (daycount-1) + (stepcount-1) .gt. 0) then S_OBDIAG.272
C----- S_OBDIAG.273
C----- Complete average S_OBDIAG.274
C----- S_OBDIAG.275
Do i = 1, 36 S_OBDIAG.276
dab2(k, i) = dab2(k, i)/ichgf S_OBDIAG.277
Do ia1 = 1, ndim S_OBDIAG.278
dap2(k, i, ia1) = dap2(k, i, ia1)/ichgf S_OBDIAG.279
enddo S_OBDIAG.280
enddo S_OBDIAG.281
Do i = 37, 44 S_OBDIAG.282
dab2(k, i) = dab2(k, i)/ichgf S_OBDIAG.283
enddo S_OBDIAG.284
C----- S_OBDIAG.285
C----- S_OBDIAG.286
C----- Feed longer time average into wave cycle average S_OBDIAG.287
C----- C S_OBDIAG.288
C----- S_OBDIAG.289
C----- S_OBDIAG.290
C----- Sum profiles S_OBDIAG.291
C----- S_OBDIAG.292
Do kl = 1, ndimq S_OBDIAG.293
dap3(k, 2, iwcavg, kl) = dap3(k, 2, iwcavg, kl) + S_OBDIAG.294
& dap2(k, 8, kl) - (qi(k, kl) * 1000.0) S_OBDIAG.295
enddo S_OBDIAG.296
Do kl = 1, ndim S_OBDIAG.297
dap3(k, 1, iwcavg, kl) = dap3(k, 1, iwcavg, kl) S_OBDIAG.298
& + dap2(k, 7, kl)-ti(k, kl) S_OBDIAG.299
dap3(k, 3, iwcavg, kl) = dap3(k, 3, iwcavg, kl) S_OBDIAG.300
& + dap2(k, 10, kl) S_OBDIAG.301
dap3(k, 4, iwcavg, kl) = dap3(k, 4, iwcavg, kl) S_OBDIAG.302
& + dap2(k, 20, kl) S_OBDIAG.303
dap3(k, 5, iwcavg, kl) = dap3(k, 5, iwcavg, kl) S_OBDIAG.304
& + dap2(k, 12, kl) + dap2(k, 22, kl) S_OBDIAG.305
dap3(k, 6, iwcavg, kl) = dap3(k, 6, iwcavg, kl) S_OBDIAG.306
& + dap2(k, 11, kl) S_OBDIAG.307
dap3(k, 7, iwcavg, kl) = dap3(k, 7, iwcavg, kl) S_OBDIAG.308
& + dap2(k, 21, kl) S_OBDIAG.309
dap3(k, 8, iwcavg, kl) = dap3(k, 8, iwcavg, kl) S_OBDIAG.310
& + dap2(k, 13, kl) S_OBDIAG.311
dap3(k, 33, iwcavg, kl) = dap3(k, 33, iwcavg, kl) S_OBDIAG.312
& + dap2(k, 33, kl) S_OBDIAG.313
dap3(k, 34, iwcavg, kl) = dap3(k, 34, iwcavg, kl) S_OBDIAG.314
& + dap2(k, 34, kl) S_OBDIAG.315
dap3(k, 9, iwcavg, kl) = dap3(k, 9, iwcavg, kl) S_OBDIAG.316
& + dap2(k, 23, kl) S_OBDIAG.317
dap3(k, 35, iwcavg, kl) = dap3(k, 35, iwcavg, kl) S_OBDIAG.318
& + dap2(k, 35, kl) S_OBDIAG.319
dap3(k, 36, iwcavg, kl) = dap3(k, 36, iwcavg, kl) S_OBDIAG.320
& + dap2(k, 36, kl) S_OBDIAG.321
dap3(k, 10, iwcavg, kl) = dap3(k, 10, iwcavg, kl) S_OBDIAG.322
& + dap2(k, 14, kl) S_OBDIAG.323
dap3(k, 11, iwcavg, kl) = dap3(k, 11, iwcavg, kl) S_OBDIAG.324
& + dap2(k, 15, kl) S_OBDIAG.325
dap3(k, 12, iwcavg, kl) = dap3(k, 12, iwcavg, kl) S_OBDIAG.326
& + dap2(k, 16, kl) S_OBDIAG.327
dap3(k, 13, iwcavg, kl) = dap3(k, 13, iwcavg, kl) S_OBDIAG.328
& + dap2(k, 19, kl) S_OBDIAG.329
dap3(k, 14, iwcavg, kl) = dap3(k, 14, iwcavg, kl) S_OBDIAG.330
& + dap2(k, 9, kl) S_OBDIAG.331
dap3(k, 15, iwcavg, kl) = dap3(k, 15, iwcavg, kl) S_OBDIAG.332
& + dap2(k, 25, kl) + dap2(k, 26, kl) S_OBDIAG.333
dap3(k, 16, iwcavg, kl) = dap3(k, 16, iwcavg, kl) S_OBDIAG.334
& + dap2(k, 27, kl) S_OBDIAG.335
dap3(k, 17, iwcavg, kl) = dap3(k, 17, iwcavg, kl) S_OBDIAG.336
& -dap2(k, 29, kl) S_OBDIAG.337
dap3(k, 18, iwcavg, kl) = dap3(k, 18, iwcavg, kl) S_OBDIAG.338
& + dap2(k, 30, kl) S_OBDIAG.339
dap3(k, 19, iwcavg, kl) = dap3(k, 19, iwcavg, kl) S_OBDIAG.340
& + dap2(k, 31, kl) S_OBDIAG.341
dap3(k, 20, iwcavg, kl) = dap3(k, 20, iwcavg, kl) S_OBDIAG.342
& + dap2(k, 1, kl) S_OBDIAG.343
enddo S_OBDIAG.344
S_OBDIAG.345
c----- S_OBDIAG.346
C----- Sum budgets S_OBDIAG.347
C----- S_OBDIAG.348
dab3(k, 1, iwcavg) = dab3(k, 1, iwcavg) + dab2(k, 1) S_OBDIAG.349
dab3(k, 2, iwcavg) = dab3(k, 2, iwcavg) + dab2(k, 2) S_OBDIAG.350
dab3(k, 3, iwcavg) = dab3(k, 3, iwcavg) + dab2(k, 3) S_OBDIAG.351
dab3(k, 4, iwcavg) = dab3(k, 4, iwcavg) + dab2(k, 14) S_OBDIAG.352
dab3(k, 5, iwcavg) = dab3(k, 5, iwcavg) + dab2(k, 5) S_OBDIAG.353
dab3(k, 6, iwcavg) = dab3(k, 6, iwcavg) + dab2(k, 4) S_OBDIAG.354
dab3(k, 7, iwcavg) = dab3(k, 7, iwcavg) + dab2(k, 15) S_OBDIAG.355
dab3(k, 8, iwcavg) = dab3(k, 8, iwcavg) + dab2(k, 7) S_OBDIAG.356
dab3(k, 41, iwcavg) = dab3(k, 41, iwcavg) + dab2(k, 41) S_OBDIAG.357
dab3(k, 42, iwcavg) = dab3(k, 42, iwcavg) + dab2(k, 42) S_OBDIAG.358
dab3(k, 9, iwcavg) = dab3(k, 9, iwcavg) + dab2(k, 17) S_OBDIAG.359
dab3(k, 43, iwcavg) = dab3(k, 43, iwcavg) + dab2(k, 43) S_OBDIAG.360
dab3(k, 44, iwcavg) = dab3(k, 44, iwcavg) + dab2(k, 44) S_OBDIAG.361
dab3(k, 10, iwcavg) = dab3(k, 10, iwcavg) + dab2(k, 8) S_OBDIAG.362
dab3(k, 11, iwcavg) = dab3(k, 11, iwcavg) + dab2(k, 9) S_OBDIAG.363
& + dab2(k, 10) S_OBDIAG.364
dab3(k, 12, iwcavg) = dab3(k, 12, iwcavg) + dab2(k, 11) S_OBDIAG.365
dab3(k, 13, iwcavg) = dab3(k, 13, iwcavg) + dab2(k, 13) S_OBDIAG.366
dab3(k, 14, iwcavg) = dab3(k, 14, iwcavg) + dab2(k, 18) S_OBDIAG.367
dab3(k, 15, iwcavg) = dab3(k, 15, iwcavg) + dab2(k, 19) S_OBDIAG.368
& + dab2(k, 20) S_OBDIAG.369
dab3(k, 16, iwcavg) = dab3(k, 16, iwcavg) + dab2(k, 21) S_OBDIAG.370
dab3(k, 17, iwcavg) = dab3(k, 17, iwcavg)-dab2(k, 22) S_OBDIAG.371
dab3(k, 18, iwcavg) = dab3(k, 18, iwcavg) + dab2(k, 6) S_OBDIAG.372
dab3(k, 19, iwcavg) = dab3(k, 19, iwcavg) + dab2(k, 16) S_OBDIAG.373
S_OBDIAG.374
C----- S_OBDIAG.375
C----- S_OBDIAG.376
C----- If simulation time less than spinup print S_OBDIAG.377
C----- write out averages and zero arrays S_OBDIAG.378
C----- first two wave cycles are taken as spin-up S_OBDIAG.379
C----- each printed out separately S_OBDIAG.380
C----- S_OBDIAG.381
C----- S_OBDIAG.382
If ((daycount-1) * 86400 / int(timestep + stepcount) S_OBDIAG.383
& .eq. 8 * ichgf) then S_OBDIAG.384
spinup = .true. S_OBDIAG.385
elseif ((daycount-1) * 86400 / int(timestep + stepcount) S_OBDIAG.386
& .eq. 16 * ichgf) then S_OBDIAG.387
spinup = .true. S_OBDIAG.388
else S_OBDIAG.389
spinup = .false. S_OBDIAG.390
endif S_OBDIAG.391
S_OBDIAG.392
If (spinup) then S_OBDIAG.393
C----- S_OBDIAG.394
C----- S_OBDIAG.395
C----- Write out wave cycle averages S_OBDIAG.396
C----- table1----writes out tables of profiles S_OBDIAG.397
C----- table2----writes out tables of budgets S_OBDIAG.398
C----- S_OBDIAG.399
C----- S_OBDIAG.400
Call TABLE1('Temperature profile deviation(K/Day)', S_OBDIAG.401
& dap3, 1, ndim, nout2) S_OBDIAG.402
Call TABLE1('LS temperature advection(K/Day)', dap3, 3, S_OBDIAG.403
& ndim, nout2) S_OBDIAG.404
Call TABLE1('Relative humidity', dap3, 14, ndim, nout2) S_OBDIAG.405
Call TABLE1('Radiation(K/Day)', dap3, 5, ndim, nout2) S_OBDIAG.406
Call TABLE1('Boundary layer-sensible heat(K/Day)', dap3, S_OBDIAG.407
& 6, ndim, nout2) S_OBDIAG.408
Call TABLE1('Large scale rain-latent heating(K/Day)', S_OBDIAG.409
& dap3, 18, ndim, nout2) S_OBDIAG.410
Call TABLE1('Q1 = apparent heat source(K/Day)', dap3, 8, S_OBDIAG.411
& ndim, nout2) S_OBDIAG.412
Call TABLE1('Q1UD = apparent heat source(K/Day)', dap3, S_OBDIAG.413
& 33, ndim, nout2) S_OBDIAG.414
Call TABLE1('Q1DD = apparent heat source(K/Day)', dap3, S_OBDIAG.415
& 34, ndim, nout2) S_OBDIAG.416
Call TABLE1('Large scale cloud (K/Day)', dap3, S_OBDIAG.417
& 13, ndim, nout2) S_OBDIAG.418
Do JL = 1, 8 S_OBDIAG.419
Do KL = 1, NDIM S_OBDIAG.420
dap3(k, 8, JL, KL) = dap3(k, 8, JL, KL) S_OBDIAG.421
& + dap3(k, 6, JL, KL) + dap3(k, 18, JL, KL) S_OBDIAG.422
& + dap3(k, 13, JL, KL) S_OBDIAG.423
enddo S_OBDIAG.424
enddo S_OBDIAG.425
Call TABLE1('Q1 + BL + LSR + LSC (K/Day)', dap3, S_OBDIAG.426
& 8, ndim, nout2) S_OBDIAG.427
Call TABLE1('Mixing ratio profile deviation(G/Kg/Day)', S_OBDIAG.428
& dap3, 2, ndim, nout2) S_OBDIAG.429
Call TABLE1('LS moisture advection(K/Day)', dap3, 4, S_OBDIAG.430
& ndim, nout2) S_OBDIAG.431
Call TABLE1('Boundary layer-latent heat(K/Day)', dap3, 7, S_OBDIAG.432
& ndim, nout2) S_OBDIAG.433
Call TABLE1('Large-scale rain-moisture(K/Day)', dap3, 19, S_OBDIAG.434
& ndim, nout2) S_OBDIAG.435
Call TABLE1('Q2 = Apparent moisture source(K/Day)', dap3, S_OBDIAG.436
& 9, ndim, nout2) S_OBDIAG.437
Call TABLE1('Q2UD = Apparent moisture source(K/Day)', S_OBDIAG.438
& dap3, 35, ndim, nout2) S_OBDIAG.439
Call TABLE1('Q2DD = Apparent moisture source(K/Day)', S_OBDIAG.440
& dap3, 36, ndim, nout2) S_OBDIAG.441
Call TABLE1('Large scale cloud (K/Day)', dap3, S_OBDIAG.442
& 17, ndim, nout2) S_OBDIAG.443
Do jl = 1, 8 S_OBDIAG.444
Do kl = 1, ndim S_OBDIAG.445
dap3(k, 9, jl, kl) = dap3(k, 9, jl, kl) S_OBDIAG.446
& + dap3(k, 7, jl, kl) + dap3(k, 19, jl, kl) S_OBDIAG.447
& + dap3(k, 17, jl, kl) S_OBDIAG.448
enddo S_OBDIAG.449
enddo S_OBDIAG.450
Call TABLE1('Q2 + BL + LSR + LSC (K/Day)', dap3, S_OBDIAG.451
& 9, ndim, nout2) S_OBDIAG.452
Call TABLE1('Cloud water (g/Kg)', dap3, 10, ndim, nout2) S_OBDIAG.453
Call TABLE1('Cloud ice (g/Kg)', dap3, 11, ndim, nout2) S_OBDIAG.454
Call TABLE1('Fractional cloud amount', dap3, S_OBDIAG.455
& 12, ndim, nout2) S_OBDIAG.456
Call TABLE1('Mass_flux', dap3, 20, ndim, nout2) S_OBDIAG.457
S_OBDIAG.458
Call HEAD2('Sensible heat budgets-J/m^2 or W/m^2', nout2) S_OBDIAG.459
Call TAB21('Temp', dab3, 1, nout2) S_OBDIAG.460
Call TAB22('ADVF', dab3, 3, nout2) S_OBDIAG.461
Call TAB22('RAD', dab3, 5, nout2) S_OBDIAG.462
Call TAB22('BL', dab3, 6, nout2) S_OBDIAG.463
Call TAB22('LSR', dab3, 18, nout2) S_OBDIAG.464
Call TAB22('Q1', dab3, 8, nout2) S_OBDIAG.465
Call TAB21('Q1UD', dab3, 41, nout2) S_OBDIAG.466
Call TAB21('Q1DD', dab3, 42, nout2) S_OBDIAG.467
Call TAB22('LSC', dab3, 13, nout2) S_OBDIAG.468
Do jl = 1, 8 S_OBDIAG.469
dab3(k, 8, jl) = dab3(k, 8, jl) + dab3(k, 6, jl) S_OBDIAG.470
& + dab3(k, 18, jl) + dab3(k, 13, jl) S_OBDIAG.471
enddo S_OBDIAG.472
Call TAB22('SUMQ1', dab3, 8, nout2) S_OBDIAG.473
S_OBDIAG.474
Call HEAD2('Latent heat budget-J/m^2 OR W/m^2', nout2) S_OBDIAG.475
Call TAB21('MIXR', dab3, 2, nout2) S_OBDIAG.476
Call TAB22('ADVF', dab3, 4, nout2) S_OBDIAG.477
Call TAB22('BL', dab3, 7, nout2) S_OBDIAG.478
Call TAB22('LSR', dab3, 19, nout2) S_OBDIAG.479
Call TAB22('Q2', dab3, 9, nout2) S_OBDIAG.480
Call TAB21('Q2UD', dab3, 43, nout2) S_OBDIAG.481
Call TAB21('Q2DD', dab3, 44, nout2) S_OBDIAG.482
Call TAB22('LSC', dab3, 17, nout2) S_OBDIAG.483
Do jl = 1, 8 S_OBDIAG.484
dab3(k, 9, jl) = dab3(k, 9, jl) + dab3(k, 7, jl) S_OBDIAG.485
& + dab3(k, 19, jl)-dab3(k, 17, jl) S_OBDIAG.486
enddo S_OBDIAG.487
Call TAB22('SUMQ2', dab3, 9, nout2) S_OBDIAG.488
S_OBDIAG.489
Do i = 1, 36 S_OBDIAG.490
Do jl = 1, 8 S_OBDIAG.491
dab3(k, i, jl) = 0.0 S_OBDIAG.492
Do kl = 1, ndim S_OBDIAG.493
dap3(k, i, jl, kl) = 0.0 S_OBDIAG.494
enddo S_OBDIAG.495
enddo S_OBDIAG.496
enddo S_OBDIAG.497
S_OBDIAG.498
Do i = 37, 44 S_OBDIAG.499
Do jl = 1, 8 S_OBDIAG.500
dab3(k, i, jl) = 0.0 S_OBDIAG.501
enddo S_OBDIAG.502
enddo S_OBDIAG.503
S_OBDIAG.504
endif S_OBDIAG.505
S_OBDIAG.506
C----- S_OBDIAG.507
C----- Print out results S_OBDIAG.508
C----- S_OBDIAG.509
ptime1 = float((daycount-1) * 24) S_OBDIAG.510
& + (float(stepcount) * timestep/3600.0) S_OBDIAG.511
ptime2 = float(ichgf) * timestep/3600.0 S_OBDIAG.512
ptime3 = ptime1 - ptime2 S_OBDIAG.513
Write (nout3, 2040) ptime2, ptime3, ptime1 S_OBDIAG.514
2040 Format(//' Average over previous ', f8.2, ' hours'/ S_OBDIAG.515
& ' hour ', f8.2, ' to hour ', f8.2// S_OBDIAG.516
& ' cloud and environment parameters'/ S_OBDIAG.517
& ' during call to convection routine'/) S_OBDIAG.518
Write (nout3, 2001) S_OBDIAG.519
Do i = ndim, 1, -1 S_OBDIAG.520
Write (nout3, 2003)i, dap2(k, 7, i), dap2(k, 8, i), S_OBDIAG.521
& dap2(k, 9, i), dap2(k, 14, i), S_OBDIAG.522
& dap2(k, 15, i), dap2(k, 16, i), dap2(k, 1, i) S_OBDIAG.523
enddo S_OBDIAG.524
Write (nout3, 2004) S_OBDIAG.525
Write (nout3, 2005) S_OBDIAG.526
Do i = ndim, 1, -1 S_OBDIAG.527
Write (nout3, 2007)i, dap2(k, 10, i), dap2(k, 12, i), S_OBDIAG.528
& dap2(k, 22, i), S_OBDIAG.529
& dap2(k, 11, i), dap2(k, 30, i), dap2(k, 19, i), S_OBDIAG.530
& dap2(k, 13, i) S_OBDIAG.531
enddo S_OBDIAG.532
Write (nout3, 2115) S_OBDIAG.533
Do i = ndim, 1, -1 S_OBDIAG.534
Write (nout3, 2117)i, dap2(k, 33, i), dap2(k, 34, i) S_OBDIAG.535
enddo S_OBDIAG.536
Write (nout3, 2008) S_OBDIAG.537
Write (nout3, 2009) S_OBDIAG.538
Do i = ndim, 1, -1 S_OBDIAG.539
Write (nout3, 2011) i, dap2(k, 20, i), dap2(k, 32, i), S_OBDIAG.540
& dap2(k, 32, i), S_OBDIAG.541
& dap2(k, 21, i), dap2(k, 31, i), -dap2(k, 29, i), S_OBDIAG.542
& dap2(k, 23, i) S_OBDIAG.543
enddo S_OBDIAG.544
Write (nout3, 2119) S_OBDIAG.545
Do i = ndim, 1, -1 S_OBDIAG.546
Write (nout3, 2117)i, dap2(k, 35, i), dap2(k, 36, i) S_OBDIAG.547
enddo S_OBDIAG.548
C----- S_OBDIAG.549
C----- Print out budgets S_OBDIAG.550
C----- S_OBDIAG.551
Write (nout3, 2012) S_OBDIAG.552
Write (nout3, 2013)dab2(k, 33), dab2(k, 35), dab2(k, 37), S_OBDIAG.553
& dab2(k, 7), dab2(k, 23), S_OBDIAG.554
& dab2(k, 24), dab2(k, 3), dab2(k, 5), dab2(k, 4), S_OBDIAG.555
& dab2(k, 6), dab2(k, 13), S_OBDIAG.556
& (dab2(k, 37) - dab2(k, 3) - dab2(k, 7) - dab2(k, 4) S_OBDIAG.557
& - dab2(k, 5) - dab2(k, 6) - dab2(k, 13)) S_OBDIAG.558
Write (nout3, 2112) S_OBDIAG.559
Write (nout3, 2113) dab2(k, 41), dab2(k, 42) S_OBDIAG.560
Write (nout3, 2014) S_OBDIAG.561
Write (nout3, 2015) dab2(k, 34), dab2(k, 36), dab2(k, 38), S_OBDIAG.562
& dab2(k, 17), -dab2(k, 23), -dab2(k, 24), dab2(k, 14), S_OBDIAG.563
& dab2(k, 15), dab2(k, 16), -dab2(k, 22), S_OBDIAG.564
& (dab2(k, 38) - dab2(k, 14) - dab2(k, 17) - dab2(k, 15) S_OBDIAG.565
& - dab2(k, 16) + dab2(k, 22)) S_OBDIAG.566
Write (nout3, 2114) S_OBDIAG.567
Write (nout3, 2113) dab2(k, 43), dab2(k, 44) S_OBDIAG.568
C----- S_OBDIAG.569
C----- Printout complete-zero longer diagnostic arrays S_OBDIAG.570
C----- S_OBDIAG.571
Do i = 1, 36 S_OBDIAG.572
dab2(k, i) = 0.0 S_OBDIAG.573
Do ia1 = 1, ndim S_OBDIAG.574
dap2(k, i, ia1) = 0.0 S_OBDIAG.575
enddo S_OBDIAG.576
enddo S_OBDIAG.577
Do i = 37, 44 S_OBDIAG.578
dab2(k, i) = 0.0 S_OBDIAG.579
enddo S_OBDIAG.580
endif S_OBDIAG.581
C S_OBDIAG.582
enddo ! k S_OBDIAG.583
S_OBDIAG.584
Return S_OBDIAG.585
End ! Subroutine OBS_DUMP S_OBDIAG.586
C S_OBDIAG.587
S_OBDIAG.588
Subroutine TABLE1(char1, para, nu, nl, nout) 48,1S_OBDIAG.589
C----- S_OBDIAG.590
C-----To printout a table of array para S_OBDIAG.591
C-----with the title char1 S_OBDIAG.592
C----- S_OBDIAG.593
Integer nout S_OBDIAG.594
Integer nu, nl, k, i S_OBDIAG.595
Real para, avg S_OBDIAG.596
S_OBDIAG.597
Dimension para(36, 8, nl) S_OBDIAG.598
Character*(*) char1 S_OBDIAG.599
S_OBDIAG.600
Write (nout, *) char1 S_OBDIAG.601
S_OBDIAG.602
Call HEAD1(nout) S_OBDIAG.603
S_OBDIAG.604
Do k = nl, 1, -1 S_OBDIAG.605
avg = 0.0 S_OBDIAG.606
Do i = 1, 8 S_OBDIAG.607
avg = avg + para(nu, i, k) / 8.0 S_OBDIAG.608
enddo S_OBDIAG.609
Write (nout, 300) k, (para(nu, i, k), i = 1, 8), avg S_OBDIAG.610
enddo S_OBDIAG.611
300 Format(5X, I2, 3X, 9(F8.2, 2X)) S_OBDIAG.612
S_OBDIAG.613
Write (nout, 400) S_OBDIAG.614
400 Format(////) S_OBDIAG.615
S_OBDIAG.616
Return S_OBDIAG.617
End ! Subroutine TABLE1 S_OBDIAG.618
S_OBDIAG.619
Subroutine HEAD1(nout) 1S_OBDIAG.620
C----- S_OBDIAG.621
C-----To print header for table1 S_OBDIAG.622
c----- S_OBDIAG.623
Integer nout, i S_OBDIAG.624
C S_OBDIAG.625
Write (nout, 100) S_OBDIAG.626
100 Format(3x, 'level', 17x, 'wave category') S_OBDIAG.627
Write (nout, 200)(i, i = 1, 8) S_OBDIAG.628
200 Format(10x, 8(4x, i1, 5x), 3x, 'mean', 3x) S_OBDIAG.629
S_OBDIAG.630
Return S_OBDIAG.631
End ! Subroutine HEAD1 S_OBDIAG.632
S_OBDIAG.633
Subroutine HEAD2(chara, nout) 4S_OBDIAG.634
C----- S_OBDIAG.635
C-----To printout header for a table S_OBDIAG.636
C----- S_OBDIAG.637
Integer nout S_OBDIAG.638
Integer i S_OBDIAG.639
Character chara*(*), char70*70 S_OBDIAG.640
C To prevent 'rubbish' filling up the remaining spaces in the S_OBDIAG.641
C variable CHARA S_OBDIAG.642
char70 = chara S_OBDIAG.643
Write (nout, 100) char70 S_OBDIAG.644
100 Format(10x, a70) S_OBDIAG.645
Write (nout, 200) (i, i = 1, 8) S_OBDIAG.646
200 Format(1x, 'Quantity', 18x, 'wave category'/ S_OBDIAG.647
& 10x, 8(7x, i1, 7x), 5x, 'mean', 6x/) S_OBDIAG.648
S_OBDIAG.649
Return S_OBDIAG.650
End ! Subroutine HEAD2 S_OBDIAG.651
S_OBDIAG.652
Subroutine TAB21(chara, para, nu, nout) 8S_OBDIAG.653
C----- S_OBDIAG.654
C-----To printout a line of a table S_OBDIAG.655
C-----exponential form e12.6 used S_OBDIAG.656
C----- S_OBDIAG.657
Integer nout S_OBDIAG.658
Integer nu, i S_OBDIAG.659
Real para, avg S_OBDIAG.660
Dimension para(44, 8) S_OBDIAG.661
Character*(*) chara S_OBDIAG.662
Character*9 char9 S_OBDIAG.663
char9 = chara S_OBDIAG.664
avg = 0.0 S_OBDIAG.665
Do i = 1, 8 S_OBDIAG.666
avg = avg + para(nu, i) / 8.0 S_OBDIAG.667
enddo S_OBDIAG.668
Write (nout, 100) char9, (para(nu, i), i = 1, 8), avg S_OBDIAG.669
100 Format(1x, a9, 9(e12.6, 3x)/) S_OBDIAG.670
S_OBDIAG.671
Return S_OBDIAG.672
End ! Subroutine TAB21 S_OBDIAG.673
S_OBDIAG.674
Subroutine TAB22(chara, para, nu, nout) 30S_OBDIAG.675
C----- S_OBDIAG.676
C-----To print a line of a table S_OBDIAG.677
C-----real form f8.2 used S_OBDIAG.678
C----- S_OBDIAG.679
Integer nout S_OBDIAG.680
Integer nu, i S_OBDIAG.681
Real para, avg S_OBDIAG.682
Dimension para(44, 8) S_OBDIAG.683
Character*(*) chara S_OBDIAG.684
Character*9 char9 S_OBDIAG.685
char9 = chara S_OBDIAG.686
avg = 0.0 S_OBDIAG.687
do i = 1, 8 S_OBDIAG.688
avg = avg + para(nu, i)/8.0 S_OBDIAG.689
enddo S_OBDIAG.690
Write (nout, 100)char9, (para(nu, i), i = 1, 8), avg S_OBDIAG.691
100 Format(1x, a9, 9(3x, f8.2, 4x)/) S_OBDIAG.692
S_OBDIAG.693
Return S_OBDIAG.694
End ! Subroutine TAB22 S_OBDIAG.695
S_OBDIAG.696
Subroutine OBS_DUMP_FINAL(points, dap3, dab3, ndim, ndimq, 1,45S_OBDIAG.697
& daycount, stepcount, timestep, ichgf, t, q, u, v, smvc, S_OBDIAG.698
& snodep, tstar, nout, nout2) S_OBDIAG.699
C S_OBDIAG.700
C S_OBDIAG.701
C Subroutine to print out final diagnostics from Single Column S_OBDIAG.702
C Model when forcing is provided by GATE observational data S_OBDIAG.703
C S_OBDIAG.704
Implicit none S_OBDIAG.705
C S_OBDIAG.706
C S_OBDIAG.707
C S_OBDIAG.708
Integer S_OBDIAG.709
& daycount, stepcount, ichgf S_OBDIAG.710
& ,i, il, jl, kl, itotwc S_OBDIAG.711
& ,points,ndim, ndimq, nout, nout2 S_OBDIAG.712
C S_OBDIAG.713
Real S_OBDIAG.714
& dap3(points, 36, 8, ndim) S_OBDIAG.715
& ,dab3(points, 44, 8) S_OBDIAG.716
& ,smvc(points), snodep(points), tstar(points) S_OBDIAG.717
& ,t(points, ndim), q(points, ndimq) S_OBDIAG.718
& ,u(points, ndim), v(points, ndim) S_OBDIAG.719
& ,timestep S_OBDIAG.720
C S_OBDIAG.721
Integer k S_OBDIAG.722
C S_OBDIAG.723
C S_OBDIAG.724
C Print out final profiles S_OBDIAG.725
C S_OBDIAG.726
Do k = 1, points S_OBDIAG.727
Write (nout, 308) S_OBDIAG.728
& (daycount-1) * 86400 / int(timestep) + stepcount, S_OBDIAG.729
& timestep S_OBDIAG.730
Write (nout, 302) smvc(k), snodep(k), tstar(k), S_OBDIAG.731
& (t(k, i), i = 1, 10), (q(k, i), i = 1, 10), S_OBDIAG.732
& (u(k, i), i = 1, 10), (v(k, i), i = 1, 10), S_OBDIAG.733
& (t(k, i), i = 11, ndim), (q(k, i), i = 11, ndimq), S_OBDIAG.734
& (u(k, i), i = 11, ndim), (v(k, i), i = 11, ndim) S_OBDIAG.735
308 Format('0After', i7, ' timesteps of ', f8.1, S_OBDIAG.736
& ' secs, the final profiles are -') S_OBDIAG.737
302 Format( S_OBDIAG.738
& '0Smvc = ', f15.7, 7x, S_OBDIAG.739
& 'snodep = ', f15.7, 7x, S_OBDIAG.740
& 'Tstar = ', f6.2/ S_OBDIAG.741
& ' t = ', 10f9.2/' q = ', 10f9.6/ S_OBDIAG.742
& ' u = ', 10f9.2/' v = ', 10f9.2/ S_OBDIAG.743
& ' t = ', 10f9.2/' q = ', 10f9.6/ S_OBDIAG.744
& ' u = ', 10f9.2/' v = ', 10f9.2/) S_OBDIAG.745
C----- S_OBDIAG.746
C----- S_OBDIAG.747
C----- Average wave cycle averages S_OBDIAG.748
C----- S_OBDIAG.749
C----- S_OBDIAG.750
itotwc = ((daycount-1) * 86400/int(timestep) + stepcount) S_OBDIAG.751
& / (ichgf * 8) S_OBDIAG.752
itotwc = itotwc-2 S_OBDIAG.753
If (itotwc .le. 0) itotwc = 1 S_OBDIAG.754
Do IL = 1, 36 S_OBDIAG.755
Do JL = 1, 8 S_OBDIAG.756
dab3(k, il, jl) = dab3(k, il, jl)/float(itotwc) S_OBDIAG.757
Do kl = 1, ndim S_OBDIAG.758
dap3(k, il, jl, kl) = dap3(k, il, jl, kl)/float(itotwc) S_OBDIAG.759
enddo S_OBDIAG.760
enddo S_OBDIAG.761
enddo S_OBDIAG.762
Do il = 37, 44 S_OBDIAG.763
Do jl = 1, 8 S_OBDIAG.764
dab3(k, il, jl) = dab3(k, il, jl) / float(itotwc) S_OBDIAG.765
enddo S_OBDIAG.766
enddo S_OBDIAG.767
C----- S_OBDIAG.768
C----- S_OBDIAG.769
C----- Write out wave cycle averages S_OBDIAG.770
C----- Table1----writes out tables of profiles S_OBDIAG.771
C----- table2----writes out tables of budgets S_OBDIAG.772
C----- S_OBDIAG.773
C----- S_OBDIAG.774
Call TABLE1('Temperature deviation(K)', dap3, 1, ndim, nout2) S_OBDIAG.775
Call TABLE1('LS temperature advection(K Day^-1)', dap3, S_OBDIAG.776
& 3, ndim, nout2) S_OBDIAG.777
Call TABLE1('Relative humidity', dap3, 14, ndim, nout2) S_OBDIAG.778
Call TABLE1('Radiation(K Day^-1)', dap3, 5, ndim, nout2) S_OBDIAG.779
Call TABLE1('Boundary layer-sensible heat(K Day^-1)', dap3, S_OBDIAG.780
& 6, ndim, nout2) S_OBDIAG.781
Call TABLE1('Large scale rain-latent heating(K Day^-1)', S_OBDIAG.782
& dap3, 18, ndim, nout2) S_OBDIAG.783
Call TABLE1('Q1 = Apparent heat source(K Day^-1)', dap3, S_OBDIAG.784
& 8, ndim, nout2) S_OBDIAG.785
Call TABLE1('Q1UD = Apparent heat source(K Day^-1)', dap3, S_OBDIAG.786
& 33, ndim, nout2) S_OBDIAG.787
Call TABLE1('Q1DD = Apparent heat source(K Day^-1)', dap3, S_OBDIAG.788
& 34, ndim ,nout2) S_OBDIAG.789
Call TABLE1('Large scale cloud(K Day^-1)', dap3, S_OBDIAG.790
& 13, ndim, nout2) S_OBDIAG.791
Do jl = 1, 8 S_OBDIAG.792
Do kl = 1, ndim S_OBDIAG.793
dap3(k, 8, jl, kl) = dap3(k, 8, jl, kl) S_OBDIAG.794
& + dap3(k, 6, jl, kl) + dap3(k, 18, jl, kl) S_OBDIAG.795
& + dap3(k, 13, jl, kl) S_OBDIAG.796
enddo S_OBDIAG.797
enddo S_OBDIAG.798
Call TABLE1('Q1 + BL + LSR + LSC (K Day^-1)', dap3, S_OBDIAG.799
& 8, ndim, nout2) S_OBDIAG.800
Call TABLE1('Mixing ratio profile deviation(G Kg^-1 Day^-1)', S_OBDIAG.801
& dap3, 2, ndim, nout2) S_OBDIAG.802
Call TABLE1('LS Moisture advection(K Day^-1)', dap3, S_OBDIAG.803
& 4, ndim, nout2) S_OBDIAG.804
Call TABLE1('Boundary layer-latent heat(K Day^-1)', dap3, 7, S_OBDIAG.805
& ndim, nout2) S_OBDIAG.806
Call TABLE1('Large-scale rain-moisture(K Day^-1)', dap3, 19, S_OBDIAG.807
& ndim, nout2) S_OBDIAG.808
Call TABLE1('Q2 = Apparent moisture source(K Day^-1)', dap3, S_OBDIAG.809
& 9, ndim, nout2) S_OBDIAG.810
Call TABLE1('Q2UD = Apparent moisture source(K Day^-1)', dap3, S_OBDIAG.811
& 35, ndim, nout2) S_OBDIAG.812
Call TABLE1('Q2DD = Apparent moisture source(K Day^-1)', dap3, S_OBDIAG.813
& 36, ndim, nout2) S_OBDIAG.814
Call TABLE1('Large scale cloud(K Day^-1)', dap3, S_OBDIAG.815
& 17, ndim, nout2) S_OBDIAG.816
Do jl = 1, 8 S_OBDIAG.817
Do kl = 1, ndim S_OBDIAG.818
dap3(k, 9, jl, kl) = dap3(k, 9, jl, kl) S_OBDIAG.819
& + dap3(k, 7, jl, kl) + dap3(k, 19, jl, kl) S_OBDIAG.820
& + dap3(k, 17, jl, kl) S_OBDIAG.821
enddo S_OBDIAG.822
enddo S_OBDIAG.823
Call TABLE1('Q2 + BL + LSR + LSC (G GK^-1 Day^-1)', dap3, S_OBDIAG.824
& 9, ndim, nout2) S_OBDIAG.825
Call TABLE1('Cloud water (g Kg^-1)', dap3, 10, ndim, nout2) S_OBDIAG.826
Call TABLE1('Cloud ice (g Kg^-1)', dap3, 11, ndim, nout2) S_OBDIAG.827
Call TABLE1('Fractional cloud amount', dap3, 12, ndim, nout2) S_OBDIAG.828
Call TABLE1('Mass flux (Pa s^-1) ', dap3, 20, ndim, nout2) S_OBDIAG.829
S_OBDIAG.830
Call HEAD2('Sensible heat budgets-J m^-2 OR W m^-2', nout2) S_OBDIAG.831
Call TAB21('TEMP', dab3, 1, nout2) S_OBDIAG.832
Call TAB22('ADVF', dab3, 3, nout2) S_OBDIAG.833
Call TAB22('RAD', dab3, 5, nout2) S_OBDIAG.834
Call TAB22('BL', dab3, 6, nout2) S_OBDIAG.835
Call TAB22('LSR', dab3, 18, nout2) S_OBDIAG.836
Call TAB22('Q1', dab3, 8, nout2) S_OBDIAG.837
Call TAB22('Q1UD', dab3, 41, nout2) S_OBDIAG.838
Call TAB22('Q1DD', dab3, 42, nout2) S_OBDIAG.839
Call TAB22('LSC', dab3, 13, nout2) S_OBDIAG.840
Do jl = 1, 8 S_OBDIAG.841
dab3(k,8, jl) = dab3(k,8, jl) + dab3(k,6, jl) S_OBDIAG.842
& + dab3(k,18, jl) + dab3(k,13, jl) S_OBDIAG.843
enddo S_OBDIAG.844
Call TAB22('SUMQ1', dab3, 8, nout2) S_OBDIAG.845
S_OBDIAG.846
Call HEAD2('Latent heat budget-J m^-2 OR W m^-2', nout2) S_OBDIAG.847
Call TAB21('MIXR', dab3, 2, nout2) S_OBDIAG.848
Call TAB22('ADVF', dab3, 4, nout2) S_OBDIAG.849
Call TAB22('BL', dab3, 7, nout2) S_OBDIAG.850
Call TAB22('LSR', dab3, 19, nout2) S_OBDIAG.851
Call TAB22('Q2', dab3, 9, nout2) S_OBDIAG.852
Call TAB22('Q2UD', dab3, 43, nout2) S_OBDIAG.853
Call TAB22('Q2DD', dab3, 44, nout2) S_OBDIAG.854
Call TAB22('LSC', dab3, 17, nout2) S_OBDIAG.855
Do jl = 1, 8 S_OBDIAG.856
dab3(k, 9, jl) = dab3(k, 9, jl) + dab3(k, 7, jl) S_OBDIAG.857
& + dab3(k, 19, jl) - dab3(k, 17, jl) S_OBDIAG.858
enddo S_OBDIAG.859
Call TAB22('SUMQ2', dab3, 9, nout2) S_OBDIAG.860
S_OBDIAG.861
enddo ! k S_OBDIAG.862
Return S_OBDIAG.863
End ! Subroutine OBS_DUMP_FINAL S_OBDIAG.864
C S_OBDIAG.865
C Subroutine to print out additional diagnostics S_OBDIAG.866
C S_OBDIAG.867
Subroutine DIAG2(points, nbl_levs, iccb, icct, cca, lat_heat, 1S_OBDIAG.868
& sens_heat, lw_flux, sw_flux, e_sea, conv_rain, conv_snow, S_OBDIAG.869
& ls_rain, ls_snow, rhokh, nout) S_OBDIAG.870
C S_OBDIAG.871
Implicit none S_OBDIAG.872
C S_OBDIAG.873
*CALL C_LHEAT S_OBDIAG.874
Integer S_OBDIAG.875
& points S_OBDIAG.876
& ,nbl_levs S_OBDIAG.877
& ,iccb(points) ! Convective cloud base and top , S_OBDIAG.878
& ,icct(points) ! at levels 1 to NLEVS S_OBDIAG.879
& ,nout ! Unit for output of observational S_OBDIAG.880
! diagnostics S_OBDIAG.881
C S_OBDIAG.882
Real S_OBDIAG.883
& cca(points) ! Convective cloud amount S_OBDIAG.884
& ,lat_heat(points) ! Surface latent heat flux, + ve S_OBDIAG.885
! upwards (W m^-2) S_OBDIAG.886
& ,sens_heat(points) ! Sensible heat (W m^-2) S_OBDIAG.887
& ,lw_flux(points) ! Net longwave flux over sea S_OBDIAG.888
! portion of grid box if S_OBDIAG.889
! sea point (W m^-2) S_OBDIAG.890
& ,sw_flux(points) ! Net shortwave flux over sea S_OBDIAG.891
! portion of grid box if S_OBDIAG.892
! sea point (W m^-2) S_OBDIAG.893
& ,e_sea(points) ! Evaporation from sea times leads S_OBDIAG.894
! fraction. Zero over land. S_OBDIAG.895
! (Kg m^-2 s^-1) S_OBDIAG.896
& ,conv_rain(points) ! Convective rainfall (Kg m^-2 s^-1) S_OBDIAG.897
& ,conv_snow(points) ! Convective snowfall (Kg m^-2 s^-1) S_OBDIAG.898
& ,ls_rain(points) ! Large scale rainfall rate (Kg m^-2) S_OBDIAG.899
& ,ls_snow(points) ! Large scale snowfall rate S_OBDIAG.900
& ,rhokh(points, nbl_levs) S_OBDIAG.901
! Exchange coeffs for moisture. S_OBDIAG.902
! Surface:out of SF_EXCH contains S_OBDIAG.903
! contains only rhokh. S_OBDIAG.904
! Above surface:out of kmkh contains S_OBDIAG.905
! gamma(1) * rhokh(, 1) * rdz(, 1) S_OBDIAG.906
C S_OBDIAG.907
Integer k ! Loop counter S_OBDIAG.908
Real S_OBDIAG.909
& c_rain(points) S_OBDIAG.910
& ,c_snow(points) S_OBDIAG.911
& ,l_rain(points) S_OBDIAG.912
& ,l_snow(points) S_OBDIAG.913
C S_OBDIAG.914
Do k = 1, points S_OBDIAG.915
c_rain(k) = conv_rain(k) * Lc S_OBDIAG.916
c_snow(k) = conv_snow(k) * (Lc + Lf) S_OBDIAG.917
l_rain(k) = ls_rain(k) * Lc S_OBDIAG.918
l_snow(k) = ls_snow(k) * (Lc + Lf) S_OBDIAG.919
enddo S_OBDIAG.920
C S_OBDIAG.921
Write (nout, *) S_OBDIAG.922
Write (nout, 100) S_OBDIAG.923
Write (nout, 110) S_OBDIAG.924
Do k = 1, points S_OBDIAG.925
Write (nout, 120) iccb(k), icct(k), cca(k) S_OBDIAG.926
enddo S_OBDIAG.927
C S_OBDIAG.928
Write (nout, *) S_OBDIAG.929
Write (nout, 130) S_OBDIAG.930
Write (nout, 140) S_OBDIAG.931
Do k = 1, points S_OBDIAG.932
Write (nout, *) lat_heat(k), sens_heat(k), lw_flux(k), S_OBDIAG.933
& sw_flux(k), e_sea(k) S_OBDIAG.934
enddo S_OBDIAG.935
Write (nout, 160) S_OBDIAG.936
Do k = 1, points S_OBDIAG.937
Write (nout, *) c_rain(k), c_snow(k), l_rain(k), l_snow(k), S_OBDIAG.938
& rhokh(k, 1) S_OBDIAG.939
enddo S_OBDIAG.940
C S_OBDIAG.941
100 Format(1X, 'Convective cloud') S_OBDIAG.942
110 Format(1X, 'Base', 2X, 'Top', 3X, 'Amount') S_OBDIAG.943
120 Format(1X, I3, 3X, I3, 3X, F5.3) S_OBDIAG.944
C S_OBDIAG.945
130 Format(1X, 'Surface fluxes') S_OBDIAG.946
140 Format(1X, 'LH', 9X, 'SH', 9X, 'LW', 9X, 'SW', 9X, 'E_SEA') S_OBDIAG.947
150 Format(1X, E10.7, 1X, E10.7, 1X, E10.7, 1X, E10.7) S_OBDIAG.948
160 Format(1X, 'CR', 9X, 'CS', 9X, 'LR', 9X, 'LS', 9X, 'RHOKH') S_OBDIAG.949
C S_OBDIAG.950
Return S_OBDIAG.951
End ! Subroutine DIAG2 S_OBDIAG.952
C S_OBDIAG.953
C Routine to output OBS forcing data to produce graphs using S_OBDIAG.954
C PV wave. S_OBDIAG.955
C S_OBDIAG.956
Subroutine OBS_GRAF(points, dap1, dapdim1, dapdim2, dab1, 1S_OBDIAG.957
& dabdim1, dabdim2, day, time, iun) S_OBDIAG.958
C--------------------------------------------------------------------- S_OBDIAG.959
C Arguments S_OBDIAG.960
C--------------------------------------------------------------------- S_OBDIAG.961
Implicit none S_OBDIAG.962
Integer S_OBDIAG.963
& points S_OBDIAG.964
& ,day ! IN S_OBDIAG.965
& ,dapdim1 ! IN I dimension array dap1 S_OBDIAG.966
& ,dapdim2 ! IN J dimension array dap1 S_OBDIAG.967
& ,dabdim1 ! IN I dimension array dab1 S_OBDIAG.968
& ,dabdim2 ! IN J dimension array dab1 S_OBDIAG.969
Real S_OBDIAG.970
& dap1(points, dapdim1, dapdim2) S_OBDIAG.971
! IN OBS. diagnostics to be output S_OBDIAG.972
! for graph S_OBDIAG.973
& ,dab1(points, dabdim1, dabdim2) S_OBDIAG.974
! IN OBS. diagnostics to be output S_OBDIAG.975
! for graph S_OBDIAG.976
& ,time S_OBDIAG.977
C S_OBDIAG.978
C Local variables S_OBDIAG.979
C S_OBDIAG.980
S_OBDIAG.981
Integer S_OBDIAG.982
& iun ! Unit for output S_OBDIAG.983
Integer S_OBDIAG.984
& i, k ! Counters S_OBDIAG.985
& ,j S_OBDIAG.986
C S_OBDIAG.987
C S_OBDIAG.988
S_OBDIAG.989
Do k = 1, points S_OBDIAG.990
Write (iun, *) day, time, S_OBDIAG.991
& ((dap1(k, i, j), j = 1, dapdim2), i = 1, dapdim1), S_OBDIAG.992
& ((dab1(k, i, j), j = 1, dabdim2), i = 1, dabdim1) S_OBDIAG.993
enddo S_OBDIAG.994
S_OBDIAG.995
Return S_OBDIAG.996
End ! Subroutine OBS_GRAF S_OBDIAG.997
*ENDIF S_OBDIAG.998