Merge branch 'LIBTOOLS-master' into MNH-52X
[MNH-git_open_source-lfs.git] / src / SURFEX / write_diag_pgd_tebn.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE WRITE_DIAG_PGD_TEB_n(HPROGRAM)
7 !     #########################################
8 !
9 !!****  *WRITE_DIAG_PGD_TEB_GARDEN_n* - writes the ISBA physiographic diagnostic fields
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!**  METHOD
15 !!    ------
16 !!
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!      V. Masson   *Meteo France*      
31 !!
32 !!    MODIFICATIONS
33 !!    -------------
34 !!      Original    01/2004 
35 !!      Modified    10/2004 by P. Le Moigne: add XZ0REL, XVEGTYPE_PATCH
36 !!      Modified    11/2005 by P. Le Moigne: limit length of VEGTYPE_PATCH field names
37 !-------------------------------------------------------------------------------
38 !
39 !*       0.    DECLARATIONS
40 !              ------------
41 !
42 USE MODD_SURF_PAR,       ONLY : XUNDEF
43 USE MODD_TEB_n
44 USE MODD_BEM_n, ONLY : XN_FLOOR, NFLOOR_LAYER, XHC_FLOOR, XTC_FLOOR, XD_FLOOR
45
46 !
47 USE MODD_IO_SURF_FA, ONLY : LFANOCOMPACT, LPREP
48 !
49 USE MODI_INIT_IO_SURF_n
50 USE MODI_WRITE_SURF
51 USE MODI_END_IO_SURF_n
52 !
53 !
54 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
55 USE PARKIND1  ,ONLY : JPRB
56 !
57 IMPLICIT NONE
58 !
59 !*       0.1   Declarations of arguments
60 !              -------------------------
61 !
62  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
63 !
64 !*       0.2   Declarations of local variables
65 !              -------------------------------
66 !
67 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
68  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
69  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
70 INTEGER           :: JLAYER         ! loop counter on layers
71 !
72 REAL(KIND=JPRB) :: ZHOOK_HANDLE
73 !-------------------------------------------------------------------------------
74 !
75 !         Initialisation for IO
76 !
77 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_TEB_N',0,ZHOOK_HANDLE)
78  CALL INIT_IO_SURF_n(HPROGRAM,'TOWN  ','TEB   ','WRITE')
79 !
80 !-------------------------------------------------------------------------------
81 !
82 !         Geometric parameters
83 !
84 YRECFM='BLD'
85 YCOMMENT='building fraction (-)'
86  CALL WRITE_SURF(HPROGRAM,YRECFM,XBLD(:),IRESP,HCOMMENT=YCOMMENT)
87 !
88 YRECFM='WALL_O_HOR'
89 YCOMMENT='Wall surface over plan area surface (-)'
90  CALL WRITE_SURF(HPROGRAM,YRECFM,XWALL_O_HOR(:),IRESP,HCOMMENT=YCOMMENT)
91 !
92 YRECFM='BLD_HEIGHT'
93 YCOMMENT='Building Height (m)'
94  CALL WRITE_SURF(HPROGRAM,YRECFM,XBLD_HEIGHT(:),IRESP,HCOMMENT=YCOMMENT)
95 !
96 YRECFM='Z0_TOWN'
97 YCOMMENT='Town roughness length (m)'
98  CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0_TOWN(:),IRESP,HCOMMENT=YCOMMENT)
99 !
100 YRECFM='XROAD_DIR'
101 YCOMMENT='Road direction'
102  CALL WRITE_SURF(HPROGRAM,YRECFM,XROAD_DIR(:),IRESP,HCOMMENT=YCOMMENT)
103 !
104 YRECFM='GARDEN_FRAC'
105 YCOMMENT='Garden fraction (-)'
106  CALL WRITE_SURF(HPROGRAM,YRECFM,XGARDEN(:),IRESP,HCOMMENT=YCOMMENT)
107 !
108 YRECFM='GREENROOF_FRAC'
109 YCOMMENT='Greenroof fraction (-)'
110  CALL WRITE_SURF(HPROGRAM,YRECFM,XGREENROOF(:),IRESP,HCOMMENT=YCOMMENT)
111 !
112 !-------------------------------------------------------------------------------
113 !
114 !         Building parameters
115 !
116 YRECFM='ALB_ROOF'
117 YCOMMENT='Roof Albedo'
118  CALL WRITE_SURF(HPROGRAM,YRECFM,XALB_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
119 !
120 YRECFM='EMIS_ROOF'
121 YCOMMENT='Roof Emissivity'
122  CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
123 !
124 DO JLAYER=1,NROOF_LAYER
125   WRITE(YRECFM,FMT='(A,I1.1)') 'HC_ROOF',JLAYER
126   YCOMMENT='Roof Heat Capacity'
127   CALL WRITE_SURF(HPROGRAM,YRECFM,XHC_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
128 END DO
129 !
130 DO JLAYER=1,NROOF_LAYER
131   WRITE(YRECFM,FMT='(A,I1.1)') 'TC_ROOF',JLAYER
132   YCOMMENT='Roof thermal conductivity'
133   CALL WRITE_SURF(HPROGRAM,YRECFM,XTC_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
134 END DO
135 !
136 DO JLAYER=1,NROOF_LAYER
137   WRITE(YRECFM,FMT='(A,I1.1)') 'D_ROOF',JLAYER
138   YCOMMENT='Roof layer thickness'
139   CALL WRITE_SURF(HPROGRAM,YRECFM,XD_ROOF(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
140 END DO
141 !
142 YRECFM='ROUGH_ROOF'
143 YCOMMENT='Roof roughness'
144  CALL WRITE_SURF(HPROGRAM,YRECFM,XROUGH_ROOF(:),IRESP,HCOMMENT=YCOMMENT)
145 !
146 YRECFM='ALB_WALL'
147 YCOMMENT='WALL Albedo'
148  CALL WRITE_SURF(HPROGRAM,YRECFM,XALB_WALL(:),IRESP,HCOMMENT=YCOMMENT)
149 !
150 YRECFM='EMIS_WALL'
151 YCOMMENT='WALL Emissivity'
152  CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS_WALL(:),IRESP,HCOMMENT=YCOMMENT)
153 !
154 DO JLAYER=1,NWALL_LAYER
155   WRITE(YRECFM,FMT='(A,I1.1)') 'HC_WALL',JLAYER
156   YCOMMENT='WALL Heat Capacity'
157   CALL WRITE_SURF(HPROGRAM,YRECFM,XHC_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
158 END DO
159 !
160 DO JLAYER=1,NWALL_LAYER
161   WRITE(YRECFM,FMT='(A,I1.1)') 'TC_WALL',JLAYER
162   YCOMMENT='WALL thermal conductivity'
163   CALL WRITE_SURF(HPROGRAM,YRECFM,XTC_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
164 END DO
165 !
166 DO JLAYER=1,NWALL_LAYER
167   WRITE(YRECFM,FMT='(A,I1.1)') 'D_WALL',JLAYER
168   YCOMMENT='WALL layer thickness'
169   CALL WRITE_SURF(HPROGRAM,YRECFM,XD_WALL(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
170 END DO
171 !
172 YRECFM='ROUGH_WALL'
173 YCOMMENT='Wall roughness'
174  CALL WRITE_SURF(HPROGRAM,YRECFM,XROUGH_WALL(:),IRESP,HCOMMENT=YCOMMENT)
175 !
176 !-------------------------------------------------------------------------------
177 !
178 !         Road parameters
179 !
180 YRECFM='ALB_ROAD'
181 YCOMMENT='ROAD Albedo'
182  CALL WRITE_SURF(HPROGRAM,YRECFM,XALB_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
183 !
184 YRECFM='EMIS_ROAD'
185 YCOMMENT='ROAD Emissivity'
186  CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS_ROAD(:),IRESP,HCOMMENT=YCOMMENT)
187 !
188 DO JLAYER=1,NROAD_LAYER
189   WRITE(YRECFM,FMT='(A,I1.1)') 'HC_ROAD',JLAYER
190   YCOMMENT='ROAD Heat Capacity'
191   CALL WRITE_SURF(HPROGRAM,YRECFM,XHC_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
192 END DO
193 !
194 DO JLAYER=1,NROAD_LAYER
195   WRITE(YRECFM,FMT='(A,I1.1)') 'TC_ROAD',JLAYER
196   YCOMMENT='ROAD thermal conductivity'
197   CALL WRITE_SURF(HPROGRAM,YRECFM,XTC_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
198 END DO
199 !
200 DO JLAYER=1,NROAD_LAYER
201   WRITE(YRECFM,FMT='(A,I1.1)') 'D_ROAD',JLAYER
202   YCOMMENT='ROAD layer thickness'
203   CALL WRITE_SURF(HPROGRAM,YRECFM,XD_ROAD(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
204 END DO
205 !
206 !-------------------------------------------------------------------------------
207 !
208 !         Anthropogneic Fluxes
209 !
210 YRECFM='H_TRAFFIC'
211 YCOMMENT='Traffic Heat Flux'
212  CALL WRITE_SURF(HPROGRAM,YRECFM,XH_TRAFFIC(:),IRESP,HCOMMENT=YCOMMENT)
213 !
214 YRECFM='LE_TRAFFIC'
215 YCOMMENT='Traffic Latent Flux'
216  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE_TRAFFIC(:),IRESP,HCOMMENT=YCOMMENT)
217 !
218 YRECFM='H_INDUSTRY'
219 YCOMMENT='INDUSTRY Heat Flux'
220  CALL WRITE_SURF(HPROGRAM,YRECFM,XH_INDUSTRY(:),IRESP,HCOMMENT=YCOMMENT)
221 !
222 YRECFM='LE_INDUSTRY'
223 YCOMMENT='INDUSTRY Latent Flux'
224  CALL WRITE_SURF(HPROGRAM,YRECFM,XLE_INDUSTRY(:),IRESP,HCOMMENT=YCOMMENT)
225 !
226 !-------------------------------------------------------------------------------
227 !
228 !         Building Energy Model parameters
229 !
230 IF (CBEM=='BEM') THEN
231    YRECFM='N_FLOOR'
232    YCOMMENT='Number of floors'
233    CALL WRITE_SURF(HPROGRAM,YRECFM,XN_FLOOR(:),IRESP,HCOMMENT=YCOMMENT)
234
235    DO JLAYER=1,NFLOOR_LAYER
236      WRITE(YRECFM,FMT='(A,I1.1)') 'HC_FLOOR',JLAYER
237      YCOMMENT='FLOOR Heat Capacity'
238      CALL WRITE_SURF(HPROGRAM,YRECFM,XHC_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
239    END DO
240    !
241    DO JLAYER=1,NFLOOR_LAYER
242      WRITE(YRECFM,FMT='(A,I1.1)') 'TC_FLOOR',JLAYER
243      YCOMMENT='FLOOR thermal conductivity'
244      CALL WRITE_SURF(HPROGRAM,YRECFM,XTC_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
245    END DO
246    !
247    DO JLAYER=1,NFLOOR_LAYER
248      WRITE(YRECFM,FMT='(A,I1.1)') 'D_FLOOR',JLAYER
249      YCOMMENT='FLOOR layer thickness'
250      CALL WRITE_SURF(HPROGRAM,YRECFM,XD_FLOOR(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
251    END DO
252 ENDIF
253 !
254 !-------------------------------------------------------------------------------
255 !
256 !         End of IO
257 !
258  CALL END_IO_SURF_n(HPROGRAM)
259 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_TEB_N',1,ZHOOK_HANDLE)
260 !
261 !
262 END SUBROUTINE WRITE_DIAG_PGD_TEB_n