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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WRITE_DIAG_PGD_TEB_n(HPROGRAM)
00003 !     #########################################
00004 !
00005 !!****  *WRITE_DIAG_PGD_TEB_GARDEN_n* - writes the ISBA physiographic diagnostic fields
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    EXTERNAL
00014 !!    --------
00015 !!
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!
00024 !!    AUTHOR
00025 !!    ------
00026 !!      V. Masson   *Meteo France*      
00027 !!
00028 !!    MODIFICATIONS
00029 !!    -------------
00030 !!      Original    01/2004 
00031 !!      Modified    10/2004 by P. Le Moigne: add XZ0REL, XVEGTYPE_PATCH
00032 !!      Modified    11/2005 by P. Le Moigne: limit length of VEGTYPE_PATCH field names
00033 !-------------------------------------------------------------------------------
00034 !
00035 !*       0.    DECLARATIONS
00036 !              ------------
00037 !
00038 USE MODD_SURF_PAR,       ONLY : XUNDEF
00039 USE MODD_TEB_n
00040 USE MODD_BEM_n, ONLY : XN_FLOOR, NFLOOR_LAYER, XHC_FLOOR, XTC_FLOOR, XD_FLOOR
00041 
00042 !
00043 USE MODD_IO_SURF_FA, ONLY : LFANOCOMPACT, LPREP
00044 !
00045 USE MODI_INIT_IO_SURF_n
00046 USE MODI_WRITE_SURF
00047 USE MODI_END_IO_SURF_n
00048 !
00049 !
00050 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00051 USE PARKIND1  ,ONLY : JPRB
00052 !
00053 IMPLICIT NONE
00054 !
00055 !*       0.1   Declarations of arguments
00056 !              -------------------------
00057 !
00058  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00059 !
00060 !*       0.2   Declarations of local variables
00061 !              -------------------------------
00062 !
00063 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00064  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
00065  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00066 INTEGER           :: JLAYER         ! loop counter on layers
00067 !
00068 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00069 !-------------------------------------------------------------------------------
00070 !
00071 !         Initialisation for IO
00072 !
00073 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_TEB_N',0,ZHOOK_HANDLE)
00074  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','WRITE')
00075 !
00076 !-------------------------------------------------------------------------------
00077 !
00078 !         Geometric parameters
00079 !
00080 YRECFM='BLD'
00081 YCOMMENT='building fraction (-)'
00082  CALL WRITE_SURF(HPROGRAM,YRECFM,XBLD(:),IRESP,HCOMMENT=YCOMMENT)
00083 !
00084 YRECFM='WALL_O_HOR'
00085 YCOMMENT='Wall surface over plan area surface (-)'
00086  CALL WRITE_SURF(HPROGRAM,YRECFM,XWALL_O_HOR(:),IRESP,HCOMMENT=YCOMMENT)
00087 !
00088 YRECFM='BLD_HEIGHT'
00089 YCOMMENT='Building Height (m)'
00090  CALL WRITE_SURF(HPROGRAM,YRECFM,XBLD_HEIGHT(:),IRESP,HCOMMENT=YCOMMENT)
00091 !
00092 YRECFM='Z0_TOWN'
00093 YCOMMENT='Town roughness length (m)'
00094  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
00095 !
00096 YRECFM='XROAD_DIR'
00097 YCOMMENT='Road direction'
00098  CALL WRITE_SURF(HPROGRAM,YRECFM,XROAD_DIR(:),IRESP,HCOMMENT=YCOMMENT)
00099 !
00100 YRECFM='GARDEN_FRAC'
00101 YCOMMENT='Garden fraction (-)'
00102  CALL WRITE_SURF(HPROGRAM,YRECFM,XGARDEN(:),IRESP,HCOMMENT=YCOMMENT)
00103 !
00104 YRECFM='GREENROOF_FRAC'
00105 YCOMMENT='Greenroof fraction (-)'
00106  CALL WRITE_SURF(HPROGRAM,YRECFM,XGREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
00107 !
00108 !-------------------------------------------------------------------------------
00109 !
00110 !         Building parameters
00111 !
00112 YRECFM='ALB_ROOF'
00113 YCOMMENT='Roof Albedo'
00114  CALL WRITE_SURF(HPROGRAM,YRECFM,XALB_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
00115 !
00116 YRECFM='EMIS_ROOF'
00117 YCOMMENT='Roof Emissivity'
00118  CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
00119 !
00120 DO JLAYER=1,NROOF_LAYER
00121   WRITE(YRECFM,FMT='(A,I1.1)') 'HC_ROOF',JLAYER
00122   YCOMMENT='Roof Heat Capacity'
00123   CALL WRITE_SURF(HPROGRAM,YRECFM,XHC_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00124 END DO
00125 !
00126 DO JLAYER=1,NROOF_LAYER
00127   WRITE(YRECFM,FMT='(A,I1.1)') 'TC_ROOF',JLAYER
00128   YCOMMENT='Roof thermal conductivity'
00129   CALL WRITE_SURF(HPROGRAM,YRECFM,XTC_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00130 END DO
00131 !
00132 DO JLAYER=1,NROOF_LAYER
00133   WRITE(YRECFM,FMT='(A,I1.1)') 'D_ROOF',JLAYER
00134   YCOMMENT='Roof layer thickness'
00135   CALL WRITE_SURF(HPROGRAM,YRECFM,XD_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00136 END DO
00137 !
00138 YRECFM='ROUGH_ROOF'
00139 YCOMMENT='Roof roughness'
00140  CALL WRITE_SURF(HPROGRAM,YRECFM,XROUGH_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
00141 !
00142 YRECFM='ALB_WALL'
00143 YCOMMENT='WALL Albedo'
00144  CALL WRITE_SURF(HPROGRAM,YRECFM,XALB_WALL(:),IRESP,HCOMMENT=YCOMMENT)
00145 !
00146 YRECFM='EMIS_WALL'
00147 YCOMMENT='WALL Emissivity'
00148  CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS_WALL(:),IRESP,HCOMMENT=YCOMMENT)
00149 !
00150 DO JLAYER=1,NWALL_LAYER
00151   WRITE(YRECFM,FMT='(A,I1.1)') 'HC_WALL',JLAYER
00152   YCOMMENT='WALL Heat Capacity'
00153   CALL WRITE_SURF(HPROGRAM,YRECFM,XHC_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00154 END DO
00155 !
00156 DO JLAYER=1,NWALL_LAYER
00157   WRITE(YRECFM,FMT='(A,I1.1)') 'TC_WALL',JLAYER
00158   YCOMMENT='WALL thermal conductivity'
00159   CALL WRITE_SURF(HPROGRAM,YRECFM,XTC_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00160 END DO
00161 !
00162 DO JLAYER=1,NWALL_LAYER
00163   WRITE(YRECFM,FMT='(A,I1.1)') 'D_WALL',JLAYER
00164   YCOMMENT='WALL layer thickness'
00165   CALL WRITE_SURF(HPROGRAM,YRECFM,XD_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00166 END DO
00167 !
00168 YRECFM='ROUGH_WALL'
00169 YCOMMENT='Wall roughness'
00170  CALL WRITE_SURF(HPROGRAM,YRECFM,XROUGH_WALL(:),IRESP,HCOMMENT=YCOMMENT)
00171 !
00172 !-------------------------------------------------------------------------------
00173 !
00174 !         Road parameters
00175 !
00176 YRECFM='ALB_ROAD'
00177 YCOMMENT='ROAD Albedo'
00178  CALL WRITE_SURF(HPROGRAM,YRECFM,XALB_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
00179 !
00180 YRECFM='EMIS_ROAD'
00181 YCOMMENT='ROAD Emissivity'
00182  CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
00183 !
00184 DO JLAYER=1,NROAD_LAYER
00185   WRITE(YRECFM,FMT='(A,I1.1)') 'HC_ROAD',JLAYER
00186   YCOMMENT='ROAD Heat Capacity'
00187   CALL WRITE_SURF(HPROGRAM,YRECFM,XHC_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00188 END DO
00189 !
00190 DO JLAYER=1,NROAD_LAYER
00191   WRITE(YRECFM,FMT='(A,I1.1)') 'TC_ROAD',JLAYER
00192   YCOMMENT='ROAD thermal conductivity'
00193   CALL WRITE_SURF(HPROGRAM,YRECFM,XTC_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00194 END DO
00195 !
00196 DO JLAYER=1,NROAD_LAYER
00197   WRITE(YRECFM,FMT='(A,I1.1)') 'D_ROAD',JLAYER
00198   YCOMMENT='ROAD layer thickness'
00199   CALL WRITE_SURF(HPROGRAM,YRECFM,XD_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00200 END DO
00201 !
00202 !-------------------------------------------------------------------------------
00203 !
00204 !         Anthropogneic Fluxes
00205 !
00206 YRECFM='H_TRAFFIC'
00207 YCOMMENT='Traffic Heat Flux'
00208  CALL WRITE_SURF(HPROGRAM,YRECFM,XH_TRAFFIC(:),IRESP,HCOMMENT=YCOMMENT)
00209 !
00210 YRECFM='LE_TRAFFIC'
00211 YCOMMENT='Traffic Latent Flux'
00212  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE_TRAFFIC(:),IRESP,HCOMMENT=YCOMMENT)
00213 !
00214 YRECFM='H_INDUSTRY'
00215 YCOMMENT='INDUSTRY Heat Flux'
00216  CALL WRITE_SURF(HPROGRAM,YRECFM,XH_INDUSTRY(:),IRESP,HCOMMENT=YCOMMENT)
00217 !
00218 YRECFM='LE_INDUSTRY'
00219 YCOMMENT='INDUSTRY Latent Flux'
00220  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE_INDUSTRY(:),IRESP,HCOMMENT=YCOMMENT)
00221 !
00222 !-------------------------------------------------------------------------------
00223 !
00224 !         Building Energy Model parameters
00225 !
00226 IF (CBEM=='BEM') THEN
00227    YRECFM='N_FLOOR'
00228    YCOMMENT='Number of floors'
00229    CALL WRITE_SURF(HPROGRAM,YRECFM,XN_FLOOR(:),IRESP,HCOMMENT=YCOMMENT)
00230 
00231    DO JLAYER=1,NFLOOR_LAYER
00232      WRITE(YRECFM,FMT='(A,I1.1)') 'HC_FLOOR',JLAYER
00233      YCOMMENT='FLOOR Heat Capacity'
00234      CALL WRITE_SURF(HPROGRAM,YRECFM,XHC_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00235    END DO
00236    !
00237    DO JLAYER=1,NFLOOR_LAYER
00238      WRITE(YRECFM,FMT='(A,I1.1)') 'TC_FLOOR',JLAYER
00239      YCOMMENT='FLOOR thermal conductivity'
00240      CALL WRITE_SURF(HPROGRAM,YRECFM,XTC_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00241    END DO
00242    !
00243    DO JLAYER=1,NFLOOR_LAYER
00244      WRITE(YRECFM,FMT='(A,I1.1)') 'D_FLOOR',JLAYER
00245      YCOMMENT='FLOOR layer thickness'
00246      CALL WRITE_SURF(HPROGRAM,YRECFM,XD_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
00247    END DO
00248 ENDIF
00249 !
00250 !-------------------------------------------------------------------------------
00251 !
00252 !         End of IO
00253 !
00254  CALL END_IO_SURF_n(HPROGRAM)
00255 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_TEB_N',1,ZHOOK_HANDLE)
00256 !
00257 !
00258 END SUBROUTINE WRITE_DIAG_PGD_TEB_n