/[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.10 by molod, Thu Aug 12 15:21:22 2004 UTC revision 1.19 by molod, Thu Mar 9 00:00:36 2006 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(myThid,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,
# Line 10  C $Name$ Line 10  C $Name$
10  C***********************************************************************  C***********************************************************************
11        implicit none        implicit none
12    
13  #ifdef ALLOW_DIAGNOSTICS        integer myid,im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer
 #include "SIZE.h"  
 #include "diagnostics_SIZE.h"  
 #include "diagnostics.h"  
 #endif  
   
       integer myThid,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),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)
22        _RL swgclr(im2,jm2,Nbi,Nbj),osr(im2,jm2,Nbi,Nbj)        _RL swgclr(im2,jm2,Nbi,Nbj),osr(im2,jm2,Nbi,Nbj)
# Line 45  C*************************************** Line 39  C***************************************
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 pinv(im2,jm2), qbar(im2,jm2)        _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 **********************************************************************          C **********************************************************************        
50    
# Line 56  C ************************************** Line 55  C **************************************
55        enddo        enddo
56        enddo        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)  c Incident Solar Radiation (W/m**2)
65  c ---------------------------------  c ---------------------------------
66        if (iradswt.ne.0) then        if(diagnostics_is_on('RADSWT  ',myid) ) then
67        do j=jm1,jm2         call diagnostics_fill(radswt,'RADSWT  ',0,1,3,bi,bj,myid)
       do i=im1,im2  
       qdiag(i,j,iradswt,bi,bj)= qdiag(i,j,iradswt,bi,bj) +  
      .                                                 radswt(i,j,bi,bj)  
       enddo  
       enddo  
68        endif        endif
69                                                                                    
70  c Net Solar Radiation at the Ground (W/m**2)  c Net Solar Radiation at the Ground (W/m**2)
71  c ------------------------------------------  c ------------------------------------------
72        if (iradswg.ne.0) then        if(diagnostics_is_on('RADSWG  ',myid) ) then
73        do j=jm1,jm2         do j=jm1,jm2
74        do i=im1,im2         do i=im1,im2
75        qdiag(i,j,iradswg,bi,bj) = qdiag(i,j,iradswg,bi,bj) +          tmpdiag(i,j) = radswg(i,j,bi,bj)*radswt(i,j,bi,bj)
76       .                               radswg(i,j,bi,bj)*radswt(i,j,bi,bj)         enddo
77        enddo         enddo
78        enddo         call diagnostics_fill(tmpdiag,'RADSWG  ',0,1,3,bi,bj,myid)
79        endif        endif
80                                                                                                                                                                    
81  c Net Clear Sky Solar Radiation at the Ground (W/m**2)  c Net Clear Sky Solar Radiation at the Ground (W/m**2)
82  c ----------------------------------------------------  c ----------------------------------------------------
83        if (iswgclr.ne.0) then        if(diagnostics_is_on('SWGCLR  ',myid) ) then
84        do j=jm1,jm2         do j=jm1,jm2
85        do i=im1,im2         do i=im1,im2
86        qdiag(i,j,iswgclr,bi,bj) = qdiag(i,j,iswgclr,bi,bj) +          tmpdiag(i,j) = swgclr(i,j,bi,bj)*radswt(i,j,bi,bj)
87       .                               swgclr(i,j,bi,bj)*radswt(i,j,bi,bj)         enddo
88        enddo         enddo
89        enddo         call diagnostics_fill(tmpdiag,'SWGCLR  ',0,1,3,bi,bj,myid)
90        endif        endif
91                                                                                                                                                                    
92  c Outgoing Solar Radiation at top (W/m**2)  c Outgoing Solar Radiation at top (W/m**2)
93  c -----------------------------------------  c -----------------------------------------
94        if (iosr.ne.0) then        if(diagnostics_is_on('OSR     ',myid) ) then
95        do j=jm1,jm2         do j=jm1,jm2
96        do i=im1,im2         do i=im1,im2
97        qdiag(i,j,iosr,bi,bj) = qdiag(i,j,iosr,bi,bj) +          tmpdiag(i,j) = (1.0-osr(i,j,bi,bj))*radswt(i,j,bi,bj)
98       .                            (1.0-osr(i,j,bi,bj))*radswt(i,j,bi,bj)         enddo
99        enddo         enddo
100        enddo         call diagnostics_fill(tmpdiag,'OSR     ',0,1,3,bi,bj,myid)
101        endif        endif
102                                                                                                                                                                    
103  c Outgoing Clear Sky Solar Radiation at top (W/m**2)  c Outgoing Clear Sky Solar Radiation at top (W/m**2)
104  c ---------------------------------------------------  c ---------------------------------------------------
105        if (iosrclr.ne.0) then        if(diagnostics_is_on('OSRCLR  ',myid) ) then
106        do j=jm1,jm2         do j=jm1,jm2
107        do i=im1,im2         do i=im1,im2
108        qdiag(i,j,iosrclr,bi,bj) = qdiag(i,j,iosrclr,bi,bj) +          tmpdiag(i,j) = (1.0-osrclr(i,j,bi,bj))*radswt(i,j,bi,bj)
109       .                         (1.0-osrclr(i,j,bi,bj))*radswt(i,j,bi,bj)                 enddo
110        enddo         enddo
111        enddo         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        endif
128                                                                                                                                                                    
129  c Upward Longwave Flux at the Ground (W/m**2)  c Upward Longwave Flux at the Ground (W/m**2)
130  c -------------------------------------------  c -------------------------------------------
131        if (ilwgup.ne.0) then        if(diagnostics_is_on('LWGUP   ',myid) ) then
132        do j=jm1,jm2         do j=jm1,jm2
133        do i=im1,im2         do i=im1,im2
134        qdiag(i,j,ilwgup,bi,bj) = qdiag(i,j,ilwgup,bi,bj) + st4(i,j,bi,bj)          tmpdiag(i,j) = st4(i,j,bi,bj)
135       .                 + 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))
136        enddo         enddo
137        enddo         enddo
138           call diagnostics_fill(tmpdiag,'LWGUP   ',0,1,3,bi,bj,myid)
139        endif        endif
140                                                                                                                                                                    
141  c Net Longwave Flux at the Ground (W/m**2)  c Net Longwave Flux at the Ground (W/m**2)
142  c ----------------------------------------  c ----------------------------------------
143        if (iradlwg.ne.0) then        if(diagnostics_is_on('RADLWG  ',myid) ) then
144        do j=jm1,jm2         do j=jm1,jm2
145        do i=im1,im2         do i=im1,im2
146        qdiag(i,j,iradlwg,bi,bj) =  qdiag(i,j,iradlwg,bi,bj) +          tmpdiag(i,j) = radlwg(i,j,bi,bj) +
      .                                              radlwg(i,j,bi,bj) +  
147       .                  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))
148        enddo         enddo
149        enddo         enddo
150           call diagnostics_fill(tmpdiag,'RADLWG  ',0,1,3,bi,bj,myid)
151        endif        endif
152                                                                                                                                                                    
153  c Net Longwave Flux at the Ground Clear Sky (W/m**2)  c Net Longwave Flux at the Ground Clear Sky (W/m**2)
154  c --------------------------------------------------  c --------------------------------------------------
155        if (ilwgclr.ne.0) then        if(diagnostics_is_on('LWGCLR  ',myid) ) then
156        do j=jm1,jm2         do j=jm1,jm2
157        do i=im1,im2         do i=im1,im2
158        qdiag(i,j,ilwgclr,bi,bj) = qdiag(i,j,ilwgclr,bi,bj) +          tmpdiag(i,j) = lwgclr(i,j,bi,bj) +
159       .                                               lwgclr(i,j,bi,bj) +       .                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
160       .                   dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))         enddo
161        enddo         enddo
162        enddo         call diagnostics_fill(tmpdiag,'LWGCLR  ',0,1,3,bi,bj,myid)
       endif  
                                                                                   
       if( (bi.eq.1) .and. (bj.eq.1) ) then  
       nradswt = nradswt + 1  
       nradswg = nradswg + 1  
       nswgclr = nswgclr + 1  
       nosr    = nosr    + 1  
       nosrclr = nosrclr + 1  
       nradlwg = nradlwg + 1  
       nlwgclr = nlwgclr + 1  
       nlwgup  = nlwgup  + 1  
163        endif        endif
164                                                                                                                                                                    
165  C **********************************************************************          C **********************************************************************        
# Line 162  C ************************************** Line 167  C **************************************
167    
168  c Total Diabatic U-Tendency (m/sec/day)  c Total Diabatic U-Tendency (m/sec/day)
169  c -------------------------------------  c -------------------------------------
170        if( idiabu.ne.0 ) then        if(diagnostics_is_on('DIABU   ',myid) ) then
171        do j=jm1,jm2         do j=jm1,jm2
172        do i=im1,im2         do i=im1,im2
173        qdiag(i,j,idiabu+L-1,bi,bj) = qdiag(i,j,idiabu+L-1,bi,bj)          tmpdiag(i,j) = (moistu (i,j,L,bi,bj)+turbu(i,j,L,bi,bj) )*86400
174       .            + ( moistu (i,j,L,bi,bj) + turbu(i,j,L,bi,bj) )*86400         enddo
175        enddo         enddo
176        enddo         call diagnostics_fill(tmpdiag,'DIABU   ',L,1,3,bi,bj,myid)
177        endif        endif
178                                                                      
179  c Total Diabatic V-Tendency (m/sec/day)  c Total Diabatic V-Tendency (m/sec/day)
180  c -------------------------------------  c -------------------------------------
181        if( idiabv.ne.0 ) then        if(diagnostics_is_on('DIABV   ',myid) ) then
182        do j=jm1,jm2         do j=jm1,jm2
183        do i=im1,im2         do i=im1,im2
184        qdiag(i,j,idiabv+L-1,bi,bj) = qdiag(i,j,idiabv+L-1,bi,bj)          tmpdiag(i,j) = (moistv (i,j,L,bi,bj)+turbv(i,j,L,bi,bj) )*86400
185       .            + ( moistv (i,j,L,bi,bj) + turbv(i,j,L,bi,bj) )*86400         enddo
186        enddo         enddo
187        enddo         call diagnostics_fill(tmpdiag,'DIABV   ',L,1,3,bi,bj,myid)
188        endif        endif
189    
190  c Total Diabatic T-Tendency (deg/day)  c Total Diabatic T-Tendency (deg/day)
191  c -----------------------------------  c -----------------------------------
192        if( idiabt.ne.0 ) then        if(diagnostics_is_on('DIABT   ',myid) ) then
193        do j=jm1,jm2         do j=jm1,jm2
194        do i=im1,im2         do i=im1,im2
195        qdiag(i,j,idiabt+L-1,bi,bj) = qdiag(i,j,idiabt+L-1,bi,bj) +          tmpdiag(i,j) =
196       .   ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +       .   ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +
197       .      lwdt(i,j,L,bi,bj) +       .      lwdt(i,j,L,bi,bj) +
198       .      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)) +
199       .      swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )       .      swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )
200       .      * pk(i,j,L,bi,bj)*pinv(i,j)*86400       .      * pk(i,j,L,bi,bj)*pinv(i,j)*86400
201        enddo         enddo
202        enddo         enddo
203           call diagnostics_fill(tmpdiag,'DIABT   ',L,1,3,bi,bj,myid)
204        endif        endif
205                                                                      
206  c Total Diabatic Q-Tendency (g/kg/day)  c Total Diabatic Q-Tendency (g/kg/day)
207  c ------------------------------------  c ------------------------------------
208        if( idiabq.ne.0 ) then        if(diagnostics_is_on('DIABQ   ',myid) ) then
209        do j=jm1,jm2         do j=jm1,jm2
210        do i=im1,im2         do i=im1,im2
211        qdiag(i,j,idiabq+L-1,bi,bj) =   qdiag(i,j,idiabq+L-1,bi,bj) +          tmpdiag(i,j) =
212       . ( 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) ) *
213       .                                      pinv(i,j)*86400*1000       .                                      pinv(i,j)*86400*1000
214        enddo         enddo
215        enddo         enddo
216           call diagnostics_fill(tmpdiag,'DIABQ   ',L,1,3,bi,bj,myid)
217        endif        endif
218            
219  c Longwave Heating (deg/day)  c Longwave Heating (deg/day)
220  c --------------------------  c --------------------------
221        if (iradlw.ne.0) then        if(diagnostics_is_on('RADLW   ',myid) ) then
222        do j=jm1,jm2         do j=jm1,jm2
223        do i=im1,im2         do i=im1,im2
224        qdiag(i,j,iradlw+l-1,bi,bj) = qdiag(i,j,iradlw+l-1,bi,bj) +          tmpdiag(i,j) =
225       . ( lwdt(i,j,l,bi,bj) +       . ( lwdt(i,j,l,bi,bj) +
226       .            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)) )
227       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400
228        enddo         enddo
229        enddo         enddo
230        endif         call diagnostics_fill(tmpdiag,'RADLW   ',L,1,3,bi,bj,myid)
       if (iudiag2.ne.0) then  
       do j=jm1,jm2  
       do i=im1,im2  
       qdiag(i,j,iudiag2+l-1,bi,bj) = qdiag(i,j,iudiag2+l-1,bi,bj) +  
      . lwdt(i,j,l,bi,bj) * pk(i,j,l,bi,bj)*pinv(i,j)*86400  
       enddo  
       enddo  
231        endif        endif
232        if (iudiag3.ne.0) then  
       do j=jm1,jm2  
       do i=im1,im2  
       qdiag(i,j,iudiag3+l-1,bi,bj) = qdiag(i,j,iudiag3+l-1,bi,bj) +  
      . dlwdtg (i,j,L,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))  
      .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400  
       enddo  
       enddo  
       endif  
                                                                                   
233  c Longwave Heating Clear-Sky (deg/day)  c Longwave Heating Clear-Sky (deg/day)
234  c ------------------------------------  c ------------------------------------
235        if (ilwclr.ne.0) then                                                            if(diagnostics_is_on('LWCLR   ',myid) ) then
236        do j=jm1,jm2         do j=jm1,jm2
237        do i=im1,im2         do i=im1,im2
238        qdiag(i,j,ilwclr+l-1,bi,bj) = qdiag(i,j,ilwclr+l-1,bi,bj) +          tmpdiag(i,j) =
239       . ( lwdtclr(i,j,l,bi,bj) +       . ( lwdtclr(i,j,l,bi,bj) +
240       .             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)) )
241       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400
242        enddo         enddo
243        enddo         enddo
244           call diagnostics_fill(tmpdiag,'LWCLR   ',L,1,3,bi,bj,myid)
245        endif        endif
246                                                                                                                                                                    
247  c Solar Radiative Heating (deg/day)  c Solar Radiative Heating (deg/day)
248  c ---------------------------------  c ---------------------------------
249        if (iradsw.ne.0) then        if(diagnostics_is_on('RADSW   ',myid) ) then
250        do j=jm1,jm2         do j=jm1,jm2
251        do i=im1,im2         do i=im1,im2
252        qdiag(i,j,iradsw+l-1,bi,bj) = qdiag(i,j,iradsw+l-1,bi,bj) +          tmpdiag(i,j) =
253       .  + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*       .  + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
254       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400
255        enddo         enddo
256        enddo         enddo
257           call diagnostics_fill(tmpdiag,'RADSW   ',L,1,3,bi,bj,myid)
258        endif        endif
259                                                                                                                                                                    
260  c Clear Sky Solar Radiative Heating (deg/day)  c Clear Sky Solar Radiative Heating (deg/day)
261  c -------------------------------------------  c -------------------------------------------
262        if (iswclr.ne.0) then        if(diagnostics_is_on('SWCLR   ',myid) ) then
263        do j=jm1,jm2         do j=jm1,jm2
264        do i=im1,im2         do i=im1,im2
265        qdiag(i,j,iswclr+l-1,bi,bj) = qdiag(i,j,iswclr+l-1,bi,bj) +          tmpdiag(i,j) =
266       .           swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*       .  + swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
267       .                           pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400
268        enddo         enddo
269        enddo         enddo
270           call diagnostics_fill(tmpdiag,'SWCLR   ',L,1,3,bi,bj,myid)
271        endif        endif
272                                                                                                                                                                    
273  c Averaged U-Field (m/sec)  c Averaged U-Field (m/sec)
274  c ------------------------  c ------------------------
275        if( iuwnd.ne.0 ) then        if(diagnostics_is_on('UWND    ',myid) ) then
276        do j=jm1,jm2         do j=jm1,jm2
277        do i=im1,im2         do i=im1,im2
278        qdiag(i,j,iuwnd+L-1,bi,bj) = qdiag(i,j,iuwnd+L-1,bi,bj) +          tmpdiag(i,j) = uphy(i,j,L)
279       .                                                 uphy(i,j,L,bi,bj)         enddo
280        enddo         enddo
281        enddo         call diagnostics_fill(tmpdiag,'UWND    ',L,1,3,bi,bj,myid)
282        endif        endif
283    
284  c Averaged V-Field (m/sec)  c Averaged V-Field (m/sec)
285  c ------------------------  c ------------------------
286        if( ivwnd.ne.0 ) then        if(diagnostics_is_on('VWND    ',myid) ) then
287        do j=jm1,jm2         do j=jm1,jm2
288        do i=im1,im2         do i=im1,im2
289        qdiag(i,j,ivwnd+L-1,bi,bj) = qdiag(i,j,ivwnd+L-1,bi,bj) +          tmpdiag(i,j) = vphy(i,j,L)
290       .                                                 vphy(i,j,L,bi,bj)         enddo
291        enddo         enddo
292        enddo         call diagnostics_fill(tmpdiag,'VWND    ',L,1,3,bi,bj,myid)
293        endif        endif
294    
295  c Averaged T-Field (deg)  c Averaged T-Field (deg)
296  c ----------------------  c ----------------------
297        if( itmpu.ne.0 ) then        if(diagnostics_is_on('TMPU    ',myid) ) then
298        do j=jm1,jm2         do j=jm1,jm2
299        do i=im1,im2         do i=im1,im2
300        qdiag(i,j,itmpu+L-1,bi,bj) = qdiag(i,j,itmpu+L-1,bi,bj) +          tmpdiag(i,j) = thphy(i,j,L)*pk(i,j,L,bi,bj)
301       .                               thphy(i,j,L,bi,bj)*pk(i,j,L,bi,bj)         enddo
302        enddo         enddo
303        enddo         call diagnostics_fill(tmpdiag,'TMPU    ',L,1,3,bi,bj,myid)
304        endif        endif
305                                                                                                                                                                    
306  c Averaged QQ-Field (m/sec)**2  c Averaged QQ-Field (m/sec)**2
307  c ----------------------------  c ----------------------------
308        if( itke.ne.0 ) then        if(diagnostics_is_on('TKE     ',myid) ) then
309        do j=jm1,jm2         do j=jm1,jm2
310        do i=im1,im2         do i=im1,im2
311        qdiag(i,j,itke+L-1,bi,bj) = qdiag(i,j,itke+L-1,bi,bj) + qq(i,j,L)          tmpdiag(i,j) = qq(i,j,L,bi,bj)
312        enddo         enddo
313        enddo         enddo
314           call diagnostics_fill(tmpdiag,'TKE     ',L,1,3,bi,bj,myid)
315        endif        endif
316                                                                                                                                                                    
317  c Averaged Q-Field (g/kg)  c Averaged Q-Field (g/kg)
318  c -----------------------  c -----------------------
319        if( isphu.ne.0 ) then        if(diagnostics_is_on('SPHU    ',myid) ) then
320        do j=jm1,jm2         do j=jm1,jm2
321        do i=im1,im2         do i=im1,im2
322        qdiag(i,j,isphu+L-1,bi,bj) = qdiag(i,j,isphu+L-1,bi,bj) +          tmpdiag(i,j) = sphy(i,j,L) * 1000.
323       .                                            sphy(i,j,L,bi,bj)*1000         enddo
324        enddo         enddo
325        enddo         call diagnostics_fill(tmpdiag,'SPHU    ',L,1,3,bi,bj,myid)
326        endif        endif
327                                                                                                                                                                    
328        enddo        enddo
329    
       if( (bi.eq.1) .and. (bj.eq.1) ) then  
       ndiabu = ndiabu + 1  
       ndiabv = ndiabv + 1  
       ndiabt = ndiabt + 1  
       ndiabq = ndiabq + 1  
       nradlw = nradlw + 1                                                      
       nlwclr = nlwclr + 1                                                      
       nradsw = nradsw + 1                                                      
       nswclr = nswclr + 1                                                      
       nuwnd  = nuwnd  + 1  
       nvwnd  = nvwnd  + 1                            
       ntmpu  = ntmpu  + 1                            
       ntke   = ntke   + 1  
       nsphu  = nsphu  + 1  
   
       nudiag3 = nudiag3 + 1  
       nudiag2 = nudiag2 + 1  
       endif  
   
330  C **********************************************************************          C **********************************************************************        
331    
332  c Vertically Averaged Moist-T Increment (K/day)  c Vertically Averaged Moist-T Increment (K/day)
333  c ---------------------------------------------  c ---------------------------------------------
334        if( ivdtmoist.ne.0 ) then        if(diagnostics_is_on('VDTMOIST',myid) ) then
335        do j=jm1,jm2         do j=jm1,jm2
336        do i=im1,im2         do i=im1,im2
337        qbar(i,j) = 0.0         qbar(i,j) = 0.0
338        enddo         enddo
339        enddo         enddo
340        do L=1,Nrphys         do L=1,Nrphys
341        do j=jm1,jm2         do j=jm1,jm2
342        do i=im1,im2         do i=im1,im2
343        qbar(i,j) = qbar(i,j) +         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)       .             moistt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
345        enddo         enddo
346        enddo         enddo
347        enddo         enddo
348        do j=jm1,jm2         do j=jm1,jm2
349        do i=im1,im2         do i=im1,im2
350        qdiag(i,j,ivdtmoist,bi,bj) = qdiag(i,j,ivdtmoist,bi,bj) +         tmpdiag(i,j) = qbar(i,j)*pinv(i,j)*pinv(i,j)*86400
351       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
352        enddo         enddo
353        enddo         call diagnostics_fill(tmpdiag,'VDTMOIST',0,1,3,bi,bj,myid)
354        endif        endif
355    
356  c Vertically Averaged Turb-T Increment (K/day)  c Vertically Averaged Turb-T Increment (K/day)
357  c --------------------------------------------  c --------------------------------------------
358        if( ivdtturb.ne.0 ) then        if(diagnostics_is_on('VDTTURB ',myid) ) then
359        do j=jm1,jm2         do j=jm1,jm2
360        do i=im1,im2         do i=im1,im2
361        qbar(i,j) = 0.0         qbar(i,j) = 0.0
362        enddo         enddo
363        enddo         enddo
364        do L=1,Nrphys         do L=1,Nrphys
365        do j=jm1,jm2         do j=jm1,jm2
366        do i=im1,im2         do i=im1,im2
367        qbar(i,j) = qbar(i,j) +         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)       .             turbt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
369        enddo         enddo
370        enddo         enddo
371        enddo         enddo
372        do j=jm1,jm2         do j=jm1,jm2
373        do i=im1,im2         do i=im1,im2
374        qdiag(i,j,ivdtturb,bi,bj) = qdiag(i,j,ivdtturb,bi,bj) +         tmpdiag(i,j) = qbar(i,j)*pinv(i,j)*pinv(i,j)*86400
375       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
376        enddo         enddo
377        enddo         call diagnostics_fill(tmpdiag,'VDTTURB ',0,1,3,bi,bj,myid)
378        endif        endif
379    
380  c Vertically Averaged RADLW Temperature Increment (K/day)  c Vertically Averaged RADLW Temperature Increment (K/day)
381  c -------------------------------------------------------  c -------------------------------------------------------
382        if( ivdtradlw.ne.0 ) then        if(diagnostics_is_on('VDTRADLW',myid) ) then
383        do j=jm1,jm2         do j=jm1,jm2
384        do i=im1,im2         do i=im1,im2
385        qbar(i,j) = 0.0         qbar(i,j) = 0.0
386        enddo         enddo
387        enddo         enddo
388        do L=1,Nrphys         do L=1,Nrphys
389        do j=jm1,jm2         do j=jm1,jm2
390        do i=im1,im2         do i=im1,im2
391        qbar(i,j) = qbar(i,j) + ( lwdt(i,j,L,bi,bj) +          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)) )       .  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)       .             *pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
394        enddo         enddo
395        enddo         enddo
396        enddo         enddo
397        do j=jm1,jm2         do j=jm1,jm2
398        do i=im1,im2         do i=im1,im2
399        qdiag(i,j,ivdtradlw,bi,bj) = qdiag(i,j,ivdtradlw,bi,bj) +         tmpdiag(i,j) = qbar(i,j)*pinv(i,j)*pinv(i,j)*86400
400       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
401        enddo         enddo
402        enddo         call diagnostics_fill(tmpdiag,'VDTRADLW',0,1,3,bi,bj,myid)
403        endif        endif
404    
405  c Vertically Averaged RADSW Temperature Increment (K/day)  c Vertically Averaged RADSW Temperature Increment (K/day)
406  c -------------------------------------------------------  c -------------------------------------------------------
407        if( ivdtradsw.ne.0 ) then        if(diagnostics_is_on('VDTRADSW',myid) ) then
408        do j=jm1,jm2         do j=jm1,jm2
409        do i=im1,im2         do i=im1,im2
410        qbar(i,j) = 0.0         qbar(i,j) = 0.0
411        enddo         enddo
412        enddo         enddo
413        do L=1,Nrphys         do L=1,Nrphys
414        do j=jm1,jm2         do j=jm1,jm2
415        do i=im1,im2         do i=im1,im2
416        qbar(i,j) = qbar(i,j) +          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)       .             swdt(i,j,L,bi,bj)*pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
418        enddo         enddo
419        enddo         enddo
420        enddo         enddo
421        do j=jm1,jm2         do j=jm1,jm2
422        do i=im1,im2         do i=im1,im2
423        qdiag(i,j,ivdtradsw,bi,bj) = qdiag(i,j,ivdtradsw,bi,bj) +         tmpdiag(i,j) = qbar(i,j) *
424       . qbar(i,j)*radswt(i,j,bi,bj)*pinv(i,j)*pinv(i,j)*86400       .             radswt(i,j,bi,bj) * pinv(i,j) * pinv(i,j) * 86400
425        enddo         enddo
426        enddo         enddo
427           call diagnostics_fill(tmpdiag,'VDTRADSW',0,1,3,bi,bj,myid)
428        endif        endif
429    
430        if( (bi.eq.1) .and. (bj.eq.1) ) then  c Total Precipitable Water (g/cm^2)
431        nvdtmoist = nvdtmoist + 1  c ---------------------------------------------
432        nvdtturb  = nvdtturb  + 1        if(diagnostics_is_on('TPW     ',myid) ) then
433        nvdtradlw = nvdtradlw + 1         gravity = getcon('GRAVITY')
434        nvdtradsw = nvdtradsw + 1         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        endif
   
454  #endif  #endif
455        return        return
456        end        end
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22