read_prep_greenroof_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 read_prep_greenroof_snow(HPROGRAM,HSNOW,KSNOW_LAYER,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,OUNIF)
!     #######################################################
!
!!****  *READ_PREP_GREENROOF_SNOW* - routine to read the configuration for snow
!!                                   in ISBA fields preparation
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!    Based on read_prep_garden_snow
!!
!!    AUTHOR
!!    ------
!!      C. de Munck   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    08/2011 
!!     M. Lafaysse  08/2013 init XZSNOW or XLWCSNOW
!      B. Decharme  07/2013 ES snow grid layer can be > to 3 (default 12)
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modn_prep_greenroof_snow
USE modd_read_namelist,        ONLY : lnam_read
!
USE modd_surf_par,             ONLY : xundef
USE modd_snow_par,             ONLY : xansmin, xrhosmax
USE modd_csts,                 ONLY : xtt
!
USE mode_pos_surf
USE modi_test_nam_var_surf
USE modi_get_luout
USE modi_open_namelist
USE modi_close_namelist
USE modi_abor1_sfx
!
USE modd_prep_teb_greenroof,   ONLY : cfile_snow_gr, ctype_snow, cfilepgd_snow_gr, &
                                      ctypepgd_snow, lsnow_ideal_gr, &
                                      xwsnow_p=>xwsnow_gr, xtsnow_p=>xtsnow_gr, xlwcsnow_p=>xlwcsnow_gr, &
                                      xrsnow_p=>xrsnow_gr, xagesnow_p=>xagesnow_gr, xasnow_gr
!
USE modd_prep_snow,            ONLY : nsnow_layer_max, lsnow_prep_perm
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram ! program calling ISBA
 CHARACTER(LEN=3),  INTENT(OUT) :: hsnow    ! snow scheme
INTEGER, INTENT(OUT)           :: ksnow_layer  ! number of snow layers
 CHARACTER(LEN=28), OPTIONAL, INTENT(OUT) :: hfile        ! file name
 CHARACTER(LEN=6),  OPTIONAL, INTENT(OUT) :: hfiletype    ! file type
 CHARACTER(LEN=28), OPTIONAL, INTENT(OUT) :: hfilepgd       ! file name
 CHARACTER(LEN=6),  OPTIONAL, INTENT(OUT) :: hfilepgdtype    ! file type  
 LOGICAL,           OPTIONAL, INTENT(OUT) :: ounif  ! uniform snow
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
 CHARACTER(LEN=3) :: csnow
INTEGER :: nsnow_layer
 CHARACTER(LEN=28) :: cfile_snow, cfilepgd_snow
LOGICAL :: lsnow_ideal, lsnow_frac_tot, lswemax
REAL :: xasnow, xswemax
REAL, DIMENSION(NSNOW_LAYER_MAX) :: xwsnow, xzsnow, xrsnow, xtsnow, xlwcsnow, xsg1snow, xsg2snow,&
                                    xhistsnow, xagesnow
INTEGER           :: jlayer                                    
!
REAL, DIMENSION(NSNOW_LAYER_MAX) :: xwsnow_gr, xzsnow_gr, xrsnow_gr, xtsnow_gr, xlwcsnow_gr, &
                                    xsg1snow_gr, xsg2snow_gr, xhistsnow_gr, xagesnow_gr
!
LOGICAL           :: lfile
!
LOGICAL           :: gfound         ! Return code when searching namelist
INTEGER           :: iluout         ! output file logical unit
INTEGER           :: ilunam         ! namelist file logical unit
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
namelist/nam_prep_isba_snow/csnow, nsnow_layer, cfile_snow, ctype_snow,  &
                            cfilepgd_snow, ctypepgd_snow,                & 
                            lsnow_ideal, lsnow_frac_tot, lsnow_prep_perm,&
                            xwsnow, xzsnow, xtsnow, xlwcsnow, xrsnow, xasnow,              &
                            xsg1snow, xsg2snow, xhistsnow, xagesnow,     &
                            lswemax, xswemax

namelist/nam_prep_greenroof_snow/csnow_gr, nsnow_layer_gr, cfile_snow_gr, ctype_snow, &
                            cfilepgd_snow_gr, ctypepgd_snow,                & 
                            lsnow_ideal_gr, xwsnow_gr, xzsnow_gr, xtsnow_gr, &
                            xlwcsnow_gr, xrsnow_gr, xasnow_gr
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('READ_PREP_GREENROOF_SNOW',0,zhook_handle)
!
!* default for greenroofs
!  ----------------------
 csnow_gr       = '3-L'
nsnow_layer_gr = 3
!
IF (lnam_read) THEN
  !
  csnow_gr          = '3-L'
  nsnow_layer_gr    = 3
  !
  cfile_snow_gr     = '                         '
  ctype_snow     = '      '  
  cfilepgd_snow_gr    = '                         '
  ctypepgd_snow    = '      '      
  !
  lsnow_ideal_gr    = .false.
  lsnow_prep_perm = .true.
  !
  xwsnow_gr(:)      = 0.
  xzsnow_gr(:) = xundef  
  xrsnow_gr(:)      = xrhosmax
  xtsnow_gr(:)      = xtt
  xlwcsnow_gr(:) = 0.
  xasnow_gr         = xansmin  
  xsg1snow_gr(:)    = xundef
  xsg2snow_gr(:)    = xundef
  xhistsnow_gr(:)   = xundef
  xagesnow_gr(:)    = xundef  
  !
  CALL get_luout(hprogram,iluout)
  CALL open_namelist(hprogram,ilunam)
  !
  !* reading of namelist
  !  -------------------
  !
  !* default can be provided by ISBA scheme variables
  CALL posnam(ilunam,'NAM_PREP_ISBA_SNOW',gfound,iluout)
  IF (gfound) THEN
    !
    csnow = '3-L'
    nsnow_layer = 3
    cfile_snow = '                         '
    lsnow_ideal = .false.
    lsnow_frac_tot = .false.
    xwsnow(:) = xundef
    xzsnow(:) = xundef
    xrsnow(:) = xrhosmax
    xtsnow(:) = xtt
    xlwcsnow(:) = 0.
    xasnow = xansmin  
    xsg1snow(:) = xundef
    xsg2snow(:) = xundef
    xhistsnow(:) = xundef
    xagesnow(:) = xundef    
    !
    READ(unit=ilunam,nml=nam_prep_isba_snow)
    CALL test_nam_var_surf(iluout,'CSNOW',csnow,'D95','3-L','EBA','NON','CRO')
    !
    csnow_gr = csnow
    nsnow_layer_gr = nsnow_layer
    cfile_snow_gr = cfile_snow
    lsnow_ideal_gr = lsnow_ideal
    xwsnow_gr(:) = xwsnow(:)
    xzsnow_gr(:) = xzsnow(:)
    xrsnow_gr(:) = xrsnow(:)
    xtsnow_gr(:) = xtsnow(:)
    xlwcsnow_gr(:) = xlwcsnow(:)
    xasnow_gr = xasnow
    xsg1snow_gr(:) = xsg1snow(:)
    xsg2snow_gr(:) = xsg2snow(:)
    xhistsnow_gr(:) = xhistsnow(:)
    xagesnow_gr(:) = xagesnow(:)
    !
  ENDIF
  !
  !* It is erased by GREENROOF namelist if specified
  CALL posnam(ilunam,'NAM_PREP_GREENROOF_SNOW',gfound,iluout)
  IF (gfound) THEN
    READ(unit=ilunam,nml=nam_prep_greenroof_snow)
    !crocus can't be used in garden if not used in isba scheme
    CALL test_nam_var_surf(iluout,'CSNOW',csnow_gr,'D95','3-L','EBA','NON')
  ENDIF
  !
  IF ( csnow_gr=='NON')                                         nsnow_layer_gr = 0
  IF ( csnow_gr=='D95' .OR. csnow_gr=='EBA')                       nsnow_layer_gr = 1
  IF (csnow_gr=='3-L' .AND. nsnow_layer_gr<=2) nsnow_layer_gr = 12
  !  
  IF (nsnow_layer_gr > nsnow_layer_max) THEN
    WRITE(iluout,*) '------------------------------------'
    WRITE(iluout,*) 'Please update modd_prep_snow.f90 routine : '
    WRITE(iluout,*) 'The maximum number of snow layers  '
    WRITE(iluout,*) 'in the declaration of the namelist variables '
    WRITE(iluout,*) 'must be decreased to : ', nsnow_layer_max
    WRITE(iluout,*) '------------------------------------'
    CALL abor1_sfx('READ_PREP_GREENROOF_SNOW: NUMBER OF SNOW LAYERS MUST BE INCREASED IN NAMELIST DECLARATION')
  ENDIF
  !
  ALLOCATE(xwsnow_p(nsnow_layer_gr))
  ALLOCATE(xrsnow_p(nsnow_layer_gr))
  ALLOCATE(xtsnow_p(nsnow_layer_gr))
  ALLOCATE(xagesnow_p(nsnow_layer_gr))
  ALLOCATE(xlwcsnow_p(nsnow_layer_gr))
  !
  DO jlayer=1,nsnow_layer_gr
    IF ((xzsnow_gr(jlayer)>0) .AND.(xzsnow_gr(jlayer)/=xundef )) THEN
      IF ((xwsnow_gr(jlayer)>0)  .AND.(xwsnow_gr(jlayer)/=xundef )) THEN
        WRITE(iluout,*) 'XWSNOW and XZSNOW are both defined.'
        WRITE(iluout,*) 'You must define only one of them.'
        WRITE(iluout,*) '    PLEASE CORRECT THAT     '
        CALL abor1_sfx('READ_PREP_GREENROOF_SNOW: ERROR IN INITIALIZATION OF SNOW DEPTH')
      ELSE
        xwsnow_p(jlayer)=xzsnow_gr(jlayer)*xrsnow_gr(jlayer)
      ENDIF
    ELSE
      xwsnow_p(jlayer)=xwsnow_gr(jlayer)
    ENDIF
  ENDDO

  xrsnow_p=xrsnow_gr(1:nsnow_layer_gr)
  xtsnow_p=xtsnow_gr(1:nsnow_layer_gr)
  xagesnow_p=xagesnow_gr(1:nsnow_layer_gr)
  xlwcsnow_p=xlwcsnow_gr(1:nsnow_layer_gr)
  !
  CALL close_namelist(hprogram,ilunam)
  !
ENDIF
!
hsnow       = csnow_gr
ksnow_layer = nsnow_layer_gr
!
IF(all(xwsnow_p(:)==xundef).AND.present(ounif))THEN
    ounif=.false.
ELSEIF(present(ounif))THEN
    ounif=.true.
ENDIF
!
lfile=(len_trim(cfile_snow_gr)>0.AND.len_trim(ctype_snow)>0 &
        .AND.len_trim(cfilepgd_snow_gr)>0.AND.len_trim(ctypepgd_snow)>0)
!
IF (present(ounif)) lfile=(lfile .AND. .NOT.ounif)
!
IF(present(hfile))THEN 
  IF(lfile)THEN
     hfile = cfile_snow_gr
  ELSE
     hfile = '                         '
  ENDIF
ENDIF
IF(present(hfiletype))THEN 
  IF(lfile)THEN
     hfiletype = ctype_snow
  ELSE
     hfiletype = '      '
  ENDIF
ENDIF
IF(present(hfilepgdtype))THEN 
  IF(lfile)THEN
     hfilepgdtype = ctypepgd_snow
  ELSE
     hfilepgdtype = '      '
  ENDIF
ENDIF
IF(present(hfilepgd))THEN 
  IF(lfile)THEN
     hfilepgd = cfilepgd_snow_gr
  ELSE
     hfilepgd = '                         '
  ENDIF
ENDIF
IF (lfile.AND.present(ounif)) ounif=.false.
!
IF (lhook) CALL dr_hook('READ_PREP_GREENROOF_SNOW',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_prep_greenroof_snow