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