prep_teb_greenroof_extern.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_extern (DTCO, IO, U, GCP, &
                                      HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,KPATCH,PFIELD)
!     #################################################################################
!
!!****  *PREP_TEB_GREENROOF_EXTERN* - initializes ISBA fields from operational GRIB
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!    Based on "prep_teb_garden_extern"
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!    A. Lemonsu & C. de Munck 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/2011
!!------------------------------------------------------------------
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_grid_conf_proj_n, ONLY : grid_conf_proj_t
!
USE modd_surfex_mpi, ONLY : nrank, npio
!
USE mode_read_extern
!
USE modd_type_date_surf
!
USE modi_prep_grid_extern
USE modi_read_surf
USE modi_interp_grid_nat
USE modi_open_aux_io_surf
USE modi_close_aux_io_surf
USE modi_read_teb_patch
USE modi_town_presence
USE modi_make_choice_array
!
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 yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_put_on_all_vegtypes
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(grid_conf_proj_t),INTENT(INOUT) :: GCP
!
 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
 CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file
 CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file
 CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file
INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing
INTEGER,            INTENT(IN)  :: KPATCH
REAL,DIMENSION(:,:,:), POINTER  :: PFIELD    ! field to interpolate horizontally (on final soil grid)
!
!*      0.2    declarations of local variables
!
 CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
INTEGER           :: IRESP          ! reading return code
INTEGER           :: INI            ! total 1D dimension
INTEGER           :: IPATCH         ! number of patch
!
REAL, DIMENSION(:,:,:), POINTER     :: ZFIELD         ! field read on initial MNH vertical soil grid, all patches
REAL, DIMENSION(:,:),   POINTER     :: ZFIELD1        ! field read on initial MNH vertical soil grid, one patch
REAL, DIMENSION(:,:,:), POINTER     :: ZD             ! depth of field in the soil
REAL, DIMENSION(:,:), POINTER       :: ZD1            ! depth of field in the soil, one patch
REAL, DIMENSION(:,:), ALLOCATABLE   :: ZOUT           !
 CHARACTER(LEN=12)                   :: YSURF          ! type of field
 CHARACTER(LEN=3)                    :: YPATCH         ! indentificator for TEB patch
INTEGER                             :: JPATCH         ! loop counter for patch
INTEGER                             :: ITEB_PATCH     ! number of TEB patches in file
INTEGER                             :: IVERSION       ! SURFEX version
INTEGER                             :: IBUGFIX        ! SURFEX bug version
LOGICAL                         :: GTEB           ! flag if TEB fields are present
LOGICAL                         :: GOLD_NAME      ! old name flag for temperatures 
LOGICAL                         :: GGREENROOF     ! T if gardens are present in the file
LOGICAL                         :: GDIM
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!------------------------------------------------------------------------------
!
!*      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.
!
IF (lhook) CALL dr_hook('PREP_TEB_GREENROOF_EXTERN',0,zhook_handle)
!
 CALL open_aux_io_surf(hfilepgd,hfilepgdtype,'FULL  ')
!
!* reading of version of the file being read
 CALL read_surf(hfilepgdtype,'VERSION',iversion,iresp)
 CALL read_surf(hfilepgdtype,'BUG',ibugfix,iresp)
gold_name=(iversion<7 .OR. (iversion==7 .AND. ibugfix<3))
!
!------------------------------------------------------------------------------
!
!*      2.     Reading of grid
!              ---------------
!
 CALL prep_grid_extern(gcp,hfilepgdtype,kluout,cingrid_type,cinterp_type,ini)
!
IF (nrank/=npio) ini = 0
!
!* reads if TEB fields exist in the input file
 CALL town_presence(hfilepgdtype,gteb,hdir='-')
!
IF (gteb) THEN
  CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
  CALL open_aux_io_surf(hfilepgd,hfilepgdtype,'TOWN  ')
  CALL read_teb_patch(hfilepgd,hfilepgdtype,iversion,ibugfix,iteb_patch,hdir='-')
  ypatch='   '
  IF (iteb_patch>1) THEN
    WRITE(ypatch,fmt='(A,I1,A)') 'T',min(kpatch,iteb_patch),'_'
  END IF
END IF
!
 CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
!
! A FAIRE : VERIFIER QUE LES MODIFS DES PATCH/GTEB/GGREENROOF SONT CORRECTES
!---------------------------------------------------------------------------------------
!
!*      3.     Transformation into physical quantity to be interpolated
!              --------------------------------------------------------
!
SELECT CASE(hsurf)
!
!*     3.      Orography
!              ---------
!
  CASE('ZS     ')
    ALLOCATE(pfield(ini,1,1))
    yrecfm='ZS'
    CALL open_aux_io_surf(hfilepgd,hfilepgdtype,'TOWN  ')
    CALL read_surf(hfilepgdtype,yrecfm,pfield(:,1,1),iresp,hdir='A')
    CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
!
!--------------------------------------------------------------------------
!
!
!*      3.1    Profile of temperature, water or ice in the soil
!
  CASE('TG    ','WG    ','WGI   ')
!* choice if one reads garden fields (if present) or ISBA fields
    CALL open_aux_io_surf(hfilepgd,hfilepgdtype,'TOWN  ')
    ggreenroof = .false.
    IF (gteb) CALL read_surf(hfilepgdtype,'LGREENROOF',ggreenroof,iresp,hdir='-')
    CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
    IF (ggreenroof) THEN
      ysurf = 'GR_'//hsurf(1:3)  
      ysurf=ypatch//ysurf      
    ELSE
      ysurf = hsurf
    END IF
    ysurf=adjustl(ysurf)
!* reading of the profile and its depth definition
     CALL read_extern_isba(u, dtco, gcp, io, hfile,hfiletype,hfilepgd,hfilepgdtype,kluout,ini,&
                           hsurf,ysurf,zfield,zd)
! 
     IF (nrank==npio) THEN

       ALLOCATE(zfield1(SIZE(zfield,1),SIZE(zfield,2)))
       ALLOCATE(zd1(SIZE(zfield,1),SIZE(zfield,2)))
       ALLOCATE(zout(SIZE(zfield,1),SIZE(xgrid_soil)))
       ALLOCATE(pfield(SIZE(zfield,1),SIZE(xgrid_soil),SIZE(zfield,3)))
       DO jpatch=1,SIZE(zfield,3)
         zfield1(:,:)=zfield(:,:,jpatch)
         zd1(:,:)=zd(:,:,jpatch)
         CALL interp_grid_nat(zd1,zfield1,xgrid_soil,zout)
         pfield(:,:,jpatch)=zout(:,:)
       END DO
       DEALLOCATE(zfield)
       DEALLOCATE(zout)
       DEALLOCATE(zfield1)
       DEALLOCATE(zd)        

     ENDIF
!
!--------------------------------------------------------------------------
!
!*      3.4    Water content intercepted on leaves, LAI
!
  CASE('WR     ')
     !* choice if one reads garden fields (if present) or ISBA fields
     CALL open_aux_io_surf(hfilepgd,hfilepgdtype,'TOWN  ')
     ggreenroof = .false.
     IF (gteb) CALL read_surf(hfilepgdtype,'LGREENROOF',ggreenroof,iresp,hdir='-')
     CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
     IF (ggreenroof) THEN
       ipatch = 1             
       yrecfm = 'GR_WR'
       yrecfm=ypatch//yrecfm
       CALL open_aux_io_surf(hfile,hfiletype,'TOWN  ')
     ELSE
       yrecfm = 'PATCH_NUMBER'
       ipatch = 0
       CALL open_aux_io_surf(hfilepgd,hfilepgdtype,'NATURE')
       CALL read_surf(hfilepgdtype,yrecfm,ipatch,iresp,hdir='-')
       CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
       CALL open_aux_io_surf(hfile,hfiletype,'NATURE')
       yrecfm = 'WR'
     END IF

     CALL read_surf(hfiletype,'VERSION',iversion,iresp)
     CALL read_surf(hfiletype,'BUG',ibugfix,iresp)
     gdim = (iversion>8 .OR. iversion==8 .AND. ibugfix>0)
     IF (gdim) CALL read_surf(hfiletype,'SPLIT_PATCH',gdim,iresp)     
     yrecfm=adjustl(yrecfm)
     ALLOCATE(zfield(ini,1,ipatch))
     IF (ggreenroof) THEN
       CALL read_surf(hfiletype,yrecfm,zfield(:,1,1),iresp,hdir='E')
     ELSE
       CALL make_choice_array(hfiletype, ipatch, gdim, yrecfm, zfield(:,1,:),hdir='E')
     ENDIF     
     CALL close_aux_io_surf(hfile,hfiletype)
     IF (ipatch/=1) THEN
       ALLOCATE(pfield(ini,1,nvegtype))
       CALL put_on_all_vegtypes(ini,1,ipatch,nvegtype,zfield,pfield)
     ELSE
       ALLOCATE(pfield(ini,1,1))
       pfield(:,:,:) = zfield(:,:,:)
     ENDIF
     DEALLOCATE(zfield)
!
  CASE('LAI    ')
     ALLOCATE(pfield(ini,1,1))
     pfield(:,:,:) = xundef
!
END SELECT
!
!
!---------------------------------------------------------------------------
!
!*      6.     End of IO
!              ---------
!
IF (lhook) CALL dr_hook('PREP_TEB_GREENROOF_EXTERN',1,zhook_handle)
!
!---------------------------------------------------------------------------
!---------------------------------------------------------------------------
END SUBROUTINE prep_teb_greenroof_extern