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