source: LMDZ.3.3/branches/rel-LF/libf/phylmd/screenp.F90 @ 520

Last change on this file since 520 was 418, checked in by (none), 22 years ago

This commit was manufactured by cvs2svn to create branch 'rel-LF'.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.4 KB
Line 
1      SUBROUTINE screenp(klon, knon, nsrf, &
2     &                   speed, tair, qair, &
3     &                   ts, qsurf, rugos, lmon, &
4     &                   ustar, testar, qstar, zref, &
5     &                   delu, delte, delq)
6      IMPLICIT none
7!-------------------------------------------------------------------------
8!
9! Objet : calcul "predicteur" des anomalies du vent, de la temperature
10!         potentielle et de l'humidite relative au niveau de reference zref et
11!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
12!         a partir des relations de Dyer-Businger.
13!
14! Reference : Hess, Colman et McAvaney (1995)
15!
16! I. Musat, 01.07.2002
17!-------------------------------------------------------------------------
18!
19! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
20! knon----input-I- nombre de points pour un type de surface
21! nsrf----input-I- indice pour le type de surface; voir indicesol.inc
22! speed---input-R- module du vent au 1er niveau du modele
23! tair----input-R- temperature de l'air au 1er niveau du modele
24! qair----input-R- humidite relative au 1er niveau du modele
25! ts------input-R- temperature de l'air a la surface
26! qsurf---input-R- humidite relative a la surface
27! rugos---input-R- rugosite
28! lmon----input-R- longueur de Monin-Obukov
29! ustar---input-R- facteur d'echelle pour le vent
30! testar--input-R- facteur d'echelle pour la temperature potentielle
31! qstar---input-R- facteur d'echelle pour l'humidite relative
32! zref----input-R- altitude de reference
33!
34! delu----input-R- anomalie du vent par rapport au 1er niveau
35! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
36! delq----input-R- anomalie de l'humidite relative par rapport a la surface
37!
38      INTEGER, intent(in) :: klon, knon, nsrf
39      REAL, dimension(klon), intent(in) :: speed, tair, qair
40      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
41      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon
42      REAL, dimension(klon), intent(in) :: ustar, testar, qstar
43      REAL, intent(in) :: zref
44!
45      REAL, dimension(klon), intent(out) :: delu, delte, delq
46!
47!-------------------------------------------------------------------------
48! Variables locales et constantes :
49      REAL, PARAMETER :: RKAR=0.40
50      INTEGER :: i
51      REAL :: xtmp, xtmp0
52!-------------------------------------------------------------------------
53      DO i = 1, knon
54!
55        IF (lmon(i).GE.0.) THEN
56!
57! STABLE CASE
58!
59          IF (speed(i).GT.1.5.AND.lmon(i).LE.1.0) THEN
60            delu(i) = (ustar(i)/RKAR)* &
61                      (log(zref/(rugos(i))+1.) + &
62                      min(5.0, 5.0 *(zref - rugos(i))/lmon(i)))
63            delte(i) = (testar(i)/RKAR)* &
64                       (log(zref/(rugos(i))+1.) + &
65                       min(5.0, 5.0 * (zref - rugos(i))/lmon(i)))
66            delq(i) = (qstar(i)/RKAR)* &
67                      (log(zref/(rugos(i))+1.) + &
68                      min(5.0, 5.0 * (zref - rugos(i))/lmon(i)))
69          ELSE
70            delu(i)  = 0.1 * speed(i)
71            delte(i) = 0.1 * (tair(i) - ts(i) )
72            delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
73          ENDIF
74        ELSE 
75!
76! UNSTABLE CASE
77!
78          IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN
79            xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
80            xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
81            delu(i) = (ustar(i)/RKAR)* &
82                      (log(zref/(rugos(i))+1.) &
83                      - 2.*log(0.5*(1. + xtmp)) &
84                      + 2.*log(0.5*(1. + xtmp0)) &
85                      - log(0.5*(1. + xtmp*xtmp)) &
86                      + log(0.5*(1. + xtmp0*xtmp0)) &
87                      + 2.*atan(xtmp) - 2.*atan(xtmp0))
88            delte(i) = (testar(i)/RKAR)* &
89                       (log(zref/(rugos(i))+1.) &
90                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
91                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
92            delq(i)  = (qstar(i)/RKAR)* &
93                       (log(zref/(rugos(i))+1.) &
94                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
95                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
96          ELSE
97            delu(i)  = 0.5 * speed(i)
98            delte(i) = 0.5 * (tair(i) - ts(i) )
99            delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
100          ENDIF
101        ENDIF
102!
103      ENDDO
104      RETURN
105      END SUBROUTINE screenp
Note: See TracBrowser for help on using the repository browser.