write_diag_misc_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 write_diag_misc_teb_n (DTCO, HSELECT, U, DMTC, DMT, DMTO, &
                                        GDD, GDDE, GDDEC, GRD, GRDE, GRDEC, &
                                        T, TOP, HPROGRAM,KTEB_PATCH)
!     #################################
!
!!****  *WRITE_DIAG_MISC_TEB* - writes the TEB diagnostic fields
!!
!!    PURPOSE
!!    -------
!!
!!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      P. Le Moigne   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2004
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_diag_misc_teb_n, ONLY : diag_misc_teb_t
USE modd_diag_misc_teb_options_n, ONLY : diag_misc_teb_options_t
USE modd_teb_n, ONLY : teb_t
USE modd_teb_option_n, ONLY : teb_options_t
!
USE modd_diag_n, ONLY : diag_t
USE modd_diag_evap_isba_n, ONLY : diag_evap_isba_t
!
USE modi_init_io_surf_n
USE modi_write_surf
USE modd_surf_par,       ONLY : xundef
USE modi_end_io_surf_n
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(diag_misc_teb_t), INTENT(INOUT) :: DMTC
TYPE(diag_misc_teb_t), INTENT(INOUT) :: DMT
TYPE(diag_misc_teb_options_t), INTENT(INOUT) :: DMTO
TYPE(teb_t), INTENT(INOUT) :: T
TYPE(teb_options_t), INTENT(INOUT) :: TOP
!
TYPE(diag_t), INTENT(INOUT) :: GDD
TYPE(diag_evap_isba_t), INTENT(INOUT) :: GDDE
TYPE(diag_evap_isba_t), INTENT(INOUT) :: GDDEC
TYPE(diag_t), INTENT(INOUT) :: GRD
TYPE(diag_evap_isba_t), INTENT(INOUT) :: GRDE
TYPE(diag_evap_isba_t), INTENT(INOUT) :: GRDEC
!
 CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM   ! program calling
INTEGER,           INTENT(IN)  :: KTEB_PATCH ! patch number being written
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
 CHARACTER(LEN=3)  :: YPATCH         ! Prefix for current patch
 CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
 CHARACTER(LEN=100):: YCOMMENT       ! Comment string
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!           Initialisation for IO
!           ---------------------
!
IF (lhook) CALL dr_hook('WRITE_DIAG_MISC_TEB_N',0,zhook_handle)
!
!-------------------------------------------------------------------------------
!
IF (dmto%LSURF_MISC_BUDGET) THEN
  !
  ypatch = '   '
  IF (top%NTEB_PATCH>1) WRITE(ypatch,fmt='(A,I1,A)') 'T',kteb_patch,'_'
  !
  CALL init_io_surf_n(dtco, u,    hprogram,'TOWN  ','TEB   ','WRITE','TEB_DIAGNOSTICS.OUT.nc')
  !
  !*       Miscellaneous fields :
  !        ----------------------
  !
  yrecfm='D_RD'
  ycomment='Road fraction'
  CALL write_surf(hselect,hprogram,yrecfm,t%XROAD(:),iresp,hcomment=ycomment)
  !
  yrecfm='Z0_TOWN'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='town roughness length'
  CALL write_surf(hselect,hprogram,yrecfm,t%XZ0_TOWN(:),iresp,hcomment=ycomment)
  !
  yrecfm='XQF_BLD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='domestic heating'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XQF_BLD(:),iresp,hcomment=ycomment)
  !
  yrecfm='XQF_TOWN'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='total anthropogenic heat'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XQF_TOWN(:),iresp,hcomment=ycomment)
  !
  yrecfm='XDQS_TOWN'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='heat storage inside building'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XDQS_TOWN(:),iresp,hcomment=ycomment)
  !
  yrecfm='RUNOFF_TW'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='aggregated runoff for town'//' (kg/m2/s)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XRUNOFF_TOWN(:),iresp,hcomment=ycomment)
  !
  yrecfm='RN_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment=' net radiation at road'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XRN_ROAD(:),iresp,hcomment=ycomment)
  !
  yrecfm='H_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='road sensible heat flux'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_ROAD(:),iresp,hcomment=ycomment)
  !
  yrecfm='LE_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='road latent heat flux'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XLE_ROAD(:),iresp,hcomment=ycomment)
  !
  yrecfm='GFLUX_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='net road conduction flux'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XGFLUX_ROAD(:),iresp,hcomment=ycomment)
  !
  yrecfm='RUNOFF_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='road surface runoff'//' (kg/m2/s)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XRUNOFF_ROAD(:),iresp,hcomment=ycomment)
  !
  IF (top%CWALL_OPT=='UNIF') THEN
    !
    yrecfm='RN_WL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net radiation for wall '//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XRN_WALL_A(:),iresp,hcomment=ycomment)
    !
    yrecfm='H_WL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='wall sensible heat flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_WALL_A(:),iresp,hcomment=ycomment)
    !
    yrecfm='GFLUX_WL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net wall conduction flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XGFLUX_WALL_A(:),iresp,hcomment=ycomment)
    !
  ELSE
    !
    yrecfm='RN_WLA'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net radiation for wall A'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XRN_WALL_A(:),iresp,hcomment=ycomment)
    !
    yrecfm='H_WLA'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='wall A sensible heat flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_WALL_A(:),iresp,hcomment=ycomment)
    !
    yrecfm='GFLUX_WLA'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net wall A conduction flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XGFLUX_WALL_A(:),iresp,hcomment=ycomment)
    !
    yrecfm='RN_WLB'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net radiation for wall B'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XRN_WALL_B(:),iresp,hcomment=ycomment)
    !
    yrecfm='H_WLB'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='wall B sensible heat flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_WALL_B(:),iresp,hcomment=ycomment)
    !
    yrecfm='GFLUX_WLB'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net wall B conduction flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XGFLUX_WALL_B(:),iresp,hcomment=ycomment)
    !
  ENDIF
  !
  yrecfm='RN_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='net radiation for roof'//yrecfm//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XRN_ROOF(:),iresp,hcomment=ycomment)
  !
  yrecfm='H_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='roof sensible heat flux'//yrecfm//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_ROOF(:),iresp,hcomment=ycomment)
  !
  yrecfm='LE_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='roof latent heat flux'//yrecfm//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XLE_ROOF(:),iresp,hcomment=ycomment)
  !
  yrecfm='GFLUX_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='net roof conduction flux'//yrecfm//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XGFLUX_ROOF(:),iresp,hcomment=ycomment)
  !
  yrecfm='RUNOFF_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='aggregated roof runoff'//' (kg/m2/s)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XRUNOFF_ROOF(:),iresp,hcomment=ycomment)
  !
  !
  IF (top%LGARDEN) THEN
    !
    yrecfm='RN_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net radiation for GARDEN areas'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,gdd%XRN(:),iresp,hcomment=ycomment)
    !
    yrecfm='H_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='GARDEN area sensible heat flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,gdd%XH(:),iresp,hcomment=ycomment)
    !
    yrecfm='LE_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='GARDEN area latent heat flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,gdd%XLE(:),iresp,hcomment=ycomment)
    !
    yrecfm='GFLUX_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net GARDEN area conduction flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,gdd%XGFLUX(:),iresp,hcomment=ycomment)
    !
    yrecfm='RUNOFF_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='garden surface runoff'//' (kg/m2/s)'
    CALL write_surf(hselect,hprogram,yrecfm,gdde%XRUNOFF(:),iresp,hcomment=ycomment)
    !
  ENDIF
  !
  yrecfm='RN_BLT'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='net radiation for built surfaces'//yrecfm//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XRN_BLT(:),iresp,hcomment=ycomment)
  !
  yrecfm='H_BLT'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='built surface sensible heat flux'//yrecfm//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_BLT(:),iresp,hcomment=ycomment)
  !
  yrecfm='LE_BLT'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='built surface latent heat flux'//yrecfm//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XLE_BLT(:),iresp,hcomment=ycomment)
  !
  yrecfm='GFLUX_BLT'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='built surface conduction flux'//yrecfm//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XGFLUX_BLT(:),iresp,hcomment=ycomment)
  !
  yrecfm='SWA_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Sdown absorbed by roofs'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_ROOF(:),iresp,hcomment=ycomment)
  !
  yrecfm='SWA_SN_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Sdown absorbed by snow on roofs'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_SNOW_ROOF(:),iresp,hcomment=ycomment)
  !
  yrecfm='LWA_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Ldown absorbed by roofs'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_ROOF(:),iresp,hcomment=ycomment)
  !
  yrecfm='LWA_SN_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Ldown absorbed by snow on roofs'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_SNOW_ROOF(:),iresp,hcomment=ycomment)
  !
  yrecfm='SWA_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Sdown absorbed by roads'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_ROAD(:),iresp,hcomment=ycomment)
  !
  yrecfm='SWA_SN_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Sdown absorbed by snow on roads'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_SNOW_ROAD(:),iresp,hcomment=ycomment)
  !
  yrecfm='LWA_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Ldown absorbed by roads'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_ROAD(:),iresp,hcomment=ycomment)
  !
  yrecfm='LWA_SN_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Ldown absorbed by snow on roads'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_SNOW_ROAD(:),iresp,hcomment=ycomment)
  !
  IF (top%CWALL_OPT=='UNIF') THEN
    !
    yrecfm='SWA_WL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Sdown absorbed by wall'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_WALL_A(:),iresp,hcomment=ycomment)
    !
    yrecfm='LWA_WL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Ldown absorbed by wall '//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_WALL_A(:),iresp,hcomment=ycomment)
    !
  ELSE
    !
    yrecfm='SWA_WLA'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Sdown absorbed by wall A'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_WALL_A(:),iresp,hcomment=ycomment)
    !
    yrecfm='LWA_WLA'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Ldown absorbed by wall A'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_WALL_A(:),iresp,hcomment=ycomment)
    !
    yrecfm='SWA_WLB'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Sdown absorbed by wall B'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_WALL_B(:),iresp,hcomment=ycomment)
    !
    yrecfm='LWA_WLB'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Ldown absorbed by wall B'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_WALL_B(:),iresp,hcomment=ycomment)
    !
  ENDIF
  !
  IF (top%LGARDEN) THEN
    !
    yrecfm='SWA_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Sdown absorbed by GARDEN areas'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_GARDEN(:),iresp,hcomment=ycomment)
    !
    yrecfm='LWA_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Ldown absorbed by GARDEN areas'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_GARDEN(:),iresp,hcomment=ycomment)
    !
  ENDIF
  !
  yrecfm='REF_SW_GO'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Total solar rad reflected by ground '//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XREF_SW_GRND(:),iresp,hcomment=ycomment)
  !
  yrecfm='LWE_GO'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='LW emitted by ground'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XEMIT_LW_GRND(:),iresp,hcomment=ycomment)
  !
  yrecfm='REF_SW_FA'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='Total solar rad reflected by facade '//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XREF_SW_FAC(:),iresp,hcomment=ycomment)
  !
  yrecfm='LWE_FA'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='LW emitted by facade'//' (W/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmt%XEMIT_LW_FAC(:),iresp,hcomment=ycomment)
  !
  IF (top%CBEM=='BEM') THEN
    !
    yrecfm='CL_CURT'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Current Cooling system temperature set point'//' (K)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XTCOOL_TARGET(:),iresp,hcomment=ycomment)
    !
    yrecfm='HT_CURT'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Current Heating system temperature set point'//' (K)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XTHEAT_TARGET(:),iresp,hcomment=ycomment)
    !
    yrecfm='QIN_CUR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Current Building internal heat loads'//' (W m-2(floor))'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XQIN(:),iresp,hcomment=ycomment)
    !
    yrecfm='XFLX_BLD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='heat flux from bld'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XFLX_BLD(:),iresp,hcomment=ycomment)
    !
    yrecfm='H_BLD_CL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='sensible cooling demand'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_BLD_COOL(:),iresp,hcomment=ycomment)
    !
    yrecfm='T_BLD_CL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Total cooling demand'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XT_BLD_COOL(:),iresp,hcomment=ycomment)
    !  
    yrecfm='H_BLD_HT'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='sensible heating demand'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_BLD_HEAT(:),iresp,hcomment=ycomment)
    !
    yrecfm='LE_BLD_CL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='latent cooling demand'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XLE_BLD_COOL(:),iresp,hcomment=ycomment)
    !
    yrecfm='LE_BLD_HT'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='latent heating demand'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XLE_BLD_HEAT(:),iresp,hcomment=ycomment)
    !
    yrecfm='H_WASTE'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='sensible waste heat from HVAC'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_WASTE(:),iresp,hcomment=ycomment)
    !
    yrecfm='LE_WASTE'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='latent waste heat from HVAC'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XLE_WASTE(:),iresp,hcomment=ycomment)  
    !
    yrecfm='HVAC_CL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='cooling energy consumption'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XHVAC_COOL(:),iresp,hcomment=ycomment)
    !
    yrecfm='HVAC_HT'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='heating energy consumption'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XHVAC_HEAT(:),iresp,hcomment=ycomment)
    !
    yrecfm='CAP_SYS'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Actual capacity of the cooling system'//' (W m-2(bld))'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XCAP_SYS(:),iresp,hcomment=ycomment)
    !
    yrecfm='M_SYS'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Actual HVAC mass flow rate'//' (kg s-1 m-2(bld))'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XM_SYS(:),iresp,hcomment=ycomment)
    !
    yrecfm='COP'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Actual COP of the cooling system'//' ()'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XCOP(:),iresp,hcomment=ycomment)  
    !
    yrecfm='Q_SYS'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Supply air specific humidity'//' (kg kg-1)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XQ_SYS(:),iresp,hcomment=ycomment)
    !
    yrecfm='T_SYS'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Supply air temperature'//' (K)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XT_SYS(:),iresp,hcomment=ycomment)  
    !
    yrecfm='TR_SW_WIN'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Solar radiation transmitted through windows'//' (W m-2(bld))'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XTR_SW_WIN(:),iresp,hcomment=ycomment)
    !
    yrecfm='FAN_POWER'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='HVAC fan power'//' (W m-2(bld))'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XFAN_POWER(:),iresp,hcomment=ycomment)  
    !
    yrecfm='T_RAD_IND'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Indoor mean radiant temperature'//' (K)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XT_RAD_IND(:),iresp,hcomment=ycomment)
    !
    yrecfm='HU_BLD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Indoor relative humidity'//' (-)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XHU_BLD(:),iresp,hcomment=ycomment)
    !
    yrecfm='SWA_WIN'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Sdown absorbed by windows'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_WIN(:),iresp,hcomment=ycomment)
    !
    yrecfm='LWA_WIN'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Ldown absorbed by windows'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_WIN(:),iresp,hcomment=ycomment)    
    !
  ENDIF
  !
  IF (top%LGREENROOF) THEN
  !
    WHERE (t%XGREENROOF(:) == 0.)
      grd%XRN    (:) = xundef   
      grd%XH     (:) = xundef 
      grd%XLE    (:) = xundef 
      grd%XGFLUX (:) = xundef 
      !
      dmt%XABS_SW_GREENROOF(:) = xundef 
      dmt%XABS_LW_GREENROOF(:) = xundef 
      dmt%XG_GREENROOF_ROOF(:) = xundef 
      !
      grde%XRUNOFF(:) = xundef 
      grde%XDRAIN (:) = xundef 
    END WHERE
    !
    yrecfm='RN_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net radiation for GREENROOFs'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,grd%XRN(:),iresp,hcomment=ycomment)
    !
    yrecfm='H_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='sensible heat flux for GREENROOFs'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,grd%XH(:),iresp,hcomment=ycomment)
    !
    yrecfm='LE_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='latent heat flux for GREENROOFs'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,grd%XLE(:),iresp,hcomment=ycomment)
    !
    yrecfm='GFLUX_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='net conduction flux for GREENROOFs'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,grd%XGFLUX(:),iresp,hcomment=ycomment)
    !
    yrecfm='SWA_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Sdown absorbed by GREENROOFs'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_GREENROOF(:),iresp,hcomment=ycomment)
    !
    yrecfm='LWA_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Ldown absorbed by GREENROOFs'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_GREENROOF(:),iresp,hcomment=ycomment)
    !
    yrecfm='G_GR_ROOF'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='heat flux between GREENROOF and ROOF'//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XG_GREENROOF_ROOF(:),iresp,hcomment=ycomment)
    !
    yrecfm='RUNOFF_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='GREENROOF soil surface runoff'//' (kg/m2/s)'
    CALL write_surf(hselect,hprogram,yrecfm,grde%XRUNOFF(:),iresp,hcomment=ycomment)
    !
    yrecfm='DRAIN_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='GREENROOF total vertical drainage'//' (kg/m2/s)'
    CALL write_surf(hselect,hprogram,yrecfm,grde%XDRAIN(:),iresp,hcomment=ycomment)
  !
    WHERE (t%XGREENROOF(:) == 1.)
      dmt%XRN_STRLROOF(:)     = xundef   
      dmt%XH_STRLROOF(:)      = xundef   
      dmt%XLE_STRLROOF(:)     = xundef   
      dmt%XGFLUX_STRLROOF(:)  = xundef   
      dmt%XRUNOFF_STRLROOF(:) = xundef   
    END WHERE
    !
    yrecfm='RN_SR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='structural roof net radiation'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XRN_STRLROOF(:),iresp,hcomment=ycomment)
    !
    yrecfm='H_SR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='structural roof sensible heat flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_STRLROOF(:),iresp,hcomment=ycomment)
    !
    yrecfm='LE_SR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='structural roof latent heat flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XLE_STRLROOF(:),iresp,hcomment=ycomment)
    !
    yrecfm='GFLUX_SR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='structural roof conduction flux'//yrecfm//' (W/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XGFLUX_STRLROOF(:),iresp,hcomment=ycomment)
    !
    yrecfm='RUNOFF_SR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='structural roof surface runoff'//' (kg/m2/s)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XRUNOFF_STRLROOF(:),iresp,hcomment=ycomment)
    !
  ENDIF
  !
  !* solar panels
  IF (top%LSOLAR_PANEL) THEN
    yrecfm='SWA_SP'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Shortwave absorbed by solar panels on roofs'//' (W/m2 panel)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_SW_PANEL(:),iresp,hcomment=ycomment)
    !
    yrecfm='LWA_SP'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Longwave  absorbed by solar panels on roofs'//' (W/m2 panel)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XABS_LW_PANEL(:),iresp,hcomment=ycomment)
    !
    yrecfm='RN_SP'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Net radiation of solar panels on roofs'//' (W/m2 panel)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XRN_PANEL(:),iresp,hcomment=ycomment)
    !
    yrecfm='H_SP'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Sensible Heat flux  from solar panels on roofs'//' (W/m2 panel)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XH_PANEL(:),iresp,hcomment=ycomment)
    !
    yrecfm='PHOT_SP'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Photovolatic production '//' (W/m2 photovoltaic panel)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XPHOT_PROD_PANEL(:),iresp,hcomment=ycomment)
    !
    yrecfm='THER_SP'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Hot Water production '//' (W/m2 thermal panel)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XTHER_PROD_PANEL(:),iresp,hcomment=ycomment)
    !
    yrecfm='PROD_SP'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Production by solar panels on roofs'//' (W/m2 panel)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XPROD_PANEL(:),iresp,hcomment=ycomment)
        !
    yrecfm='PHOT_BLD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Photovolatic production '//' (W/m2 bld)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XPHOT_PROD_BLD(:),iresp,hcomment=ycomment)
    !
    yrecfm='THER_BLD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Hot Water production '//' (W/m2 bld)'
    CALL write_surf(hselect,hprogram,yrecfm,dmt%XTHER_PROD_BLD(:),iresp,hcomment=ycomment)
    !
  END IF
  !
  !*
  !*       3. Cumulated fields
  !           ----------------
  !
  CALL end_io_surf_n(hprogram)
  CALL init_io_surf_n(dtco, u,hprogram,'TOWN  ','TEB   ','WRITE','TEB_DIAG_CUMUL.OUT.nc')
  !  
  IF  (top%CBEM=='BEM') THEN
    !
    yrecfm='HVACC_CL'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='cumulated cooling energy consumption'//' (J/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmtc%XHVAC_COOL(:),iresp,hcomment=ycomment)
    !
    yrecfm='HVACC_HT'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='cumulated heating energy consumption'//' (J/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmtc%XHVAC_HEAT(:),iresp,hcomment=ycomment)
    !
  END IF
  !
  yrecfm='RUNOFFC_TW'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='cumulated aggregated runoff for town'//' (kg/m2)'
  CALL write_surf(hselect,hprogram,yrecfm,dmtc%XRUNOFF_TOWN(:),iresp,hcomment=ycomment)
  !
  yrecfm='RUNOFFC_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='cumulated road surface runoff'//' (kg/m2 road)'
  CALL write_surf(hselect,hprogram,yrecfm,dmtc%XRUNOFF_ROAD(:),iresp,hcomment=ycomment)
  !
  yrecfm='RUNOFFC_RF'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='cumulated aggregated roof runoff'//' (kg/m2 roof)'
  CALL write_surf(hselect,hprogram,yrecfm,dmtc%XRUNOFF_ROOF(:),iresp,hcomment=ycomment)
  !
  yrecfm='IRRIGC_RD'
  yrecfm=adjustl(ypatch//yrecfm)
  ycomment='cumulated road irrigation'//' (kg/m2 road)'
  CALL write_surf(hselect,hprogram,yrecfm,dmtc%XIRRIG_ROAD(:),iresp,hcomment=ycomment)
  !
  IF (top%LGARDEN) THEN
    !
    yrecfm='RUNOFFC_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='cumulated garden surface runoff'//' (kg/m2 garden)'
    CALL write_surf(hselect,hprogram,yrecfm,gddec%XRUNOFF(:),iresp,hcomment=ycomment)
    !
    yrecfm='DRAINC_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='cumulated garden surface drainage'//' (kg/m2 garden)'
    CALL write_surf(hselect,hprogram,yrecfm,gddec%XDRAIN(:),iresp,hcomment=ycomment)
    !
    yrecfm='IRRIGC_GD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='cumulated garden irrigation'//' (kg/m2 garden)'
    CALL write_surf(hselect,hprogram,yrecfm,dmtc%XIRRIG_GARDEN(:),iresp,hcomment=ycomment)
    !
  END IF
  !
  IF (top%LGREENROOF) THEN
    !
    WHERE (t%XGREENROOF(:) == 0.)
      grdec%XRUNOFF (:) = xundef   
      grdec%XDRAIN  (:) = xundef 
      dmtc%XIRRIG_GREENROOF  (:) = xundef 
    END WHERE
    !  
    yrecfm='RUNOFFC_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='GREENROOF cumulated soil surface runoff'//' (kg/m2 greenroof)'
    CALL write_surf(hselect,hprogram,yrecfm,grdec%XRUNOFF(:),iresp,hcomment=ycomment)
    !
    yrecfm='DRAINC_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='GREENROOF cumulated total vertical drainage'//' (kg/m2 greenroof)'
    CALL write_surf(hselect,hprogram,yrecfm,grdec%XDRAIN(:),iresp,hcomment=ycomment)
    !
    !
    yrecfm='IRRIGC_GR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='GREENROOF cumulated irrigation'//' (kg/m2 greenroof)'
    CALL write_surf(hselect,hprogram,yrecfm,dmtc%XIRRIG_GREENROOF(:),iresp,hcomment=ycomment)
    !
    WHERE (t%XGREENROOF(:) == 1.)
      dmtc%XRUNOFF_STRLROOF  (:) = xundef   
    END WHERE 
    !
    yrecfm='RUNOFFC_SR'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='cumulated structural roof surface runoff'//' (kg/m2)'
    CALL write_surf(hselect,hprogram,yrecfm,dmtc%XRUNOFF_STRLROOF(:),iresp,hcomment=ycomment)
    !
  END IF
  !  
  !* solar panels
  IF (top%LSOLAR_PANEL) THEN
    !
    yrecfm='PHOTC_BLD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Cumulated Photovolatic production '//' (J/m2 bld)'
    CALL write_surf(hselect,hprogram,yrecfm,dmtc%XPHOT_PROD_BLD(:),iresp,hcomment=ycomment)
    !
    yrecfm='THERC_BLD'
    yrecfm=adjustl(ypatch//yrecfm)
    ycomment='Cumulated Hot water production '//' (J/m2 bld)'
    CALL write_surf(hselect,hprogram,yrecfm,dmtc%XTHER_PROD_BLD(:),iresp,hcomment=ycomment)
    !
  END IF
  !
  !-------------------------------------------------------------------------------
  !
  !         End of IO
  !
  CALL end_io_surf_n(hprogram)
  !
END IF
!
IF (lhook) CALL dr_hook('WRITE_DIAG_MISC_TEB_N',1,zhook_handle)
!
END SUBROUTINE write_diag_misc_teb_n