prep_isba_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_isba_grib(HPROGRAM,HSURF,HFILE,KLUOUT,PFIELD,OKEY)
!     #################################################################################
!
!!****  *PREP_ISBA_GRIB* - initializes ISBA fields from operational GRIB
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      S. Riette   04/2010 READ_GRIB_WGI_ECMWF interface changed
!!------------------------------------------------------------------
!
USE mode_read_grib
!
USE modd_type_date_surf
!
USE modi_interp_grid_nat
!
USE modd_prep_isba,      ONLY : xgrid_soil, xwr_def, xwrv_def,     &
                                xwrvn_def, xqc_def
USE modd_surf_par,       ONLY : xundef
USE modd_grid_grib,      ONLY : cgrib_file, nni, cinmodel
!
!
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
LOGICAL, OPTIONAL,  INTENT(INOUT) :: OKEY
!
!*      0.2    declarations of local variables
!
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()             ! layer thicknesses
INTEGER                         :: JVEGTYPE       ! loop counter on vegtypes
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
!*      1.     Reading of grid
!              ---------------
!
IF (lhook) CALL dr_hook('PREP_ISBA_GRIB',0,zhook_handle)
!
IF (trim(hfile).NE.cgrib_file) cgrib_file=""
!
 CALL read_grib_land_mask(hfile,kluout,cinmodel,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(cinmodel)
       CASE('ECMWF ')
         IF(PRESENT(okey))okey=.false.
         CALL read_grib_tg_ecmwf(hfile,kluout,cinmodel,zmask,zfield,zd)
       CASE('ARPEGE','ALADIN','MOCAGE')
         CALL read_grib_tg_meteo_france(hfile,kluout,cinmodel,zmask,zfield,zd)
       CASE('HIRLAM')
         CALL read_grib_tg_hirlam(hfile,kluout,cinmodel,zmask,zfield,zd)
     END SELECT
     CALL soil_profile_grib

  CASE('WG    ')
     !* reading of the profile and its depth definition
     SELECT CASE(cinmodel)
       CASE('ECMWF ')
         IF(PRESENT(okey))okey=.false.
         CALL read_grib_wg_ecmwf(hfile,kluout,cinmodel,zmask,zfield,zd)
       CASE('ARPEGE','ALADIN','MOCAGE')
         CALL read_grib_wg_meteo_france(hfile,kluout,cinmodel,zmask,zfield,zd)
       CASE('HIRLAM')
         CALL read_grib_wg_hirlam(hfile,kluout,cinmodel,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(cinmodel)
       CASE('ECMWF ')
         IF(PRESENT(okey))okey=.false.
         CALL read_grib_wgi_ecmwf(hfile,kluout,cinmodel,zmask,zfield,zd)
       CASE('ARPEGE','ALADIN','MOCAGE')
         CALL read_grib_wgi_meteo_france(hfile,kluout,cinmodel,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,1))
     pfield(:,:,:) = xwr_def
!
  CASE('LAI    ')
     ALLOCATE(pfield(nni,1,1))
     pfield(:,:,:) = xundef
!
!
!*      3.5    Other fields
!
  CASE('ZS     ')
     CALL read_grib_zs_land(hfile,kluout,cinmodel,zmask,zfield1d)
     ALLOCATE(pfield(SIZE(zfield1d,1),1,1))
     pfield(:,1,1)=zfield1d(:)
     DEALLOCATE(zfield1d)
!
  CASE('ICE_STO')
     ALLOCATE(pfield(nni,1,1))
     pfield(:,:,:) = 0.0
!
!*      3.6    MEB fields
!
  CASE('WRV    ')
     ALLOCATE(pfield(nni,1,1))
     pfield(:,:,:) = xwrv_def
!
  CASE('WRVN   ')
     ALLOCATE(pfield(nni,1,1))
     pfield(:,:,:) = xwrvn_def
!
  CASE('QC     ')
     ALLOCATE(pfield(nni,1,1))
     pfield(:,:,:) = xqc_def
!
  CASE('TV     ','TC     ')
     !* reading of the profile and its depth definition
     SELECT CASE(cinmodel)
       CASE('ECMWF ')
         IF(PRESENT(okey))okey=.false.
         CALL read_grib_tg_ecmwf(hfile,kluout,cinmodel,zmask,zfield,zd)
       CASE('ARPEGE','ALADIN','MOCAGE')
         CALL read_grib_tg_meteo_france(hfile,kluout,cinmodel,zmask,zfield,zd)
       CASE('HIRLAM')
         CALL read_grib_tg_hirlam(hfile,kluout,cinmodel,zmask,zfield,zd)
     END SELECT
     ALLOCATE(pfield(nni,1,1))
     pfield(:,1,1) =zfield(:,1)
     DEALLOCATE(zfield)
     DEALLOCATE(zd)
!
  CASE DEFAULT
    CALL abor1_sfx('PREP_ISBA_GRIB: '//trim(hsurf)//" initialization not implemented !")
!
END SELECT
!
DEALLOCATE(zmask)
!
!*      4.     Interpolation method
!              --------------------
!
!-------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('PREP_ISBA_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),1))
     pfield(:,:,1)=zout(:,:)
     !* 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_isba_grib