SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
read_bld_descriptionn.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########################
6  SUBROUTINE read_bld_description_n (&
7  bdd, &
8  hprogram)
9 ! #########################
10 !
11 !!
12 !! PURPOSE
13 !! -------
14 !!
15 !! METHOD
16 !! ------
17 !!
18 !!
19 !! EXTERNAL
20 !! --------
21 !!
22 !! IMPLICIT ARGUMENTS
23 !! ------------------
24 !!
25 !! REFERENCE
26 !! ---------
27 !!
28 !! AUTHOR
29 !! ------
30 !!
31 !! V. Masson Meteo-France
32 !!
33 !! MODIFICATION
34 !! ------------
35 !!
36 !! Original 05/2012
37 !
38 !----------------------------------------------------------------------------
39 !
40 !* 0. DECLARATION
41 ! -----------
42 !
43 !
44 !
45 !
46 !
47 !
49 !
51 USE modi_abor1_sfx
52 !
53 !
54 USE yomhook ,ONLY : lhook, dr_hook
55 USE parkind1 ,ONLY : jprb
56 !
57 IMPLICIT NONE
58 !
59 !* 0.1 Declaration of arguments
60 ! ------------------------
61 !
62 !
63 !
64 !
65 TYPE(bld_desc_t), INTENT(INOUT) :: bdd
66 !
67  CHARACTER(LEN=6), INTENT(IN) :: hprogram
68 !
69 !
70 !* 0.2 Declaration of local variables
71 ! ------------------------------
72 !
73 REAL(KIND=JPRB) :: zhook_handle
74 !
75 REAL, DIMENSION(:), ALLOCATABLE :: zwork
76 INTEGER :: iresp
77 INTEGER :: i1, i2
78 INTEGER :: jl
79 INTEGER :: itot
80 INTEGER :: iversion ! surface version
81 INTEGER :: ibugfix ! surface bugfix version
82 !-------------------------------------------------------------------------------
83 !-------------------------------------------------------------------------------
84 !
85 IF (lhook) CALL dr_hook('READ_BLD_DESCRIPTION_n',0,zhook_handle)
86 !
87 !-------------------------------------------------------------------------------
88 !
89 !* 1. Read file version
90 ! -----------------
91 !
92  CALL read_surf(&
93  hprogram,'VERSION',iversion,iresp)
94  CALL read_surf(&
95  hprogram,'BUG',ibugfix,iresp)
96 !-------------------------------------------------------------------------------
97 !
98 !* 1. Read configuration variables of the descriptive data
99 ! ----------------------------------------------------
100 !
101 ALLOCATE(zwork(7))
102  CALL read_surf(&
103  hprogram,'BLD_DESC_CNF',zwork,iresp,hdir='-')
104 !
105 bdd%NDESC_BLD = nint(zwork(1))
106 bdd%NDESC_AGE = nint(zwork(2))
107 bdd%NDESC_USE = nint(zwork(3))
108 bdd%NDESC_WALL_LAYER = nint(zwork(4))
109 bdd%NDESC_ROOF_LAYER = nint(zwork(5))
110 bdd%NDESC_ROAD_LAYER = nint(zwork(6))
111 bdd%NDESC_FLOOR_LAYER = nint(zwork(7))
112 !
113 DEALLOCATE(zwork)
114 !
115 bdd%NDESC_CODE = bdd%NDESC_BLD * bdd%NDESC_AGE
116 !-------------------------------------------------------------------------------
117 !
118 !* 2. Allocates descriptive data
119 ! --------------------------
120 !
121 !
122 ALLOCATE(bdd%NDESC_BLD_LIST(bdd%NDESC_BLD))
123 ALLOCATE(bdd%NDESC_CODE_LIST(bdd%NDESC_CODE))
124 ALLOCATE(bdd%XDESC_ALB_ROOF(bdd%NDESC_CODE))
125 ALLOCATE(bdd%XDESC_ALB_ROAD(bdd%NDESC_CODE))
126 ALLOCATE(bdd%XDESC_ALB_WALL(bdd%NDESC_CODE))
127 ALLOCATE(bdd%XDESC_EMIS_ROOF(bdd%NDESC_CODE))
128 ALLOCATE(bdd%XDESC_EMIS_ROAD(bdd%NDESC_CODE))
129 ALLOCATE(bdd%XDESC_EMIS_WALL(bdd%NDESC_CODE))
130 ALLOCATE(bdd%XDESC_HC_ROOF(bdd%NDESC_CODE,bdd%NDESC_ROOF_LAYER))
131 ALLOCATE(bdd%XDESC_TC_ROOF(bdd%NDESC_CODE,bdd%NDESC_ROOF_LAYER))
132 ALLOCATE(bdd%XDESC_D_ROOF (bdd%NDESC_CODE,bdd%NDESC_ROOF_LAYER))
133 ALLOCATE(bdd%XDESC_HC_ROAD(bdd%NDESC_CODE,bdd%NDESC_ROAD_LAYER))
134 ALLOCATE(bdd%XDESC_TC_ROAD(bdd%NDESC_CODE,bdd%NDESC_ROAD_LAYER))
135 ALLOCATE(bdd%XDESC_D_ROAD (bdd%NDESC_CODE,bdd%NDESC_ROAD_LAYER))
136 ALLOCATE(bdd%XDESC_HC_WALL(bdd%NDESC_CODE,bdd%NDESC_WALL_LAYER))
137 ALLOCATE(bdd%XDESC_TC_WALL(bdd%NDESC_CODE,bdd%NDESC_WALL_LAYER))
138 ALLOCATE(bdd%XDESC_D_WALL (bdd%NDESC_CODE,bdd%NDESC_WALL_LAYER))
139 ALLOCATE(bdd%XDESC_HC_FLOOR(bdd%NDESC_CODE,bdd%NDESC_FLOOR_LAYER))
140 ALLOCATE(bdd%XDESC_TC_FLOOR(bdd%NDESC_CODE,bdd%NDESC_FLOOR_LAYER))
141 ALLOCATE(bdd%XDESC_D_FLOOR (bdd%NDESC_CODE,bdd%NDESC_FLOOR_LAYER))
142 ALLOCATE(bdd%XDESC_SHGC(bdd%NDESC_CODE))
143 ALLOCATE(bdd%XDESC_U_WIN(bdd%NDESC_CODE))
144 ALLOCATE(bdd%XDESC_GR(bdd%NDESC_CODE))
145 !
146 ALLOCATE(bdd%XDESC_F_WASTE_CAN(bdd%NDESC_CODE))
147 ALLOCATE(bdd%XDESC_F_WATER_COND(bdd%NDESC_CODE))
148 ALLOCATE(bdd%XDESC_COP_RAT(bdd%NDESC_CODE))
149 ALLOCATE(bdd%XDESC_EFF_HEAT(bdd%NDESC_CODE))
150 ALLOCATE(bdd%XDESC_INF(bdd%NDESC_CODE))
151 ALLOCATE(bdd%XDESC_V_VENT(bdd%NDESC_CODE))
152 ALLOCATE(bdd%XDESC_GREENROOF(bdd%NDESC_CODE))
153 !
154 ALLOCATE(bdd%XDESC_EMIS_PANEL(bdd%NDESC_CODE))
155 ALLOCATE(bdd%XDESC_ALB_PANEL (bdd%NDESC_CODE))
156 ALLOCATE(bdd%XDESC_EFF_PANEL (bdd%NDESC_CODE))
157 ALLOCATE(bdd%XDESC_FRAC_PANEL(bdd%NDESC_CODE))
158 !
159 ALLOCATE(bdd%NDESC_USE_LIST(bdd%NDESC_USE))
160 ALLOCATE(bdd%XDESC_TCOOL_TARGET(bdd%NDESC_USE))
161 ALLOCATE(bdd%XDESC_THEAT_TARGET(bdd%NDESC_USE))
162 ALLOCATE(bdd%XDESC_QIN(bdd%NDESC_USE))
163 ALLOCATE(bdd%XDESC_QIN_FLAT(bdd%NDESC_USE))
164 ALLOCATE(bdd%XDESC_SHGC_SH(bdd%NDESC_USE))
165 ALLOCATE(bdd%XDESC_SHADE(bdd%NDESC_USE))
166 ALLOCATE(bdd%XDESC_NATVENT(bdd%NDESC_USE))
167 ALLOCATE(bdd%XDESC_RESIDENTIAL(bdd%NDESC_USE))
168 !
169 ALLOCATE(bdd%NDESC_AGE_LIST(bdd%NDESC_AGE))
170 ALLOCATE(bdd%NDESC_AGE_DATE(bdd%NDESC_AGE))
171 !
172 !* default data for old files
173 bdd%XDESC_EMIS_PANEL = 0.9
174 bdd%XDESC_ALB_PANEL = 0.1
175 bdd%XDESC_EFF_PANEL = 0.14
176 bdd%XDESC_FRAC_PANEL = 0. ! no solar panels for old versions of SURFEX
177 !-------------------------------------------------------------------------------
178 !
179 !* 3. Read descriptive data
180 ! ---------------------
181 !
182 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 &
183  + 9*bdd%NDESC_USE + 2*bdd%NDESC_AGE + bdd%NDESC_BLD
184 ALLOCATE(zwork(itot))
185 !
186  CALL read_surf(&
187  hprogram,'BLD_DESC_DAT',zwork,iresp,hdir='-')
188 !
189 !
190 i1=0 ; i2=0
191  CALL up_desc_ind(bdd%NDESC_BLD) ; bdd%NDESC_BLD_LIST(:) = nint(zwork(i1:i2))
192  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%NDESC_CODE_LIST(:) = nint(zwork(i1:i2))
193  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_ALB_ROOF(:) = zwork(i1:i2)
194  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_ALB_ROAD(:) = zwork(i1:i2)
195  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_ALB_WALL(:) = zwork(i1:i2)
196  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_EMIS_ROOF(:) = zwork(i1:i2)
197  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_EMIS_ROAD(:) = zwork(i1:i2)
198  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_EMIS_WALL(:) = zwork(i1:i2)
199 DO jl=1,bdd%NDESC_ROOF_LAYER
200  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_HC_ROOF(:,jl) = zwork(i1:i2)
201 END DO
202 DO jl=1,bdd%NDESC_ROOF_LAYER
203  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_TC_ROOF(:,jl) = zwork(i1:i2)
204 END DO
205 DO jl=1,bdd%NDESC_ROOF_LAYER
206  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_D_ROOF (:,jl) = zwork(i1:i2)
207 END DO
208 DO jl=1,bdd%NDESC_ROAD_LAYER
209  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_HC_ROAD(:,jl) = zwork(i1:i2)
210 END DO
211 DO jl=1,bdd%NDESC_ROAD_LAYER
212  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_TC_ROAD(:,jl) = zwork(i1:i2)
213 END DO
214 DO jl=1,bdd%NDESC_ROAD_LAYER
215  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_D_ROAD (:,jl) = zwork(i1:i2)
216 END DO
217 DO jl=1,bdd%NDESC_WALL_LAYER
218  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_HC_WALL(:,jl) = zwork(i1:i2)
219 END DO
220 DO jl=1,bdd%NDESC_WALL_LAYER
221  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_TC_WALL(:,jl) = zwork(i1:i2)
222 END DO
223 DO jl=1,bdd%NDESC_WALL_LAYER
224  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_D_WALL (:,jl) = zwork(i1:i2)
225 END DO
226 DO jl=1,bdd%NDESC_FLOOR_LAYER
227  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_HC_FLOOR(:,jl) = zwork(i1:i2)
228 END DO
229 DO jl=1,bdd%NDESC_FLOOR_LAYER
230  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_TC_FLOOR(:,jl) = zwork(i1:i2)
231 END DO
232 DO jl=1,bdd%NDESC_FLOOR_LAYER
233  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_D_FLOOR (:,jl) = zwork(i1:i2)
234 END DO
235 !
236  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_SHGC(:) = zwork(i1:i2)
237  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_U_WIN(:) = zwork(i1:i2)
238  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_GR(:) = zwork(i1:i2)
239 !
240  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_F_WASTE_CAN(:) = zwork(i1:i2)
241  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_F_WATER_COND(:) = zwork(i1:i2)
242  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_COP_RAT(:) = zwork(i1:i2)
243  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_EFF_HEAT(:) = zwork(i1:i2)
244  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_INF(:) = zwork(i1:i2)
245  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_V_VENT(:) = zwork(i1:i2)
246  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_GREENROOF(:) = zwork(i1:i2)
247  IF (iversion>7 .OR. (iversion==7 .AND. ibugfix>=4)) THEN
248  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_EMIS_PANEL(:) = zwork(i1:i2)
249  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_ALB_PANEL(:) = zwork(i1:i2)
250  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_EFF_PANEL(:) = zwork(i1:i2)
251  CALL up_desc_ind(bdd%NDESC_CODE) ; bdd%XDESC_FRAC_PANEL(:) = zwork(i1:i2)
252  END IF
253 !
254  CALL up_desc_ind(bdd%NDESC_USE) ; bdd%NDESC_USE_LIST(:) = nint(zwork(i1:i2))
255  CALL up_desc_ind(bdd%NDESC_USE) ; bdd%XDESC_TCOOL_TARGET(:) = zwork(i1:i2)
256  CALL up_desc_ind(bdd%NDESC_USE) ; bdd%XDESC_THEAT_TARGET(:) = zwork(i1:i2)
257  CALL up_desc_ind(bdd%NDESC_USE) ; bdd%XDESC_QIN(:) = zwork(i1:i2)
258  CALL up_desc_ind(bdd%NDESC_USE) ; bdd%XDESC_QIN_FLAT(:) = zwork(i1:i2)
259  CALL up_desc_ind(bdd%NDESC_USE) ; bdd%XDESC_SHGC_SH(:) = zwork(i1:i2)
260  CALL up_desc_ind(bdd%NDESC_USE) ; bdd%XDESC_SHADE(:) = zwork(i1:i2)
261  CALL up_desc_ind(bdd%NDESC_USE) ; bdd%XDESC_NATVENT(:) = zwork(i1:i2)
262  CALL up_desc_ind(bdd%NDESC_USE) ; bdd%XDESC_RESIDENTIAL(:) = zwork(i1:i2)
263 !
264  CALL up_desc_ind(bdd%NDESC_AGE) ; bdd%NDESC_AGE_LIST(:) = nint(zwork(i1:i2))
265  CALL up_desc_ind(bdd%NDESC_AGE) ; bdd%NDESC_AGE_DATE(:) = nint(zwork(i1:i2))
266 !
267 DEALLOCATE(zwork)
268 !
269 IF (lhook) CALL dr_hook('READ_BLD_DESCRIPTION_n',1,zhook_handle)
270 !-------------------------------------------------------------------------------
271  CONTAINS
272 SUBROUTINE up_desc_ind(K)
273 INTEGER, INTENT(IN) :: k
274 i1=i2+1
275 i2=i2+k
276 END SUBROUTINE up_desc_ind
277 !-------------------------------------------------------------------------------
278 !
279 END SUBROUTINE read_bld_description_n
subroutine up_desc_ind(K)
subroutine read_bld_description_n(BDD, HPROGRAM)