source: LMDZ5/trunk/libf/phylmd/screenp.F90 @ 5444

Last change on this file since 5444 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.5 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 indice_sol_mod.F90
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                        &
63     &                      .AND. rugos(i).LE.1.0) THEN
64            delu(i) = (ustar(i)/RKAR)* &
65                      (log(zref/(rugos(i))+1.) + &
66                      min(5.d0, 5.0 *(zref - rugos(i))/lmon(i)))
67            delte(i) = (testar(i)/RKAR)* &
68                       (log(zref/(rugos(i))+1.) + &
69                       min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
70            delq(i) = (qstar(i)/RKAR)* &
71                      (log(zref/(rugos(i))+1.) + &
72                      min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
73          ELSE
74            delu(i)  = 0.1 * speed(i)
75            delte(i) = 0.1 * (tair(i) - ts(i) )
76            delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
77          ENDIF
78        ELSE 
79!
80! UNSTABLE CASE
81!
82          IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN
83            xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
84            xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
85            delu(i) = (ustar(i)/RKAR)* &
86                      (log(zref/(rugos(i))+1.) &
87                      - 2.*log(0.5*(1. + xtmp)) &
88                      + 2.*log(0.5*(1. + xtmp0)) &
89                      - log(0.5*(1. + xtmp*xtmp)) &
90                      + log(0.5*(1. + xtmp0*xtmp0)) &
91                      + 2.*atan(xtmp) - 2.*atan(xtmp0))
92            delte(i) = (testar(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            delq(i)  = (qstar(i)/RKAR)* &
97                       (log(zref/(rugos(i))+1.) &
98                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
99                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
100          ELSE
101            delu(i)  = 0.5 * speed(i)
102            delte(i) = 0.5 * (tair(i) - ts(i) )
103            delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
104          ENDIF
105        ENDIF
106!
107      ENDDO
108      RETURN
109      END SUBROUTINE screenp
Note: See TracBrowser for help on using the repository browser.