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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WATER_FLUX(PZ0SEA,                                         &
00003                               PTA, PEXNA, PRHOA, PSST, PEXNS, PQA, PRR, PRS,  &
00004                               PTT, PVMOD, PZREF, PUREF,                       &
00005                               PPS, PQSAT,                                     &
00006                               PSFTH, PSFTQ, PUSTAR,                           &
00007                               PCD, PCDN, PCH, PRI, PRESA, PZ0HSEA             )  
00008 !     #######################################################################
00009 !
00010 !
00011 !!****  *WATER_FLUX*  
00012 !!
00013 !!    PURPOSE
00014 !!    -------
00015 !      Calculate the surface fluxes of heat, moisture, and momentum over
00016 !      water surfaces.  
00017 !     
00018 !!**  METHOD
00019 !!    ------
00020 !
00021 !!    EXTERNAL
00022 !!    --------
00023 !!
00024 !!    IMPLICIT ARGUMENTS
00025 !!    ------------------ 
00026 !!
00027 !!      
00028 !!    REFERENCE
00029 !!    ---------
00030 !!      
00031 !!    AUTHOR
00032 !!    ------
00033 !!      S. Belair           * Meteo-France *
00034 !!
00035 !!    MODIFICATIONS
00036 !!    -------------
00037 !!      Original      01/09/95 
00038 !!      (J.Stein)     16/11/95  use PUSLOPE and Theta to compute Ri
00039 !!      (P.Lacarrere) 19/03/96  bug in the ZTHVI and ZTHVIS computations
00040 !!      (J.Stein)     27/03/96  use only H and LE in the soil scheme
00041 !!      (P.Jabouille) 12/11/96  bug in the Z0 computation
00042 !!      (V.Masson)    01/02/00  detection of sea ice
00043 !!      (P. Tulet)    01/10/03  aerodynamical resistance output
00044 !!      (P. LeMoigne) 29/03/04  bug in the heat flux computation
00045 !!      (P. LeMoigne) 29/03/04  use z0h for diagnostics (ice)
00046 !!      (P. LeMoigne) 20/06/07  minimum wind speed and/or shear
00047 !!      B. Decharme    06/2009 limitation of Ri
00048 !!      B. Decharme    09/2012 limitation of Ri in surface_ri.F90
00049 !-------------------------------------------------------------------------------
00050 !
00051 !*       0.     DECLARATIONS
00052 !               ------------
00053 !
00054 USE MODD_CSTS,       ONLY : XG, XCPD, XLSTT
00055 USE MODD_SURF_PAR,   ONLY : XUNDEF
00056 USE MODD_SNOW_PAR,   ONLY : XZ0SN, XZ0HSN
00057 !
00058 USE MODI_SURFACE_RI
00059 USE MODI_SURFACE_AERO_COND
00060 USE MODI_SURFACE_CD
00061 USE MODI_SURFACE_CDCH_1DARP
00062 USE MODI_WIND_THRESHOLD
00063 !
00064 USE MODE_THERMOS
00065 !
00066 USE MODD_SURF_ATM,    ONLY : LDRAG_COEF_ARP, XVCHRNK, XVZ0CM, LVZIUSTAR0_ARP, XVZIUSTAR0,  &
00067                                LRRGUST_ARP, XRRSCALE, XRRGAMMA, XUTILGUST, XRZHZ0M  
00068 
00069 !
00070 !
00071 !
00072 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00073 USE PARKIND1  ,ONLY : JPRB
00074 !
00075 IMPLICIT NONE
00076 !
00077 !*      0.1    declarations of arguments
00078 !
00079 !
00080 REAL, DIMENSION(:), INTENT(IN)       :: PTA   ! air temperature at atm. level
00081 REAL, DIMENSION(:), INTENT(IN)       :: PQA   ! air humidity at atm. level (kg/kg)
00082 REAL, DIMENSION(:), INTENT(IN)       :: PEXNA ! Exner function at atm. level
00083 REAL, DIMENSION(:), INTENT(IN)       :: PRHOA ! air density at atm. level
00084 REAL, DIMENSION(:), INTENT(IN)       :: PVMOD ! module of wind at atm. wind level
00085 REAL, DIMENSION(:), INTENT(IN)       :: PZREF ! atm. level for temp. and humidity
00086 REAL, DIMENSION(:), INTENT(IN)       :: PUREF ! atm. level for wind
00087 REAL, DIMENSION(:), INTENT(IN)       :: PSST  ! Sea Surface Temperature
00088 REAL, DIMENSION(:), INTENT(IN)       :: PEXNS ! Exner function at sea surface
00089 REAL, DIMENSION(:), INTENT(IN)       :: PPS   ! air pressure at sea surface
00090 REAL, DIMENSION(:), INTENT(IN)       :: PRR   ! rain rate
00091 REAL, DIMENSION(:), INTENT(IN)       :: PRS   ! snow rate
00092 REAL,               INTENT(IN)       :: PTT   ! temperature of freezing point
00093 !
00094 REAL, DIMENSION(:), INTENT(INOUT)    :: PZ0SEA! roughness length over the ocean
00095 !                                         
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 ! humidity at saturation
00104 REAL, DIMENSION(:), INTENT(OUT)      :: PCD   ! heat drag coefficient
00105 REAL, DIMENSION(:), INTENT(OUT)      :: PCDN  ! momentum drag coefficient
00106 REAL, DIMENSION(:), INTENT(OUT)      :: PCH   ! neutral momentum drag coefficient
00107 REAL, DIMENSION(:), INTENT(OUT)      :: PRI   ! Richardson number
00108 REAL, DIMENSION(:), INTENT(OUT)      :: PRESA ! aerodynamical resistance
00109 REAL, DIMENSION(:), INTENT(OUT)      :: PZ0HSEA ! heat roughness length over the ocean
00110 !
00111 !
00112 !*      0.2    declarations of local variables
00113 !
00114 !
00115 REAL, DIMENSION(SIZE(PTA)) :: ZVMOD     ! wind modulus
00116 REAL, DIMENSION(SIZE(PTA)) :: ZUSTAR2   ! square of friction velocity
00117 REAL, DIMENSION(SIZE(PTA)) :: ZAC       ! Aerodynamical conductance
00118 REAL, DIMENSION(SIZE(PTA)) :: ZRA       ! Aerodynamical resistance
00119 REAL, DIMENSION(SIZE(PTA)) :: ZDIRCOSZW ! orography slope cosine (=1 on water!)
00120 REAL, DIMENSION(SIZE(PTA)) :: ZFP       ! working variable
00121 REAL, DIMENSION(SIZE(PTA)) :: ZRRCOR    ! correction of CD, CH, CDN due to moist-gustiness
00122 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00123 !
00124 !-------------------------------------------------------------------------------
00125 !
00126 !       1.     Initializations
00127 !              ---------------
00128 !
00129 IF (LHOOK) CALL DR_HOOK('WATER_FLUX',0,ZHOOK_HANDLE)
00130 ZDIRCOSZW=1.
00131 !
00132 PRI(:) = XUNDEF
00133 PCH(:) = XUNDEF
00134 PCD(:) = XUNDEF
00135 PCDN(:) = XUNDEF
00136 !
00137 PSFTH (:)=XUNDEF
00138 PSFTQ (:)=XUNDEF
00139 PUSTAR(:)=XUNDEF
00140 PRESA(:)=XUNDEF
00141 !
00142 !
00143 !       1.1    Saturated specified humidity near the water surface
00144 !              ---------------------------------------------------
00145 !
00146 PQSAT(:) = QSAT(PSST(:),PPS(:))
00147 !
00148 !-------------------------------------------------------------------------------
00149 !
00150 !       2.     Calculate the drag coefficient for momentum (PCD)
00151 !              -------------------------------------------------
00152 !
00153 !       2.1    Richardson number
00154 !              -----------------
00155 !
00156  CALL SURFACE_RI(PSST,PQSAT,PEXNS,PEXNA,PTA,PQA,  &
00157                   PZREF, PUREF, ZDIRCOSZW,PVMOD,PRI)
00158 !
00159 !       2.2    Detection of sea ice
00160 !              --------------------
00161 !
00162 IF (LVZIUSTAR0_ARP.AND.(XVZIUSTAR0 == 0.)) THEN
00163   WHERE (PSST(:) >= PTT)
00164     PZ0HSEA(:)=MIN(PZ0SEA(:),PZ0SEA(:)*XRZHZ0M)
00165   END WHERE
00166 ELSEIF ( .NOT. LVZIUSTAR0_ARP ) THEN
00167   WHERE (PSST(:) >= PTT)
00168     PZ0HSEA(:)=PZ0SEA(:)
00169   END WHERE
00170 ENDIF
00171 WHERE (PSST(:) < PTT)
00172   PZ0HSEA(:) = XZ0HSN
00173 END WHERE
00174 !
00175 !       2.3    Drag coefficient
00176 !              ----------------
00177 !
00178 ZVMOD(:)=WIND_THRESHOLD(PVMOD(:),PUREF(:))
00179 !
00180 IF (LDRAG_COEF_ARP) THEN
00181  
00182   CALL SURFACE_CDCH_1DARP(PZREF, PZ0SEA, PZ0HSEA, ZVMOD, PTA, PSST, &
00183                             PQA, PQSAT, PCD, PCDN, PCH                )  
00184 
00185   ZRA(:) = 1. / ( PCH(:) * ZVMOD(:) )
00186 !
00187 !       2.4    Calculate u* and the roughness length over the ocean
00188 !              ----------------------------------------------------
00189 !
00190 !                              According to Charnock's expression...
00191 !
00192   ZUSTAR2(:) = PCD(:)*ZVMOD(:)*ZVMOD(:)
00193   WHERE (PSST(:)>=PTT)
00194     PZ0SEA(:) = XVCHRNK * ZUSTAR2(:) / XG + XVZ0CM * PCD(:) / PCDN(:)
00195   ELSEWHERE
00196     PZ0SEA(:) = XZ0SN
00197   END WHERE
00198   IF (LVZIUSTAR0_ARP) THEN
00199     WHERE (PSST(:)>=PTT)
00200       PZ0HSEA(:)=PZ0SEA(:)*EXP(-SQRT(ZUSTAR2(:))*XVZIUSTAR0)
00201     END WHERE
00202   ELSE
00203     WHERE (PSST(:)>=PTT)
00204       PZ0HSEA(:)=PZ0SEA(:)
00205     END WHERE
00206   ENDIF     
00207 
00208 ELSE
00209 !
00210   CALL SURFACE_CD(PRI, PZREF, PUREF, PZ0SEA, PZ0HSEA, PCD, PCDN)
00211 !
00212 !-------------------------------------------------------------------------------
00213 !
00214 !       3.     Calculate u* and the roughness length over the ocean
00215 !              ----------------------------------------------------
00216 !
00217 !                              According to Charnock's expression...
00218 !
00219   ZUSTAR2(:) = PCD(:)*ZVMOD(:)*ZVMOD(:)
00220 !
00221   WHERE (PSST(:)>=PTT)
00222     PZ0SEA(:) = XVCHRNK * ZUSTAR2(:) / XG + XVZ0CM * PCD(:) / PCDN(:)
00223   ELSEWHERE
00224     PZ0SEA(:) = XZ0SN
00225   END WHERE
00226   IF (LVZIUSTAR0_ARP) THEN
00227     WHERE (PSST(:)>=PTT)
00228       PZ0HSEA(:)=PZ0SEA(:)*EXP(-SQRT(ZUSTAR2(:))*XVZIUSTAR0)
00229     END WHERE
00230   ELSE
00231     WHERE (PSST(:)>=PTT)
00232       PZ0HSEA(:)=PZ0SEA(:)
00233     END WHERE
00234   ENDIF     
00235 !
00236 !-------------------------------------------------------------------------------
00237 !
00238 !       4.     Drag coefficient for heat and aerodynamical resistance
00239 !              -------------------------------------------------------
00240 !
00241   CALL SURFACE_AERO_COND(PRI, PZREF, PUREF, ZVMOD, PZ0SEA, PZ0HSEA, ZAC, ZRA, PCH)
00242 !
00243 ENDIF
00244 !
00245 IF (LRRGUST_ARP) THEN
00246   ZFP(:)=MAX(0.0,PRR(:)+PRS(:))
00247   ZRRCOR(:)=SQRT(1.0+((((ZFP(:)/(ZFP(:)+XRRSCALE))**XRRGAMMA)*XUTILGUST)**2) &
00248       /(PCD(:)*ZVMOD(:)**2))  
00249 
00250   PCD  = PCD*ZRRCOR
00251   PCH  = PCH*ZRRCOR
00252   PCDN = PCDN*ZRRCOR
00253 ENDIF
00254 !
00255 PRESA(:) = ZRA(:)
00256 !
00257 !-------------------------------------------------------------------------------
00258 !
00259 !       5.     The fluxes
00260 !              ----------
00261 !
00262 PSFTH (:) =  XCPD * PRHOA(:) * PCH(:) * ZVMOD(:) * ( PSST(:) -PTA(:) * PEXNS(:) / PEXNA(:) ) / PEXNS(:)
00263 PSFTQ (:) =  PRHOA(:) * PCH(:) * ZVMOD(:) * ( PQSAT(:)-PQA(:) )
00264 PUSTAR(:) = SQRT(ZUSTAR2(:))
00265 IF (LHOOK) CALL DR_HOOK('WATER_FLUX',1,ZHOOK_HANDLE)
00266 !
00267 !-------------------------------------------------------------------------------
00268 !
00269 !       6.     Specific fields for GELATO
00270 !              --------------------------
00271 !
00272 !
00273 !-------------------------------------------------------------------------------
00274 !
00275 END SUBROUTINE WATER_FLUX