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, DTI, IG, I, UG, U, &
                                     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
!----------------------------------------------------------------------------
!
!*    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_isba_grid_n, ONLY : isba_grid_t
USE modd_isba_n, ONLY : isba_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_prep,             ONLY : cingrid_type, cinterp_type, linterp
!
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) :: dti
TYPE(isba_grid_t), INTENT(INOUT) :: ig
TYPE(isba_t), INTENT(INOUT) :: i
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 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
!            ------------------------------
!
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_grid_extern(&
                       hinifiletype,iluout,cingrid_type,cinterp_type,ini)
!
 CALL prep_output_grid(ug, u, &
                       iluout,ig%CGRID,ig%XGRID_PAR,ig%XLAT,ig%XLON)
!
!------------------------------------------------------------------------------
!
!*      3.     Reading of fields
!              -----------------
!
!
ALLOCATE(zfield(ini))
!
ALLOCATE(zsand(ini,i%NGROUND_LAYER))
 CALL read_surf(&
                hprogram,'SAND',zfield,iresp,hdir='A')
DO jlayer=1,i%NGROUND_LAYER
  zsand(:,jlayer) = zfield(:)
END DO
!
ALLOCATE(zclay(ini,i%NGROUND_LAYER))
 CALL read_surf(&
                hprogram,'CLAY',zfield,iresp,hdir='A')
DO jlayer=1,i%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',i%LSOCP,iresp)
ELSE
   i%LSOCP=.false.
ENDIF
!
IF(i%LSOCP)THEN
!  
  ALLOCATE(i%XSOC (ini,i%NGROUND_LAYER))
!
  CALL read_surf(&
                hprogram,'SOC_TOP',i%XSOC(:,1),iresp)
  CALL read_surf(&
                hprogram,'SOC_SUB',i%XSOC(:,2),iresp)
!
  DO jlayer=2,i%NGROUND_LAYER
    i%XSOC (:,jlayer)=i%XSOC (:,2)
  END DO
!
ELSE
!  
  ALLOCATE(i%XSOC (0,1))
!
ENDIF
!
!* permafrost distribution
!
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) THEN
   CALL read_surf(&
                hprogram,'PERMAFROST',i%LPERM,iresp)
ELSE
   i%LPERM=.false.
ENDIF
!
IF(i%LPERM)THEN
!  
  ALLOCATE(i%XPERM (ini))
  CALL read_surf(&
                hprogram,'PERM',i%XPERM(:),iresp)
!
ELSE
!  
  ALLOCATE(i%XPERM (0))
!
ENDIF
!
!* groundwater distribution
!
IF (iversion>=8) THEN
   CALL read_surf(&
                hprogram,'GWKEY',i%LGW,iresp)
ELSE
   i%LGW=.false.
ENDIF
!
IF(i%LGW)THEN
!  
  ALLOCATE(i%XGW (ini))
  CALL read_surf(&
                hprogram,'GWFRAC',i%XGW(:),iresp)
!
ELSE
!  
  ALLOCATE(i%XGW (0))
!
ENDIF
!
IF (iversion>7 .OR. (iversion==7 .AND. ibugfix>=3)) THEN
   CALL read_surf(&
                hprogram,'NO',i%LNOF,iresp)
ELSE
   i%LNOF = .false.
ENDIF
!
!SOILNOX
!
IF (chi%LCH_NO_FLUX) THEN
  !
  IF (i%LNOF) THEN
    !
    ALLOCATE(i%XPH(ini))
    CALL read_surf(&
                hprogram,'PH',i%XPH(:),iresp)
    !
    ALLOCATE(i%XFERT(ini))
    CALL read_surf(&
                hprogram,'FERT',i%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(i%XPH (0))
  ALLOCATE(i%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, &
                   iluout,zsand,i%XSAND)
 CALL hor_interpol(dtco, u, &
                   iluout,zclay,i%XCLAY)
ALLOCATE(zoutb(SIZE(i%XRUNOFFB),1))
 CALL hor_interpol(dtco, u, &
                   iluout,zrunoffb,zoutb)
i%XRUNOFFB(:) = zoutb(:,1)
DEALLOCATE(zoutb)
ALLOCATE(zoutw(SIZE(i%XWDRAIN),1))
 CALL hor_interpol(dtco, u, &
                   iluout,zwdrain,zoutw)
i%XWDRAIN(:) = zoutw(:,1)
DEALLOCATE(zoutw)
!
 CALL get_type_dim_n(dtco, u, &
                     'NATURE',ig%NDIM)
 CALL read_pgd_isba_par_n(dtco, u, &
                          dti, ig, i, &
                          hprogram,ini,.false.,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