1 | include(dom.inc)
2 |
3 | SUBROUTINE avbp2dom(file1, file2, file3 )
4 |
5 | ! ===============================================================!
6 | ! !
7 | ! avbp2dom.F : Reads AVBP mesh files and starts data structure !
8 | ! !
9 | ! in : The .coor file name 'file1' !
10 | ! The .conn file name 'file2' !
11 | ! The .exBound filename 'file3' !
12 | ! !
13 | ! author : J. AMAYA (avril 2007) !
14 | ! !
15 | ! Nota : i_nnodes and i_nfacesmax must be initialized in !
16 | ! this subroutine !
17 | ! !
18 | ! ===============================================================!
19 |
20 | USE avbp_coor
21 | USE avbp_conn
22 | USE avbp_exBound
23 | USE datas
24 |
25 | IMPLICIT NONE
26 |
27 | INCLUDE 'dom_constants.h'
28 |
29 | ! IN
30 | CHARACTER*80 file1
31 | CHARACTER*80 file2
32 | CHARACTER*80 file3
33 |
34 | ! LOCAL
35 | DOM_INT :: i, j, iel, k, beg, iend, idx
36 | DOM_INT :: nbeg, nlen, nend, pnode
37 | DOM_INT :: nfacevert, nfaces, nvert
38 | DOM_INT :: cellid
39 | DOM_INT :: facelist6(6), facelist4(4), facelist3(3)
40 | DOM_INT :: nodelist4(4), nodelist3(3), nodelist2(2)
41 | DOM_INT :: nbpatches, facepatch
42 |
43 | character*80 :: patchname, patchkey
44 |
45 | type(cell), pointer :: new_cell
46 |
47 | !-- CL are treated in initbc
48 | ! DOM_REAL, allocatable, dimension(:) :: bndy_epsil
49 | ! DOM_REAL, allocatable, dimension(:) :: bndy_Tw
50 | !--
51 |
52 | ! --------------------!
53 | ! Read AVBP coor file !
54 | ! --------------------!
55 | coorfile = file1
56 | CALL readcoor
57 |
58 | i_nnodes = coor_nnode
59 | conn_ndim = coor_ndim
60 |
61 | ! ---------------------!
62 | ! Initialise the nodes !
63 | ! ---------------------!
64 |
65 | ALLOCATE(node_list(3,i_nnodes))
66 | ALLOCATE(facesatnode(i_nnodes))
67 |
68 | DO i=1, i_nnodes
69 | NULLIFY(facesatnode(i)%fatnode_ptr)
70 | ENDDO
71 |
72 | IF (coor_ndim.eq.3) THEN
73 | node_list(1,:) = coor(1,:)
74 | node_list(2,:) = coor(2,:)
75 | node_list(3,:) = coor(3,:)
76 | ELSE
77 | node_list(1,:) = coor(1,:)
78 | node_list(2,:) = coor(2,:)
79 | node_list(3,:) = 0.0d0
80 | ENDIF
81 |
82 | CALL destroycoormemory
83 |
84 | ! ---------------------!
85 | ! Read connection file !
86 | ! ---------------------!
87 |
88 | connfile = file2
89 | CALL readconn
90 |
91 | ! -------------------------------------------!
92 | ! Read .exBound file and boundary properties !
93 | ! -------------------------------------------!
94 |
95 | exBound_ndim = coor_ndim
96 | exBoundfile = file3
97 | CALL readexBound
98 |
99 | ALLOCATE(nodepatch(0:exBound_npbound, coor_nnode))
100 | nodepatch = 0
101 |
102 | do j=1, exBound_npbound
103 | WRITE(*,*) "Reading nodes at patch: ", j
104 | nbeg = exBound_ibound1(j)
105 | nlen = exBound_ibound2(j)
106 | nend = nbeg + nlen - 1
107 |
108 | do i = nbeg, nend
109 | pnode = exBound_ibound(i)
110 | nodepatch(0,pnode) = nodepatch(0,pnode) + 1
111 | idx = nodepatch(0,pnode)
112 | nodepatch(idx,pnode) = j
113 | enddo
114 |
115 | enddo
116 |
117 | !-- CL are donne in initbc
118 | ! -------------------------!
119 | ! Read boundary properties !
120 | ! -------------------------!
121 | !
122 | ! IF (ALLOCATED(bndy_epsil)) DEALLOCATE(bndy_epsil)
123 | ! IF (ALLOCATED(bndy_Tw)) DEALLOCATE(bndy_Tw)
124 | !
125 | ! ALLOCATE(bndy_epsil(0:exBound_mnbpatch))
126 | ! ALLOCATE( bndy_Tw(0:exBound_mnbpatch))
127 | !
128 | ! ------------------------------------------------!
129 | ! Setup default non-boundary faces epsilon and Tw !
130 | ! ------------------------------------------------!
131 | !
132 | ! bndy_epsil(0) = -1.
133 | ! bndy_Tw (0) = 0.
134 | !
135 | ! --------------------------------------!
136 | ! Read BC properties from boundary file !
137 | ! --------------------------------------!
138 | !
139 | ! OPEN(1, FILE=bndyfile, FORM='formatted')
140 | !
141 | ! READ(1,*)
142 | ! READ(1,*) nbpatches
143 | !
144 | ! IF (nbpatches.ne.exBound_mnbpatch) THEN
145 | ! CLOSE(1)
146 | ! WRITE(*,*) " Fatal Error: The number of patches in input "
147 | ! WRITE(*,*) " file input_boundary.dat does not"
148 | ! WRITE(*,*) " match the number of patches of "
149 | ! WRITE(*,*) " the exBound mesh file."
150 | ! STOP
151 | ! ENDIF
152 | !
153 | ! DO i=1, nbpatches
154 | ! READ(1,*)
155 | ! READ(1,*)
156 | ! READ(1,*) patchname
157 | ! READ(1,*) patchkey
158 | ! print*, trim(patchkey)
159 | !
160 | ! -----------------------------------!
161 | ! Detect patch type and set variales !
162 | ! -----------------------------------!
163 | !
164 | ! IF (trim(patchkey).eq.'EMISSIVE_WALL') THEN
165 | !
166 | ! READ(1,*) bndy_epsil(i)
167 | ! READ(1,*) bndy_Tw(i)
168 | !
169 | ! ELSEIF(trim(patchkey).eq.'BLACK_WALL') THEN
170 | !
171 | ! bndy_epsil(i) = 1.
172 | ! READ(1,*) bndy_Tw(i)
173 | !
174 | ! ELSE
175 | !
176 | ! WRITE(*,*) " Fatal Error: Unknown patch type"
177 | ! WRITE(*,*) " ", trim(patchkey)
178 | ! STOP
179 | !
180 | ! ENDIF
181 | !
182 | ! ENDDO
183 | !
184 | ! print*, " => Boundary epsil:",bndy_epsil
185 | ! print*, " => Boundary Tw:",bndy_Tw
186 | !
187 | ! CLOSE(1)
188 | !--
189 |
190 | ! --------------------------------------!
191 | ! Allocating memory for face indexation !
192 | ! --------------------------------------!
193 |
194 | ALLOCATE(faceidx(MAX_NFACES_CELL*conn_ntcell))
195 |
196 | ! -----------------------!
197 | ! Create faces and cells !
198 | ! -----------------------!
199 |
200 | WRITE(*,*) " Building the data structure..."
201 | cellid = 1
202 |
203 | DO iel=1, conn_maxtype
204 | DO i=1, nclength(iel)
205 |
206 | ! -----------------------------------------------------------!
207 | ! Allocate memory space for the new cell (needed in addface) !
208 | ! -----------------------------------------------------------!
209 | ALLOCATE(new_cell)
210 | NULLIFY(new_cell%next_cell)
211 | current_cell => new_cell
212 | current_cell%cell_id = cellid
213 |
214 | SELECT CASE (iel)
215 |
216 | CASE (EL_TRI)
217 |
218 | nfacevert = 2
219 | nvert = 3
220 | nfaces = 3
221 | beg = ncbeg(iel) +((i-1)*nvert)
222 | iend = beg + nvert
223 |
224 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
225 |
226 | ! -----------------!
227 | ! Create Tri faces !
228 | ! -----------------!
229 |
230 | nodelist2=(/ ielno(beg+2), ielno(beg+3) /)
231 | CALL detectpatch(nfacevert, nodelist2, facepatch, &
232 | & nodepatch,coor_nnode)
233 | CALL addface(cellid, nfacevert, nodelist2, facelist3(1),&
234 | & facepatch)
235 |
236 | nodelist2=(/ ielno(beg+3), ielno(beg+1) /)
237 | CALL detectpatch(nfacevert, nodelist2, facepatch, &
238 | & nodepatch,coor_nnode)
239 | CALL addface(cellid, nfacevert, nodelist2, facelist3(2),&
240 | & facepatch)
241 |
242 | nodelist2=(/ ielno(beg+1), ielno(beg+2) /)
243 | CALL detectpatch(nfacevert, nodelist2, facepatch, &
244 | & nodepatch,coor_nnode)
245 | CALL addface(cellid, nfacevert, nodelist2, facelist3(3),&
246 | & facepatch)
247 |
248 | ! ------------------------!
249 | ! Create the new TRI cell !
250 | ! ------------------------!
251 |
252 | CALL addcell(cellid, EL_TRI, 3, facelist3)
253 | ! print*, " >> Cell ", cellid, " added"
254 | cellid = cellid + 1
255 |
256 | CASE (EL_QUAD)
257 |
258 | nfacevert = 2
259 | nvert = 4
260 | nfaces = 4
261 | beg = ncbeg(iel) +((i-1)*nvert)
262 | iend = beg + nvert
263 |
264 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
265 |
266 | ! ------------------!
267 | ! Create Quad faces !
268 | ! ------------------!
269 |
270 | nodelist2=(/ ielno(beg+1), ielno(beg+2) /)
271 | CALL detectpatch(nfacevert, nodelist2, facepatch, &
272 | & nodepatch,coor_nnode)
273 | CALL addface(cellid, nfacevert, nodelist2, facelist4(1),&
274 | & facepatch)
275 |
276 | nodelist2=(/ ielno(beg+2), ielno(beg+3) /)
277 | CALL detectpatch(nfacevert, nodelist2, facepatch, &
278 | & nodepatch,coor_nnode)
279 | CALL addface(cellid, nfacevert, nodelist2, facelist4(2),&
280 | & facepatch)
281 |
282 | nodelist2=(/ ielno(beg+3), ielno(beg+4) /)
283 | CALL detectpatch(nfacevert, nodelist2, facepatch, &
284 | & nodepatch,coor_nnode)
285 | CALL addface(cellid, nfacevert, nodelist2, facelist4(3),&
286 | & facepatch)
287 |
288 | nodelist2=(/ ielno(beg+4), ielno(beg+1) /)
289 | CALL detectpatch(nfacevert, nodelist2, facepatch, &
290 | & nodepatch,coor_nnode)
291 | CALL addface(cellid, nfacevert, nodelist2, facelist4(4),&
292 | & facepatch)
293 |
294 | ! -------------------------!
295 | ! Create the new QUAD cell !
296 | ! -------------------------!
297 |
298 | CALL addcell(cellid, EL_QUAD, 4, facelist4)
299 | ! print*, " >> Cell ", cellid, " added"
300 | cellid = cellid + 1
301 |
302 | CASE (EL_TETRA)
303 |
304 | nfacevert = 3
305 | nvert = 4
306 | nfaces = 4
307 | beg = ncbeg(iel) +((i-1)*nvert)
308 | iend = beg + nvert
309 |
310 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
311 |
312 | ! -------------------!
313 | ! Create Tetra faces !
314 | ! -------------------!
315 |
316 | nodelist3=(/ ielno(beg+2), ielno(beg+4), ielno(beg+3) /)
317 | CALL detectpatch(nfacevert, nodelist3, facepatch, &
318 | & nodepatch,coor_nnode)
319 | CALL addface(cellid, nfacevert, nodelist3, facelist4(1),&
320 | & facepatch)
321 |
322 | nodelist3=(/ ielno(beg+1), ielno(beg+3), ielno(beg+4) /)
323 | CALL detectpatch(nfacevert, nodelist3, facepatch, &
324 | & nodepatch,coor_nnode)
325 | CALL addface(cellid, nfacevert, nodelist3, facelist4(2),&
326 | & facepatch)
327 |
328 | nodelist3=(/ ielno(beg+1), ielno(beg+4), ielno(beg+2) /)
329 | CALL detectpatch(nfacevert, nodelist3, facepatch, &
330 | & nodepatch,coor_nnode)
331 | CALL addface(cellid, nfacevert, nodelist3, facelist4(3),&
332 | & facepatch)
333 |
334 | nodelist3=(/ ielno(beg+1), ielno(beg+2), ielno(beg+3) /)
335 | CALL detectpatch(nfacevert, nodelist3, facepatch, &
336 | & nodepatch,coor_nnode)
337 | CALL addface(cellid, nfacevert, nodelist3, facelist4(4),&
338 | & facepatch)
339 |
340 | ! --------------------------!
341 | ! Create the new TETRA cell !
342 | ! --------------------------!
343 |
344 | CALL addcell(cellid, EL_TETRA, 4, facelist4)
345 | ! print*, " >> Cell ", cellid, " added"
346 | cellid = cellid + 1
347 |
348 | CASE (EL_HEXA)
349 |
350 | nfacevert = 4
351 | nvert = 8
352 | nfaces = 6
353 | beg = ncbeg(iel) +((i-1)*nvert)
354 | iend = beg + nvert
355 |
356 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
357 |
358 | ! ------------------!
359 | ! Create Hexa faces !
360 | ! ------------------!
361 | nodelist4 = (/ ielno(beg+1), ielno(beg+2), &
362 | & ielno(beg+6), ielno(beg+5) /)
363 | CALL detectpatch(nfacevert, nodelist4, facepatch, &
364 | & nodepatch,coor_nnode)
365 | CALL addface(cellid, nfacevert, nodelist4, facelist6(1),&
366 | & facepatch)
367 |
368 | nodelist4 = (/ ielno(beg+6), ielno(beg+2), &
369 | & ielno(beg+3), ielno(beg+7) /)
370 | CALL detectpatch(nfacevert, nodelist4, facepatch, &
371 | & nodepatch,coor_nnode)
372 | CALL addface(cellid, nfacevert, nodelist4, facelist6(2),&
373 | & facepatch)
374 |
375 | nodelist4 = (/ ielno(beg+8), ielno(beg+7), &
376 | & ielno(beg+3), ielno(beg+4) /)
377 | CALL detectpatch(nfacevert, nodelist4, facepatch, &
378 | & nodepatch,coor_nnode)
379 | CALL addface(cellid, nfacevert, nodelist4, facelist6(3),&
380 | & facepatch)
381 |
382 | nodelist4 = (/ ielno(beg+1), ielno(beg+5), &
383 | & ielno(beg+8), ielno(beg+4) /)
384 | CALL detectpatch(nfacevert, nodelist4, facepatch, &
385 | & nodepatch,coor_nnode)
386 | CALL addface(cellid, nfacevert, nodelist4, facelist6(4),&
387 | & facepatch)
388 |
389 | nodelist4 = (/ ielno(beg+1), ielno(beg+4), &
390 | & ielno(beg+3), ielno(beg+2) /)
391 | CALL detectpatch(nfacevert, nodelist4, facepatch, &
392 | & nodepatch,coor_nnode)
393 | CALL addface(cellid, nfacevert, nodelist4, facelist6(5),&
394 | & facepatch)
395 |
396 | nodelist4 = (/ ielno(beg+5), ielno(beg+6), &
397 | & ielno(beg+7), ielno(beg+8) /)
398 | CALL detectpatch(nfacevert, nodelist4, facepatch, &
399 | & nodepatch,coor_nnode)
400 | CALL addface(cellid, nfacevert, nodelist4, facelist6(6),&
401 | & facepatch)
402 |
403 | ! -------------------------!
404 | ! Create the new HEXA cell !
405 | ! -------------------------!
406 |
407 | CALL addcell(cellid, EL_HEXA, 6, facelist6)
408 | ! print*, " >> Cell ", cellid, " added"
409 | cellid = cellid + 1
410 |
411 | END SELECT
412 |
413 | ENDDO
414 | ENDDO
415 |
416 | WRITE(*,*) " Total cells added: ", i_ncells
417 | WRITE(*,*) " Total faces added: ", i_nfaces
418 | CALL destroyconnmemory
419 |
420 | END SUBROUTINE avbp2dom
avbp2dom.F could be called by: