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