/[lmdze]/trunk/phylmd/Orography/drag_noro.f
ViewVC logotype

Diff of /trunk/phylmd/Orography/drag_noro.f

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

trunk/libf/phylmd/Orography/drag_noro.f90 revision 38 by guez, Thu Jan 6 17:52:19 2011 UTC trunk/phylmd/Orography/drag_noro.f revision 298 by guez, Thu Jul 26 16:45:51 2018 UTC
# Line 1  Line 1 
1      SUBROUTINE drag_noro(nlon,nlev,dtime,paprs,pplay,pmea,pstd,psig,pgam,pthe, &  module drag_noro_m
         ppic,pval,kgwd,kdx,ktest,t,u,v,pulow,pvlow,pustr,pvstr,d_t,d_u,d_v)  
2    
3      IMPLICIT NONE
4    
5  ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/orografi.F,v 1.4 2005/12/01 11:27:29  contains
6    
7        USE dimens_m    SUBROUTINE drag_noro(paprs, pplay, pmea, pstd, psig, pgam, pthe, ppic, pval, &
8        USE dimphy         ktest, t, u, v, pulow, pvlow, pustr, pvstr, d_t, d_u, d_v)
       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 pmea(nlon)  
       REAL, INTENT (IN) :: pstd(nlon), psig(nlon)  
       REAL pgam(nlon), pthe(nlon)  
       REAL ppic(nlon), pval(nlon)  
       REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon)  
       REAL t(nlon,nlev), u(nlon,nlev), v(nlon,nlev)  
       REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev)  
   
       INTEGER i, k, kgwd, kdx(nlon), 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 orodrag(klon,klev,kgwd,kdx,ktest,dtime,papmh,papmf,zgeom,pt,pu,pv, &  
         pmea,pstd,psig,pgam,pthe,ppic,pval,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  
9    
10        RETURN      ! From LMDZ4/libf/phylmd/orografi.F, version 1.4 2005/12/01 11:27:29
11      END  
12        ! Author: F. Lott (LMD/CNRS). Date: 1995/02/01.
13        ! Objet : frottement de la montagne, interface.
14    
15        use comconst, only: dtphys
16        USE dimphy, ONLY: klev, klon
17        use orodrag_m, only: orodrag
18        USE suphec_m, ONLY: rd, rg
19    
20        REAL, INTENT (IN):: paprs(klon, klev+1) ! pression pour chaque
21                                                 ! inter-couche (en Pa)
22        REAL, INTENT (IN):: pplay(klon, klev) ! pression pour le mileu de
23                                               ! chaque couche (en Pa)
24        REAL pmea(klon)
25        REAL, INTENT (IN):: pstd(klon), psig(klon)
26        REAL pgam(klon), pthe(klon)
27        REAL ppic(klon), pval(klon)
28        integer ktest(klon)
29        REAL, INTENT (IN):: t(klon, klev) ! temperature (K)
30        real, INTENT (IN):: u(klon, klev), v(klon, klev) ! vitesse horizontale (m/s)
31        REAL, intent(out):: pulow(klon), pvlow(klon), pustr(klon), pvstr(klon)
32        REAL, intent(out):: d_t(klon, klev) ! increment de la temperature
33    
34        REAL, intent(out):: d_u(klon, klev), d_v(klon, klev) ! increment
35        ! de la vitesse
36    
37        ! Local:
38        INTEGER i, k
39        REAL zgeom(klon, klev)
40        REAL pdtdt(klon, klev), pdudt(klon, klev), pdvdt(klon, klev)
41        REAL pt(klon, klev), pu(klon, klev), pv(klon, klev)
42        REAL papmf(klon, klev), papmh(klon, klev+1)
43    
44        !--------------------------------------------------------------------
45    
46        ! Initialiser les variables de sortie (pour securite)
47    
48        DO i = 1, klon
49           pulow(i) = 0.0
50           pvlow(i) = 0.0
51           pustr(i) = 0.0
52           pvstr(i) = 0.0
53        END DO
54        DO k = 1, klev
55           DO i = 1, klon
56              d_t(i, k) = 0.0
57              d_u(i, k) = 0.0
58              d_v(i, k) = 0.0
59              pdudt(i, k) = 0.0
60              pdvdt(i, k) = 0.0
61              pdtdt(i, k) = 0.0
62           END DO
63        END DO
64    
65        ! Preparer les variables d'entree (attention: l'ordre des niveaux
66        ! verticaux augmente du haut vers le bas)
67    
68        DO k = 1, klev
69           DO i = 1, klon
70              pt(i, k) = t(i, klev-k+1)
71              pu(i, k) = u(i, klev-k+1)
72              pv(i, k) = v(i, klev-k+1)
73              papmf(i, k) = pplay(i, klev-k+1)
74           END DO
75        END DO
76        DO k = 1, klev + 1
77           DO i = 1, klon
78              papmh(i, k) = paprs(i, klev-k+2)
79           END DO
80        END DO
81        DO i = 1, klon
82           zgeom(i, klev) = rd*pt(i, klev)*log(papmh(i, klev+1)/papmf(i, klev))
83        END DO
84        DO k = klev - 1, 1, -1
85           DO i = 1, klon
86              zgeom(i, k) = zgeom(i, k + 1) + rd * (pt(i, k) + pt(i, k + 1)) / 2. &
87                   * log(papmf(i, k + 1) / papmf(i, k))
88           END DO
89        END DO
90    
91        ! Appeler la routine principale
92    
93        CALL orodrag(klon, klev, ktest, dtphys, papmh, papmf, zgeom, pt, pu, pv, &
94             pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, pvlow, pdudt, &
95             pdvdt, pdtdt)
96    
97        DO k = 1, klev
98           DO i = 1, klon
99              d_u(i, klev+1-k) = dtphys*pdudt(i, k)
100              d_v(i, klev+1-k) = dtphys*pdvdt(i, k)
101              d_t(i, klev+1-k) = dtphys*pdtdt(i, k)
102              pustr(i) = pustr(i) &
103                   + pdudt(i, k)*(papmh(i, k+1)-papmh(i, k))/rg
104              pvstr(i) = pvstr(i) &
105                   + pdvdt(i, k)*(papmh(i, k+1)-papmh(i, k))/rg
106           END DO
107        END DO
108    
109      END SUBROUTINE drag_noro
110    
111    end module drag_noro_m
Legend:
Removed from v.38  
changed lines
  Added in v.298
  ViewVC Help
Powered by ViewVC 1.1.21