/[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.5 by molod, Wed Jul 14 14:50:04 2004 UTC revision 1.17 by molod, Fri Jun 17 01:04:24 2005 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "PACKAGES_CONFIG.h"  #include "FIZHI_OPTIONS.h"
5  #include "CPP_OPTIONS.h"        subroutine fizhi_step_diag(myid,p,uphy,vphy,thphy,sphy,qq,pk,dp,
       subroutine fizhi_step_diag(myThid,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 11  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
14  #include "SIZE.h"        _RL p(im2,jm2,Nbi,Nbj)
15  #include "diagnostics_SIZE.h"        _RL uphy(im2,jm2,Nrphys,Nbi,Nbj)
16  #include "diagnostics.h"        _RL vphy(im2,jm2,Nrphys,Nbi,Nbj)
17  #endif        _RL thphy(im2,jm2,Nrphys,Nbi,Nbj)
18          _RL sphy(im2,jm2,Nrphys,Nbi,Nbj)
19        integer myThid,im1,im2,jm1,jm2,Nrphys,Nbi,Nbj,bi,bj,ntracer        _RL qq(im2,jm2,Nrphys,Nbi,Nbj),pk(im2,jm2,Nrphys,Nbi,Nbj)
20        real p(im2,jm2,Nbi,Nbj)        _RL dp(im2,jm2,Nrphys,Nbi,Nbj)
21        real uphy(im2,jm2,Nrphys,Nbi,Nbj),vphy(im2,jm2,Nrphys,Nbi,Nbj)        _RL radswt(im2,jm2,Nbi,Nbj),radswg(im2,jm2,Nbi,Nbj)
22        real thphy(im2,jm2,Nrphys,Nbi,Nbj),sphy(im2,jm2,Nrphys,Nbi,Nbj)        _RL swgclr(im2,jm2,Nbi,Nbj),osr(im2,jm2,Nbi,Nbj)
23        real qq(im2,jm2,Nrphys),pk(im2,jm2,Nrphys,Nbi,Nbj)        _RL osrclr(im2,jm2,Nbi,Nbj),st4(im2,jm2,Nbi,Nbj)
24        real dp(im2,jm2,Nrphys,Nbi,Nbj)        _RL dst4(im2,jm2,Nbi,Nbj),tgz(im2,jm2,Nbi,Nbj)
25        real radswt(im2,jm2,Nbi,Nbj),radswg(im2,jm2,Nbi,Nbj)        _RL tg0(im2,jm2,Nbi,Nbj),radlwg(im2,jm2,Nbi,Nbj)
26        real swgclr(im2,jm2,Nbi,Nbj),osr(im2,jm2,Nbi,Nbj)        _RL lwgclr(im2,jm2,Nbi,Nbj)
27        real osrclr(im2,jm2,Nbi,Nbj),st4(im2,jm2,Nbi,Nbj)        _RL turbu(im2,jm2,Nrphys,Nbi,Nbj)
28        real dst4(im2,jm2,Nbi,Nbj),tgz(im2,jm2,Nbi,Nbj)        _RL turbv(im2,jm2,Nrphys,Nbi,Nbj)
29        real tg0(im2,jm2,Nbi,Nbj),radlwg(im2,jm2,Nbi,Nbj)        _RL turbt(im2,jm2,Nrphys,Nbi,Nbj)
30        real lwgclr(im2,jm2,Nbi,Nbj)        _RL turbq(im2,jm2,Nrphys,ntracer,Nbi,Nbj)
31        real turbu(im2,jm2,Nrphys,Nbi,Nbj),turbv(im2,jm2,Nrphys,Nbi,Nbj)        _RL moistu(im2,jm2,Nrphys,Nbi,Nbj)
32        real turbt(im2,jm2,Nrphys,Nbi,Nbj)        _RL moistv(im2,jm2,Nrphys,Nbi,Nbj)
33        real turbq(im2,jm2,Nrphys,ntracer,Nbi,Nbj)        _RL moistt(im2,jm2,Nrphys,Nbi,Nbj)
34        real moistu(im2,jm2,Nrphys,Nbi,Nbj),moistv(im2,jm2,Nrphys,Nbi,Nbj)        _RL moistq(im2,jm2,Nrphys,ntracer,Nbi,Nbj)
35        real moistt(im2,jm2,Nrphys,Nbi,Nbj)        _RL lwdt(im2,jm2,Nrphys,Nbi,Nbj)
36        real moistq(im2,jm2,Nrphys,ntracer,Nbi,Nbj)        _RL swdt(im2,jm2,Nrphys,Nbi,Nbj)
37        real lwdt(im2,jm2,Nrphys,Nbi,Nbj),swdt(im2,jm2,Nrphys,Nbi,Nbj)        _RL lwdtclr(im2,jm2,Nrphys,Nbi,Nbj)
38        real lwdtclr(im2,jm2,Nrphys,Nbi,Nbj)        _RL swdtclr(im2,jm2,Nrphys,Nbi,Nbj)
39        real swdtclr(im2,jm2,Nrphys,Nbi,Nbj)        _RL dlwdtg(im2,jm2,Nrphys,Nbi,Nbj)
       real dlwdtg(im2,jm2,Nrphys,Nbi,Nbj)  
40    
41        integer  i,j,L        integer  i,j,L
42        real 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    
50    #ifdef ALLOW_DIAGNOSTICS
51        do j=jm1,jm2        do j=jm1,jm2
52        do i=im1,im2        do i=im1,im2
53        pinv(i,j) = 1.0 / p(i,j,bi,bj)        pinv(i,j) = 1.0 / p(i,j,bi,bj)
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
112                                                                                    
113    c Planetary Albedo
114    c ----------------
115          if(diagnostics_is_on('PLALBEDO',myid) ) then
116           do j=jm1,jm2
117           do i=im1,im2
118            if(radswt(i,j,bi,bj).ne.0.) then
119             tmpdiag(i,j) = osr(i,j,bi,bj)
120            else
121             tmpdiag(i,j) = 0.
122            endif
123           enddo
124           enddo
125           call diagnostics_fill(tmpdiag,'PLALBEDO',0,1,3,bi,bj,myid)
126        endif        endif
127                                                                                                                                                                    
128  c Upward Longwave Flux at the Ground (W/m**2)  c Upward Longwave Flux at the Ground (W/m**2)
129  c -------------------------------------------  c -------------------------------------------
130        if (ilwgup.ne.0) then        if(diagnostics_is_on('LWGUP   ',myid) ) then
131        do j=jm1,jm2         do j=jm1,jm2
132        do i=im1,im2         do i=im1,im2
133        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)
134       .                 + 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))
135        enddo         enddo
136        enddo         enddo
137           call diagnostics_fill(tmpdiag,'LWGUP   ',0,1,3,bi,bj,myid)
138        endif        endif
139                                                                                                                                                                    
140  c Net Longwave Flux at the Ground (W/m**2)  c Net Longwave Flux at the Ground (W/m**2)
141  c ----------------------------------------  c ----------------------------------------
142        if (iradlwg.ne.0) then        if(diagnostics_is_on('RADLWG  ',myid) ) then
143        do j=jm1,jm2         do j=jm1,jm2
144        do i=im1,im2         do i=im1,im2
145        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) +  
146       .                  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))
147        enddo         enddo
148        enddo         enddo
149           call diagnostics_fill(tmpdiag,'RADLWG  ',0,1,3,bi,bj,myid)
150        endif        endif
151                                                                                                                                                                    
152  c Net Longwave Flux at the Ground Clear Sky (W/m**2)  c Net Longwave Flux at the Ground Clear Sky (W/m**2)
153  c --------------------------------------------------  c --------------------------------------------------
154        if (ilwgclr.ne.0) then        if(diagnostics_is_on('LWGCLR  ',myid) ) then
155        do j=jm1,jm2         do j=jm1,jm2
156        do i=im1,im2         do i=im1,im2
157        qdiag(i,j,ilwgclr,bi,bj) = qdiag(i,j,ilwgclr,bi,bj) +          tmpdiag(i,j) = lwgclr(i,j,bi,bj) +
158       .                                               lwgclr(i,j,bi,bj) +       .                  dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))
159       .                   dst4(i,j,bi,bj)*(tgz(i,j,bi,bj)-tg0(i,j,bi,bj))         enddo
160        enddo         enddo
161        enddo         call diagnostics_fill(tmpdiag,'LWGCLR  ',0,1,3,bi,bj,myid)
162        endif        endif
163                                                                                                                                                                    
       nradswt = nradswt + 1  
       nradswg = nradswg + 1  
       nswgclr = nswgclr + 1  
       nosr    = nosr    + 1  
       nosrclr = nosrclr + 1  
       nradlwg = nradlwg + 1  
       nlwgclr = nlwgclr + 1  
       nlwgup  = nlwgup  + 1  
                                                                                   
164  C **********************************************************************          C **********************************************************************        
165        do L=1,Nrphys        do L=1,Nrphys
166    
167  c Total Diabatic U-Tendency (m/sec/day)  c Total Diabatic U-Tendency (m/sec/day)
168  c -------------------------------------  c -------------------------------------
169        if( idiabu.ne.0 ) then        if(diagnostics_is_on('DIABU   ',myid) ) then
170        do j=jm1,jm2         do j=jm1,jm2
171        do i=im1,im2         do i=im1,im2
172        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
173       .            + ( moistu (i,j,L,bi,bj) + turbu(i,j,L,bi,bj) )*86400         enddo
174        enddo         enddo
175        enddo         call diagnostics_fill(tmpdiag,'DIABU   ',L,1,3,bi,bj,myid)
176        endif        endif
177                                                                      
178  c Total Diabatic V-Tendency (m/sec/day)  c Total Diabatic V-Tendency (m/sec/day)
179  c -------------------------------------  c -------------------------------------
180        if( idiabv.ne.0 ) then        if(diagnostics_is_on('DIABV   ',myid) ) then
181        do j=jm1,jm2         do j=jm1,jm2
182        do i=im1,im2         do i=im1,im2
183        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
184       .            + ( moistv (i,j,L,bi,bj) + turbv(i,j,L,bi,bj) )*86400         enddo
185        enddo         enddo
186        enddo         call diagnostics_fill(tmpdiag,'DIABV   ',L,1,3,bi,bj,myid)
187        endif        endif
188    
189  c Total Diabatic T-Tendency (deg/day)  c Total Diabatic T-Tendency (deg/day)
190  c -----------------------------------  c -----------------------------------
191        if( idiabt.ne.0 ) then        if(diagnostics_is_on('DIABT   ',myid) ) then
192        do j=jm1,jm2         do j=jm1,jm2
193        do i=im1,im2         do i=im1,im2
194        qdiag(i,j,idiabt+L-1,bi,bj) = qdiag(i,j,idiabt+L-1,bi,bj) +          tmpdiag(i,j) =
195       .   ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +       .   ( turbt(i,j,L,bi,bj) + moistt(i,j,L,bi,bj) +
196       .      lwdt(i,j,L,bi,bj) +       .      lwdt(i,j,L,bi,bj) +
197       .      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)) +
198       .      swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )       .      swdt(i,j,L,bi,bj)*radswt(i,j,bi,bj) )
199       .      * pk(i,j,L,bi,bj)*pinv(i,j)*86400       .      * pk(i,j,L,bi,bj)*pinv(i,j)*86400
200        enddo         enddo
201        enddo         enddo
202           call diagnostics_fill(tmpdiag,'DIABT   ',L,1,3,bi,bj,myid)
203        endif        endif
204                                                                      
205  c Total Diabatic Q-Tendency (g/kg/day)  c Total Diabatic Q-Tendency (g/kg/day)
206  c ------------------------------------  c ------------------------------------
207        if( idiabq.ne.0 ) then        if(diagnostics_is_on('DIABQ   ',myid) ) then
208        do j=jm1,jm2         do j=jm1,jm2
209        do i=im1,im2         do i=im1,im2
210        qdiag(i,j,idiabq+L-1,bi,bj) =   qdiag(i,j,idiabq+L-1,bi,bj) +          tmpdiag(i,j) =
211       . ( 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) ) *
212       .                                      pinv(i,j)*86400*1000       .                                      pinv(i,j)*86400*1000
213        enddo         enddo
214        enddo         enddo
215           call diagnostics_fill(tmpdiag,'DIABQ   ',L,1,3,bi,bj,myid)
216        endif        endif
217            
218  c Longwave Heating (deg/day)  c Longwave Heating (deg/day)
219  c --------------------------  c --------------------------
220        if (iradlw.ne.0) then        if(diagnostics_is_on('RADLW   ',myid) ) then
221        do j=jm1,jm2         do j=jm1,jm2
222        do i=im1,im2         do i=im1,im2
223        qdiag(i,j,iradlw+l-1,bi,bj) = qdiag(i,j,iradlw+l-1,bi,bj) +          tmpdiag(i,j) =
224       . ( lwdt(i,j,l,bi,bj) +       . ( lwdt(i,j,l,bi,bj) +
225       .            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)) )
226       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400
227        enddo         enddo
228        enddo         enddo
229           call diagnostics_fill(tmpdiag,'RADLW   ',L,1,3,bi,bj,myid)
230        endif        endif
231                                                                                    
232  c Longwave Heating Clear-Sky (deg/day)  c Longwave Heating Clear-Sky (deg/day)
233  c ------------------------------------  c ------------------------------------
234        if (ilwclr.ne.0) then                                                            if(diagnostics_is_on('LWCLR   ',myid) ) then
235        do j=jm1,jm2         do j=jm1,jm2
236        do i=im1,im2         do i=im1,im2
237        qdiag(i,j,ilwclr+l-1,bi,bj) = qdiag(i,j,ilwclr+l-1,bi,bj) +          tmpdiag(i,j) =
238       . ( lwdtclr(i,j,l,bi,bj) +       . ( lwdtclr(i,j,l,bi,bj) +
239       .             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)) )
240       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                      * pk(i,j,l,bi,bj)*pinv(i,j)*86400
241        enddo         enddo
242        enddo         enddo
243           call diagnostics_fill(tmpdiag,'LWCLR   ',L,1,3,bi,bj,myid)
244        endif        endif
245                                                                                                                                                                    
246  c Solar Radiative Heating (deg/day)  c Solar Radiative Heating (deg/day)
247  c ---------------------------------  c ---------------------------------
248        if (iradsw.ne.0) then        if(diagnostics_is_on('RADSW   ',myid) ) then
249        do j=jm1,jm2         do j=jm1,jm2
250        do i=im1,im2         do i=im1,im2
251        qdiag(i,j,iradsw+l-1,bi,bj) = qdiag(i,j,iradsw+l-1,bi,bj) +          tmpdiag(i,j) =
252       .  + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*       .  + swdt(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
253       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400
254        enddo         enddo
255        enddo         enddo
256           call diagnostics_fill(tmpdiag,'RADSW   ',L,1,3,bi,bj,myid)
257        endif        endif
258                                                                                                                                                                    
259  c Clear Sky Solar Radiative Heating (deg/day)  c Clear Sky Solar Radiative Heating (deg/day)
260  c -------------------------------------------  c -------------------------------------------
261        if (iswclr.ne.0) then        if(diagnostics_is_on('SWCLR   ',myid) ) then
262        do j=jm1,jm2         do j=jm1,jm2
263        do i=im1,im2         do i=im1,im2
264        qdiag(i,j,iswclr+l-1,bi,bj) = qdiag(i,j,iswclr+l-1,bi,bj) +          tmpdiag(i,j) =
265       .           swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*       .  + swdtclr(i,j,l,bi,bj)*radswt(i,j,bi,bj)*
266       .                           pk(i,j,l,bi,bj)*pinv(i,j)*86400       .                   pk(i,j,l,bi,bj)*pinv(i,j)*86400
267        enddo         enddo
268        enddo         enddo
269           call diagnostics_fill(tmpdiag,'SWCLR   ',L,1,3,bi,bj,myid)
270        endif        endif
271                                                                                                                                                                    
272  c Averaged U-Field (m/sec)  c Averaged U-Field (m/sec)
273  c ------------------------  c ------------------------
274        if( iuwnd.ne.0 ) then        if(diagnostics_is_on('UWND    ',myid) ) then
275        do j=jm1,jm2         do j=jm1,jm2
276        do i=im1,im2         do i=im1,im2
277        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)
278       .                                                 uphy(i,j,L,bi,bj)         enddo
279        enddo         enddo
280        enddo         call diagnostics_fill(tmpdiag,'UWND    ',L,1,3,bi,bj,myid)
281        endif        endif
282    
283  c Averaged V-Field (m/sec)  c Averaged V-Field (m/sec)
284  c ------------------------  c ------------------------
285        if( ivwnd.ne.0 ) then        if(diagnostics_is_on('VWND    ',myid) ) then
286        do j=jm1,jm2         do j=jm1,jm2
287        do i=im1,im2         do i=im1,im2
288        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)
289       .                                                 vphy(i,j,L,bi,bj)         enddo
290        enddo         enddo
291        enddo         call diagnostics_fill(tmpdiag,'VWND    ',L,1,3,bi,bj,myid)
292        endif        endif
293    
294  c Averaged T-Field (deg)  c Averaged T-Field (deg)
295  c ----------------------  c ----------------------
296        if( itmpu.ne.0 ) then        if(diagnostics_is_on('TMPU    ',myid) ) then
297        do j=jm1,jm2         do j=jm1,jm2
298        do i=im1,im2         do i=im1,im2
299        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)
300       .                               thphy(i,j,L,bi,bj)*pk(i,j,L,bi,bj)         enddo
301        enddo         enddo
302        enddo         call diagnostics_fill(tmpdiag,'TMPU    ',L,1,3,bi,bj,myid)
303        endif        endif
304                                                                                                                                                                    
305  c Averaged QQ-Field (m/sec)**2  c Averaged QQ-Field (m/sec)**2
306  c ----------------------------  c ----------------------------
307        if( itke.ne.0 ) then        if(diagnostics_is_on('TKE     ',myid) ) then
308        do j=jm1,jm2         do j=jm1,jm2
309        do i=im1,im2         do i=im1,im2
310        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)
311        enddo         enddo
312        enddo         enddo
313           call diagnostics_fill(tmpdiag,'TKE     ',L,1,3,bi,bj,myid)
314        endif        endif
315                                                                                                                                                                    
316  c Averaged Q-Field (g/kg)  c Averaged Q-Field (g/kg)
317  c -----------------------  c -----------------------
318        if( isphu.ne.0 ) then        if(diagnostics_is_on('SPHU    ',myid) ) then
319        do j=jm1,jm2         do j=jm1,jm2
320        do i=im1,im2         do i=im1,im2
321        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.
322       .                                            sphy(i,j,L,bi,bj)*1000         enddo
323        enddo         enddo
324        enddo         call diagnostics_fill(tmpdiag,'SPHU    ',L,1,3,bi,bj,myid)
325        endif        endif
326                                                                                                                                                                    
327        enddo        enddo
328    
       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  
   
329  C **********************************************************************          C **********************************************************************        
330    
331  c Vertically Averaged Moist-T Increment (K/day)  c Vertically Averaged Moist-T Increment (K/day)
332  c ---------------------------------------------  c ---------------------------------------------
333        if( ivdtmoist.ne.0 ) then        if(diagnostics_is_on('VDTMOIST',myid) ) then
334        do j=jm1,jm2         do j=jm1,jm2
335        do i=im1,im2         do i=im1,im2
336        qbar(i,j) = 0.0         qbar(i,j) = 0.0
337        enddo         enddo
338        enddo         enddo
339        do L=1,Nrphys         do L=1,Nrphys
340        do j=jm1,jm2         do j=jm1,jm2
341        do i=im1,im2         do i=im1,im2
342        qbar(i,j) = qbar(i,j) +         qbar(i,j) = qbar(i,j) +
343       .             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)
344        enddo         enddo
345        enddo         enddo
346        enddo         enddo
347        do j=jm1,jm2         do j=jm1,jm2
348        do i=im1,im2         do i=im1,im2
349        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
350       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
351        enddo         enddo
352        enddo         call diagnostics_fill(tmpdiag,'VDTMOIST',0,1,3,bi,bj,myid)
353        endif        endif
354    
355  c Vertically Averaged Turb-T Increment (K/day)  c Vertically Averaged Turb-T Increment (K/day)
356  c --------------------------------------------  c --------------------------------------------
357        if( ivdtturb.ne.0 ) then        if(diagnostics_is_on('VDTTURB ',myid) ) then
358        do j=jm1,jm2         do j=jm1,jm2
359        do i=im1,im2         do i=im1,im2
360        qbar(i,j) = 0.0         qbar(i,j) = 0.0
361        enddo         enddo
362        enddo         enddo
363        do L=1,Nrphys         do L=1,Nrphys
364        do j=jm1,jm2         do j=jm1,jm2
365        do i=im1,im2         do i=im1,im2
366        qbar(i,j) = qbar(i,j) +         qbar(i,j) = qbar(i,j) +
367       .             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)
368        enddo         enddo
369        enddo         enddo
370        enddo         enddo
371        do j=jm1,jm2         do j=jm1,jm2
372        do i=im1,im2         do i=im1,im2
373        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
374       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
375        enddo         enddo
376        enddo         call diagnostics_fill(tmpdiag,'VDTTURB ',0,1,3,bi,bj,myid)
377        endif        endif
378    
379  c Vertically Averaged RADLW Temperature Increment (K/day)  c Vertically Averaged RADLW Temperature Increment (K/day)
380  c -------------------------------------------------------  c -------------------------------------------------------
381        if( ivdtradlw.ne.0 ) then        if(diagnostics_is_on('VDTRADLW',myid) ) then
382        do j=jm1,jm2         do j=jm1,jm2
383        do i=im1,im2         do i=im1,im2
384        qbar(i,j) = 0.0         qbar(i,j) = 0.0
385        enddo         enddo
386        enddo         enddo
387        do L=1,Nrphys         do L=1,Nrphys
388        do j=jm1,jm2         do j=jm1,jm2
389        do i=im1,im2         do i=im1,im2
390        qbar(i,j) = qbar(i,j) + ( lwdt(i,j,L,bi,bj) +          qbar(i,j) = qbar(i,j) + ( lwdt(i,j,L,bi,bj) +
391       .  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)) )
392       .             *pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)       .             *pk(i,j,l,bi,bj)*dp(i,j,L,bi,bj)
393        enddo         enddo
394        enddo         enddo
395        enddo         enddo
396        do j=jm1,jm2         do j=jm1,jm2
397        do i=im1,im2         do i=im1,im2
398        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
399       .      qbar(i,j)*pinv(i,j)*pinv(i,j)*86400         enddo
400        enddo         enddo
401        enddo         call diagnostics_fill(tmpdiag,'VDTRADLW',0,1,3,bi,bj,myid)
402        endif        endif
403    
404  c Vertically Averaged RADSW Temperature Increment (K/day)  c Vertically Averaged RADSW Temperature Increment (K/day)
405  c -------------------------------------------------------  c -------------------------------------------------------
406        if( ivdtradsw.ne.0 ) then        if(diagnostics_is_on('VDTRADSW',myid) ) then
407        do j=jm1,jm2         do j=jm1,jm2
408        do i=im1,im2         do i=im1,im2
409        qbar(i,j) = 0.0         qbar(i,j) = 0.0
410        enddo         enddo
411        enddo         enddo
412        do L=1,Nrphys         do L=1,Nrphys
413        do j=jm1,jm2         do j=jm1,jm2
414        do i=im1,im2         do i=im1,im2
415        qbar(i,j) = qbar(i,j) +          qbar(i,j) = qbar(i,j) +
416       .             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)
417        enddo         enddo
418        enddo         enddo
419        enddo         enddo
420        do j=jm1,jm2         do j=jm1,jm2
421        do i=im1,im2         do i=im1,im2
422        qdiag(i,j,ivdtradsw,bi,bj) = qdiag(i,j,ivdtradsw,bi,bj) +         tmpdiag(i,j) = qbar(i,j) *
423       . 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
424        enddo         enddo
425        enddo         enddo
426           call diagnostics_fill(tmpdiag,'VDTRADSW',0,1,3,bi,bj,myid)
427        endif        endif
428    
429        nvdtmoist = nvdtmoist + 1  #endif
       nvdtturb  = nvdtturb  + 1  
       nvdtradlw = nvdtradlw + 1  
       nvdtradsw = nvdtradsw + 1  
   
430        return        return
431        end        end
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22