source: LMDZ6/trunk/libf/phylmd/coefcdrag.f90 @ 5403

Last change on this file since 5403 was 5285, checked in by abarral, 7 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

  • 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: 6.0 KB
RevLine 
[524]1!
2!
3!
4      SUBROUTINE coefcdrag (klon, knon, nsrf, zxli, &
5                            speed, t, q, zgeop, psol, &
6                            ts, qsurf, rugos, okri, ri1, &
7                            cdram, cdrah, cdran, zri1, pref)
[1785]8
[5282]9      USE clesphys_mod_h
[1785]10      USE indice_sol_mod
11
[5285]12      USE yomcst_mod_h
[5284]13      USE yoethf_mod_h
[5274]14IMPLICIT none
[524]15!-------------------------------------------------------------------------
[5274]16! Objet : calcul des cdrags pour le moment (cdram) et les flux de chaleur
17!         sensible et latente (cdrah), du cdrag neutre (cdran),
18!         du nombre de Richardson entre la surface et le niveau de reference
19!         (zri1) et de la pression au niveau de reference (pref).
[524]20!
21! I. Musat, 01.07.2002
22!-------------------------------------------------------------------------
23!
24! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
25! knon----input-I- nombre de points pour un type de surface
[1785]26! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
[524]27! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
28! speed---input-R- module du vent au 1er niveau du modele
29! t-------input-R- temperature de l'air au 1er niveau du modele
30! q-------input-R- humidite de l'air au 1er niveau du modele
31! zgeop---input-R- geopotentiel au 1er niveau du modele
[5274]32! psol----input-R- pression au sol
[524]33! ts------input-R- temperature de l'air a la surface
34! qsurf---input-R- humidite de l'air a la surface
35! rugos---input-R- rugosite
[5274]36! okri----input-L- TRUE si on veut tester le nb. Richardson entre la sfce
[524]37!                  et zref par rapport au Ri entre la sfce et la 1ere couche
38! ri1-----input-R- nb. Richardson entre la surface et la 1ere couche
39!
40! cdram--output-R- cdrag pour le moment
41! cdrah--output-R- cdrag pour les flux de chaleur latente et sensible
42! cdran--output-R- cdrag neutre
43! zri1---output-R- nb. Richardson entre la surface et la couche zgeop/RG
44! pref---output-R- pression au niveau zgeop/RG
45!
46      INTEGER, intent(in) :: klon, knon, nsrf
[5274]47      LOGICAL, intent(in) :: zxli
[524]48      REAL, dimension(klon), intent(in) :: speed, t, q, zgeop, psol
[5274]49      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos, ri1
50      LOGICAL, intent(in) :: okri
[524]51!
52      REAL, dimension(klon), intent(out) :: cdram, cdrah, cdran, zri1, pref
53!-------------------------------------------------------------------------
54!
[5274]55
[524]56! Quelques constantes :
[1061]57      REAL, parameter :: RKAR=0.40, CB=5.0, CC=5.0, CD=5.0, cepdu2=(0.1)**2
[524]58!
59! Variables locales :
60      INTEGER :: i
61      REAL, dimension(klon) :: zdu2, zdphi, ztsolv, ztvd
62      REAL, dimension(klon) :: zscf, friv, frih, zucf, zcr
63      REAL, dimension(klon) :: zcfm1, zcfh1
64      REAL, dimension(klon) :: zcfm2, zcfh2
65      REAL, dimension(klon) :: trm0, trm1
[2126]66
[2232]67  CHARACTER (LEN=80) :: abort_message
68  CHARACTER (LEN=20) :: modname = 'coefcdra'
69
70
71!
72
73
[524]74!-------------------------------------------------------------------------
75      REAL :: fsta, fins, x
76      fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
77      fins(x) = SQRT(1.0-18.0*x)
78!-------------------------------------------------------------------------
[2232]79
80  abort_message='obsolete, remplace par cdrag, use at you own risk'
[2311]81  CALL abort_physic(modname,abort_message,1)
[2232]82
[524]83!
84      DO i = 1, knon
85!
86       zdphi(i) = zgeop(i)
[1061]87       zdu2(i) = max(cepdu2,speed(i)**2)
[524]88       pref(i) = exp(log(psol(i)) - zdphi(i)/(RD*t(i)* &
89                 (1.+ RETV * max(q(i),0.0))))
90       ztsolv(i) = ts(i)
[2011]91!       ztvd(i) = t(i) * (psol(i)/pref(i))**RKAPPA
[2158]92!       ztvd(i) = (t(i)+zdphi(i)/RCPD/(1.+RVTMP2*q(i))) &
93!          *(1.+RETV*q(i))
94       ztvd(i) = (t(i)+zdphi(i)/RCPD/(1.+RVTMP2*q(i)))
[524]95       trm0(i) = 1. + RETV * max(qsurf(i),0.0)
96       trm1(i) = 1. + RETV * max(q(i),0.0)
97       ztsolv(i) = ztsolv(i) * trm0(i)
[2158]98       ztvd(i) = ztvd(i) * trm1(i)
[524]99       zri1(i) = zdphi(i)*(ztvd(i)-ztsolv(i))/(zdu2(i)*ztvd(i))
100!
101! on teste zri1 par rapport au Richardson de la 1ere couche ri1
102!
103!IM +++
104       IF(1.EQ.0) THEN
105       IF (okri) THEN
106         IF (ri1(i).GE.0.0.AND.zri1(i).LT.0.0) THEN
107           zri1(i) = ri1(i)
108         ELSE IF(ri1(i).LT.0.0.AND.zri1(i).GE.0.0) THEN
109           zri1(i) = ri1(i)
110         ENDIF
111       ENDIF
112       ENDIF
113!IM ---
114!
115       cdran(i) = (RKAR/log(1.+zdphi(i)/(RG*rugos(i))))**2
116
117       IF (zri1(i) .ge. 0.) THEN
118!
119! situation stable : pour eviter les inconsistances dans les cas
120! tres stables on limite zri1 a 20. cf Hess et al. (1995)
121!
122         zri1(i) = min(20.,zri1(i))
123!
124         IF (.NOT.zxli) THEN
125           zscf(i) = SQRT(1.+CD*ABS(zri1(i)))
[2126]126           friv(i) = max(1. / (1.+2.*CB*zri1(i)/ zscf(i)), f_ri_cd_min)
[524]127           zcfm1(i) = cdran(i) * friv(i)
[2126]128           frih(i) = max(1./ (1.+3.*CB*zri1(i)*zscf(i)), f_ri_cd_min )
[2011]129!           zcfh1(i) = cdran(i) * frih(i)
130           zcfh1(i) = f_cdrag_ter*cdran(i) * frih(i)
131           IF(nsrf.EQ.is_oce) zcfh1(i)=f_cdrag_oce*cdran(i)*frih(i)
[524]132           cdram(i) = zcfm1(i)
133           cdrah(i) = zcfh1(i)
134         ELSE
135           cdram(i) = cdran(i)* fsta(zri1(i))
136           cdrah(i) = cdran(i)* fsta(zri1(i))
137         ENDIF
138!
139       ELSE
140!
141! situation instable
142!
143         IF (.NOT.zxli) THEN
144           zucf(i) = 1./(1.+3.0*CB*CC*cdran(i)*SQRT(ABS(zri1(i)) &
145                 *(1.0+zdphi(i)/(RG*rugos(i)))))
[2126]146           zcfm2(i) = cdran(i)*max((1.-2.0*CB*zri1(i)*zucf(i)),f_ri_cd_min)
147!           zcfh2(i) = cdran(i)*max((1.-3.0*CB*zri1(i)*zucf(i)),f_ri_cd_min)
148           zcfh2(i) = f_cdrag_ter*cdran(i)*max((1.-3.0*CB*zri1(i)*zucf(i)),f_ri_cd_min)
[524]149           cdram(i) = zcfm2(i)
150           cdrah(i) = zcfh2(i)
151         ELSE
152           cdram(i) = cdran(i)* fins(zri1(i))
153           cdrah(i) = cdran(i)* fins(zri1(i))
154         ENDIF
155!
156! cdrah sur l'ocean cf. Miller et al. (1992)
157!
158         zcr(i) = (0.0016/(cdran(i)*SQRT(zdu2(i))))*ABS(ztvd(i)-ztsolv(i)) &
159               **(1./3.)
[2011]160!         IF (nsrf.EQ.is_oce) cdrah(i) = cdran(i)*(1.0+zcr(i)**1.25) &
161!                  **(1./1.25)
162         IF (nsrf.EQ.is_oce) cdrah(i)=f_cdrag_oce*cdran(i)*(1.0+zcr(i)**1.25) &
[524]163                  **(1./1.25)
164       ENDIF
165!
166      END DO
167      RETURN
168      END SUBROUTINE coefcdrag
Note: See TracBrowser for help on using the repository browser.