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

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

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


Revision 1.16 - (hide annotations) (download)
Tue May 24 21:03:08 2005 UTC (19 years, 1 month ago) by molod
Branch: MAIN
Changes since 1.15: +7 -1 lines
Add fill of surface pressure diagnostic

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

  ViewVC Help
Powered by ViewVC 1.1.22