!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !SFX_LIC for details. version 1. ! ######### module coare30_flux_cnrm_mod IMPLICIT NONE PRIVATE public COARE30_FLUX_CNRM CONTAINS SUBROUTINE COARE30_FLUX_CNRM(PZ0SEA, PTA, PSST, PQA, & PVMOD, PZREF, PUREF, PPS, PQSATA, PQSAT, PSFTH, PSFTQ, PUSTAR, PCD, PCDN, PCH, PCE, PRI, & PRESA, PRAIN, PPA, PZ0HSEA, LPRECIP, LPWG, coeffs) ! ####################################################################### !!**** *COARE25_FLUX* !! !! PURPOSE !! ------- ! Calculate the surface fluxes of heat, moisture, and momentum over ! sea surface with bulk algorithm COARE3.0. !!** METHOD !! ------ ! transfer coefficients were obtained using a dataset which combined COARE ! data with those from three other ETL field experiments, and reanalysis of ! the HEXMAX data (DeCosmos et al. 1996). ! ITERMAX=3 ! Take account of the surface gravity waves on the velocity roughness and ! hence the momentum transfer coefficient ! NGRVWAVES=0 no gravity waves action (Charnock) !default value ! NGRVWAVES=1 wave age parameterization of Oost et al. 2002 ! NGRVWAVES=2 model of Taylor and Yelland 2001 !! EXTERNAL !! -------- !! !! IMPLICIT ARGUMENTS !! ------------------ !! !! REFERENCE !! --------- !! Fairall et al (2003), J. of Climate, vol. 16, 571-591 !! Fairall et al (1996), JGR, 3747-3764 !! Gosnell et al (1995), JGR, 437-442 !! Fairall et al (1996), JGR, 1295-1308 !! !! AUTHOR !! ------ !! C. Lebeaupin *Météo-France* (adapted from C. Fairall's code) !! !! MODIFICATIONS !! ------------- !! Original 1/06/2006 !! B. Decharme 06/2009 limitation of Ri !! B. Decharme 09/2012 Bug in Ri calculation and limitation of Ri in surface_ri.F90 !! B. Decharme 06/2013 bug in z0 (output) computation !! J.Escobar 06/2013 for REAL4/8 add EPSILON management !! C. Lebeaupin 03/2014 bug if PTA=PSST and PEXNA=PEXNS: set a minimum value !! add abort if no convergence !------------------------------------------------------------------------------- !* 0. DECLARATIONS ! ------------ !USE MODD_SEAFLUX_n, ONLY: SEAFLUX_t !----------Rajout Olive --------- USE dimphy USE indice_sol_mod USE coare_cp_mod, ONLY: PSIFCTT => psit_30, PSIFCTU => psiuo !-------------------------------- USE MODD_CSTS, ONLY: XKARMAN, XG, XSTEFAN, XRD, XRV, XPI, & XLVTT, XCL, XCPD, XCPV, XRHOLW, XTT, & XP00 USE lmdz_abort_physic, ONLY: abort_physic USE lmdz_clesphys USE lmdz_yomcst !USE MODD_SURF_ATM, ONLY: XVZ0CM !USE MODD_SURF_PAR, ONLY: XUNDEF, XSURF_EPSILON !USE MODD_WATER_PAR !USE MODI_SURFACE_RI !USE MODI_WIND_THRESHOLD !USE MODE_COARE30_PSI !USE MODE_THERMOS !USE MODI_ABOR1_SFX !USE YOMHOOK ,ONLY: LHOOK, DR_HOOK !USE PARKIND1 ,ONLY: JPRB IMPLICIT NONE !* 0.1 declarations of arguments !TYPE(SEAFLUX_t), INTENT(INOUT) :: S REAL, DIMENSION(klon), INTENT(IN) :: PTA ! air temperature at atm. level (K) REAL, DIMENSION(klon), INTENT(IN) :: PQA ! air humidity at atm. level (kg/kg) !REAL, DIMENSION(:), INTENT(IN) :: PEXNA ! Exner function at atm. level !REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density at atm. level REAL, DIMENSION(klon), INTENT(IN) :: PVMOD ! module of wind at atm. wind level (m/s) REAL, DIMENSION(klon), INTENT(IN) :: PZREF ! atm. level for temp. and humidity (m) REAL, DIMENSION(klon), INTENT(IN) :: PUREF ! atm. level for wind (m) REAL, DIMENSION(klon), INTENT(IN) :: PSST ! Sea Surface Temperature (K) !REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! Exner function at sea surface REAL, DIMENSION(klon), INTENT(IN) :: PPS ! air pressure at sea surface (Pa) REAL, DIMENSION(klon), INTENT(IN) :: PRAIN !precipitation rate (kg/s/m2) REAL, DIMENSION(klon), INTENT(IN) :: PPA ! air pressure at atm level (Pa) REAL, DIMENSION(klon), INTENT(IN) :: PQSATA ! air pressure at atm level (Pa) REAL, DIMENSION(klon), INTENT(INOUT) :: PZ0SEA! roughness length over the ocean ! surface fluxes : latent heat, sensible heat, friction fluxes REAL, DIMENSION(klon), INTENT(OUT) :: PSFTH ! heat flux (W/m2) REAL, DIMENSION(klon), INTENT(OUT) :: PSFTQ ! water flux (kg/m2/s) REAL, DIMENSION(klon), INTENT(OUT) :: PUSTAR! friction velocity (m/s) ! diagnostics REAL, DIMENSION(klon), INTENT(OUT) :: PQSAT ! humidity at saturation REAL, DIMENSION(klon), INTENT(OUT) :: PCD ! heat drag coefficient REAL, DIMENSION(klon), INTENT(OUT) :: PCDN ! momentum drag coefficient REAL, DIMENSION(klon), INTENT(OUT) :: PCH ! neutral momentum drag coefficient REAL, DIMENSION(klon), INTENT(OUT) :: PCE !transfer coef. for latent heat flux REAL, DIMENSION(klon), INTENT(OUT) :: PRI ! Richardson number REAL, DIMENSION(klon), INTENT(OUT) :: PRESA ! aerodynamical resistance REAL, DIMENSION(klon), INTENT(OUT) :: PZ0HSEA ! heat roughness length LOGICAL, INTENT(IN) :: LPRECIP ! LOGICAL, INTENT(IN) :: LPWG ! REAL, DIMENSION(3), INTENT(INOUT) :: coeffs !* 0.2 declarations of local variables REAL, DIMENSION(SIZE(PTA)) :: ZVMOD ! wind intensity REAL, DIMENSION(SIZE(PTA)) :: ZPA ! Pressure at atm. level REAL, DIMENSION(SIZE(PTA)) :: ZTA ! Temperature at atm. level REAL, DIMENSION(SIZE(PTA)) :: ZQASAT ! specific humidity at saturation at atm. level (kg/kg) !rajout REAL, DIMENSION(SIZE(PTA)) :: PEXNA ! Exner function at atm level REAL, DIMENSION(SIZE(PTA)) :: PEXNS ! Exner function at atm level REAL, DIMENSION(SIZE(PTA)) :: ZO ! rougness length ref REAL, DIMENSION(SIZE(PTA)) :: ZWG ! gustiness factor (m/s) REAL, DIMENSION(SIZE(PTA)) :: ZDU, ZDT, ZDQ, ZDUWG !differences REAL, DIMENSION(SIZE(PTA)) :: ZUSR !velocity scaling parameter "ustar" (m/s) = friction velocity REAL, DIMENSION(SIZE(PTA)) :: ZTSR !temperature sacling parameter "tstar" (degC) REAL, DIMENSION(SIZE(PTA)) :: ZQSR !humidity scaling parameter "qstar" (kg/kg) REAL, DIMENSION(SIZE(PTA)) :: ZU10, ZT10 !vertical profils (10-m height) REAL, DIMENSION(SIZE(PTA)) :: ZVISA !kinematic viscosity of dry air REAL, DIMENSION(SIZE(PTA)) :: ZO10, ZOT10 !roughness length at 10m REAL, DIMENSION(SIZE(PTA)) :: ZCD, ZCT, ZCC REAL, DIMENSION(SIZE(PTA)) :: ZCD10, ZCT10 !transfer coef. at 10m REAL, DIMENSION(SIZE(PTA)) :: ZRIBU, ZRIBCU REAL, DIMENSION(SIZE(PTA)) :: ZETU, ZL10 REAL, DIMENSION(SIZE(PTA)) :: ZCHARN !Charnock number depends on wind module REAL, DIMENSION(SIZE(PTA)) :: ZTWAVE, ZHWAVE, ZCWAVE, ZLWAVE !to compute gravity waves' impact REAL, DIMENSION(SIZE(PTA)) :: ZZL, ZZTL!,ZZQL !Obukhovs stability !param. z/l for u,T,q REAL, DIMENSION(SIZE(PTA)) :: ZRR REAL, DIMENSION(SIZE(PTA)) :: ZOT, ZOQ !rougness length ref REAL, DIMENSION(SIZE(PTA)) :: ZPUZ, ZPTZ, ZPQZ !PHI funct. for u,T,q REAL, DIMENSION(SIZE(PTA)) :: ZBF !constants to compute gustiness factor REAL, DIMENSION(SIZE(PTA)) :: ZTAU !momentum flux (W/m2) REAL, DIMENSION(SIZE(PTA)) :: ZHF !sensible heat flux (W/m2) REAL, DIMENSION(SIZE(PTA)) :: ZEF !latent heat flux (W/m2) REAL, DIMENSION(SIZE(PTA)) :: ZWBAR !diag for webb correction but not used here after REAL, DIMENSION(SIZE(PTA)) :: ZTAUR !momentum flux due to rain (W/m2) REAL, DIMENSION(SIZE(PTA)) :: ZRF !sensible heat flux due to rain (W/m2) REAL, DIMENSION(SIZE(PTA)) :: ZCHN, ZCEN !neutral coef. for heat and vapor REAL, DIMENSION(SIZE(PTA)) :: ZLV !latent heat constant REAL, DIMENSION(SIZE(PTA)) :: ZTAC, ZDQSDT, ZDTMP, ZDWAT, ZALFAC ! for precipitation impact REAL, DIMENSION(SIZE(PTA)) :: ZXLR ! vaporisation heat at a given temperature REAL, DIMENSION(SIZE(PTA)) :: ZCPLW ! specific heat for water at a given temperature REAL, DIMENSION(SIZE(PTA)) :: ZUSTAR2 ! square of friction velocity REAL, DIMENSION(SIZE(PTA)) :: ZDIRCOSZW! orography slope cosine (=1 on water!) REAL, DIMENSION(SIZE(PTA)) :: ZAC ! Aerodynamical conductance INTEGER, DIMENSION(SIZE(PTA)) :: ITERMAX ! maximum number of iterations REAL :: ZRVSRDM1, ZRDSRV, ZR2 ! thermodynamic constants REAL :: ZBETAGUST !gustiness factor REAL :: ZZBL !atm. boundary layer depth (m) REAL :: ZVISW !m2/s kinematic viscosity of water REAL :: ZS !height of rougness length ref REAL :: ZCH10 !transfer coef. at 10m REAL :: QSAT_SEAWATER REAL :: QSATSEAW_1D INTEGER :: J, JLOOP !loop indice !REAL(KIND=JPRB) :: ZHOOK_HANDLE !--------- Modif Olive ----------------- REAL, DIMENSION(SIZE(PTA)) :: PRHOA REAL, PARAMETER :: XUNDEF = 1.E+20 REAL :: XVCHRNK = 0.021 REAL :: XVZ0CM = 1.0E-5 !REAL :: XRIMAX INTEGER :: PREF ! reference pressure for exner function INTEGER :: NGRVWAVES ! Pour le choix du z0 !-------------------------------------- PRHOA(:) = PPS(:) / (287.1 * PTA(:) * (1. + .61 * PQA(:))) PREF = 100000. ! = 1000 hPa NGRVWAVES = 1 PEXNA = (PPA / PREF)**(RD / RCPD) PEXNS = (PPS / PREF)**(RD / RCPD) !------------------------------------------------------------------------------- ! 1. Initializations ! --------------- ! 1.1 Constants and parameters !IF (LHOOK) CALL DR_HOOK('COARE30_FLUX',0,ZHOOK_HANDLE) ZRVSRDM1 = XRV / XRD - 1. ! 0.607766 ZRDSRV = XRD / XRV ! 0.62198 ZR2 = 1. - ZRDSRV ! pas utilisé dans cette routine ZBETAGUST = 1.2 ! value based on TOGA-COARE experiment ZZBL = 600. ! Set a default value for boundary layer depth ZS = 10. ! Standard heigth =10m ZCH10 = 0.00115 ZVISW = 1.E-6 ! 1.2 Array initialization by undefined values PSFTH (:) = XUNDEF PSFTQ (:) = XUNDEF PUSTAR(:) = XUNDEF PCD(:) = XUNDEF PCDN(:) = XUNDEF PCH(:) = XUNDEF PCE(:) = XUNDEF PRI(:) = XUNDEF PRESA(:) = XUNDEF !------------------------------------------------------------------------------- ! 2. INITIAL GUESS FOR THE ITERATIVE METHOD ! ------------------------------------- ! 2.0 Temperature ! Set a non-zero value for the temperature gradient WHERE((PTA(:) * PEXNS(:) / PEXNA(:) - PSST(:))==0.) ZTA(:) = PTA(:) - 1E-3 ELSEWHERE ZTA(:) = PTA(:) ENDWHERE ! 2.1 Wind and humidity ! Sea surface specific humidity !PQSAT(:)=QSAT_SEAWATER(PSST(:),PPS(:)) PQSAT(:) = QSATSEAW_1D(PSST(:), PPS(:)) ! Set a minimum value to wind !ZVMOD(:) = WIND_THRESHOLD(PVMOD(:),PUREF(:)) ZVMOD = MAX(PVMOD, 0.1 * MIN(10., PUREF)) !set a minimum value to wind !ZVMOD = PVMOD !set a minimum value to wind ! Specific humidity at saturation at the atm. level ZPA(:) = XP00 * (PEXNA(:)**(XCPD / XRD)) !ZQASAT(:) = QSAT_SEAWATER(ZTA(:),ZPA(:)) ZQASAT = QSATSEAW_1D(ZTA(:), ZPA(:)) ZO(:) = 0.0001 ZWG(:) = 0. IF (LPWG) ZWG(:) = 0.5 ZCHARN(:) = 0.011 DO J = 1, SIZE(PTA) ! 2.2 initial guess ZDU(J) = ZVMOD(J) !wind speed difference with surface current(=0) (m/s) !initial guess for gustiness factor ZDT(J) = -(ZTA(J) / PEXNA(J)) + (PSST(J) / PEXNS(J)) !potential temperature difference ZDQ(J) = PQSAT(J) - PQA(J) !specific humidity difference ZDUWG(J) = SQRT(ZDU(J)**2 + ZWG(J)**2) !wind speed difference including gustiness ZWG ! 2.3 initialization of neutral coefficients ZU10(J) = ZDUWG(J) * LOG(ZS / ZO(J)) / LOG(PUREF(J) / ZO(J)) ZUSR(J) = 0.035 * ZU10(J) ZVISA(J) = 1.326E-5 * (1. + 6.542E-3 * (ZTA(J) - XTT) + & 8.301E-6 * (ZTA(J) - XTT)**2 - 4.84E-9 * (ZTA(J) - XTT)**3) !Andrea (1989) CRREL Rep. 89-11 ZO10(J) = ZCHARN(J) * ZUSR(J) * ZUSR(J) / XG + 0.11 * ZVISA(J) / ZUSR(J) ZCD(J) = (XKARMAN / LOG(PUREF(J) / ZO10(J)))**2 !drag coefficient ZCD10(J) = (XKARMAN / LOG(ZS / ZO10(J)))**2 ZCT10(J) = ZCH10 / SQRT(ZCD10(J)) ZOT10(J) = ZS / EXP(XKARMAN / ZCT10(J)) !------------------------------------------------------------------------------- ! Grachev and Fairall (JAM, 1997) ZCT(J) = XKARMAN / LOG(PZREF(J) / ZOT10(J)) !temperature transfer coefficient ZCC(J) = XKARMAN * ZCT(J) / ZCD(J) !z/L vs Rib linear coef. ZRIBCU(J) = -PUREF(J) / (ZZBL * 0.004 * ZBETAGUST**3) !saturation or plateau Rib !ZRIBU(J) =-XG*PUREF(J)*(ZDT(J)+ZRVSRDM1*(ZTA(J)-XTT)*ZDQ)/& ! &((ZTA(J)-XTT)*ZDUWG(J)**2) ZRIBU(J) = -XG * PUREF(J) * (ZDT(J) + ZRVSRDM1 * ZTA(J) * ZDQ(J)) / & (ZTA(J) * ZDUWG(J)**2) IF (ZRIBU(J)<0.) THEN ZETU(J) = ZCC(J) * ZRIBU(J) / (1. + ZRIBU(J) / ZRIBCU(J)) !Unstable G and F ELSE ZETU(J) = ZCC(J) * ZRIBU(J) / (1. + 27. / 9. * ZRIBU(J) / ZCC(J))!Stable ENDIF ZL10(J) = PUREF(J) / ZETU(J) !MO length ENDDO ! First guess M-O stability dependent scaling params. (u*,T*,q*) to estimate ZO and z/L (ZZL) ZUSR(:) = ZDUWG(:) * XKARMAN / (LOG(PUREF(:) / ZO10(:)) - PSIFCTU(PUREF(1) / ZL10(1))) ZTSR(:) = -ZDT(:) * XKARMAN / (LOG(PZREF(:) / ZOT10(:)) - PSIFCTT(PZREF(1) / ZL10(1))) ZQSR(:) = -ZDQ(:) * XKARMAN / (LOG(PZREF(:) / ZOT10(:)) - PSIFCTT(PZREF(1) / ZL10(1))) ZZL(:) = 0.0 DO J = 1, SIZE(PTA) IF (ZETU(J)>50.) THEN ITERMAX(J) = 1 ELSE ITERMAX(J) = 3 !number of iterations ENDIF !then modify Charnork for high wind speeds Chris Fairall's data IF (ZDUWG(J)>10.) ZCHARN(J) = 0.011 + (0.018 - 0.011) * (ZDUWG(J) - 10.) / (18. - 10.) IF (ZDUWG(J)>18.) ZCHARN(J) = 0.018 ! 3. ITERATIVE LOOP TO COMPUTE USR, TSR, QSR ! ------------------------------------------- ZHWAVE(J) = 0.018 * ZVMOD(J) * ZVMOD(J) * (1. + 0.015 * ZVMOD(J)) ZTWAVE(J) = 0.729 * ZVMOD(J) ZCWAVE(J) = XG * ZTWAVE(J) / (2. * XPI) ZLWAVE(J) = ZTWAVE(J) * ZCWAVE(J) ENDDO DO JLOOP = 1, MAXVAL(ITERMAX) ! begin of iterative loop DO J = 1, SIZE(PTA) IF (JLOOP>ITERMAX(J)) CYCLE IF (NGRVWAVES==0) THEN ZO(J) = ZCHARN(J) * ZUSR(J) * ZUSR(J) / XG + 0.11 * ZVISA(J) / ZUSR(J) !Smith 1988 ELSE IF (NGRVWAVES==1) THEN ZO(J) = (50. / (2. * XPI)) * ZLWAVE(J) * (ZUSR(J) / ZCWAVE(J))**4.5 & + 0.11 * ZVISA(J) / ZUSR(J) !Oost et al. 2002 ELSE IF (NGRVWAVES==2) THEN ZO(J) = 1200. * ZHWAVE(J) * (ZHWAVE(J) / ZLWAVE(J))**4.5 & + 0.11 * ZVISA(J) / ZUSR(J) !Taulor and Yelland 2001 ENDIF ZRR(J) = ZO(J) * ZUSR(J) / ZVISA(J) ZOQ(J) = MIN(1.15E-4, 5.5E-5 / ZRR(J)**0.6) ZOT(J) = ZOQ(J) ZZL(J) = XKARMAN * XG * PUREF(J) * & (ZTSR(J) * (1. + ZRVSRDM1 * PQA(J)) + ZRVSRDM1 * ZTA(J) * ZQSR(J)) / & (ZTA(J) * ZUSR(J) * ZUSR(J) * (1. + ZRVSRDM1 * PQA(J))) ZZTL(J) = ZZL(J) * PZREF(J) / PUREF(J) ! for T ! ZZQL(J)=ZZL(J)*PZREF(J)/PUREF(J) ! for Q ENDDO ZPUZ(:) = PSIFCTU(ZZL(1)) ZPTZ(:) = PSIFCTT(ZZTL(1)) DO J = 1, SIZE(PTA) ! ZPQZ(J)=PSIFCTT(ZZQL(J)) ZPQZ(J) = ZPTZ(J) ! 3.1 scale parameters ZUSR(J) = ZDUWG(J) * XKARMAN / (LOG(PUREF(J) / ZO(J)) - ZPUZ(J)) ZTSR(J) = -ZDT(J) * XKARMAN / (LOG(PZREF(J) / ZOT(J)) - ZPTZ(J)) ZQSR(J) = -ZDQ(J) * XKARMAN / (LOG(PZREF(J) / ZOQ(J)) - ZPQZ(J)) ! 3.2 Gustiness factor (ZWG) IF(LPWG) THEN ZBF(J) = -XG / ZTA(J) * ZUSR(J) * (ZTSR(J) + ZRVSRDM1 * ZTA(J) * ZQSR(J)) IF (ZBF(J)>0.) THEN ZWG(J) = ZBETAGUST * (ZBF(J) * ZZBL)**(1. / 3.) ELSE ZWG(J) = 0.2 ENDIF ENDIF ZDUWG(J) = SQRT(ZVMOD(J)**2 + ZWG(J)**2) ENDDO ENDDO !------------------------------------------------------------------------------- ! 4. COMPUTE transfer coefficients PCD, PCH, ZCE and SURFACE FLUXES ! -------------------------------------------------------------- ZTAU(:) = XUNDEF ZHF(:) = XUNDEF ZEF(:) = XUNDEF ZWBAR(:) = 0. ZTAUR(:) = 0. ZRF(:) = 0. DO J = 1, SIZE(PTA) ! 4. transfert coefficients PCD, PCH and PCE ! and neutral PCDN, ZCHN, ZCEN PCD(J) = (ZUSR(J) / ZDUWG(J))**2. PCH(J) = ZUSR(J) * ZTSR(J) / (ZDUWG(J) * (ZTA(J) * PEXNS(J) / PEXNA(J) - PSST(J))) PCE(J) = ZUSR(J) * ZQSR(J) / (ZDUWG(J) * (PQA(J) - PQSAT(J))) PCDN(J) = (XKARMAN / LOG(ZS / ZO(J)))**2. ZCHN(J) = (XKARMAN / LOG(ZS / ZO(J))) * (XKARMAN / LOG(ZS / ZOT(J))) ZCEN(J) = (XKARMAN / LOG(ZS / ZO(J))) * (XKARMAN / LOG(ZS / ZOQ(J))) ZLV(J) = XLVTT + (XCPV - XCL) * (PSST(J) - XTT) ! 4. 2 surface fluxes IF (ABS(PCDN(J))>1.E-2) THEN !!!! secure COARE3.0 CODE WRITE(*, *) 'pb PCDN in COARE30: ', PCDN(J) WRITE(*, *) 'point: ', J, "/", SIZE(PTA) WRITE(*, *) 'roughness: ', ZO(J) WRITE(*, *) 'ustar: ', ZUSR(J) WRITE(*, *) 'wind: ', ZDUWG(J) CALL abort_physic('COARE30', ': PCDN too large -> no convergence', 1) ELSE ZTSR(J) = -ZTSR(J) ZQSR(J) = -ZQSR(J) ZTAU(J) = -PRHOA(J) * ZUSR(J) * ZUSR(J) * ZVMOD(J) / ZDUWG(J) ZHF(J) = PRHOA(J) * XCPD * ZUSR(J) * ZTSR(J) ZEF(J) = PRHOA(J) * ZLV(J) * ZUSR(J) * ZQSR(J) ! 4.3 Contributions to surface fluxes due to rainfall ! SB: a priori, le facteur ZRDSRV=XRD/XRV est introduit pour ! adapter la formule de Clausius-Clapeyron (pour l'air ! sec) au cas humide. IF (LPRECIP) THEN ! heat surface fluxes ZTAC(J) = ZTA(J) - XTT ZXLR(J) = XLVTT + (XCPV - XCL) * ZTAC(J) ! latent heat of rain vaporization ZDQSDT(J) = ZQASAT(J) * ZXLR(J) / (XRD * ZTA(J)**2) ! Clausius-Clapeyron relation ZDTMP(J) = (1.0 + 3.309e-3 * ZTAC(J) - 1.44e-6 * ZTAC(J) * ZTAC(J)) * & !heat diffusivity 0.02411 / (PRHOA(J) * XCPD) ZDWAT(J) = 2.11e-5 * (XP00 / ZPA(J)) * (ZTA(J) / XTT)**1.94 ! water vapour diffusivity from eq (13.3) ! ! of Pruppacher and Klett (1978) ZALFAC(J) = 1.0 / (1.0 + & ! Eq.11 in GoF95 ZRDSRV * ZDQSDT(J) * ZXLR(J) * ZDWAT(J) / (ZDTMP(J) * XCPD)) ! ZALFAC=wet-bulb factor (sans dim) ZCPLW(J) = 4224.8482 + ZTAC(J) * & (-4.707 + ZTAC(J) * & (0.08499 + ZTAC(J) * & (1.2826e-3 + ZTAC(J) * & (4.7884e-5 - 2.0027e-6 * ZTAC(J))))) ! specific heat ZRF(J) = PRAIN(J) * ZCPLW(J) * ZALFAC(J) * & !Eq.12 in GoF95 !SIGNE? (PSST(J) - ZTA(J) + (PQSAT(J) - PQA(J)) * ZXLR(J) / XCPD) ! Momentum flux due to rainfall ZTAUR(J) = -0.85 * (PRAIN(J) * ZVMOD(J)) !pp3752 in FBR96 ENDIF ! 4.4 Webb correction to latent heat flux ZWBAR(J) = - (1. / ZRDSRV) * ZUSR(J) * ZQSR(J) / (1.0 + (1. / ZRDSRV) * PQA(J)) & - ZUSR(J) * ZTSR(J) / ZTA(J) ! Eq.21*rhoa in FBR96 ! 4.5 friction velocity which contains correction du to rain ZUSTAR2(J) = - (ZTAU(J) + ZTAUR(J)) / PRHOA(J) PUSTAR(J) = SQRT(ZUSTAR2(J)) ! 4.6 Total surface fluxes PSFTH (J) = ZHF(J) + ZRF(J) PSFTQ (J) = ZEF(J) / ZLV(J) ENDIF ENDDO coeffs = [PCD, & PCE, & PCH] !------------------------------------------------------------------------------- ! 5. FINAL STEP : TOTAL SURFACE FLUXES AND DERIVED DIAGNOSTICS ! ----------- ! 5.1 Richardson number !------------STOP LA -------------------- !ZDIRCOSZW(:) = 1. ! CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,ZTA,ZQASAT,& ! PZREF,PUREF,ZDIRCOSZW,PVMOD,PRI ) !! !! 5.2 Aerodynamical conductance and resistance !! !ZAC(:) = PCH(:)*ZVMOD(:) !PRESA(:) = 1. / MAX(ZAC(:),XSURF_EPSILON) !! 5.3 Z0 and Z0H over sea !! !PZ0SEA(:) = ZCHARN(:) * ZUSTAR2(:) / XG + XVZ0CM * PCD(:) / PCDN(:) !! !!PZ0HSEA(:) = PZ0SEA(:) !! !IF (LHOOK) CALL DR_HOOK('COARE30_FLUX',1,ZHOOK_HANDLE) !------------------------------------------------------------------------------- END SUBROUTINE COARE30_FLUX_CNRM END MODULE coare30_flux_cnrm_mod