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

Contents of /trunk/phylmd/cdrag.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 248 - (show annotations)
Fri Jan 5 16:40:13 2018 UTC (6 years, 4 months ago) by guez
Original Path: trunk/Sources/phylmd/clcdrag.f
File size: 3195 byte(s)
Move the call to clcdrag up from coefkz to clmain (folllowing
LMDZ). As both clcdrag and coefkz need zgeop, also move the
computation of zgeop from coefkz to clmain.

1 module clcdrag_m
2
3 IMPLICIT NONE
4
5 contains
6
7 SUBROUTINE clcdrag(nsrf, u, v, t, q, zgeop, ts, qsurf, rugos, pcfm, pcfh)
8
9 ! From LMDZ4/libf/phylmd/clcdrag.F90, version 1.1.1.1, 2004/05/19 12:53:07
10
11 ! Objet : calcul des cdrags pour le moment (pcfm) et les flux de
12 ! chaleur sensible et latente (pcfh).
13 ! Calculer le frottement au sol (Cdrag)
14
15 USE indicesol, ONLY: is_oce
16 use nr_util, only: assert_eq
17 USE suphec_m, ONLY: rcpd, retv, rg
18 USE yoethf_m, ONLY: rvtmp2
19
20 INTEGER, intent(in):: nsrf ! indice pour le type de surface
21
22 REAL, intent(in):: u(:), v(:) ! (knon) vent au 1er niveau du mod\`ele
23
24 REAL, intent(in):: t(:) ! (knon)
25 ! temperature de l'air au 1er niveau du modele
26
27 REAL, intent(in):: q(:) ! (knon) ! humidite de l'air au 1er niveau du modele
28 REAL, intent(in):: zgeop(:) ! (knon) géopotentiel au 1er niveau du modèle
29 REAL, intent(in):: ts(:) ! (knon) temperature de l'air a la surface
30 REAL, intent(in):: qsurf(:) ! (knon) humidite de l'air a la surface
31 REAL, intent(in):: rugos(:) ! (knon) rugosit\'e
32 REAL, intent(out):: pcfm(:) ! (knon) cdrag pour le moment
33
34 REAL, intent(out):: pcfh(:) ! (knon)
35 ! cdrag pour les flux de chaleur latente et sensible
36
37 ! Local:
38
39 ! Quelques constantes et options:
40 REAL, PARAMETER:: ckap=0.40, cb=5.0, cc=5.0, cd=5.0, cepdu2=0.1**2
41
42 INTEGER:: i, knon
43 REAL:: zdu2, ztsolv, ztvd, zscf
44 REAL:: zucf, zcr
45 REAL:: friv, frih
46 REAL, dimension(size(u)):: zcfm1, zcfm2
47 REAL, dimension(size(u)):: zcfh1, zcfh2
48 REAL, dimension(size(u)):: zcdn
49 REAL, dimension(size(u)):: zri
50
51 !--------------------------------------------------------------------
52
53 knon = assert_eq([size(u), size(v), size(t), size(q), size(zgeop), &
54 size(ts), size(qsurf), size(rugos), size(pcfm), size(pcfh), &
55 size(pcfm)], "clcdrag knon")
56
57 DO i = 1, knon
58 zdu2 = max(cepdu2,u(i)**2+v(i)**2)
59 ztsolv = ts(i) * (1.0+RETV*qsurf(i))
60 ztvd = (t(i)+zgeop(i)/RCPD/(1.+RVTMP2*q(i))) &
61 *(1.+RETV*q(i))
62 zri(i) = zgeop(i)*(ztvd-ztsolv)/(zdu2*ztvd)
63 zcdn(i) = (ckap/log(1.+zgeop(i)/(RG*rugos(i))))**2
64
65 IF (zri(i) .gt. 0.) THEN
66 ! situation stable
67 zri(i) = min(20.,zri(i))
68 zscf = SQRT(1.+cd*ABS(zri(i)))
69 FRIV = AMAX1(1. / (1.+2.*CB*zri(i)/ZSCF), 0.1)
70 zcfm1(i) = zcdn(i) * FRIV
71 FRIH = AMAX1(1./ (1.+3.*CB*zri(i)*ZSCF), 0.1 )
72 zcfh1(i) = 0.8 * zcdn(i) * FRIH
73 pcfm(i) = zcfm1(i)
74 pcfh(i) = zcfh1(i)
75 ELSE
76 ! situation instable
77 zucf = 1./(1.+3.0*cb*cc*zcdn(i)*SQRT(ABS(zri(i)) &
78 *(1.0+zgeop(i)/(RG*rugos(i)))))
79 zcfm2(i) = zcdn(i)*amax1((1.-2.0*cb*zri(i)*zucf),0.1)
80 zcfh2(i) = 0.8 * zcdn(i)*amax1((1.-3.0*cb*zri(i)*zucf),0.1)
81 pcfm(i) = zcfm2(i)
82 pcfh(i) = zcfh2(i)
83 zcr = (0.0016/(zcdn(i)*SQRT(zdu2)))*ABS(ztvd-ztsolv)**(1./3.)
84 IF(nsrf == is_oce) pcfh(i) = 0.8 * zcdn(i) &
85 * (1. + zcr**1.25)**(1. / 1.25)
86 ENDIF
87 END DO
88
89 END SUBROUTINE clcdrag
90
91 end module clcdrag_m

  ViewVC Help
Powered by ViewVC 1.1.21