[2630] | 1 | SUBROUTINE bl_for_dms(u,v,paprs,pplay,cdragh,cdragm |
---|
| 2 | . ,t,q,tsol,ustar,obklen) |
---|
| 3 | USE dimphy |
---|
| 4 | IMPLICIT NONE |
---|
| 5 | c |
---|
| 6 | c=================================================================== |
---|
| 7 | c Auteur : E. Cosme |
---|
| 8 | c Calcul de la vitesse de friction (ustar) et de la longueur de |
---|
| 9 | c Monin-Obukhov (obklen), necessaires pour calculer les flux de DMS |
---|
| 10 | c par la methode de Nightingale. |
---|
| 11 | c Cette subroutine est plus que fortement inspiree de la subroutine |
---|
| 12 | c 'nonlocal' dans clmain.F . |
---|
| 13 | c reference : Holtslag, A.A.M., and B.A. Boville, 1993: |
---|
| 14 | c Local versus nonlocal boundary-layer diffusion in a global climate |
---|
| 15 | c model. J. of Climate, vol. 6, 1825-1842. (a confirmer) |
---|
| 16 | c 31 08 01 |
---|
| 17 | c=================================================================== |
---|
| 18 | c |
---|
[4743] | 19 | INCLUDE "dimensions.h" |
---|
| 20 | INCLUDE "YOMCST.h" |
---|
| 21 | INCLUDE "YOETHF.h" |
---|
| 22 | INCLUDE "FCTTRE.h" |
---|
[2630] | 23 | c |
---|
| 24 | c Arguments : |
---|
| 25 | REAL u(klon,klev) ! vent zonal |
---|
| 26 | REAL v(klon,klev) ! vent meridien |
---|
| 27 | REAL paprs(klon,klev+1) ! niveaux de pression aux intercouches (Pa) |
---|
| 28 | REAL pplay(klon,klev) ! niveaux de pression aux milieux... (Pa) |
---|
| 29 | REAL cdragh(klon) ! coefficient de trainee pour la chaleur |
---|
| 30 | REAL cdragm(klon) ! coefficient de trainee pour le vent |
---|
| 31 | REAL t(klon,klev) ! temperature |
---|
| 32 | REAL q(klon,klev) ! humidite kg/kg |
---|
| 33 | REAL tsol(klon) ! temperature du sol |
---|
| 34 | REAL ustar(klon) ! vitesse de friction |
---|
| 35 | REAL obklen(klon) ! longueur de Monin-Obukhov |
---|
| 36 | c |
---|
| 37 | c Locales : |
---|
| 38 | REAL vk |
---|
| 39 | PARAMETER (vk=0.35) |
---|
| 40 | REAL beta ! coefficient d'evaporation reelle (/evapotranspiration) |
---|
| 41 | ! entre 0 et 1, mais 1 au-dessus de la mer |
---|
| 42 | PARAMETER (beta=1.) |
---|
| 43 | INTEGER i,k |
---|
| 44 | REAL zxt, zxu, zxv, zxq, zxqs, zxmod, taux, tauy |
---|
| 45 | REAL zcor, zdelta, zcvm5 |
---|
| 46 | REAL z(klon,klev) |
---|
| 47 | REAL zx_alf1, zx_alf2 ! parametres pour extrapolation |
---|
| 48 | REAL khfs(klon) ! surface kinematic heat flux [mK/s] |
---|
| 49 | REAL kqfs(klon) ! sfc kinematic constituent flux [m/s] |
---|
| 50 | REAL heatv(klon) ! surface virtual heat flux |
---|
| 51 | |
---|
| 52 | |
---|
| 53 | c |
---|
| 54 | c====================================================================== |
---|
| 55 | c |
---|
| 56 | c Calculer les hauteurs de chaque couche |
---|
| 57 | c |
---|
| 58 | ! JE20150707 r2es=611.14 *18.0153/28.9644 |
---|
| 59 | DO i = 1, klon |
---|
| 60 | z(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1))) |
---|
| 61 | . * (paprs(i,1)-pplay(i,1)) / RG |
---|
| 62 | ENDDO |
---|
| 63 | DO k = 2, klev |
---|
| 64 | DO i = 1, klon |
---|
| 65 | z(i,k) = z(i,k-1) |
---|
| 66 | . + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k) |
---|
| 67 | . * (pplay(i,k-1)-pplay(i,k)) / RG |
---|
| 68 | ENDDO |
---|
| 69 | ENDDO |
---|
| 70 | |
---|
| 71 | DO i = 1, klon |
---|
| 72 | c |
---|
| 73 | zdelta=MAX(0.,SIGN(1.,RTT-tsol(i))) |
---|
| 74 | zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta |
---|
| 75 | zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q(i,1)) |
---|
| 76 | zxqs= r2es * FOEEW(tsol(i),zdelta)/paprs(i,1) |
---|
| 77 | zxqs=MIN(0.5,zxqs) |
---|
| 78 | zcor=1./(1.-retv*zxqs) |
---|
| 79 | zxqs=zxqs*zcor |
---|
| 80 | c |
---|
| 81 | zx_alf1 = 1.0 |
---|
| 82 | zx_alf2 = 1.0 - zx_alf1 |
---|
| 83 | zxt = (t(i,1)+z(i,1)*RG/RCPD/(1.+RVTMP2*q(i,1))) |
---|
| 84 | . *(1.+RETV*q(i,1))*zx_alf1 |
---|
| 85 | . + (t(i,2)+z(i,2)*RG/RCPD/(1.+RVTMP2*q(i,2))) |
---|
| 86 | . *(1.+RETV*q(i,2))*zx_alf2 |
---|
| 87 | zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2 |
---|
| 88 | zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2 |
---|
| 89 | zxq = q(i,1)*zx_alf1+q(i,2)*zx_alf2 |
---|
| 90 | zxmod = 1.0+SQRT(zxu**2+zxv**2) |
---|
| 91 | khfs(i) = (tsol(i)*(1.+RETV*q(i,1))-zxt) *zxmod*cdragh(i) |
---|
| 92 | kqfs(i) = (zxqs-zxq) *zxmod*cdragh(i) * beta |
---|
| 93 | heatv(i) = khfs(i) + 0.61*zxt*kqfs(i) |
---|
| 94 | taux = zxu *zxmod*cdragm(i) |
---|
| 95 | tauy = zxv *zxmod*cdragm(i) |
---|
| 96 | ustar(i) = SQRT(taux**2+tauy**2) |
---|
| 97 | ustar(i) = MAX(SQRT(ustar(i)),0.01) |
---|
| 98 | c |
---|
| 99 | ENDDO |
---|
| 100 | c |
---|
| 101 | DO i = 1, klon |
---|
| 102 | obklen(i) = -t(i,1)*ustar(i)**3/(RG*vk*heatv(i)) |
---|
| 103 | ENDDO |
---|
| 104 | c |
---|
| 105 | END SUBROUTINE |
---|