/[lmdze]/trunk/libf/phylmd/Orography/drag_noro.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/Orography/drag_noro.f90

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

revision 51 by guez, Thu Jan 6 17:52:19 2011 UTC revision 52 by guez, Fri Sep 23 12:28:01 2011 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(nlon, nlev, dtime, paprs, pplay, pmea, pstd, psig, &
8        USE dimphy         pgam, pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, pvlow, &
9        USE suphec_m         pustr, pvstr, d_t, d_u, d_v)
10        IMPLICIT NONE  
11  !======================================================================      ! From LMDZ4/libf/phylmd/orografi.F, version 1.4 2005/12/01 11:27:29
12  ! Auteur(s): F.Lott (LMD/CNRS) date: 19950201  
13  ! Objet: Frottement de la montagne Interface      USE dimphy, ONLY : klev, klon
14  !======================================================================      USE suphec_m, ONLY : rd, rg
15  ! Arguments:  
16  ! dtime---input-R- pas d'integration (s)      ! Auteur(s): F.Lott (LMD/CNRS) date: 19950201
17  ! paprs---input-R-pression pour chaque inter-couche (en Pa)      ! Objet: Frottement de la montagne Interface
18  ! pplay---input-R-pression pour le mileu de chaque couche (en Pa)      !======================================================================
19  ! t-------input-R-temperature (K)      ! Arguments:
20  ! u-------input-R-vitesse horizontale (m/s)      ! dtime---input-R- pas d'integration (s)
21  ! v-------input-R-vitesse horizontale (m/s)      ! paprs---input-R-pression pour chaque inter-couche (en Pa)
22        ! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
23  ! d_t-----output-R-increment de la temperature      ! t-------input-R-temperature (K)
24  ! d_u-----output-R-increment de la vitesse u      ! u-------input-R-vitesse horizontale (m/s)
25  ! d_v-----output-R-increment de la vitesse v      ! v-------input-R-vitesse horizontale (m/s)
26  !======================================================================  
27        ! d_t-----output-R-increment de la temperature
28  ! ARGUMENTS      ! d_u-----output-R-increment de la vitesse u
29        ! d_v-----output-R-increment de la vitesse v
30        INTEGER nlon, nlev      !======================================================================
31        REAL, INTENT (IN) :: dtime  
32        REAL, INTENT (IN) :: paprs(klon,klev+1)      ! ARGUMENTS
33        REAL, INTENT (IN) :: pplay(klon,klev)  
34        REAL pmea(nlon)      INTEGER nlon, nlev
35        REAL, INTENT (IN) :: pstd(nlon), psig(nlon)      REAL, INTENT (IN) :: dtime
36        REAL pgam(nlon), pthe(nlon)      REAL, INTENT (IN) :: paprs(klon, klev+1)
37        REAL ppic(nlon), pval(nlon)      REAL, INTENT (IN) :: pplay(klon, klev)
38        REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon)      REAL pmea(nlon)
39        REAL t(nlon,nlev), u(nlon,nlev), v(nlon,nlev)      REAL, INTENT (IN):: pstd(nlon), psig(nlon)
40        REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev)      REAL pgam(nlon), pthe(nlon)
41        REAL ppic(nlon), pval(nlon)
42        INTEGER i, k, kgwd, kdx(nlon), ktest(nlon)      REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon)
43        REAL, INTENT (IN):: t(nlon, nlev)
44  ! Variables locales:      real u(nlon, nlev), v(nlon, nlev)
45        REAL d_t(nlon, nlev), d_u(nlon, nlev), d_v(nlon, nlev)
46        REAL zgeom(klon,klev)  
47        REAL pdtdt(klon,klev), pdudt(klon,klev), pdvdt(klon,klev)      INTEGER i, k, kgwd, kdx(nlon), ktest(nlon)
48        REAL pt(klon,klev), pu(klon,klev), pv(klon,klev)  
49        REAL papmf(klon,klev), papmh(klon,klev+1)      ! Variables locales:
50    
51  ! initialiser les variables de sortie (pour securite)      REAL zgeom(klon, klev)
52        REAL pdtdt(klon, klev), pdudt(klon, klev), pdvdt(klon, klev)
53        DO i = 1, klon      REAL pt(klon, klev), pu(klon, klev), pv(klon, klev)
54          pulow(i) = 0.0      REAL papmf(klon, klev), papmh(klon, klev+1)
55          pvlow(i) = 0.0  
56          pustr(i) = 0.0      ! initialiser les variables de sortie (pour securite)
57          pvstr(i) = 0.0  
58        END DO      DO i = 1, klon
59        DO k = 1, klev         pulow(i) = 0.0
60          DO i = 1, klon         pvlow(i) = 0.0
61            d_t(i,k) = 0.0         pustr(i) = 0.0
62            d_u(i,k) = 0.0         pvstr(i) = 0.0
63            d_v(i,k) = 0.0      END DO
64            pdudt(i,k) = 0.0      DO k = 1, klev
65            pdvdt(i,k) = 0.0         DO i = 1, klon
66            pdtdt(i,k) = 0.0            d_t(i, k) = 0.0
67          END DO            d_u(i, k) = 0.0
68        END DO            d_v(i, k) = 0.0
69              pdudt(i, k) = 0.0
70  ! preparer les variables d'entree (attention: l'ordre des niveaux            pdvdt(i, k) = 0.0
71  ! verticaux augmente du haut vers le bas)            pdtdt(i, k) = 0.0
72           END DO
73        DO k = 1, klev      END DO
74          DO i = 1, klon  
75            pt(i,k) = t(i,klev-k+1)      ! preparer les variables d'entree (attention: l'ordre des niveaux
76            pu(i,k) = u(i,klev-k+1)      ! verticaux augmente du haut vers le bas)
77            pv(i,k) = v(i,klev-k+1)  
78            papmf(i,k) = pplay(i,klev-k+1)      DO k = 1, klev
79          END DO         DO i = 1, klon
80        END DO            pt(i, k) = t(i, klev-k+1)
81        DO k = 1, klev + 1            pu(i, k) = u(i, klev-k+1)
82          DO i = 1, klon            pv(i, k) = v(i, klev-k+1)
83            papmh(i,k) = paprs(i,klev-k+2)            papmf(i, k) = pplay(i, klev-k+1)
84          END DO         END DO
85        END DO      END DO
86        DO i = 1, klon      DO k = 1, klev + 1
87          zgeom(i,klev) = rd*pt(i,klev)*log(papmh(i,klev+1)/papmf(i,klev))         DO i = 1, klon
88        END DO            papmh(i, k) = paprs(i, klev-k+2)
89        DO k = klev - 1, 1, -1         END DO
90          DO i = 1, klon      END DO
91            zgeom(i,k) = zgeom(i,k+1) + rd*(pt(i,k)+pt(i,k+1))/2.0*log(papmf(i,k &      DO i = 1, klon
92              +1)/papmf(i,k))         zgeom(i, klev) = rd*pt(i, klev)*log(papmh(i, klev+1)/papmf(i, klev))
93          END DO      END DO
94        END DO      DO k = klev - 1, 1, -1
95           DO i = 1, klon
96  ! appeler la routine principale            zgeom(i, k) = zgeom(i, k + 1) + rd * (pt(i, k) + pt(i, k + 1)) / 2. &
97                   * log(papmf(i, k + 1) / papmf(i, k))
98        CALL orodrag(klon,klev,kgwd,kdx,ktest,dtime,papmh,papmf,zgeom,pt,pu,pv, &         END DO
99          pmea,pstd,psig,pgam,pthe,ppic,pval,pulow,pvlow,pdudt,pdvdt,pdtdt)      END DO
100    
101        DO k = 1, klev      ! appeler la routine principale
102          DO i = 1, klon  
103            d_u(i,klev+1-k) = dtime*pdudt(i,k)      CALL orodrag(klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, zgeom, &
104            d_v(i,klev+1-k) = dtime*pdvdt(i,k)           pt, pu, pv, pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, pvlow, &
105            d_t(i,klev+1-k) = dtime*pdtdt(i,k)           pdudt, pdvdt, pdtdt)
106    
107        DO k = 1, klev
108           DO i = 1, klon
109              d_u(i, klev+1-k) = dtime*pdudt(i, k)
110              d_v(i, klev+1-k) = dtime*pdvdt(i, k)
111              d_t(i, klev+1-k) = dtime*pdtdt(i, k)
112            pustr(i) = pustr(i) &            pustr(i) = pustr(i) &
113               + pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg                 + pdudt(i, k)*(papmh(i, k+1)-papmh(i, k))/rg
114            pvstr(i) = pvstr(i) &            pvstr(i) = pvstr(i) &
115               + pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg                 + pdvdt(i, k)*(papmh(i, k+1)-papmh(i, k))/rg
116          END DO         END DO
117        END DO      END DO
118    
119        RETURN    END SUBROUTINE drag_noro
120      END  
121    end module drag_noro_m
Legend:
Removed from v.51  
changed lines
  Added in v.52
  ViewVC Help
Powered by ViewVC 1.1.21