1 |
SUBROUTINE lift_noro(nlon,nlev,dtime,paprs,pplay,plat,pmea,pstd,ppic, & |
2 |
ktest,t,u,v,pulow,pvlow,pustr,pvstr,d_t,d_u,d_v) |
3 |
|
4 |
USE dimens_m |
5 |
USE dimphy |
6 |
USE suphec_m |
7 |
IMPLICIT NONE |
8 |
!====================================================================== |
9 |
! Auteur(s): F.Lott (LMD/CNRS) date: 19950201 |
10 |
! Objet: Frottement de la montagne Interface |
11 |
!====================================================================== |
12 |
! Arguments: |
13 |
! dtime---input-R- pas d'integration (s) |
14 |
! paprs---input-R-pression pour chaque inter-couche (en Pa) |
15 |
! pplay---input-R-pression pour le mileu de chaque couche (en Pa) |
16 |
! t-------input-R-temperature (K) |
17 |
! u-------input-R-vitesse horizontale (m/s) |
18 |
! v-------input-R-vitesse horizontale (m/s) |
19 |
|
20 |
! d_t-----output-R-increment de la temperature |
21 |
! d_u-----output-R-increment de la vitesse u |
22 |
! d_v-----output-R-increment de la vitesse v |
23 |
!====================================================================== |
24 |
|
25 |
! ARGUMENTS |
26 |
|
27 |
INTEGER nlon, nlev |
28 |
REAL, INTENT (IN) :: dtime |
29 |
REAL, INTENT (IN) :: paprs(klon,klev+1) |
30 |
REAL, INTENT (IN) :: pplay(klon,klev) |
31 |
REAL, INTENT (IN) :: plat(nlon) |
32 |
REAL pmea(nlon) |
33 |
REAL, INTENT (IN):: pstd(nlon) |
34 |
REAL ppic(nlon) |
35 |
REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon) |
36 |
REAL, INTENT (IN):: t(nlon,nlev) |
37 |
real, INTENT (IN):: u(nlon,nlev), v(nlon,nlev) |
38 |
REAL d_t(nlon,nlev), d_u(nlon,nlev), d_v(nlon,nlev) |
39 |
|
40 |
INTEGER i, k, ktest(nlon) |
41 |
|
42 |
! Variables locales: |
43 |
|
44 |
REAL zgeom(klon,klev) |
45 |
REAL pdtdt(klon,klev), pdudt(klon,klev), pdvdt(klon,klev) |
46 |
REAL pt(klon,klev), pu(klon,klev), pv(klon,klev) |
47 |
REAL papmf(klon,klev), papmh(klon,klev+1) |
48 |
|
49 |
! initialiser les variables de sortie (pour securite) |
50 |
|
51 |
DO i = 1, klon |
52 |
pulow(i) = 0.0 |
53 |
pvlow(i) = 0.0 |
54 |
pustr(i) = 0.0 |
55 |
pvstr(i) = 0.0 |
56 |
END DO |
57 |
DO k = 1, klev |
58 |
DO i = 1, klon |
59 |
d_t(i,k) = 0.0 |
60 |
d_u(i,k) = 0.0 |
61 |
d_v(i,k) = 0.0 |
62 |
pdudt(i,k) = 0.0 |
63 |
pdvdt(i,k) = 0.0 |
64 |
pdtdt(i,k) = 0.0 |
65 |
END DO |
66 |
END DO |
67 |
|
68 |
! preparer les variables d'entree (attention: l'ordre des niveaux |
69 |
! verticaux augmente du haut vers le bas) |
70 |
|
71 |
DO k = 1, klev |
72 |
DO i = 1, klon |
73 |
pt(i,k) = t(i,klev-k+1) |
74 |
pu(i,k) = u(i,klev-k+1) |
75 |
pv(i,k) = v(i,klev-k+1) |
76 |
papmf(i,k) = pplay(i,klev-k+1) |
77 |
END DO |
78 |
END DO |
79 |
DO k = 1, klev + 1 |
80 |
DO i = 1, klon |
81 |
papmh(i,k) = paprs(i,klev-k+2) |
82 |
END DO |
83 |
END DO |
84 |
DO i = 1, klon |
85 |
zgeom(i,klev) = rd*pt(i,klev)*log(papmh(i,klev+1)/papmf(i,klev)) |
86 |
END DO |
87 |
DO k = klev - 1, 1, -1 |
88 |
DO i = 1, klon |
89 |
zgeom(i,k) = zgeom(i,k+1) + rd*(pt(i,k)+pt(i,k+1))/2.0*log(papmf(i,k & |
90 |
+1)/papmf(i,k)) |
91 |
END DO |
92 |
END DO |
93 |
|
94 |
! appeler la routine principale |
95 |
|
96 |
CALL orolift(klon,klev,ktest,dtime,papmh,zgeom,pt,pu,pv,plat,pmea,pstd, & |
97 |
ppic,pulow,pvlow,pdudt,pdvdt,pdtdt) |
98 |
|
99 |
DO k = 1, klev |
100 |
DO i = 1, klon |
101 |
d_u(i,klev+1-k) = dtime*pdudt(i,k) |
102 |
d_v(i,klev+1-k) = dtime*pdvdt(i,k) |
103 |
d_t(i,klev+1-k) = dtime*pdtdt(i,k) |
104 |
pustr(i) = pustr(i) & |
105 |
+ pdudt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg |
106 |
pvstr(i) = pvstr(i) & |
107 |
+ pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k))/rg |
108 |
END DO |
109 |
END DO |
110 |
|
111 |
RETURN |
112 |
END |