SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/write_bld

Go to the documentation of this file.
00001 !     #########################
00002       SUBROUTINE WRITE_BLD_DESCRIPTION(HPROGRAM)
00003 !     #########################
00004 !
00005 !!
00006 !!    PURPOSE
00007 !!    -------
00008 !!
00009 !!    METHOD
00010 !!    ------
00011 !!
00012 !!
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!    IMPLICIT ARGUMENTS
00017 !!    ------------------
00018 !!
00019 !!    REFERENCE
00020 !!    ---------
00021 !!
00022 !!    AUTHOR
00023 !!    ------
00024 !!
00025 !!    V. Masson        Meteo-France
00026 !!
00027 !!    MODIFICATION
00028 !!    ------------
00029 !!
00030 !!    Original    05/2012 
00031 !
00032 !----------------------------------------------------------------------------
00033 !
00034 !*    0.     DECLARATION
00035 !            -----------
00036 !
00037 USE MODD_BLD_DESCRIPTION
00038 !
00039 USE MODI_WRITE_SURF
00040 USE MODI_ABOR1_SFX
00041 !
00042 !
00043 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00044 USE PARKIND1  ,ONLY : JPRB
00045 !
00046 IMPLICIT NONE
00047 !
00048 !*    0.1    Declaration of arguments
00049 !            ------------------------
00050 !
00051  CHARACTER(LEN=6),  INTENT(IN) :: HPROGRAM
00052 !
00053 !
00054 !*    0.2    Declaration of local variables
00055 !      ------------------------------
00056 !
00057 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00058 !
00059 REAL, DIMENSION(:), ALLOCATABLE :: ZWORK
00060 INTEGER                         :: IRESP
00061 INTEGER                         :: I1, I2
00062 INTEGER                         :: JL
00063 INTEGER                         :: ITOT
00064  CHARACTER(LEN=100)              :: YCOMMENT
00065 !-------------------------------------------------------------------------------
00066 !-------------------------------------------------------------------------------
00067 !
00068 IF (LHOOK) CALL DR_HOOK('WRITE_BLD_DESCRIPTION',0,ZHOOK_HANDLE)
00069 !
00070 !-------------------------------------------------------------------------------
00071 !
00072 !*    1.   Writes configuration variables of the descriptive data
00073 !          ------------------------------------------------------
00074 !
00075 ALLOCATE(ZWORK(7))
00076 !
00077 ZWORK(1) = FLOAT(NDESC_BLD)
00078 ZWORK(2) = FLOAT(NDESC_AGE)
00079 ZWORK(3) = FLOAT(NDESC_USE)
00080 ZWORK(4) = FLOAT(NDESC_WALL_LAYER)
00081 ZWORK(5) = FLOAT(NDESC_ROOF_LAYER)
00082 ZWORK(6) = FLOAT(NDESC_ROAD_LAYER)
00083 ZWORK(7) = FLOAT(NDESC_FLOOR_LAYER)
00084 !
00085 YCOMMENT='Configuration numbers for descriptive building data'
00086  CALL WRITE_SURF(HPROGRAM,'BLD_DESC_CONF',ZWORK,IRESP,YCOMMENT,HDIR='-')
00087 DEALLOCATE(ZWORK)
00088 !
00089 !-------------------------------------------------------------------------------
00090 !
00091 !*    3.   Writes descriptive data
00092 !          -----------------------
00093 !
00094 ITOT=(17+3*NDESC_ROOF_LAYER+3*NDESC_ROAD_LAYER+3*NDESC_WALL_LAYER+3*NDESC_FLOOR_LAYER)*NDESC_CODE &
00095       + 8*NDESC_USE+2*NDESC_AGE+NDESC_BLD
00096 ALLOCATE(ZWORK(ITOT))
00097 !
00098 !
00099 I1=0 ; I2=0
00100  CALL UP_DESC_IND_W(NDESC_BLD)  ; ZWORK(I1:I2) = FLOAT(NDESC_BLD_LIST(:))
00101  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = FLOAT(NDESC_CODE_LIST(:))
00102  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_ALB_ROOF(:)
00103  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_ALB_ROAD(:)
00104  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_ALB_WALL(:)
00105  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_EMIS_ROOF(:)
00106  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_EMIS_ROAD(:)
00107  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_EMIS_WALL(:)
00108 DO JL=1,NDESC_ROOF_LAYER
00109   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_HC_ROOF(:,JL)
00110 END DO
00111 DO JL=1,NDESC_ROOF_LAYER
00112   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_TC_ROOF(:,JL)
00113 END DO
00114 DO JL=1,NDESC_ROOF_LAYER
00115   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_D_ROOF (:,JL) 
00116 END DO
00117 DO JL=1,NDESC_ROAD_LAYER
00118   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_HC_ROAD(:,JL)
00119 END DO
00120 DO JL=1,NDESC_ROAD_LAYER
00121   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_TC_ROAD(:,JL) 
00122 END DO
00123 DO JL=1,NDESC_ROAD_LAYER
00124   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_D_ROAD (:,JL)
00125 END DO
00126 DO JL=1,NDESC_WALL_LAYER
00127   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_HC_WALL(:,JL)
00128 END DO
00129 DO JL=1,NDESC_WALL_LAYER
00130   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_TC_WALL(:,JL) 
00131 END DO
00132 DO JL=1,NDESC_WALL_LAYER
00133   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_D_WALL (:,JL)
00134 END DO
00135 DO JL=1,NDESC_FLOOR_LAYER
00136   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_HC_FLOOR(:,JL)
00137 END DO
00138 DO JL=1,NDESC_FLOOR_LAYER
00139   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_TC_FLOOR(:,JL) 
00140 END DO
00141 DO JL=1,NDESC_FLOOR_LAYER
00142   CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_D_FLOOR (:,JL)
00143 END DO
00144 !
00145  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_SHGC(:)
00146  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_U_WIN(:)
00147  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_GR(:) 
00148 !
00149  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_F_WASTE_CAN(:)
00150  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_F_WATER_COND(:)
00151  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_COP_RAT(:)
00152  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_EFF_HEAT(:)
00153  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_INF(:)
00154  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_V_VENT(:) 
00155  CALL UP_DESC_IND_W(NDESC_CODE) ; ZWORK(I1:I2) = XDESC_GREENROOF(:) 
00156 !
00157  CALL UP_DESC_IND_W(NDESC_USE) ; ZWORK(I1:I2) = FLOAT(NDESC_USE_LIST(:))
00158  CALL UP_DESC_IND_W(NDESC_USE) ; ZWORK(I1:I2) = XDESC_TCOOL_TARGET(:)
00159  CALL UP_DESC_IND_W(NDESC_USE) ; ZWORK(I1:I2) = XDESC_THEAT_TARGET(:)
00160  CALL UP_DESC_IND_W(NDESC_USE) ; ZWORK(I1:I2) = XDESC_QIN(:)
00161  CALL UP_DESC_IND_W(NDESC_USE) ; ZWORK(I1:I2) = XDESC_QIN_FLAT(:)
00162  CALL UP_DESC_IND_W(NDESC_USE) ; ZWORK(I1:I2) = XDESC_SHGC_SH(:)
00163  CALL UP_DESC_IND_W(NDESC_USE) ; ZWORK(I1:I2) = XDESC_SHADE(:)
00164  CALL UP_DESC_IND_W(NDESC_USE) ; ZWORK(I1:I2) = XDESC_NATVENT(:)
00165 !
00166  CALL UP_DESC_IND_W(NDESC_AGE) ; ZWORK(I1:I2) = FLOAT(NDESC_AGE_LIST(:))
00167  CALL UP_DESC_IND_W(NDESC_AGE) ; ZWORK(I1:I2) = FLOAT(NDESC_AGE_DATE(:))
00168 !
00169 YCOMMENT='Descriptive building data'
00170  CALL WRITE_SURF(HPROGRAM,'BLD_DESC_DATA',ZWORK,IRESP,YCOMMENT,HDIR='-')
00171 DEALLOCATE(ZWORK)
00172 !
00173 IF (LHOOK) CALL DR_HOOK('WRITE_BLD_DESCRIPTION',1,ZHOOK_HANDLE)
00174 !-------------------------------------------------------------------------------
00175 CONTAINS
00176 SUBROUTINE UP_DESC_IND_W(K)
00177 INTEGER, INTENT(IN) :: K
00178 I1=I2+1
00179 I2=I2+K
00180 END SUBROUTINE UP_DESC_IND_W
00181 !-------------------------------------------------------------------------------
00182 !
00183 END SUBROUTINE WRITE_BLD_DESCRIPTION