prep_teb_greenroof_grib.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_greenroof_grib(HPROGRAM,HSURF,HFILE,KLUOUT,PFIELD)
!     #################################################################################
!
!!****  *PREP_TEB_GREENROOF_GRIB* - initializes ISBA fields from operational GRIB
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!    Based on "prep_teb_garden_grib"
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!    A. Lemonsu & C. de Munck 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/2011
!!------------------------------------------------------------------
!

!
USE mode_read_grib
!
USE modd_type_date_surf
!
USE modi_prep_grib_grid
USE modi_interp_grid_nat
!
USE modd_prep,               ONLY : cingrid_type, cinterp_type
USE modd_prep_teb_greenroof, ONLY : xgrid_soil, xwr_def
USE modd_data_cover_par,     ONLY : nvegtype
USE modd_surf_par,           ONLY : xundef
USE modd_grid_grib,          ONLY : cgrib_file, nni
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
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
 CHARACTER(LEN=28),  INTENT(IN)  :: hfile     ! name of file
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_grib          ! current date and time
 CHARACTER(LEN=6)                :: yinmodel             ! model from which GRIB file originates
REAL, DIMENSION(:)  , POINTER   :: zmask => null()      ! Land mask
REAL, DIMENSION(:,:), POINTER   :: zfield => null()     ! field read
REAL, DIMENSION(:),   POINTER   :: zfield1d => null()   ! field read
REAL, DIMENSION(:,:), POINTER   :: zd => null()         ! 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_GREENROOF_GRIB',0,zhook_handle)
!
IF (trim(hfile).NE.cgrib_file) cgrib_file=""
!
 CALL prep_grib_grid(hfile,kluout,yinmodel,cingrid_type,tztime_grib)
!
 CALL read_grib_land_mask(hfile,kluout,yinmodel,zmask)
!
!*      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('ECMWF ')
         CALL read_grib_tg_ecmwf(hfile,kluout,yinmodel,zmask,zfield,zd)
       CASE('ARPEGE','ALADIN','MOCAGE')
         CALL read_grib_tg_meteo_france(hfile,kluout,yinmodel,zmask,zfield,zd)
       CASE('HIRLAM')
         CALL read_grib_tg_hirlam(hfile,kluout,yinmodel,zmask,zfield,zd)
     END SELECT
     CALL soil_profile_grib

  CASE('WG    ')
     !* reading of the profile and its depth definition
     SELECT CASE(yinmodel)
       CASE('ECMWF ')
         CALL read_grib_wg_ecmwf(hfile,kluout,yinmodel,zmask,zfield,zd)
       CASE('ARPEGE','ALADIN','MOCAGE')
         CALL read_grib_wg_meteo_france(hfile,kluout,yinmodel,zmask,zfield,zd)
       CASE('HIRLAM')
         CALL read_grib_wg_hirlam(hfile,kluout,yinmodel,zmask,zfield,zd)
     END SELECT
     CALL soil_profile_grib


!*      3.3    Profile of soil ice content

  CASE('WGI   ')    
     !* reading of the profile and its depth definition
     SELECT CASE(yinmodel)
       CASE('ECMWF ')
         CALL read_grib_wgi_ecmwf(hfile,kluout,yinmodel,zmask,zfield,zd)
       CASE('ARPEGE','ALADIN','MOCAGE')
         CALL read_grib_wgi_meteo_france(hfile,kluout,yinmodel,zmask,zfield,zd)
       CASE('HIRLAM')
         CALL read_grib_wgi_hirlam(hfile,kluout,zfield,zd)
     END SELECT
     CALL soil_profile_grib
!
!*      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     ')
     CALL read_grib_zs_land(hfile,kluout,yinmodel,zmask,zfield1d)
     ALLOCATE(pfield(SIZE(zfield1d,1),1,1))
     pfield(:,1,1)=zfield1d(:)
     DEALLOCATE(zfield1d)

  CASE default
     CALL abor1_sfx('PREP_TEB_GREENROOF_GRIB: OPTION NOT SUPPORTED - '//hsurf)

END SELECT
!
DEALLOCATE(zmask)
!
!*      4.     Interpolation method
!              --------------------
!
 cinterp_type='HORIBL'
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PREP_TEB_GREENROOF_GRIB',1,zhook_handle)
 CONTAINS
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
SUBROUTINE soil_profile_grib
!-------------------------------------------------------------------------------------
!
REAL, DIMENSION(:,:), ALLOCATABLE :: zout   ! work array
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
     !
     !* interpolation on fine vertical grid
     IF (lhook) CALL dr_hook('SOIL_PROFILE_GRIB',0,zhook_handle)
     ALLOCATE(zout(SIZE(zfield,1),SIZE(xgrid_soil)))
     CALL interp_grid_nat(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_GRIB',1,zhook_handle)

END SUBROUTINE soil_profile_grib
!
!-------------------------------------------------------------------------------------
END SUBROUTINE prep_teb_greenroof_grib