/[lmdze]/trunk/phylmd/screenp.f
ViewVC logotype

Contents of /trunk/phylmd/screenp.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 82 - (show annotations)
Wed Mar 5 14:57:53 2014 UTC (10 years, 2 months ago) by guez
File size: 4590 byte(s)
Changed all ".f90" suffixes to ".f".
1 !
2 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/screenp.F90,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
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(5d0, 5d0 *(zref - rugos(i))/lmon(i)))
66 delte(i) = (testar(i)/RKAR)* &
67 (log(zref/(rugos(i))+1.) + &
68 min(5d0, 5d0 * (zref - rugos(i))/lmon(i)))
69 delq(i) = (qstar(i)/RKAR)* &
70 (log(zref/(rugos(i))+1.) + &
71 min(5d0, 5d0 * (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

  ViewVC Help
Powered by ViewVC 1.1.21