1 | include(dom.inc)
2 |
3 | SUBROUTINE gambit2dom(meshfile)
4 |
5 | ! =================================================================!
6 | ! !
7 | ! gambit2dom.F : Reads GAMBIT mesh files and starts data structure !
8 | ! !
9 | ! author : D. POITOU (march 2008) !
10 | ! !
11 | ! Nota : i_nnodes and i_nfacesmax must be initialized in !
12 | ! this subroutine !
13 | ! !
14 | ! =================================================================!
15 |
16 | USE gambit_read
17 | USE datas
18 |
19 | IMPLICIT NONE
20 |
21 | include 'dom_constants.h'
22 |
23 | ! IN
24 | DOM_STR80 meshfile
25 |
26 | ! LOCAL
27 | DOM_INT :: iel,ipat,ien,ifa
28 | DOM_INT :: nfacevert, nfaces
29 | DOM_INT :: cellid
30 |
31 | TYPE(cell), POINTER :: new_cell
32 |
33 | DOM_INT, ALLOCATABLE,DIMENSION(:,:) :: nodelist
34 | DOM_INT, ALLOCATABLE,DIMENSION(:) :: facelist
35 |
36 | ! -----------------------------!
37 | ! Read the GAMBIT neutral file !
38 | ! -----------------------------!
39 |
40 | gambit_meshfile = meshfile
41 | CALL readmsh
42 |
43 | ! ------------------------------!
44 | ! Geometrical value for Prissma !
45 | ! ------------------------------!
46 | i_nnodes = NUMNP
47 | i_nfacesmax = 0
48 |
49 | ! ---------------------!
50 | ! Initialise the nodes !
51 | ! ---------------------!
52 |
53 | ALLOCATE(node_list (3,i_nnodes))
54 | ALLOCATE(facesatnode (i_nnodes))
55 |
56 | DO i=1,i_nnodes
57 | NULLIFY(facesatnode(i)%fatnode_ptr)
58 | ENDDO
59 |
60 | IF (NDFCD.eq.3) THEN
61 | node_list(1,:) = X(1,:)
62 | node_list(2,:) = X(2,:)
63 | node_list(3,:) = X(3,:)
64 | ELSE
65 | node_list(1,:) = X(1,:)
66 | node_list(2,:) = X(2,:)
67 | node_list(3,:) = 0.0d0
68 | ENDIF
69 |
70 | IF(ALLOCATED(X)) DEALLOCATE(X)
71 |
72 | ALLOCATE(faceidx(MAX_NFACES_CELL*NELEM))
73 |
74 | ! -----------------------!
75 | ! Create faces and cells !
76 | ! -----------------------!
77 |
78 | PRINT*, 'Building the data structure...'
79 | cellid = 1
80 |
81 | DO iel=1,NELEM
82 |
83 | ! -----------------------------------------------------------!
84 | ! Allocate memory space for the new cell (needed in addface) !
85 | ! -----------------------------------------------------------!
86 | ALLOCATE(new_cell)
87 | NULLIFY(new_cell%next_cell)
88 | current_cell => new_cell
89 | current_cell%cell_id = cellid
90 |
91 | SELECT CASE(NTYPE(iel))
92 |
93 | CASE(GB_QUAD)
94 |
95 | nfacevert = 2
96 | nfaces = 4
97 |
98 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
99 |
100 | IF(ALLOCATED(nodelist)) DEALLOCATE(nodelist)
101 | IF(ALLOCATED(facelist)) DEALLOCATE(facelist)
102 |
103 | ALLOCATE(nodelist (nfaces,nfacevert))
104 | ALLOCATE(facelist (nfaces))
105 |
106 | ! -------------!
107 | ! Set nodelist !
108 | ! -------------!
109 |
110 | nodelist(1,:)=(/ NODE(1,iel), NODE(2,iel) /)
111 | nodelist(2,:)=(/ NODE(2,iel), NODE(3,iel) /)
112 | nodelist(3,:)=(/ NODE(3,iel), NODE(4,iel) /)
113 | nodelist(4,:)=(/ NODE(4,iel), NODE(0,iel) /)
114 |
115 | ! ---------------------!
116 | ! Create GB_QUAD faces !
117 | ! ---------------------!
118 |
119 | DO ifa=1,nfaces
120 | CALL addface(cellid,nfacevert,nodelist(ifa,:), &
121 | & facelist(ifa),facepatch(ifa,iel))
122 | ENDDO
123 |
124 | ! --------------------!
125 | ! Create EL_QUAD cell !
126 | ! --------------------!
127 |
128 | CALL addcell(cellid, EL_QUAD, 4, facelist)
129 | cellid = cellid + 1
130 |
131 | CASE(GB_HEXA)
132 |
133 | nfacevert = 4
134 | nfaces = 6
135 |
136 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
137 |
138 | IF(ALLOCATED(nodelist)) DEALLOCATE(nodelist)
139 | IF(ALLOCATED(facelist)) DEALLOCATE(facelist)
140 |
141 | ALLOCATE(nodelist (nfaces,nfacevert))
142 | ALLOCATE(facelist (nfaces))
143 |
144 | ! -------------!
145 | ! Set nodelist !
146 | ! -------------!
147 |
148 | nodelist(1,:)=(/ NODE(1,iel), NODE(2,iel), NODE(6,iel), &
149 | & NODE(5,iel)/)
150 | nodelist(2,:)=(/ NODE(2,iel), NODE(4,iel), NODE(8,iel), &
151 | & NODE(6,iel)/)
152 | nodelist(3,:)=(/ NODE(4,iel), NODE(3,iel), NODE(7,iel), &
153 | & NODE(8,iel) /)
154 | nodelist(4,:)=(/ NODE(3,iel), NODE(1,iel), NODE(5,iel), &
155 | & NODE(7,iel) /)
156 | nodelist(5,:)=(/ NODE(2,iel), NODE(1,iel), NODE(3,iel), &
157 | & NODE(4,iel) /)
158 | nodelist(6,:)=(/ NODE(5,iel), NODE(6,iel), NODE(8,iel), &
159 | & NODE(7,iel) /)
160 |
161 | ! ---------------------!
162 | ! Create GB_HEXA faces !
163 | ! ---------------------!
164 |
165 | DO ifa=1,nfaces
166 | CALL addface(cellid,nfacevert,nodelist(ifa,:), &
167 | & facelist(ifa),facepatch(ifa,iel))
168 | ENDDO
169 |
170 | ! --------------------!
171 | ! Create EL_HEXA cell !
172 | ! --------------------!
173 |
174 | CALL addcell(cellid, EL_HEXA, 6, facelist)
175 | cellid = cellid + 1
176 |
177 | CASE(GB_TRI)
178 |
179 | nfacevert = 2
180 | nfaces = 3
181 |
182 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
183 |
184 | IF(ALLOCATED(nodelist)) DEALLOCATE(nodelist)
185 | IF(ALLOCATED(facelist)) DEALLOCATE(facelist)
186 |
187 | ALLOCATE(nodelist (nfaces,nfacevert))
188 | ALLOCATE(facelist (nfaces))
189 |
190 | ! -------------!
191 | ! Set nodelist !
192 | ! -------------!
193 |
194 | nodelist(1,:)=(/ NODE(1,iel), NODE(2,iel) /)
195 | nodelist(2,:)=(/ NODE(2,iel), NODE(3,iel) /)
196 | nodelist(3,:)=(/ NODE(3,iel), NODE(1,iel) /)
197 |
198 | ! --------------------!
199 | ! Create GB_TRI faces !
200 | ! --------------------!
201 |
202 | DO ifa=1,nfaces
203 | CALL addface(cellid,nfacevert,nodelist(ifa,:), &
204 | & facelist(ifa),facepatch(ifa,iel))
205 | ENDDO
206 |
207 | ! -------------------!
208 | ! Create EL_TRI cell !
209 | ! -------------------!
210 |
211 | CALL addcell(cellid, EL_TRI, 3, facelist)
212 | cellid = cellid + 1
213 |
214 | CASE(GB_PRISM)
215 |
216 | nfacevert = 4 ! faces à 3 et 4 noeuds
217 | nfaces = 5
218 |
219 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
220 |
221 | IF(ALLOCATED(nodelist)) DEALLOCATE(nodelist)
222 | IF(ALLOCATED(facelist)) DEALLOCATE(facelist)
223 |
224 | ALLOCATE(nodelist(nfaces,nfacevert))
225 | ALLOCATE(facelist(nfaces))
226 |
227 | ! -------------!
228 | ! Set nodelist !
229 | ! -------------!
230 |
231 | nodelist(1,:)=(/ NODE(1,iel), NODE(2,iel), NODE(5,iel), &
232 | & NODE(4,iel)/)
233 | nodelist(2,:)=(/ NODE(2,iel), NODE(3,iel), NODE(6,iel), &
234 | & NODE(5,iel)/)
235 | nodelist(3,:)=(/ NODE(3,iel), NODE(1,iel), NODE(4,iel), &
236 | & NODE(6,iel) /)
237 | nodelist(4,:)=(/ NODE(1,iel), NODE(3,iel), NODE(2,iel) /)
238 | nodelist(5,:)=(/ NODE(4,iel), NODE(5,iel), NODE(6,iel) /)
239 |
240 | ! ----------------------!
241 | ! Create GB_PRISM faces !
242 | ! ----------------------!
243 |
244 | DO ifa=1,nfaces
245 | IF (ifa.lt.4) THEN
246 | nfacevert = 4
247 | ELSE
248 | nfacevert = 3
249 | ENDIF
250 | CALL addface(cellid,nfacevert,nodelist(ifa,:), &
251 | & facelist(ifa),facepatch(ifa,iel))
252 | ENDDO
253 |
254 | ! ---------------------!
255 | ! Create EL_PRISM cell !
256 | ! ---------------------!
257 |
258 | CALL addcell(cellid, EL_PRISM, 5, facelist)
259 | cellid = cellid + 1
260 |
261 | CASE(GB_TETRA)
262 |
263 | nfacevert = 3
264 | nfaces = 4
265 |
266 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
267 |
268 | IF(ALLOCATED(nodelist)) DEALLOCATE(nodelist)
269 | IF(ALLOCATED(facelist)) DEALLOCATE(facelist)
270 |
271 | ALLOCATE(nodelist (nfaces,nfacevert))
272 | ALLOCATE(facelist (nfaces))
273 |
274 | ! -------------!
275 | ! Set nodelist !
276 | ! -------------!
277 |
278 | nodelist(1,:)=(/ NODE(2,iel), NODE(1,iel), NODE(3,iel) /)
279 | nodelist(2,:)=(/ NODE(1,iel), NODE(2,iel), NODE(4,iel) /)
280 | nodelist(3,:)=(/ NODE(2,iel), NODE(3,iel), NODE(4,iel) /)
281 | nodelist(4,:)=(/ NODE(3,iel), NODE(1,iel), NODE(4,iel) /)
282 |
283 | ! ----------------------!
284 | ! Create GB_TETRA faces !
285 | ! ----------------------!
286 |
287 | DO ifa=1,nfaces
288 | CALL addface(cellid,nfacevert,nodelist(ifa,:), &
289 | & facelist(ifa),facepatch(ifa,iel))
290 | ENDDO
291 |
292 | ! ---------------------!
293 | ! Create EL_TETRA cell !
294 | ! ---------------------!
295 |
296 | CALL addcell(cellid, EL_TETRA, 4, facelist)
297 | cellid = cellid + 1
298 |
299 | CASE(GB_PYRAM)
300 |
301 | nfacevert = 4 ! faces à 3 et 4 noeuds
302 | nfaces = 5
303 |
304 | IF (nfaces.gt.i_nfacesmax) i_nfacesmax = nfaces
305 |
306 | IF(ALLOCATED(nodelist)) DEALLOCATE(nodelist)
307 | IF(ALLOCATED(facelist)) DEALLOCATE(facelist)
308 |
309 | ALLOCATE(nodelist (nfaces,nfacevert))
310 | ALLOCATE(facelist (nfaces))
311 |
312 | ! -------------!
313 | ! Set nodelist !
314 | ! -------------!
315 |
316 | nodelist(1,:)=(/ NODE(1,iel), NODE(3,iel), NODE(4,iel), &
317 | & NODE(2,iel)/)
318 | nodelist(2,:)=(/ NODE(1,iel), NODE(2,iel), NODE(5,iel) /)
319 | nodelist(3,:)=(/ NODE(2,iel), NODE(4,iel), NODE(5,iel) /)
320 | nodelist(4,:)=(/ NODE(4,iel), NODE(3,iel), NODE(5,iel) /)
321 | nodelist(5,:)=(/ NODE(3,iel), NODE(1,iel), NODE(5,iel) /)
322 |
323 | ! ----------------------!
324 | ! Create GB_PYRAM faces !
325 | ! ----------------------!
326 |
327 | DO ifa=1,nfaces
328 |
329 | IF (ifa.lt.2) THEN
330 | nfacevert = 4
331 | ELSE
332 | nfacevert = 3
333 | ENDIF
334 | CALL addface(cellid,nfacevert,nodelist(ifa,:), &
335 | & facelist(ifa),facepatch(ifa,iel))
336 | ENDDO
337 |
338 | ! ---------------------!
339 | ! Create EL_PYRAM cell !
340 | ! ---------------------!
341 |
342 | CALL addcell(cellid, EL_PYRAM, 5, facelist)
343 | cellid = cellid + 1
344 |
345 | END SELECT
346 |
347 | ENDDO
348 |
349 | END SUBROUTINE gambit2dom
gambit2dom.F could be called by: