mode_read_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.
MODULE mode_read_buffer
!     #####################
!-------------------------------------------------------------------
!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
 CONTAINS
!-------------------------------------------------------------------
!     ####################
      SUBROUTINE read_buffer_land_mask(KLUOUT,HINMODEL,PMASK)
!     ####################
!
USE modd_grid_buffer, ONLY : nni
!
USE modi_read_buffer
!
INTEGER,            INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),   INTENT(IN)    :: hinmodel  ! originating model
REAL, DIMENSION(:), POINTER       :: pmask     ! Land mask
!
INTEGER                           :: iret      ! return code
REAL, DIMENSION(:), POINTER       :: zfield    ! field read
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_LAND_MASK',0,zhook_handle)
WRITE (kluout,'(A)') ' | Reading land mask'
SELECT CASE (hinmodel)
 CASE ('ALADIN')
ALLOCATE (zfield(nni))
    CALL read_buffer('LSM   ',zfield,iret)
END SELECT
IF (iret /= 0) THEN
  CALL abor1_sfx('MODE_READ_BUFFER: LAND SEA MASK MISSING')
END IF
!
ALLOCATE (pmask(nni))
WHERE (zfield>0.5)
  pmask = 1.
ELSEWHERE
  pmask = 0.
END WHERE
DEALLOCATE (zfield)
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_LAND_MASK',1,zhook_handle)
!
END SUBROUTINE read_buffer_land_mask
!-------------------------------------------------------------------
!     ############################
      SUBROUTINE read_buffer_zs_land(KLUOUT,HINMODEL,PFIELD)
!     ############################
!
USE modd_surf_par,   ONLY : xundef
USE modd_csts,       ONLY : xg
USE modd_grid_buffer,  ONLY : nni
!
USE modi_read_buffer
!
INTEGER,            INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),   INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:), POINTER       :: pfield    ! 
!
INTEGER                           :: iret      ! return code
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------
!
!* Read orography
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_ZS_LAND',0,zhook_handle)
WRITE (kluout,'(A)') ' | Reading land orography'
SELECT CASE (hinmodel)
 CASE ('ALADIN')
   ALLOCATE (pfield(nni))
   CALL read_buffer('LPHIS ',pfield,iret)
END SELECT
!
IF (iret /= 0) THEN
  CALL abor1_sfx('MODE_READ_BUFFER: LAND OROGRAPHY MISSING')
END IF
!
! Datas given in archives are multiplied by the gravity acceleration
pfield = pfield / xg
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_ZS_LAND',1,zhook_handle)
!
!
END SUBROUTINE read_buffer_zs_land
!-------------------------------------------------------------------
!     ############################
      SUBROUTINE read_buffer_zs_sea(KLUOUT,HINMODEL,PFIELD)
!     ############################
!
USE modd_surf_par,   ONLY : xundef
USE modd_csts,       ONLY : xg
USE modd_grid_buffer,  ONLY : nni
!
USE modi_read_buffer
!
INTEGER,            INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),   INTENT(IN)    :: hinmodel  ! Buffer originating model
REAL, DIMENSION(:), POINTER       :: pfield    ! 
!
INTEGER                           :: iret      ! return code
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------
!
!* Read orography
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_ZS_SEA',0,zhook_handle)
WRITE (kluout,'(A)') ' | Reading sea orography in buffer'
SELECT CASE (hinmodel)
 CASE ('ALADIN')
   ALLOCATE (pfield(nni))
   CALL read_buffer('SPHIS ',pfield,iret)
END SELECT
!
IF (iret /= 0) THEN
  CALL abor1_sfx('MODE_READ_BUFFER: SEA OROGRAPHY MISSING')
END IF
!
! Datas given in archives are multiplied by the gravity acceleration
pfield = pfield / xg
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_ZS_SEA',1,zhook_handle)
!
!
END SUBROUTINE read_buffer_zs_sea
!
!-------------------------------------------------------------------
!     ############################
      SUBROUTINE read_buffer_zs(KLUOUT,HINMODEL,PFIELD)
!     ############################
!
USE modd_surf_par,   ONLY : xundef
USE modd_csts,       ONLY : xg
USE modd_grid_buffer,  ONLY : nni
!
USE modi_read_buffer
!
INTEGER,            INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),   INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:), POINTER       :: pfield    ! 
!
INTEGER                           :: iret      ! return code
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------
!
!* Read orography
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_ZS',0,zhook_handle)
WRITE (kluout,'(A)') ' | Reading orography'
SELECT CASE (hinmodel)
 CASE ('ALADIN')
   ALLOCATE (pfield(nni))
   CALL read_buffer('PHIS  ',pfield,iret)
END SELECT
!
IF (iret /= 0) THEN
  CALL abor1_sfx('MODE_READ_BUFFER: OROGRAPHY MISSING')
END IF
!
! Datas given in archives are multiplied by the gravity acceleration
pfield = pfield / xg
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_ZS',1,zhook_handle)
!
END SUBROUTINE read_buffer_zs
!
!     ###########################
      SUBROUTINE read_buffer_ts(KLUOUT,HINMODEL,PFIELD)
!     ###########################
!
USE modd_surf_par,   ONLY : xundef
USE modd_grid_buffer,  ONLY : nni
!
USE modi_read_buffer
!
INTEGER,            INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),   INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:), POINTER       :: pfield    ! 
!
INTEGER                           :: iret      ! return code
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------
!
!* Read surface temperature
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_TS',0,zhook_handle)
WRITE (kluout,'(A)') ' | Reading surface temperature'
!
SELECT CASE (hinmodel)
 CASE ('ALADIN')
   ALLOCATE (pfield(nni))
   CALL read_buffer('TG1   ',pfield,iret)
END SELECT
IF (iret /= 0) THEN
  CALL abor1_sfx('MODE_READ_BUFFER: SURFACE TEMPERATURE MISSING')
END IF
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_TS',1,zhook_handle)
!
END SUBROUTINE read_buffer_ts
!
!-------------------------------------------------------------------
!     ###########################
      SUBROUTINE read_buffer_sst(KLUOUT,HINMODEL,PFIELD)
!     ###########################
!
USE modd_surf_par,   ONLY : xundef
USE modd_grid_buffer,  ONLY : nni
!
USE modi_read_buffer
!
INTEGER,            INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),   INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:), POINTER       :: pfield    ! 
!
INTEGER                           :: iret      ! return code
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------
!
!* Read surface temperature
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_SST',0,zhook_handle)
WRITE (kluout,'(A)') ' | Reading sea surface temperature'
!
SELECT CASE (hinmodel)
 CASE ('ALADIN')
   ALLOCATE (pfield(nni))
   CALL read_buffer('SST   ',pfield,iret)
!
END SELECT
!
IF (iret /= 0) THEN
  CALL abor1_sfx('MODE_READ_BUFFER: SEA SURFACE TEMPERATURE MISSING')
END IF
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_SST',1,zhook_handle)
!
END SUBROUTINE read_buffer_sst
!
!-------------------------------------------------------------------
!     ###########################
      SUBROUTINE read_buffer_t2(KLUOUT,HINMODEL,PFIELD)
!     ###########################
!
USE modd_surf_par,   ONLY : xundef
USE modd_grid_buffer,  ONLY : nni
!
USE modi_read_buffer
!
INTEGER,            INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),   INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:), POINTER       :: pfield    ! 
!
INTEGER                           :: iret      ! return code
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------
!
!* Read surface temperature
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_T2',0,zhook_handle)
WRITE (kluout,'(A)') ' | Reading deep soil temperature'
!
SELECT CASE (hinmodel)

 CASE ('ALADIN')
   ALLOCATE (pfield(nni))
   CALL read_buffer('TG2   ',pfield,iret)
END SELECT
!
IF (iret /= 0) THEN
  CALL abor1_sfx('MODE_READ_BUFFER: DEEP SOIL TEMPERATURE MISSING')
END IF
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_T2',1,zhook_handle)
!
!
END SUBROUTINE read_buffer_t2
!
!     #######################
      SUBROUTINE read_buffer_wg(KLUOUT,HINMODEL,PFIELD,PD)
!     #######################
!
! This tasks is divided in the following steps :
!  - computing the MesoNH constants
!  - reading the grib datas according to the type of file (ECMWF/Arpege/Aladin)
!  - converting from specific humidity to relative humidity
!  - interpolation with land mask
!  - converting back from relative humidity to specific humidity with MesoNH constants
! Five different models are supported :
!  - ECMWF with 2 layers (untested)
!  - ECMWF with 3 layers (archive before 1991 - Blondin model)
!  - ECMWF with 4 layers (archive after 1991 - Viterbo model)
!  - Arpege/Aladin before ISBA (I don't know the name of this model)
!  - Arpege/Aladin with ISBA model
! The available model is detect according to the fields which are presents :
!  - ECMWF archive : loads as many layers as possible
!  - Arpege/Aladin archive : ISBA model needs Clay and Sans fraction fields, if they
!    are present, they are used and the model is declared to be ISBA.
! To detect the height of the layers, two methods are used :
!  - if level type is not 112, a default value is assumed and a warning message is
!    displayed
!  - if level type is ID 112, then the position of the top and bottom surface may be
!    given. If they are present, they are used, if not the default value is taken and
!    a warning message is issued.
!
USE modd_grid_buffer,  ONLY : nni
USE modd_surf_par,   ONLY : xundef
!
USE modi_read_buffer
!
IMPLICIT NONE
!
!* dummy arguments
!  ---------------
!
INTEGER,              INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),     INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:,:), POINTER       :: pfield    ! field to initialize
REAL, DIMENSION(:,:), POINTER       :: pd        ! thickness of each layer
!
!
!* local variables
!  ---------------
!
LOGICAL                           :: gisba     ! T: surface scheme in file is ISBA
INTEGER                           :: iret      ! return code
REAL,    DIMENSION(:), POINTER    :: zfield    ! field to read
REAL,  DIMENSION(:,:), ALLOCATABLE:: zwg       ! profile of soil water contents
REAL,  DIMENSION(:),   ALLOCATABLE:: zclay     ! clay fraction
REAL,  DIMENSION(:),   ALLOCATABLE:: zsand     ! sand fraction
REAL,  DIMENSION(:),   ALLOCATABLE:: zwwilt     ! wilting point
REAL,  DIMENSION(:),   ALLOCATABLE:: zwfc       ! field capacity
REAL,  DIMENSION(:),   ALLOCATABLE:: zwsat      ! saturation
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
! 1.  Search and read clay fraction if available
!     ------------------------------------------
!
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_WG',0,zhook_handle)
ALLOCATE (zfield(nni))
 CALL read_buffer('CLAY  ',zfield,iret)
!
! if not available, the model is not ISBA
IF (iret /= 0) THEN
  gisba = .false.
ELSE
  gisba = .true.
  WRITE (kluout,'(A)') ' | The soil model is ISBA'
  ALLOCATE (zclay(nni))
  zclay(:) = zfield(:) / 100. ! this field is given in percent
  DEALLOCATE (zfield)
END IF
!
!-------------------------------------------------------------------------------
!
! 2.  Search and read sand fraction if available
!     ------------------------------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer('SAND  ',zfield,iret)
!
! if not available, the model is not ISBA (IWMODE=1)
IF (gisba) THEN
  IF (iret /= 0) THEN
    CALL abor1_sfx('MODE_READ_BUFFER: (WG) SAND FRACTION MISSING')
  ELSE
    ALLOCATE (zsand(nni))
    zsand(:) = zfield(:) / 100. ! this field is given in percent
    DEALLOCATE (zfield)
  END IF
END IF
!
!-------------------------------------------------------------------------------
!
! 3.  Read layer 1 moisture
!     ---------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer('WG1   ',zfield,iret)
IF (iret /= 0) THEN
  CALL abor1_sfx('MODE_READ_BUFFER: SOIL MOISTURE LEVEL 1 MISSING')
END IF
!
ALLOCATE(zwg(nni,2))
zwg(:,1) = zfield(:)
DEALLOCATE(zfield)
!
!-------------------------------------------------------------------------------
!
! 4.  Read layer 2 moisture
!     ---------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer('WG2   ',zfield,iret)
IF (iret /= 0) THEN
  CALL abor1_sfx('MODE_READ_BUFFER: SOIL MOISTURE LEVEL 2 MISSING')
END IF
!
zwg(:,2) = zfield(:)
DEALLOCATE(zfield)
!
!-------------------------------------------------------------------------------
!
! 5.  Read layer 2 depth (ISBA only)
!     ------------------
!
ALLOCATE(pd(nni,3))
!
!* note that soil water reservoir is considered uniform between 0.2m and BUFFER soil depth
IF (gisba) THEN
  ALLOCATE (zfield(nni))
  CALL read_buffer('D2    ',zfield,iret)
  IF (iret /= 0) THEN
    CALL abor1_sfx('MODE_READ_BUFFER: LEVEL 2 DEPTH MISSING')
  END IF
  pd(:,1) = 0.01
  pd(:,2) = 0.20
  pd(:,3) = zfield(:)
  !
  !* updates Wg in m3/m3
  !
  zwg(:,1) = zwg(:,1) / 10.
  zwg(:,2) = zwg(:,2) /(1000. * zfield(:))
  DEALLOCATE(zfield)
ELSE
  pd(:,1) = 0.01
  pd(:,2) = 0.2
  pd(:,3) = 2.0
END IF
!
!
!-------------------------------------------------------------------------------
!
! 6.  Compute relative humidity from units kg/m^2
!     -------------------------------------------
!
ALLOCATE(pfield(nni,3))
!
! Compute ISBA model constants (if needed)
!
IF (gisba) THEN
  ALLOCATE (zwfc(nni))
  ALLOCATE (zwwilt(nni))
  ALLOCATE (zwsat(nni))
  !
  zwsat(:) = (-1.08*100. * zsand(:) + 494.305) * 0.001
  zwwilt(:) = 37.1342e-3 * sqrt( 100. * zclay(:) )
  zwfc(:) = 89.0467e-3 * (100. * zclay(:) )**0.3496
  !
  DEALLOCATE (zsand)
  DEALLOCATE (zclay)

  zwg(:,1) = max(min(zwg(:,1),zwsat),0.)
  zwg(:,2) = max(min(zwg(:,2),zwsat),0.)
  !
  pfield(:,1) = (zwg(:,1) - zwwilt) / (zwfc - zwwilt)
  pfield(:,2) = (zwg(:,2) - zwwilt) / (zwfc - zwwilt)
  pfield(:,3) = pfield(:,2)
  DEALLOCATE (zwsat)
  DEALLOCATE (zwwilt)
  DEALLOCATE (zwfc)
  !
ELSE ! Non ISBA
  pfield(:,1) =  zwg(:,1)           /  20.
  pfield(:,2) = (zwg(:,1)+zwg(:,2)) / (20. + 100.)
  pfield(:,3) = pfield(:,2)
END IF
!
DEALLOCATE(zwg)
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_WG',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_buffer_wg
!
!-------------------------------------------------------------------
!
!     #######################
      SUBROUTINE read_buffer_wgi(KLUOUT,HINMODEL,PFIELD,PD)
!     #######################
!
! This tasks is divided in the following steps :
!  - computing the MesoNH constants
!  - reading the grib datas according to the type of file (ECMWF/Arpege/Aladin)
!  - converting from specific humidity to relative humidity
!  - interpolation with land mask
!  - converting back from relative humidity to specific humidity with MesoNH constants
! Five different models are supported :
!  - ECMWF with 2 layers (untested)
!  - ECMWF with 3 layers (archive before 1991 - Blondin model)
!  - ECMWF with 4 layers (archive after 1991 - Viterbo model)
!  - Arpege/Aladin before ISBA (I don't know the name of this model)
!  - Arpege/Aladin with ISBA model
! The available model is detect according to the fields which are presents :
!  - ECMWF archive : loads as many layers as possible
!  - Arpege/Aladin archive : ISBA model needs Clay and Sans fraction fields, if they
!    are present, they are used and the model is declared to be ISBA.
! To detect the height of the layers, two methods are used :
!  - if level type is not 112, a default value is assumed and a warning message is
!    displayed
!  - if level type is ID 112, then the position of the top and bottom surface may be
!    given. If they are present, they are used, if not the default value is taken and
!    a warning message is issued.
!
USE modd_grid_buffer,  ONLY : nni
USE modd_surf_par,   ONLY : xundef
!
USE modi_read_buffer
!
IMPLICIT NONE
!
!* dummy arguments
!  ---------------
!
INTEGER,              INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),     INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:,:), POINTER       :: pfield    ! field to initialize
REAL, DIMENSION(:,:), POINTER       :: pd        ! thickness of each layer
!
!
!* local variables
!  ---------------
!
LOGICAL                           :: gisba     ! T: surface scheme in file is ISBA
INTEGER                           :: iret      ! return code
REAL,    DIMENSION(:), POINTER    :: zfield    ! field to read
REAL,  DIMENSION(:,:), ALLOCATABLE:: zwgi      ! profile of soil ice contents
REAL,  DIMENSION(:),   ALLOCATABLE:: zclay     ! clay fraction
REAL,  DIMENSION(:),   ALLOCATABLE:: zsand     ! sand fraction
REAL,  DIMENSION(:),   ALLOCATABLE:: zwwilt     ! wilting point
REAL,  DIMENSION(:),   ALLOCATABLE:: zwfc       ! field capacity
REAL,  DIMENSION(:),   ALLOCATABLE:: zwsat      ! saturation
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
! 1.  Search and read clay fraction if available
!     ------------------------------------------
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_WGI',0,zhook_handle)
ALLOCATE (zfield(nni))
 CALL read_buffer('CLAY  ',zfield,iret)
!
! if not available, the model is not ISBA (IWMODE=1)
IF (iret /= 0) THEN
  gisba = .false.
ELSE
  gisba = .true.
  WRITE (kluout,'(A)') ' | The soil model is ISBA'
  ALLOCATE (zclay(nni))
  zclay(:) = zfield(:) / 100. ! this field is given in percent
  DEALLOCATE (zfield)
END IF
!
!-------------------------------------------------------------------------------
!
! 2.  Search and read sand fraction if available
!     ------------------------------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer('SAND  ',zfield,iret)
!
! if not available, the model is not ISBA (IWMODE=1)
IF (gisba) THEN
  IF (iret /= 0) THEN
    CALL abor1_sfx('MODE_READ_BUFFER: (WGI) SAND FRACTION MISSING')
  ELSE
    ALLOCATE (zsand(nni))
    zsand(:) = zfield(:) / 100. ! this field is given in percent
    DEALLOCATE (zfield)
  END IF
END IF
!
!-------------------------------------------------------------------------------
!
! 3.  Allocate soil ice reservoir
!     ---------------------------
!
ALLOCATE(zwgi(nni,2))
!
!-------------------------------------------------------------------------------
!
! 4.  Read layer 1 soil ice
!     ---------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer('WGI1  ',zfield,iret)
IF (iret == 0) THEN
  WRITE (kluout,'(A)') ' -> Soil ice level 1 is present'
  zwgi(:,1) = zfield(:)
  DEALLOCATE(zfield)
ELSE
  zwgi(:,1) = 0.
END IF
!
!
!-------------------------------------------------------------------------------
!
! 5.  Read layer 2 soil ice
!     ---------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer('WGI2  ',zfield,iret)
IF (iret == 0) THEN
  WRITE (kluout,'(A)') ' -> Soil ice level 2 is present'
  zwgi(:,2) = zfield(:)
  DEALLOCATE(zfield)
ELSE
  zwgi(:,2) = 0.
END IF
!
!
!-------------------------------------------------------------------------------
!
! 5.  Read layer 2 depth (ISBA only)
!     ------------------
!
ALLOCATE(pd(nni,3))
!
IF (gisba) THEN
  ALLOCATE (zfield(nni))
  CALL read_buffer('D2    ',zfield,iret)
  IF (iret /= 0) THEN
    CALL abor1_sfx('MODE_READ_BUFFER: LEVEL 2 DEPTH FOR ICE MISSING')
  END IF
  pd(:,1) = 0.01
  pd(:,2) = 0.20
  pd(:,3) = zfield(:)
  !
  !* updates Wgi in m3/m3
  !
  zwgi(:,1) = zwgi(:,1) / 10.
  zwgi(:,2) = zwgi(:,2) /(1000. * zfield(:))
  DEALLOCATE(zfield)
ELSE
  pd(:,1) = 0.01
  pd(:,2) = 0.20
  pd(:,3) = 2.0
END IF
!
!
!-------------------------------------------------------------------------------
!
! 6.  Compute relative humidity from units kg/m^2
!     -------------------------------------------
!
ALLOCATE(pfield(nni,3))
!
! Compute ISBA model constants (if needed)
!
IF (gisba) THEN
  ALLOCATE (zwfc(nni))
  ALLOCATE (zwwilt(nni))
  ALLOCATE (zwsat(nni))
  !
  zwsat(:) = (-1.08*100. * zsand(:) + 494.305) * 0.001
  zwwilt(:) = 37.1342e-3 * sqrt( 100. * zclay(:) )
  zwfc(:) = 89.0467e-3 * (100. * zclay(:) )**0.3496
  !
  DEALLOCATE (zsand)
  DEALLOCATE (zclay)

  zwgi(:,1) = max(min(zwgi(:,1),zwsat),0.)
  zwgi(:,2) = max(min(zwgi(:,2),zwsat),0.)
  !
  pfield(:,1) = zwgi(:,1) / zwsat
  pfield(:,2) = zwgi(:,2) / zwsat
  pfield(:,3) = pfield(:,2)
  DEALLOCATE (zwsat)
  DEALLOCATE (zwwilt)
  DEALLOCATE (zwfc)
  !
ELSE ! Non ISBA
  pfield(:,1) = 0.
  pfield(:,2) = 0.
  pfield(:,3) = 0.
END IF
!
DEALLOCATE(zwgi)
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_WGI',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_buffer_wgi
!
!-------------------------------------------------------------------
!
!     #######################
      SUBROUTINE read_buffer_tg(KLUOUT,HINMODEL,PFIELD,PD)
!     #######################
!
!
USE modd_grid_buffer,  ONLY : nni
USE modd_surf_par,   ONLY : xundef
!
USE modi_read_buffer
!
IMPLICIT NONE
!
!* dummy arguments
!  ---------------
!
INTEGER,              INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),     INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:,:), POINTER       :: pfield    ! field to initialize
REAL, DIMENSION(:,:), POINTER       :: pd        ! thickness of each layer
!
!
!* local variables
!  ---------------
!
REAL,    DIMENSION(:), POINTER    :: zfield    ! field to read
REAL(KIND=JPRB) :: zhook_handle
!
!--------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_TG',0,zhook_handle)
WRITE  (kluout,'(A)') ' | Reading soil temperature'
!
!--------------------------------------------------------------------------------
!
! 1.  Allocate soil temperature profile
!     ---------------------------------
!
ALLOCATE(pfield(nni,3))
ALLOCATE(pd(nni,3))
!
!--------------------------------------------------------------------------------
!
! 2.  Search and read level 1 (and its depth)
!     -----------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer_ts(kluout,hinmodel,zfield)
!
pfield(:,1) = zfield(:)
pd(:,1) = 0.01
DEALLOCATE(zfield)
!
!--------------------------------------------------------------------------------
!
! 3.  Deep soil temperature
!     ---------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer_t2(kluout,hinmodel,zfield)
!
pfield(:,2) = zfield(:)
pd(:,2) = 0.4         ! deep temperature depth assumed equal to 0.2m
DEALLOCATE(zfield)
!
!--------------------------------------------------------------------------------
!
! 4.  Assumes uniform temperature profile below
!     -----------------------------------------
!
pfield(:,3) = pfield(:,2)
pd(:,3) = 5.          ! temperature profile down to 5m
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_TG',1,zhook_handle)
!
!
!--------------------------------------------------------------------------------
!
END SUBROUTINE read_buffer_tg
!-------------------------------------------------------------------
!---------------------------------------------------------------------------------------
!
!     #######################
      SUBROUTINE read_buffer_snow_veg_depth(KLUOUT,HINMODEL,PFIELD)
!     #######################
!
!
USE modd_grid_buffer,  ONLY : nni
USE modd_surf_par,   ONLY : xundef
USE modd_snow_par,   ONLY : xrhosmax
!
USE modi_read_buffer
!
IMPLICIT NONE
!
!* dummy arguments
!  ---------------
!
INTEGER,              INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),     INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:),   POINTER       :: pfield    ! field to initialize
!
!
!* local variables
!  ---------------
!
INTEGER                           :: iret      ! return code
REAL(KIND=JPRB) :: zhook_handle

!
!--------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_SNOW_VEG_DEPTH',0,zhook_handle)
WRITE  (kluout,'(A)') ' | Reading snow depth'
!
!--------------------------------------------------------------------------------
!
! 1.  Allocate soil temperature profile
!     ---------------------------------
!
ALLOCATE(pfield(nni))
!
!--------------------------------------------------------------------------------
!
! 2.  Search and read level 1 (kg/m2)
!     -----------------------
!
 CALL read_buffer('SNOW  ',pfield,iret)
!
! conversion to snow depth (meters)
!
  pfield = pfield / xrhosmax
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_SNOW_VEG_DEPTH',1,zhook_handle)
!
!--------------------------------------------------------------------------------
!
END SUBROUTINE read_buffer_snow_veg_depth
!-------------------------------------------------------------------
!-------------------------------------------------------------------
!---------------------------------------------------------------------------------------
!
!     #######################
      SUBROUTINE read_buffer_snow_veg(KLUOUT,HINMODEL,PFIELD)
!     #######################
!
!
USE modd_grid_buffer,  ONLY : nni
USE modd_surf_par,   ONLY : xundef
USE modd_snow_par,   ONLY : xrhosmax
!
USE modi_read_buffer
!
IMPLICIT NONE
!
!* dummy arguments
!  ---------------
!
INTEGER,              INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),     INTENT(IN)    :: hinmodel  ! Grib originating model
REAL, DIMENSION(:),   POINTER       :: pfield    ! field to initialize
!
!
!* local variables
!  ---------------
!
INTEGER                           :: iret      ! return code
REAL(KIND=JPRB) :: zhook_handle

!
!--------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_SNOW_VEG',0,zhook_handle)
WRITE  (kluout,'(A)') ' | Reading snow content (kg/m2)'
!
!--------------------------------------------------------------------------------
!
! 1.  Allocate soil temperature profile
!     ---------------------------------
!
ALLOCATE(pfield(nni))
!
!--------------------------------------------------------------------------------
!
! 2.  Search and read level 1 (and its depth)
!     -----------------------
!
 CALL read_buffer('SNOW  ',pfield,iret)
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_SNOW_VEG',1,zhook_handle)
!
!
!--------------------------------------------------------------------------------
!
END SUBROUTINE read_buffer_snow_veg
!-------------------------------------------------------------------
!-------------------------------------------------------------------
!---------------------------------------------------------------------------------------
!
!     #######################
      SUBROUTINE read_buffer_t_teb(KLUOUT,HINMODEL,PTI,PFIELD,PD)
!     #######################
!
!
USE modd_grid_buffer,  ONLY : nni
USE modd_surf_par,   ONLY : xundef
!
IMPLICIT NONE
!
!* dummy arguments
!  ---------------
!
INTEGER,              INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),     INTENT(IN)    :: hinmodel  ! Grib originating model
REAL,                 INTENT(IN)    :: pti       ! internal temperature
REAL, DIMENSION(:,:), POINTER       :: pfield    ! field to initialize
REAL, DIMENSION(:,:), POINTER       :: pd        ! normalized grid
!
!
!* local variables
!  ---------------
!
REAL,    DIMENSION(:), POINTER    :: zfield    ! field to read
REAL(KIND=JPRB) :: zhook_handle
!
!--------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_T_TEB',0,zhook_handle)
WRITE  (kluout,'(A)') ' | Reading temperature for buildings'
!
!--------------------------------------------------------------------------------
!
! 1.  Allocate soil temperature profile
!     ---------------------------------
!
ALLOCATE(pfield(nni,3))
ALLOCATE(pd(nni,3))
!
!--------------------------------------------------------------------------------
!
! 2.  Search and read level 1
!     -----------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer_ts(kluout,hinmodel,zfield)
!
pfield(:,1) = zfield(:)
pd(:,1) = 0.
DEALLOCATE(zfield)
!
!--------------------------------------------------------------------------------
!
! 3.  Deep temperature
!     ----------------
!
pfield(:,2) = pti
pd(:,2) = 0.5         ! deep temperature depth assumed at half of wall or roof
!
!--------------------------------------------------------------------------------
!
! 4.  Assumes uniform temperature profile below
!     -----------------------------------------
!
pfield(:,3) = pti
pd(:,3) = 1.          ! temperature at building interior
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_T_TEB',1,zhook_handle)
!
!
!--------------------------------------------------------------------------------
!
END SUBROUTINE read_buffer_t_teb
!-------------------------------------------------------------------
!
!     #######################
      SUBROUTINE read_buffer_tf_teb(KLUOUT,HINMODEL,PTI,PFIELD,PD)
!     #######################
!
!
USE modd_grid_buffer,  ONLY : nni
USE modd_surf_par,   ONLY : xundef
!
USE modi_read_buffer
!
IMPLICIT NONE
!
!* dummy arguments
!  ---------------
!
INTEGER,              INTENT(IN)    :: kluout    ! logical unit of output listing
 CHARACTER(LEN=6),     INTENT(IN)    :: hinmodel  ! Grib originating model
REAL,                 INTENT(IN)    :: pti       ! internal temperature
REAL, DIMENSION(:,:), POINTER       :: pfield    ! field to initialize
REAL, DIMENSION(:,:), POINTER       :: pd        ! thickness of each layer
!
!
!* local variables
!  ---------------
!
REAL,    DIMENSION(:), POINTER    :: zfield    ! field to read
REAL(KIND=JPRB) :: zhook_handle
!
!--------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_TF_TEB',0,zhook_handle)
WRITE  (kluout,'(A)') ' | Reading soil temperature'
!
!--------------------------------------------------------------------------------
!
! 1.  Allocate soil temperature profile
!     ---------------------------------
!
ALLOCATE(pfield(nni,3))
ALLOCATE(pd(nni,3))
!
!--------------------------------------------------------------------------------
!
! 2.  use building internal temperature as first level
!     -----------------------
!
ALLOCATE (zfield(nni))
!
pfield(:,1) = pti
pd(:,1) = 0.
DEALLOCATE(zfield)
!
!--------------------------------------------------------------------------------
!
! 3.  Deep soil temperature
!     ---------------------
!
ALLOCATE (zfield(nni))
 CALL read_buffer_t2(kluout,hinmodel,zfield)
!
pfield(:,2) = zfield(:)
pd(:,2) = 0.5         ! deep temperature depth assumed at half of the floor
DEALLOCATE(zfield)
!
!--------------------------------------------------------------------------------
!
! 4.  Assumes uniform temperature profile below
!     -----------------------------------------
!
pfield(:,3) = pfield(:,2)
pd(:,3) = 1.          ! temperature profile down to depth of the floor
!
!
IF (lhook) CALL dr_hook('MODE_READ_BUFFER:READ_BUFFER_TF_TEB',1,zhook_handle)
!
!--------------------------------------------------------------------------------
!
END SUBROUTINE read_buffer_tf_teb
!-------------------------------------------------------------------
END MODULE mode_read_buffer