phylmd/Interface_surf/stdlevvar.f

module stdlevvar_m

 IMPLICIT NONE

contains

  SUBROUTINE stdlevvar(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 nr_util, only: assert_eq

    use cdrag_m, only: cdrag
    USE dimphy, ONLY: klon
    USE suphec_m, ONLY: rg, rkappa
    use screenc_m, only: screenc
    use screenp_m, only: screenp

    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(:) ! (knon) humidit\'e 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:
    INTEGER knon ! nombre de points pour un type de surface
    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 cdram(size(u1)), cdrah(size(u1))
    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
    real pref(size(u1)) ! (knon)

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

    knon = assert_eq([size(u1), size(v1), size(t1), size(wind10m), &
         size(ustar)], "stdlevvar knon")
    
    DO i=1, knon
       speed(i)=SQRT(u1(i)**2+v1(i)**2)
    ENDDO

    CALL cdrag(nsrf, speed(:knon), t1(:knon), q1(:knon), z1(:knon), &
         psol(:knon), ts1(:knon), qsurf, rugos(:knon), cdram, cdrah) 

    ! Star variables 

    DO i = 1, knon
       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	272	SUBROUTINE stdlevvar(nsrf, u1, v1, t1, q1, z1, ts1, qsurf, rugos, psol, &
8			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	272	use nr_util, only: assert_eq
21
22	guez	275	use cdrag_m, only: cdrag
23	guez	272	USE dimphy, ONLY: klon
24	guez	225	USE suphec_m, ONLY: rg, rkappa
25			use screenc_m, only: screenc
26			use screenp_m, only: screenp
27
28			INTEGER, intent(in):: nsrf ! indice pour le type de surface
29			REAL, intent(in):: u1(:) ! (knon) vent zonal au 1er niveau du modele
30			REAL, intent(in):: v1(:) ! (knon) vent meridien au 1er niveau du modele
31	guez	227	REAL, intent(in):: t1(:) ! (knon) temperature de l'air au 1er
32			! niveau du modele
33	guez	225	REAL, intent(in):: q1(klon) ! humidite relative au 1er niveau du modele
34			REAL, intent(in):: z1 (klon) ! geopotentiel au 1er niveau du modele
35			REAL, intent(in):: ts1(klon) ! temperature de l'air a la surface
36	guez	309	REAL, intent(in):: qsurf(:) ! (knon) humidit\'e relative \`a la surface
37	guez	225	REAL, intent(in):: rugos(klon) ! rugosite
38			REAL, intent(in):: psol(klon) ! pression au sol
39			REAL, intent(in):: pat1(klon) ! pression au 1er niveau du modele
40			REAL, intent(out):: t_2m(klon) ! temperature de l'air a 2m
41			REAL, intent(out):: q_2m(klon) ! humidite relative a 2m
42			REAL, intent(out):: t_10m(klon) ! temperature de l'air a 10m
43			REAL, intent(out):: q_10m(klon) ! humidite specifique a 10m
44	guez	227	REAL, intent(out):: wind10m(:) ! (knon) norme du vent \`a 10m
45	guez	246	REAL, intent(out):: ustar(:) ! (knon) u*
46	guez	104
47			! Local:
48	guez	272	INTEGER knon ! nombre de points pour un type de surface
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	guez	274	REAL cdram(size(u1)), cdrah(size(u1))
57	guez	104	REAL, dimension(klon):: testar, qstar
58			REAL, dimension(klon):: zdte, zdq
59			! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
60			DOUBLE PRECISION, dimension(klon):: lmon
61			REAL, dimension(klon):: delu, delte, delq
62			REAL, dimension(klon):: u_zref, te_zref, q_zref
63	guez	272	REAL, dimension(klon):: temp
64			real pref(size(u1)) ! (knon)
65	guez	104
66			!-------------------------------------------------------------------------
67
68	guez	272	knon = assert_eq([size(u1), size(v1), size(t1), size(wind10m), &
69			size(ustar)], "stdlevvar knon")
70
71	guez	104	DO i=1, knon
72	guez	3	speed(i)=SQRT(u1(i)2+v1(i)2)
73	guez	104	ENDDO
74
75	guez	275	CALL cdrag(nsrf, speed(:knon), t1(:knon), q1(:knon), z1(:knon), &
76	guez	304	psol(:knon), ts1(:knon), qsurf, rugos(:knon), cdram, cdrah)
77	guez	104
78			! Star variables
79
80			DO i = 1, knon
81			tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
82			ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
83			zdte(i) = tpot(i) - ts1(i)
84			zdq(i) = max(q1(i), 0.0) - max(qsurf(i), 0.0)
85
86			zdte(i) = sign(max(abs(zdte(i)), 1.e-10), zdte(i))
87
88			testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
89			qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
90	guez	227	lmon(i) = (ustar(i) * ustar(i) * tpot(i)) / (RKAR * RG * testar(i))
91	guez	104	ENDDO
92
93			! First aproximation of variables at zref
94			zref = 2.0
95	guez	227	CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
96			testar, qstar, zref, delu, delte, delq)
97	guez	104
98			DO i = 1, knon
99			u_zref(i) = delu(i)
100			q_zref(i) = max(qsurf(i), 0.0) + delq(i)
101			te_zref(i) = ts1(i) + delte(i)
102			temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
103			ENDDO
104
105			! Iteration of the variables at the reference level zref :
106			! corrector calculation ; see Hess & McAvaney, 1995
107
108			DO n = 1, niter
109	guez	227	CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
110			qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
111	guez	104
112			DO i = 1, knon
113	guez	3	u_zref(i) = delu(i)
114	guez	104	q_zref(i) = delq(i) + max(qsurf(i), 0.0)
115	guez	3	te_zref(i) = delte(i) + ts1(i)
116	guez	104
117			! return to normal temperature
118	guez	3	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
119	guez	104	ENDDO
120			ENDDO
121
122			! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
123
124			DO i = 1, knon
125	guez	227	t_2m(i) = temp(i)
126			q_2m(i) = q_zref(i)
127	guez	104	ENDDO
128
129			! First aproximation of variables at zref
130
131	guez	227	zref = 10.
132			CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
133	guez	225	testar, qstar, zref, delu, delte, delq)
134	guez	104
135			DO i = 1, knon
136			u_zref(i) = delu(i)
137			q_zref(i) = max(qsurf(i), 0.0) + delq(i)
138			te_zref(i) = ts1(i) + delte(i)
139			temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
140			ENDDO
141
142			! Iteration of the variables at the reference level zref:
143			! corrector ; see Hess & McAvaney, 1995
144
145			DO n = 1, niter
146	guez	227	CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
147			qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
148	guez	104
149			DO i = 1, knon
150	guez	3	u_zref(i) = delu(i)
151	guez	104	q_zref(i) = delq(i) + max(qsurf(i), 0.0)
152	guez	3	te_zref(i) = delte(i) + ts1(i)
153			temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
154	guez	104	ENDDO
155			ENDDO
156
157			DO i = 1, knon
158	guez	227	wind10m(i) = u_zref(i)
159			t_10m(i) = temp(i)
160			q_10m(i) = q_zref(i)
161	guez	104	ENDDO
162
163			END subroutine stdlevvar
164
165			end module stdlevvar_m