phylmd/Orography/drag_noro.f90

module drag_noro_m

  IMPLICIT NONE

contains

  SUBROUTINE drag_noro(nlon, nlev, dtime, paprs, pplay, pmea, pstd, psig, &
       pgam, pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, pvlow, &
       pustr, pvstr, d_t, d_u, d_v)

    ! From LMDZ4/libf/phylmd/orografi.F, version 1.4 2005/12/01 11:27:29

    USE dimphy, ONLY : klev, klon
    USE suphec_m, ONLY : rd, rg

    ! 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 pmea(nlon)
    REAL, INTENT (IN):: pstd(nlon), psig(nlon)
    REAL pgam(nlon), pthe(nlon)
    REAL ppic(nlon), pval(nlon)
    REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon)
    REAL, INTENT (IN):: t(nlon, nlev)
    real u(nlon, nlev), v(nlon, nlev)
    REAL d_t(nlon, nlev), d_u(nlon, nlev), d_v(nlon, nlev)

    INTEGER i, k, kgwd, kdx(nlon), 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. &
               * log(papmf(i, k + 1) / papmf(i, k))
       END DO
    END DO

    ! appeler la routine principale

    CALL orodrag(klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, zgeom, &
         pt, pu, pv, pmea, pstd, psig, pgam, pthe, ppic, pval, 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

  END SUBROUTINE drag_noro

end module drag_noro_m
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) = rdpt(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