Skip to content
Snippets Groups Projects
write_bld_descriptionn.F90 7.16 KiB
Newer Older
  • Learn to ignore specific revisions
  • !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