SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/ecume

Go to the documentation of this file.
00001 !     #########
00002     SUBROUTINE ECUME_FLUX(PZ0SEA,PTA,PEXNA,PRHOA,PSST,PEXNS,PQA,PVMOD, &
00003                             PZREF,PUREF,PPS,PICHCE,OPRECIP,OPWEBB,OPWG,&
00004                             PQSAT,PSFTH,PSFTQ,PUSTAR,PCD,PCDN,PCH,PCE, &
00005                             PRI,PRESA,PRAIN,PZ0HSEA    )  
00006 !###############################################################################
00007 !!
00008 !!****  *ECUME_FLUX*
00009 !!
00010 !!    PURPOSE
00011 !!    -------
00012 !       Calculate the surface turbulent fluxes of heat, moisture, and momentum 
00013 !       over sea surface + corrections due to rainfall & Webb effect.
00014 !!
00015 !!**  METHOD
00016 !!    ------
00017 !       The estimation of the transfer coefficients relies on the iterative 
00018 !       computation of the scaling parameters U*/Teta*/q*. The convergence is
00019 !       supposed to be reached in NITERFL iterations maximum.
00020 !       The neutral transfer coefficients for momentum/temperature/humidity
00021 !       are computed as a function of the 10m-height neutral wind speed using
00022 !       the ECUME_v0 formulation based on the multi-campaign (POMME,FETCH,CATCH,
00023 !       SEMAPHORE,EQUALANT) ALBATROS dataset. See  MERSEA report for more
00024 !       details on the ECUME formulation.
00025 !!
00026 !!    EXTERNAL
00027 !!    --------
00028 !!
00029 !!    IMPLICIT ARGUMENTS
00030 !!    ------------------
00031 !!
00032 !!    REFERENCE
00033 !!    ---------
00034 !!      Fairall et al (1996), JGR, 3747-3764
00035 !!      Gosnell et al (1995), JGR, 437-442
00036 !!      Fairall et al (1996), JGR, 1295-1308
00037 !!
00038 !!    AUTHOR
00039 !!    ------
00040 !!      C. Lebeaupin  *M�t�o-France* (adapted from S. Belamari's code)
00041 !!
00042 !!    MODIFICATIONS
00043 !!    -------------
00044 !!      Original     15/03/2005
00045 !!      Modified        01/2006  C. Lebeaupin (adapted from  A. Pirani's code)
00046 !!      Modified     20/07/2009  S. Belamari
00047 !!      Modified        08/2009  B. Decharme: limitation of Ri
00048 !!      Modified        09/2012  B. Decharme: CD correction
00049 !!      Modified        09/2012  B. Decharme: limitation of Ri in surface_ri.F90
00050 !!      Modified        10/2012  P. Le Moigne: extra inputs for FLake use
00051 !!!
00052 !-------------------------------------------------------------------------------
00053 
00054 !       0.   DECLARATIONS
00055 !            ------------
00056 
00057 USE MODD_CSTS,       ONLY : XKARMAN, XG, XSTEFAN, XRD, XRV, &
00058                               XLVTT, XCL, XCPD, XCPV, XRHOLW, XTT,XP00  
00059 USE MODD_SURF_PAR,   ONLY : XUNDEF
00060 USE MODD_SNOW_PAR,   ONLY : XZ0SN, XZ0HSN
00061 USE MODD_WATER_PAR
00062 !
00063 USE MODI_WIND_THRESHOLD
00064 USE MODI_SURFACE_RI
00065 !
00066 USE MODE_THERMOS
00067 !
00068 !
00069 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00070 USE PARKIND1  ,ONLY : JPRB
00071 !
00072 USE MODI_ABOR1_SFX
00073 !
00074 IMPLICIT NONE
00075 
00076 !       0.1. Declarations of arguments
00077 
00078 REAL, DIMENSION(:), INTENT(IN)    :: PTA       ! air temperature, atm.lev (K)
00079 REAL, DIMENSION(:), INTENT(IN)    :: PQA       ! air spec. hum., atm.lev (kg/kg)
00080 REAL, DIMENSION(:), INTENT(IN)    :: PRHOA     ! air density, atm.lev (kg/m3)
00081 REAL, DIMENSION(:), INTENT(IN)    :: PVMOD     ! module of wind, atm.lev (m/s)
00082 REAL, DIMENSION(:), INTENT(IN)    :: PZREF     ! atm.level for temp./hum. (m)
00083 REAL, DIMENSION(:), INTENT(IN)    :: PUREF     ! atm.level for wind (m)
00084 REAL, DIMENSION(:), INTENT(IN)    :: PSST      ! Sea Surface Temperature (K)
00085 REAL, DIMENSION(:), INTENT(IN)    :: PPS       ! air pressure at sea surf. (Pa)
00086 REAL, DIMENSION(:), INTENT(IN)    :: PRAIN     ! precipitation rate (kg/s/m2)
00087 REAL, DIMENSION(:), INTENT(IN)    :: PEXNA     ! Exner function at atm. level
00088 REAL, DIMENSION(:), INTENT(IN)    :: PEXNS     ! Exner function at sea surface
00089 
00090 REAL,               INTENT(IN)    :: PICHCE    !
00091 LOGICAL,            INTENT(IN)    :: OPRECIP   !
00092 LOGICAL,            INTENT(IN)    :: OPWEBB    !
00093 LOGICAL,            INTENT(IN)    :: OPWG      !
00094 
00095 REAL, DIMENSION(:), INTENT(INOUT) :: PZ0SEA    ! roughness length over the ocean
00096 
00097 ! surface fluxes : latent heat, sensible heat, friction fluxes
00098 REAL, DIMENSION(:), INTENT(OUT)   :: PSFTH     ! heat flux (W/m2)
00099 REAL, DIMENSION(:), INTENT(OUT)   :: PSFTQ     ! water flux (kg/m2/s)
00100 REAL, DIMENSION(:), INTENT(OUT)   :: PUSTAR    ! friction velocity (m/s)
00101 
00102 ! diagnostics
00103 REAL, DIMENSION(:), INTENT(OUT)   :: PQSAT     ! sea surface spec. hum. (kg/kg)
00104 REAL, DIMENSION(:), INTENT(OUT)   :: PCD       ! transfer coef. for momentum
00105 REAL, DIMENSION(:), INTENT(OUT)   :: PCH       ! transfer coef. for temperature
00106 REAL, DIMENSION(:), INTENT(OUT)   :: PCE       ! transfer coef. for humidity
00107 REAL, DIMENSION(:), INTENT(OUT)   :: PCDN      ! neutral coef. for momentum
00108 REAL, DIMENSION(:), INTENT(OUT)   :: PRESA     ! aerodynamical resistance
00109 REAL, DIMENSION(:), INTENT(OUT)   :: PRI       ! Richardson number
00110 REAL, DIMENSION(:), INTENT(OUT)   :: PZ0HSEA   ! heat roughness length
00111 
00112 !       0.2. Declarations of local variables
00113 
00114 REAL, DIMENSION(SIZE(PTA))        :: ZTAU      ! momentum flux (N/m2)
00115 REAL, DIMENSION(SIZE(PTA))        :: ZHF       ! sensible heat flux (W/m2)
00116 REAL, DIMENSION(SIZE(PTA))        :: ZEF       ! latent heat flux (W/m2)
00117 REAL, DIMENSION(SIZE(PTA))        :: ZTAUR     ! momentum flx due to rain (N/m2)
00118 REAL, DIMENSION(SIZE(PTA))        :: ZRF       ! sensible flx due to rain (W/m2)
00119 REAL, DIMENSION(SIZE(PTA))        :: ZEFWEBB   ! Webb corr. on latent flx (W/m2)
00120 
00121 REAL, DIMENSION(SIZE(PTA))        :: ZVMOD     ! wind intensity at atm.lev (m/s)
00122 REAL, DIMENSION(SIZE(PTA))        :: ZQSATA    ! sat.spec.hum., atm.lev (kg/kg)
00123 REAL, DIMENSION(SIZE(PTA))        :: ZPA       ! air pressure at atm. level (Pa)
00124 REAL, DIMENSION(SIZE(PTA))        :: ZUSR      ! velocity scaling param. (m/s)
00125                                                ! =friction velocity
00126 REAL, DIMENSION(SIZE(PTA))        :: ZTSR      ! temperature scaling param. (K)
00127 REAL, DIMENSION(SIZE(PTA))        :: ZQSR      ! humidity scaling param. (kg/kg)
00128 REAL, DIMENSION(SIZE(PTA))        :: ZWG       ! gustiness factor (m/s)
00129 
00130 REAL, DIMENSION(SIZE(PTA))        :: ZUSTAR2   ! square of friction velocity
00131 REAL, DIMENSION(SIZE(PTA))        :: ZAC       ! aerodynamical conductance
00132 REAL, DIMENSION(SIZE(PTA))        :: ZDIRCOSZW ! orography slope cosine
00133                                                ! (=1 on water!)
00134 
00135 REAL, DIMENSION(SIZE(PTA))        :: ZLV,ZLR   ! vap.heat, sea/atm level (J/kg)
00136 REAL, DIMENSION(SIZE(PTA))        :: ZDU,ZDTH,ZDQ,ZDUWG
00137                                                ! vert. gradients (real atm.)
00138 REAL, DIMENSION(SIZE(PTA))        :: ZDELTAU10N,ZDELTAT10N,ZDELTAQ10N
00139                                                ! vert. gradients (10-m, neutral)
00140 REAL, DIMENSION(SIZE(PTA))        :: ZCHN,ZCEN ! neutral coef. for T,Q
00141 REAL, DIMENSION(SIZE(PTA))        :: ZD0
00142 !
00143 REAL    :: ZETV,ZRDSRV     ! thermodynamic constants
00144 REAL    :: ZLMOU,ZLMOT     ! Obukhovs stability param. z/l for U, T/Q
00145 REAL    :: ZPSI_U,ZPSI_T   ! PSI funct. for U, T/Q
00146 REAL    :: ZLMOMIN,ZLMOMAX ! min/max value of Obukhovs stability parameter z/l
00147 REAL    :: ZCHIC,ZCHIK,ZEPS,ZLOGHS10,ZLOGTS10,ZPI,ZPIS2,ZPSIC,ZPSIK, 
00148              ZSQR3,ZZDQ,ZZDTH  
00149 !
00150 REAL    :: ZALFAC,ZCPLW,ZDQSDT,ZDTMP,ZDWAT,ZP00,ZTAC,ZWW
00151                                 ! to compute rainfall impact & Webb correction
00152 !
00153 INTEGER :: NITERFL         ! maximum number of iterations (5 or 6)
00154 INTEGER :: JLON, JJ
00155 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00156 !
00157 !-------------------------------------------------------------------------------
00158 IF (LHOOK) CALL DR_HOOK('ECUME_FLUX',0,ZHOOK_HANDLE)
00159 !
00160 NITERFL = 6
00161 !
00162 IF(OPWG) THEN
00163    CALL ABOR1_SFX('Ecume_flux : Correction of fluxes due to gustiness was removed, OPWG should be at false')           
00164 ENDIF
00165 !
00166 !-------------------------------------------------------------------------------
00167 !
00168 !       1.   AUXILIARY CONSTANTS & ARRAY INITIALISATION BY UNDEFINED VALUES.
00169 !       --------------------------------------------------------------------
00170 !
00171 ZLMOMIN = -200.0
00172 ZLMOMAX = 0.25
00173 ZP00    = 1013.25E+02
00174 ZPIS2   = 2.0*ATAN(1.0)
00175 ZPI     = 2.0*ZPIS2
00176 ZSQR3   = SQRT(3.0)
00177 ZEPS    = 1.E-12
00178 ZETV    = XRV/XRD-1.0
00179 ZRDSRV  = XRD/XRV
00180 !
00181 ZDIRCOSZW(:)=1.
00182 !
00183 PCD (:) = XUNDEF
00184 PCH (:) = XUNDEF
00185 PCE (:) = XUNDEF
00186 PCDN(:) = XUNDEF
00187 ZUSR(:) = XUNDEF
00188 ZTSR(:) = XUNDEF
00189 ZQSR(:) = XUNDEF
00190 ZTAU(:) = XUNDEF
00191 ZHF (:) = XUNDEF
00192 ZEF (:) = XUNDEF
00193 !
00194 PSFTH (:) = XUNDEF
00195 PSFTQ (:) = XUNDEF
00196 PUSTAR(:) = XUNDEF
00197 PRESA (:) = XUNDEF
00198 PRI   (:) = XUNDEF
00199 !
00200 ZWG    (:) = 0.0
00201 ZTAUR  (:) = 0.0
00202 ZRF    (:) = 0.0
00203 ZEFWEBB(:) = 0.0
00204 !
00205 !-------------------------------------------------------------------------------
00206 !
00207 !       2.   INITIALISATIONS BEFORE ITERATIVE LOOP.
00208 !       -------------------------------------------
00209 !
00210 ZVMOD (:) = WIND_THRESHOLD(PVMOD(:),PUREF(:))   !set a minimum value to wind
00211 !
00212 !       2.1. Specific humidity at saturation
00213 !
00214 PQSAT (:) = QSAT_SEAWATER(PSST(:),PPS(:))                       !at sea surface
00215 ZPA   (:) = XP00*(PEXNA(:)**(XCPD/XRD))
00216 ZQSATA(:) = QSAT(PTA(:),ZPA(:))                                 !at atm. level
00217 !
00218 !       2.2. Gradients at the air-sea interface
00219 !
00220 ZDU (:) = ZVMOD(:)              !one assumes u is measured / sea surface current
00221 ZDTH(:) = PTA(:)/PEXNA(:)-PSST(:)/PEXNS(:)
00222 ZDQ (:) = PQA(:)-PQSAT(:)
00223 !
00224 !       2.3. Initial guess
00225 !
00226 ZD0(:) = 1.2+6.3E-03*MAX(ZDU(:)-10.0,0.0)
00227 !
00228 !IF(OPWG) ZWG(:) = 0.0                  !no gustiness initial guess
00229 !ZDUWG(:) = SQRT(ZDU(:)**2+ZWG(:)**2)
00230 ZDUWG     (:) = ZDU  (:)
00231 ZDELTAU10N(:) = ZDUWG(:)
00232 ZDELTAT10N(:) = ZDTH (:)*ZD0(:)
00233 ZDELTAQ10N(:) = ZDQ  (:)
00234 !
00235 !       2.4. Latent heat of vaporisation
00236 !
00237 ZLV(:) = XLVTT+(XCPV-XCL)*(PSST(:)-XTT)                 !at sea surface
00238 ZLR(:) = XLVTT+(XCPV-XCL)*(PTA(:)-XTT)                  !at atm.level
00239 !
00240 !-------------------------------------------------------------------------------
00241 !
00242 !       3.   ITERATIVE LOOP TO COMPUTE U*, T*, Q*.
00243 !       ------------------------------------------
00244 !
00245 DO JJ=1,NITERFL
00246   DO JLON=1,SIZE(PTA)
00247 !
00248 !       3.1. Neutral coefficient for wind speed cdn (ECUME_v0 formulation)
00249 !
00250     IF (ZDELTAU10N(JLON) <= 16.8) THEN
00251       PCDN(JLON) = 1.3013E-03                          &
00252                   + (-1.2719E-04 * ZDELTAU10N(JLON)   ) &
00253                   + (+1.3067E-05 * ZDELTAU10N(JLON)**2) &
00254                   + (-2.2261E-07 * ZDELTAU10N(JLON)**3)  
00255     ELSEIF (ZDELTAU10N(JLON) <= 50.0) THEN
00256       PCDN(JLON) = 1.3633E-03                          &
00257                   + (-1.3056E-04 * ZDELTAU10N(JLON)   ) &
00258                   + (+1.6212E-05 * ZDELTAU10N(JLON)**2) &
00259                   + (-4.8208E-07 * ZDELTAU10N(JLON)**3) &
00260                   + (+4.2684E-09 * ZDELTAU10N(JLON)**4)  
00261     ELSE
00262       PCDN(JLON) = 1.7828E-03
00263     ENDIF
00264 !
00265 !       3.2. Neutral coefficient for temperature chn (ECUME_v0 formulation)
00266 !
00267     IF (ZDELTAU10N(JLON) <= 33.0) THEN
00268       ZCHN(JLON) = 1.2536E-03                          &
00269                   + (-1.2455E-04 * ZDELTAU10N(JLON)   ) &
00270                   + (+1.6038E-05 * ZDELTAU10N(JLON)**2) &
00271                   + (-4.3701E-07 * ZDELTAU10N(JLON)**3) &
00272                   + (+3.4517E-09 * ZDELTAU10N(JLON)**4) &
00273                   + (+3.5763E-12 * ZDELTAU10N(JLON)**5)  
00274     ELSE
00275       ZCHN(JLON) = 3.1374E-03
00276     ENDIF
00277 !
00278 !       3.3. Neutral coefficient for humidity cen (ECUME_v0 formulation)
00279 !
00280     IF (ZDELTAU10N(JLON) <= 29.0) THEN
00281       ZCEN(JLON) = 1.2687E-03                          &
00282                   + (-1.1384E-04 * ZDELTAU10N(JLON)   ) &
00283                   + (+1.1467E-05 * ZDELTAU10N(JLON)**2) &
00284                   + (-3.9144E-07 * ZDELTAU10N(JLON)**3) &
00285                   + (+5.0864E-09 * ZDELTAU10N(JLON)**4)  
00286     ELSEIF (ZDELTAU10N(JLON) <= 33.0) THEN
00287       ZCEN(JLON) = -1.3526E-03                         &
00288                   + (+1.8229E-04 * ZDELTAU10N(JLON)   ) &
00289                   + (-2.6995E-06 * ZDELTAU10N(JLON)**2)  
00290     ELSE
00291       ZCEN(JLON) = 1.7232E-03
00292     ENDIF
00293     ZCEN(JLON) = ZCEN(JLON)*(1.0-PICHCE)+ZCHN(JLON)*PICHCE
00294 !
00295 !       3.4. Scaling parameters and roughness lenght
00296 !
00297     ZUSR(JLON) = SQRT(PCDN(JLON))*ZDELTAU10N(JLON)
00298     ZTSR(JLON) = ZCHN(JLON)/SQRT(PCDN(JLON))*ZDELTAT10N(JLON)
00299     ZQSR(JLON) = ZCEN(JLON)/SQRT(PCDN(JLON))*ZDELTAQ10N(JLON)
00300     PZ0SEA(JLON) = 10.0/EXP(XKARMAN*ZDELTAU10N(JLON)/ZUSR(JLON))
00301 !
00302 !       3.5. Gustiness factor ZWG following Mondon & Redelsperger (1998)
00303 !
00304 !       3.6. Obukhovs stability param. z/l following Liu et al. (JAS, 1979)
00305 !
00306 ! For U
00307     ZLMOU = PUREF(JLON)*XG*XKARMAN*(ZTSR(JLON)/(PTA(JLON)) &
00308        +ZETV*ZQSR(JLON)/(1.0+ZETV*PQA(JLON)))/MAX(ZUSR(JLON),ZEPS)**2  
00309 ! For T/Q
00310     ZLMOT = ZLMOU*PZREF(JLON)/PUREF(JLON)
00311     ZLMOU = MAX(MIN(ZLMOU,ZLMOMAX),ZLMOMIN)
00312     ZLMOT = MAX(MIN(ZLMOT,ZLMOMAX),ZLMOMIN)
00313 !
00314 !       3.7. Stability function psi (see Liu et al, 1979 ; Dyer and Hicks, 1970)
00315 !            Modified to include convective form following Fairall (unpublished)
00316 !
00317 !   For U
00318     IF (ZLMOU == 0.0) THEN
00319       ZPSI_U = 0.0
00320     ELSEIF (ZLMOU > 0.0) THEN
00321       ZPSI_U = -7.0*ZLMOU
00322     ELSE
00323       ZCHIK  = (1.0-16.0*ZLMOU)**0.25
00324       ZPSIK  = 2.0*LOG((1.0+ZCHIK)/2.0) &
00325                 +LOG((1.0+ZCHIK**2)/2.0) &
00326                 -2.0*ATAN(ZCHIK)+ZPIS2  
00327       ZCHIC  = (1.0-12.87*ZLMOU)**(1.0/3.0)     !for very unstable conditions
00328       ZPSIC  = 1.5*LOG((ZCHIC**2+ZCHIC+1.0)/3.0)  &
00329                 -ZSQR3*ATAN((2.0*ZCHIC+1.0)/ZSQR3) &
00330                 +ZPI/ZSQR3  
00331       ZPSI_U = ZPSIC+(ZPSIK-ZPSIC)/(1.0+ZLMOU**2)
00332                                                 !match Kansas & free-conv. forms
00333     ENDIF
00334 !   For T/Q
00335     IF (ZLMOT == 0.0) THEN
00336       ZPSI_T = 0.0
00337     ELSEIF (ZLMOT > 0.0) THEN
00338       ZPSI_T = -7.0*ZLMOT
00339     ELSE
00340       ZCHIK  = (1.0-16.0*ZLMOT)**0.25
00341       ZPSIK  = 2.0*LOG((1.0+ZCHIK**2)/2.0)
00342       ZCHIC  = (1.0-12.87*ZLMOT)**(1.0/3.0)     !for very unstable conditions
00343       ZPSIC  = 1.5*LOG((ZCHIC**2+ZCHIC+1.0)/3.0)  &
00344                 -ZSQR3*ATAN((2.0*ZCHIC+1.0)/ZSQR3) &
00345                 +ZPI/ZSQR3  
00346       ZPSI_T = ZPSIC+(ZPSIK-ZPSIC)/(1.0+ZLMOT**2)
00347                                                 !match Kansas & free-conv. forms
00348     ENDIF
00349 !
00350 !       3.8. Update ZDELTAU10N, ZDELTAT10N and ZDELTAQ10N
00351 !
00352     ZLOGHS10 = LOG(PUREF(JLON)/10.0)
00353     ZLOGTS10 = LOG(PZREF(JLON)/10.0)
00354     ZDUWG(JLON) = (ZDU(JLON)**2+ZWG(JLON)**2)**0.5
00355     ZDELTAU10N(JLON) = ZDUWG(JLON)-ZUSR(JLON)*(ZLOGHS10-ZPSI_U)/XKARMAN
00356     ZDELTAT10N(JLON) = ZDTH (JLON)-ZTSR(JLON)*(ZLOGTS10-ZPSI_T)/XKARMAN
00357     ZDELTAQ10N(JLON) = ZDQ  (JLON)-ZQSR(JLON)*(ZLOGTS10-ZPSI_T)/XKARMAN
00358 
00359   ENDDO
00360 ENDDO
00361 !
00362 !-------------------------------------------------------------------------------
00363 !
00364 !       4.   COMPUTATION OF EXCHANGE COEFFICIENTS AND TURBULENT FLUXES.
00365 !       ---------------------------------------------------------------
00366 !
00367 DO JLON=1,SIZE(PTA)
00368 !
00369 !       4.1. Exchange coefficients PCD, PCH, PCE
00370 !
00371   ZZDTH = 0.5* &
00372            ((1.0+SIGN(1.0,ZDTH(JLON)))*MAX(ZDTH(JLON),ZEPS) &
00373            +(1.0-SIGN(1.0,ZDTH(JLON)))*MIN(ZDTH(JLON),-ZEPS))  
00374   ZZDQ  = 0.5* &
00375            ((1.0+SIGN(1.0,ZDQ(JLON)))*MAX(ZDQ(JLON),ZEPS)   &
00376            +(1.0-SIGN(1.0,ZDQ(JLON)))*MIN(ZDQ(JLON),-ZEPS))  
00377   PCD(JLON) = (ZUSR(JLON)/ZDUWG(JLON))**2
00378   PCH(JLON) = ZUSR(JLON)*ZTSR(JLON)/(ZDUWG(JLON)*ZZDTH)
00379   PCE(JLON) = ZUSR(JLON)*ZQSR(JLON)/(ZDUWG(JLON)*ZZDQ)
00380 !
00381 !       4.2. Surface turbulent fluxes
00382 !            (ATM CONV.: ZTAU<<0 ; ZHF,ZEF<0 if atm looses heat)
00383 !
00384   ZTAU(JLON) = -PRHOA(JLON)*PCD(JLON)*ZDUWG(JLON)**2
00385   ZHF (JLON) = -PRHOA(JLON)*XCPD*PCH(JLON)*ZDUWG(JLON)*ZDTH(JLON)
00386   ZEF (JLON) = -PRHOA(JLON)*ZLV(JLON)*PCE(JLON)*ZDUWG(JLON)*ZDQ(JLON)
00387 !
00388 ENDDO
00389 !
00390 !-------------------------------------------------------------------------------
00391 !
00392 !       5.   COMPUTATION OF FLUX CORRECTIONS DUE TO RAINFALL.
00393 !            (ATM conv: ZRF<0 if atm. looses heat, ZTAUR<<0)
00394 !       -----------------------------------------------------
00395 
00396 IF(OPRECIP) THEN
00397   DO JLON=1,SIZE(PTA)
00398 !
00399 !       5.1. Momentum flux due to rainfall (ZTAUR, N/m2)
00400 !
00401 ! See pp3752 in FBR96.
00402     ZTAUR(JLON) = -PRAIN(JLON)*ZDUWG(JLON)
00403 !
00404 !       5.2. Sensible heat flux due to rainfall (ZRF, W/m2)
00405 !
00406 ! See Eq.12 in GoF95, with ZCPLW as specific heat of water (J/kg/K), ZDWAT as
00407 ! water vapor diffusivity (Eq.13-3 of Pruppacher and Klett, 1978), ZDTMP as
00408 ! heat diffusivity, ZDQSDT from Clausius-Clapeyron relation and ZALFAC as
00409 ! wet-bulb factor (Eq.11 in GoF95).
00410     ZTAC   = PTA(JLON)-XTT
00411     ZCPLW  = 4224.8482+ZTAC*(-4.707+ZTAC*(0.08499 &
00412               +ZTAC*(1.2826E-03+ZTAC*(4.7884E-05   &
00413               -2.0027E-06*ZTAC))))  
00414     ZDWAT  = 2.11E-05*(ZP00/ZPA(JLON)) &
00415               *(PTA(JLON)/XTT)**1.94  
00416     ZDTMP  = (1.0+3.309E-03*ZTAC-1.44E-06*ZTAC**2) &
00417               *0.02411/(PRHOA(JLON)*XCPD)  
00418     ZDQSDT = ZQSATA(JLON)*ZLR(JLON)/(XRD*PTA(JLON)**2)
00419     ZALFAC = 1.0/(1.0+ZDQSDT*(ZLR(JLON)*ZDWAT)/(ZDTMP*XCPD))
00420     ZRF(JLON) = ZCPLW*PRAIN(JLON)*ZALFAC*((PSST(JLON)-PTA(JLON)) &
00421                  +(PQSAT(JLON)-PQA(JLON))*(ZLR(JLON)*ZDWAT)/(ZDTMP*XCPD))  
00422 
00423   ENDDO
00424 ENDIF
00425 !
00426 !-------------------------------------------------------------------------------
00427 !
00428 !       6.   COMPUTATION OF WEBB CORRECTION TO LATENT HEAT FLUX (ZEFWEBB, W/m2).
00429 !       ------------------------------------------------------------------------
00430 !
00431 ! See Eq.21 and Eq.22 in FBR96.
00432 IF (OPWEBB) THEN
00433   DO JLON=1,SIZE(PTA)
00434     ZWW = -(1.0+ZETV)*(PCE(JLON)*ZDUWG(JLON)*ZDQ(JLON)) &
00435            -(1.0+(1.0+ZETV)*PQA(JLON))*              &
00436            (PCH(JLON)*ZDUWG(JLON)*ZDTH(JLON))/(PTA(JLON))  
00437     ZEFWEBB(JLON) = PRHOA(JLON)*ZWW*ZLV(JLON)*PQA(JLON)
00438   ENDDO
00439 ENDIF
00440 !
00441 !-------------------------------------------------------------------------------
00442 !
00443 !       7.   FINAL STEP : TOTAL SURFACE FLUXES AND DERIVED DIAGNOSTICS. 
00444 !       ---------------------------------------------------------------
00445 !
00446 !       7.1. Richardson number
00447 !
00448  CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,PTA,ZQSATA, &
00449                 PZREF,PUREF,ZDIRCOSZW,PVMOD,PRI    )  
00450 !
00451 !       7.2. Friction velocity which contains correction du to rain
00452 !
00453 ZUSTAR2(:)=-(ZTAU(:)+ZTAUR(:))/PRHOA(:)
00454 !
00455 IF(OPRECIP) THEN
00456   PCD(:)=ZUSTAR2(:)/(ZDUWG(:)**2)
00457 ENDIF
00458 !
00459 PUSTAR(:)=SQRT(ZUSTAR2(:))
00460 !
00461 !       7.3. Aerodynamical conductance and resistance
00462 !
00463 ZAC(:)=PCH(:)*ZVMOD(:)
00464 PRESA(:)=1./ZAC(:)
00465 !
00466 !       7.4. Total surface fluxes
00467 !
00468 PSFTH(:)=ZHF(:)+ZRF(:)
00469 PSFTQ(:)=(ZEF(:)+ZEFWEBB(:))/ZLV(:)
00470 !
00471 !       7.5. Z0H over water
00472 !
00473 PZ0HSEA(:)=PZ0SEA(:)
00474 !
00475 IF (LHOOK) CALL DR_HOOK('ECUME_FLUX',1,ZHOOK_HANDLE)
00476 !-------------------------------------------------------------------------------
00477 
00478 END SUBROUTINE ECUME_FLUX