prep_teb_garden_buffer.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 prep_teb_garden_buffer(HPROGRAM,HSURF,KLUOUT,PFIELD)
!     #################################################################################
!
!!****  *PREP_TEB_GARDEN_BUFFER* - initializes ISBA fields from operational BUFFER
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     S. Malardel 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    03/2005
!!------------------------------------------------------------------
!

!
USE mode_read_buffer
!
USE modd_type_date_surf
!
USE modi_prep_buffer_grid
USE modi_interp_grid
!
USE modd_prep,           ONLY : cinterp_type
USE modd_prep_teb_garden,ONLY : xgrid_soil, xwr_def
USE modd_data_cover_par, ONLY : nvegtype
USE modd_surf_par,       ONLY : xundef
USE modd_grid_buffer,    ONLY : nni
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=7),   INTENT(IN)  :: hsurf     ! type of field
INTEGER,            INTENT(IN)  :: kluout    ! logical unit of output listing
REAL,DIMENSION(:,:,:), POINTER    :: pfield    ! field to interpolate horizontally
!
!*      0.2    declarations of local variables
!
TYPE (date_time)                :: tztime_buf    ! current date and time
 CHARACTER(LEN=6)                :: yinmodel       ! model from which buffer originates
REAL, DIMENSION(:,:), POINTER   :: zfield         ! field read
REAL, DIMENSION(:),   POINTER   :: zfield1d       ! field read
REAL, DIMENSION(:,:), POINTER   :: zd             ! depth of field in the soil
INTEGER                         :: jvegtype       ! loop counter on vegtypes
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
!*      1.     Reading of grid
!              ---------------
!
IF (lhook) CALL dr_hook('PREP_TEB_GARDEN_BUFFER',0,zhook_handle)
 CALL prep_buffer_grid(kluout,yinmodel,tztime_buf)

!
!*      2.     Reading of field
!              ----------------
!
!*      3.     Transformation into physical quantity to be interpolated
!              --------------------------------------------------------
!
SELECT CASE(hsurf)
!
!*      3.1    Profile of temperature in the soil
!
  CASE('TG    ')
     !* reading of the profile and its depth definition
     SELECT CASE(yinmodel)
     CASE('ALADIN')
        CALL read_buffer_tg(kluout,yinmodel,zfield,zd)
     END SELECT
     
     CALL soil_profile_buffer

  CASE('WG    ')
     !* reading of the profile and its depth definition
     SELECT CASE(yinmodel)
     CASE('ARPEGE','ALADIN','MOCAGE')
        CALL read_buffer_wg(kluout,yinmodel,zfield,zd)
     END SELECT
     CALL soil_profile_buffer


!*      3.3    Profile of soil ice content

  CASE('WGI   ')    
     !* reading of the profile and its depth definition
     SELECT CASE(yinmodel)
       CASE('ALADIN')
         CALL read_buffer_wgi(kluout,yinmodel,zfield,zd)
     END SELECT
     CALL soil_profile_buffer
!
!*      3.4    Water content intercepted on leaves, LAI
!
  CASE('WR     ')
     ALLOCATE(pfield(nni,1,nvegtype))
     pfield(:,:,:) = xwr_def
!
  CASE('LAI    ')
     ALLOCATE(pfield(nni,1,nvegtype))
     pfield(:,:,:) = xundef
!
!
!*      3.5    Other fields
!
  CASE('ZS     ')
!GH
!    CALL READ_BUFFER_ZS_LAND(KLUOUT,YINMODEL,ZFIELD1D)
     CALL read_buffer_zs(kluout,yinmodel,zfield1d)
!END GH
     ALLOCATE(pfield(SIZE(zfield1d,1),1,1))
     pfield(:,1,1)=zfield1d(:)
     DEALLOCATE(zfield1d)
END SELECT
!
!*      4.     Interpolation method
!              --------------------
!
 cinterp_type='BUFFER'
!
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PREP_TEB_GARDEN_BUFFER',1,zhook_handle)
 CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
SUBROUTINE soil_profile_buffer
!-------------------------------------------------------------------------------------
!
REAL, DIMENSION(:,:), ALLOCATABLE :: zout   ! work array
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
     !
     !* interpolation on fine vertical grid
     IF (lhook) CALL dr_hook('SOIL_PROFILE_BUFFER',0,zhook_handle)
     ALLOCATE(zout(SIZE(zfield,1),SIZE(xgrid_soil)))
     CALL interp_grid(zd,zfield,xgrid_soil,zout)
     !
     !* extends definition to all vegtypes.
     ALLOCATE(pfield(SIZE(zfield,1),SIZE(xgrid_soil),nvegtype))
     DO jvegtype=1,nvegtype
       pfield(:,:,jvegtype)=zout(:,:)
     END DO
     !* end
     DEALLOCATE(zout)
     DEALLOCATE(zfield)
     DEALLOCATE(zd)
IF (lhook) CALL dr_hook('SOIL_PROFILE_BUFFER',1,zhook_handle)

END SUBROUTINE soil_profile_buffer
!
!-------------------------------------------------------------------------------------
END SUBROUTINE prep_teb_garden_buffer