trunk/phylmd/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 coefcdrag_m, only: coefcdrag
    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(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:
    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 coefcdrag(nsrf, speed(:knon), t1(:knon), q1(:knon), z1(:knon), &
         psol(:knon), ts1(:knon), qsurf(:knon), 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	module stdlevvar_m
2
3	IMPLICIT NONE
4
5	contains
6
7	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
10	! From LMDZ4/libf/phylmd/stdlevvar.F90, version 1.3, 2005/05/25 13:10:09
11
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	! Author: I. Musat, July 1st, 2002
19
20	use nr_util, only: assert_eq
21
22	use coefcdrag_m, only: coefcdrag
23	USE dimphy, ONLY: klon
24	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	REAL, intent(in):: t1(:) ! (knon) temperature de l'air au 1er
32	! niveau du modele
33	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	REAL, intent(in):: qsurf(klon) ! humidite relative a la surface
37	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	REAL, intent(out):: wind10m(:) ! (knon) norme du vent \`a 10m
45	REAL, intent(out):: ustar(:) ! (knon) u*
46
47	! Local:
48	INTEGER knon ! nombre de points pour un type de surface
49	REAL, PARAMETER:: RKAR = 0.4 ! constante de von Karman
50	INTEGER, parameter:: niter = 2 ! nombre iterations calcul "corrector"
51	INTEGER i, n
52	REAL zref
53	REAL, dimension(klon):: speed
54	! tpot : temperature potentielle
55	REAL, dimension(klon):: tpot
56	REAL cdram(size(u1)), cdrah(size(u1))
57	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	REAL, dimension(klon):: temp
64	real pref(size(u1)) ! (knon)
65
66	!-------------------------------------------------------------------------
67
68	knon = assert_eq([size(u1), size(v1), size(t1), size(wind10m), &
69	size(ustar)], "stdlevvar knon")
70
71	DO i=1, knon
72	speed(i)=SQRT(u1(i)2+v1(i)2)
73	ENDDO
74
75	CALL coefcdrag(nsrf, speed(:knon), t1(:knon), q1(:knon), z1(:knon), &
76	psol(:knon), ts1(:knon), qsurf(:knon), rugos(:knon), cdram, cdrah)
77
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	lmon(i) = (ustar(i) * ustar(i) * tpot(i)) / (RKAR * RG * testar(i))
91	ENDDO
92
93	! First aproximation of variables at zref
94	zref = 2.0
95	CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
96	testar, qstar, zref, delu, delte, delq)
97
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	CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
110	qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
111
112	DO i = 1, knon
113	u_zref(i) = delu(i)
114	q_zref(i) = delq(i) + max(qsurf(i), 0.0)
115	te_zref(i) = delte(i) + ts1(i)
116
117	! return to normal temperature
118	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
119	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	t_2m(i) = temp(i)
126	q_2m(i) = q_zref(i)
127	ENDDO
128
129	! First aproximation of variables at zref
130
131	zref = 10.
132	CALL screenp(knon, speed, tpot, q1, ts1, qsurf, rugos, lmon, ustar, &
133	testar, qstar, zref, delu, delte, delq)
134
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	CALL screenc(klon, knon, nsrf, u_zref, temp, q_zref, zref, ts1, &
147	qsurf, rugos, psol, ustar, testar, qstar, pref, delu, delte, delq)
148
149	DO i = 1, knon
150	u_zref(i) = delu(i)
151	q_zref(i) = delq(i) + max(qsurf(i), 0.0)
152	te_zref(i) = delte(i) + ts1(i)
153	temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
154	ENDDO
155	ENDDO
156
157	DO i = 1, knon
158	wind10m(i) = u_zref(i)
159	t_10m(i) = temp(i)
160	q_10m(i) = q_zref(i)
161	ENDDO
162
163	END subroutine stdlevvar
164
165	end module stdlevvar_m