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

Annotation of /trunk/phylmd/Orography/lift_noro.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 298 - (hide annotations)
Thu Jul 26 16:45:51 2018 UTC (5 years, 10 months ago) by guez
File size: 3375 byte(s)
Use directly dtphys from module comconst when possible instead of
having it trickle down through procedure arguments.

1 guez 227 module lift_noro_m
2 guez 23
3 guez 227 IMPLICIT NONE
4 guez 23
5 guez 227 contains
6 guez 23
7 guez 298 SUBROUTINE lift_noro(paprs, pplay, pmea, pstd, ppic, ktest, t, u, v, pulow, &
8     pvlow, pustr, pvstr, d_t, d_u, d_v)
9 guez 23
10 guez 227 ! Author: F.Lott (LMD/CNRS) date: 1995/02/01
11     ! Objet: Frottement de la montagne, interface
12 guez 23
13 guez 298 use comconst, only: dtphys
14 guez 227 USE dimphy, only: klon, klev
15     use phyetat0_m, only: rlat
16     USE suphec_m, only: rd, rg
17    
18     REAL, INTENT (IN) :: paprs(klon, klev + 1)
19     ! paprs---input-R-pression pour chaque inter-couche (en Pa)
20     REAL, INTENT (IN) :: pplay(klon, klev)
21     ! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
22     REAL pmea(klon)
23     REAL, INTENT (IN):: pstd(klon)
24     REAL ppic(klon)
25     integer ktest(klon)
26     REAL, INTENT (IN):: t(klon, klev)
27     ! t-------input-R-temperature (K)
28     real, INTENT (IN):: u(klon, klev), v(klon, klev)
29     ! u-------input-R-vitesse horizontale (m / s)
30     ! v-------input-R-vitesse horizontale (m / s)
31     REAL pulow(klon), pvlow(klon), pustr(klon), pvstr(klon)
32     REAL d_t(klon, klev), d_u(klon, klev), d_v(klon, klev)
33     ! d_t-----output-R-increment de la temperature
34     ! d_u-----output-R-increment de la vitesse u
35     ! d_v-----output-R-increment de la vitesse v
36 guez 23
37 guez 227 ! 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 guez 23
44 guez 227 !----------------------------------------------------------------------
45 guez 23
46 guez 227 ! initialiser les variables de sortie (pour securite)
47 guez 23
48 guez 227 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 227 ! preparer les variables d'entree (attention: l'ordre des niveaux
66     ! verticaux augmente du haut vers le bas)
67 guez 23
68 guez 227 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) &
83     * log(papmh(i, klev + 1) / papmf(i, klev))
84     END DO
85     DO k = klev - 1, 1, -1
86     DO i = 1, klon
87     zgeom(i, k) = zgeom(i, k + 1) + rd * (pt(i, k) + pt(i, k + 1)) &
88     / 2. * log(papmf(i, k + 1) / papmf(i, k))
89     END DO
90     END DO
91 guez 23
92 guez 227 ! appeler la routine principale
93 guez 23
94 guez 298 CALL orolift(klon, klev, ktest, dtphys, papmh, zgeom, pt, pu, pv, rlat, &
95 guez 227 pmea, pstd, ppic, pulow, pvlow, pdudt, pdvdt, pdtdt)
96 guez 23
97 guez 227 DO k = 1, klev
98     DO i = 1, klon
99 guez 298 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 guez 227 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 guez 23
109 guez 227 END SUBROUTINE lift_noro
110    
111     end module lift_noro_m

  ViewVC Help
Powered by ViewVC 1.1.21