hydro_glacier.F90

Go to the documentation of this file.

!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.
!     #########
      SUBROUTINE hydro_glacier (PTSTEP, PSR, PEK, PICEFLUX)
!     ########################################################################
!
!!****  *HYDRO_GLACIER*  
!!
!!    PURPOSE
!!    -------
!
!     Calculate the ice runoff fluxes over permanent snow area with LGLACIER
!     option
!     
!!**  METHOD
!!    ------
!
!     Direct calculation
!
!!    EXTERNAL
!!    --------
!
!     None
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!      
!!    REFERENCE
!!    ---------
!!      
!!    AUTHOR
!!    ------
!!      B. Decharme     
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    09/09 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_n, ONLY : isba_pe_t
!
USE modd_csts,     ONLY : xday
USE modd_snow_par, ONLY : xrhosmax, xhgla, xsnowdmin, xrhosmax_es
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL, INTENT(IN)                     :: PTSTEP
!                                       KTSTEP = timestep [s]
!
REAL, DIMENSION(:), INTENT(IN)       :: PSR
!                                       PSR      = Snowfall    [kg/m²s]
!
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
REAL, DIMENSION(:), INTENT(OUT)      :: PICEFLUX
!                                       PICEFLUX = Ice flux from the Snowfall reservoir [kg/m²s]
!
!
!*      0.2    declarations of local variables
!
REAL, PARAMETER :: ZTAU=365.25 !days
!
REAL, DIMENSION(SIZE(PSR)) :: ZGLASTO,ZSTOMAX,ZFLUX,ZSR,ZSWE
REAL, DIMENSION(SIZE(PSR)) :: ZSNOWD
!
REAL              ::ZRHOSMAX
!
INTEGER :: JWRK
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('HYDRO_GLACIER',0,zhook_handle)
!
zglasto(:) = pek%XICE_STO(:)
zstomax(:) = 0.0
zflux(:) = 0.0
zsr(:) = 0.0
zswe(:) = 0.0
!
piceflux(:) = 0.0
!
!-------------------------------------------------------------------------------
!Ice accumulation only if snow amount is > to 33.3 meters of aged snow
!
IF(pek%TSNOW%SCHEME/='3-L' .AND. pek%TSNOW%SCHEME/='CRO')THEN
  zrhosmax = xrhosmax
  zswe(:)  = pek%TSNOW%WSNOW(:,1)
ELSE
  zrhosmax=xrhosmax_es
  DO jwrk=1,SIZE(pek%TSNOW%WSNOW,2)
     zswe(:) = zswe(:) + pek%TSNOW%WSNOW(:,jwrk)
  END DO
ENDIF
!
WHERE(zswe(:)>xhgla*zrhosmax)
     zsr(:) = psr(:)
ELSEWHERE
     zsr(:) = 0.0
ENDWHERE
!
!Snow storage calculation
!
pek%XICE_STO(:) = (zglasto(:)+ptstep*zsr(:))/(1.0+ptstep/(ztau*xday))
!
!supress numerical artifacs
!
zstomax(:) = zsr(:)*ptstep+zglasto(:)
!
pek%XICE_STO(:) = min(zstomax(:),pek%XICE_STO(:))
!
!Ice flux calculation                
!
zflux(:) = (zglasto(:)-pek%XICE_STO(:))/ptstep+zsr(:)
!      
!supress numerical artifacs
!
piceflux(:) = max(0.0,zflux(:))
pek%XICE_STO(:) = pek%XICE_STO(:) + piceflux(:)-zflux(:)             
!
WHERE(pek%XICE_STO(:)<=1.e-10)pek%XICE_STO(:)=0.0
!
!-------------------------------------------------------------------------------
!Snow pack update
!
IF(pek%TSNOW%SCHEME/='3-L' .AND. pek%TSNOW%SCHEME/='CRO')THEN
!
  WHERE(pek%TSNOW%WSNOW(:,1)<=xhgla*zrhosmax)piceflux(:)=0.0
  pek%TSNOW%WSNOW(:,1)=pek%TSNOW%WSNOW(:,1)-piceflux(:)*ptstep
!
ELSE
!
  WHERE(zswe(:)<=xhgla*zrhosmax)piceflux(:)=0.0
!
! Snow total depth
  zsnowd(:) = 0.
  DO jwrk=1,SIZE(pek%TSNOW%WSNOW,2)
     zsnowd(:) = zsnowd(:) + pek%TSNOW%WSNOW(:,jwrk)/pek%TSNOW%RHO(:,jwrk)
  END DO
!
! Flux
  DO jwrk=1,SIZE(pek%TSNOW%WSNOW,2)
     zflux(:) = piceflux(:)*(pek%TSNOW%WSNOW(:,jwrk)/pek%TSNOW%RHO(:,jwrk)) &
                /max(zsnowd(:),0.0001)
     pek%TSNOW%WSNOW(:,jwrk)=pek%TSNOW%WSNOW(:,jwrk)-zflux(:)*ptstep
  END DO
!
ENDIF
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('HYDRO_GLACIER',1,zhook_handle)
!-------------------------------------------------------------------------------
END SUBROUTINE hydro_glacier