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