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

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

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

revision 226 by guez, Wed Apr 29 15:47:56 2015 UTC revision 227 by guez, Thu Nov 2 15:47:03 2017 UTC
# Line 1  Line 1 
1      SUBROUTINE lift_noro(nlon,nlev,dtime,paprs,pplay,plat,pmea,pstd,ppic, &  module lift_noro_m
         ktest,t,u,v,pulow,pvlow,pustr,pvstr,d_t,d_u,d_v)  
2    
3        USE dimens_m    IMPLICIT NONE
       USE dimphy  
       USE suphec_m  
       IMPLICIT NONE  
 !======================================================================  
 ! Auteur(s): F.Lott (LMD/CNRS) date: 19950201  
 ! Objet: Frottement de la montagne Interface  
 !======================================================================  
 ! Arguments:  
 ! dtime---input-R- pas d'integration (s)  
 ! paprs---input-R-pression pour chaque inter-couche (en Pa)  
 ! pplay---input-R-pression pour le mileu de chaque couche (en Pa)  
 ! t-------input-R-temperature (K)  
 ! u-------input-R-vitesse horizontale (m/s)  
 ! v-------input-R-vitesse horizontale (m/s)  
   
 ! d_t-----output-R-increment de la temperature  
 ! d_u-----output-R-increment de la vitesse u  
 ! d_v-----output-R-increment de la vitesse v  
 !======================================================================  
   
 ! ARGUMENTS  
   
       INTEGER nlon, nlev  
       REAL, INTENT (IN) :: dtime  
       REAL, INTENT (IN) :: paprs(klon,klev+1)  
       REAL, INTENT (IN) :: pplay(klon,klev)  
       REAL, INTENT (IN) :: plat(nlon)  
       REAL pmea(nlon)  
       REAL, INTENT (IN):: pstd(nlon)  
       REAL ppic(nlon)  
       REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon)  
       REAL, INTENT (IN):: t(nlon,nlev)  
       real, INTENT (IN):: u(nlon,nlev), v(nlon,nlev)  
       REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev)  
   
       INTEGER i, k, ktest(nlon)  
   
 ! Variables locales:  
   
       REAL zgeom(klon,klev)  
       REAL pdtdt(klon,klev), pdudt(klon,klev), pdvdt(klon,klev)  
       REAL pt(klon,klev), pu(klon,klev), pv(klon,klev)  
       REAL papmf(klon,klev), papmh(klon,klev+1)  
   
 ! initialiser les variables de sortie (pour securite)  
   
       DO i = 1, klon  
         pulow(i) = 0.0  
         pvlow(i) = 0.0  
         pustr(i) = 0.0  
         pvstr(i) = 0.0  
       END DO  
       DO k = 1, klev  
         DO i = 1, klon  
           d_t(i,k) = 0.0  
           d_u(i,k) = 0.0  
           d_v(i,k) = 0.0  
           pdudt(i,k) = 0.0  
           pdvdt(i,k) = 0.0  
           pdtdt(i,k) = 0.0  
         END DO  
       END DO  
   
 ! preparer les variables d'entree (attention: l'ordre des niveaux  
 ! verticaux augmente du haut vers le bas)  
   
       DO k = 1, klev  
         DO i = 1, klon  
           pt(i,k) = t(i,klev-k+1)  
           pu(i,k) = u(i,klev-k+1)  
           pv(i,k) = v(i,klev-k+1)  
           papmf(i,k) = pplay(i,klev-k+1)  
         END DO  
       END DO  
       DO k = 1, klev + 1  
         DO i = 1, klon  
           papmh(i,k) = paprs(i,klev-k+2)  
         END DO  
       END DO  
       DO i = 1, klon  
         zgeom(i,klev) = rd*pt(i,klev)*log(papmh(i,klev+1)/papmf(i,klev))  
       END DO  
       DO k = klev - 1, 1, -1  
         DO i = 1, klon  
           zgeom(i,k) = zgeom(i,k+1) + rd*(pt(i,k)+pt(i,k+1))/2.0*log(papmf(i,k &  
             +1)/papmf(i,k))  
         END DO  
       END DO  
   
 ! appeler la routine principale  
   
       CALL orolift(klon,klev,ktest,dtime,papmh,zgeom,pt,pu,pv,plat,pmea,pstd, &  
         ppic,pulow,pvlow,pdudt,pdvdt,pdtdt)  
   
       DO k = 1, klev  
         DO i = 1, klon  
           d_u(i,klev+1-k) = dtime*pdudt(i,k)  
           d_v(i,klev+1-k) = dtime*pdvdt(i,k)  
           d_t(i,klev+1-k) = dtime*pdtdt(i,k)  
           pustr(i) = pustr(i) &  
              + pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg  
           pvstr(i) = pvstr(i) &  
              + pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg  
         END DO  
       END DO  
4    
5        RETURN  contains
6      END  
7      SUBROUTINE lift_noro(dtime, paprs, pplay, pmea, pstd, ppic, ktest, t, u, v, &
8           pulow, pvlow, pustr, pvstr, d_t, d_u, d_v)
9    
10        ! Author: F.Lott (LMD/CNRS) date: 1995/02/01
11        ! Objet: Frottement de la montagne, interface
12    
13        USE dimphy, only: klon, klev
14        use phyetat0_m, only: rlat
15        USE suphec_m, only: rd, rg
16        
17        REAL, INTENT (IN) :: dtime
18        ! dtime---input-R- pas d'integration (s)
19        REAL, INTENT (IN) :: paprs(klon, klev + 1)
20        ! paprs---input-R-pression pour chaque inter-couche (en Pa)
21        REAL, INTENT (IN) :: pplay(klon, klev)
22        ! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
23        REAL pmea(klon)
24        REAL, INTENT (IN):: pstd(klon)
25        REAL ppic(klon)
26        integer ktest(klon)
27        REAL, INTENT (IN):: t(klon, klev)
28        ! t-------input-R-temperature (K)
29        real, INTENT (IN):: u(klon, klev), v(klon, klev)
30        ! u-------input-R-vitesse horizontale (m / s)
31        ! v-------input-R-vitesse horizontale (m / s)
32        REAL pulow(klon), pvlow(klon), pustr(klon), pvstr(klon)
33        REAL d_t(klon, klev), d_u(klon, klev), d_v(klon, klev)
34        ! d_t-----output-R-increment de la temperature
35        ! d_u-----output-R-increment de la vitesse u
36        ! d_v-----output-R-increment de la vitesse v
37    
38        ! Local:
39        INTEGER i, k
40        REAL zgeom(klon, klev)
41        REAL pdtdt(klon, klev), pdudt(klon, klev), pdvdt(klon, klev)
42        REAL pt(klon, klev), pu(klon, klev), pv(klon, klev)
43        REAL papmf(klon, klev), papmh(klon, klev + 1)
44    
45        !----------------------------------------------------------------------
46    
47        ! initialiser les variables de sortie (pour securite)
48    
49        DO i = 1, klon
50           pulow(i) = 0.0
51           pvlow(i) = 0.0
52           pustr(i) = 0.0
53           pvstr(i) = 0.0
54        END DO
55        DO k = 1, klev
56           DO i = 1, klon
57              d_t(i, k) = 0.0
58              d_u(i, k) = 0.0
59              d_v(i, k) = 0.0
60              pdudt(i, k) = 0.0
61              pdvdt(i, k) = 0.0
62              pdtdt(i, k) = 0.0
63           END DO
64        END DO
65    
66        ! preparer les variables d'entree (attention: l'ordre des niveaux
67        ! verticaux augmente du haut vers le bas)
68    
69        DO k = 1, klev
70           DO i = 1, klon
71              pt(i, k) = t(i, klev-k + 1)
72              pu(i, k) = u(i, klev-k + 1)
73              pv(i, k) = v(i, klev-k + 1)
74              papmf(i, k) = pplay(i, klev-k + 1)
75           END DO
76        END DO
77        DO k = 1, klev + 1
78           DO i = 1, klon
79              papmh(i, k) = paprs(i, klev-k + 2)
80           END DO
81        END DO
82        DO i = 1, klon
83           zgeom(i, klev) = rd * pt(i, klev) &
84                * log(papmh(i, klev + 1) / papmf(i, klev))
85        END DO
86        DO k = klev - 1, 1, -1
87           DO i = 1, klon
88              zgeom(i, k) = zgeom(i, k + 1) + rd * (pt(i, k) + pt(i, k + 1)) &
89                   / 2. * log(papmf(i, k + 1) / papmf(i, k))
90           END DO
91        END DO
92    
93        ! appeler la routine principale
94    
95        CALL orolift(klon, klev, ktest, dtime, papmh, zgeom, pt, pu, pv, rlat, &
96             pmea, pstd, ppic, pulow, pvlow, pdudt, pdvdt, pdtdt)
97    
98        DO k = 1, klev
99           DO i = 1, klon
100              d_u(i, klev + 1-k) = dtime * pdudt(i, k)
101              d_v(i, klev + 1-k) = dtime * pdvdt(i, k)
102              d_t(i, klev + 1-k) = dtime * pdtdt(i, k)
103              pustr(i) = pustr(i) &
104                   + pdudt(i, k) * (papmh(i, k + 1)-papmh(i, k)) / rg
105              pvstr(i) = pvstr(i) &
106                   + pdvdt(i, k) * (papmh(i, k + 1)-papmh(i, k)) / rg
107           END DO
108        END DO
109    
110      END SUBROUTINE lift_noro
111    
112    end module lift_noro_m
Legend:
Removed from v.226  
changed lines
  Added in v.227
  ViewVC Help
Powered by ViewVC 1.1.21