7 pz0sea,pta,pexna,prhoa,psst,pexns,pqa, &
8 pvmod,pzref,puref,pps,pqsat,psfth,psftq,pustar,pcd,pcdn,pch,pce,pri,&
66 USE modd_csts, ONLY : xkarman, xg, xstefan, xrd, xrv, xpi, &
67 xlvtt, xcl, xcpd, xcpv, xrholw, xtt, &
75 USE modi_wind_threshold
84 USE yomhook
,ONLY : lhook, dr_hook
85 USE parkind1
,ONLY : jprb
95 REAL,
DIMENSION(:),
INTENT(IN) :: pta
96 REAL,
DIMENSION(:),
INTENT(IN) :: pqa
97 REAL,
DIMENSION(:),
INTENT(IN) :: pexna
98 REAL,
DIMENSION(:),
INTENT(IN) :: prhoa
99 REAL,
DIMENSION(:),
INTENT(IN) :: pvmod
100 REAL,
DIMENSION(:),
INTENT(IN) :: pzref
101 REAL,
DIMENSION(:),
INTENT(IN) :: puref
102 REAL,
DIMENSION(:),
INTENT(IN) :: psst
103 REAL,
DIMENSION(:),
INTENT(IN) :: pexns
104 REAL,
DIMENSION(:),
INTENT(IN) :: pps
105 REAL,
DIMENSION(:),
INTENT(IN) :: prain
107 REAL,
DIMENSION(:),
INTENT(INOUT) :: pz0sea
110 REAL,
DIMENSION(:),
INTENT(OUT) :: psfth
111 REAL,
DIMENSION(:),
INTENT(OUT) :: psftq
112 REAL,
DIMENSION(:),
INTENT(OUT) :: pustar
115 REAL,
DIMENSION(:),
INTENT(OUT) :: pqsat
116 REAL,
DIMENSION(:),
INTENT(OUT) :: pcd
117 REAL,
DIMENSION(:),
INTENT(OUT) :: pcdn
118 REAL,
DIMENSION(:),
INTENT(OUT) :: pch
119 REAL,
DIMENSION(:),
INTENT(OUT) :: pce
120 REAL,
DIMENSION(:),
INTENT(OUT) :: pri
121 REAL,
DIMENSION(:),
INTENT(OUT) :: presa
122 REAL,
DIMENSION(:),
INTENT(OUT) :: pz0hsea
127 REAL,
DIMENSION(SIZE(PTA)) :: zvmod
128 REAL,
DIMENSION(SIZE(PTA)) :: zpa
129 REAL,
DIMENSION(SIZE(PTA)) :: zta
130 REAL,
DIMENSION(SIZE(PTA)) :: zqasat
132 REAL,
DIMENSION(SIZE(PTA)) :: zo
133 REAL,
DIMENSION(SIZE(PTA)) :: zwg
135 REAL,
DIMENSION(SIZE(PTA)) :: zdu,zdt,zdq,zduwg
137 REAL,
DIMENSION(SIZE(PTA)) :: zusr
138 REAL,
DIMENSION(SIZE(PTA)) :: ztsr
139 REAL,
DIMENSION(SIZE(PTA)) :: zqsr
141 REAL,
DIMENSION(SIZE(PTA)) :: zu10,zt10
142 REAL,
DIMENSION(SIZE(PTA)) :: zvisa
143 REAL,
DIMENSION(SIZE(PTA)) :: zo10,zot10
144 REAL,
DIMENSION(SIZE(PTA)) :: zcd,zct,zcc
145 REAL,
DIMENSION(SIZE(PTA)) :: zcd10,zct10
146 REAL,
DIMENSION(SIZE(PTA)) :: zribu,zribcu
147 REAL,
DIMENSION(SIZE(PTA)) :: zetu,zl10
149 REAL,
DIMENSION(SIZE(PTA)) :: zcharn
150 REAL,
DIMENSION(SIZE(PTA)) :: ztwave,zhwave,zcwave,zlwave
152 REAL,
DIMENSION(SIZE(PTA)) :: zzl,zztl
154 REAL,
DIMENSION(SIZE(PTA)) :: zrr
155 REAL,
DIMENSION(SIZE(PTA)) :: zot,zoq
156 REAL,
DIMENSION(SIZE(PTA)) :: zpuz,zptz,zpqz
158 REAL,
DIMENSION(SIZE(PTA)) :: zbf
160 REAL,
DIMENSION(SIZE(PTA)) :: ztau
161 REAL,
DIMENSION(SIZE(PTA)) :: zhf
162 REAL,
DIMENSION(SIZE(PTA)) :: zef
163 REAL,
DIMENSION(SIZE(PTA)) :: zwbar
164 REAL,
DIMENSION(SIZE(PTA)) :: ztaur
165 REAL,
DIMENSION(SIZE(PTA)) :: zrf
166 REAL,
DIMENSION(SIZE(PTA)) :: zchn,zcen
168 REAL,
DIMENSION(SIZE(PTA)) :: zlv
170 REAL,
DIMENSION(SIZE(PTA)) :: ztac,zdqsdt,zdtmp,zdwat,zalfac
171 REAL,
DIMENSION(SIZE(PTA)) :: zxlr
172 REAL,
DIMENSION(SIZE(PTA)) :: zcplw
174 REAL,
DIMENSION(SIZE(PTA)) :: zustar2
176 REAL,
DIMENSION(SIZE(PTA)) :: zdircoszw
177 REAL,
DIMENSION(SIZE(PTA)) :: zac
180 INTEGER,
DIMENSION(SIZE(PTA)) :: itermax
182 REAL :: zrvsrdm1,zrdsrv,zr2
190 REAL(KIND=JPRB) :: zhook_handle
199 IF (lhook) CALL dr_hook(
'COARE30_FLUX',0,zhook_handle)
201 zrvsrdm1 = xrv/xrd-1.
233 WHERE((pta(:)*pexns(:)/pexna(:)-psst(:))==0.)
251 zpa(:) = xp00* (pexna(:)**(xcpd/xrd))
252 zqasat(:) =
qsat(zta(:),zpa(:))
257 IF (s%LPWG) zwg(:) = 0.5
267 zdt(j) = -(zta(j)/pexna(j)) + (psst(j)/pexns(j))
268 zdq(j) = pqsat(j)-pqa(j)
270 zduwg(j) = sqrt(zdu(j)**2+zwg(j)**2)
274 zu10(j) = zduwg(j)*log(zs/zo(j))/log(puref(j)/zo(j))
275 zusr(j) = 0.035*zu10(j)
276 zvisa(j) = 1.326e-5*(1.+6.542e-3*(zta(j)-xtt)+&
277 8.301e-6*(zta(j)-xtt)**2-4.84e-9*(zta(j)-xtt)**3)
279 zo10(j) = zcharn(j)*zusr(j)*zusr(j)/xg+0.11*zvisa(j)/zusr(j)
280 zcd(j) = (xkarman/log(puref(j)/zo10(j)))**2
281 zcd10(j)= (xkarman/log(zs/zo10(j)))**2
282 zct10(j)= zch10/sqrt(zcd10(j))
283 zot10(j)= zs/exp(xkarman/zct10(j))
287 zct(j) = xkarman/log(pzref(j)/zot10(j))
288 zcc(j) = xkarman*zct(j)/zcd(j)
290 zribcu(j) = -puref(j)/(zzbl*0.004*zbetagust**3)
293 zribu(j) = -xg*puref(j)*(zdt(j)+zrvsrdm1*zta(j)*zdq(j))/&
296 IF (zribu(j)<0.)
THEN
297 zetu(j) = zcc(j)*zribu(j)/(1.+zribu(j)/zribcu(j))
299 zetu(j) = zcc(j)*zribu(j)/(1.+27./9.*zribu(j)/zcc(j))
302 zl10(j) = puref(j)/zetu(j)
307 zusr(:) = zduwg(:)*xkarman/(log(puref(:)/zo10(:))-
psifctu(puref(:)/zl10(:)))
308 ztsr(:) = -zdt(:)*xkarman/(log(pzref(:)/zot10(:))-
psifctt(pzref(:)/zl10(:)))
309 zqsr(:) = -zdq(:)*xkarman/(log(pzref(:)/zot10(:))-
psifctt(pzref(:)/zl10(:)))
315 IF (zetu(j)>50.)
THEN
322 IF (zduwg(j)>10.) zcharn(j) = 0.011 + (0.018-0.011)*(zduwg(j)-10.)/(18.-10.)
323 IF (zduwg(j)>18.) zcharn(j) = 0.018
328 zhwave(j) = 0.018*zvmod(j)*zvmod(j)*(1.+0.015*zvmod(j))
329 ztwave(j) = 0.729*zvmod(j)
330 zcwave(j) = xg*ztwave(j)/(2.*xpi)
331 zlwave(j) = ztwave(j)*zcwave(j)
337 DO jloop=1,maxval(itermax)
341 IF (jloop.GT.itermax(j)) cycle
343 IF (s%NGRVWAVES==0)
THEN
344 zo(j) = zcharn(j)*zusr(j)*zusr(j)/xg + 0.11*zvisa(j)/zusr(j)
345 ELSE IF (s%NGRVWAVES==1)
THEN
346 zo(j) = (50./(2.*xpi))*zlwave(j)*(zusr(j)/zcwave(j))**4.5 &
347 + 0.11*zvisa(j)/zusr(j)
348 ELSE IF (s%NGRVWAVES==2)
THEN
349 zo(j) = 1200.*zhwave(j)*(zhwave(j)/zlwave(j))**4.5 &
350 + 0.11*zvisa(j)/zusr(j)
353 zrr(j) = zo(j)*zusr(j)/zvisa(j)
354 zoq(j) = min(1.15e-4 , 5.5e-5/zrr(j)**0.6)
357 zzl(j) = xkarman * xg * puref(j) * &
358 ( ztsr(j)*(1.+zrvsrdm1*pqa(j)) + zrvsrdm1*zta(j)*zqsr(j) ) / &
359 ( zta(j)*zusr(j)*zusr(j)*(1.+zrvsrdm1*pqa(j)) )
360 zztl(j)= zzl(j)*pzref(j)/puref(j)
374 zusr(j) = zduwg(j)*xkarman/(log(puref(j)/zo(j)) -zpuz(j))
375 ztsr(j) = -zdt(j) *xkarman/(log(pzref(j)/zot(j))-zptz(j))
376 zqsr(j) = -zdq(j) *xkarman/(log(pzref(j)/zoq(j))-zpqz(j))
381 zbf(j) = -xg/zta(j)*zusr(j)*(ztsr(j)+zrvsrdm1*zta(j)*zqsr(j))
383 zwg(j) = zbetagust*(zbf(j)*zzbl)**(1./3.)
388 zduwg(j) = sqrt(zvmod(j)**2 + zwg(j)**2)
412 pcd(j) = (zusr(j)/zduwg(j))**2.
413 pch(j) = zusr(j)*ztsr(j)/(zduwg(j)*(zta(j)*pexns(j)/pexna(j)-psst(j)))
414 pce(j) = zusr(j)*zqsr(j)/(zduwg(j)*(pqa(j)-pqsat(j)))
416 pcdn(j) = (xkarman/log(zs/zo(j)))**2.
417 zchn(j) = (xkarman/log(zs/zo(j)))*(xkarman/log(zs/zot(j)))
418 zcen(j) = (xkarman/log(zs/zo(j)))*(xkarman/log(zs/zoq(j)))
420 zlv(j) = xlvtt + (xcpv-xcl)*(psst(j)-xtt)
424 IF (abs(pcdn(j))>1.e-2)
THEN
425 write(*,*)
'pb PCDN in COARE30: ',pcdn(j)
426 write(*,*)
'point: ',j,
"/",
SIZE(pta)
427 write(*,*)
'roughness: ', zo(j)
428 write(*,*)
'ustar: ',zusr(j)
429 write(*,*)
'wind: ',zduwg(j)
430 CALL
abor1_sfx(
'COARE30: PCDN too large -> no convergence')
434 ztau(j) = -prhoa(j)*zusr(j)*zusr(j)*zvmod(j)/zduwg(j)
435 zhf(j) = prhoa(j)*xcpd*zusr(j)*ztsr(j)
436 zef(j) = prhoa(j)*zlv(j)*zusr(j)*zqsr(j)
449 zxlr(j) = xlvtt + (xcpv-xcl)* ztac(j)
450 zdqsdt(j)= zqasat(j) * zxlr(j) / (xrd*zta(j)**2)
451 zdtmp(j) = (1.0 + 3.309e-3*ztac(j) -1.44e-6*ztac(j)*ztac(j)) * &
452 0.02411 / (prhoa(j)*xcpd)
454 zdwat(j) = 2.11e-5 * (xp00/zpa(j)) * (zta(j)/xtt)**1.94
456 zalfac(j)= 1.0 / (1.0 + &
457 zrdsrv*zdqsdt(j)*zxlr(j)*zdwat(j)/(zdtmp(j)*xcpd))
458 zcplw(j) = 4224.8482 + ztac(j) * &
459 ( -4.707 + ztac(j) * &
460 (0.08499 + ztac(j) * &
461 (1.2826e-3 + ztac(j) * &
462 (4.7884e-5 - 2.0027e-6* ztac(j)))))
464 zrf(j) = prain(j) * zcplw(j) * zalfac(j) * &
465 (psst(j) - zta(j) + (pqsat(j)-pqa(j))*zxlr(j)/xcpd )
469 ztaur(j)=-0.85*(prain(j) *zvmod(j))
475 zwbar(j)=- (1./zrdsrv)*zusr(j)*zqsr(j) / (1.0+(1./zrdsrv)*pqa(j)) &
476 - zusr(j)*ztsr(j)/zta(j)
480 zustar2(j)= - (ztau(j) + ztaur(j)) / prhoa(j)
481 pustar(j) = sqrt(zustar2(j))
485 psfth(j) = zhf(j) + zrf(j)
486 psftq(j) = zef(j) / zlv(j)
498 CALL
surface_ri(psst,pqsat,pexns,pexna,zta,zqasat,&
499 pzref,puref,zdircoszw,pvmod,pri )
503 zac(:) = pch(:)*zvmod(:)
504 presa(:) = 1. / max(zac(:),xsurf_epsilon)
508 pz0sea(:) = zcharn(:) * zustar2(:) / xg + xvz0cm * pcd(:) / pcdn(:)
510 pz0hsea(:) = pz0sea(:)
512 IF (lhook) CALL dr_hook(
'COARE30_FLUX',1,zhook_handle)
real function, dimension(size(pwind)) wind_threshold(PWIND, PUREF)
subroutine surface_ri(PTG, PQS, PEXNS, PEXNA, PTA, PQA, PZREF, PUREF, PDIRCOSZW, PVMOD, PRI)
subroutine abor1_sfx(YTEXT)
subroutine coare30_flux(S, PZ0SEA, PTA, PEXNA, PRHOA, PSST, PEXNS, PQA, PVMOD, PZREF, PUREF, PPS, PQSAT, PSFTH, PSFTQ, PUSTAR, PCD, PCDN, PCH, PCE, PRI, PRESA, PRAIN, PZ0HSEA)