source: LMDZ4/branches/IPSL-CM4_IPCC_patches/libf/phylmd/screenp.F90 @ 5306

Last change on this file since 5306 was 524, checked in by lmdzadmin, 20 years ago

Initial revision

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