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

Go to the documentation of this file.
00001 !     ##########################
00002       MODULE MODE_SURF_SNOW_FRAC
00003 !     ##########################
00004 !
00005 !!****  *MODE_SURF_SNOW_FRAC* -  module for routines to compute snow fraction
00006 !!                               for surface schemes
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !    
00011 !      The purpose of this routine is to store here all routines to compute
00012 !     snow fractions for the TEB scheme. This allows to insure a coherent
00013 !     way in retrieving snow fraction or snow contents.
00014 !
00015 !!
00016 !!**  IMPLICIT ARGUMENTS
00017 !!    ------------------
00018 !!       NONE          
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!      V. Masson       * Meteo France *
00027 !!
00028 !!    MODIFICATIONS
00029 !!    -------------
00030 !!      Original    15/03/99
00031 !!     (B.Decharme) 12/03/08  Make sure PPSNV <= PPSNG
00032 !--------------------------------------------------------------------------------
00033 !
00034 !*       0.    DECLARATIONS
00035 !              ------------
00036 !
00037 !
00038 !-------------------------------------------------------------------------------
00039 !
00040 !
00041 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00042 USE PARKIND1  ,ONLY : JPRB
00043 !
00044 CONTAINS
00045 !-------------------------------------------------------------------------------
00046 !
00047 !     ###############################################
00048       FUNCTION SNOW_FRAC_GROUND(PWSNOW) RESULT(PPSNG)
00049 !     ###############################################
00050 !
00051 USE MODD_SNOW_PAR, ONLY : XWCRN
00052 IMPLICIT NONE
00053 !
00054 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW ! snow amount over natural areas (kg/m2)
00055 REAL, DIMENSION(SIZE(PWSNOW))   :: PPSNG  ! snow fraction over bare ground
00056 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00057 !
00058 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND',0,ZHOOK_HANDLE)
00059 PPSNG(:) = PWSNOW(:) / (PWSNOW(:)+XWCRN)       ! fraction of ground covered
00060 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND',1,ZHOOK_HANDLE)
00061 !
00062 END FUNCTION SNOW_FRAC_GROUND
00063 !
00064 !-------------------------------------------------------------------------------
00065 !
00066 !     ##########################################################
00067       FUNCTION WSNOW_FROM_SNOW_FRAC_GROUND(PPSNG) RESULT(PWSNOW)
00068 !     ##########################################################
00069 !
00070 USE MODD_SNOW_PAR, ONLY : XWCRN
00071 IMPLICIT NONE
00072 !
00073 REAL, DIMENSION(:), INTENT(IN)  :: PPSNG  ! snow fraction over bare ground
00074 REAL, DIMENSION(SIZE(PPSNG))    :: PWSNOW ! snow amount over natural areas (kg/m2)
00075 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00076 !
00077 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:WSNOW_FROM_SNOW_FRAC_GROUND',0,ZHOOK_HANDLE)
00078 PWSNOW(:) = XWCRN * PPSNG(:) / (1. - PPSNG(:))
00079 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:WSNOW_FROM_SNOW_FRAC_GROUND',1,ZHOOK_HANDLE)
00080 !
00081 END FUNCTION WSNOW_FROM_SNOW_FRAC_GROUND
00082 !-------------------------------------------------------------------------------
00083 !
00084 !     #########################################################
00085       FUNCTION SNOW_FRAC_VEG(PPSNG,PWSNOW,PZ0VEG,PRHOS) RESULT(PPSNV)
00086 !     #########################################################
00087 !
00088 USE MODD_SNOW_PAR, ONLY : XWSNV
00089 IMPLICIT NONE
00090 !
00091 REAL, DIMENSION(:), INTENT(IN)  :: PPSNG  ! snow fraction over bare ground
00092 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW ! snow amount over natural areas (kg/m2)
00093 REAL, DIMENSION(:), INTENT(IN)  :: PZ0VEG ! vegetation roughness length for momentum
00094 REAL, DIMENSION(:), INTENT(IN)  :: PRHOS  ! snow density (kg/m3)
00095 REAL, DIMENSION(SIZE(PWSNOW))   :: PPSNV  ! snow fraction over vegetation
00096 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00097 !
00098 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG',0,ZHOOK_HANDLE)
00099 PPSNV(:) = PWSNOW(:) / (PWSNOW(:)+PRHOS(:)*XWSNV*PZ0VEG(:))
00100 ! Make sure PPSNV <= PPSNG
00101 PPSNV(:) = MIN(PPSNV(:),PPSNG(:))
00102 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG',1,ZHOOK_HANDLE)
00103 !
00104 END FUNCTION SNOW_FRAC_VEG
00105 !
00106 !-------------------------------------------------------------------------------
00107 !     **********************************************************
00108       FUNCTION SNOW_FRAC_VEG_A(P_PSNG,P_LAI,P_SNOWALB) RESULT(PPSNV)
00109 !     **********************************************************
00110 !
00111 IMPLICIT NONE
00112 !
00113 REAL, DIMENSION(:), INTENT(IN)  :: P_LAI ! leaf area index
00114 REAL, DIMENSION(:), INTENT(IN)  :: P_SNOWALB ! snow albedo
00115 REAL, DIMENSION(:), INTENT(IN)  :: P_PSNG ! snow fraction over bare ground
00116 REAL, DIMENSION(SIZE(P_LAI))    :: PPSNV  ! snow fraction over vegetation
00117 !
00118 !
00119 !
00120 ! Definition of local variables
00121 REAL, DIMENSION(SIZE(P_LAI))   :: FLAI  ! snow fraction over vegetation
00122 REAL  RLAIMAX,RLAI,A1,A2
00123 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00124 !
00125 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_A',0,ZHOOK_HANDLE)
00126 RLAIMAX=7.
00127 RLAI=3.
00128 A1=0.87
00129 A2=0.84
00130 FLAI(:)=1.
00131 WHERE(P_LAI(:)>RLAI)
00132  FLAI(:)=1.-(P_LAI(:)/RLAIMAX)*(MAX(0.0,(A1-MAX(A2,P_SNOWALB(:))))/(A1-A2))
00133 END WHERE
00134 PPSNV(:)=P_PSNG(:)*FLAI(:)
00135 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_A',1,ZHOOK_HANDLE)
00136 !
00137 END FUNCTION SNOW_FRAC_VEG_A
00138 
00139 !-------------------------------------------------------------------------------
00140 !
00141 !     ############################################################
00142       FUNCTION SNOW_FRAC_NAT(PWSNOW,PPSNG,PPSNV,PVEG) RESULT(PPSN)
00143 !     ############################################################
00144 !
00145 IMPLICIT NONE
00146 !
00147 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW ! snow amount over natural areas (kg/m2)
00148 REAL, DIMENSION(:), INTENT(IN)  :: PPSNG  ! snow fraction over bare ground
00149 REAL, DIMENSION(:), INTENT(IN)  :: PPSNV  ! snow fraction over vegetation
00150 REAL, DIMENSION(:), INTENT(IN)  :: PVEG   ! vegetation fraction
00151 REAL, DIMENSION(SIZE(PWSNOW))   :: PPSN   ! snow fraction over natural areas
00152 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00153 !
00154 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT',0,ZHOOK_HANDLE)
00155 PPSN(:) = (1-PVEG(:))*PPSNG(:) + PVEG(:)*PPSNV(:)
00156 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT',1,ZHOOK_HANDLE)
00157 !
00158 END FUNCTION SNOW_FRAC_NAT
00159 !
00160 !-------------------------------------------------------------------------------
00161 !
00162 !-------------------------------------------------------------------------------
00163 !
00164 !     ##############################################################
00165       SUBROUTINE SNOW_FRAC_ROAD(PWSNOW_ROAD,OSNOW,PDN_ROAD,PDF_ROAD)
00166 !     ##############################################################
00167 !
00168 USE MODD_SNOW_PAR, ONLY : XWCRN
00169 !
00170 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW_ROAD ! snow amount over roads (kg/m2) 
00171 LOGICAL, DIMENSION(:), INTENT(IN)  :: OSNOW    ! T: snow-fall is occuring
00172 REAL, DIMENSION(:), INTENT(OUT) :: PDN_ROAD    ! snow fraction over roads
00173 REAL, DIMENSION(:), INTENT(OUT) :: PDF_ROAD    ! snow-free fraction over roads
00174 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00175 !
00176 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_ROAD',0,ZHOOK_HANDLE)
00177 PDF_ROAD(:)     = 1.
00178 PDN_ROAD(:)     = 0.
00179 !
00180 ! due to the flatness of horizontal surfaces (compared to landscape and
00181 ! vegetation), the amount of snow necessary to cover the entire surface XWCRN
00182 ! is reduced (equal to 1kg/m2 instead of 10).
00183 !
00184 WHERE (PWSNOW_ROAD(:)>0. .OR. OSNOW)
00185   PDN_ROAD(:)     = MAX(MIN(PWSNOW_ROAD(:)/(PWSNOW_ROAD(:) + XWCRN*0.1) , 0.7), 0.01)
00186   PDF_ROAD(:)     = 1.-PDN_ROAD(:)
00187 END WHERE
00188 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_ROAD',1,ZHOOK_HANDLE)
00189 !
00190 END SUBROUTINE SNOW_FRAC_ROAD
00191 !
00192 !-------------------------------------------------------------------------------
00193 !
00194 !     ##############################################################
00195       SUBROUTINE SNOW_FRAC_ROOF(PWSNOW_ROOF,OSNOW,PDN_ROOF,PDF_ROOF)
00196 !     ##############################################################
00197 !
00198 USE MODD_SNOW_PAR, ONLY : XWCRN
00199 !
00200 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW_ROOF ! snow amount over roofs (kg/m2) 
00201 LOGICAL, DIMENSION(:), INTENT(IN)  :: OSNOW    ! T: snow-fall is occuring
00202 REAL, DIMENSION(:), INTENT(OUT) :: PDN_ROOF    ! snow fraction over roofs
00203 REAL, DIMENSION(:), INTENT(OUT) :: PDF_ROOF    ! snow-free fraction over roofs
00204 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00205 !
00206 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_ROOF',0,ZHOOK_HANDLE)
00207 PDF_ROOF(:)     = 1.
00208 PDN_ROOF(:)     = 0.
00209 !
00210 ! due to the flatness of horizontal surfaces (compared to landscape and
00211 ! vegetation), the amount of snow necessary to cover the entire surface XWCRN
00212 ! is reduced (equal to 1kg/m2 instead of 10).
00213 !
00214 WHERE (PWSNOW_ROOF(:)>0. .OR. OSNOW)
00215   PDN_ROOF(:)     = MAX(PWSNOW_ROOF(:)/(PWSNOW_ROOF(:) + XWCRN*0.1),0.01)
00216   PDF_ROOF(:)     = 1.-PDN_ROOF(:)
00217 END WHERE
00218 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_ROOF',1,ZHOOK_HANDLE)
00219 !
00220 END SUBROUTINE SNOW_FRAC_ROOF
00221 !
00222 !-------------------------------------------------------------------------------
00223 !-------------------------------------------------------------------------------
00224 ! routines bidon pour tora
00225 !
00226 !     ########################################################
00227       FUNCTION SNOW_FRAC_NAT_1D(PWSNOW)RESULT(BIDON)
00228 !     ########################################################
00229 !
00230 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW ! snow amount over natural areas (kg/m2)
00231 REAL :: BIDON
00232 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00233 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT_1D',0,ZHOOK_HANDLE)
00234 BIDON=PWSNOW(1)
00235 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT_1D',1,ZHOOK_HANDLE)
00236 !
00237 END FUNCTION SNOW_FRAC_NAT_1D
00238 !
00239 !-------------------------------------------------------------------------------
00240 !
00241 !     ########################################################
00242       FUNCTION SNOW_FRAC_NAT_2D(PWSNOW) RESULT(BIDON)
00243 !     ########################################################
00244 
00245 REAL :: BIDON
00246 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW ! snow amount over natural areas (kg/m2)
00247 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00248 !
00249 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT_2D',0,ZHOOK_HANDLE)
00250 BIDON=PWSNOW(1)
00251 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_NAT_2D',1,ZHOOK_HANDLE)
00252 
00253 END FUNCTION SNOW_FRAC_NAT_2D
00254 
00255 !----------------------------------------------------------------------------------
00256 !     ############################################################
00257       FUNCTION SNOW_FRAC_VEG_1D(PWSNOW) RESULT(BIDON)
00258 !     ############################################################
00259 REAL :: BIDON
00260 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW ! snow amount over natural areas (kg/m2)
00261 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00262 !
00263 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_1D',0,ZHOOK_HANDLE)
00264 BIDON=PWSNOW(1)
00265 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_1D',1,ZHOOK_HANDLE)
00266 END FUNCTION SNOW_FRAC_VEG_1D
00267 !
00268 !-------------------------------------------------------------------------------
00269 !
00270 !     ############################################################
00271       FUNCTION SNOW_FRAC_VEG_2D(PWSNOW) RESULT(BIDON)
00272 !     ############################################################
00273 
00274 REAL :: BIDON
00275 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW ! snow amount over natural areas (kg/m2)
00276 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00277 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_2D',0,ZHOOK_HANDLE)
00278 BIDON=PWSNOW(1)
00279 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_VEG_2D',1,ZHOOK_HANDLE)
00280 !
00281 END FUNCTION SNOW_FRAC_VEG_2D
00282 !
00283 !-------------------------------------------------------------------------------
00284 !     ##################################################
00285       FUNCTION SNOW_FRAC_GROUND_1D(PWSNOW) RESULT(BIDON)
00286 !     ##################################################
00287 !
00288 REAL :: BIDON      
00289 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW ! snow amount over natural areas (kg/m2)
00290 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00291 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND_1D',0,ZHOOK_HANDLE)
00292 BIDON=PWSNOW(1)
00293 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND_1D',1,ZHOOK_HANDLE)
00294 !
00295 END FUNCTION SNOW_FRAC_GROUND_1D
00296 !
00297 !-------------------------------------------------------------------------------
00298 !
00299 !     ##################################################
00300       FUNCTION SNOW_FRAC_GROUND_2D(PWSNOW) RESULT(BIDON)
00301 !     ##################################################
00302 !
00303 REAL :: BIDON
00304 REAL, DIMENSION(:), INTENT(IN)  :: PWSNOW ! snow amount over natural areas (kg/m2)
00305 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00306 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND_2D',0,ZHOOK_HANDLE)
00307 BIDON=PWSNOW(1)
00308 IF (LHOOK) CALL DR_HOOK('MODE_SURF_SNOW_FRAC:SNOW_FRAC_GROUND_2D',1,ZHOOK_HANDLE)
00309 
00310 !
00311 END FUNCTION SNOW_FRAC_GROUND_2D
00312 !
00313 
00314 !-------------------------------------------------------------------------------
00315 !-------------------------------------------------------------------------------
00316 !
00317 END MODULE MODE_SURF_SNOW_FRAC