write_bld_descriptionn.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_bld_description_n (DGU, U, &
                                           bdd, &
                                          hprogram)
!     #########################
!
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    05/2012 
!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_bld_description_n, ONLY : bld_desc_t
!
USE modi_write_surf
USE modi_abor1_sfx
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
TYPE(bld_desc_t), INTENT(INOUT) :: bdd
!
 CHARACTER(LEN=6),  INTENT(IN) :: hprogram
!
!
!*    0.2    Declaration of local variables
!      ------------------------------
!
REAL(KIND=JPRB) :: zhook_handle
!
REAL, DIMENSION(:), ALLOCATABLE :: zwork
INTEGER                         :: iresp
INTEGER                         :: i1, i2
INTEGER                         :: jl
INTEGER                         :: itot
 CHARACTER(LEN=100)              :: ycomment
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('WRITE_BLD_DESCRIPTION_n',0,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!*    1.   Writes configuration variables of the descriptive data
!          ------------------------------------------------------
!
ALLOCATE(zwork(7))
!
zwork(1) = float(bdd%NDESC_BLD)
zwork(2) = float(bdd%NDESC_AGE)
zwork(3) = float(bdd%NDESC_USE)
zwork(4) = float(bdd%NDESC_WALL_LAYER)
zwork(5) = float(bdd%NDESC_ROOF_LAYER)
zwork(6) = float(bdd%NDESC_ROAD_LAYER)
zwork(7) = float(bdd%NDESC_FLOOR_LAYER)
!
ycomment='Configuration numbers for descriptive building data'
 CALL write_surf(dgu, u, &
                 hprogram,'BLD_DESC_CNF',zwork,iresp,ycomment,'-','Bld_dimensions  ')
DEALLOCATE(zwork)
!
!-------------------------------------------------------------------------------
!
!*    3.   Writes descriptive data
!          -----------------------
!
itot=(21+3*bdd%NDESC_ROOF_LAYER+3*bdd%NDESC_ROAD_LAYER+3*bdd%NDESC_WALL_LAYER+3*bdd%NDESC_FLOOR_LAYER)*bdd%NDESC_CODE &
      + 9*bdd%NDESC_USE+2*bdd%NDESC_AGE+bdd%NDESC_BLD
ALLOCATE(zwork(itot))
!
!
i1=0 ; i2=0
 CALL up_desc_ind_w(bdd%NDESC_BLD)  ; zwork(i1:i2) = float(bdd%NDESC_BLD_LIST(:))
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = float(bdd%NDESC_CODE_LIST(:))
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_ALB_ROOF(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_ALB_ROAD(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_ALB_WALL(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_EMIS_ROOF(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_EMIS_ROAD(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_EMIS_WALL(:)
DO jl=1,bdd%NDESC_ROOF_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_HC_ROOF(:,jl)
END DO
DO jl=1,bdd%NDESC_ROOF_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_TC_ROOF(:,jl)
END DO
DO jl=1,bdd%NDESC_ROOF_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_D_ROOF (:,jl) 
END DO
DO jl=1,bdd%NDESC_ROAD_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_HC_ROAD(:,jl)
END DO
DO jl=1,bdd%NDESC_ROAD_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_TC_ROAD(:,jl) 
END DO
DO jl=1,bdd%NDESC_ROAD_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_D_ROAD (:,jl)
END DO
DO jl=1,bdd%NDESC_WALL_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_HC_WALL(:,jl)
END DO
DO jl=1,bdd%NDESC_WALL_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_TC_WALL(:,jl) 
END DO
DO jl=1,bdd%NDESC_WALL_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_D_WALL (:,jl)
END DO
DO jl=1,bdd%NDESC_FLOOR_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_HC_FLOOR(:,jl)
END DO
DO jl=1,bdd%NDESC_FLOOR_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_TC_FLOOR(:,jl) 
END DO
DO jl=1,bdd%NDESC_FLOOR_LAYER
  CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_D_FLOOR (:,jl)
END DO
!
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_SHGC(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_U_WIN(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_GR(:) 
!
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_F_WASTE_CAN(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_F_WATER_COND(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_COP_RAT(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_EFF_HEAT(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_INF(:)
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_V_VENT(:) 
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_GREENROOF(:) 
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_EMIS_PANEL(:) 
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_ALB_PANEL(:) 
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_EFF_PANEL(:) 
 CALL up_desc_ind_w(bdd%NDESC_CODE) ; zwork(i1:i2) = bdd%XDESC_FRAC_PANEL(:) 
!
 CALL up_desc_ind_w(bdd%NDESC_USE) ; zwork(i1:i2) = float(bdd%NDESC_USE_LIST(:))
 CALL up_desc_ind_w(bdd%NDESC_USE) ; zwork(i1:i2) = bdd%XDESC_TCOOL_TARGET(:)
 CALL up_desc_ind_w(bdd%NDESC_USE) ; zwork(i1:i2) = bdd%XDESC_THEAT_TARGET(:)
 CALL up_desc_ind_w(bdd%NDESC_USE) ; zwork(i1:i2) = bdd%XDESC_QIN(:)
 CALL up_desc_ind_w(bdd%NDESC_USE) ; zwork(i1:i2) = bdd%XDESC_QIN_FLAT(:)
 CALL up_desc_ind_w(bdd%NDESC_USE) ; zwork(i1:i2) = bdd%XDESC_SHGC_SH(:)
 CALL up_desc_ind_w(bdd%NDESC_USE) ; zwork(i1:i2) = bdd%XDESC_SHADE(:)
 CALL up_desc_ind_w(bdd%NDESC_USE) ; zwork(i1:i2) = bdd%XDESC_NATVENT(:)
 CALL up_desc_ind_w(bdd%NDESC_USE) ; zwork(i1:i2) = bdd%XDESC_RESIDENTIAL(:)
!
 CALL up_desc_ind_w(bdd%NDESC_AGE) ; zwork(i1:i2) = float(bdd%NDESC_AGE_LIST(:))
 CALL up_desc_ind_w(bdd%NDESC_AGE) ; zwork(i1:i2) = float(bdd%NDESC_AGE_DATE(:))
!
ycomment='Descriptive building data'
 CALL write_surf(dgu, u, &
                 hprogram,'BLD_DESC_DAT',zwork,iresp,ycomment,'-','Bld_parameters  ')
DEALLOCATE(zwork)
!
IF (lhook) CALL dr_hook('WRITE_BLD_DESCRIPTION_n',1,zhook_handle)
!-------------------------------------------------------------------------------
 CONTAINS
SUBROUTINE up_desc_ind_w(K)
INTEGER, INTENT(IN) :: k
i1=i2+1
i2=i2+k
END SUBROUTINE up_desc_ind_w
!-------------------------------------------------------------------------------
!
END SUBROUTINE write_bld_description_n