read_prep_flake_conf.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_flake_conf(HPROGRAM,HVAR,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
                                      hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,kluout,ounif)
!     #######################################################
!
!!****  *READ_PREP_FLAKE_CONF* - routine to read the configuration for
!!                                 FLAKE fields preparation
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      P. Le Moigne 10/2005, Phasage Arome
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modi_read_prep_surf_atm_conf
!
USE modn_prep_flake
USE modd_prep_flake, ONLY : cfile_flake, cfilepgd_flake, ctype, ctypepgd, &
                              xts_unif,         &
                              xunif_t_snow,     &
                              xunif_t_ice,      &
                              xunif_t_mnw,      &
                              xunif_t_wml,      &
                              xunif_t_bot,      &
                              xunif_t_b1,       &
                              xunif_ct,         &
                              xunif_h_snow,     &
                              xunif_h_ice,      &
                              xunif_h_ml,       &
                              xunif_h_b1,       &
                              lclim_lake   
!
USE modd_surf_par,   ONLY : xundef
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram ! program calling ISBA
 CHARACTER(LEN=7),  INTENT(IN)  :: hvar     ! variable treated
 CHARACTER(LEN=28), INTENT(OUT) :: hfile    ! file name
 CHARACTER(LEN=6),  INTENT(OUT) :: hfiletype! file type
 CHARACTER(LEN=28), INTENT(OUT) :: hfilepgd    ! file name
 CHARACTER(LEN=6),  INTENT(OUT) :: hfilepgdtype! file type
 CHARACTER(LEN=28), INTENT(IN)  :: hatmfile    ! atmospheric file name
 CHARACTER(LEN=6),  INTENT(IN)  :: hatmfiletype! atmospheric file type
 CHARACTER(LEN=28), INTENT(IN)  :: hpgdfile    ! atmospheric file name
 CHARACTER(LEN=6),  INTENT(IN)  :: hpgdfiletype! atmospheric file type
INTEGER,           INTENT(IN)  :: kluout   ! logical unit of output listing
LOGICAL,           INTENT(OUT) :: ounif    ! flag for prescribed uniform field

!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: iresp          ! IRESP  : return-code if a problem appears 
                                    ! at the open of the file in LFI  routines 
INTEGER           :: ilunam         ! Logical unit of namelist file
!
 CHARACTER(LEN=28) :: ynamelist      ! namelist file
!
LOGICAL           :: gfound         ! Return code when searching namelist
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
!
IF (lhook) CALL dr_hook('READ_PREP_FLAKE_CONF',0,zhook_handle)
hfile = '                         '
hfiletype = '      '
!
hfilepgd = '                         '
hfilepgdtype = '      '
!
ounif     = .false.
!
!-------------------------------------------------------------------------------
!
!* choice of input file
!  --------------------
!
IF (len_trim(hfile)==0 .AND. len_trim(cfile_flake)>0 .AND. len_trim(ctype)>0) THEN
  hfile     = cfile_flake
  hfiletype = ctype
END IF
!
IF (len_trim(hfilepgd)==0 .AND. len_trim(cfilepgd_flake)>0 .AND. len_trim(ctypepgd)>0) THEN
  hfilepgd     = cfilepgd_flake
  hfilepgdtype = ctypepgd
END IF
!
!! If no file name in the scheme namelist,
!! try to find a name in NAM_SURF_ATM
!
IF (len_trim(hfile)==0) THEN
!
 CALL read_prep_surf_atm_conf(hprogram,hfile,hfiletype,hfilepgd,hfilepgdtype,&
                             hatmfile,hatmfiletype,hpgdfile,hpgdfiletype,kluout)
!
END IF
!-------------------------------------------------------------------------------
!
!* Is an uniform field prescribed?
!  ------------------------------
SELECT CASE (hvar)
 CASE('TS     ')
   ounif = (xts_unif/=xundef)
 CASE('T_SNOW ')
   ounif = (xunif_t_snow/=xundef)
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN          ! all fields but TS 
      hfile = '                         ' ! are not readed
      hfiletype = '      '                ! from grib files
   END IF    
 CASE('T_ICE  ')
   ounif = (xunif_t_ice/=xundef)
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN
      hfile = '                         '
      hfiletype = '      '
   END IF    
 CASE('T_MNW  ')
   ounif = .false.
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN
      hfile = '                         '
      hfiletype = '      '
   END IF    
 CASE('T_WML  ')
   ounif = (xunif_t_wml/=xundef)
   hfile = '                         '
   hfiletype = '      '
 CASE('T_BOT  ')
   ounif = (xunif_t_bot/=xundef)
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN
      hfile = '                         '
      hfiletype = '      '
   END IF    
 CASE('T_B1   ')
   ounif = (xunif_t_b1/=xundef)
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN
      hfile = '                         '
      hfiletype = '      '
   END IF    
 CASE('CT     ')
   ounif = (xunif_ct/=xundef)
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN
      hfile = '                         '
      hfiletype = '      '
   END IF    
 CASE('H_SNOW ')
   ounif = (xunif_h_snow/=xundef)
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN
      hfile = '                         '
      hfiletype = '      '
   END IF    
 CASE('H_ICE  ')
   ounif = (xunif_h_ice/=xundef)
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN
      hfile = '                         '
      hfiletype = '      '
   END IF    
 CASE('H_ML   ')
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN
      hfile = '                         '
      hfiletype = '      '
   END IF    
   ounif = (xunif_h_ml/=xundef)
 CASE('H_B1   ')
   ounif = (xunif_h_b1/=xundef)
   IF (hfiletype=='GRIB  '.OR.hfiletype=='ASCLLV') THEN
      hfile = '                         '
      hfiletype = '      '
   END IF    
END SELECT
!
!
!-------------------------------------------------------------------------------
!
!* If no file and no uniform field is prescribed:  default values used
!  ---------------------------------------------
!
IF (len_trim(hfiletype)==0 .AND. .NOT. ounif) THEN
   SELECT CASE (hvar)
     CASE ('ZS     ')
       ounif = .true.
       IF (lhook) CALL dr_hook('READ_PREP_FLAKE_CONF',1,zhook_handle)
       RETURN
     CASE ('DATE   ')
       IF (lhook) CALL dr_hook('READ_PREP_FLAKE_CONF',1,zhook_handle)
       RETURN
     CASE('TS     ') ! an input file or a uniform value must be given for TS
       CALL abor1_sfx('READ_PREP_FLAKE_CONF: AN INPUT FILE OR A UNIFORM PRESCRIBED TS REQUIRED')
   END SELECT
END IF
IF (lhook) CALL dr_hook('READ_PREP_FLAKE_CONF',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_prep_flake_conf