1 |
module lift_noro_m |
2 |
|
3 |
IMPLICIT NONE |
4 |
|
5 |
contains |
6 |
|
7 |
SUBROUTINE lift_noro(paprs, pplay, pmea, pstd, ppic, ktest, t, u, v, pulow, & |
8 |
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 comconst, only: dtphys |
14 |
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 |
|
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) & |
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 |
|
92 |
! appeler la routine principale |
93 |
|
94 |
CALL orolift(klon, klev, ktest, dtphys, papmh, zgeom, pt, pu, pv, rlat, & |
95 |
pmea, pstd, ppic, pulow, pvlow, pdudt, 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 lift_noro |
110 |
|
111 |
end module lift_noro_m |