read_tebn.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 read_teb_n (B, BOP, DTCO, DGU, U, T, TOP, TPN, &
                             hprogram,kpatch)
!     #########################################
!
!!****  *READ_TEB_n* - reads TEB fields
!!                        
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_bem_n, ONLY : bem_t
USE modd_bem_option_n, ONLY : bem_options_t
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_teb_n, ONLY : teb_t
USE modd_teb_option_n, ONLY : teb_options_t
USE modd_teb_panel_n, ONLY : teb_panel_t
!
USE modd_data_cover_par, ONLY : jpcover
!
USE modd_assim, ONLY : lassim,xat2m_teb,nific,nvar
!
USE modi_read_surf
!
USE modi_init_io_surf_n
USE modi_set_surfex_filein
USE modi_end_io_surf_n
USE modi_town_presence
USE modi_allocate_gr_snow
USE modi_read_gr_snow
USE modi_io_buff
!
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_get_type_dim_n
USE modd_surf_par, ONLY : xundef
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(bem_t), INTENT(INOUT) :: b
TYPE(bem_options_t), INTENT(INOUT) :: bop
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(teb_t), INTENT(INOUT) :: t
TYPE(teb_options_t), INTENT(INOUT) :: top
TYPE(teb_panel_t), INTENT(INOUT) :: tpn
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram ! calling program
INTEGER,           INTENT(IN)  :: kpatch   ! current patch number
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
LOGICAL           :: gtown          ! town variables written in the file
INTEGER           :: ilu          ! 1D physical dimension
!
INTEGER           :: iresp          ! Error code after redding
!
 CHARACTER(LEN=12) :: yrecfm         ! Name of the article to be read
 CHARACTER(LEN=3)  :: ypatch         ! suffix if more than 1 patch
!
INTEGER           :: iversion, ibugfix
LOGICAL           :: gold_name      ! name of temperatures in old versions of SURFEX
LOGICAL           :: gknown
!
INTEGER :: jlayer  ! loop counter on layers
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!* 1D physical dimension
!
IF (lhook) CALL dr_hook('READ_TEB_N',0,zhook_handle)
yrecfm='SIZE_TOWN'
 CALL get_type_dim_n(dtco, u, &
                     'TOWN  ',ilu)
!
ypatch='   '
IF (top%NTEB_PATCH>1) WRITE(ypatch,fmt='(A1,I1,A1)') 'T',kpatch,'_'
!  
 CALL read_surf(&
                hprogram,'VERSION',iversion,iresp)
 CALL read_surf(&
                hprogram,'BUG',ibugfix,iresp)
gold_name = (iversion<7 .OR. (iversion==7 .AND. ibugfix<=2))
!
!*       2.     Prognostic fields:
!               -----------------
!
!* roof temperatures
!
ALLOCATE(t%CUR%XT_ROOF(ilu,top%NROOF_LAYER))
!
DO jlayer=1,top%NROOF_LAYER
  WRITE(yrecfm,'(A3,A5,I1.1)') ypatch,'TROOF',jlayer
  yrecfm=adjustl(yrecfm)
  IF (gold_name) WRITE(yrecfm,'(A6,I1.1)') 'T_ROOF',jlayer

 CALL read_surf(&
                hprogram,yrecfm,t%CUR%XT_ROOF(:,jlayer),iresp)
END DO
!
!* roof water content
!
ALLOCATE(t%CUR%XWS_ROOF(ilu))
!
yrecfm=ypatch//'WS_ROOF'
yrecfm=adjustl(yrecfm)
 CALL read_surf(&
                hprogram,yrecfm,t%CUR%XWS_ROOF(:),iresp)
!
!* road temperatures
!
ALLOCATE(t%CUR%XT_ROAD(ilu,top%NROAD_LAYER))
!
DO jlayer=1,top%NROAD_LAYER
  WRITE(yrecfm,'(A3,A5,I1.1)') ypatch,'TROAD',jlayer
  yrecfm=adjustl(yrecfm)
  IF (gold_name) WRITE(yrecfm,'(A6,I1.1)') 'T_ROAD',jlayer
 CALL read_surf(&
                hprogram,yrecfm,t%CUR%XT_ROAD(:,jlayer),iresp)
END DO
!
!* road water content
!
ALLOCATE(t%CUR%XWS_ROAD(ilu))
!
yrecfm=ypatch//'WS_ROAD'
yrecfm=adjustl(yrecfm)
 CALL read_surf(&
                hprogram,yrecfm,t%CUR%XWS_ROAD(:),iresp)
!
!* wall temperatures
!
ALLOCATE(t%CUR%XT_WALL_A(ilu,top%NWALL_LAYER))
ALLOCATE(t%CUR%XT_WALL_B(ilu,top%NWALL_LAYER))
!
DO jlayer=1,top%NWALL_LAYER
  IF (top%CWALL_OPT=='UNIF' .OR. gold_name) THEN
    WRITE(yrecfm,'(A3,A5,I1.1)') ypatch,'TWALL',jlayer
    yrecfm=adjustl(yrecfm)
    IF (gold_name) WRITE(yrecfm,'(A6,I1.1)') 'T_WALL',jlayer
    CALL read_surf(&
                hprogram,yrecfm,t%CUR%XT_WALL_A(:,jlayer),iresp)
    !
    t%CUR%XT_WALL_B = t%CUR%XT_WALL_A
  ELSE
    WRITE(yrecfm,'(A3,A6,I1.1)') ypatch,'TWALLA',jlayer
    yrecfm=adjustl(yrecfm)
    CALL read_surf(&
                hprogram,yrecfm,t%CUR%XT_WALL_A(:,jlayer),iresp)
    !
    WRITE(yrecfm,'(A3,A6,I1.1)') ypatch,'TWALLB',jlayer
    yrecfm=adjustl(yrecfm)
    CALL read_surf(&
                hprogram,yrecfm,t%CUR%XT_WALL_B(:,jlayer),iresp)
  END IF
END DO
!
!* internal building temperature
!
ALLOCATE(b%CUR%XTI_BLD(ilu))
!
yrecfm=ypatch//'TI_BLD'
yrecfm=adjustl(yrecfm)
 CALL read_surf(&
                hprogram,yrecfm,b%CUR%XTI_BLD(:),iresp)

!
!* outdoor window temperature
!
ALLOCATE(b%CUR%XT_WIN1(ilu))
!
IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) THEN
   yrecfm=ypatch//'T_WIN1'
   yrecfm=adjustl(yrecfm)
   CALL read_surf(&
                hprogram,yrecfm,b%CUR%XT_WIN1(:),iresp)
ELSE
   b%CUR%XT_WIN1(:)=xundef
ENDIF
!
!
!* internal building specific humidity
!
ALLOCATE(b%CUR%XQI_BLD(ilu))
!
IF (top%CBEM=='BEM' .AND. (iversion>7 .OR. iversion==7 .AND. ibugfix>=3)) THEN
   yrecfm=ypatch//'QI_BLD'
   yrecfm=adjustl(yrecfm)
   CALL read_surf(&
                hprogram,yrecfm,b%CUR%XQI_BLD(:),iresp)
ELSE
   b%CUR%XQI_BLD(:) = xundef
ENDIF
!
IF (top%CBEM=='BEM') THEN
  !
  !* indoor window temperature
  !
  ALLOCATE(b%CUR%XT_WIN2(ilu))
  !
  yrecfm=ypatch//'T_WIN2'
  yrecfm=adjustl(yrecfm)
  CALL read_surf(&
                hprogram,yrecfm,b%CUR%XT_WIN2(:),iresp)        
  !
  !* floor temperatures
  !
  ALLOCATE(b%CUR%XT_FLOOR(ilu,bop%NFLOOR_LAYER))
  !
  DO jlayer=1,bop%NFLOOR_LAYER
    WRITE(yrecfm,'(A3,A5,I1.1)') ypatch,'TFLOO',jlayer
    yrecfm=adjustl(yrecfm)
    CALL read_surf(&
                hprogram,yrecfm,b%CUR%XT_FLOOR(:,jlayer),iresp)
  END DO
  !
  !* mass temperatures
  !
  ALLOCATE(b%CUR%XT_MASS(ilu,bop%NFLOOR_LAYER))
  !
  DO jlayer=1,bop%NFLOOR_LAYER
    WRITE(yrecfm,'(A3,A5,I1.1)') ypatch,'TMASS',jlayer
    yrecfm=adjustl(yrecfm)
    CALL read_surf(&
                hprogram,yrecfm,b%CUR%XT_MASS(:,jlayer),iresp)
  END DO
  !
ELSE 
  ALLOCATE(b%CUR%XT_WIN2(0))
  ALLOCATE(b%CUR%XT_FLOOR(0,0))
  ALLOCATE(b%CUR%XT_MASS(0,0))
ENDIF
!
!* deep road temperature
!
ALLOCATE(t%CUR%XTI_ROAD(ilu))
!
yrecfm=ypatch//'TI_ROAD'
yrecfm=adjustl(yrecfm)
 CALL read_surf(&
                hprogram,yrecfm,t%CUR%XTI_ROAD(:),iresp)
!
!
!* snow mantel
!
 CALL end_io_surf_n(hprogram)
 CALL set_surfex_filein(hprogram,'PGD ')
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'TOWN  ','TEB   ','READ ')
!
 CALL town_presence(&
                    hprogram,gtown)
!
 CALL end_io_surf_n(hprogram)
 CALL set_surfex_filein(hprogram,'PREP')
 CALL init_io_surf_n(dtco, dgu, u, &
                     hprogram,'TOWN  ','TEB   ','READ ')
!
IF (.NOT. gtown) THEN
  t%CUR%TSNOW_ROAD%SCHEME='1-L'
  CALL allocate_gr_snow(t%CUR%TSNOW_ROAD,ilu,1)
  t%CUR%TSNOW_ROOF%SCHEME='1-L'
  CALL allocate_gr_snow(t%CUR%TSNOW_ROOF,ilu,1)  
ELSE
  IF (iversion>7 .OR. iversion==7 .AND. ibugfix>=3) THEN
    CALL read_gr_snow(&
                      hprogram,'RD',ypatch,ilu,1,t%CUR%TSNOW_ROAD  )
    CALL read_gr_snow(&
                      hprogram,'RF',ypatch,ilu,1,t%CUR%TSNOW_ROOF  )
  ELSE
    CALL read_gr_snow(&
                      hprogram,'ROAD',ypatch,ilu,1,t%CUR%TSNOW_ROAD  )
    CALL read_gr_snow(&
                      hprogram,'ROOF',ypatch,ilu,1,t%CUR%TSNOW_ROOF  )
  ENDIF    
END IF
!
!-------------------------------------------------------------------------------
!
!*       3.     Semi-prognostic fields:
!               ----------------------
!
!* temperature in canyon air
!
ALLOCATE(t%CUR%XT_CANYON(ilu))
t%CUR%XT_CANYON(:) = t%CUR%XT_ROAD(:,1)
!
yrecfm=ypatch//'TCANYON'
yrecfm=adjustl(yrecfm)
IF (gold_name) yrecfm='T_CANYON'
 CALL read_surf(&
                hprogram,yrecfm,t%CUR%XT_CANYON(:),iresp)
!
!* water vapor in canyon air
!
ALLOCATE(t%CUR%XQ_CANYON(ilu))
t%CUR%XQ_CANYON(:) = 0.
!
yrecfm=ypatch//'QCANYON'
yrecfm=adjustl(yrecfm)
IF (gold_name) yrecfm='Q_CANYON'
 CALL read_surf(&
                hprogram,yrecfm,t%CUR%XQ_CANYON(:),iresp)
!
!* Thermal solar panels present day production
!
IF (top%LSOLAR_PANEL) THEN
  ALLOCATE(tpn%XTHER_PRODC_DAY(ilu))
  tpn%XTHER_PRODC_DAY(:) = 0.

  yrecfm=ypatch//'THER_PDAY'
  yrecfm=adjustl(yrecfm)
  CALL read_surf(&
                hprogram,yrecfm,tpn%XTHER_PRODC_DAY(:),iresp)
END IF

IF ( lassim .AND. nific/=nvar+2 ) THEN
  ! Diagnostic fields for assimilation
  IF ( .NOT. ALLOCATED(xat2m_teb)) ALLOCATE(xat2m_teb(ilu))
  xat2m_teb=xundef
  yrecfm='T2M'
  CALL io_buff(yrecfm,'R',gknown)
  CALL read_surf(&
                hprogram,yrecfm,xat2m_teb(:),iresp)
ENDIF

!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('READ_TEB_N',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE read_teb_n