Sources/phylmd/stdlevvar.f

module stdlevvar_m

 IMPLICIT NONE

contains

  SUBROUTINE stdlevvar(klon, knon, nsrf, u1, v1, t1, q1, z1, ts1, qsurf, &
       rugos, psol, pat1, t_2m, q_2m, t_10m, q_10m, wind10m, ustar)

    ! From LMDZ4/libf/phylmd/stdlevvar.F90, version 1.3, 2005/05/25 13:10:09

    ! Objet : calcul de la température et de l'humidité relative à 2 m
    ! et du module du vent à 10 m à partir des relations de
    ! Dyer-Businger et des équations de Louis.

    ! Reference: Hess, Colman and McAvaney (1995) 

    ! Author: I. Musat, July 1st, 2002

    use coefcdrag_m, only: coefcdrag
    USE suphec_m, ONLY: rg, rkappa
    use screenc_m, only: screenc
    use screenp_m, only: screenp

    INTEGER, intent(in):: klon
    ! dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)

    INTEGER, intent(in):: knon ! nombre de points pour un type de surface
    INTEGER, intent(in):: nsrf ! indice pour le type de surface
    REAL, intent(in):: u1(:) ! (knon) vent zonal au 1er niveau du modele
    REAL, intent(in):: v1(:) ! (knon) vent meridien au 1er niveau du modele
    REAL, intent(in):: t1(:) ! (knon) temperature de l'air au 1er
                             ! niveau du modele
    REAL, intent(in):: q1(klon) ! humidite relative au 1er niveau du modele
    REAL, intent(in):: z1 (klon) ! geopotentiel au 1er niveau du modele
    REAL, intent(in):: ts1(klon) ! temperature de l'air a la surface
    REAL, intent(in):: qsurf(klon) ! humidite relative a la surface
    REAL, intent(in):: rugos(klon) ! rugosite
    REAL, intent(in):: psol(klon) ! pression au sol
    REAL, intent(in):: pat1(klon) ! pression au 1er niveau du modele
    REAL, intent(out):: t_2m(klon) ! temperature de l'air a 2m
    REAL, intent(out):: q_2m(klon) ! humidite relative a 2m
    REAL, intent(out):: t_10m(klon) ! temperature de l'air a 10m
    REAL, intent(out):: q_10m(klon) ! humidite specifique a 10m
    REAL, intent(out):: wind10m(:) ! (knon) norme du vent \`a 10m
    REAL, intent(out):: ustar(:) ! (knon) u*

    ! Local:
    REAL, PARAMETER:: RKAR = 0.4 ! constante de von Karman
    INTEGER, parameter:: niter = 2 ! nombre iterations calcul "corrector"
    INTEGER i, n
    REAL zref
    REAL, dimension(klon):: speed
    ! tpot : temperature potentielle
    REAL, dimension(klon):: tpot
    REAL, dimension(klon):: zri1, cdran
    REAL cdram(klon), cdrah(klon)
    ! ri1 : nb. de Richardson entre la surface --> la 1ere couche
    REAL, dimension(klon):: ri1 
    REAL, dimension(klon):: testar, qstar
    REAL, dimension(klon):: zdte, zdq 
    ! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney 
    DOUBLE PRECISION, dimension(klon):: lmon
    REAL, dimension(klon):: delu, delte, delq
    REAL, dimension(klon):: u_zref, te_zref, q_zref 
    REAL, dimension(klon):: temp, pref

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

    DO i=1, knon
       speed(i)=SQRT(u1(i)**2+v1(i)**2)
       ri1(i) = 0.0
    ENDDO

    CALL coefcdrag(nsrf, speed(:knon), t1(:knon), q1(:knon), z1(:knon), &
         psol(:knon), ts1, qsurf, rugos, cdram, cdrah, cdran, zri1, pref) 

    ! Star variables 

    DO i = 1, knon
       ri1(i) = zri1(i)
       tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
       ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
       zdte(i) = tpot(i) - ts1(i)
       zdq(i) = max(q1(i), 0.0) - max(qsurf(i), 0.0)

       zdte(i) = sign(max(abs(zdte(i)), 1.e-10), zdte(i))

       testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
       qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
       lmon(i) = (ustar(i) * ustar(i) * tpot(i)) / (RKAR * RG * testar(i))
    ENDDO

    ! First aproximation of variables at zref  
    zref = 2.0
    CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
         testar, qstar, zref, delu, delte, delq)

    DO i = 1, knon
       u_zref(i) = delu(i)
       q_zref(i) = max(qsurf(i), 0.0) + delq(i)
       te_zref(i) = ts1(i) + delte(i)
       temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
    ENDDO

    ! Iteration of the variables at the reference level zref :
    ! corrector calculation ; see Hess & McAvaney, 1995

    DO n = 1, niter
       CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
            qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq) 

       DO i = 1, knon
          u_zref(i) = delu(i)
          q_zref(i) = delq(i) + max(qsurf(i), 0.0)
          te_zref(i) = delte(i) + ts1(i) 

          ! return to normal temperature
          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
       ENDDO
    ENDDO

    ! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref

    DO i = 1, knon
       t_2m(i) = temp(i)
       q_2m(i) = q_zref(i)
    ENDDO

    ! First aproximation of variables at zref  

    zref = 10.
    CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
         testar, qstar, zref, delu, delte, delq)

    DO i = 1, knon
       u_zref(i) = delu(i)
       q_zref(i) = max(qsurf(i), 0.0) + delq(i)
       te_zref(i) = ts1(i) + delte(i)
       temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
    ENDDO

    ! Iteration of the variables at the reference level zref:
    ! corrector ; see Hess & McAvaney, 1995

    DO n = 1, niter
       CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
            qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)

       DO i = 1, knon
          u_zref(i) = delu(i)
          q_zref(i) = delq(i) + max(qsurf(i), 0.0)
          te_zref(i) = delte(i) + ts1(i)
          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
       ENDDO
    ENDDO

    DO i = 1, knon
       wind10m(i) = u_zref(i)
       t_10m(i) = temp(i)
       q_10m(i) = q_zref(i)
    ENDDO

  END subroutine stdlevvar

end module stdlevvar_m
1	guez	104	module stdlevvar_m
2
3			IMPLICIT NONE
4
5			contains
6
7	guez	227	SUBROUTINE stdlevvar(klon, knon, nsrf, u1, v1, t1, q1, z1, ts1, qsurf, &
8			rugos, psol, pat1, t_2m, q_2m, t_10m, q_10m, wind10m, ustar)
9	guez	104
10	guez	227	! From LMDZ4/libf/phylmd/stdlevvar.F90, version 1.3, 2005/05/25 13:10:09
11	guez	104
12			! Objet : calcul de la température et de l'humidité relative à 2 m
13			! et du module du vent à 10 m à partir des relations de
14			! Dyer-Businger et des équations de Louis.
15
16			! Reference: Hess, Colman and McAvaney (1995)
17
18	guez	208	! Author: I. Musat, July 1st, 2002
19	guez	104
20	guez	225	use coefcdrag_m, only: coefcdrag
21			USE suphec_m, ONLY: rg, rkappa
22			use screenc_m, only: screenc
23			use screenp_m, only: screenp
24
25	guez	104	INTEGER, intent(in):: klon
26			! dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
27
28	guez	208	INTEGER, intent(in):: knon ! nombre de points pour un type de surface
29	guez	225	INTEGER, intent(in):: nsrf ! indice pour le type de surface
30			REAL, intent(in):: u1(:) ! (knon) vent zonal au 1er niveau du modele
31			REAL, intent(in):: v1(:) ! (knon) vent meridien au 1er niveau du modele
32	guez	227	REAL, intent(in):: t1(:) ! (knon) temperature de l'air au 1er
33			! niveau du modele
34	guez	225	REAL, intent(in):: q1(klon) ! humidite relative au 1er niveau du modele
35			REAL, intent(in):: z1 (klon) ! geopotentiel au 1er niveau du modele
36			REAL, intent(in):: ts1(klon) ! temperature de l'air a la surface
37			REAL, intent(in):: qsurf(klon) ! humidite relative a la surface
38			REAL, intent(in):: rugos(klon) ! rugosite
39			REAL, intent(in):: psol(klon) ! pression au sol
40			REAL, intent(in):: pat1(klon) ! pression au 1er niveau du modele
41			REAL, intent(out):: t_2m(klon) ! temperature de l'air a 2m
42			REAL, intent(out):: q_2m(klon) ! humidite relative a 2m
43			REAL, intent(out):: t_10m(klon) ! temperature de l'air a 10m
44			REAL, intent(out):: q_10m(klon) ! humidite specifique a 10m
45	guez	227	REAL, intent(out):: wind10m(:) ! (knon) norme du vent \`a 10m
46	guez	246	REAL, intent(out):: ustar(:) ! (knon) u*
47	guez	104
48			! Local:
49	guez	227	REAL, PARAMETER:: RKAR = 0.4 ! constante de von Karman
50			INTEGER, parameter:: niter = 2 ! nombre iterations calcul "corrector"
51	guez	104	INTEGER i, n
52			REAL zref
53			REAL, dimension(klon):: speed
54			! tpot : temperature potentielle
55			REAL, dimension(klon):: tpot
56			REAL, dimension(klon):: zri1, cdran
57			REAL cdram(klon), cdrah(klon)
58			! ri1 : nb. de Richardson entre la surface --> la 1ere couche
59			REAL, dimension(klon):: ri1
60			REAL, dimension(klon):: testar, qstar
61			REAL, dimension(klon):: zdte, zdq
62			! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
63			DOUBLE PRECISION, dimension(klon):: lmon
64			REAL, dimension(klon):: delu, delte, delq
65			REAL, dimension(klon):: u_zref, te_zref, q_zref
66			REAL, dimension(klon):: temp, pref
67
68			!-------------------------------------------------------------------------
69
70			DO i=1, knon
71	guez	3	speed(i)=SQRT(u1(i)2+v1(i)2)
72			ri1(i) = 0.0
73	guez	104	ENDDO
74
75	guez	246	CALL coefcdrag(nsrf, speed(:knon), t1(:knon), q1(:knon), z1(:knon), &
76			psol(:knon), ts1, qsurf, rugos, cdram, cdrah, cdran, zri1, pref)
77	guez	104
78			! Star variables
79
80			DO i = 1, knon
81			ri1(i) = zri1(i)
82			tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
83			ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
84			zdte(i) = tpot(i) - ts1(i)
85			zdq(i) = max(q1(i), 0.0) - max(qsurf(i), 0.0)
86
87			zdte(i) = sign(max(abs(zdte(i)), 1.e-10), zdte(i))
88
89			testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
90			qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
91	guez	227	lmon(i) = (ustar(i) * ustar(i) * tpot(i)) / (RKAR * RG * testar(i))
92	guez	104	ENDDO
93
94			! First aproximation of variables at zref
95			zref = 2.0
96	guez	227	CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
97			testar, qstar, zref, delu, delte, delq)
98	guez	104
99			DO i = 1, knon
100			u_zref(i) = delu(i)
101			q_zref(i) = max(qsurf(i), 0.0) + delq(i)
102			te_zref(i) = ts1(i) + delte(i)
103			temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
104			ENDDO
105
106			! Iteration of the variables at the reference level zref :
107			! corrector calculation ; see Hess & McAvaney, 1995
108
109			DO n = 1, niter
110	guez	227	CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
111			qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
112	guez	104
113			DO i = 1, knon
114	guez	3	u_zref(i) = delu(i)
115	guez	104	q_zref(i) = delq(i) + max(qsurf(i), 0.0)
116	guez	3	te_zref(i) = delte(i) + ts1(i)
117	guez	104
118			! return to normal temperature
119	guez	3	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
120	guez	104	ENDDO
121			ENDDO
122
123			! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
124
125			DO i = 1, knon
126	guez	227	t_2m(i) = temp(i)
127			q_2m(i) = q_zref(i)
128	guez	104	ENDDO
129
130			! First aproximation of variables at zref
131
132	guez	227	zref = 10.
133			CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
134	guez	225	testar, qstar, zref, delu, delte, delq)
135	guez	104
136			DO i = 1, knon
137			u_zref(i) = delu(i)
138			q_zref(i) = max(qsurf(i), 0.0) + delq(i)
139			te_zref(i) = ts1(i) + delte(i)
140			temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
141			ENDDO
142
143			! Iteration of the variables at the reference level zref:
144			! corrector ; see Hess & McAvaney, 1995
145
146			DO n = 1, niter
147	guez	227	CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
148			qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
149	guez	104
150			DO i = 1, knon
151	guez	3	u_zref(i) = delu(i)
152	guez	104	q_zref(i) = delq(i) + max(qsurf(i), 0.0)
153	guez	3	te_zref(i) = delte(i) + ts1(i)
154			temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
155	guez	104	ENDDO
156			ENDDO
157
158			DO i = 1, knon
159	guez	227	wind10m(i) = u_zref(i)
160			t_10m(i) = temp(i)
161			q_10m(i) = q_zref(i)
162	guez	104	ENDDO
163
164			END subroutine stdlevvar
165
166			end module stdlevvar_m