zoom_pgd_isba_full.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 zoom_pgd_isba_full (CHI, DTCO, DTV, IG, IO, S, K, UG, U, GCP, &
                                     HPROGRAM,HINIFILE,HINIFILETYPE)
!     ###########################################################

!!
!!    PURPOSE
!!    -------
!!   This program prepares the physiographic data fields.
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson                   Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original     13/10/03
!!    B. Decharme      2008  XWDRAIN
!!    M.Tomasini   17/04/12 All COVER physiographic fields are now 
!!                          interpolated for spawning => 
!!                          ABOR1_SFX if (.NOT.OECOCLIMAP) in comment
!!    10/2016 B. Decharme : bug surface/groundwater coupling  
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
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_sfx_grid_n, ONLY : grid_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_grid_conf_proj_n, ONLY : grid_conf_proj_t
!
USE modd_prep,             ONLY : cingrid_type, cinterp_type, linterp
!
USE modd_type_date_surf, ONLY : date
!
USE modi_get_luout
USE modi_open_aux_io_surf
USE modi_prep_grid_extern
USE modi_prep_output_grid
USE modi_read_surf
USE modi_close_aux_io_surf
USE modi_hor_interpol
USE modi_get_type_dim_n
USE modi_read_pgd_isba_par_n
USE modi_clean_prep_output_grid
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
!
TYPE(ch_isba_t), INTENT(INOUT) :: CHI
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(data_isba_t), INTENT(INOUT) :: DTV
TYPE(grid_t), INTENT(INOUT) :: IG
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(grid_conf_proj_t),INTENT(INOUT) :: GCP
!
 CHARACTER(LEN=6),       INTENT(IN)  :: HPROGRAM     ! program calling
 CHARACTER(LEN=28),      INTENT(IN)  :: HINIFILE     ! input atmospheric file name
 CHARACTER(LEN=6),       INTENT(IN)  :: HINIFILETYPE ! input atmospheric file type
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
TYPE(date) :: TDATE_BEG, TDATE_END
!
INTEGER :: IVERSION, IBUGFIX
INTEGER :: IRESP
INTEGER :: ILUOUT
INTEGER :: INI     ! total 1D dimension (input grid)
INTEGER :: JLAYER  ! loop counter
REAL, DIMENSION(:),   ALLOCATABLE :: ZFIELD    ! field read
REAL, DIMENSION(:,:), POINTER     :: ZSAND   ! sand   on all surface points
REAL, DIMENSION(:,:), POINTER     :: ZCLAY   ! clay   on all surface points
REAL, DIMENSION(:,:), POINTER     :: ZRUNOFFB! runoff coef. on all surface points
REAL, DIMENSION(:,:), POINTER     :: ZWDRAIN ! drainage coef. on all surface points
REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUTB   ! runoff coef. on all surface points
REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUTW   ! drainage coef. on all surface points
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ZOOM_PGD_ISBA_FULL',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!*      1.     Preparation of IO for reading in the file
!              -----------------------------------------
!
!* Note that all points are read, even those without physical meaning.
!  These points will not be used during the horizontal interpolation step.
!  Their value must be defined as XUNDEF.
!
 CALL open_aux_io_surf(hinifile,hinifiletype,'FULL  ')
!
 CALL read_surf(hinifiletype,'VERSION',iversion,iresp)
 CALL read_surf(hinifiletype,'BUG',ibugfix,iresp) 
!
!------------------------------------------------------------------------------
!
!*      2.     Reading of grid
!              ---------------
!
 CALL prep_output_grid(ug%G, ig, u%NSIZE_FULL, iluout)
!
 CALL prep_grid_extern(gcp,hinifiletype,iluout,cingrid_type,cinterp_type,ini)
!
!-----------------------------------------------------------------------------
!
!*      3.     Reading of fields
!              -----------------
!
!
ALLOCATE(zfield(ini))
!
ALLOCATE(zsand(ini,io%NGROUND_LAYER))
 CALL read_surf(hprogram,'SAND',zfield,iresp,hdir='A')
DO jlayer=1,io%NGROUND_LAYER
  zsand(:,jlayer) = zfield(:)
END DO
!
ALLOCATE(zclay(ini,io%NGROUND_LAYER))
 CALL read_surf(hprogram,'CLAY',zfield,iresp,hdir='A')
DO jlayer=1,io%NGROUND_LAYER
  zclay(:,jlayer) = zfield(:)
END DO
!
!* Soil organic carbon profile
!
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) THEN
   CALL read_surf(hprogram,'SOCP',io%LSOCP,iresp)
ELSE
   io%LSOCP=.false.
ENDIF
!
IF(io%LSOCP)THEN
!  
  ALLOCATE(s%XSOC (ini,io%NGROUND_LAYER))
!
  CALL read_surf(hprogram,'SOC_TOP',s%XSOC(:,1),iresp)
  CALL read_surf(hprogram,'SOC_SUB',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
   CALL read_surf(hprogram,'PERMAFROST',io%LPERM,iresp)
ELSE
   io%LPERM=.false.
ENDIF
!
IF(io%LPERM)THEN
!  
  ALLOCATE(k%XPERM (ini))
  CALL read_surf(hprogram,'PERM',k%XPERM(:),iresp)
!
ELSE
!  
  ALLOCATE(k%XPERM (0))
!
ENDIF
!
!SOILNOX
!
IF (iversion>7 .OR. (iversion==7 .AND. ibugfix>=3)) THEN
   CALL read_surf(hprogram,'NO',io%LNOF,iresp)
ELSE
   io%LNOF = .false.
ENDIF
!
IF (chi%LCH_NO_FLUX) THEN
  !
  IF (io%LNOF) THEN
    !
    ALLOCATE(s%XPH(ini))
    CALL read_surf(hprogram,'PH',s%XPH(:),iresp,hdir='A')
    !
    ALLOCATE(s%XFERT(ini))
    CALL read_surf(hprogram,'FERT',s%XFERT(:),iresp,hdir='A')
    !
  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
!
ALLOCATE(zrunoffb(ini,1))
 CALL read_surf(hprogram,'RUNOFFB',zfield,iresp,hdir='A')
zrunoffb(:,1) = zfield(:)
!
ALLOCATE(zwdrain(ini,1))
 CALL read_surf(hprogram,'WDRAIN',zfield,iresp,hdir='A')
zwdrain(:,1) = zfield(:)
!
DEALLOCATE(zfield)
!
!------------------------------------------------------------------------------
!
!*      4.     Interpolations
!              --------------
!
!* mask where interpolations must be done
!
linterp(:) = .true.
!
!* interpolations
!
 CALL hor_interpol(dtco, u, gcp, iluout,zsand,k%XSAND)
!
 CALL hor_interpol(dtco, u, gcp, iluout,zclay,k%XCLAY)
!
ALLOCATE(zoutb(SIZE(k%XRUNOFFB),1))
 CALL hor_interpol(dtco, u, gcp, iluout,zrunoffb,zoutb)
k%XRUNOFFB(:) = zoutb(:,1)
DEALLOCATE(zoutb)
ALLOCATE(zoutw(SIZE(k%XWDRAIN),1))
 CALL hor_interpol(dtco, u, gcp, iluout,zwdrain,zoutw)
k%XWDRAIN(:) = zoutw(:,1)
DEALLOCATE(zoutw)
!
 CALL get_type_dim_n(dtco, u, 'NATURE',ig%NDIM)
!
tdate_beg%YEAR = 2016
tdate_beg%MONTH = 1
tdate_beg%DAY = 1
tdate_end%YEAR = 2016
tdate_end%MONTH = 12
tdate_end%DAY = 31
 CALL read_pgd_isba_par_n(dtco, u, gcp, dtv, ig%NDIM, io, &
                          hprogram,ini,.false.,tdate_beg, tdate_end, hdir='A')
!
 CALL close_aux_io_surf(hinifile,hinifiletype)
!
 CALL clean_prep_output_grid
IF (lhook) CALL dr_hook('ZOOM_PGD_ISBA_FULL',1,zhook_handle)
!------------------------------------------------------------------------------
!
END SUBROUTINE zoom_pgd_isba_full