read_pgd_teb_irrign.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_pgd_teb_irrig_n (G, TIR, HPROGRAM)
!     ################################################
!
!!****  *READ_PGD_TEB_IRRIG_n* - reads ISBA physiographic fields
!!                        
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    05/2005
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
!
!
USE modd_sfx_grid_n, ONLY : grid_t
USE modd_teb_irrig_n, ONLY : teb_irrig_t
!
USE modi_read_surf
USE modi_get_luout
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
!
!
TYPE(grid_t), INTENT(INOUT) :: G
TYPE(teb_irrig_t), INTENT(INOUT) :: TIR
!
 CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: ILUOUT         ! output listing logical unit
INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
 CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
 CHARACTER(LEN=80) :: YCOMMENT       ! Comment of the article to be read
INTEGER           :: JLAYER         ! loop index
!
INTEGER           :: IVERSION       ! surface version
INTEGER           :: IBUGFIX        ! surface bugfix version
REAL, DIMENSION(G%NDIM) :: ZWORK      ! work array
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('READ_PGD_TEB_IRRIG_N',0,zhook_handle)
!
 CALL get_luout(hprogram,iluout)
!
yrecfm='VERSION'
 CALL read_surf(hprogram,yrecfm,iversion,iresp)
yrecfm='BUG'
 CALL read_surf(hprogram,yrecfm,ibugfix,iresp)
!
IF (iversion<7 .OR. (iversion==7 .AND. ibugfix<=3)) THEN
  !
  tir%LPAR_GD_IRRIG = .false.
  tir%LPAR_GR_IRRIG = .false.
  tir%LPAR_RD_IRRIG = .false.
  !
ELSE
  !
  yrecfm='L_PAR_GD_IRR'
  CALL read_surf(hprogram,yrecfm,tir%LPAR_GD_IRRIG,iresp)
  yrecfm='L_PAR_GR_IRR'
  CALL read_surf(hprogram,yrecfm,tir%LPAR_GR_IRRIG,iresp)
  yrecfm='L_PAR_RD_IRR'
  CALL read_surf(hprogram,yrecfm,tir%LPAR_RD_IRRIG,iresp)
  !
ENDIF
!
!* read garden irrigation
!
IF (tir%LPAR_GD_IRRIG) THEN
  ALLOCATE(tir%XGD_START_MONTH(g%NDIM))
  yrecfm='D_GD_SM_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XGD_START_MONTH(:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XGD_END_MONTH  (g%NDIM))
  yrecfm='D_GD_EM_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XGD_END_MONTH  (:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XGD_START_HOUR (g%NDIM))
  yrecfm='D_GD_SH_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XGD_START_HOUR (:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XGD_END_HOUR   (g%NDIM))
  yrecfm='D_GD_EH_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XGD_END_HOUR   (:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XGD_24H_IRRIG  (g%NDIM))
  yrecfm='D_GD_IRRIG'
  CALL read_surf(hprogram,yrecfm,tir%XGD_24H_IRRIG  (:),iresp,hcomment=ycomment)
ELSE
  ALLOCATE(tir%XGD_START_MONTH(0))
  ALLOCATE(tir%XGD_END_MONTH  (0))
  ALLOCATE(tir%XGD_START_HOUR (0))
  ALLOCATE(tir%XGD_END_HOUR   (0))
  ALLOCATE(tir%XGD_24H_IRRIG  (0))
END IF
!
!* read greenroof irrigation
!
IF (tir%LPAR_GR_IRRIG) THEN
  ALLOCATE(tir%XGR_START_MONTH(g%NDIM))
  yrecfm='D_GR_SM_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XGR_START_MONTH(:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XGR_END_MONTH  (g%NDIM))
  yrecfm='D_GR_EM_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XGR_END_MONTH  (:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XGR_START_HOUR (g%NDIM))
  yrecfm='D_GR_SH_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XGR_START_HOUR (:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XGR_END_HOUR   (g%NDIM))
  yrecfm='D_GR_EH_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XGR_END_HOUR   (:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XGR_24H_IRRIG  (g%NDIM))
  yrecfm='D_GR_IRRIG'
  CALL read_surf(hprogram,yrecfm,tir%XGR_24H_IRRIG  (:),iresp,hcomment=ycomment)
ELSE
  ALLOCATE(tir%XGR_START_MONTH(0))
  ALLOCATE(tir%XGR_END_MONTH  (0))
  ALLOCATE(tir%XGR_START_HOUR (0))
  ALLOCATE(tir%XGR_END_HOUR   (0))
  ALLOCATE(tir%XGR_24H_IRRIG  (0))
END IF
!
!* read road watering
!
IF (tir%LPAR_RD_IRRIG) THEN
  ALLOCATE(tir%XRD_START_MONTH(g%NDIM))
  yrecfm='D_RD_SM_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XRD_START_MONTH(:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XRD_END_MONTH  (g%NDIM))
  yrecfm='D_RD_EM_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XRD_END_MONTH  (:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XRD_START_HOUR (g%NDIM))
  yrecfm='D_RD_SH_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XRD_START_HOUR (:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XRD_END_HOUR   (g%NDIM))
  yrecfm='D_RD_EH_IRR'
  CALL read_surf(hprogram,yrecfm,tir%XRD_END_HOUR   (:),iresp,hcomment=ycomment)
  !
  ALLOCATE(tir%XRD_24H_IRRIG  (g%NDIM))
  yrecfm='D_RD_IRRIG'
  CALL read_surf(hprogram,yrecfm,tir%XRD_24H_IRRIG  (:),iresp,hcomment=ycomment)
ELSE
  ALLOCATE(tir%XRD_START_MONTH(0))
  ALLOCATE(tir%XRD_END_MONTH  (0))
  ALLOCATE(tir%XRD_START_HOUR (0))
  ALLOCATE(tir%XRD_END_HOUR   (0))
  ALLOCATE(tir%XRD_24H_IRRIG  (0))
END IF

!
IF (lhook) CALL dr_hook('READ_PGD_TEB_IRRIG_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_pgd_teb_irrig_n