/[MITgcm]/MITgcm/pkg/fizhi/fizhi_step_diag.F
ViewVC logotype

Contents of /MITgcm/pkg/fizhi/fizhi_step_diag.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.19 - (show annotations) (download)
Thu Mar 9 00:00:36 2006 UTC (18 years, 1 month ago) by molod
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, checkpoint58u_post, checkpoint58w_post, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58q_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58c_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint58p_post, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint58b_post, checkpoint58m_post
Changes since 1.18: +10 -10 lines
Fix little bug in call to fizhi diagnostic routine

1 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_step_diag.F,v 1.18 2006/01/17 15:59:44 molod Exp $
2 C $Name: $
3
4 #include "FIZHI_OPTIONS.h"
5 subroutine fizhi_step_diag(myid,p,uphy,vphy,thphy,sphy,qq,pk,dp,
6 . radswt,radswg,swgclr,osr,osrclr,st4,dst4,tgz,tg0,radlwg,lwgclr,
7 . turbu,turbv,turbt,turbq,moistu,moistv,moistt,moistq,
8 . lwdt,swdt,lwdtclr,swdtclr,dlwdtg,
9 . im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer)
10 C***********************************************************************
11 implicit none
12
13 integer myid,im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer
14 _RL p(im2,jm2,Nbi,Nbj)
15 _RL uphy(im2,jm2,Nrphys)
16 _RL vphy(im2,jm2,Nrphys)
17 _RL thphy(im2,jm2,Nrphys)
18 _RL sphy(im2,jm2,Nrphys)
19 _RL qq(im2,jm2,Nrphys,Nbi,Nbj),pk(im2,jm2,Nrphys,Nbi,Nbj)
20 _RL dp(im2,jm2,Nrphys,Nbi,Nbj)
21 _RL radswt(im2,jm2,Nbi,Nbj),radswg(im2,jm2,Nbi,Nbj)
22 _RL swgclr(im2,jm2,Nbi,Nbj),osr(im2,jm2,Nbi,Nbj)
23 _RL osrclr(im2,jm2,Nbi,Nbj),st4(im2,jm2,Nbi,Nbj)
24 _RL dst4(im2,jm2,Nbi,Nbj),tgz(im2,jm2,Nbi,Nbj)
25 _RL tg0(im2,jm2,Nbi,Nbj),radlwg(im2,jm2,Nbi,Nbj)
26 _RL lwgclr(im2,jm2,Nbi,Nbj)
27 _RL turbu(im2,jm2,Nrphys,Nbi,Nbj)
28 _RL turbv(im2,jm2,Nrphys,Nbi,Nbj)
29 _RL turbt(im2,jm2,Nrphys,Nbi,Nbj)
30 _RL turbq(im2,jm2,Nrphys,ntracer,Nbi,Nbj)
31 _RL moistu(im2,jm2,Nrphys,Nbi,Nbj)
32 _RL moistv(im2,jm2,Nrphys,Nbi,Nbj)
33 _RL moistt(im2,jm2,Nrphys,Nbi,Nbj)
34 _RL moistq(im2,jm2,Nrphys,ntracer,Nbi,Nbj)
35 _RL lwdt(im2,jm2,Nrphys,Nbi,Nbj)
36 _RL swdt(im2,jm2,Nrphys,Nbi,Nbj)
37 _RL lwdtclr(im2,jm2,Nrphys,Nbi,Nbj)
38 _RL swdtclr(im2,jm2,Nrphys,Nbi,Nbj)
39 _RL dlwdtg(im2,jm2,Nrphys,Nbi,Nbj)
40
41 integer i,j,L
42 _RL getcon, gravity
43 _RL pinv(im2,jm2), qbar(im2,jm2),tmpdiag(im2,jm2)
44 #ifdef ALLOW_DIAGNOSTICS
45 logical diagnostics_is_on
46 external diagnostics_is_on
47 #endif
48
49 C **********************************************************************
50
51 #ifdef ALLOW_DIAGNOSTICS
52 do j=jm1,jm2
53 do i=im1,im2
54 pinv(i,j) = 1.0 / p(i,j,bi,bj)
55 enddo
56 enddo
57
58 c Surface Pressure (mb)
59 c ---------------------------------
60 if(diagnostics_is_on('PS ',myid) ) then
61 call diagnostics_fill(p(1,1,bi,bj),'PS ',0,1,3,bi,bj,myid)
62 endif
63
64 c Incident Solar Radiation (W/m**2)
65 c ---------------------------------
66 if(diagnostics_is_on('RADSWT ',myid) ) then
67 call diagnostics_fill(radswt,'RADSWT ',0,1,3,bi,bj,myid)
68 endif
69
70 c Net Solar Radiation at the Ground (W/m**2)
71 c ------------------------------------------
72 if(diagnostics_is_on('RADSWG ',myid) ) then
73 do j=jm1,jm2
74 do i=im1,im2
75 tmpdiag(i,j) = radswg(i,j,bi,bj)*radswt(i,j,bi,bj)
76 enddo
77 enddo
78 call diagnostics_fill(tmpdiag,'RADSWG ',0,1,3,bi,bj,myid)
79 endif
80
81 c Net Clear Sky Solar Radiation at the Ground (W/m**2)
82 c ----------------------------------------------------
83 if(diagnostics_is_on('SWGCLR ',myid) ) then
84 do j=jm1,jm2
85 do i=im1,im2
86 tmpdiag(i,j) = swgclr(i,j,bi,bj)*radswt(i,j,bi,bj)
87 enddo
88 enddo
89 call diagnostics_fill(tmpdiag,'SWGCLR ',0,1,3,bi,bj,myid)
90 endif
91
92 c Outgoing Solar Radiation at top (W/m**2)
93 c -----------------------------------------
94 if(diagnostics_is_on('OSR ',myid) ) then
95 do j=jm1,jm2
96 do i=im1,im2
97 tmpdiag(i,j) = (1.0-osr(i,j,bi,bj))*radswt(i,j,bi,bj)
98 enddo
99 enddo
100 call diagnostics_fill(tmpdiag,'OSR ',0,1,3,bi,bj,myid)
101 endif
102
103 c Outgoing Clear Sky Solar Radiation at top (W/m**2)
104 c ---------------------------------------------------
105 if(diagnostics_is_on('OSRCLR ',myid) ) then
106 do j=jm1,jm2
107 do i=im1,im2
108 tmpdiag(i,j) = (1.0-osrclr(i,j,bi,bj))*radswt(i,j,bi,bj)
109 enddo
110 enddo
111 call diagnostics_fill(tmpdiag,'OSRCLR ',0,1,3,bi,bj,myid)
112 endif
113
114 c Planetary Albedo
115 c ----------------
116 if(diagnostics_is_on('PLALBEDO',myid) ) then
117 do j=jm1,jm2
118 do i=im1,im2
119 if(radswt(i,j,bi,bj).ne.0.) then
120 tmpdiag(i,j) = osr(i,j,bi,bj)
121 else
122 tmpdiag(i,j) = 0.
123 endif
124 enddo
125 enddo
126 call diagnostics_fill(tmpdiag,'PLALBEDO',0,1,3,bi,bj,myid)
127 endif
128
129 c Upward Longwave Flux at the Ground (W/m**2)
130 c -------------------------------------------
131 if(diagnostics_is_on('LWGUP ',myid) ) then
132 do j=jm1,jm2
133 do i=im1,im2
134 tmpdiag(i,j) = st4(i,j,bi,bj)
135 . + dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
136 enddo
137 enddo
138 call diagnostics_fill(tmpdiag,'LWGUP ',0,1,3,bi,bj,myid)
139 endif
140
141 c Net Longwave Flux at the Ground (W/m**2)
142 c ----------------------------------------
143 if(diagnostics_is_on('RADLWG ',myid) ) then
144 do j=jm1,jm2
145 do i=im1,im2
146 tmpdiag(i,j) = radlwg(i,j,bi,bj) +
147 . dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
148 enddo
149 enddo
150 call diagnostics_fill(tmpdiag,'RADLWG ',0,1,3,bi,bj,myid)
151 endif
152
153 c Net Longwave Flux at the Ground Clear Sky (W/m**2)
154 c --------------------------------------------------
155 if(diagnostics_is_on('LWGCLR ',myid) ) then
156 do j=jm1,jm2
157 do i=im1,im2
158 tmpdiag(i,j) = lwgclr(i,j,bi,bj) +
159 . dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
160 enddo
161 enddo
162 call diagnostics_fill(tmpdiag,'LWGCLR ',0,1,3,bi,bj,myid)
163 endif
164
165 C **********************************************************************
166 do L=1,Nrphys
167
168 c Total Diabatic U-Tendency (m/sec/day)
169 c -------------------------------------
170 if(diagnostics_is_on('DIABU ',myid) ) then
171 do j=jm1,jm2
172 do i=im1,im2
173 tmpdiag(i,j) = (moistu (i,j,L,bi,bj)+turbu(i,j,L,bi,bj) )*86400
174 enddo
175 enddo
176 call diagnostics_fill(tmpdiag,'DIABU ',L,1,3,bi,bj,myid)
177 endif
178
179 c Total Diabatic V-Tendency (m/sec/day)
180 c -------------------------------------
181 if(diagnostics_is_on('DIABV ',myid) ) then
182 do j=jm1,jm2
183 do i=im1,im2
184 tmpdiag(i,j) = (moistv (i,j,L,bi,bj)+turbv(i,j,L,bi,bj) )*86400
185 enddo
186 enddo
187 call diagnostics_fill(tmpdiag,'DIABV ',L,1,3,bi,bj,myid)
188 endif
189
190 c Total Diabatic T-Tendency (deg/day)
191 c -----------------------------------
192 if(diagnostics_is_on('DIABT ',myid) ) then
193 do j=jm1,jm2
194 do i=im1,im2
195 tmpdiag(i,j) =
196 . ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +
197 . lwdt(i,j,L,bi,bj) +
198 . dlwdtg(i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) +
199 . swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )
200 . * pk(i,j,L,bi,bj)*pinv(i,j)*86400
201 enddo
202 enddo
203 call diagnostics_fill(tmpdiag,'DIABT ',L,1,3,bi,bj,myid)
204 endif
205
206 c Total Diabatic Q-Tendency (g/kg/day)
207 c ------------------------------------
208 if(diagnostics_is_on('DIABQ ',myid) ) then
209 do j=jm1,jm2
210 do i=im1,im2
211 tmpdiag(i,j) =
212 . ( turbq(i,j,L,1,bi,bj) + moistq(i,j,L,1,bi,bj) ) *
213 . pinv(i,j)*86400*1000
214 enddo
215 enddo
216 call diagnostics_fill(tmpdiag,'DIABQ ',L,1,3,bi,bj,myid)
217 endif
218
219 c Longwave Heating (deg/day)
220 c --------------------------
221 if(diagnostics_is_on('RADLW ',myid) ) then
222 do j=jm1,jm2
223 do i=im1,im2
224 tmpdiag(i,j) =
225 . ( lwdt(i,j,l,bi,bj) +
226 . dlwdtg (i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )
227 . * pk(i,j,l,bi,bj)*pinv(i,j)*86400
228 enddo
229 enddo
230 call diagnostics_fill(tmpdiag,'RADLW ',L,1,3,bi,bj,myid)
231 endif
232
233 c Longwave Heating Clear-Sky (deg/day)
234 c ------------------------------------
235 if(diagnostics_is_on('LWCLR ',myid) ) then
236 do j=jm1,jm2
237 do i=im1,im2
238 tmpdiag(i,j) =
239 . ( lwdtclr(i,j,l,bi,bj) +
240 . dlwdtg (i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )
241 . * pk(i,j,l,bi,bj)*pinv(i,j)*86400
242 enddo
243 enddo
244 call diagnostics_fill(tmpdiag,'LWCLR ',L,1,3,bi,bj,myid)
245 endif
246
247 c Solar Radiative Heating (deg/day)
248 c ---------------------------------
249 if(diagnostics_is_on('RADSW ',myid) ) then
250 do j=jm1,jm2
251 do i=im1,im2
252 tmpdiag(i,j) =
253 . + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
254 . pk(i,j,l,bi,bj)*pinv(i,j)*86400
255 enddo
256 enddo
257 call diagnostics_fill(tmpdiag,'RADSW ',L,1,3,bi,bj,myid)
258 endif
259
260 c Clear Sky Solar Radiative Heating (deg/day)
261 c -------------------------------------------
262 if(diagnostics_is_on('SWCLR ',myid) ) then
263 do j=jm1,jm2
264 do i=im1,im2
265 tmpdiag(i,j) =
266 . + swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
267 . pk(i,j,l,bi,bj)*pinv(i,j)*86400
268 enddo
269 enddo
270 call diagnostics_fill(tmpdiag,'SWCLR ',L,1,3,bi,bj,myid)
271 endif
272
273 c Averaged U-Field (m/sec)
274 c ------------------------
275 if(diagnostics_is_on('UWND ',myid) ) then
276 do j=jm1,jm2
277 do i=im1,im2
278 tmpdiag(i,j) = uphy(i,j,L)
279 enddo
280 enddo
281 call diagnostics_fill(tmpdiag,'UWND ',L,1,3,bi,bj,myid)
282 endif
283
284 c Averaged V-Field (m/sec)
285 c ------------------------
286 if(diagnostics_is_on('VWND ',myid) ) then
287 do j=jm1,jm2
288 do i=im1,im2
289 tmpdiag(i,j) = vphy(i,j,L)
290 enddo
291 enddo
292 call diagnostics_fill(tmpdiag,'VWND ',L,1,3,bi,bj,myid)
293 endif
294
295 c Averaged T-Field (deg)
296 c ----------------------
297 if(diagnostics_is_on('TMPU ',myid) ) then
298 do j=jm1,jm2
299 do i=im1,im2
300 tmpdiag(i,j) = thphy(i,j,L)*pk(i,j,L,bi,bj)
301 enddo
302 enddo
303 call diagnostics_fill(tmpdiag,'TMPU ',L,1,3,bi,bj,myid)
304 endif
305
306 c Averaged QQ-Field (m/sec)**2
307 c ----------------------------
308 if(diagnostics_is_on('TKE ',myid) ) then
309 do j=jm1,jm2
310 do i=im1,im2
311 tmpdiag(i,j) = qq(i,j,L,bi,bj)
312 enddo
313 enddo
314 call diagnostics_fill(tmpdiag,'TKE ',L,1,3,bi,bj,myid)
315 endif
316
317 c Averaged Q-Field (g/kg)
318 c -----------------------
319 if(diagnostics_is_on('SPHU ',myid) ) then
320 do j=jm1,jm2
321 do i=im1,im2
322 tmpdiag(i,j) = sphy(i,j,L) * 1000.
323 enddo
324 enddo
325 call diagnostics_fill(tmpdiag,'SPHU ',L,1,3,bi,bj,myid)
326 endif
327
328 enddo
329
330 C **********************************************************************
331
332 c Vertically Averaged Moist-T Increment (K/day)
333 c ---------------------------------------------
334 if(diagnostics_is_on('VDTMOIST',myid) ) then
335 do j=jm1,jm2
336 do i=im1,im2
337 qbar(i,j) = 0.0
338 enddo
339 enddo
340 do L=1,Nrphys
341 do j=jm1,jm2
342 do i=im1,im2
343 qbar(i,j) = qbar(i,j) +
344 . moistt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
345 enddo
346 enddo
347 enddo
348 do j=jm1,jm2
349 do i=im1,im2
350 tmpdiag(i,j) = qbar(i,j)*pinv(i,j)*pinv(i,j)*86400
351 enddo
352 enddo
353 call diagnostics_fill(tmpdiag,'VDTMOIST',0,1,3,bi,bj,myid)
354 endif
355
356 c Vertically Averaged Turb-T Increment (K/day)
357 c --------------------------------------------
358 if(diagnostics_is_on('VDTTURB ',myid) ) then
359 do j=jm1,jm2
360 do i=im1,im2
361 qbar(i,j) = 0.0
362 enddo
363 enddo
364 do L=1,Nrphys
365 do j=jm1,jm2
366 do i=im1,im2
367 qbar(i,j) = qbar(i,j) +
368 . turbt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
369 enddo
370 enddo
371 enddo
372 do j=jm1,jm2
373 do i=im1,im2
374 tmpdiag(i,j) = qbar(i,j)*pinv(i,j)*pinv(i,j)*86400
375 enddo
376 enddo
377 call diagnostics_fill(tmpdiag,'VDTTURB ',0,1,3,bi,bj,myid)
378 endif
379
380 c Vertically Averaged RADLW Temperature Increment (K/day)
381 c -------------------------------------------------------
382 if(diagnostics_is_on('VDTRADLW',myid) ) then
383 do j=jm1,jm2
384 do i=im1,im2
385 qbar(i,j) = 0.0
386 enddo
387 enddo
388 do L=1,Nrphys
389 do j=jm1,jm2
390 do i=im1,im2
391 qbar(i,j) = qbar(i,j) + ( lwdt(i,j,L,bi,bj) +
392 . dlwdtg(i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )
393 . *pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
394 enddo
395 enddo
396 enddo
397 do j=jm1,jm2
398 do i=im1,im2
399 tmpdiag(i,j) = qbar(i,j)*pinv(i,j)*pinv(i,j)*86400
400 enddo
401 enddo
402 call diagnostics_fill(tmpdiag,'VDTRADLW',0,1,3,bi,bj,myid)
403 endif
404
405 c Vertically Averaged RADSW Temperature Increment (K/day)
406 c -------------------------------------------------------
407 if(diagnostics_is_on('VDTRADSW',myid) ) then
408 do j=jm1,jm2
409 do i=im1,im2
410 qbar(i,j) = 0.0
411 enddo
412 enddo
413 do L=1,Nrphys
414 do j=jm1,jm2
415 do i=im1,im2
416 qbar(i,j) = qbar(i,j) +
417 . swdt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
418 enddo
419 enddo
420 enddo
421 do j=jm1,jm2
422 do i=im1,im2
423 tmpdiag(i,j) = qbar(i,j) *
424 . radswt(i,j,bi,bj) * pinv(i,j) * pinv(i,j) * 86400
425 enddo
426 enddo
427 call diagnostics_fill(tmpdiag,'VDTRADSW',0,1,3,bi,bj,myid)
428 endif
429
430 c Total Precipitable Water (g/cm^2)
431 c ---------------------------------------------
432 if(diagnostics_is_on('TPW ',myid) ) then
433 gravity = getcon('GRAVITY')
434 do j=jm1,jm2
435 do i=im1,im2
436 qbar(i,j) = 0.0
437 enddo
438 enddo
439 do L=1,Nrphys
440 do j=jm1,jm2
441 do i=im1,im2
442 qbar(i,j) = qbar(i,j) +
443 . sphy(i,j,L)*dp(i,j,L,bi,bj)
444 enddo
445 enddo
446 enddo
447 do j=jm1,jm2
448 do i=im1,im2
449 tmpdiag(i,j) = qbar(i,j)*10. _d 0 /gravity
450 enddo
451 enddo
452 call diagnostics_fill(tmpdiag,'TPW ',0,1,3,bi,bj,myid)
453 endif
454 #endif
455 return
456 end

  ViewVC Help
Powered by ViewVC 1.1.22