/[MITgcm]/MITgcm/pkg/fizhi/fizhi_gwdrag.F
ViewVC logotype

Diff of /MITgcm/pkg/fizhi/fizhi_gwdrag.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by molod, Fri May 20 23:50:52 2005 UTC revision 1.2 by molod, Sat May 21 23:50:13 2005 UTC
# Line 38  C Line 38  C
38  C***********************************************************************  C***********************************************************************
39        implicit none        implicit none
40    
 #ifdef ALLOW_DIAGNOSTICS  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
 #endif  
   
41  c Input Variables  c Input Variables
42  c ---------------  c ---------------
43        integer myid,im,jm,lm,bi,bj,istrip,npcs,imglobal        integer myid,im,jm,lm,bi,bj,istrip,npcs,imglobal
44        real pz(im,jm)        _RL pz(im,jm)
45        real pl(im,jm,lm)        _RL pl(im,jm,lm)
46        real ple(im,jm,lm+1)        _RL ple(im,jm,lm+1)
47        real dpres(im,jm,lm)        _RL dpres(im,jm,lm)
48        real pkz(im,jm,lm)        _RL pkz(im,jm,lm)
49        real uz(im,jm,lm)        _RL uz(im,jm,lm)
50        real vz(im,jm,lm)        _RL vz(im,jm,lm)
51        real tz(im,jm,lm)        _RL tz(im,jm,lm)
52        real qz(im,jm,lm)        _RL qz(im,jm,lm)
53        real phis_var(im,jm)        _RL phis_var(im,jm)
54    
55        real dudt(im,jm,lm)        _RL dudt(im,jm,lm)
56        real dvdt(im,jm,lm)        _RL dvdt(im,jm,lm)
57        real dtdt(im,jm,lm)        _RL dtdt(im,jm,lm)
58    
59  c Local Variables  c Local Variables
60  c ---------------  c ---------------
61        real tv(im,jm,lm)        _RL tv(im,jm,lm)
62        real dragu(im,jm,lm), dragv(im,jm,lm)        _RL dragu(im,jm,lm), dragv(im,jm,lm)
63        real dragt(im,jm,lm)        _RL dragt(im,jm,lm)
64        real dragx(im,jm), dragy(im,jm)        _RL dragx(im,jm), dragy(im,jm)
65        real sumu(im,jm)        _RL sumu(im,jm)
66        integer nthin(im,jm),nbase(im,jm)        integer nthin(im,jm),nbase(im,jm)
67        integer nthini, nbasei        integer nthini, nbasei
68    
69        real phis_std(im,jm)        _RL phis_std(im,jm)
70    
71        real std(istrip), ps(istrip)        _RL std(istrip), ps(istrip)
72        real us(istrip,lm), vs(istrip,lm), ts(istrip,lm)        _RL us(istrip,lm), vs(istrip,lm), ts(istrip,lm)
73        real dragus(istrip,lm), dragvs(istrip,lm)        _RL dragus(istrip,lm), dragvs(istrip,lm)
74        real dragxs(istrip), dragys(istrip)        _RL dragxs(istrip), dragys(istrip)
75        real plstr(istrip,lm),plestr(istrip,lm),dpresstr(istrip,lm)        _RL plstr(istrip,lm),plestr(istrip,lm),dpresstr(istrip,lm)
76        integer nthinstr(istrip),nbasestr(istrip)        integer nthinstr(istrip),nbasestr(istrip)
77    
78        integer n,i,j,L        integer n,i,j,L
79        real    getcon, pi        _RL getcon, pi
80        real    grav, rgas, cp, cpinv, lstar        _RL grav, rgas, cp, cpinv, lstar
81    #ifdef ALLOW_DIAGNOSTICS
82          logical  diagnostics_is_on
83          external diagnostics_is_on
84          _RL tmpdiag(im,jm)
85    #endif
86    
87  c Initialization  c Initialization
88  c --------------  c --------------
# Line 185  c -------------------------------------- Line 184  c --------------------------------------
184    
185  c Compute Diagnostics  c Compute Diagnostics
186  c -------------------  c -------------------
187        if( igwdu.ne.0 .or. igwdv.ne.0 .or. igwdt.ne.0 ) then  #ifdef ALLOW_DIAGNOSTICS
188        do L = 1,lm        do L = 1,lm
189         if( igwdu.ne.0 ) then  
190          do j = 1,jm        if(diagnostics_is_on('GWDU    ',myid) ) then
191          do i = 1,im         do j=1,jm
192          qdiag(i,j,igwdu+L-1,bi,bj) = qdiag(i,j,igwdu+L-1,bi,bj) +         do i=1,im
193       .                                         dragu(i,j,L)*86400          tmpdiag(i,j) = dragu(i,j,L)*86400
194          enddo         enddo
195          enddo         enddo
196         endif         call diagnostics_fill(tmpdiag,'GWDU    ',L,1,3,bi,bj,myid)
        if( igwdv.ne.0 ) then  
         do j = 1,jm  
         do i = 1,im  
         qdiag(i,j,igwdv+L-1,bi,bj) = qdiag(i,j,igwdv+L-1,bi,bj) +  
      .                                         dragv(i,j,L)*86400  
         enddo  
         enddo  
        endif  
        if( igwdt.ne.0 ) then  
         do j = 1,jm  
         do i = 1,im  
         qdiag(i,j,igwdt+L-1,bi,bj) = qdiag(i,j,igwdt+L-1,bi,bj) +  
      .                                         dragt(i,j,L)*86400  
         enddo  
         enddo  
        endif  
       enddo  
197        endif        endif
198    
199          if(diagnostics_is_on('GWDV    ',myid) ) then
200           do j=1,jm
201           do i=1,im
202            tmpdiag(i,j) = dragv(i,j,L)*86400
203           enddo
204           enddo
205           call diagnostics_fill(tmpdiag,'GWDV    ',L,1,3,bi,bj,myid)
206          endif
207    
208          if(diagnostics_is_on('GWDT    ',myid) ) then
209           do j=1,jm
210           do i=1,im
211            tmpdiag(i,j) = dragt(i,j,L)*86400
212           enddo
213           enddo
214           call diagnostics_fill(tmpdiag,'GWDT    ',L,1,3,bi,bj,myid)
215          endif
216    
217          enddo
218    
219  c Gravity Wave Drag at Surface (U-Wind)  c Gravity Wave Drag at Surface (U-Wind)
220  c -------------------------------------  c -------------------------------------
221        if( igwdus.ne.0 ) then        if(diagnostics_is_on('GWDUS   ',myid) ) then
222        do j = 1,jm         call diagnostics_fill(dragx,'GWDUS   ',0,1,3,bi,bj,myid)
       do i = 1,im  
       qdiag(i,j,igwdus,bi,bj) = qdiag(i,j,igwdus,bi,bj) + dragx(i,j)  
       enddo  
       enddo  
223        endif        endif
224    
225  c Gravity Wave Drag at Surface (V-Wind)  c Gravity Wave Drag at Surface (V-Wind)
226  c -------------------------------------  c -------------------------------------
227        if( igwdvs.ne.0 ) then        if(diagnostics_is_on('GWDVS   ',myid) ) then
228        do j = 1,jm         call diagnostics_fill(dragy,'GWDVS   ',0,1,3,bi,bj,myid)
       do i = 1,im  
       qdiag(i,j,igwdvs,bi,bj) = qdiag(i,j,igwdvs,bi,bj) + dragy(i,j)  
       enddo  
       enddo  
229        endif        endif
230    
231  c Gravity Wave Drag at Model Top (U-Wind)  c Gravity Wave Drag at Model Top (U-Wind)
232  c ---------------------------------------  c ---------------------------------------
233        if( igwdut.ne.0 ) then        if(diagnostics_is_on('GWDUT   ',myid) ) then
234        do j = 1,jm        do j = 1,jm
235        do i = 1,im        do i = 1,im
236        sumu(i,j) = 0.0        sumu(i,j) = 0.0
# Line 249  c -------------------------------------- Line 243  c --------------------------------------
243        enddo        enddo
244        enddo        enddo
245        enddo        enddo
246        do j = 1,jm         do j=1,jm
247        do i = 1,im         do i=1,im
248        qdiag(i,j,igwdut,bi,bj) = qdiag(i,j,igwdut,bi,bj) + dragx(i,j)          tmpdiag(i,j) = dragx(i,j) + sumu(i,j)*pz(i,j)/grav*100
249       .                  + sumu(i,j)*pz(i,j)/grav*100         enddo
250        enddo         enddo
251        enddo         call diagnostics_fill(tmpdiag,'GWDUT   ',0,1,3,bi,bj,myid)
252        endif        endif
253    
254  c Gravity Wave Drag at Model Top (V-Wind)  c Gravity Wave Drag at Model Top (V-Wind)
255  c ---------------------------------------  c ---------------------------------------
256        if( igwdvt.ne.0 ) then        if(diagnostics_is_on('GWDVT   ',myid) ) then
257        do j = 1,jm        do j = 1,jm
258        do i = 1,im        do i = 1,im
259        sumu(i,j) = 0.0        sumu(i,j) = 0.0
# Line 272  c -------------------------------------- Line 266  c --------------------------------------
266        enddo        enddo
267        enddo        enddo
268        enddo        enddo
269        do j = 1,jm         do j=1,jm
270        do i = 1,im         do i=1,im
271        qdiag(i,j,igwdvt,bi,bj) = qdiag(i,j,igwdvt,bi,bj) + dragy(i,j)          tmpdiag(i,j) = dragy(i,j) + sumu(i,j)*pz(i,j)/grav*100
272       .                  + sumu(i,j)*pz(i,j)/grav*100         enddo
273        enddo         enddo
274        enddo         call diagnostics_fill(tmpdiag,'GWDVT   ',0,1,3,bi,bj,myid)
275        endif        endif
276    #endif
       ngwdu  = ngwdu  + 1  
       ngwdv  = ngwdv  + 1  
       ngwdt  = ngwdt  + 1  
       ngwdus = ngwdus + 1  
       ngwdvs = ngwdvs + 1  
       ngwdut = ngwdut + 1  
       ngwdvt = ngwdvt + 1  
277    
278        return        return
279        end        end
# Line 331  C*************************************** Line 318  C***************************************
318  c Input Variables  c Input Variables
319  c ---------------  c ---------------
320        integer irun,lm        integer irun,lm
321        real ps(irun)        _RL ps(irun)
322        real u(irun,lm), v(irun,lm), t(irun,lm)        _RL u(irun,lm), v(irun,lm), t(irun,lm)
323        real dudt(irun,lm), dvdt(irun,lm)        _RL dudt(irun,lm), dvdt(irun,lm)
324        real xdrag(irun), ydrag(irun)        _RL xdrag(irun), ydrag(irun)
325        real std(irun)        _RL std(irun)
326        real ple(irun,lm+1), pl(irun,lm), dpres(irun,lm)        _RL ple(irun,lm+1), pl(irun,lm), dpres(irun,lm)
327        real grav, rgas, cp        _RL grav, rgas, cp
328        integer nthin(irun),nbase(irun)        integer nthin(irun),nbase(irun)
329        real lstar        _RL lstar
330    
331  c Dynamic Allocation Variables  c Dynamic Allocation Variables
332  c ----------------------------  c ----------------------------
333        real ubar(irun), vbar(irun), robar(irun)        _RL ubar(irun), vbar(irun), robar(irun)
334        real speed(irun), ang(irun)        _RL speed(irun), ang(irun)
335        real bv(irun,lm)        _RL bv(irun,lm)
336        real nbar(irun)        _RL nbar(irun)
337    
338        real tstd(irun)        _RL tstd(irun)
339        real XTENS(irun,lm+1), YTENS(irun,lm+1)        _RL XTENS(irun,lm+1), YTENS(irun,lm+1)
340        real TENSIO(irun,lm+1)        _RL TENSIO(irun,lm+1)
341        real DRAGSF(irun)        _RL DRAGSF(irun)
342        real RO(irun,lm), DZ(irun,lm)        _RL RO(irun,lm), DZ(irun,lm)
343    
344        integer icrilv(irun)        integer icrilv(irun)
345    
346  c Local Variables  c Local Variables
347  c ---------------  c ---------------
348        integer  i,l        integer  i,l
349        real a,g,stdmax,agrav,akwnmb        _RL a,g,stdmax,agrav,akwnmb
350        real gocp,roave,roiave,frsf,gstar,vai1,vai2        _RL gocp,roave,roiave,frsf,gstar,vai1,vai2
351        real vaisd,velco,deluu,delvv,delve2,delz,vsqua        _RL vaisd,velco,deluu,delvv,delve2,delz,vsqua
352        real richsn,crifro,crif2,fro2,coef        _RL richsn,crifro,crif2,fro2,coef
353    
354  c Initialization  c Initialization
355  c --------------  c --------------
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22