zoom_pgd_teb.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_teb (BOP, BDD, DTB, DTCO, DTT, UG, U, GCP, IO, K, TG, TOP, &
                               HPROGRAM,HINIFILE,HINIFILETYPE,OECOCLIMAP,OGARDEN)
!     ###########################################################

!!
!!    PURPOSE
!!    -------
!!   This program prepares the physiographic data fields.
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson                   Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original     13/10/03
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_k_t
!
USE modd_bem_option_n, ONLY : bem_options_t
USE modd_bld_description_n, ONLY : bld_desc_t
USE modd_data_bem_n, ONLY : data_bem_t
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_data_teb_n, ONLY : data_teb_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_sfx_grid_n, ONLY : grid_t
USE modd_teb_option_n, ONLY : teb_options_t
!
USE modd_data_cover_par,  ONLY : jpcover
!
USE modd_surf_par,     ONLY : xundef
USE modd_prep,         ONLY : cingrid_type, cinterp_type, linterp
USE modd_isba_par,     ONLY : xoptimgrid
!
USE modi_get_luout
USE modi_abor1_sfx
USE modi_open_aux_io_surf
USE modi_get_surf_size_n
USE modi_pack_pgd
USE modi_prep_grid_extern
USE modi_prep_output_grid
USE modi_read_surf
USE modi_read_pgd_teb_par_n
USE modi_close_aux_io_surf
USE modi_clean_prep_output_grid
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
!
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
!
TYPE(bem_options_t), INTENT(INOUT) :: BOP
TYPE(bld_desc_t), INTENT(INOUT) :: BDD
TYPE(data_bem_t), INTENT(INOUT) :: DTB
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(data_teb_t), INTENT(INOUT) :: DTT
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(grid_conf_proj_t),INTENT(INOUT) :: GCP
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_k_t), INTENT(INOUT) :: K
TYPE(grid_t), INTENT(INOUT) :: TG
TYPE(teb_options_t), INTENT(INOUT) :: TOP
!
 CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
 CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! file to read
 CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! file type
LOGICAL,              INTENT(IN)  :: OECOCLIMAP  ! flag to use ecoclimap
LOGICAL,              INTENT(IN)  :: OGARDEN     ! flag to use garden
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER :: IRESP   ! error return code
INTEGER :: ILUOUT  ! output listing logical unit
INTEGER :: INI     ! total 1D dimension (input grid)
INTEGER :: JLAYER  ! loop counter
INTEGER :: ILU     ! total 1D dimension (output grid, TOWN points only)
INTEGER :: JPATCH  ! TEB patch
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER           :: IVERSION
INTEGER           :: IBUGFIX
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ZOOM_PGD_TEB',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
top%LECOCLIMAP = oecoclimap
top%LGARDEN = ogarden
!
IF (.NOT. oecoclimap) THEN
  WRITE(iluout,*) 'ERROR'
  WRITE(iluout,*) 'Ecoclimap is not used'
  WRITE(iluout,*) 'Routine zoom_pgd_teb.f90 must be updated'
  WRITE(iluout,*) 'to interpolate all TEB physiographic fields'
  CALL abor1_sfx('ZOOM_PGD_TEB: ECOCLIMAP NOT USED, ROUTINE MUST BE UPDATED')
END IF
!
!
!*      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  ')
!
!-------------------------------------------------------------------------------
!
!*    2.      Number of points and packing of general fields
!             ----------------------------------------------
!
!
 CALL get_surf_size_n(dtco, u, 'TOWN  ',ilu)
!
ALLOCATE(top%LCOVER    (jpcover))
ALLOCATE(top%XZS       (ilu))
ALLOCATE(tg%XLAT       (ilu))
ALLOCATE(tg%XLON       (ilu))
ALLOCATE(tg%XMESH_SIZE (ilu))
!
 CALL pack_pgd(dtco, u, hprogram, 'TOWN  ', tg, top%LCOVER, top%XCOVER, top%XZS   )  
!
tg%NDIM = ilu
!
!
 CALL read_surf(hprogram,'VERSION',iversion,iresp)
 CALL read_surf(hprogram,'BUG',ibugfix,iresp)
!------------------------------------------------------------------------------
!
!*      3.     Reading of grid
!              ---------------
!
 CALL prep_output_grid(ug%G, tg, u%NSIZE_FULL, iluout)
!
 CALL prep_grid_extern(gcp,hinifiletype,iluout,cingrid_type,cinterp_type,ini)
!
!------------------------------------------------------------------------------
!
!*      4.     Reading & interpolation of fields
!              ---------------------------------
!
!
IF (iversion<7 .OR. iversion==7 .AND. ibugfix<=2) THEN
  top%NTEB_PATCH=1
ELSE
  CALL read_surf(hprogram,'TEB_PATCH',top%NTEB_PATCH,iresp)
END IF

!
 CALL read_surf(hprogram,'ROOF_LAYER',top%NROOF_LAYER,iresp)
 CALL read_surf(hprogram,'ROAD_LAYER',top%NROAD_LAYER,iresp)
 CALL read_surf(hprogram,'WALL_LAYER',top%NWALL_LAYER,iresp)
!
IF (iversion<7 .OR.( iversion==7 .AND. ibugfix<=2)) THEN
  top%CBLD_ATYPE='ARI'
  top%CBEM = 'DEF'
ELSE
  CALL read_surf(hprogram,'BLD_ATYPE' ,top%CBLD_ATYPE,iresp)
  CALL read_surf(hprogram,'BEM'       ,top%CBEM      ,iresp)
END IF
!
IF (top%CBEM/='DEF') THEN
  CALL read_surf(hprogram,'FLOOR_LAYER',bop%NFLOOR_LAYER,iresp)
END IF
!
DO jpatch=1,top%NTEB_PATCH
  CALL read_pgd_teb_par_n(dtco, u, gcp, bdd, dtb, dtt, tg%NDIM, top, &
                          hprogram,ini,'A')
!
!------------------------------------------------------------------------------
!
!*      5.     Gardens
!              -------
!
  IF (top%LGARDEN) CALL zoom_pgd_teb_garden
END DO
!
 CALL close_aux_io_surf(hinifile,hinifiletype)
!
 CALL clean_prep_output_grid
!
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ZOOM_PGD_TEB',1,zhook_handle)
!------------------------------------------------------------------------------
!
CONTAINS
!
SUBROUTINE zoom_pgd_teb_garden
!
USE modi_hor_interpol
!
!
IMPLICIT NONE
!
REAL, DIMENSION(:,:), POINTER     :: ZIN     ! field  on all surface points
!
REAL, DIMENSION(INI)              :: ZFIELD  ! field read
REAL, DIMENSION(ILU,1)            :: ZOUT    ! final field
 CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
 CHARACTER(LEN=4 ) :: YLVL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (lhook) CALL dr_hook('ZOOM_PGD_TEB:ZOOM_PGD_TEB_GARDEN',0,zhook_handle)
!
linterp(:) = .true.
!
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) THEN
  CALL read_surf(hprogram,'GD_LAYER',io%NGROUND_LAYER,iresp)
  CALL read_surf(hprogram,'GD_ISBA',io%CISBA,iresp)
  CALL read_surf(hprogram,'GD_PHOTO',io%CPHOTO,iresp)
  CALL read_surf(hprogram,'GD_PEDOTF',io%CPEDOTF,iresp)
  CALL read_surf(hprogram,'GD_TR_ML',io%LTR_ML,iresp)
  io%NNBIOMASS=1
  IF (io%CPHOTO=='NIT') io%NNBIOMASS=3  
ELSE
  CALL read_surf(hprogram,'TWN_LAYER',io%NGROUND_LAYER,iresp)
  CALL read_surf(hprogram,'TWN_ISBA',io%CISBA,iresp)
  CALL read_surf(hprogram,'TWN_PHOTO',io%CPHOTO,iresp)
  CALL read_surf( hprogram,'TWN_PEDOTF',io%CPEDOTF,iresp)
  CALL read_surf(hprogram,'TWN_NBIOMASS',io%NNBIOMASS,iresp)
  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=2) THEN
    CALL read_surf(hprogram,'TWN_TR_ML',io%LTR_ML,iresp)
  ELSE
    io%LTR_ML = .false.
  ENDIF
ENDIF
!
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='GD_SGRID'//adjustl(ylvl(:len_trim(ylvl)))
        CALL read_surf(hprogram,yrecfm,io%XSOILGRID(jlayer),iresp)
     ENDDO
  ELSEIF (iversion==7 .AND. ibugfix>=2) THEN
    yrecfm='TWN_SOILGRID'
    IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_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
!
IF (iversion>8 .OR. iversion==8 .AND. ibugfix>=1) THEN
  CALL read_surf(hprogram,'GD_ALBEDO',io%CALBEDO,iresp)
ELSE
  io%CALBEDO = "DRY"
ENDIF
!
ALLOCATE(io%LMEB_PATCH(1))
io%LMEB_PATCH(:) = .false.

!* sand
!
ALLOCATE(zin(ini,io%NGROUND_LAYER))
yrecfm='TWN_SAND'
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_SAND'
 CALL read_surf(hprogram,yrecfm,zfield,iresp,hdir='A')
DO jlayer=1,io%NGROUND_LAYER
  zin(:,jlayer) = zfield(:)
END DO
ALLOCATE(k%XSAND(ilu,io%NGROUND_LAYER))
 CALL hor_interpol(dtco, u, gcp, iluout,zin,k%XSAND)
DEALLOCATE(zin)
!
!* clay
!
ALLOCATE(zin(ini,io%NGROUND_LAYER))
yrecfm='TWN_CLAY'
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_CLAY'
 CALL read_surf(hprogram,yrecfm,zfield,iresp,hdir='A')
DO jlayer=1,io%NGROUND_LAYER
  zin(:,jlayer) = zfield(:)
END DO
ALLOCATE(k%XCLAY(ilu,io%NGROUND_LAYER))
 CALL hor_interpol(dtco, u, gcp, iluout,zin,k%XCLAY)
DEALLOCATE(zin)
!
!* runoff & drainage
!
ALLOCATE(zin(ini,1))
yrecfm='TWN_RUNOFFB'
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_RUNOFFB'
 CALL read_surf(hprogram,yrecfm,zfield,iresp,hdir='A')
zin(:,1) = zfield(:)
ALLOCATE(k%XRUNOFFB(ilu))
 CALL hor_interpol(dtco, u, gcp, iluout,zin,zout)
k%XRUNOFFB(:) = zout(:,1)
!
IF (iversion<=3) THEN
  k%XWDRAIN = 0.
ELSE
 yrecfm='TWN_WDRAIN'
 IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) yrecfm='GD_WDRAIN'
 CALL read_surf(hprogram,yrecfm,zfield,iresp,hdir='A')
 zin(:,1) = zfield(:)
 ALLOCATE(k%XWDRAIN(ilu))
 CALL hor_interpol(dtco, u, gcp, iluout,zin,zout)
 k%XWDRAIN(:) = zout(:,1)
ENDIF
!
DEALLOCATE(zin)
!
IF(io%CISBA=='DIF') THEN
  ALLOCATE(io%XSOILGRID(io%NGROUND_LAYER))
  io%XSOILGRID = xundef
  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=2) THEN
    CALL read_surf(hprogram,'GD_SOILGRID',io%XSOILGRID,iresp,hdir='-')
  ELSE
    io%XSOILGRID(1:io%NGROUND_LAYER)=xoptimgrid(1:io%NGROUND_LAYER)
  ENDIF
ELSE
  ALLOCATE(io%XSOILGRID(0))
ENDIF
!
!* other garden parameters
!
 CALL read_surf(hprogram,'PAR_GARDEN',io%LPAR,iresp)
!
!!
IF (io%LPAR) THEN
  WRITE(iluout,*) 'ERROR'
  WRITE(iluout,*) 'Specific garden fields are prescribed'
  WRITE(iluout,*) 'Routine zoom_pgd_teb.f90 must be updated'
  WRITE(iluout,*) 'to interpolate all TEB physiographic garden fields'
  CALL abor1_sfx('ZOOM_PGD_TEB: GARDEN fields used, ROUTINE MUST BE UPDATED')
END IF
!
IF (lhook) CALL dr_hook('ZOOM_PGD_TEB:ZOOM_PGD_TEB_GARDEN',1,zhook_handle)
!
END SUBROUTINE zoom_pgd_teb_garden
!_______________________________________________________________________________
!
END SUBROUTINE zoom_pgd_teb