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                             :: ipatch    ! number of patches
INTEGER                             :: jpatch    ! loop counter on patches
INTEGER                             :: jlayer    ! loop counter on snow layers
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PREP_VER_SNOW',0,zhook_handle)
ipatch = SIZE(tpsnow%WSNOW,3)
!
!*       1.    Snow reservoir on initial orography
!              -----------------------------------
!
ALLOCATE(zwsnow_ls(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,2),ipatch))
zwsnow_ls(:,:,:) =  tpsnow%WSNOW(:,:,:)
!
!-------------------------------------------------------------------------------------
!
!*       2.    temperature of snow on initial orography
!              ----------------------------------------
!
ALLOCATE(ztsnow_ls(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,2),ipatch))
SELECT CASE(tpsnow%SCHEME)
  CASE ('D95','EBA')
    IF (present(ptg_ls)) THEN
      DO jpatch=1,ipatch
        ztsnow_ls(:,1,jpatch) =  min(ptg_ls(:,1,jpatch),xtt)
      END DO
    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),ipatch))
DO jpatch=1,ipatch
  DO jlayer=1,tpsnow%NLAYER
    ztsnow(:,jlayer,jpatch) = ztsnow_ls(:,jlayer,jpatch) + xt_clim_grad  * (pzs(:) - pzs_ls(:))  
  END DO
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),ipatch))
!
zwsnow(:,:,:) = zwsnow_ls(:,:,:) 
!
IF (present(ptg)) THEN
  DO jpatch=1,ipatch
    DO jlayer=1,tpsnow%NLAYER
      WHERE(zwsnow_ls(:,jlayer,jpatch)>0..AND.((ptg(:,kdeep_soil,jpatch)-xtt >= 2.).OR.(pzs(:) > pzs_ls(:))))
        zwsnow(:,jlayer,jpatch) = zwsnow_ls(:,jlayer,jpatch) + &
        &( xwsnow_clim_grad  * (pzs(:) - pzs_ls(:))/tpsnow%NLAYER)
        zwsnow(:,jlayer,jpatch) = max(zwsnow(:,jlayer,jpatch),0.)
      END WHERE
    END DO
  END DO
ELSE
  DO jpatch=1,ipatch
    DO jlayer=1,tpsnow%NLAYER
      WHERE(zwsnow_ls(:,jlayer,jpatch)>0.)
        zwsnow(:,jlayer,jpatch) = zwsnow_ls(:,jlayer,jpatch) + &
        &( xwsnow_clim_grad  * (pzs(:) - pzs_ls(:))/tpsnow%NLAYER)
        zwsnow(:,jlayer,jpatch) = max(zwsnow(:,jlayer,jpatch),0.)
      END WHERE
    END DO
  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),ipatch))
  DO jpatch=1,ipatch
    zzsfreeze(:,jpatch) = pzs &
                          + (xtt - ptg(:,kdeep_soil,jpatch)) / xt_clim_grad  
  END DO
!
!*       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,ipatch))
  ALLOCATE(ztsnow2(SIZE(tpsnow%WSNOW,1),tpsnow%NLAYER,ipatch))
  DO jpatch=1,ipatch
    DO jlayer=1,tpsnow%NLAYER
      zwsnow2(:,jlayer,jpatch) =  xwsnow_clim_grad  *&
      & (pzs(:) - zzsfreeze(:,jpatch))/tpsnow%NLAYER
      zwsnow2(:,jlayer,jpatch) = max(zwsnow2(:,jlayer,jpatch),0.)
      ztsnow2(:,jlayer,jpatch) = ptg(:,kdeep_soil,jpatch)
    END DO
  END DO
!
!*       5.3   Apply maximum between this value and the shifted one
!              ----------------------------------------------------
!
  DO jpatch=1,ipatch
    DO jlayer=1,tpsnow%NLAYER
      WHERE(tpsnow%WSNOW(:,jlayer,jpatch)/=xundef .AND. zwsnow_ls(:,jlayer,jpatch)==0. &
                                                    .AND. (pzs(:)-pzs_ls(:))>1000. )  
        tpsnow%WSNOW(:,jlayer,jpatch) = zwsnow2(:,jlayer,jpatch)
        ztsnow(:,jlayer,jpatch) = ztsnow2(:,jlayer,jpatch)
      END WHERE
    END DO
  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),ipatch))
    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),ipatch))
    ALLOCATE(zdzsn(SIZE(tpsnow%WSNOW,1),SIZE(tpsnow%WSNOW,2),ipatch))
    zdtot(:,:)=0.0
    DO jlayer=1,tpsnow%NLAYER
       WHERE(tpsnow%WSNOW(:,jlayer,:)/=xundef.AND.tpsnow%RHO(:,jlayer,:)/=xundef)
             zdtot(:,:)=zdtot(:,:)+tpsnow%WSNOW(:,jlayer,:)/tpsnow%RHO(:,jlayer,:)
       ENDWHERE
    END DO
    DO jpatch=1,ipatch
       CALL snow3lgrid(zdzsn(:,:,jpatch),zdtot(:,jpatch))
      DO jlayer=1,tpsnow%NLAYER
         WHERE(tpsnow%RHO(:,jlayer,jpatch)/=xundef.AND.zdtot(:,jpatch)>0.)
           tpsnow%WSNOW(:,jlayer,jpatch) = tpsnow%RHO(:,jlayer,jpatch) * zdzsn(:,jlayer,jpatch)
         ELSEWHERE(tpsnow%RHO(:,jlayer,jpatch)==xundef.OR.zdtot(:,jpatch)==0.0)
           tpsnow%WSNOW(:,jlayer,jpatch) = 0.0
         ELSEWHERE
           tpsnow%WSNOW(:,jlayer,jpatch) = xundef
         END WHERE
      END DO
    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