trunk/phylmd/coefkzmin.f

module coefkzmin_m

  IMPLICIT NONE

contains

  SUBROUTINE coefkzmin(ngrid, ypaprs, ypplay, yu, yv, yt, yq, ycoefm, km, kn)

    ! From LMDZ4/libf/phylmd/coefkzmin.F, version 1.1.1.1 2004/05/19 12:53:08

    ! Entrées modifiées en attendant une version où les zlev et zlay
    ! soient disponibles.

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

    integer, intent(in):: ngrid
    REAL, intent(in):: ypaprs(klon, klev+1), ypplay(klon, klev)
    REAL, intent(in):: yu(klon, klev), yv(klon, klev) ! wind, in m s-1
    REAL, intent(in):: yt(klon, klev) ! temperature, in K
    REAL, intent(in):: yq(klon, klev)

    REAL, intent(in):: ycoefm(klon) ! drag coefficient

    REAL, intent(inout):: km(klon, klev)
    ! coefficient de diffusion turbulente de quantité de mouvement (au
    ! bas de chaque couche) (en sortie : la valeur à la fin du pas de
    ! temps), m2 s-1

    REAL, intent(inout):: kn(klon, klev)
    ! coefficient de diffusion turbulente des scalaires (au bas de
    ! chaque couche) (en sortie : la valeur à la fin du pas de temps), m2 s-1

    ! Local:

    real ustar(ngrid) ! u*
    real zlay(ngrid, klev) ! in m
    integer i, k
    real pblhmin(ngrid)
    real, parameter:: coriol = 1e-4

    REAL zlev(ngrid, 2: klev)
    ! altitude at level (interface between layer with same index), in m

    REAL teta(ngrid, klev)
    ! température potentielle au centre de chaque couche (la valeur au
    ! debut du pas de temps)

    real, PARAMETER:: kap = 0.4

    !---------------------------------------------------------------------

    ! Debut de la partie qui doit etre incluse a terme dans clmain.

    do i = 1, ngrid
       zlay(i, 1) = RD * yt(i, 1) * 2 / (ypaprs(i, 1) + ypplay(i, 1)) &
            * (ypaprs(i, 1) - ypplay(i, 1)) / RG
    enddo

    do k = 2, klev
       do i = 1, ngrid
          zlay(i, k) = zlay(i, k-1) + RD * 0.5 * (yt(i, k - 1) + yt(i, k)) &
               / ypaprs(i, k) * (ypplay(i, k - 1) - ypplay(i, k)) / RG
       enddo
    enddo

    do k=1, klev
       do i = 1, ngrid
          ! Attention : on passe la temperature potentielle virtuelle
          ! pour le calcul de K.
          teta(i, k) = yt(i, k) * (ypaprs(i, 1) / ypplay(i, k))**rkappa &
               * (1. + 0.61 * yq(i, k))
       enddo
    enddo

    forall (k = 2: klev) zlev(:, k) = 0.5 * (zlay(:, k) + zlay(:, k-1))
    ustar = SQRT(ycoefm(:ngrid) * (yu(:ngrid, 1)**2 + yv(:ngrid, 1)**2))

    ! Fin de la partie qui doit être incluse à terme dans clmain

    ! Cette routine est ecrite pour avoir en entree ustar, teta et zlev
    ! Ici, on a inclus le calcul de ces trois variables dans la routine
    ! coefkzmin en attendant une nouvelle version de la couche limite
    ! ou ces variables seront disponibles.

    ! Debut de la routine coefkzmin proprement dite

    pblhmin = 0.07 * ustar / coriol

    do k = 2, klev
       do i = 1, ngrid
          if (teta(i, 2) > teta(i, 1)) then
             kn(i, k) = kap * zlev(i, k) * ustar(i) &
                  * (max(1. - zlev(i, k) / pblhmin(i), 0.))**2
          else
             kn(i, k) = 0. ! min n'est utilisé que pour les SL stables
          endif
          km(i, k) = kn(i, k)
       enddo
    enddo

  end SUBROUTINE coefkzmin

end module coefkzmin_m
1	guez	47	module coefkzmin_m
2	guez	3
3	guez	47	IMPLICIT NONE
4	guez	3
5	guez	47	contains
6	guez	3
7	guez	47	SUBROUTINE coefkzmin(ngrid, ypaprs, ypplay, yu, yv, yt, yq, ycoefm, km, kn)
8	guez	3
9	guez	47	! From LMDZ4/libf/phylmd/coefkzmin.F, version 1.1.1.1 2004/05/19 12:53:08
10	guez	3
11	guez	47	! Entrées modifiées en attendant une version où les zlev et zlay
12			! soient disponibles.
13	guez	3
14	guez	47	USE dimphy, ONLY: klev, klon
15			USE suphec_m, ONLY: rd, rg, rkappa
16	guez	3
17	guez	47	integer, intent(in):: ngrid
18			REAL, intent(in):: ypaprs(klon, klev+1), ypplay(klon, klev)
19			REAL, intent(in):: yu(klon, klev), yv(klon, klev) ! wind, in m s-1
20			REAL, intent(in):: yt(klon, klev) ! temperature, in K
21			REAL, intent(in):: yq(klon, klev)
22	guez	3
23	guez	47	REAL, intent(in):: ycoefm(klon) ! drag coefficient
24	guez	3
25	guez	47	REAL, intent(inout):: km(klon, klev)
26			! coefficient de diffusion turbulente de quantité de mouvement (au
27			! bas de chaque couche) (en sortie : la valeur à la fin du pas de
28			! temps), m2 s-1
29	guez	3
30	guez	47	REAL, intent(inout):: kn(klon, klev)
31			! coefficient de diffusion turbulente des scalaires (au bas de
32			! chaque couche) (en sortie : la valeur à la fin du pas de temps), m2 s-1
33	guez	3
34	guez	47	! Local:
35	guez	3
36	guez	47	real ustar(ngrid) ! u*
37			real zlay(ngrid, klev) ! in m
38			integer i, k
39			real pblhmin(ngrid)
40			real, parameter:: coriol = 1e-4
41	guez	3
42	guez	47	REAL zlev(ngrid, 2: klev)
43			! altitude at level (interface between layer with same index), in m
44	guez	3
45	guez	47	REAL teta(ngrid, klev)
46			! température potentielle au centre de chaque couche (la valeur au
47			! debut du pas de temps)
48	guez	3
49	guez	47	real, PARAMETER:: kap = 0.4
50	guez	3
51	guez	47	!---------------------------------------------------------------------
52	guez	3
53	guez	47	! Debut de la partie qui doit etre incluse a terme dans clmain.
54	guez	3
55	guez	47	do i = 1, ngrid
56			zlay(i, 1) = RD * yt(i, 1) * 2 / (ypaprs(i, 1) + ypplay(i, 1)) &
57			* (ypaprs(i, 1) - ypplay(i, 1)) / RG
58			enddo
59	guez	3
60	guez	47	do k = 2, klev
61			do i = 1, ngrid
62			zlay(i, k) = zlay(i, k-1) + RD * 0.5 * (yt(i, k - 1) + yt(i, k)) &
63			/ ypaprs(i, k) * (ypplay(i, k - 1) - ypplay(i, k)) / RG
64			enddo
65			enddo
66	guez	3
67	guez	47	do k=1, klev
68			do i = 1, ngrid
69			! Attention : on passe la temperature potentielle virtuelle
70			! pour le calcul de K.
71			teta(i, k) = yt(i, k) * (ypaprs(i, 1) / ypplay(i, k))**rkappa &
72			* (1. + 0.61 * yq(i, k))
73			enddo
74			enddo
75	guez	3
76	guez	47	forall (k = 2: klev) zlev(:, k) = 0.5 * (zlay(:, k) + zlay(:, k-1))
77			ustar = SQRT(ycoefm(:ngrid) * (yu(:ngrid, 1)2 + yv(:ngrid, 1)2))
78	guez	3
79	guez	47	! Fin de la partie qui doit être incluse à terme dans clmain
80	guez	3
81	guez	47	! Cette routine est ecrite pour avoir en entree ustar, teta et zlev
82			! Ici, on a inclus le calcul de ces trois variables dans la routine
83			! coefkzmin en attendant une nouvelle version de la couche limite
84			! ou ces variables seront disponibles.
85	guez	3
86	guez	47	! Debut de la routine coefkzmin proprement dite
87
88			pblhmin = 0.07 * ustar / coriol
89
90			do k = 2, klev
91			do i = 1, ngrid
92			if (teta(i, 2) > teta(i, 1)) then
93			kn(i, k) = kap * zlev(i, k) * ustar(i) &
94			* (max(1. - zlev(i, k) / pblhmin(i), 0.))**2
95			else
96			kn(i, k) = 0. ! min n'est utilisé que pour les SL stables
97			endif
98			km(i, k) = kn(i, k)
99			enddo
100			enddo
101
102			end SUBROUTINE coefkzmin
103
104			end module coefkzmin_m