phylmd/Orography/drag_noro.f

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, INTENT (IN):: 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	module drag_noro_m
2
3	IMPLICIT NONE
4
5	contains
6
7	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
11	! From LMDZ4/libf/phylmd/orografi.F, version 1.4 2005/12/01 11:27:29
12
13	USE dimphy, ONLY : klev, klon
14	USE suphec_m, ONLY : rd, rg
15
16	! 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
27	! 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
32	! ARGUMENTS
33
34	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, INTENT (IN):: u(nlon, nlev), v(nlon, nlev)
45	REAL d_t(nlon, nlev), d_u(nlon, nlev), d_v(nlon, nlev)
46
47	INTEGER i, k, kgwd, kdx(nlon), ktest(nlon)
48
49	! Variables locales:
50
51	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
56	! initialiser les variables de sortie (pour securite)
57
58	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
75	! preparer les variables d'entree (attention: l'ordre des niveaux
76	! verticaux augmente du haut vers le bas)
77
78	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	pustr(i) = pustr(i) &
113	+ pdudt(i, k)*(papmh(i, k+1)-papmh(i, k))/rg
114	pvstr(i) = pvstr(i) &
115	+ pdvdt(i, k)*(papmh(i, k+1)-papmh(i, k))/rg
116	END DO
117	END DO
118
119	END SUBROUTINE drag_noro
120
121	end module drag_noro_m