read_teb_patch.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_teb_patch (&
                                 hfilepgd,hfilepgdtype,kteb_patch)
!     #######################
!
!
!
!
USE modi_read_surf
USE modi_town_presence
!
USE modi_open_aux_io_surf
USE modi_close_aux_io_surf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!* dummy arguments
!  ---------------
!
!
!
 CHARACTER(LEN=28),  INTENT(IN)  :: hfilepgd     ! name of file
 CHARACTER(LEN=6),   INTENT(IN)  :: hfilepgdtype ! type of file
INTEGER,            INTENT(OUT) :: kteb_patch! number of TEB patches
!
!
!* local variables
!  ---------------
!
 CHARACTER(LEN=12) :: yrecfm     ! Name of the article to be read
INTEGER           :: iresp      ! reading return code
!
INTEGER           :: iversion   ! surface version
INTEGER           :: ibugfix    ! surface bugfix
LOGICAL           :: gtown
REAL(KIND=JPRB) :: zhook_handle
!
!
!------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('READ_TEB_PATCH',0,zhook_handle)
!
 CALL open_aux_io_surf(&
                      hfilepgd,hfilepgdtype,'FULL  ')
yrecfm='VERSION'
 CALL read_surf(&
               hfilepgdtype,yrecfm,iversion,iresp)
yrecfm='BUG'
 CALL read_surf(&
               hfilepgdtype,yrecfm,ibugfix,iresp)
!
 CALL town_presence(&
                   hfilepgdtype,gtown)
 CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
!
IF (iversion<7 .OR. (iversion==7 .AND. ibugfix<=2).OR..NOT.gtown) THEN
  kteb_patch = 1
ELSE
  yrecfm='TEB_PATCH'
  CALL open_aux_io_surf(&
                      hfilepgd,hfilepgdtype,'TOWN  ')
  CALL read_surf(&
               hfilepgdtype,yrecfm,kteb_patch,iresp)
  CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
END IF
!
IF (lhook) CALL dr_hook('READ_TEB_PATCH',1,zhook_handle)
!
!------------------------------------------------------------------------------
!
END SUBROUTINE read_teb_patch