/[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

trunk/libf/phylmd/Orography/orodrag.f90 revision 54 by guez, Tue Dec 6 15:07:04 2011 UTC trunk/Sources/phylmd/Orography/orodrag.f revision 178 by guez, Fri Mar 11 18:47:26 2016 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    
5        USE dimens_m        USE dimens_m
6        USE dimphy        USE dimphy
7          use gwstress_m, only: gwstress
8        USE suphec_m        USE suphec_m
9        USE yoegwd        USE yoegwd
10        use gwprofil_m, only: gwprofil        use gwprofil_m, only: gwprofil
11          use orosetup_m, only: orosetup
12        IMPLICIT NONE        IMPLICIT NONE
13    
14    
# Line 40  Line 42 
42  !     method.  !     method.
43  !     -------  !     -------
44    
 !     externals.  
 !     ----------  
       INTEGER ismin, ismax  
       EXTERNAL ismin, ismax  
   
45  !     reference.  !     reference.
46  !     ----------  !     ----------
47    
# Line 62  Line 59 
59  !              ---------  !              ---------
60    
61    
62        INTEGER nlon, nlev, klevm1        INTEGER nlon, nlev
63        INTEGER kgwd, jl, ilevp1, jk, ji        INTEGER jl, ilevp1, jk, ji
64        REAL zdelp, ztemp, zforc, ztend        REAL zdelp, ztemp, zforc, ztend
65        REAL rover, zb, zc, zconb, zabsv        REAL rover, zb, zc, zconb, zabsv
66        REAL zzd1, ratio, zbet, zust, zvst, zdis        REAL zzd1, ratio, zbet, zust, zvst, zdis
# Line 75  Line 72 
72        REAL pgamma(nlon), ptheta(nlon), ppic(nlon), pval(nlon), &        REAL pgamma(nlon), ptheta(nlon), ppic(nlon), pval(nlon), &
73          pgeom1(nlon,nlev), papm1(nlon,nlev), paphm1(nlon,nlev+1)          pgeom1(nlon,nlev), papm1(nlon,nlev), paphm1(nlon,nlev+1)
74    
75        INTEGER kdx(nlon), ktest(nlon)        INTEGER ktest(nlon)
76  !-----------------------------------------------------------------------  !-----------------------------------------------------------------------
77    
78  !*       0.2   local arrays  !*       0.2   local arrays
79  !              ------------  !              ------------
80        INTEGER isect(klon), icrit(klon), ikcrith(klon), ikenvh(klon), &        INTEGER icrit(klon), ikcrith(klon), ikenvh(klon), &
81          iknu(klon), iknu2(klon), ikcrit(klon), ikhlim(klon)          iknu(klon), iknu2(klon), ikcrit(klon)
82    
83        REAL ztau(klon,klev+1), ztauf(klon,klev+1), zstab(klon,klev+1), &        REAL ztau(klon,klev+1), zstab(klon,klev+1), &
84          zvph(klon,klev+1), zrho(klon,klev+1), zri(klon,klev+1), &          zvph(klon,klev+1), zrho(klon,klev+1), zri(klon,klev+1), &
85          zpsi(klon,klev+1), zzdep(klon,klev)          zpsi(klon,klev+1), zzdep(klon,klev)
86        REAL zdudt(klon), zdvdt(klon), zdtdt(klon), zdedt(klon), zvidis(klon), &        REAL zdudt(klon), zdvdt(klon), zvidis(klon), &
87          znu(klon), zd1(klon), zd2(klon), zdmod(klon)          znu(klon), zd1(klon), zd2(klon), zdmod(klon)
88        REAL ztmst, zrtmst        REAL ztmst
89        REAL, INTENT (IN) :: ptsphy        REAL, INTENT (IN) :: ptsphy
90    
91  !------------------------------------------------------------------  !------------------------------------------------------------------
# Line 96  Line 93 
93  !*         1.    initialization  !*         1.    initialization
94  !                --------------  !                --------------
95    
 100   CONTINUE  
   
 !     ------------------------------------------------------------------  
   
96  !*         1.1   computational constants  !*         1.1   computational constants
97  !                -----------------------  !                -----------------------
98    
 110   CONTINUE  
   
 !     ztmst=twodt  
 !     if(nstep.eq.nstart) ztmst=0.5*twodt  
       klevm1 = klev - 1  
99        ztmst = ptsphy        ztmst = ptsphy
       zrtmst = 1./ztmst  
 !     ------------------------------------------------------------------  
   
 120   CONTINUE  
   
100  !     ------------------------------------------------------------------  !     ------------------------------------------------------------------
101    
102  !*         1.3   check whether row contains point for printing  !*         1.3   check whether row contains point for printing
103  !                ---------------------------------------------  !                ---------------------------------------------
104    
 130   CONTINUE  
   
 !     ------------------------------------------------------------------  
   
105  !*         2.     precompute basic state variables.  !*         2.     precompute basic state variables.
106  !*                ---------- ----- ----- ----------  !*                ---------- ----- ----- ----------
107  !*                define low level wind, project winds in plane of  !*                define low level wind, project winds in plane of
108  !*                low level wind, determine sector in which to take  !*                low level wind, determine sector in which to take
109  !*                the variance and set indicator for critical levels.  !*                the variance and set indicator for critical levels.
110    
 200   CONTINUE  
   
   
111    
112        CALL orosetup(nlon,ktest,ikcrit,ikcrith,icrit,ikenvh,iknu,iknu2,paphm1, &        CALL orosetup(nlon,ktest,ikcrit,ikcrith,icrit,ikenvh,iknu,iknu2,paphm1, &
113          papm1,pum1,pvm1,ptm1,pgeom1,pstd,zrho,zri,zstab,ztau,zvph,zpsi,zzdep, &          papm1,pum1,pvm1,ptm1,pgeom1,zrho,zri,zstab,ztau,zvph,zpsi,zzdep, &
114          pulow,pvlow,ptheta,pgamma,pmea,ppic,pval,znu,zd1,zd2,zdmod)          pulow,pvlow,ptheta,pgamma,pmea,ppic,pval,znu,zd1,zd2,zdmod)
115    
116    
# Line 146  Line 122 
122  !*                 supercritical forms.computes anisotropy coefficient  !*                 supercritical forms.computes anisotropy coefficient
123  !*                 as measure of orographic twodimensionality.  !*                 as measure of orographic twodimensionality.
124    
125  300   CONTINUE        CALL gwstress(nlon,nlev,ktest,ikenvh,zrho,zstab,zvph,pstd, &
   
       CALL gwstress(nlon,nlev,ktest,icrit,ikenvh,iknu,zrho,zstab,zvph,pstd, &  
126          psig,pmea,ppic,ztau,pgeom1,zdmod)          psig,pmea,ppic,ztau,pgeom1,zdmod)
127    
128    
129  !*         4.      compute stress profile.  !*         4.      compute stress profile.
130  !*                 ------- ------ --------  !*                 ------- ------ --------
131    
132  400   CONTINUE        CALL gwprofil(nlon,nlev,ktest,ikcrith,icrit,paphm1,zrho,zstab, &
   
   
       CALL gwprofil(nlon,nlev,kgwd,kdx,ktest,ikcrith,icrit,paphm1,zrho,zstab, &  
133          zvph,zri,ztau,zdmod,psig,pstd)          zvph,zri,ztau,zdmod,psig,pstd)
134    
135    
136  !*         5.      compute tendencies.  !*         5.      compute tendencies.
137  !*                 -------------------  !*                 -------------------
138    
 500   CONTINUE  
   
139  !  explicit solution at all levels for the gravity wave  !  explicit solution at all levels for the gravity wave
140  !  implicit solution for the blocked levels  !  implicit solution for the blocked levels
141    
# Line 174  Line 143 
143          zvidis(jl) = 0.0          zvidis(jl) = 0.0
144          zdudt(jl) = 0.0          zdudt(jl) = 0.0
145          zdvdt(jl) = 0.0          zdvdt(jl) = 0.0
         zdtdt(jl) = 0.0  
146  510   CONTINUE  510   CONTINUE
147    
148        ilevp1 = klev + 1        ilevp1 = klev + 1
# Line 183  Line 151 
151        DO 524 jk = 1, klev        DO 524 jk = 1, klev
152    
153    
 !     do 523 jl=1,kgwd  
 !     ji=kdx(jl)  
154  !  Modif vectorisation 02/04/2004  !  Modif vectorisation 02/04/2004
155          DO 523 ji = 1, klon          DO 523 ji = 1, klon
156            IF (ktest(ji)==1) THEN            IF (ktest(ji)==1) THEN
# Line 236  Line 202 
202              zust = pum1(ji,jk) + ztmst*zdudt(ji)              zust = pum1(ji,jk) + ztmst*zdudt(ji)
203              zvst = pvm1(ji,jk) + ztmst*zdvdt(ji)              zvst = pvm1(ji,jk) + ztmst*zdvdt(ji)
204              zdis = 0.5*(pum1(ji,jk)**2+pvm1(ji,jk)**2-zust**2-zvst**2)              zdis = 0.5*(pum1(ji,jk)**2+pvm1(ji,jk)**2-zust**2-zvst**2)
             zdedt(ji) = zdis/ztmst  
205              zvidis(ji) = zvidis(ji) + zdis*zdelp              zvidis(ji) = zvidis(ji) + zdis*zdelp
             zdtdt(ji) = zdedt(ji)/rcpd  
 !     pte(ji,jk)=zdtdt(ji)  
206    
207  !  ENCORE UN TRUC POUR EVITER LES EXPLOSIONS  !  ENCORE UN TRUC POUR EVITER LES EXPLOSIONS
208    
Legend:
Removed from v.54  
changed lines
  Added in v.178
  ViewVC Help
Powered by ViewVC 1.1.21