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

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

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

revision 1.17 by molod, Fri Jun 17 01:04:24 2005 UTC revision 1.20 by jmc, Tue Mar 20 19:50:45 2012 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "FIZHI_OPTIONS.h"  #include "FIZHI_OPTIONS.h"
5        subroutine fizhi_step_diag(myid,p,uphy,vphy,thphy,sphy,qq,pk,dp,        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,       &  radswt,radswg,swgclr,osr,osrclr,st4,dst4,tgz,tg0,radlwg,lwgclr,
7       .  turbu,turbv,turbt,turbq,moistu,moistv,moistt,moistq,       &  turbu,turbv,turbt,turbq,moistu,moistv,moistt,moistq,
8       .  lwdt,swdt,lwdtclr,swdtclr,dlwdtg,       &  lwdt,swdt,lwdtclr,swdtclr,dlwdtg,
9       .  im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer)       &  im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer)
10  C***********************************************************************  C***********************************************************************
11        implicit none        IMPLICIT NONE
12    
13        integer myid,im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer        INTEGER myid,im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer
14        _RL p(im2,jm2,Nbi,Nbj)        _RL p(im2,jm2,Nbi,Nbj)
15        _RL uphy(im2,jm2,Nrphys,Nbi,Nbj)        _RL uphy(im2,jm2,Nrphys)
16        _RL vphy(im2,jm2,Nrphys,Nbi,Nbj)        _RL vphy(im2,jm2,Nrphys)
17        _RL thphy(im2,jm2,Nrphys,Nbi,Nbj)        _RL thphy(im2,jm2,Nrphys)
18        _RL sphy(im2,jm2,Nrphys,Nbi,Nbj)        _RL sphy(im2,jm2,Nrphys)
19        _RL qq(im2,jm2,Nrphys,Nbi,Nbj),pk(im2,jm2,Nrphys,Nbi,Nbj)        _RL qq(im2,jm2,Nrphys,Nbi,Nbj),pk(im2,jm2,Nrphys,Nbi,Nbj)
20        _RL dp(im2,jm2,Nrphys,Nbi,Nbj)        _RL dp(im2,jm2,Nrphys,Nbi,Nbj)
21        _RL radswt(im2,jm2,Nbi,Nbj),radswg(im2,jm2,Nbi,Nbj)        _RL radswt(im2,jm2,Nbi,Nbj),radswg(im2,jm2,Nbi,Nbj)
# Line 38  C*************************************** Line 38  C***************************************
38        _RL swdtclr(im2,jm2,Nrphys,Nbi,Nbj)        _RL swdtclr(im2,jm2,Nrphys,Nbi,Nbj)
39        _RL dlwdtg(im2,jm2,Nrphys,Nbi,Nbj)        _RL dlwdtg(im2,jm2,Nrphys,Nbi,Nbj)
40    
41        integer  i,j,L        INTEGER  i,j,L
42          _RL getcon, gravity
43        _RL pinv(im2,jm2), qbar(im2,jm2),tmpdiag(im2,jm2)        _RL pinv(im2,jm2), qbar(im2,jm2),tmpdiag(im2,jm2)
44  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
45        logical  diagnostics_is_on        LOGICAL  diagnostics_is_on
46        external diagnostics_is_on        EXTERNAL diagnostics_is_on
47  #endif  #endif
48    
49  C **********************************************************************          C **********************************************************************
50    
51  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
52        do j=jm1,jm2        do j=jm1,jm2
# Line 56  C ************************************** Line 57  C **************************************
57    
58  c Surface Pressure (mb)  c Surface Pressure (mb)
59  c ---------------------------------  c ---------------------------------
60        if(diagnostics_is_on('PS      ',myid) ) then        call diagnostics_fill(p(1,1,bi,bj),'PS      ',0,1,3,bi,bj,myid)
        call diagnostics_fill(p(1,1,bi,bj),'PS      ',0,1,3,bi,bj,myid)  
       endif  
61    
62  c Incident Solar Radiation (W/m**2)  c Incident Solar Radiation (W/m**2)
63  c ---------------------------------  c ---------------------------------
64        if(diagnostics_is_on('RADSWT  ',myid) ) then        call diagnostics_fill(radswt(1,1,bi,bj),'RADSWT  ',
65         call diagnostics_fill(radswt,'RADSWT  ',0,1,3,bi,bj,myid)       &                      0,1,3,bi,bj,myid)
       endif  
66    
67  c Net Solar Radiation at the Ground (W/m**2)  c Net Solar Radiation at the Ground (W/m**2)
68  c ------------------------------------------  c ------------------------------------------
# Line 76  c -------------------------------------- Line 74  c --------------------------------------
74         enddo         enddo
75         call diagnostics_fill(tmpdiag,'RADSWG  ',0,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'RADSWG  ',0,1,3,bi,bj,myid)
76        endif        endif
77                                                                                    
78  c Net Clear Sky Solar Radiation at the Ground (W/m**2)  c Net Clear Sky Solar Radiation at the Ground (W/m**2)
79  c ----------------------------------------------------  c ----------------------------------------------------
80        if(diagnostics_is_on('SWGCLR  ',myid) ) then        if(diagnostics_is_on('SWGCLR  ',myid) ) then
# Line 87  c -------------------------------------- Line 85  c --------------------------------------
85         enddo         enddo
86         call diagnostics_fill(tmpdiag,'SWGCLR  ',0,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'SWGCLR  ',0,1,3,bi,bj,myid)
87        endif        endif
88                                                                                    
89  c Outgoing Solar Radiation at top (W/m**2)  c Outgoing Solar Radiation at top (W/m**2)
90  c -----------------------------------------  c -----------------------------------------
91        if(diagnostics_is_on('OSR     ',myid) ) then        if(diagnostics_is_on('OSR     ',myid) ) then
# Line 98  c -------------------------------------- Line 96  c --------------------------------------
96         enddo         enddo
97         call diagnostics_fill(tmpdiag,'OSR     ',0,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'OSR     ',0,1,3,bi,bj,myid)
98        endif        endif
99                                                                                    
100  c Outgoing Clear Sky Solar Radiation at top (W/m**2)  c Outgoing Clear Sky Solar Radiation at top (W/m**2)
101  c ---------------------------------------------------  c ---------------------------------------------------
102        if(diagnostics_is_on('OSRCLR  ',myid) ) then        if(diagnostics_is_on('OSRCLR  ',myid) ) then
# Line 109  c -------------------------------------- Line 107  c --------------------------------------
107         enddo         enddo
108         call diagnostics_fill(tmpdiag,'OSRCLR  ',0,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'OSRCLR  ',0,1,3,bi,bj,myid)
109        endif        endif
110                                                                                    
111  c Planetary Albedo  c Planetary Albedo
112  c ----------------  c ----------------
113        if(diagnostics_is_on('PLALBEDO',myid) ) then        if(diagnostics_is_on('PLALBEDO',myid) ) then
# Line 124  c ---------------- Line 122  c ----------------
122         enddo         enddo
123         call diagnostics_fill(tmpdiag,'PLALBEDO',0,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'PLALBEDO',0,1,3,bi,bj,myid)
124        endif        endif
125                                                                                    
126  c Upward Longwave Flux at the Ground (W/m**2)  c Upward Longwave Flux at the Ground (W/m**2)
127  c -------------------------------------------  c -------------------------------------------
128        if(diagnostics_is_on('LWGUP   ',myid) ) then        if(diagnostics_is_on('LWGUP   ',myid) ) then
129         do j=jm1,jm2         do j=jm1,jm2
130         do i=im1,im2         do i=im1,im2
131          tmpdiag(i,j) = st4(i,j,bi,bj)          tmpdiag(i,j) = st4(i,j,bi,bj)
132       .                 + dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))       &                 + dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
133         enddo         enddo
134         enddo         enddo
135         call diagnostics_fill(tmpdiag,'LWGUP   ',0,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'LWGUP   ',0,1,3,bi,bj,myid)
136        endif        endif
137                                                                                    
138  c Net Longwave Flux at the Ground (W/m**2)  c Net Longwave Flux at the Ground (W/m**2)
139  c ----------------------------------------  c ----------------------------------------
140        if(diagnostics_is_on('RADLWG  ',myid) ) then        if(diagnostics_is_on('RADLWG  ',myid) ) then
141         do j=jm1,jm2         do j=jm1,jm2
142         do i=im1,im2         do i=im1,im2
143          tmpdiag(i,j) = radlwg(i,j,bi,bj) +          tmpdiag(i,j) = radlwg(i,j,bi,bj) +
144       .                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))       &                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
145         enddo         enddo
146         enddo         enddo
147         call diagnostics_fill(tmpdiag,'RADLWG  ',0,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'RADLWG  ',0,1,3,bi,bj,myid)
148        endif        endif
149                                                                                    
150  c Net Longwave Flux at the Ground Clear Sky (W/m**2)  c Net Longwave Flux at the Ground Clear Sky (W/m**2)
151  c --------------------------------------------------  c --------------------------------------------------
152        if(diagnostics_is_on('LWGCLR  ',myid) ) then        if(diagnostics_is_on('LWGCLR  ',myid) ) then
153         do j=jm1,jm2         do j=jm1,jm2
154         do i=im1,im2         do i=im1,im2
155          tmpdiag(i,j) = lwgclr(i,j,bi,bj) +          tmpdiag(i,j) = lwgclr(i,j,bi,bj) +
156       .                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))       &                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
157         enddo         enddo
158         enddo         enddo
159         call diagnostics_fill(tmpdiag,'LWGCLR  ',0,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'LWGCLR  ',0,1,3,bi,bj,myid)
160        endif        endif
161                                                                                    
162  C **********************************************************************          C **********************************************************************
163        do L=1,Nrphys        do L=1,Nrphys
164    
165  c Total Diabatic U-Tendency (m/sec/day)  c Total Diabatic U-Tendency (m/sec/day)
# Line 191  c ----------------------------------- Line 189  c -----------------------------------
189        if(diagnostics_is_on('DIABT   ',myid) ) then        if(diagnostics_is_on('DIABT   ',myid) ) then
190         do j=jm1,jm2         do j=jm1,jm2
191         do i=im1,im2         do i=im1,im2
192          tmpdiag(i,j) =          tmpdiag(i,j) =
193       .   ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +       &   ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +
194       .      lwdt(i,j,L,bi,bj) +       &      lwdt(i,j,L,bi,bj) +
195       .      dlwdtg(i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) +       &      dlwdtg(i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) +
196       .      swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )       &      swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )
197       .      * pk(i,j,L,bi,bj)*pinv(i,j)*86400       &      * pk(i,j,L,bi,bj)*pinv(i,j)*86400
198         enddo         enddo
199         enddo         enddo
200         call diagnostics_fill(tmpdiag,'DIABT   ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'DIABT   ',L,1,3,bi,bj,myid)
# Line 207  c ------------------------------------ Line 205  c ------------------------------------
205        if(diagnostics_is_on('DIABQ   ',myid) ) then        if(diagnostics_is_on('DIABQ   ',myid) ) then
206         do j=jm1,jm2         do j=jm1,jm2
207         do i=im1,im2         do i=im1,im2
208          tmpdiag(i,j) =          tmpdiag(i,j) =
209       . ( turbq(i,j,L,1,bi,bj) + moistq(i,j,L,1,bi,bj) ) *       & ( turbq(i,j,L,1,bi,bj) + moistq(i,j,L,1,bi,bj) ) *
210       .                                      pinv(i,j)*86400*1000       &                                      pinv(i,j)*86400*1000
211         enddo         enddo
212         enddo         enddo
213         call diagnostics_fill(tmpdiag,'DIABQ   ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'DIABQ   ',L,1,3,bi,bj,myid)
214        endif        endif
215        
216  c Longwave Heating (deg/day)  c Longwave Heating (deg/day)
217  c --------------------------  c --------------------------
218        if(diagnostics_is_on('RADLW   ',myid) ) then        if(diagnostics_is_on('RADLW   ',myid) ) then
219         do j=jm1,jm2         do j=jm1,jm2
220         do i=im1,im2         do i=im1,im2
221          tmpdiag(i,j) =          tmpdiag(i,j) =
222       . ( lwdt(i,j,l,bi,bj) +       & ( lwdt(i,j,l,bi,bj) +
223       .            dlwdtg (i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )       &            dlwdtg (i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )
224       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400       &                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400
225         enddo         enddo
226         enddo         enddo
227         call diagnostics_fill(tmpdiag,'RADLW   ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'RADLW   ',L,1,3,bi,bj,myid)
# Line 234  c ------------------------------------ Line 232  c ------------------------------------
232        if(diagnostics_is_on('LWCLR   ',myid) ) then        if(diagnostics_is_on('LWCLR   ',myid) ) then
233         do j=jm1,jm2         do j=jm1,jm2
234         do i=im1,im2         do i=im1,im2
235          tmpdiag(i,j) =          tmpdiag(i,j) =
236       . ( lwdtclr(i,j,l,bi,bj) +       & ( lwdtclr(i,j,l,bi,bj) +
237       .            dlwdtg (i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )       &            dlwdtg (i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )
238       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400       &                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400
239         enddo         enddo
240         enddo         enddo
241         call diagnostics_fill(tmpdiag,'LWCLR   ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'LWCLR   ',L,1,3,bi,bj,myid)
242        endif        endif
243                                                                                    
244  c Solar Radiative Heating (deg/day)  c Solar Radiative Heating (deg/day)
245  c ---------------------------------  c ---------------------------------
246        if(diagnostics_is_on('RADSW   ',myid) ) then        if(diagnostics_is_on('RADSW   ',myid) ) then
247         do j=jm1,jm2         do j=jm1,jm2
248         do i=im1,im2         do i=im1,im2
249          tmpdiag(i,j) =          tmpdiag(i,j) =
250       .  + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*       &  + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
251       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400       &                   pk(i,j,l,bi,bj)*pinv(i,j)*86400
252         enddo         enddo
253         enddo         enddo
254         call diagnostics_fill(tmpdiag,'RADSW   ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'RADSW   ',L,1,3,bi,bj,myid)
255        endif        endif
256                                                                                    
257  c Clear Sky Solar Radiative Heating (deg/day)  c Clear Sky Solar Radiative Heating (deg/day)
258  c -------------------------------------------  c -------------------------------------------
259        if(diagnostics_is_on('SWCLR   ',myid) ) then        if(diagnostics_is_on('SWCLR   ',myid) ) then
260         do j=jm1,jm2         do j=jm1,jm2
261         do i=im1,im2         do i=im1,im2
262          tmpdiag(i,j) =          tmpdiag(i,j) =
263       .  + swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*       &  + swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
264       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400       &                   pk(i,j,l,bi,bj)*pinv(i,j)*86400
265         enddo         enddo
266         enddo         enddo
267         call diagnostics_fill(tmpdiag,'SWCLR   ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'SWCLR   ',L,1,3,bi,bj,myid)
268        endif        endif
269                                                                                    
270  c Averaged U-Field (m/sec)  c Averaged U-Field (m/sec)
271  c ------------------------  c ------------------------
272        if(diagnostics_is_on('UWND    ',myid) ) then        if(diagnostics_is_on('UWND    ',myid) ) then
273         do j=jm1,jm2         do j=jm1,jm2
274         do i=im1,im2         do i=im1,im2
275          tmpdiag(i,j) = uphy(i,j,L,bi,bj)          tmpdiag(i,j) = uphy(i,j,L)
276         enddo         enddo
277         enddo         enddo
278         call diagnostics_fill(tmpdiag,'UWND    ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'UWND    ',L,1,3,bi,bj,myid)
# Line 285  c ------------------------ Line 283  c ------------------------
283        if(diagnostics_is_on('VWND    ',myid) ) then        if(diagnostics_is_on('VWND    ',myid) ) then
284         do j=jm1,jm2         do j=jm1,jm2
285         do i=im1,im2         do i=im1,im2
286          tmpdiag(i,j) = vphy(i,j,L,bi,bj)          tmpdiag(i,j) = vphy(i,j,L)
287         enddo         enddo
288         enddo         enddo
289         call diagnostics_fill(tmpdiag,'VWND    ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'VWND    ',L,1,3,bi,bj,myid)
# Line 296  c ---------------------- Line 294  c ----------------------
294        if(diagnostics_is_on('TMPU    ',myid) ) then        if(diagnostics_is_on('TMPU    ',myid) ) then
295         do j=jm1,jm2         do j=jm1,jm2
296         do i=im1,im2         do i=im1,im2
297          tmpdiag(i,j) = thphy(i,j,L,bi,bj)*pk(i,j,L,bi,bj)          tmpdiag(i,j) = thphy(i,j,L)*pk(i,j,L,bi,bj)
298         enddo         enddo
299         enddo         enddo
300         call diagnostics_fill(tmpdiag,'TMPU    ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'TMPU    ',L,1,3,bi,bj,myid)
301        endif        endif
302                                                                                    
303  c Averaged QQ-Field (m/sec)**2  c Averaged QQ-Field (m/sec)**2
304  c ----------------------------  c ----------------------------
305        if(diagnostics_is_on('TKE     ',myid) ) then        if(diagnostics_is_on('TKE     ',myid) ) then
# Line 312  c ---------------------------- Line 310  c ----------------------------
310         enddo         enddo
311         call diagnostics_fill(tmpdiag,'TKE     ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'TKE     ',L,1,3,bi,bj,myid)
312        endif        endif
313                                                                                    
314  c Averaged Q-Field (g/kg)  c Averaged Q-Field (g/kg)
315  c -----------------------  c -----------------------
316        if(diagnostics_is_on('SPHU    ',myid) ) then        if(diagnostics_is_on('SPHU    ',myid) ) then
317         do j=jm1,jm2         do j=jm1,jm2
318         do i=im1,im2         do i=im1,im2
319          tmpdiag(i,j) = sphy(i,j,L,bi,bj) * 1000.          tmpdiag(i,j) = sphy(i,j,L) * 1000.
320         enddo         enddo
321         enddo         enddo
322         call diagnostics_fill(tmpdiag,'SPHU    ',L,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'SPHU    ',L,1,3,bi,bj,myid)
323        endif        endif
324                                                                                    
325        enddo        enddo
326    
327  C **********************************************************************          C **********************************************************************
328    
329  c Vertically Averaged Moist-T Increment (K/day)  c Vertically Averaged Moist-T Increment (K/day)
330  c ---------------------------------------------  c ---------------------------------------------
# Line 339  c -------------------------------------- Line 337  c --------------------------------------
337         do L=1,Nrphys         do L=1,Nrphys
338         do j=jm1,jm2         do j=jm1,jm2
339         do i=im1,im2         do i=im1,im2
340         qbar(i,j) = qbar(i,j) +         qbar(i,j) = qbar(i,j) +
341       .             moistt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)       &             moistt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
342         enddo         enddo
343         enddo         enddo
344         enddo         enddo
# Line 363  c -------------------------------------- Line 361  c --------------------------------------
361         do L=1,Nrphys         do L=1,Nrphys
362         do j=jm1,jm2         do j=jm1,jm2
363         do i=im1,im2         do i=im1,im2
364         qbar(i,j) = qbar(i,j) +         qbar(i,j) = qbar(i,j) +
365       .             turbt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)       &             turbt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
366         enddo         enddo
367         enddo         enddo
368         enddo         enddo
# Line 388  c -------------------------------------- Line 386  c --------------------------------------
386         do j=jm1,jm2         do j=jm1,jm2
387         do i=im1,im2         do i=im1,im2
388          qbar(i,j) = qbar(i,j) + ( lwdt(i,j,L,bi,bj) +          qbar(i,j) = qbar(i,j) + ( lwdt(i,j,L,bi,bj) +
389       .  dlwdtg(i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )       &  dlwdtg(i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj)) )
390       .             *pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)       &             *pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
391         enddo         enddo
392         enddo         enddo
393         enddo         enddo
# Line 412  c -------------------------------------- Line 410  c --------------------------------------
410         do L=1,Nrphys         do L=1,Nrphys
411         do j=jm1,jm2         do j=jm1,jm2
412         do i=im1,im2         do i=im1,im2
413          qbar(i,j) = qbar(i,j) +          qbar(i,j) = qbar(i,j) +
414       .             swdt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)       &             swdt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
415         enddo         enddo
416         enddo         enddo
417         enddo         enddo
418         do j=jm1,jm2         do j=jm1,jm2
419         do i=im1,im2         do i=im1,im2
420         tmpdiag(i,j) = qbar(i,j) *         tmpdiag(i,j) = qbar(i,j) *
421       .             radswt(i,j,bi,bj) * pinv(i,j) * pinv(i,j) * 86400       &             radswt(i,j,bi,bj) * pinv(i,j) * pinv(i,j) * 86400
422         enddo         enddo
423         enddo         enddo
424         call diagnostics_fill(tmpdiag,'VDTRADSW',0,1,3,bi,bj,myid)         call diagnostics_fill(tmpdiag,'VDTRADSW',0,1,3,bi,bj,myid)
425        endif        endif
426    
427    c Total Precipitable Water (g/cm^2)
428    c ---------------------------------------------
429          if(diagnostics_is_on('TPW     ',myid) ) then
430           gravity = getcon('GRAVITY')
431           do j=jm1,jm2
432           do i=im1,im2
433           qbar(i,j) = 0.0
434           enddo
435           enddo
436           do L=1,Nrphys
437           do j=jm1,jm2
438           do i=im1,im2
439           qbar(i,j) = qbar(i,j) +
440         &             sphy(i,j,L)*dp(i,j,L,bi,bj)
441           enddo
442           enddo
443           enddo
444           do j=jm1,jm2
445           do i=im1,im2
446           tmpdiag(i,j) = qbar(i,j)*10. _d 0 /gravity
447           enddo
448           enddo
449           call diagnostics_fill(tmpdiag,'TPW     ',0,1,3,bi,bj,myid)
450          endif
451  #endif  #endif
452        return        return
453        end        end
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22