Sources/phylmd/screenp.f

module screenp_m

  IMPLICIT none

contains

  SUBROUTINE screenp(knon, speed, tair, qair, ts, qsurf, rugos, lmon, ustar, &
       testar, qstar, zref, delu, delte, delq)

    ! From LMDZ4/libf/phylmd/screenp.F90, version 1.1.1.1, 2004/05/19 12:53:09

    ! Objet : calcul "pr\'edicteur" des anomalies du vent, de la
    ! temp\'erature potentielle et de l'humidit\'e relative au niveau
    ! de r\'ef\'erence zref et par rapport au 1er niveau (pour u) ou
    ! \`a la surface (pour theta et q) \`a partir des relations de
    ! Dyer-Businger.

    ! Reference: Hess, Colman and McAvaney (1995)

    ! I. Musat, 01.07.2002

    use dimphy, only: klon

    INTEGER, intent(in):: knon
    ! knon----input-I- nombre de points pour un type de surface
    REAL, dimension(klon), intent(in):: speed
    ! speed---input-R- module du vent au 1er niveau du modele
    REAL, dimension(klon), intent(in):: tair
    ! tair----input-R- temperature de l'air au 1er niveau du modele
    REAL, dimension(klon), intent(in):: qair
    ! qair----input-R- humidite relative au 1er niveau du modele
    REAL, dimension(klon), intent(in):: ts
    ! ts------input-R- temperature de l'air a la surface
    REAL, dimension(klon), intent(in):: qsurf
    ! qsurf---input-R- humidite relative a la surface
    REAL, dimension(klon), intent(in):: rugos
    ! rugos---input-R- rugosite
    DOUBLE PRECISION, dimension(klon), intent(in):: lmon
    ! lmon----input-R- longueur de Monin-Obukov
    REAL, intent(in):: ustar(:) ! (knon) facteur d'\'echelle pour le vent
    REAL, dimension(klon), intent(in):: testar
    ! testar--input-R- facteur d'echelle pour la temperature potentielle
    REAL, dimension(klon), intent(in):: qstar
    ! qstar---input-R- facteur d'echelle pour l'humidite relative
    REAL, intent(in):: zref
    ! zref----input-R- altitude de reference

    REAL, dimension(klon), intent(out):: delu
    ! delu----input-R- anomalie du vent par rapport au 1er niveau

    REAL, dimension(klon), intent(out):: delte
    ! anomalie de la temperature potentielle par rapport a la surface

    REAL, dimension(klon), intent(out):: delq
    ! delq----input-R- anomalie de l'humidite relative par rapport a la surface

    ! Local:
    REAL, PARAMETER:: RKAR=0.40
    INTEGER i
    REAL xtmp, xtmp0
    
    !-------------------------------------------------------------------------
    
    DO i = 1, knon
       IF (lmon(i) >= 0.) THEN
          ! STABLE CASE
          IF (speed(i) > 1.5.AND.lmon(i) <= 1.0) THEN
             delu(i) = (ustar(i)/RKAR)* &
                  (log(zref/(rugos(i))+1.) + &
                  min(5d0, 5d0 *(zref - rugos(i))/lmon(i)))
             delte(i) = (testar(i)/RKAR)* &
                  (log(zref/(rugos(i))+1.) + &
                  min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))
             delq(i) = (qstar(i)/RKAR)* &
                  (log(zref/(rugos(i))+1.) + &
                  min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))
          ELSE
             delu(i) = 0.1 * speed(i)
             delte(i) = 0.1 * (tair(i) - ts(i))
             delq(i) = 0.1 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
          ENDIF
       ELSE
          ! UNSTABLE CASE
          IF (speed(i) > 5.0.AND.abs(lmon(i)) <= 50.0) THEN
             xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
             xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
             delu(i) = (ustar(i)/RKAR)* &
                  (log(zref/(rugos(i))+1.) &
                  - 2.*log(0.5*(1. + xtmp)) &
                  + 2.*log(0.5*(1. + xtmp0)) &
                  - log(0.5*(1. + xtmp*xtmp)) &
                  + log(0.5*(1. + xtmp0*xtmp0)) &
                  + 2.*atan(xtmp) - 2.*atan(xtmp0))
             delte(i) = (testar(i)/RKAR)* &
                  (log(zref/(rugos(i))+1.) &
                  - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
                  + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
             delq(i) = (qstar(i)/RKAR)* &
                  (log(zref/(rugos(i))+1.) &
                  - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
                  + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
          ELSE
             delu(i) = 0.5 * speed(i)
             delte(i) = 0.5 * (tair(i) - ts(i))
             delq(i) = 0.5 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
          ENDIF
       ENDIF
    ENDDO

  END SUBROUTINE screenp

end module screenp_m
1	guez	178	module screenp_m
2
3			IMPLICIT none
4
5			contains
6
7	guez	227	SUBROUTINE screenp(knon, speed, tair, qair, ts, qsurf, rugos, lmon, ustar, &
8			testar, qstar, zref, delu, delte, delq)
9	guez	178
10	guez	227	! From LMDZ4/libf/phylmd/screenp.F90, version 1.1.1.1, 2004/05/19 12:53:09
11
12			! Objet : calcul "pr\'edicteur" des anomalies du vent, de la
13			! temp\'erature potentielle et de l'humidit\'e relative au niveau
14			! de r\'ef\'erence zref et par rapport au 1er niveau (pour u) ou
15			! \`a la surface (pour theta et q) \`a partir des relations de
16			! Dyer-Businger.
17
18	guez	246	! Reference: Hess, Colman and McAvaney (1995)
19	guez	227
20	guez	178	! I. Musat, 01.07.2002
21	guez	227
22			use dimphy, only: klon
23
24			INTEGER, intent(in):: knon
25	guez	178	! knon----input-I- nombre de points pour un type de surface
26	guez	246	REAL, dimension(klon), intent(in):: speed
27	guez	178	! speed---input-R- module du vent au 1er niveau du modele
28	guez	246	REAL, dimension(klon), intent(in):: tair
29	guez	178	! tair----input-R- temperature de l'air au 1er niveau du modele
30	guez	246	REAL, dimension(klon), intent(in):: qair
31	guez	178	! qair----input-R- humidite relative au 1er niveau du modele
32	guez	246	REAL, dimension(klon), intent(in):: ts
33	guez	178	! ts------input-R- temperature de l'air a la surface
34	guez	246	REAL, dimension(klon), intent(in):: qsurf
35	guez	178	! qsurf---input-R- humidite relative a la surface
36	guez	246	REAL, dimension(klon), intent(in):: rugos
37	guez	178	! rugos---input-R- rugosite
38	guez	227	DOUBLE PRECISION, dimension(klon), intent(in):: lmon
39	guez	178	! lmon----input-R- longueur de Monin-Obukov
40	guez	246	REAL, intent(in):: ustar(:) ! (knon) facteur d'\'echelle pour le vent
41			REAL, dimension(klon), intent(in):: testar
42	guez	178	! testar--input-R- facteur d'echelle pour la temperature potentielle
43	guez	246	REAL, dimension(klon), intent(in):: qstar
44	guez	178	! qstar---input-R- facteur d'echelle pour l'humidite relative
45	guez	227	REAL, intent(in):: zref
46	guez	178	! zref----input-R- altitude de reference
47	guez	227
48			REAL, dimension(klon), intent(out):: delu
49	guez	178	! delu----input-R- anomalie du vent par rapport au 1er niveau
50	guez	227
51			REAL, dimension(klon), intent(out):: delte
52			! anomalie de la temperature potentielle par rapport a la surface
53
54			REAL, dimension(klon), intent(out):: delq
55	guez	178	! delq----input-R- anomalie de l'humidite relative par rapport a la surface
56	guez	227
57			! Local:
58			REAL, PARAMETER:: RKAR=0.40
59			INTEGER i
60			REAL xtmp, xtmp0
61
62	guez	178	!-------------------------------------------------------------------------
63	guez	227
64	guez	178	DO i = 1, knon
65	guez	227	IF (lmon(i) >= 0.) THEN
66	guez	178	! STABLE CASE
67	guez	227	IF (speed(i) > 1.5.AND.lmon(i) <= 1.0) THEN
68	guez	178	delu(i) = (ustar(i)/RKAR)* &
69			(log(zref/(rugos(i))+1.) + &
70			min(5d0, 5d0 *(zref - rugos(i))/lmon(i)))
71			delte(i) = (testar(i)/RKAR)* &
72			(log(zref/(rugos(i))+1.) + &
73			min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))
74			delq(i) = (qstar(i)/RKAR)* &
75			(log(zref/(rugos(i))+1.) + &
76			min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))
77	guez	3	ELSE
78	guez	227	delu(i) = 0.1 * speed(i)
79			delte(i) = 0.1 * (tair(i) - ts(i))
80			delq(i) = 0.1 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
81	guez	3	ENDIF
82	guez	227	ELSE
83	guez	178	! UNSTABLE CASE
84	guez	227	IF (speed(i) > 5.0.AND.abs(lmon(i)) <= 50.0) THEN
85	guez	178	xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
86			xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
87			delu(i) = (ustar(i)/RKAR)* &
88	guez	227	(log(zref/(rugos(i))+1.) &
89	guez	178	- 2.log(0.5(1. + xtmp)) &
90			+ 2.log(0.5(1. + xtmp0)) &
91			- log(0.5(1. + xtmpxtmp)) &
92			+ log(0.5(1. + xtmp0xtmp0)) &
93			+ 2.atan(xtmp) - 2.atan(xtmp0))
94			delte(i) = (testar(i)/RKAR)* &
95			(log(zref/(rugos(i))+1.) &
96	guez	227	- 2.0 * log(0.5(1. + xtmpxtmp)) &
97	guez	178	+ 2.0 * log(0.5(1. + xtmp0xtmp0)))
98	guez	227	delq(i) = (qstar(i)/RKAR)* &
99	guez	178	(log(zref/(rugos(i))+1.) &
100	guez	227	- 2.0 * log(0.5(1. + xtmpxtmp)) &
101	guez	178	+ 2.0 * log(0.5(1. + xtmp0xtmp0)))
102	guez	3	ELSE
103	guez	227	delu(i) = 0.5 * speed(i)
104			delte(i) = 0.5 * (tair(i) - ts(i))
105			delq(i) = 0.5 * (max(qair(i), 0.0) - max(qsurf(i), 0.0))
106	guez	3	ENDIF
107	guez	178	ENDIF
108			ENDDO
109	guez	227
110	guez	178	END SUBROUTINE screenp
111
112			end module screenp_m