Skip to content
Snippets Groups Projects
write_bld_descriptionn.F90 7.16 KiB
Newer Older
!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 (HSELECT, BDD, HPROGRAM)
!     #########################
!
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    05/2012 
!
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
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
!            ------------------------
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
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(HSELECT, 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(HSELECT, &
                 HPROGRAM,'BLD_DESC_DAT',ZWORK,IRESP,YCOMMENT,'-','Bld_parameters  ')
DEALLOCATE(ZWORK)
!
IF (LHOOK) CALL DR_HOOK('WRITE_BLD_DESCRIPTION_n',1,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
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