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