read_prep_teb_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_teb_snow(HPROGRAM,HSNOW_ROOF,KSNOW_ROOF,HSNOW_ROAD,KSNOW_ROAD,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE)
!     #######################################################
!
!!****  *READ_PREP_TEB_SNOW* - routine to read the configuration for snow
!!                              in TEB fields preparation
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      A. Lemonsu  *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    04/2007 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modn_prep_teb_snow
USE modd_read_namelist, ONLY : lnam_read
!
USE modd_surf_par,       ONLY : xundef
!
USE mode_pos_surf
USE modi_test_nam_var_surf
USE modi_get_luout
USE modi_open_namelist
USE modi_close_namelist
!
USE modd_csts,     ONLY : xtt
USE modd_snow_par, ONLY : xansmin, xrhosmax
USE modd_prep_teb, ONLY : xwsnow_roof_p=>xwsnow_roof, xtsnow_roof_p=>xtsnow_roof, xlwcsnow_roof_p=>xlwcsnow_roof, &
                          xrsnow_roof_p=>xrsnow_roof, xasnow_roof, &
                          xwsnow_road_p=>xwsnow_road, xtsnow_road_p=>xtsnow_road, xlwcsnow_road_p=>xlwcsnow_road,&
                          xrsnow_road_p=>xrsnow_road, xasnow_road, &
                          cfile_snow_teb, ctype_snow, cfilepgd_snow_teb, &
                           ctypepgd_snow, lsnow_ideal_teb
!
USE modd_prep_snow, ONLY : nsnow_layer_max
!
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 TEB
 CHARACTER(LEN=3),  INTENT(OUT) :: hsnow_roof ! snow scheme for roofs
 CHARACTER(LEN=3),  INTENT(OUT) :: hsnow_road ! snow scheme for roads
INTEGER,           INTENT(OUT) :: ksnow_roof ! snow scheme layers for roofs
INTEGER,           INTENT(OUT) :: ksnow_road ! snow scheme layers for roads
 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
 
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(NSNOW_LAYER_MAX) :: xwsnow_road, xrsnow_road, xtsnow_road, xlwcsnow_road, &
                                    xwsnow_roof, xrsnow_roof, xtsnow_roof, xlwcsnow_roof
!
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_teb_snow/csnow_roof, csnow_road, cfile_snow_teb, ctype_snow, &
                           lsnow_ideal_teb, cfilepgd_snow_teb, ctypepgd_snow,      & 
                           xwsnow_roof, xtsnow_roof, xlwcsnow_roof, xrsnow_roof, xasnow_roof, &
                           xwsnow_road, xtsnow_road, xlwcsnow_road, xrsnow_road, xasnow_road
!-------------------------------------------------------------------------------
!
!* default
!  -------
!

IF (lhook) CALL dr_hook('READ_PREP_TEB_SNOW',0,zhook_handle)
IF (lnam_read) THEN
  !
  csnow_roof = '1-L'
  csnow_road = '1-L'
  !
  cfile_snow_teb = '                         '
  ctype_snow     = '      ' 
  cfilepgd_snow_teb = '                         '
  ctypepgd_snow     = '      '    
  !
  xwsnow_roof(:) = 0.
  xtsnow_roof(:) = xtt
  xlwcsnow_roof(:) = 0.
  xrsnow_roof(:) = xrhosmax
  xasnow_roof = xansmin
  !
  xwsnow_road(:) = 0.
  xtsnow_road(:) = xtt
  xlwcsnow_road(:) = 0.
  xrsnow_road(:) = xrhosmax
  xasnow_road = xansmin
  !
  CALL get_luout(hprogram,iluout)
  CALL open_namelist(hprogram,ilunam)
  !
  !* reading of namelist
  !  -------------------
  !
  !
  CALL posnam(ilunam,'NAM_PREP_TEB_SNOW',gfound,iluout)
  IF (gfound) READ(unit=ilunam,nml=nam_prep_teb_snow)
  !
  CALL test_nam_var_surf(iluout,'CSNOW_ROOF',csnow_roof,'1-L')
  CALL test_nam_var_surf(iluout,'CSNOW_ROAD',csnow_road,'1-L')
  !
  ALLOCATE(xwsnow_roof_p(1))
  ALLOCATE(xrsnow_roof_p(1))
  ALLOCATE(xtsnow_roof_p(1))
  ALLOCATE(xlwcsnow_roof_p(1))
  !
  xwsnow_roof_p=xwsnow_roof(1)
  xrsnow_roof_p=xrsnow_roof(1)
  xtsnow_roof_p=xtsnow_roof(1)
  xlwcsnow_roof_p=xlwcsnow_roof(1)
  !
  ALLOCATE(xwsnow_road_p(1))
  ALLOCATE(xrsnow_road_p(1))
  ALLOCATE(xtsnow_road_p(1))
  ALLOCATE(xlwcsnow_road_p(1))
  !
  xwsnow_road_p=xwsnow_road(1)
  xrsnow_road_p=xrsnow_road(1)
  xtsnow_road_p=xtsnow_road(1)
  xlwcsnow_road_p=xlwcsnow_road(1)
  !
  CALL close_namelist(hprogram,ilunam)
  !
ENDIF
!
hsnow_roof = csnow_roof
hsnow_road = csnow_road
ksnow_roof = 1
ksnow_road = 1
!
IF (len_trim(cfile_snow_teb)>0 .AND. len_trim(ctype_snow)>0 & 
        .AND.len_trim(cfilepgd_snow_teb)>0.AND.len_trim(ctypepgd_snow)>0) THEN
  IF (present(hfile)) hfile = cfile_snow_teb
  IF (present(hfiletype)) hfiletype = ctype_snow
  IF (present(hfilepgd)) hfilepgd = cfilepgd_snow_teb
  IF (present(hfilepgdtype)) hfilepgdtype = ctypepgd_snow  
END IF
!
IF (lhook) CALL dr_hook('READ_PREP_TEB_SNOW',1,zhook_handle)
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_prep_teb_snow