| 1 |
module drag_noro_m |
| 2 |
|
| 3 |
IMPLICIT NONE |
| 4 |
|
| 5 |
contains |
| 6 |
|
| 7 |
SUBROUTINE drag_noro(paprs, pplay, pmea, pstd, psig, pgam, pthe, ppic, pval, & |
| 8 |
ktest, t, u, v, pulow, pvlow, pustr, pvstr, d_t, d_u, d_v) |
| 9 |
|
| 10 |
! From LMDZ4/libf/phylmd/orografi.F, version 1.4 2005/12/01 11:27:29 |
| 11 |
|
| 12 |
! Author: F. Lott (LMD/CNRS). Date: 1995/02/01. |
| 13 |
! Objet : frottement de la montagne, interface. |
| 14 |
|
| 15 |
use comconst, only: dtphys |
| 16 |
USE dimphy, ONLY: klev, klon |
| 17 |
use orodrag_m, only: orodrag |
| 18 |
USE suphec_m, ONLY: rd, rg |
| 19 |
|
| 20 |
REAL, INTENT (IN):: paprs(klon, klev+1) ! pression pour chaque |
| 21 |
! inter-couche (en Pa) |
| 22 |
REAL, INTENT (IN):: pplay(klon, klev) ! pression pour le mileu de |
| 23 |
! chaque couche (en Pa) |
| 24 |
REAL pmea(klon) |
| 25 |
REAL, INTENT (IN):: pstd(klon), psig(klon) |
| 26 |
REAL pgam(klon), pthe(klon) |
| 27 |
REAL ppic(klon), pval(klon) |
| 28 |
integer ktest(klon) |
| 29 |
REAL, INTENT (IN):: t(klon, klev) ! temperature (K) |
| 30 |
real, INTENT (IN):: u(klon, klev), v(klon, klev) ! vitesse horizontale (m/s) |
| 31 |
REAL, intent(out):: pulow(klon), pvlow(klon), pustr(klon), pvstr(klon) |
| 32 |
REAL, intent(out):: d_t(klon, klev) ! increment de la temperature |
| 33 |
|
| 34 |
REAL, intent(out):: d_u(klon, klev), d_v(klon, klev) ! increment |
| 35 |
! de la vitesse |
| 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)*log(papmh(i, klev+1)/papmf(i, klev)) |
| 83 |
END DO |
| 84 |
DO k = klev - 1, 1, -1 |
| 85 |
DO i = 1, klon |
| 86 |
zgeom(i, k) = zgeom(i, k + 1) + rd * (pt(i, k) + pt(i, k + 1)) / 2. & |
| 87 |
* log(papmf(i, k + 1) / papmf(i, k)) |
| 88 |
END DO |
| 89 |
END DO |
| 90 |
|
| 91 |
! Appeler la routine principale |
| 92 |
|
| 93 |
CALL orodrag(klon, klev, ktest, dtphys, papmh, papmf, zgeom, pt, pu, pv, & |
| 94 |
pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, pvlow, pdudt, & |
| 95 |
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 drag_noro |
| 110 |
|
| 111 |
end module drag_noro_m |
Parent Directory
| 
Revision Log