prep_ver_snow.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 prep_ver_snow(TPSNOW,PZS_LS,PZS,PTG_LS,PTG,KDEEP_SOIL)
!          ###########################################
!
!
!!****  *PREP_VER_SNOW* - change in snow variables due to altitude change
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!       02/2014    E. Martin, vertical correction applied to snow cover and not by layers
!!       09/2014    B. Decharme, Bug : Coherence between snow layer and depth
!!------------------------------------------------------------------
!

USE modd_type_snow
USE modd_csts,       ONLY : xtt
USE modd_prep,       ONLY : xt_clim_grad
USE modd_prep_snow,  ONLY : xwsnow_clim_grad
USE modd_surf_par,   ONLY : xundef
!
USE modi_snow_heat_to_t_wliq
USE modi_snow_t_wliq_to_heat
USE modi_mkflag_snow
!
USE mode_snow3l
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(surf_snow), INTENT(INOUT) :: TPSNOW ! snow mantel characteristics
REAL, DIMENSION(:), INTENT(IN) :: PZS_LS ! initial orography
REAL, DIMENSION(:), INTENT(IN) :: PZS    ! final   orography
REAL, DIMENSION(:,:),INTENT(IN),OPTIONAL:: PTG_LS ! soil temperature on initial orography
REAL, DIMENSION(:,:),INTENT(IN),OPTIONAL:: PTG    ! soil temperature on final   orography
INTEGER,               INTENT(IN),OPTIONAL:: KDEEP_SOIL ! index of deep soil temperature
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSNOW_LS ! snow reservoir   on initial orography
REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSNOW_LS ! snow temperature on initial orography
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSNOW    ! snow content     on final   orography
REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSNOW    ! snow temperature on final   orography
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSNOW2   ! snow content     on final   orography
REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSNOW2   ! snow temperature on final   orography
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWLIQ     ! snow liquid water content
REAL, DIMENSION(:),   ALLOCATABLE :: ZZSFREEZE ! altitude where deep soil freezes
REAL, DIMENSION(:),   ALLOCATABLE :: ZDTOT     ! snow depth
REAL, DIMENSION(:,:), ALLOCATABLE :: ZDZSN     ! snow layer thickness
!
INTEGER                             :: JL    ! loop counter on snow layers
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PREP_VER_SNOW',0,zhook_handle)
!
!*       1.    Snow reservoir on initial orography
!              -----------------------------------
!
ALLOCATE(zwsnow_ls(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,2)))
zwsnow_ls(:,:) =  tpsnow%WSNOW(:,:)
!
!-------------------------------------------------------------------------------------
!
!*       2.    temperature of snow on initial orography
!              ----------------------------------------
!
ALLOCATE(ztsnow_ls(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,2)))
SELECT CASE(tpsnow%SCHEME)
  CASE ('D95','EBA')
    IF (PRESENT(ptg_ls)) THEN
      ztsnow_ls(:,1) =  min(ptg_ls(:,1),xtt)
    ELSE
      ztsnow_ls = xundef
    END IF
  CASE ('1-L')
    ztsnow_ls(:,:) =  tpsnow%T(:,:)
  CASE ('3-L','CRO')
    CALL snow_heat_to_t_wliq(tpsnow%HEAT(:,:),tpsnow%RHO(:,:),ztsnow_ls(:,:))
END SELECT
!
!-------------------------------------------------------------------------------------
!
!*       3.    vertical shift of temperature
!              -----------------------------
!
ALLOCATE(ztsnow(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,2)))
DO jl=1,tpsnow%NLAYER
  ztsnow(:,jl) = ztsnow_ls(:,jl) + xt_clim_grad  * (pzs(:) - pzs_ls(:))  
END DO
!
!-------------------------------------------------------------------------------------
!
!*       4.    vertical shift of snow content where snow already exists
!              ------------------------------
!
!* use of climatological snow content gradient
!
ALLOCATE(zwsnow(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,2)))
!
zwsnow(:,:) = zwsnow_ls(:,:) 
!
IF (PRESENT(ptg)) THEN
  DO jl=1,tpsnow%NLAYER
    WHERE(zwsnow_ls(:,jl)>0..AND.((ptg(:,kdeep_soil)-xtt >= 2.).OR.(pzs(:) > pzs_ls(:))))
      zwsnow(:,jl) = zwsnow_ls(:,jl) + ( xwsnow_clim_grad  * (pzs(:) - pzs_ls(:))/tpsnow%NLAYER)
      zwsnow(:,jl) = max(zwsnow(:,jl),0.)
    END WHERE
  END DO
ELSE
  DO jl=1,tpsnow%NLAYER
    WHERE(zwsnow_ls(:,jl)>0.)
      zwsnow(:,jl) = zwsnow_ls(:,jl) + ( xwsnow_clim_grad  * (pzs(:) - pzs_ls(:))/tpsnow%NLAYER)
      zwsnow(:,jl) = max(zwsnow(:,jl),0.)
    END WHERE
  END DO
ENDIF
!
WHERE(tpsnow%WSNOW(:,:)/=xundef) tpsnow%WSNOW = zwsnow
!
!-------------------------------------------------------------------------------------
!
!        5.    Where snow did not exist on initial orography
!              ---------------------------------------------
!
!* in this case, new snow can appear only if orography differences in larger
!  than 1000m, and starts at an altitude where the deep soil temperature becomes negative
!
!* the same climatological gradient is used, but the value zero for the snow
!  content is defined as the altitude where deep soil freezes.
!
!*       5.1   Altitude where deep soil freezes (only if soil temperatures are provided)
!              --------------------------------
!
IF (PRESENT(ptg)) THEN

  ALLOCATE(zzsfreeze(SIZE(tpsnow%WSNOW,1)))
  zzsfreeze(:) = pzs + (xtt - ptg(:,kdeep_soil)) / xt_clim_grad  
!
!*       5.2   Amount and Temperature of new snow (only if soil temperatures are provided)
!              ----------------------------------
!
!* Snow temperature is then defined as the deep soil temperature at the final
!  altitude.
!
  ALLOCATE(zwsnow2(SIZE(tpsnow%WSNOW,1),tpsnow%NLAYER))
  ALLOCATE(ztsnow2(SIZE(tpsnow%WSNOW,1),tpsnow%NLAYER))
  DO jl=1,tpsnow%NLAYER
    zwsnow2(:,jl) =  xwsnow_clim_grad * (pzs(:) - zzsfreeze(:))/tpsnow%NLAYER
    zwsnow2(:,jl) = max(zwsnow2(:,jl),0.)
    ztsnow2(:,jl) = ptg(:,kdeep_soil)
  END DO
!
!*       5.3   Apply maximum between this value and the shifted one
!              ----------------------------------------------------
!
  DO jl=1,tpsnow%NLAYER
    WHERE(tpsnow%WSNOW(:,jl)/=xundef .AND. zwsnow_ls(:,jl)==0. .AND. (pzs(:)-pzs_ls(:))>1000. )  
      tpsnow%WSNOW(:,jl) = zwsnow2(:,jl)
      ztsnow(:,jl) = ztsnow2(:,jl)
    END WHERE
  END DO

  DEALLOCATE(zzsfreeze)
  DEALLOCATE(zwsnow2  )
  DEALLOCATE(ztsnow2  )
END IF
!
!-------------------------------------------------------------------------------------
!
!*       6.1   Coherence between temperature and snow content
!              ----------------------------------------------
!
SELECT CASE(tpsnow%SCHEME)
  CASE('1-L')
    !* snow temperature cannot be larger than 0 C
    tpsnow%T (:,:) = min( ztsnow(:,:), xtt )
  CASE('3-L','CRO')
    ALLOCATE(zwliq(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,2)))
    CALL snow_t_wliq_to_heat(tpsnow%HEAT,tpsnow%RHO,ztsnow)
    CALL snow_heat_to_t_wliq(tpsnow%HEAT,tpsnow%RHO,ztsnow,zwliq)
    CALL snow_t_wliq_to_heat(tpsnow%HEAT,tpsnow%RHO,ztsnow,zwliq)
    DEALLOCATE(zwliq)
END SELECT
!
!*       6.2   Coherence between snow layer and depth
!              --------------------------------------
!
SELECT CASE(tpsnow%SCHEME)
  CASE('3-L','CRO')
    ALLOCATE(zdtot(SIZE(tpsnow%WSNOW,1)))
    ALLOCATE(zdzsn(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,2)))
    zdtot(:)=0.0
    DO jl=1,tpsnow%NLAYER
       WHERE(tpsnow%WSNOW(:,jl)/=xundef.AND.tpsnow%RHO(:,jl)/=xundef)
         zdtot(:)=zdtot(:)+tpsnow%WSNOW(:,jl)/tpsnow%RHO(:,jl)
       ENDWHERE
    END DO
    CALL snow3lgrid(zdzsn(:,:),zdtot(:))
    DO jl=1,tpsnow%NLAYER
      WHERE(tpsnow%RHO(:,jl)/=xundef.AND.zdtot(:)>0.)
        tpsnow%WSNOW(:,jl) = tpsnow%RHO(:,jl) * zdzsn(:,jl)
      ELSEWHERE(tpsnow%RHO(:,jl)==xundef.OR.zdtot(:)==0.0)
        tpsnow%WSNOW(:,jl) = 0.0
      ELSEWHERE
        tpsnow%WSNOW(:,jl) = xundef
      END WHERE
    END DO   
    DEALLOCATE(zdtot)
    DEALLOCATE(zdzsn)
END SELECT
!
!-------------------------------------------------------------------------------------
!
!*       7.    Masking where there is no snow
!              ------------------------------
!
 CALL mkflag_snow(tpsnow)
!
!-------------------------------------------------------------------------------------
DEALLOCATE(zwsnow_ls)
DEALLOCATE(ztsnow_ls)
DEALLOCATE(zwsnow   )
DEALLOCATE(ztsnow   )
IF (lhook) CALL dr_hook('PREP_VER_SNOW',1,zhook_handle)
!-------------------------------------------------------------------------------------
!
END SUBROUTINE prep_ver_snow