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

Annotation of /trunk/phylmd/Orography/drag_noro.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 254 - (hide annotations)
Mon Feb 5 10:39:38 2018 UTC (6 years, 4 months ago) by guez
Original Path: trunk/phylmd/Orography/drag_noro.f
File size: 3459 byte(s)
Move Sources/* to root directory.
1 guez 52 module drag_noro_m
2 guez 23
3 guez 52 IMPLICIT NONE
4 guez 23
5 guez 52 contains
6 guez 23
7 guez 247 SUBROUTINE drag_noro(dtime, paprs, pplay, pmea, pstd, psig, pgam, pthe, &
8     ppic, pval, ktest, t, u, v, pulow, pvlow, pustr, pvstr, d_t, d_u, d_v)
9 guez 23
10 guez 52 ! From LMDZ4/libf/phylmd/orografi.F, version 1.4 2005/12/01 11:27:29
11 guez 23
12 guez 247 ! Author: F. Lott (LMD/CNRS). Date: 1995/02/01.
13     ! Objet : frottement de la montagne, interface.
14 guez 23
15 guez 247 USE dimphy, ONLY: klev, klon
16     use orodrag_m, only: orodrag
17     USE suphec_m, ONLY: rd, rg
18 guez 23
19 guez 247 REAL, INTENT (IN):: dtime ! pas d'int\'egration (s)
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 guez 23
34 guez 247 REAL, intent(out):: d_u(klon, klev), d_v(klon, klev) ! increment
35     ! de la vitesse
36 guez 23
37 guez 247 ! Local:
38     INTEGER i, k
39 guez 52 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 guez 23
44 guez 247 !--------------------------------------------------------------------
45 guez 23
46 guez 247 ! Initialiser les variables de sortie (pour securite)
47    
48 guez 52 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 guez 23
65 guez 247 ! Preparer les variables d'entree (attention: l'ordre des niveaux
66 guez 52 ! verticaux augmente du haut vers le bas)
67 guez 23
68 guez 52 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 guez 247 ! Appeler la routine principale
92 guez 52
93 guez 247 CALL orodrag(klon, klev, ktest, dtime, papmh, papmf, zgeom, pt, pu, pv, &
94     pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, pvlow, pdudt, &
95     pdvdt, pdtdt)
96 guez 52
97     DO k = 1, klev
98     DO i = 1, klon
99     d_u(i, klev+1-k) = dtime*pdudt(i, k)
100     d_v(i, klev+1-k) = dtime*pdvdt(i, k)
101     d_t(i, klev+1-k) = dtime*pdtdt(i, k)
102 guez 247 pustr(i) = pustr(i) &
103 guez 52 + pdudt(i, k)*(papmh(i, k+1)-papmh(i, k))/rg
104 guez 247 pvstr(i) = pvstr(i) &
105 guez 52 + pdvdt(i, k)*(papmh(i, k+1)-papmh(i, k))/rg
106     END DO
107     END DO
108 guez 23
109 guez 52 END SUBROUTINE drag_noro
110    
111     end module drag_noro_m

  ViewVC Help
Powered by ViewVC 1.1.21