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

Annotation of /trunk/phylmd/screenp.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 76 - (hide annotations)
Fri Nov 15 18:45:49 2013 UTC (10 years, 6 months ago) by guez
File size: 4590 byte(s)
Moved everything out of libf.
1 guez 3 !
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