/[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.14 by jmc, Wed Mar 9 20:01:03 2005 UTC revision 1.15 by molod, Sat May 21 23:50:13 2005 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,Nbi,Nbj)
16        _RL vphy(im2,jm2,Nrphys,Nbi,Nbj)        _RL vphy(im2,jm2,Nrphys,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 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    
48  C **********************************************************************          C **********************************************************************        
49    
# Line 58  C ************************************** Line 56  C **************************************
56    
57  c Incident Solar Radiation (W/m**2)  c Incident Solar Radiation (W/m**2)
58  c ---------------------------------  c ---------------------------------
59        if (iradswt.ne.0) then        if(diagnostics_is_on('RADSWT  ',myid) ) then
60        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  
61        endif        endif
62                                                                                    
63  c Net Solar Radiation at the Ground (W/m**2)  c Net Solar Radiation at the Ground (W/m**2)
64  c ------------------------------------------  c ------------------------------------------
65        if (iradswg.ne.0) then        if(diagnostics_is_on('RADSWG  ',myid) ) then
66        do j=jm1,jm2         do j=jm1,jm2
67        do i=im1,im2         do i=im1,im2
68        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)
69       .                               radswg(i,j,bi,bj)*radswt(i,j,bi,bj)         enddo
70        enddo         enddo
71        enddo         call diagnostics_fill(tmpdiag,'RADSWG  ',0,1,3,bi,bj,myid)
72        endif        endif
73                                                                                                                                                                    
74  c Net Clear Sky Solar Radiation at the Ground (W/m**2)  c Net Clear Sky Solar Radiation at the Ground (W/m**2)
75  c ----------------------------------------------------  c ----------------------------------------------------
76        if (iswgclr.ne.0) then        if(diagnostics_is_on('SWGCLR  ',myid) ) then
77        do j=jm1,jm2         do j=jm1,jm2
78        do i=im1,im2         do i=im1,im2
79        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)
80       .                               swgclr(i,j,bi,bj)*radswt(i,j,bi,bj)         enddo
81        enddo         enddo
82        enddo         call diagnostics_fill(tmpdiag,'SWGCLR  ',0,1,3,bi,bj,myid)
83        endif        endif
84                                                                                                                                                                    
85  c Outgoing Solar Radiation at top (W/m**2)  c Outgoing Solar Radiation at top (W/m**2)
86  c -----------------------------------------  c -----------------------------------------
87        if (iosr.ne.0) then        if(diagnostics_is_on('OSR     ',myid) ) then
88        do j=jm1,jm2         do j=jm1,jm2
89        do i=im1,im2         do i=im1,im2
90        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)
91       .                            (1.0-osr(i,j,bi,bj))*radswt(i,j,bi,bj)         enddo
92        enddo         enddo
93        enddo         call diagnostics_fill(tmpdiag,'OSR     ',0,1,3,bi,bj,myid)
94        endif        endif
95                                                                                                                                                                    
96  c Outgoing Clear Sky Solar Radiation at top (W/m**2)  c Outgoing Clear Sky Solar Radiation at top (W/m**2)
97  c ---------------------------------------------------  c ---------------------------------------------------
98        if (iosrclr.ne.0) then        if(diagnostics_is_on('OSRCLR  ',myid) ) then
99        do j=jm1,jm2         do j=jm1,jm2
100        do i=im1,im2         do i=im1,im2
101        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)
102       .                         (1.0-osrclr(i,j,bi,bj))*radswt(i,j,bi,bj)                 enddo
103        enddo         enddo
104        enddo         call diagnostics_fill(tmpdiag,'OSRCLR  ',0,1,3,bi,bj,myid)
105        endif        endif
106                                                                                                                                                                    
107  c Upward Longwave Flux at the Ground (W/m**2)  c Upward Longwave Flux at the Ground (W/m**2)
108  c -------------------------------------------  c -------------------------------------------
109        if (ilwgup.ne.0) then        if(diagnostics_is_on('LWGUP   ',myid) ) then
110        do j=jm1,jm2         do j=jm1,jm2
111        do i=im1,im2         do i=im1,im2
112        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)
113       .                 + 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))
114        enddo         enddo
115        enddo         enddo
116           call diagnostics_fill(tmpdiag,'LWGUP   ',0,1,3,bi,bj,myid)
117        endif        endif
118                                                                                                                                                                    
119  c Net Longwave Flux at the Ground (W/m**2)  c Net Longwave Flux at the Ground (W/m**2)
120  c ----------------------------------------  c ----------------------------------------
121        if (iradlwg.ne.0) then        if(diagnostics_is_on('RADLWG  ',myid) ) then
122        do j=jm1,jm2         do j=jm1,jm2
123        do i=im1,im2         do i=im1,im2
124        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) +  
125       .                  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))
126        enddo         enddo
127        enddo         enddo
128           call diagnostics_fill(tmpdiag,'RADLWG  ',0,1,3,bi,bj,myid)
129        endif        endif
130                                                                                                                                                                    
131  c Net Longwave Flux at the Ground Clear Sky (W/m**2)  c Net Longwave Flux at the Ground Clear Sky (W/m**2)
132  c --------------------------------------------------  c --------------------------------------------------
133        if (ilwgclr.ne.0) then        if(diagnostics_is_on('LWGCLR  ',myid) ) then
134        do j=jm1,jm2         do j=jm1,jm2
135        do i=im1,im2         do i=im1,im2
136        qdiag(i,j,ilwgclr,bi,bj) = qdiag(i,j,ilwgclr,bi,bj) +          tmpdiag(i,j) = lwgclr(i,j,bi,bj) +
137       .                                               lwgclr(i,j,bi,bj) +       .                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
138       .                   dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))         enddo
139        enddo         enddo
140        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  
141        endif        endif
142                                                                                                                                                                    
143  C **********************************************************************          C **********************************************************************        
# Line 162  C ************************************** Line 145  C **************************************
145    
146  c Total Diabatic U-Tendency (m/sec/day)  c Total Diabatic U-Tendency (m/sec/day)
147  c -------------------------------------  c -------------------------------------
148        if( idiabu.ne.0 ) then        if(diagnostics_is_on('DIABU   ',myid) ) then
149        do j=jm1,jm2         do j=jm1,jm2
150        do i=im1,im2         do i=im1,im2
151        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
152       .            + ( moistu (i,j,L,bi,bj) + turbu(i,j,L,bi,bj) )*86400         enddo
153        enddo         enddo
154        enddo         call diagnostics_fill(tmpdiag,'DIABU   ',L,1,3,bi,bj,myid)
155        endif        endif
156                                                                      
157  c Total Diabatic V-Tendency (m/sec/day)  c Total Diabatic V-Tendency (m/sec/day)
158  c -------------------------------------  c -------------------------------------
159        if( idiabv.ne.0 ) then        if(diagnostics_is_on('DIABV   ',myid) ) then
160        do j=jm1,jm2         do j=jm1,jm2
161        do i=im1,im2         do i=im1,im2
162        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
163       .            + ( moistv (i,j,L,bi,bj) + turbv(i,j,L,bi,bj) )*86400         enddo
164        enddo         enddo
165        enddo         call diagnostics_fill(tmpdiag,'DIABV   ',L,1,3,bi,bj,myid)
166        endif        endif
167    
168  c Total Diabatic T-Tendency (deg/day)  c Total Diabatic T-Tendency (deg/day)
169  c -----------------------------------  c -----------------------------------
170        if( idiabt.ne.0 ) then        if(diagnostics_is_on('DIABT   ',myid) ) then
171        do j=jm1,jm2         do j=jm1,jm2
172        do i=im1,im2         do i=im1,im2
173        qdiag(i,j,idiabt+L-1,bi,bj) = qdiag(i,j,idiabt+L-1,bi,bj) +          tmpdiag(i,j) =
174       .   ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +       .   ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +
175       .      lwdt(i,j,L,bi,bj) +       .      lwdt(i,j,L,bi,bj) +
176       .      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)) +
177       .      swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )       .      swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )
178       .      * pk(i,j,L,bi,bj)*pinv(i,j)*86400       .      * pk(i,j,L,bi,bj)*pinv(i,j)*86400
179        enddo         enddo
180        enddo         enddo
181           call diagnostics_fill(tmpdiag,'DIABT   ',L,1,3,bi,bj,myid)
182        endif        endif
183                                                                      
184  c Total Diabatic Q-Tendency (g/kg/day)  c Total Diabatic Q-Tendency (g/kg/day)
185  c ------------------------------------  c ------------------------------------
186        if( idiabq.ne.0 ) then        if(diagnostics_is_on('DIABQ   ',myid) ) then
187        do j=jm1,jm2         do j=jm1,jm2
188        do i=im1,im2         do i=im1,im2
189        qdiag(i,j,idiabq+L-1,bi,bj) =   qdiag(i,j,idiabq+L-1,bi,bj) +          tmpdiag(i,j) =
190       . ( 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) ) *
191       .                                      pinv(i,j)*86400*1000       .                                      pinv(i,j)*86400*1000
192        enddo         enddo
193        enddo         enddo
194           call diagnostics_fill(tmpdiag,'DIABQ   ',L,1,3,bi,bj,myid)
195        endif        endif
196            
197  c Longwave Heating (deg/day)  c Longwave Heating (deg/day)
198  c --------------------------  c --------------------------
199        if (iradlw.ne.0) then        if(diagnostics_is_on('RADLW   ',myid) ) then
200        do j=jm1,jm2         do j=jm1,jm2
201        do i=im1,im2         do i=im1,im2
202        qdiag(i,j,iradlw+l-1,bi,bj) = qdiag(i,j,iradlw+l-1,bi,bj) +          tmpdiag(i,j) =
203       . ( lwdt(i,j,l,bi,bj) +       . ( lwdt(i,j,l,bi,bj) +
204       .            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)) )
205       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400
206        enddo         enddo
207        enddo         enddo
208           call diagnostics_fill(tmpdiag,'RADLW   ',L,1,3,bi,bj,myid)
209        endif        endif
210    
211  c Longwave Heating Clear-Sky (deg/day)  c Longwave Heating Clear-Sky (deg/day)
212  c ------------------------------------  c ------------------------------------
213        if (ilwclr.ne.0) then                                                            if(diagnostics_is_on('LWCLR   ',myid) ) then
214        do j=jm1,jm2         do j=jm1,jm2
215        do i=im1,im2         do i=im1,im2
216        qdiag(i,j,ilwclr+l-1,bi,bj) = qdiag(i,j,ilwclr+l-1,bi,bj) +          tmpdiag(i,j) =
217       . ( lwdtclr(i,j,l,bi,bj) +       . ( lwdtclr(i,j,l,bi,bj) +
218       .             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)) )
219       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400
220        enddo         enddo
221        enddo         enddo
222           call diagnostics_fill(tmpdiag,'LWCLR   ',L,1,3,bi,bj,myid)
223        endif        endif
224                                                                                                                                                                    
225  c Solar Radiative Heating (deg/day)  c Solar Radiative Heating (deg/day)
226  c ---------------------------------  c ---------------------------------
227        if (iradsw.ne.0) then        if(diagnostics_is_on('RADSW   ',myid) ) then
228        do j=jm1,jm2         do j=jm1,jm2
229        do i=im1,im2         do i=im1,im2
230        qdiag(i,j,iradsw+l-1,bi,bj) = qdiag(i,j,iradsw+l-1,bi,bj)          tmpdiag(i,j) =
231       .  + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*       .  + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
232       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400
233        enddo         enddo
234        enddo         enddo
235           call diagnostics_fill(tmpdiag,'RADSW   ',L,1,3,bi,bj,myid)
236        endif        endif
237                                                                                                                                                                    
238  c Clear Sky Solar Radiative Heating (deg/day)  c Clear Sky Solar Radiative Heating (deg/day)
239  c -------------------------------------------  c -------------------------------------------
240        if (iswclr.ne.0) then        if(diagnostics_is_on('SWCLR   ',myid) ) then
241        do j=jm1,jm2         do j=jm1,jm2
242        do i=im1,im2         do i=im1,im2
243        qdiag(i,j,iswclr+l-1,bi,bj) = qdiag(i,j,iswclr+l-1,bi,bj) +          tmpdiag(i,j) =
244       .           swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*       .  + swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
245       .                           pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400
246        enddo         enddo
247        enddo         enddo
248           call diagnostics_fill(tmpdiag,'SWCLR   ',L,1,3,bi,bj,myid)
249        endif        endif
250                                                                                                                                                                    
251  c Averaged U-Field (m/sec)  c Averaged U-Field (m/sec)
252  c ------------------------  c ------------------------
253        if( iuwnd.ne.0 ) then        if(diagnostics_is_on('UWND    ',myid) ) then
254        do j=jm1,jm2         do j=jm1,jm2
255        do i=im1,im2         do i=im1,im2
256        qdiag(i,j,iuwnd+L-1,bi,bj) = qdiag(i,j,iuwnd+L-1,bi,bj) +          tmpdiag(i,j) = uphy(i,j,L,bi,bj)
257       .                                                 uphy(i,j,L,bi,bj)         enddo
258        enddo         enddo
259        enddo         call diagnostics_fill(tmpdiag,'UWND    ',L,1,3,bi,bj,myid)
260        endif        endif
261    
262  c Averaged V-Field (m/sec)  c Averaged V-Field (m/sec)
263  c ------------------------  c ------------------------
264        if( ivwnd.ne.0 ) then        if(diagnostics_is_on('VWND    ',myid) ) then
265        do j=jm1,jm2         do j=jm1,jm2
266        do i=im1,im2         do i=im1,im2
267        qdiag(i,j,ivwnd+L-1,bi,bj) = qdiag(i,j,ivwnd+L-1,bi,bj) +          tmpdiag(i,j) = vphy(i,j,L,bi,bj)
268       .                                                 vphy(i,j,L,bi,bj)         enddo
269        enddo         enddo
270        enddo         call diagnostics_fill(tmpdiag,'VWND    ',L,1,3,bi,bj,myid)
271        endif        endif
272    
273  c Averaged T-Field (deg)  c Averaged T-Field (deg)
274  c ----------------------  c ----------------------
275        if( itmpu.ne.0 ) then        if(diagnostics_is_on('TMPU    ',myid) ) then
276        do j=jm1,jm2         do j=jm1,jm2
277        do i=im1,im2         do i=im1,im2
278        qdiag(i,j,itmpu+L-1,bi,bj) = qdiag(i,j,itmpu+L-1,bi,bj) +          tmpdiag(i,j) = thphy(i,j,L,bi,bj)*pk(i,j,L,bi,bj)
279       .                               thphy(i,j,L,bi,bj)*pk(i,j,L,bi,bj)         enddo
280        enddo         enddo
281        enddo         call diagnostics_fill(tmpdiag,'TMPU    ',L,1,3,bi,bj,myid)
282        endif        endif
283                                                                                                                                                                    
284  c Averaged QQ-Field (m/sec)**2  c Averaged QQ-Field (m/sec)**2
285  c ----------------------------  c ----------------------------
286        if( itke.ne.0 ) then        if(diagnostics_is_on('TKE     ',myid) ) then
287        do j=jm1,jm2         do j=jm1,jm2
288        do i=im1,im2         do i=im1,im2
289        qdiag(i,j,itke+L-1,bi,bj) = qdiag(i,j,itke+L-1,bi,bj)          tmpdiag(i,j) = qq(i,j,L,bi,bj)
290       &                          + qq(i,j,L,bi,bj)         enddo
291        enddo         enddo
292        enddo         call diagnostics_fill(tmpdiag,'TKE     ',L,1,3,bi,bj,myid)
293        endif        endif
294                                                                                                                                                                    
295  c Averaged Q-Field (g/kg)  c Averaged Q-Field (g/kg)
296  c -----------------------  c -----------------------
297        if( isphu.ne.0 ) then        if(diagnostics_is_on('SPHU    ',myid) ) then
298        do j=jm1,jm2         do j=jm1,jm2
299        do i=im1,im2         do i=im1,im2
300        qdiag(i,j,isphu+L-1,bi,bj) = qdiag(i,j,isphu+L-1,bi,bj) +          tmpdiag(i,j) = sphy(i,j,L,bi,bj) * 1000.
301       .                                            sphy(i,j,L,bi,bj)*1000         enddo
302        enddo         enddo
303        enddo         call diagnostics_fill(tmpdiag,'SPHU    ',L,1,3,bi,bj,myid)
304        endif        endif
305                                                                                                                                                                    
306        enddo        enddo
307    
       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  
   
       endif  
   
308  C **********************************************************************          C **********************************************************************        
309    
310  c Vertically Averaged Moist-T Increment (K/day)  c Vertically Averaged Moist-T Increment (K/day)
311  c ---------------------------------------------  c ---------------------------------------------
312        if( ivdtmoist.ne.0 ) then        if(diagnostics_is_on('VDTMOIST',myid) ) then
313        do j=jm1,jm2         do j=jm1,jm2
314        do i=im1,im2         do i=im1,im2
315        qbar(i,j) = 0.0         qbar(i,j) = 0.0
316        enddo         enddo
317        enddo         enddo
318        do L=1,Nrphys         do L=1,Nrphys
319        do j=jm1,jm2         do j=jm1,jm2
320        do i=im1,im2         do i=im1,im2
321        qbar(i,j) = qbar(i,j) +         qbar(i,j) = qbar(i,j) +
322       .             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)
323        enddo         enddo
324        enddo         enddo
325        enddo         enddo
326        do j=jm1,jm2         do j=jm1,jm2
327        do i=im1,im2         do i=im1,im2
328        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
329       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
330        enddo         enddo
331        enddo         call diagnostics_fill(tmpdiag,'VDTMOIST',0,1,3,bi,bj,myid)
332        endif        endif
333    
334  c Vertically Averaged Turb-T Increment (K/day)  c Vertically Averaged Turb-T Increment (K/day)
335  c --------------------------------------------  c --------------------------------------------
336        if( ivdtturb.ne.0 ) then        if(diagnostics_is_on('VDTTURB ',myid) ) then
337        do j=jm1,jm2         do j=jm1,jm2
338        do i=im1,im2         do i=im1,im2
339        qbar(i,j) = 0.0         qbar(i,j) = 0.0
340        enddo         enddo
341        enddo         enddo
342        do L=1,Nrphys         do L=1,Nrphys
343        do j=jm1,jm2         do j=jm1,jm2
344        do i=im1,im2         do i=im1,im2
345        qbar(i,j) = qbar(i,j) +         qbar(i,j) = qbar(i,j) +
346       .             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)
347        enddo         enddo
348        enddo         enddo
349        enddo         enddo
350        do j=jm1,jm2         do j=jm1,jm2
351        do i=im1,im2         do i=im1,im2
352        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
353       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
354        enddo         enddo
355        enddo         call diagnostics_fill(tmpdiag,'VDTTURB ',0,1,3,bi,bj,myid)
356        endif        endif
357    
358  c Vertically Averaged RADLW Temperature Increment (K/day)  c Vertically Averaged RADLW Temperature Increment (K/day)
359  c -------------------------------------------------------  c -------------------------------------------------------
360        if( ivdtradlw.ne.0 ) then        if(diagnostics_is_on('VDTRADLW',myid) ) then
361        do j=jm1,jm2         do j=jm1,jm2
362        do i=im1,im2         do i=im1,im2
363        qbar(i,j) = 0.0         qbar(i,j) = 0.0
364        enddo         enddo
365        enddo         enddo
366        do L=1,Nrphys         do L=1,Nrphys
367        do j=jm1,jm2         do j=jm1,jm2
368        do i=im1,im2         do i=im1,im2
369        qbar(i,j) = qbar(i,j) + ( lwdt(i,j,L,bi,bj) +          qbar(i,j) = qbar(i,j) + ( lwdt(i,j,L,bi,bj) +
370       .  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)) )
371       .             *pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)       .             *pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
372        enddo         enddo
373        enddo         enddo
374        enddo         enddo
375        do j=jm1,jm2         do j=jm1,jm2
376        do i=im1,im2         do i=im1,im2
377        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
378       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
379        enddo         enddo
380        enddo         call diagnostics_fill(tmpdiag,'VDTRADLW',0,1,3,bi,bj,myid)
381        endif        endif
382    
383  c Vertically Averaged RADSW Temperature Increment (K/day)  c Vertically Averaged RADSW Temperature Increment (K/day)
384  c -------------------------------------------------------  c -------------------------------------------------------
385        if( ivdtradsw.ne.0 ) then        if(diagnostics_is_on('VDTRADSW',myid) ) then
386        do j=jm1,jm2         do j=jm1,jm2
387        do i=im1,im2         do i=im1,im2
388        qbar(i,j) = 0.0         qbar(i,j) = 0.0
389        enddo         enddo
390        enddo         enddo
391        do L=1,Nrphys         do L=1,Nrphys
392        do j=jm1,jm2         do j=jm1,jm2
393        do i=im1,im2         do i=im1,im2
394        qbar(i,j) = qbar(i,j) +          qbar(i,j) = qbar(i,j) +
395       .             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)
396        enddo         enddo
397        enddo         enddo
398        enddo         enddo
399        do j=jm1,jm2         do j=jm1,jm2
400        do i=im1,im2         do i=im1,im2
401        qdiag(i,j,ivdtradsw,bi,bj) = qdiag(i,j,ivdtradsw,bi,bj) +         tmpdiag(i,j) = qbar(i,j) *
402       . 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
403        enddo         enddo
404        enddo         enddo
405           call diagnostics_fill(tmpdiag,'VDTRADSW',0,1,3,bi,bj,myid)
406        endif        endif
407    
       if( (bi.eq.1) .and. (bj.eq.1) ) then  
       nvdtmoist = nvdtmoist + 1  
       nvdtturb  = nvdtturb  + 1  
       nvdtradlw = nvdtradlw + 1  
       nvdtradsw = nvdtradsw + 1  
       endif  
   
408  #endif  #endif
409        return        return
410        end        end
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22