/[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.17 - (hide annotations) (download)
Fri Jun 17 01:04:24 2005 UTC (19 years ago) by molod
Branch: MAIN
CVS Tags: checkpoint57t_post, checkpoint57o_post, checkpoint57v_post, checkpoint57m_post, checkpoint57s_post, checkpoint57k_post, checkpoint57i_post, checkpoint57y_post, checkpoint57y_pre, checkpoint57r_post, checkpoint58, checkpoint57x_post, checkpoint57n_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, checkpoint57z_post, checkpoint57j_post, checkpoint57l_post
Changes since 1.16: +16 -1 lines
Add code to fill diagnostic for planetary albedo

1 molod 1.17 C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_step_diag.F,v 1.16 2005/05/24 21:03:08 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 molod 1.17 c Planetary Albedo
114     c ----------------
115     if(diagnostics_is_on('PLALBEDO',myid) ) then
116     do j=jm1,jm2
117     do i=im1,im2
118     if(radswt(i,j,bi,bj).ne.0.) then
119     tmpdiag(i,j) = osr(i,j,bi,bj)
120     else
121     tmpdiag(i,j) = 0.
122     endif
123     enddo
124     enddo
125     call diagnostics_fill(tmpdiag,'PLALBEDO',0,1,3,bi,bj,myid)
126     endif
127    
128 molod 1.1 c Upward Longwave Flux at the Ground (W/m**2)
129     c -------------------------------------------
130 molod 1.15 if(diagnostics_is_on('LWGUP ',myid) ) then
131     do j=jm1,jm2
132     do i=im1,im2
133     tmpdiag(i,j) = st4(i,j,bi,bj)
134 molod 1.2 . + dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
135 molod 1.15 enddo
136     enddo
137     call diagnostics_fill(tmpdiag,'LWGUP ',0,1,3,bi,bj,myid)
138 molod 1.2 endif
139 molod 1.1
140     c Net Longwave Flux at the Ground (W/m**2)
141     c ----------------------------------------
142 molod 1.15 if(diagnostics_is_on('RADLWG ',myid) ) then
143     do j=jm1,jm2
144     do i=im1,im2
145     tmpdiag(i,j) = radlwg(i,j,bi,bj) +
146 molod 1.2 . dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
147 molod 1.15 enddo
148     enddo
149     call diagnostics_fill(tmpdiag,'RADLWG ',0,1,3,bi,bj,myid)
150 molod 1.2 endif
151 molod 1.1
152     c Net Longwave Flux at the Ground Clear Sky (W/m**2)
153     c --------------------------------------------------
154 molod 1.15 if(diagnostics_is_on('LWGCLR ',myid) ) then
155     do j=jm1,jm2
156     do i=im1,im2
157     tmpdiag(i,j) = lwgclr(i,j,bi,bj) +
158     . dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
159     enddo
160     enddo
161     call diagnostics_fill(tmpdiag,'LWGCLR ',0,1,3,bi,bj,myid)
162 molod 1.9 endif
163 molod 1.1
164     C **********************************************************************
165     do L=1,Nrphys
166    
167     c Total Diabatic U-Tendency (m/sec/day)
168     c -------------------------------------
169 molod 1.15 if(diagnostics_is_on('DIABU ',myid) ) then
170     do j=jm1,jm2
171     do i=im1,im2
172     tmpdiag(i,j) = (moistu (i,j,L,bi,bj)+turbu(i,j,L,bi,bj) )*86400
173     enddo
174     enddo
175     call diagnostics_fill(tmpdiag,'DIABU ',L,1,3,bi,bj,myid)
176 molod 1.1 endif
177 molod 1.15
178 molod 1.1 c Total Diabatic V-Tendency (m/sec/day)
179     c -------------------------------------
180 molod 1.15 if(diagnostics_is_on('DIABV ',myid) ) then
181     do j=jm1,jm2
182     do i=im1,im2
183     tmpdiag(i,j) = (moistv (i,j,L,bi,bj)+turbv(i,j,L,bi,bj) )*86400
184     enddo
185     enddo
186     call diagnostics_fill(tmpdiag,'DIABV ',L,1,3,bi,bj,myid)
187 molod 1.1 endif
188    
189     c Total Diabatic T-Tendency (deg/day)
190     c -----------------------------------
191 molod 1.15 if(diagnostics_is_on('DIABT ',myid) ) then
192     do j=jm1,jm2
193     do i=im1,im2
194     tmpdiag(i,j) =
195 molod 1.2 . ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +
196     . lwdt(i,j,L,bi,bj) +
197     . dlwdtg(i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) +
198     . swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )
199     . * pk(i,j,L,bi,bj)*pinv(i,j)*86400
200 molod 1.15 enddo
201     enddo
202     call diagnostics_fill(tmpdiag,'DIABT ',L,1,3,bi,bj,myid)
203 molod 1.1 endif
204 molod 1.15
205 molod 1.1 c Total Diabatic Q-Tendency (g/kg/day)
206     c ------------------------------------
207 molod 1.15 if(diagnostics_is_on('DIABQ ',myid) ) then
208     do j=jm1,jm2
209     do i=im1,im2
210     tmpdiag(i,j) =
211 molod 1.2 . ( turbq(i,j,L,1,bi,bj) + moistq(i,j,L,1,bi,bj) ) *
212     . pinv(i,j)*86400*1000
213 molod 1.15 enddo
214     enddo
215     call diagnostics_fill(tmpdiag,'DIABQ ',L,1,3,bi,bj,myid)
216 molod 1.1 endif
217    
218 molod 1.2 c Longwave Heating (deg/day)
219     c --------------------------
220 molod 1.15 if(diagnostics_is_on('RADLW ',myid) ) then
221     do j=jm1,jm2
222     do i=im1,im2
223     tmpdiag(i,j) =
224 molod 1.2 . ( lwdt(i,j,l,bi,bj) +
225     . dlwdtg (i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )
226     . * pk(i,j,l,bi,bj)*pinv(i,j)*86400
227 molod 1.15 enddo
228     enddo
229     call diagnostics_fill(tmpdiag,'RADLW ',L,1,3,bi,bj,myid)
230 molod 1.1 endif
231 molod 1.11
232 molod 1.1 c Longwave Heating Clear-Sky (deg/day)
233     c ------------------------------------
234 molod 1.15 if(diagnostics_is_on('LWCLR ',myid) ) then
235     do j=jm1,jm2
236     do i=im1,im2
237     tmpdiag(i,j) =
238 molod 1.2 . ( lwdtclr(i,j,l,bi,bj) +
239 molod 1.15 . dlwdtg (i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )
240 molod 1.2 . * pk(i,j,l,bi,bj)*pinv(i,j)*86400
241 molod 1.15 enddo
242     enddo
243     call diagnostics_fill(tmpdiag,'LWCLR ',L,1,3,bi,bj,myid)
244 molod 1.2 endif
245 molod 1.1
246     c Solar Radiative Heating (deg/day)
247     c ---------------------------------
248 molod 1.15 if(diagnostics_is_on('RADSW ',myid) ) then
249     do j=jm1,jm2
250     do i=im1,im2
251     tmpdiag(i,j) =
252 molod 1.2 . + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
253     . pk(i,j,l,bi,bj)*pinv(i,j)*86400
254 molod 1.15 enddo
255     enddo
256     call diagnostics_fill(tmpdiag,'RADSW ',L,1,3,bi,bj,myid)
257 molod 1.2 endif
258 molod 1.1
259     c Clear Sky Solar Radiative Heating (deg/day)
260     c -------------------------------------------
261 molod 1.15 if(diagnostics_is_on('SWCLR ',myid) ) then
262     do j=jm1,jm2
263     do i=im1,im2
264     tmpdiag(i,j) =
265     . + swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
266     . pk(i,j,l,bi,bj)*pinv(i,j)*86400
267     enddo
268     enddo
269     call diagnostics_fill(tmpdiag,'SWCLR ',L,1,3,bi,bj,myid)
270 molod 1.1 endif
271 molod 1.2
272 molod 1.1 c Averaged U-Field (m/sec)
273     c ------------------------
274 molod 1.15 if(diagnostics_is_on('UWND ',myid) ) then
275     do j=jm1,jm2
276     do i=im1,im2
277     tmpdiag(i,j) = uphy(i,j,L,bi,bj)
278     enddo
279     enddo
280     call diagnostics_fill(tmpdiag,'UWND ',L,1,3,bi,bj,myid)
281 molod 1.1 endif
282    
283     c Averaged V-Field (m/sec)
284     c ------------------------
285 molod 1.15 if(diagnostics_is_on('VWND ',myid) ) then
286     do j=jm1,jm2
287     do i=im1,im2
288     tmpdiag(i,j) = vphy(i,j,L,bi,bj)
289     enddo
290     enddo
291     call diagnostics_fill(tmpdiag,'VWND ',L,1,3,bi,bj,myid)
292 molod 1.1 endif
293    
294     c Averaged T-Field (deg)
295     c ----------------------
296 molod 1.15 if(diagnostics_is_on('TMPU ',myid) ) then
297     do j=jm1,jm2
298     do i=im1,im2
299     tmpdiag(i,j) = thphy(i,j,L,bi,bj)*pk(i,j,L,bi,bj)
300     enddo
301     enddo
302     call diagnostics_fill(tmpdiag,'TMPU ',L,1,3,bi,bj,myid)
303 molod 1.1 endif
304    
305     c Averaged QQ-Field (m/sec)**2
306     c ----------------------------
307 molod 1.15 if(diagnostics_is_on('TKE ',myid) ) then
308     do j=jm1,jm2
309     do i=im1,im2
310     tmpdiag(i,j) = qq(i,j,L,bi,bj)
311     enddo
312     enddo
313     call diagnostics_fill(tmpdiag,'TKE ',L,1,3,bi,bj,myid)
314 molod 1.1 endif
315    
316     c Averaged Q-Field (g/kg)
317     c -----------------------
318 molod 1.15 if(diagnostics_is_on('SPHU ',myid) ) then
319     do j=jm1,jm2
320     do i=im1,im2
321     tmpdiag(i,j) = sphy(i,j,L,bi,bj) * 1000.
322     enddo
323     enddo
324     call diagnostics_fill(tmpdiag,'SPHU ',L,1,3,bi,bj,myid)
325 molod 1.1 endif
326    
327 molod 1.2 enddo
328 molod 1.1
329     C **********************************************************************
330    
331     c Vertically Averaged Moist-T Increment (K/day)
332     c ---------------------------------------------
333 molod 1.15 if(diagnostics_is_on('VDTMOIST',myid) ) then
334     do j=jm1,jm2
335     do i=im1,im2
336     qbar(i,j) = 0.0
337     enddo
338     enddo
339     do L=1,Nrphys
340     do j=jm1,jm2
341     do i=im1,im2
342     qbar(i,j) = qbar(i,j) +
343 molod 1.2 . moistt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
344 molod 1.15 enddo
345     enddo
346     enddo
347     do j=jm1,jm2
348     do i=im1,im2
349     tmpdiag(i,j) = qbar(i,j)*pinv(i,j)*pinv(i,j)*86400
350     enddo
351     enddo
352     call diagnostics_fill(tmpdiag,'VDTMOIST',0,1,3,bi,bj,myid)
353 molod 1.1 endif
354    
355     c Vertically Averaged Turb-T Increment (K/day)
356     c --------------------------------------------
357 molod 1.15 if(diagnostics_is_on('VDTTURB ',myid) ) then
358     do j=jm1,jm2
359     do i=im1,im2
360     qbar(i,j) = 0.0
361     enddo
362     enddo
363     do L=1,Nrphys
364     do j=jm1,jm2
365     do i=im1,im2
366     qbar(i,j) = qbar(i,j) +
367 molod 1.2 . turbt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
368 molod 1.15 enddo
369     enddo
370     enddo
371     do j=jm1,jm2
372     do i=im1,im2
373     tmpdiag(i,j) = qbar(i,j)*pinv(i,j)*pinv(i,j)*86400
374     enddo
375     enddo
376     call diagnostics_fill(tmpdiag,'VDTTURB ',0,1,3,bi,bj,myid)
377 molod 1.1 endif
378    
379     c Vertically Averaged RADLW Temperature Increment (K/day)
380     c -------------------------------------------------------
381 molod 1.15 if(diagnostics_is_on('VDTRADLW',myid) ) then
382     do j=jm1,jm2
383     do i=im1,im2
384     qbar(i,j) = 0.0
385     enddo
386     enddo
387     do L=1,Nrphys
388     do j=jm1,jm2
389     do i=im1,im2
390     qbar(i,j) = qbar(i,j) + ( lwdt(i,j,L,bi,bj) +
391 molod 1.2 . dlwdtg(i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )
392     . *pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
393 molod 1.15 enddo
394     enddo
395     enddo
396     do j=jm1,jm2
397     do i=im1,im2
398     tmpdiag(i,j) = qbar(i,j)*pinv(i,j)*pinv(i,j)*86400
399     enddo
400     enddo
401     call diagnostics_fill(tmpdiag,'VDTRADLW',0,1,3,bi,bj,myid)
402 molod 1.1 endif
403    
404     c Vertically Averaged RADSW Temperature Increment (K/day)
405     c -------------------------------------------------------
406 molod 1.15 if(diagnostics_is_on('VDTRADSW',myid) ) then
407     do j=jm1,jm2
408     do i=im1,im2
409     qbar(i,j) = 0.0
410     enddo
411     enddo
412     do L=1,Nrphys
413     do j=jm1,jm2
414     do i=im1,im2
415     qbar(i,j) = qbar(i,j) +
416 molod 1.2 . swdt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
417 molod 1.15 enddo
418     enddo
419     enddo
420     do j=jm1,jm2
421     do i=im1,im2
422     tmpdiag(i,j) = qbar(i,j) *
423     . radswt(i,j,bi,bj) * pinv(i,j) * pinv(i,j) * 86400
424     enddo
425     enddo
426     call diagnostics_fill(tmpdiag,'VDTRADSW',0,1,3,bi,bj,myid)
427 molod 1.1 endif
428    
429 molod 1.8 #endif
430 molod 1.1 return
431     end

  ViewVC Help
Powered by ViewVC 1.1.22