read_pgd_isban.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_isba_n (CHI, DTCO, DTV, DTZ, GB, IG, ISS, IO, S, K, &
                                  UG, U, USS, GCP, SV, HPROGRAM, OLAND_USE, TPDATE_END)
!     #########################################
!
!!****  *READ_PGD_ISBA_n* - routine to initialise ISBA physiographic variables 
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003 
!!      P. Le Moigne  12/2004 : add type of photosynthesis
!!      B. Decharme      2008 : add XWDRAIN
!!      B. Decharme   06/2009 : add topographic index statistics
!!      A.L. Gibelin 04/2009 : dimension NBIOMASS for ISBA-A-gs
!!      B. Decharme  07/2012  : files of data for permafrost area and for SOC top and sub soil
!!                   11/2013  : same for groundwater distribution
!!                   11/2014  : Read XSOILGRID as a series of real 
!!      P. Samuelsson 10/2014 : MEB
!!    10/2016 B. Decharme : bug surface/groundwater coupling   
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_ch_isba_n, ONLY : ch_isba_t
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_data_tsz0_n, ONLY : data_tsz0_t
USE modd_gr_biog_n, ONLY : gr_biog_t
USE modd_sfx_grid_n, ONLY : grid_t
USE modd_sso_n, ONLY : sso_t
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_s_t, isba_k_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_sso_n, ONLY : sso_t
USE modd_grid_conf_proj_n, ONLY : grid_conf_proj_t
USE modd_sv_n, ONLY : sv_t
!
USE modd_type_date_surf
!
USE modd_data_cover_par, ONLY : jpcover
!
USE modd_surf_par,   ONLY : xundef
USE modd_isba_par,    ONLY : xoptimgrid
!
USE modi_read_nam_pgd_isba
!
USE modi_init_io_surf_n
USE modi_end_io_surf_n
!
USE modi_read_surf
USE modi_pack_init
USE modi_pack_sso
USE modi_read_pgd_isba_par_n
USE modi_read_pgd_tsz0_par_n
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_get_type_dim_n
USE modi_read_lecoclimap
!
USE modi_abor1_sfx
!
USE modi_get_luout
USE modi_pack_same_rank
USE modi_get_surf_mask_n
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(ch_isba_t), INTENT(INOUT) :: CHI
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(data_isba_t), INTENT(INOUT) :: DTV
TYPE(data_tsz0_t), INTENT(INOUT) :: DTZ
TYPE(gr_biog_t), INTENT(INOUT) :: GB
TYPE(grid_t), INTENT(INOUT) :: IG
TYPE(sso_t), INTENT(INOUT) :: ISS
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_s_t), INTENT(INOUT) :: S
TYPE(isba_k_t), INTENT(INOUT) :: K
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(sso_t), INTENT(INOUT) :: USS
TYPE(grid_conf_proj_t),INTENT(INOUT) :: GCP
TYPE(sv_t), INTENT(INOUT) :: SV
!
 CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program
LOGICAL,           INTENT(IN)  :: OLAND_USE ! 
TYPE(date), INTENT(IN) :: TPDATE_END
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER, DIMENSION(:), POINTER :: IMASK  ! mask for packing from complete field to nature field
!
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
!
 CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
 CHARACTER(LEN=4 ) :: YLVL
!
INTEGER :: ISIZE_LMEB_PATCH  ! Number of patches with MEB=true
INTEGER :: ILU    ! expected physical size of full surface array
INTEGER :: ILUOUT ! output listing logical unit
INTEGER :: IRESP  ! Error code after redding
INTEGER :: JLAYER ! loop counter on layers
INTEGER :: IVERSION, IBUGFIX   ! surface version
!
INTEGER                  :: IPATCH           ! number of patches
INTEGER                  :: IGROUND_LAYER    ! number of soil layers
INTEGER                  :: JVEGTYPE
 CHARACTER(LEN=3)         :: YISBA            ! ISBA option
 CHARACTER(LEN=4)         :: YPEDOTF          ! Pedo transfert function for DIF
 CHARACTER(LEN=3)         :: YPHOTO           ! photosynthesis option
LOGICAL                  :: GTR_ML           ! new radiative transfert
 CHARACTER(LEN=4)         :: YALBEDO
REAL                     :: ZRM_PATCH        ! threshold to remove little fractions of patches
 CHARACTER(LEN=28)        :: YSAND            ! file name for sand fraction
 CHARACTER(LEN=28)        :: YCLAY            ! file name for clay fraction
 CHARACTER(LEN=28)        :: YSOC_TOP         ! file name for organic carbon top soil
 CHARACTER(LEN=28)        :: YSOC_SUB         ! file name for organic carbon sub soil
 CHARACTER(LEN=28)        :: YCTI             ! file name for topographic index
 CHARACTER(LEN=28)        :: YRUNOFFB         ! file name for runoffb parameter
 CHARACTER(LEN=28)        :: YWDRAIN          ! file name for wdrain parameter
 CHARACTER(LEN=28)        :: YPERM            ! file name for permafrost distribution
 CHARACTER(LEN=6)         :: YSANDFILETYPE    ! sand data file type
 CHARACTER(LEN=6)         :: YCLAYFILETYPE    ! clay data file type
 CHARACTER(LEN=6)         :: YSOCFILETYPE     ! organic carbon data file type
 CHARACTER(LEN=6)         :: YCTIFILETYPE     ! topographic index data file type
 CHARACTER(LEN=6)         :: YRUNOFFBFILETYPE ! subgrid runoff data file type
 CHARACTER(LEN=6)         :: YWDRAINFILETYPE  ! subgrid drainage data file type
 CHARACTER(LEN=6)         :: YPERMFILETYPE    ! permafrost distribution data file type
REAL                     :: XUNIF_SAND       ! uniform value of sand fraction  (-)
REAL                     :: XUNIF_CLAY       ! uniform value of clay fraction  (-)
REAL                     :: XUNIF_SOC_TOP    ! uniform value of organic carbon top soil (kg/m2)
REAL                     :: XUNIF_SOC_SUB    ! uniform value of organic carbon sub soil (kg/m2)
REAL                     :: XUNIF_RUNOFFB    ! uniform value of subgrid runoff coefficient
REAL                     :: XUNIF_WDRAIN     ! uniform subgrid drainage parameter
REAL                     :: XUNIF_PERM       ! uniform permafrost distribution
LOGICAL                  :: LIMP_SAND        ! Imposed maps of Sand
LOGICAL                  :: LIMP_CLAY        ! Imposed maps of Clay
LOGICAL                  :: LIMP_SOC         ! Imposed maps of organic carbon
LOGICAL                  :: LIMP_CTI         ! Imposed maps of topographic index statistics
LOGICAL                  :: LIMP_PERM        ! Imposed maps of permafrost distribution
REAL, DIMENSION(150)     :: ZSOILGRID        ! Soil grid reference for DIF
 CHARACTER(LEN=28)        :: YPH           ! file name for pH
 CHARACTER(LEN=28)        :: YFERT         ! file name for fertilisation rate
 CHARACTER(LEN=6)         :: YPHFILETYPE   ! pH data file type
 CHARACTER(LEN=6)         :: YFERTFILETYPE ! fertilisation data file type
REAL                     :: XUNIF_PH      ! uniform value of pH
REAL                     :: XUNIF_FERT    ! uniform value of fertilisation rate
LOGICAL                  :: GMEB      ! Multi-energy balance (MEB)
!
LOGICAL :: GECOSG
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!* 1D physical dimension
!
IF (lhook) CALL dr_hook('READ_PGD_ISBA_N',0,zhook_handle)
yrecfm='SIZE_NATURE'
 CALL get_type_dim_n(dtco, u, 'NATURE',ig%NDIM)
!
yrecfm='VERSION'
 CALL read_surf(hprogram,yrecfm,iversion,iresp)
!
yrecfm='BUG'
 CALL read_surf(hprogram,yrecfm,ibugfix,iresp)
!
!*       2.     Dimension initializations:
!               -------------------------
!
!* soil scheme
!
yrecfm='ISBA'
 CALL read_surf(hprogram,yrecfm,io%CISBA,iresp)
!
IF (iversion>=7) THEN
  !
  !* Pedo-transfert function
  !
  yrecfm='PEDOTF'
  CALL read_surf(hprogram,yrecfm,io%CPEDOTF,iresp)
  !
ELSE
  io%CPEDOTF = 'CH78'
ENDIF
!
!* type of photosynthesis
!
yrecfm='PHOTO'
 CALL read_surf(hprogram,yrecfm,io%CPHOTO,iresp)
!
!* new radiative transfert
!
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=2) THEN
  !
  yrecfm='TR_ML'
  CALL read_surf(hprogram,yrecfm,io%LTR_ML,iresp)
  !
ELSE 
  io%LTR_ML = .false.
ENDIF
!
IF (iversion>8 .OR. iversion==8 .AND. ibugfix>=1) THEN
  !
  yrecfm='ALBEDO'
  CALL read_surf(hprogram,yrecfm,io%CALBEDO,iresp)
  !
ELSE
  !
  CALL read_nam_pgd_isba(hprogram, ipatch, iground_layer,                        &
                       yisba,  ypedotf, yphoto, gtr_ml, yalbedo, zrm_patch,      &
                       yclay, yclayfiletype, xunif_clay, limp_clay,              &
                       ysand, ysandfiletype, xunif_sand, limp_sand,              &
                       ysoc_top, ysoc_sub, ysocfiletype, xunif_soc_top,          &
                       xunif_soc_sub, limp_soc, ycti, yctifiletype, limp_cti,    &
                       yperm, ypermfiletype, xunif_perm, limp_perm, gmeb,        &                       
                       yrunoffb, yrunoffbfiletype, xunif_runoffb,                &
                       ywdrain,  ywdrainfiletype , xunif_wdrain, zsoilgrid,      &
                       yph, yphfiletype, xunif_ph, yfert, yfertfiletype,         &
                       xunif_fert                          )  
  io%CALBEDO = yalbedo
  !
ENDIF
!
!* threshold to remove little fractions of patches
!
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) THEN
  !
  yrecfm='RM_PATCH'
  CALL read_surf(hprogram,yrecfm,io%XRM_PATCH,iresp)
  !
ELSE 
  io%XRM_PATCH = 0.0
ENDIF
!
!* number of soil layers
!
yrecfm='GROUND_LAYER'
 CALL read_surf(hprogram,yrecfm,io%NGROUND_LAYER,iresp)
!
!* Reference grid for DIF
!
IF(io%CISBA=='DIF') THEN
  ALLOCATE(io%XSOILGRID(io%NGROUND_LAYER))
  io%XSOILGRID=xundef
  IF (iversion>=8) THEN
    DO jlayer=1,io%NGROUND_LAYER
      WRITE(ylvl,'(I4)') jlayer
      yrecfm='SOILGRID'//adjustl(ylvl(:len_trim(ylvl)))
      CALL read_surf(hprogram,yrecfm,io%XSOILGRID(jlayer),iresp)
    ENDDO    
  ELSEIF (iversion==7 .AND. ibugfix>=2) THEN
    yrecfm='SOILGRID'
    CALL read_surf(hprogram,yrecfm,io%XSOILGRID,iresp,hdir='-')
  ELSE
    io%XSOILGRID(1:io%NGROUND_LAYER)=xoptimgrid(1:io%NGROUND_LAYER)
  ENDIF
ELSE
  ALLOCATE(io%XSOILGRID(0))
ENDIF
!
!* number of biomass pools
!
IF (iversion>=6) THEN
  yrecfm='NBIOMASS'
  CALL read_surf(hprogram,yrecfm,io%NNBIOMASS,iresp)
ELSE
  SELECT CASE (io%CPHOTO)
    CASE ('AST')
      io%NNBIOMASS = 1
    CASE ('NIT')
      io%NNBIOMASS = 3
    CASE ('NCB')
      io%NNBIOMASS = 6
  END SELECT
ENDIF
!
!* number of tiles
!
yrecfm='PATCH_NUMBER'
 CALL read_surf(hprogram,yrecfm,io%NPATCH,iresp)
!
!* logical vector indicating for which patches MEB should be applied
!
ALLOCATE(io%LMEB_PATCH(io%NPATCH))
!
IF (iversion>=8) THEN
!
  yrecfm='MEB_PATCH'
  CALL read_surf(hprogram,yrecfm,io%LMEB_PATCH(:),iresp,hdir='-')
!
  isize_lmeb_patch = count(io%LMEB_PATCH(:))
!
  IF (isize_lmeb_patch>0)THEN
    yrecfm='FORC_MEASURE'
    CALL read_surf(hprogram,yrecfm,io%LFORC_MEASURE,iresp)
    yrecfm='MEB_LITTER'
    CALL read_surf(hprogram,yrecfm,io%LMEB_LITTER,iresp)
    yrecfm='MEB_GNDRES'
    CALL read_surf(hprogram,yrecfm,io%LMEB_GNDRES,iresp)      
  ELSE
    io%LFORC_MEASURE=.false.
    io%LMEB_LITTER  =.false. 
    io%LMEB_GNDRES  =.false.    
  ENDIF
!
ELSE
  io%LMEB_PATCH(:)=.false.
  io%LFORC_MEASURE=.false.
  io%LMEB_LITTER  =.false.
  io%LMEB_GNDRES  =.false.  
ENDIF
!
!
!*       3.     Physiographic data fields:
!               -------------------------
!
!
!*       3.1    Cover classes :
!               -------------
!
ALLOCATE(s%LCOVER(jpcover))
ALLOCATE(s%XZS(ig%NDIM))
!
ALLOCATE(ig%XLAT       (ig%NDIM))
ALLOCATE(ig%XLON       (ig%NDIM))
ALLOCATE(ig%XMESH_SIZE (ig%NDIM))
!
ALLOCATE(iss%XZ0EFFJPDIR(ig%NDIM))
!
 CALL pack_init(dtco, u, ug, hprogram, 'NATURE', ig, s%LCOVER, s%XCOVER, s%XZS, iss%XZ0EFFJPDIR )
!
!* clay fraction : attention, seul un niveau est present dans le fichier
!* on rempli tout les niveaux de  XCLAY avec les valeurs du fichiers
!
ALLOCATE(k%XCLAY(ig%NDIM,io%NGROUND_LAYER))
yrecfm='CLAY'
 CALL read_surf(hprogram,yrecfm,k%XCLAY(:,1),iresp)
DO jlayer=2,io%NGROUND_LAYER
  k%XCLAY(:,jlayer) = k%XCLAY(:,1)
END DO
!
!* sand fraction
!
ALLOCATE(k%XSAND(ig%NDIM,io%NGROUND_LAYER))
yrecfm='SAND'
 CALL read_surf(hprogram,yrecfm,k%XSAND(:,1),iresp)
DO jlayer=2,io%NGROUND_LAYER
  k%XSAND(:,jlayer) = k%XSAND(:,1)
END DO
!
!* Soil organic carbon profile
!
IF (iversion>7 .OR. (iversion==7 .AND. ibugfix>=3)) THEN
   yrecfm='SOCP'
   CALL read_surf(hprogram,yrecfm,io%LSOCP,iresp)
ELSE
   io%LSOCP=.false.
ENDIF
!
IF(io%LSOCP)THEN
!  
  ALLOCATE(s%XSOC (ig%NDIM,io%NGROUND_LAYER))
!
  yrecfm='SOC_TOP'
  CALL read_surf(hprogram,yrecfm,s%XSOC(:,1),iresp)
  yrecfm='SOC_SUB'
  CALL read_surf(hprogram,yrecfm,s%XSOC(:,2),iresp)
!
  DO jlayer=2,io%NGROUND_LAYER
    s%XSOC (:,jlayer)=s%XSOC (:,2)
  END DO
!
ELSE
!  
  ALLOCATE(s%XSOC (0,1))
!
ENDIF
!
!* permafrost distribution
!
IF (iversion>7 .OR. (iversion==7 .AND. ibugfix>=3)) THEN
   yrecfm='PERMAFROST'
   CALL read_surf(hprogram,yrecfm,io%LPERM,iresp)
ELSE
   io%LPERM=.false.
ENDIF
!
IF(io%LPERM)THEN
!  
  ALLOCATE(k%XPERM (ig%NDIM))
!
  yrecfm='PERM'
  CALL read_surf(hprogram,yrecfm,k%XPERM(:),iresp)
!
ELSE
!  
  ALLOCATE(k%XPERM (0))
!
ENDIF
!
!SOILNOX
!
IF (iversion>7 .OR. (iversion==7 .AND. ibugfix>=3)) THEN
   yrecfm='NO'
   CALL read_surf(hprogram,yrecfm,io%LNOF,iresp)
ELSE
   io%LNOF = .false.
ENDIF
!
IF (chi%LCH_NO_FLUX) THEN
  !
  IF (io%LNOF) THEN
    !
    ALLOCATE(s%XPH(ig%NDIM))
    yrecfm='PH'
    CALL read_surf(hprogram,yrecfm,s%XPH(:),iresp)
    !
    ALLOCATE(s%XFERT(ig%NDIM))
    yrecfm='FERT'
    CALL read_surf(hprogram,yrecfm,s%XFERT(:),iresp)
    !
  ELSE
    CALL abor1_sfx("READ_PGD_ISBAn: WITH LCH_NO_FLUX=T, PH AND FERT FIELDS ARE GIVEN AT PGD STEP")
  ENDIF
  !
ELSE
  ALLOCATE(s%XPH (0))
  ALLOCATE(s%XFERT(0))
END IF
!
!* subgrid-scale orography parameters to compute dynamical roughness length
!
ALLOCATE(iss%XAOSIP(ig%NDIM))
ALLOCATE(iss%XAOSIM(ig%NDIM))
ALLOCATE(iss%XAOSJP(ig%NDIM))
ALLOCATE(iss%XAOSJM(ig%NDIM))
ALLOCATE(iss%XHO2IP(ig%NDIM))
ALLOCATE(iss%XHO2IM(ig%NDIM))
ALLOCATE(iss%XHO2JP(ig%NDIM))
ALLOCATE(iss%XHO2JM(ig%NDIM))
ALLOCATE(iss%XSSO_SLOPE(ig%NDIM))
ALLOCATE(iss%XSSO_STDEV(ig%NDIM))
!
 CALL pack_sso(uss,hprogram,u%NR_NATURE, iss)
!
!* orographic runoff coefficient
!
ALLOCATE(k%XRUNOFFB(ig%NDIM))
yrecfm='RUNOFFB'
 CALL read_surf(hprogram,yrecfm,k%XRUNOFFB,iresp)
!
!* subgrid drainage coefficient
!
ALLOCATE(k%XWDRAIN(ig%NDIM))
IF (iversion<=3) THEN
  k%XWDRAIN = 0.
ELSE
  yrecfm='WDRAIN'
  CALL read_surf(hprogram,yrecfm,k%XWDRAIN,iresp)
ENDIF
!
!* topographic index statistics
!
IF(io%CRUNOFF=='SGH ' .AND. iversion>=5) THEN 
!
  yrecfm='CTI'
  CALL read_surf(hprogram,yrecfm,io%LCTI,iresp)        
!
  IF (.NOT.io%LCTI) CALL abor1_sfx("READ_PGD_ISBA_n:WITH CRUNOFF=SGH, CTI MAPS MUST BE GIVEN TO PGD")
  !
  ALLOCATE(s%XTI_MIN(ig%NDIM))
  ALLOCATE(s%XTI_MAX(ig%NDIM))
  ALLOCATE(s%XTI_MEAN(ig%NDIM))
  ALLOCATE(s%XTI_STD(ig%NDIM))
  ALLOCATE(s%XTI_SKEW(ig%NDIM))
!
  yrecfm='TI_MIN'
  CALL read_surf(hprogram,yrecfm,s%XTI_MIN,iresp)
!
  yrecfm='TI_MAX'
  CALL read_surf(hprogram,yrecfm,s%XTI_MAX,iresp)
!
  yrecfm='TI_MEAN'
  CALL read_surf(hprogram,yrecfm,s%XTI_MEAN,iresp)
!
  yrecfm='TI_STD'
  CALL read_surf(hprogram,yrecfm,s%XTI_STD,iresp)
!
  yrecfm='TI_SKEW'
  CALL read_surf(hprogram,yrecfm,s%XTI_SKEW,iresp)
!
ELSE
!
  ALLOCATE(s%XTI_MIN(0))
  ALLOCATE(s%XTI_MAX(0))
  ALLOCATE(s%XTI_MEAN(0))
  ALLOCATE(s%XTI_STD(0))
  ALLOCATE(s%XTI_SKEW(0))
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!* biogenic chemical emissions
!
IF (chi%LCH_BIO_FLUX) THEN
  ALLOCATE(zwork(u%NSIZE_FULL,1))
  !
  CALL end_io_surf_n(hprogram)
 CALL init_io_surf_n(dtco, u, hprogram,'FULL  ','SURF  ','READ ')
  !
  CALL get_luout(hprogram,iluout)
  ALLOCATE(imask(ig%NDIM))
  ilu=0
  CALL get_surf_mask_n(dtco, u, 'NATURE',ig%NDIM,imask,ilu,iluout)
  ALLOCATE(gb%XISOPOT(ig%NDIM))
  ALLOCATE(gb%XMONOPOT(ig%NDIM))
  !
  zwork(:,:) = 0.  
  yrecfm='E_ISOPOT'
  CALL read_surf(hprogram,yrecfm,zwork,iresp)
  CALL pack_same_rank(imask,zwork(:,1),gb%XISOPOT(:))
  !
  zwork(:,:) = 0.  
  yrecfm='E_MONOPOT'
  CALL read_surf(hprogram,yrecfm,zwork,iresp)
  CALL pack_same_rank(imask,zwork(:,1),gb%XMONOPOT(:))
  !
  CALL end_io_surf_n(hprogram)
 CALL init_io_surf_n(dtco, u, hprogram,'NATURE','ISBA  ','READ ')
  !
  DEALLOCATE(zwork)
ELSE
  ALLOCATE(gb%XISOPOT (0))
  ALLOCATE(gb%XMONOPOT(0))
END IF
!
!-------------------------------------------------------------------------------
!
!*       4.     Physiographic data fields not to be computed by ecoclimap
!               ---------------------------------------------------------
!
 CALL read_lecoclimap(hprogram,io%LECOCLIMAP,gecosg)
!
 CALL read_pgd_isba_par_n(dtco, u, gcp, dtv, ig%NDIM, io, hprogram,ig%NDIM, oland_use, s%TTIME%TDATE, tpdate_end)
IF (u%CNATURE == 'TSZ0') CALL read_pgd_tsz0_par_n(dtz, hprogram)
!
IF (lhook) CALL dr_hook('READ_PGD_ISBA_N',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_pgd_isba_n