/[lmdze]/trunk/libf/phylmd/clcdrag.f90
ViewVC logotype

Annotation of /trunk/libf/phylmd/clcdrag.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 2 months ago) by guez
File size: 4329 byte(s)
Initial import
1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/clcdrag.F90,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $
3     !
4     SUBROUTINE clcdrag(klon, knon, nsrf, zxli, &
5     u, v, t, q, zgeop, &
6     ts, qsurf, rugos, &
7     pcfm, pcfh)
8     use indicesol
9     use YOMCST
10     use yoethf
11     IMPLICIT NONE
12     ! ================================================================= c
13     !
14     ! Objet : calcul des cdrags pour le moment (pcfm) et
15     ! les flux de chaleur sensible et latente (pcfh).
16     !
17     ! ================================================================= c
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     ! zxli----input-L- calcul des cdrags selon Laurent Li
23     ! u-------input-R- vent zonal au 1er niveau du modele
24     ! v-------input-R- vent meridien au 1er niveau du modele
25     ! t-------input-R- temperature de l'air au 1er niveau du modele
26     ! q-------input-R- humidite de l'air au 1er niveau du modele
27     ! zgeop---input-R- geopotentiel au 1er niveau du modele
28     ! ts------input-R- temperature de l'air a la surface
29     ! qsurf---input-R- humidite de l'air a la surface
30     ! rugos---input-R- rugosite
31     !
32     ! pcfm---output-R- cdrag pour le moment
33     ! pcfh---output-R- cdrag pour les flux de chaleur latente et sensible
34     !
35     INTEGER, intent(in) :: klon, knon, nsrf
36     LOGICAL, intent(in) :: zxli
37     REAL, intent(in), dimension(klon) :: u, v, t, q, zgeop
38     REAL, intent(in), dimension(klon) :: ts, qsurf
39     REAL, intent(in), dimension(klon) :: rugos
40     REAL, intent(out), dimension(klon) :: pcfm, pcfh
41     ! ================================================================= c
42     !
43     !
44     ! Quelques constantes et options:
45     !!$PB REAL, PARAMETER :: ckap=0.35, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
46     REAL, PARAMETER :: ckap=0.40, cb=5.0, cc=5.0, cd=5.0, cepdu2=(0.1)**2
47     !
48     ! Variables locales :
49     INTEGER :: i
50     REAL :: zdu2, ztsolv, ztvd, zscf
51     REAL :: zucf, zcr
52     REAL :: friv, frih
53     REAL, dimension(klon) :: zcfm1, zcfm2
54     REAL, dimension(klon) :: zcfh1, zcfh2
55     REAL, dimension(klon) :: zcdn
56     REAL, dimension(klon) :: zri
57     !
58     ! Fonctions thermodynamiques et fonctions d'instabilite
59     REAL :: fsta, fins, x
60     fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
61     fins(x) = SQRT(1.0-18.0*x)
62     ! ================================================================= c
63     !
64     ! Calculer le frottement au sol (Cdrag)
65     !
66     DO i = 1, knon
67     zdu2 = max(cepdu2,u(i)**2+v(i)**2)
68     ztsolv = ts(i) * (1.0+RETV*qsurf(i))
69     ztvd = (t(i)+zgeop(i)/RCPD/(1.+RVTMP2*q(i))) &
70     *(1.+RETV*q(i))
71     zri(i) = zgeop(i)*(ztvd-ztsolv)/(zdu2*ztvd)
72     zcdn(i) = (ckap/log(1.+zgeop(i)/(RG*rugos(i))))**2
73     !
74     !!$ IF (zri(i) .ge. 0.) THEN ! situation stable
75     IF (zri(i) .gt. 0.) THEN ! situation stable
76     zri(i) = min(20.,zri(i))
77     IF (.NOT.zxli) THEN
78     zscf = SQRT(1.+cd*ABS(zri(i)))
79     FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), 0.1)
80     zcfm1(i) = zcdn(i) * FRIV
81     FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
82     !!$ PB zcfh1(i) = zcdn(i) * FRIH
83     zcfh1(i) = 0.8 * zcdn(i) * FRIH
84     pcfm(i) = zcfm1(i)
85     pcfh(i) = zcfh1(i)
86     ELSE
87     pcfm(i) = zcdn(i)* fsta(zri(i))
88     pcfh(i) = zcdn(i)* fsta(zri(i))
89     ENDIF
90     ELSE ! situation instable
91     IF (.NOT.zxli) THEN
92     zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
93     *(1.0+zgeop(i)/(RG*rugos(i)))))
94     zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
95     !!$PB zcfh2(i) = zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
96     zcfh2(i) = 0.8 * zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
97     pcfm(i) = zcfm2(i)
98     pcfh(i) = zcfh2(i)
99     ELSE
100     pcfm(i) = zcdn(i)* fins(zri(i))
101     pcfh(i) = zcdn(i)* fins(zri(i))
102     ENDIF
103     zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
104     IF(nsrf.EQ.is_oce) pcfh(i) =0.8* zcdn(i)*(1.0+zcr**1.25)**(1./1.25)
105     ENDIF
106     END DO
107     RETURN
108     END SUBROUTINE clcdrag

  ViewVC Help
Powered by ViewVC 1.1.21