prep_snow_unif.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_snow_unif(KLUOUT,HSURF,PFIELD, TPTIME,  &
                          OSNOW_IDEAL,                  &
                          PUNIF_WSNOW, PUNIF_RSNOW,     &
                          PUNIF_TSNOW, PUNIF_LWCSNOW,   &
                          PUNIF_ASNOW,                  &
                          PUNIF_SG1SNOW, PUNIF_SG2SNOW, &
                          PUNIF_HISTSNOW,PUNIF_AGESNOW, &
                          KLAYER                        )  
!     #################################################################################
!
!!****  *PREP_SNOW_UNIF* - prepares snow field from prescribed values
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      M. Lafaysse adaptation with new snow age
!!      2012-11-19 M. Lafaysse initialization of liquid water content
!!------------------------------------------------------------------
!
USE mode_snow3l
!
USE modd_type_date_surf, ONLY : date_time
!
USE modd_surf_par,       ONLY : xundef
USE modd_prep,           ONLY : cinterp_type
USE modd_data_cover_par, ONLY : nvegtype
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
INTEGER,            INTENT(IN)  :: KLUOUT    ! output listing logical unit
 CHARACTER(LEN=10),  INTENT(IN)  :: HSURF     ! type of field
REAL, POINTER, DIMENSION(:,:,:) :: PFIELD    ! field to interpolate horizontally
TYPE(date_time),    INTENT(IN)  :: TPTIME    ! date and time
LOGICAL,            INTENT(IN)  :: OSNOW_IDEAL
REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_WSNOW ! prescribed snow content (kg/m2)
REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_RSNOW ! prescribed density (kg/m3)
REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_TSNOW ! prescribed temperature (K)
REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_LWCSNOW ! prescribed snow liquid water content (kg/m3)
REAL,               INTENT(IN)  :: PUNIF_ASNOW ! prescribed albedo (-)
REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_SG1SNOW ! 
REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_SG2SNOW ! 
REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_HISTSNOW ! 
REAL, DIMENSION(:), INTENT(IN)  :: PUNIF_AGESNOW ! 
INTEGER,            INTENT(IN)  :: KLAYER        ! Number of layer of output snow scheme
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTSNOW, ZRSNOW
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLWCSNOW !(kg/m2)
!
REAL, DIMENSION(1) :: ZD
INTEGER            :: JVEGTYPE       ! loop counter on vegtypes
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
!
IF (lhook) CALL dr_hook('PREP_SNOW_UNIF',0,zhook_handle)
!
IF (osnow_ideal) THEN
  ALLOCATE(pfield(1,SIZE(punif_wsnow),1))
  ALLOCATE(ztsnow(1,SIZE(punif_wsnow),1))
  ALLOCATE(zrsnow(1,SIZE(punif_wsnow),1))
  ALLOCATE(zlwcsnow(1,SIZE(punif_wsnow),1))
ELSE
  ALLOCATE(pfield(1,1,1))
  ALLOCATE(ztsnow(1,1,1))
  ALLOCATE(zrsnow(1,1,1))
  ALLOCATE(zlwcsnow(1,1,1))
ENDIF
!
!*      1.     No snow
!              -------
!
IF (any(punif_rsnow(:)==0. .AND. punif_wsnow(:)/=0.)) THEN 
  WRITE(kluout,*)'XWSNOW/=0. AND RSNOW=0.'
  CALL abor1_sfx('PREP_SNOW_UNIF: WITH XWSNOW/=0., RSNOW MUST NOT BE 0.')
END IF
!
!*      2.     Snow prescribed
!              ---------------
!
SELECT CASE(hsurf(1:3))
!
  CASE('WWW')
    IF (osnow_ideal) THEN
      pfield(1,:,1) = punif_wsnow(:)
    ELSE
      pfield(1,:,1) = punif_wsnow(1)
    ENDIF
!    
  CASE('DEP')
    IF (osnow_ideal) THEN
      pfield(1,:,1) = punif_wsnow(:)/punif_rsnow(:)
    ELSE
       IF(punif_rsnow(1)>0.0)THEN
         zd(1)=punif_wsnow(1)/punif_rsnow(1)
       ELSE
         zd(1)=0.0
       ENDIF
       CALL snow3lgrid(pfield(:,:,1),zd(:))
    ENDIF
!
  CASE('RHO')
    IF (osnow_ideal) THEN
      pfield(1,:,1) = punif_rsnow(:)
    ELSE
      pfield(1,:,1) = punif_rsnow(1)
    ENDIF
!
  CASE('ALB')
     pfield(1,:,1) = punif_asnow
!n
  CASE('HEA')
    IF (osnow_ideal) THEN
      pfield(1,:,1) = punif_tsnow(:)
    ELSE
      pfield(1,:,1) = punif_tsnow(1)
    ENDIF          
  
!
  CASE('SG1')
    IF (osnow_ideal) THEN
      pfield(1,:,1) = punif_sg1snow(:)
    ELSE
      pfield(1,:,1) = punif_sg1snow(1)
    ENDIF
!
  CASE('SG2')
    IF (osnow_ideal) THEN
      pfield(1,:,1) = punif_sg2snow(:)
    ELSE
      pfield(1,:,1) = punif_sg2snow(1)
    ENDIF
!
  CASE('HIS')
    IF (osnow_ideal) THEN
      pfield(1,:,1) = punif_histsnow(:)
    ELSE
      pfield(1,:,1) = punif_histsnow(1)
    ENDIF    
!
  CASE('AGE')
    IF (osnow_ideal) THEN
      pfield(1,:,1) = punif_agesnow(:)
    ELSE
      pfield(1,:,1) = punif_agesnow(1)
    ENDIF           
  !
END SELECT
!
!*      2.     Interpolation method
!              --------------------
!
cinterp_type='UNIF  '
DEALLOCATE(ztsnow)
DEALLOCATE(zrsnow)
DEALLOCATE(zlwcsnow)
IF (lhook) CALL dr_hook('PREP_SNOW_UNIF',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
END SUBROUTINE prep_snow_unif