/[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.6 by molod, Tue May 31 20:14:37 2005 UTC revision 1.10 by ce107, Fri Jun 17 16:51:24 2005 UTC
# Line 120  c ----------------------- Line 120  c -----------------------
120        enddo        enddo
121        enddo        enddo
122    
       if(diagnostics_is_on('SDIAG1  ',myid) ) then  
        do j=1,jm  
        do i=1,im  
         tmpdiag(i,j) = float(nthin(i,j))  
        enddo  
        enddo  
        call diagnostics_fill(tmpdiag,'SDIAG1  ',0,1,3,bi,bj,myid)  
       endif  
       if(diagnostics_is_on('SDIAG2  ',myid) ) then  
        do j=1,jm  
        do i=1,im  
         tmpdiag(i,j) = float(nbase(i,j))  
        enddo  
        enddo  
        call diagnostics_fill(tmpdiag,'SDIAG2  ',0,1,3,bi,bj,myid)  
       endif  
   
123  c Compute Topography Sub-Grid Standard Deviation  c Compute Topography Sub-Grid Standard Deviation
124  c        and constrain the Maximum Value  c        and constrain the Maximum Value
125  c ----------------------------------------------  c ----------------------------------------------
126        do j=1,jm        do j=1,jm
127        do i=1,im        do i=1,im
128        phis_std(i,j) = min( 400.0, sqrt( max(0.0,phis_var(i,j)) )/grav )           phis_std(i,j) = min( 400.0 _d 0, sqrt( max(0.0 _d 0,
129         $        phis_var(i,j)) )/grav )
130        enddo        enddo
131        enddo        enddo
132    
       if(diagnostics_is_on('SDIAG3  ',myid) ) then  
        do j=1,jm  
        do i=1,im  
         tmpdiag(i,j) = phis_std(i,j)  
        enddo  
        enddo  
        call diagnostics_fill(tmpdiag,'SDIAG3  ',0,1,3,bi,bj,myid)  
       endif  
   
133  c Compute Virtual Temperatures  c Compute Virtual Temperatures
134  c ----------------------------  c ----------------------------
135        do L = 1,Lm        do L = 1,Lm
# Line 180  c -------------------------------------- Line 155  c --------------------------------------
155    
156        do n=1,npcs        do n=1,npcs
157    
158        call strip ( phis_std,std,im*jm,istrip,1,n )        call stripit ( phis_std,std,im*jm,im*jm,istrip,1,n )
159    
160        call strip ( pz,ps,im*jm,istrip,1 ,n )        call stripit ( pz,ps,im*jm,im*jm,istrip,1 ,n )
161        call strip ( uz,us,im*jm,istrip,Lm,n )        call stripit ( uz,us,im*jm,im*jm,istrip,Lm,n )
162        call strip ( vz,vs,im*jm,istrip,Lm,n )        call stripit ( vz,vs,im*jm,im*jm,istrip,Lm,n )
163        call strip ( tv,ts,im*jm,istrip,Lm,n )        call stripit ( tv,ts,im*jm,im*jm,istrip,Lm,n )
164        call strip ( pl,plstr,im*jm,istrip,Lm,n )        call stripit ( pl,plstr,im*jm,im*jm,istrip,Lm,n )
165        call strip ( ple,plestr,im*jm,istrip,Lm,n )        call stripit ( ple,plestr,im*jm,im*jm,istrip,Lm,n )
166        call strip ( dpres,dpresstr,im*jm,istrip,Lm,n )        call stripit ( dpres,dpresstr,im*jm,im*jm,istrip,Lm,n )
167        call stripint ( nthin,nthinstr,im*jm,istrip,1,n )        call stripitint ( nthin,nthinstr,im*jm,im*jm,istrip,1,n )
168        call stripint ( nbase,nbasestr,im*jm,istrip,1,n )        call stripitint ( nbase,nbasestr,im*jm,im*jm,istrip,1,n )
169    
170        call GWDD ( ps,us,vs,ts,        call GWDD ( ps,us,vs,ts,
171       .            dragus,dragvs,dragxs,dragys,std,       .            dragus,dragvs,dragxs,dragys,std,
172       .            plstr,plestr,dpresstr,grav,rgas,cp,       .            plstr,plestr,dpresstr,grav,rgas,cp,
173       .            istrip,Lm,nthinstr,nbasestr,lstar )       .            istrip,Lm,nthinstr,nbasestr,lstar )
174    
175        call paste ( dragus,dragu,istrip,im*jm,Lm,n )        call pastit( dragus,dragu,istrip,im*jm,im*jm,Lm,n )
176        call paste ( dragvs,dragv,istrip,im*jm,Lm,n )        call pastit( dragvs,dragv,istrip,im*jm,im*jm,Lm,n )
177        call paste ( dragxs,dragx,istrip,im*jm,1 ,n )        call pastit( dragxs,dragx,istrip,im*jm,im*jm,1 ,n )
178        call paste ( dragys,dragy,istrip,im*jm,1 ,n )        call pastit( dragys,dragy,istrip,im*jm,im*jm,1 ,n )
179    
180        enddo        enddo
181    
# Line 209  c -------------------------------------- Line 184  c --------------------------------------
184        do L = 1,Lm        do L = 1,Lm
185        do j = 1,jm        do j = 1,jm
186        do i = 1,im        do i = 1,im
187        dragu(i,j,L) = sign( min(0.006,abs(dragu(i,j,L))),dragu(i,j,L) )           dragu(i,j,L) = sign( min(0.006 _d 0,abs(dragu(i,j,L))), dragu(i
188        dragv(i,j,L) = sign( min(0.006,abs(dragv(i,j,L))),dragv(i,j,L) )       $        ,j,L) )
189             dragv(i,j,L) = sign( min(0.006 _d 0,abs(dragv(i,j,L))), dragv(i
190         $        ,j,L) )
191        dragt(i,j,L) = -( uz(i,j,L)*dragu(i,j,L)+vz(i,j,L)*dragv(i,j,L) )        dragt(i,j,L) = -( uz(i,j,L)*dragu(i,j,L)+vz(i,j,L)*dragv(i,j,L) )
192       .                                                         *cpinv       .                                                         *cpinv
193         dudt(i,j,L) = dudt(i,j,L) + dragu(i,j,L)         dudt(i,j,L) = dudt(i,j,L) + dragu(i,j,L)
# Line 440  c --------------------------------- Line 417  c ---------------------------------
417        enddo        enddo
418    
419        do  i = 1,irun        do  i = 1,irun
420         robar(i) = robar(i)/(ps(i)-ple(i,Lm+1-nbase(i)-1)) * 100.0         robar(i) = robar(i)/(ps(i)-ple(i,Lm+1-(nbase(i)-1))) * 100.0
421         ubar(i) = ubar(i)/(ps(i)-ple(i,Lm+1-nbase(i)-1))         ubar(i) = ubar(i)/(ps(i)-ple(i,Lm+1-(nbase(i)-1)))
422         vbar(i) = vbar(i)/(ps(i)-ple(i,Lm+1-nbase(i)-1))         vbar(i) = vbar(i)/(ps(i)-ple(i,Lm+1-(nbase(i)-1)))
423    
424         speed(i) = sqrt( ubar(i)*ubar(i) + vbar(i)*vbar(i) )         speed(i) = sqrt( ubar(i)*ubar(i) + vbar(i)*vbar(i) )
425         ang(i) = atan2(vbar(i),ubar(i))         ang(i) = atan2(vbar(i),ubar(i))
# Line 550  c exceeds the Critical Froude number Line 527  c exceeds the Critical Froude number
527  c ----------------------------------  c ----------------------------------
528          crifro = 1.0 - 0.25/richsn          crifro = 1.0 - 0.25/richsn
529          crif2 = crifro*crifro          crif2 = crifro*crifro
530          if( l.eq.2 ) crif2 = min(0.7,crif2)          if( l.eq.2 ) crif2 = min(0.7 _d 0,crif2)
531    
532          if( fro2.gt.crif2 ) then          if( fro2.gt.crif2 ) then
533           tensio(i,L) = crif2/fro2*tensio(i,L-1)           tensio(i,L) = crif2/fro2*tensio(i,L-1)
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22