src/SURFEX/read_from_surfex_file.F90

   1 !SURFEX_LIC Copyright 1994-2014 Meteo-France
   2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
   3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
   4 !SURFEX_LIC for details. version 1.
   5 SUBROUTINE READ_FROM_SURFEX_FILE(HFTYP,HFNAM,HMASK,HSCHEME,PFIELD,HNAM)
   6 !
   7 USE MODI_INIT_IO_SURF_n
   8 USE MODI_END_IO_SURF_n
   9 USE MODI_READ_SURF
  10 !
  11 #ifdef ASC
  12 USE MODI_SET_SURFEX_FILE_NAME_ASC
  13 #endif
  14 #ifdef FA
  15 USE MODI_SET_SURFEX_FILE_NAME_FA
  16 #endif
  17 #ifdef LFI
  18 USE MODI_SET_SURFEX_FILE_NAME_LFI
  19 #endif
  20 !
  21 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  22 USE PARKIND1  ,ONLY : JPRB
  23 !
  24 IMPLICIT NONE
  25 !
  26  CHARACTER(LEN=6), INTENT(IN) :: HFTYP
  27  CHARACTER(LEN=28), INTENT(IN) :: HFNAM
  28  CHARACTER(LEN=6), INTENT(IN) :: HMASK
  29  CHARACTER(LEN=6), INTENT(IN) :: HSCHEME
  30 REAL, DIMENSION(:), INTENT(OUT) :: PFIELD
  31  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HNAM
  32 !
  33  CHARACTER(LEN=28)     :: HNAME
  34  CHARACTER(LEN=12)     :: YRECFM
  35 INTEGER               :: IRESP, I0
  36 !
  37 REAL(KIND=JPRB) :: ZHOOK_HANDLE
  38
  39 IF (LHOOK) CALL DR_HOOK('READ_FROM_SURFEX_FILE',0,ZHOOK_HANDLE)
  40
  41 HNAME=ADJUSTL(ADJUSTR(HFNAM))
  42
  43 IF (PRESENT(HNAM)) THEN
  44   YRECFM=HNAM
  45 ELSE
  46   I0=INDEX(HNAME,'.',BACK=.TRUE.)
  47   YRECFM=HNAME(1:I0-1)
  48 ENDIF
  49
  50 IF (HFTYP=='ASCII ') THEN
  51 #ifdef ASC
  52   CALL SET_SURFEX_FILE_NAME_ASC(HNAME_IN=HNAME)
  53 #endif
  54 ELSEIF (HFTYP=='FA    ') THEN
  55 #ifdef FA
  56   CALL SET_SURFEX_FILE_NAME_FA(HNAME_IN=HNAME)
  57 #endif
  58 ELSEIF (HFTYP=='LFI   ') THEN
  59 #ifdef LFI
  60   CALL SET_SURFEX_FILE_NAME_LFI(HNAME_IN=HNAME)
  61 #endif
  62 ENDIF
  63
  64  CALL INIT_IO_SURF_n(HFTYP,HMASK,HSCHEME,'READ ')
  65  CALL READ_SURF(HFTYP,YRECFM,PFIELD,IRESP)
  66  CALL END_IO_SURF_n(HFTYP)
  67
  68 IF (LHOOK) CALL DR_HOOK('READ_FROM_SURFEX_FILE',1,ZHOOK_HANDLE)
  69
  70 END SUBROUTINE READ_FROM_SURFEX_FILE