/[lmdze]/trunk/Sources/phylmd/Orography/orodrag.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Orography/orodrag.f

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

revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 150 by guez, Thu Jun 18 13:49:26 2015 UTC
# Line 1  Line 1 
1      SUBROUTINE orodrag(nlon,nlev,kgwd,kdx,ktest,ptsphy,paphm1,papm1,pgeom1, &      SUBROUTINE orodrag(nlon,nlev,ktest,ptsphy,paphm1,papm1,pgeom1, &
2          ptm1,pum1,pvm1,pmea,pstd,psig,pgamma,ptheta,ppic,pval &          ptm1,pum1,pvm1,pmea,pstd,psig,pgamma,ptheta,ppic,pval &
3          ,pulow,pvlow,pvom,pvol,pte)          ,pulow,pvlow,pvom,pvol,pte)
4    
# Line 63  Line 63 
63    
64    
65        INTEGER nlon, nlev, klevm1        INTEGER nlon, nlev, klevm1
66        INTEGER kgwd, jl, ilevp1, jk, ji        INTEGER jl, ilevp1, jk, ji
67        REAL zdelp, ztemp, zforc, ztend        REAL zdelp, ztemp, zforc, ztend
68        REAL rover, zb, zc, zconb, zabsv        REAL rover, zb, zc, zconb, zabsv
69        REAL zzd1, ratio, zbet, zust, zvst, zdis        REAL zzd1, ratio, zbet, zust, zvst, zdis
# Line 75  Line 75 
75        REAL pgamma(nlon), ptheta(nlon), ppic(nlon), pval(nlon), &        REAL pgamma(nlon), ptheta(nlon), ppic(nlon), pval(nlon), &
76          pgeom1(nlon,nlev), papm1(nlon,nlev), paphm1(nlon,nlev+1)          pgeom1(nlon,nlev), papm1(nlon,nlev), paphm1(nlon,nlev+1)
77    
78        INTEGER kdx(nlon), ktest(nlon)        INTEGER ktest(nlon)
79  !-----------------------------------------------------------------------  !-----------------------------------------------------------------------
80    
81  !*       0.2   local arrays  !*       0.2   local arrays
82  !              ------------  !              ------------
83        INTEGER isect(klon), icrit(klon), ikcrith(klon), ikenvh(klon), &        INTEGER icrit(klon), ikcrith(klon), ikenvh(klon), &
84          iknu(klon), iknu2(klon), ikcrit(klon), ikhlim(klon)          iknu(klon), iknu2(klon), ikcrit(klon)
85    
86        REAL ztau(klon,klev+1), ztauf(klon,klev+1), zstab(klon,klev+1), &        REAL ztau(klon,klev+1), zstab(klon,klev+1), &
87          zvph(klon,klev+1), zrho(klon,klev+1), zri(klon,klev+1), &          zvph(klon,klev+1), zrho(klon,klev+1), zri(klon,klev+1), &
88          zpsi(klon,klev+1), zzdep(klon,klev)          zpsi(klon,klev+1), zzdep(klon,klev)
89        REAL zdudt(klon), zdvdt(klon), zdtdt(klon), zdedt(klon), zvidis(klon), &        REAL zdudt(klon), zdvdt(klon), zdtdt(klon), zdedt(klon), zvidis(klon), &
# Line 96  Line 96 
96  !*         1.    initialization  !*         1.    initialization
97  !                --------------  !                --------------
98    
 100   CONTINUE  
   
 !     ------------------------------------------------------------------  
   
99  !*         1.1   computational constants  !*         1.1   computational constants
100  !                -----------------------  !                -----------------------
101    
 110   CONTINUE  
   
 !     ztmst=twodt  
 !     if(nstep.eq.nstart) ztmst=0.5*twodt  
102        klevm1 = klev - 1        klevm1 = klev - 1
103        ztmst = ptsphy        ztmst = ptsphy
104        zrtmst = 1./ztmst        zrtmst = 1./ztmst
105  !     ------------------------------------------------------------------  !     ------------------------------------------------------------------
106    
 120   CONTINUE  
   
 !     ------------------------------------------------------------------  
   
107  !*         1.3   check whether row contains point for printing  !*         1.3   check whether row contains point for printing
108  !                ---------------------------------------------  !                ---------------------------------------------
109    
 130   CONTINUE  
   
 !     ------------------------------------------------------------------  
   
110  !*         2.     precompute basic state variables.  !*         2.     precompute basic state variables.
111  !*                ---------- ----- ----- ----------  !*                ---------- ----- ----- ----------
112  !*                define low level wind, project winds in plane of  !*                define low level wind, project winds in plane of
113  !*                low level wind, determine sector in which to take  !*                low level wind, determine sector in which to take
114  !*                the variance and set indicator for critical levels.  !*                the variance and set indicator for critical levels.
115    
 200   CONTINUE  
   
   
116    
117        CALL orosetup(nlon,ktest,ikcrit,ikcrith,icrit,ikenvh,iknu,iknu2,paphm1, &        CALL orosetup(nlon,ktest,ikcrit,ikcrith,icrit,ikenvh,iknu,iknu2,paphm1, &
118          papm1,pum1,pvm1,ptm1,pgeom1,pstd,zrho,zri,zstab,ztau,zvph,zpsi,zzdep, &          papm1,pum1,pvm1,ptm1,pgeom1,pstd,zrho,zri,zstab,ztau,zvph,zpsi,zzdep, &
# Line 146  Line 127 
127  !*                 supercritical forms.computes anisotropy coefficient  !*                 supercritical forms.computes anisotropy coefficient
128  !*                 as measure of orographic twodimensionality.  !*                 as measure of orographic twodimensionality.
129    
 300   CONTINUE  
   
130        CALL gwstress(nlon,nlev,ktest,icrit,ikenvh,iknu,zrho,zstab,zvph,pstd, &        CALL gwstress(nlon,nlev,ktest,icrit,ikenvh,iknu,zrho,zstab,zvph,pstd, &
131          psig,pmea,ppic,ztau,pgeom1,zdmod)          psig,pmea,ppic,ztau,pgeom1,zdmod)
132    
# Line 155  Line 134 
134  !*         4.      compute stress profile.  !*         4.      compute stress profile.
135  !*                 ------- ------ --------  !*                 ------- ------ --------
136    
137  400   CONTINUE        CALL gwprofil(nlon,nlev,ktest,ikcrith,icrit,paphm1,zrho,zstab, &
   
   
       CALL gwprofil(nlon,nlev,kgwd,kdx,ktest,ikcrith,icrit,paphm1,zrho,zstab, &  
138          zvph,zri,ztau,zdmod,psig,pstd)          zvph,zri,ztau,zdmod,psig,pstd)
139    
140    
141  !*         5.      compute tendencies.  !*         5.      compute tendencies.
142  !*                 -------------------  !*                 -------------------
143    
 500   CONTINUE  
   
144  !  explicit solution at all levels for the gravity wave  !  explicit solution at all levels for the gravity wave
145  !  implicit solution for the blocked levels  !  implicit solution for the blocked levels
146    
# Line 183  Line 157 
157        DO 524 jk = 1, klev        DO 524 jk = 1, klev
158    
159    
 !     do 523 jl=1,kgwd  
 !     ji=kdx(jl)  
160  !  Modif vectorisation 02/04/2004  !  Modif vectorisation 02/04/2004
161          DO 523 ji = 1, klon          DO 523 ji = 1, klon
162            IF (ktest(ji)==1) THEN            IF (ktest(ji)==1) THEN
Legend:
Removed from v.134  
changed lines
  Added in v.150
  ViewVC Help
Powered by ViewVC 1.1.21