/[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.11 by molod, Sun Aug 29 19:43:43 2004 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(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,
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  #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 44  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 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    
51  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
52        do j=jm1,jm2        do j=jm1,jm2
# Line 56  C ************************************** Line 55  C **************************************
55        enddo        enddo
56        enddo        enddo
57    
58    c Surface Pressure (mb)
59    c ---------------------------------
60          call diagnostics_fill(p(1,1,bi,bj),'PS      ',0,1,3,bi,bj,myid)
61    
62  c Incident Solar Radiation (W/m**2)  c Incident Solar Radiation (W/m**2)
63  c ---------------------------------  c ---------------------------------
64        if (iradswt.ne.0) then        call diagnostics_fill(radswt(1,1,bi,bj),'RADSWT  ',
65        do j=jm1,jm2       &                      0,1,3,bi,bj,myid)
66        do i=im1,im2  
       qdiag(i,j,iradswt,bi,bj)= qdiag(i,j,iradswt,bi,bj) +  
      .                                                 radswt(i,j,bi,bj)  
       enddo  
       enddo  
       endif  
                                                                                   
67  c Net Solar Radiation at the Ground (W/m**2)  c Net Solar Radiation at the Ground (W/m**2)
68  c ------------------------------------------  c ------------------------------------------
69        if (iradswg.ne.0) then        if(diagnostics_is_on('RADSWG  ',myid) ) then
70        do j=jm1,jm2         do j=jm1,jm2
71        do i=im1,im2         do i=im1,im2
72        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)
73       .                               radswg(i,j,bi,bj)*radswt(i,j,bi,bj)         enddo
74        enddo         enddo
75        enddo         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 (iswgclr.ne.0) then        if(diagnostics_is_on('SWGCLR  ',myid) ) then
81        do j=jm1,jm2         do j=jm1,jm2
82        do i=im1,im2         do i=im1,im2
83        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)
84       .                               swgclr(i,j,bi,bj)*radswt(i,j,bi,bj)         enddo
85        enddo         enddo
86        enddo         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 (iosr.ne.0) then        if(diagnostics_is_on('OSR     ',myid) ) then
92        do j=jm1,jm2         do j=jm1,jm2
93        do i=im1,im2         do i=im1,im2
94        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)
95       .                            (1.0-osr(i,j,bi,bj))*radswt(i,j,bi,bj)         enddo
96        enddo         enddo
97        enddo         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 (iosrclr.ne.0) then        if(diagnostics_is_on('OSRCLR  ',myid) ) then
103        do j=jm1,jm2         do j=jm1,jm2
104        do i=im1,im2         do i=im1,im2
105        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)
106       .                         (1.0-osrclr(i,j,bi,bj))*radswt(i,j,bi,bj)                 enddo
107        enddo         enddo
108        enddo         call diagnostics_fill(tmpdiag,'OSRCLR  ',0,1,3,bi,bj,myid)
109          endif
110    
111    c Planetary Albedo
112    c ----------------
113          if(diagnostics_is_on('PLALBEDO',myid) ) then
114           do j=jm1,jm2
115           do i=im1,im2
116            if(radswt(i,j,bi,bj).ne.0.) then
117             tmpdiag(i,j) = osr(i,j,bi,bj)
118            else
119             tmpdiag(i,j) = 0.
120            endif
121           enddo
122           enddo
123           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 (ilwgup.ne.0) 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        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)
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)
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 (iradlwg.ne.0) 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        qdiag(i,j,iradlwg,bi,bj) =  qdiag(i,j,iradlwg,bi,bj) +          tmpdiag(i,j) = radlwg(i,j,bi,bj) +
144       .                                              radlwg(i,j,bi,bj) +       &                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
145       .                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))         enddo
146        enddo         enddo
147        enddo         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 (ilwgclr.ne.0) 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        qdiag(i,j,ilwgclr,bi,bj) = qdiag(i,j,ilwgclr,bi,bj) +          tmpdiag(i,j) = lwgclr(i,j,bi,bj) +
156       .                                               lwgclr(i,j,bi,bj) +       &                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
157       .                   dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))         enddo
158        enddo         enddo
159        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  
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)
166  c -------------------------------------  c -------------------------------------
167        if( idiabu.ne.0 ) then        if(diagnostics_is_on('DIABU   ',myid) ) then
168        do j=jm1,jm2         do j=jm1,jm2
169        do i=im1,im2         do i=im1,im2
170        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
171       .            + ( moistu (i,j,L,bi,bj) + turbu(i,j,L,bi,bj) )*86400         enddo
172        enddo         enddo
173        enddo         call diagnostics_fill(tmpdiag,'DIABU   ',L,1,3,bi,bj,myid)
174        endif        endif
175                                                                      
176  c Total Diabatic V-Tendency (m/sec/day)  c Total Diabatic V-Tendency (m/sec/day)
177  c -------------------------------------  c -------------------------------------
178        if( idiabv.ne.0 ) then        if(diagnostics_is_on('DIABV   ',myid) ) then
179        do j=jm1,jm2         do j=jm1,jm2
180        do i=im1,im2         do i=im1,im2
181        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
182       .            + ( moistv (i,j,L,bi,bj) + turbv(i,j,L,bi,bj) )*86400         enddo
183        enddo         enddo
184        enddo         call diagnostics_fill(tmpdiag,'DIABV   ',L,1,3,bi,bj,myid)
185        endif        endif
186    
187  c Total Diabatic T-Tendency (deg/day)  c Total Diabatic T-Tendency (deg/day)
188  c -----------------------------------  c -----------------------------------
189        if( idiabt.ne.0 ) 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        qdiag(i,j,idiabt+L-1,bi,bj) = qdiag(i,j,idiabt+L-1,bi,bj) +          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)
201        endif        endif
202                                                                      
203  c Total Diabatic Q-Tendency (g/kg/day)  c Total Diabatic Q-Tendency (g/kg/day)
204  c ------------------------------------  c ------------------------------------
205        if( idiabq.ne.0 ) 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        qdiag(i,j,idiabq+L-1,bi,bj) =   qdiag(i,j,idiabq+L-1,bi,bj) +          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)
214        endif        endif
215        
216  c Longwave Heating (deg/day)  c Longwave Heating (deg/day)
217  c --------------------------  c --------------------------
218        if (iradlw.ne.0) 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        qdiag(i,j,iradlw+l-1,bi,bj) = qdiag(i,j,iradlw+l-1,bi,bj) +          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)
228        endif        endif
229    
230  c Longwave Heating Clear-Sky (deg/day)  c Longwave Heating Clear-Sky (deg/day)
231  c ------------------------------------  c ------------------------------------
232        if (ilwclr.ne.0) 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        qdiag(i,j,ilwclr+l-1,bi,bj) = qdiag(i,j,ilwclr+l-1,bi,bj) +          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)
242        endif        endif
243                                                                                    
244  c Solar Radiative Heating (deg/day)  c Solar Radiative Heating (deg/day)
245  c ---------------------------------  c ---------------------------------
246        if (iradsw.ne.0) 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        qdiag(i,j,iradsw+l-1,bi,bj) = qdiag(i,j,iradsw+l-1,bi,bj) +          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)
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 (iswclr.ne.0) 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        qdiag(i,j,iswclr+l-1,bi,bj) = qdiag(i,j,iswclr+l-1,bi,bj) +          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)
268        endif        endif
269                                                                                    
270  c Averaged U-Field (m/sec)  c Averaged U-Field (m/sec)
271  c ------------------------  c ------------------------
272        if( iuwnd.ne.0 ) 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        qdiag(i,j,iuwnd+L-1,bi,bj) = qdiag(i,j,iuwnd+L-1,bi,bj) +          tmpdiag(i,j) = uphy(i,j,L)
276       .                                                 uphy(i,j,L,bi,bj)         enddo
277        enddo         enddo
278        enddo         call diagnostics_fill(tmpdiag,'UWND    ',L,1,3,bi,bj,myid)
279        endif        endif
280    
281  c Averaged V-Field (m/sec)  c Averaged V-Field (m/sec)
282  c ------------------------  c ------------------------
283        if( ivwnd.ne.0 ) 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        qdiag(i,j,ivwnd+L-1,bi,bj) = qdiag(i,j,ivwnd+L-1,bi,bj) +          tmpdiag(i,j) = vphy(i,j,L)
287       .                                                 vphy(i,j,L,bi,bj)         enddo
288        enddo         enddo
289        enddo         call diagnostics_fill(tmpdiag,'VWND    ',L,1,3,bi,bj,myid)
290        endif        endif
291    
292  c Averaged T-Field (deg)  c Averaged T-Field (deg)
293  c ----------------------  c ----------------------
294        if( itmpu.ne.0 ) 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        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)
298       .                               thphy(i,j,L,bi,bj)*pk(i,j,L,bi,bj)         enddo
299        enddo         enddo
300        enddo         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( itke.ne.0 ) then        if(diagnostics_is_on('TKE     ',myid) ) then
306        do j=jm1,jm2         do j=jm1,jm2
307        do i=im1,im2         do i=im1,im2
308        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)
309        enddo         enddo
310        enddo         enddo
311           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( isphu.ne.0 ) 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        qdiag(i,j,isphu+L-1,bi,bj) = qdiag(i,j,isphu+L-1,bi,bj) +          tmpdiag(i,j) = sphy(i,j,L) * 1000.
320       .                                            sphy(i,j,L,bi,bj)*1000         enddo
321        enddo         enddo
322        enddo         call diagnostics_fill(tmpdiag,'SPHU    ',L,1,3,bi,bj,myid)
323        endif        endif
                                                                                   
       enddo  
   
       if( (bi.eq.1) .and. (bj.eq.1) ) then  
324    
325        ndiabu = ndiabu + 1        enddo
       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  
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 ---------------------------------------------
331        if( ivdtmoist.ne.0 ) then        if(diagnostics_is_on('VDTMOIST',myid) ) then
332        do j=jm1,jm2         do j=jm1,jm2
333        do i=im1,im2         do i=im1,im2
334        qbar(i,j) = 0.0         qbar(i,j) = 0.0
335        enddo         enddo
336        enddo         enddo
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
345        do j=jm1,jm2         do j=jm1,jm2
346        do i=im1,im2         do i=im1,im2
347        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
348       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
349        enddo         enddo
350        enddo         call diagnostics_fill(tmpdiag,'VDTMOIST',0,1,3,bi,bj,myid)
351        endif        endif
352    
353  c Vertically Averaged Turb-T Increment (K/day)  c Vertically Averaged Turb-T Increment (K/day)
354  c --------------------------------------------  c --------------------------------------------
355        if( ivdtturb.ne.0 ) then        if(diagnostics_is_on('VDTTURB ',myid) ) then
356        do j=jm1,jm2         do j=jm1,jm2
357        do i=im1,im2         do i=im1,im2
358        qbar(i,j) = 0.0         qbar(i,j) = 0.0
359        enddo         enddo
360        enddo         enddo
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
369        do j=jm1,jm2         do j=jm1,jm2
370        do i=im1,im2         do i=im1,im2
371        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
372       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
373        enddo         enddo
374        enddo         call diagnostics_fill(tmpdiag,'VDTTURB ',0,1,3,bi,bj,myid)
375        endif        endif
376    
377  c Vertically Averaged RADLW Temperature Increment (K/day)  c Vertically Averaged RADLW Temperature Increment (K/day)
378  c -------------------------------------------------------  c -------------------------------------------------------
379        if( ivdtradlw.ne.0 ) then        if(diagnostics_is_on('VDTRADLW',myid) ) then
380        do j=jm1,jm2         do j=jm1,jm2
381        do i=im1,im2         do i=im1,im2
382        qbar(i,j) = 0.0         qbar(i,j) = 0.0
383        enddo         enddo
384        enddo         enddo
385        do L=1,Nrphys         do L=1,Nrphys
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
394        do j=jm1,jm2         do j=jm1,jm2
395        do i=im1,im2         do i=im1,im2
396        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
397       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
398        enddo         enddo
399        enddo         call diagnostics_fill(tmpdiag,'VDTRADLW',0,1,3,bi,bj,myid)
400        endif        endif
401    
402  c Vertically Averaged RADSW Temperature Increment (K/day)  c Vertically Averaged RADSW Temperature Increment (K/day)
403  c -------------------------------------------------------  c -------------------------------------------------------
404        if( ivdtradsw.ne.0 ) then        if(diagnostics_is_on('VDTRADSW',myid) ) then
405        do j=jm1,jm2         do j=jm1,jm2
406        do i=im1,im2         do i=im1,im2
407        qbar(i,j) = 0.0         qbar(i,j) = 0.0
408        enddo         enddo
409        enddo         enddo
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        qdiag(i,j,ivdtradsw,bi,bj) = qdiag(i,j,ivdtradsw,bi,bj) +         tmpdiag(i,j) = qbar(i,j) *
421       . 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
422        enddo         enddo
423        enddo         enddo
424           call diagnostics_fill(tmpdiag,'VDTRADSW',0,1,3,bi,bj,myid)
425        endif        endif
426    
427        if( (bi.eq.1) .and. (bj.eq.1) ) then  c Total Precipitable Water (g/cm^2)
428        nvdtmoist = nvdtmoist + 1  c ---------------------------------------------
429        nvdtturb  = nvdtturb  + 1        if(diagnostics_is_on('TPW     ',myid) ) then
430        nvdtradlw = nvdtradlw + 1         gravity = getcon('GRAVITY')
431        nvdtradsw = nvdtradsw + 1         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        endif
   
451  #endif  #endif
452        return        return
453        end        end
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22