1 subroutine pcma22 ( nbnoto, nbelem,
2 > nbtr3d, nbqu3d, nbhe3d, nbpe3d, nbele3,
3 > fameel, typele, noeele,
4 > fame3d, type3d, noee3d,
5 > faminf, famsup, nu3dno,
7 > arerec, quarec, tabaux,
8 > ulsort, langue, codret )
9 c ______________________________________________________________________
13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
16 c aupres des huissiers de justice Simart et Lavoir a Clamart
17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
18 c aupres des huissiers de justice
19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
21 c HOMARD est une marque deposee d'Electricite de France
27 c ______________________________________________________________________
29 c aPres adaptation - Conversion de MAillage - 2D/3D - phase 2
31 c Creation des mailles
32 c ______________________________________________________________________
34 c . nom . e/s . taille . description .
35 c .____________________________________________________________________.
36 c . nbnoto . e . 1 . nombre de noeuds du maillage externe .
37 c . nbtr3d . e . 1 . nombre de triangles du maillage 3d .
38 c . nbqu3d . e . 1 . nombre de quadrangles du maillage 3d .
39 c . nbhe3d . e . 1 . nombre d'hexaedres du maillage 3d .
40 c . nbpe3d . e . 1 . nombre de pentaedres du maillage 3d .
41 c . nbelem . e . 1 . nombre d'elements du maillage externe .
42 c . nu3dno . e . nbnoto . numero du calcul des noeuds .
43 c . fameel . e . nbelem . famille med des elements .
44 c . typele . e . nbelem . type des elements pour le code de calcul .
45 c . noeele . e . nbelem . noeuds des elements .
47 c . fame3d . s . nbele3 . famille med des elements du maillage 3d .
48 c . type3d . s . nbele3 . type des elements du maillage 3d .
49 c . noee3d . s . nbele3 . noeuds des elements du maillage 3d .
51 c . faminf . e . 1 . famille med des quad de la face inferieure .
52 c . famsup . e . 1 . famille med des quad de la face superieure .
53 c . nu3dno . e . nbnoto . numero du calcul des noeuds .
54 c . nparrc . es . 1 . nombre de paires d'aretes a recoller .
55 c . npqurc . s . 1 . nombre de paires de quadrangles a recoller .
56 c . arerec . e .2*nparrc. paires des aretes a recoller .
57 c . quarec . s . 2** . paires des quadrangles a recoller .
58 c . tabaux . a . nbarto . tableau auxiliaire .
59 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
60 c . langue . e . 1 . langue des messages .
61 c . . . . 1 : francais, 2 : anglais .
62 c . codret . es . 1 . code de retour des modules .
63 c . . . . 0 : pas de probleme .
64 c . . . . 1 : probleme .
65 c ______________________________________________________________________
68 c 0. declarations et dimensionnement
71 c 0.1. ==> generalites
77 parameter ( nompro = 'PCMA22' )
93 integer nbtr3d, nbqu3d, nbhe3d, nbpe3d, nbele3
95 integer faminf, famsup
96 integer fameel(nbelem), typele(nbelem), noeele(nbelem,*)
97 integer fame3d(nbele3), type3d(nbele3), noee3d(nbele3,*)
98 integer nu3dno(nbnoto)
100 integer nparrc, npqurc
101 integer arerec(2,*), quarec(2,*)
104 integer ulsort, langue, codret
106 c 0.4. ==> variables locales
112 parameter ( nbmess = 10 )
113 character*80 texte(nblang,nbmess)
115 c 0.5. ==> initialisations
116 c ______________________________________________________________________
124 #ifdef _DEBUG_HOMARD_
125 write (ulsort,texte(langue,1)) 'Entree', nompro
129 texte(1,4) = '(''Maille numero :'',i10,'', de noeuds '',8i10)'
130 texte(1,5) = '(i1,'' noeud(s) sont dans le plan zinf.'')'
131 texte(1,6) = '(''Pour un '',a,'', il en faudrait '',a)'
132 texte(1,7) = '(''Famille de la face '',a,'' : '',i6)'
133 texte(1,8) = '(''Famille du '',a,i10,'' : '',i6)'
135 >'(''Nombre de '',a,'' attendus pour le maillage 3D :'',i10)'
137 >'(''Nombre de '',a,'' trouves pour le maillage 3D :'',i10)'
139 texte(2,4) = '(''Mesh # :'',i10,'', with nodes '',8i10)'
140 texte(2,5) = '(i1,'' node(s) are in zinf plane.'')'
141 texte(2,6) = '(''For '',a,'', '',a,'' were expected.'')'
142 texte(2,7) = '(''Family for '',a,'' face : '',i6)'
143 texte(2,8) = '(''Family for '',a,'' #'',i10,'' : '',i6)'
145 > '(''Expected number of '',a,'' for the 3D mesh :'',i10)'
147 > '(''Found number of '',a,'' for the 3D mesh :'',i10)'
153 #ifdef _DEBUG_HOMARD_
154 write (ulsort,90002) 'nbele3', nbele3
159 c 2. transformations des quadrangles en hexaedres
160 c Convention MED des hexaedres :
163 c --------------------
168 c 2 -------------------- 3 .
176 c --------------------
179 c . Les noeuds (1,2,3,4) definissent un quadrangle a orientation
181 c . Les noeuds (5,6,7,8) sont translates de (1,2,3,4)
182 c . Le triedre (12,15,14) est direct
185 #ifdef _DEBUG_HOMARD_
186 write (ulsort,90002) '2. quad -> hexa ; codret', codret
187 write (ulsort,90002) 'nbhe3d', nbhe3d
190 if ( nbhe3d.ne.0 ) then
192 if ( codret.eq.0 ) then
194 do 21 , el = 1 , nbelem
196 if ( typele(el).eq.edqua4 ) then
199 do 211 , iaux = 1 , 4
200 noee3d(nuel3d,iaux) = nu3dno(noeele(el,iaux)) + nbnoto - 1
201 noee3d(nuel3d,iaux+4) = nu3dno(noeele(el,iaux))
203 fame3d(nuel3d) = fameel(el)
204 type3d(nuel3d) = edhex8
210 if ( nuel3d.ne.nbhe3d ) then
211 write (ulsort,texte(langue,9)) mess14(langue,3,9), nbhe3d
212 write (ulsort,texte(langue,10)) mess14(langue,3,9), nuel3d
221 c 3. transformations des triangles en pentaedres
222 c Convention MED des pentaedres :
224 #ifdef _DEBUG_HOMARD_
225 write (ulsort,90002) '3. tria -> pent ; codret', codret
226 write (ulsort,90002) 'nbpe3d', nbpe3d
229 if ( nbpe3d.ne.0 ) then
231 if ( codret.eq.0 ) then
233 do 31 , el = 1 , nbelem
235 if ( typele(el).eq.edtri3 ) then
238 do 311 , iaux = 1 , 3
239 noee3d(nuel3d,iaux) = nu3dno(noeele(el,iaux)) + nbnoto - 1
240 noee3d(nuel3d,iaux+3) = nu3dno(noeele(el,iaux))
242 fame3d(nuel3d) = fameel(el)
243 type3d(nuel3d) = edpen6
249 if ( (nuel3d-nbhe3d).ne.nbpe3d ) then
250 write (ulsort,texte(langue,9)) mess14(langue,3,9), nbpe3d
251 write (ulsort,texte(langue,10)) mess14(langue,3,9),
261 c 4. creation des quadrangles
263 #ifdef _DEBUG_HOMARD_
264 write (ulsort,90002) '4. creation quadrangles ; codret', codret
267 if ( nbqu3d.ne.0 ) then
269 c 4.1. ==> transformations des segments en quadrangles de bord
271 if ( codret.eq.0 ) then
273 do 41 , el = 1 , nbelem
275 if ( typele(el).eq.edseg2 ) then
277 #ifdef _DEBUG_HOMARD_
278 write (ulsort,90002) 'nuel3d', nuel3d
279 write (ulsort,90015) 'noeele(',el,') = ',
280 > noeele(el,1), noeele(el,2)
281 write (ulsort,90015) 'nu3dno(noeele(',el,')) = ',
282 > nu3dno(noeele(el,1)), nu3dno(noeele(el,2))
285 noee3d(nuel3d,1) = nu3dno(noeele(el,1))
286 noee3d(nuel3d,2) = nu3dno(noeele(el,2))
287 noee3d(nuel3d,3) = nu3dno(noeele(el,2)) + nbnoto - 1
288 noee3d(nuel3d,4) = nu3dno(noeele(el,1)) + nbnoto - 1
289 fame3d(nuel3d) = fameel(el)
290 type3d(nuel3d) = edqua4
291 if ( nparrc.gt.0 ) then
292 tabaux(el) = nuel3d - nbhe3d
301 c 4.2. ==> creation des quadrangles des faces inf et sup
302 c deux faces paralleles doivent tourner en sens inverse ...
304 if ( codret.eq.0 ) then
306 #ifdef _DEBUG_HOMARD_
307 write (ulsort,texte(langue,7)) 'inf', faminf
308 write (ulsort,texte(langue,7)) 'sup', famsup
311 do 42 , el = 1 , nbelem
313 if ( typele(el).eq.edqua4 ) then
316 noee3d(nuel3d,1) = nu3dno(noeele(el,4))
317 noee3d(nuel3d,2) = nu3dno(noeele(el,3))
318 noee3d(nuel3d,3) = nu3dno(noeele(el,2))
319 noee3d(nuel3d,4) = nu3dno(noeele(el,1))
320 fame3d(nuel3d) = faminf
321 type3d(nuel3d) = edqua4
324 noee3d(nuel3d,1) = nu3dno(noeele(el,1)) + nbnoto - 1
325 noee3d(nuel3d,2) = nu3dno(noeele(el,2)) + nbnoto - 1
326 noee3d(nuel3d,3) = nu3dno(noeele(el,3)) + nbnoto - 1
327 noee3d(nuel3d,4) = nu3dno(noeele(el,4)) + nbnoto - 1
328 fame3d(nuel3d) = famsup
329 type3d(nuel3d) = edqua4
337 if ( codret.eq.0 ) then
339 if ( (nuel3d-nbhe3d-nbpe3d).ne.(nbqu3d+nbtr3d) ) then
340 write (ulsort,texte(langue,9)) mess14(langue,3,8), nbqu3d+nbtr3d
341 write (ulsort,texte(langue,10))
342 > mess14(langue,3,8), nuel3d-nbhe3d-nbpe3d
351 c 5. creation des triangles
353 #ifdef _DEBUG_HOMARD_
354 write (ulsort,90002) '5. creation triangles ; codret', codret
357 if ( nbtr3d.ne.0 ) then
359 c 5.1. ==> creation des triangles des faces inf et sup
360 c deux faces paralleles doivent tourner en sens inverse ...
362 if ( codret.eq.0 ) then
364 #ifdef _DEBUG_HOMARD_
365 write (ulsort,texte(langue,7)) 'inf', faminf
366 write (ulsort,texte(langue,7)) 'sup', famsup
369 do 51 , el = 1 , nbelem
371 if ( typele(el).eq.edtri3 ) then
374 noee3d(nuel3d,1) = nu3dno(noeele(el,1))
375 noee3d(nuel3d,2) = nu3dno(noeele(el,2))
376 noee3d(nuel3d,3) = nu3dno(noeele(el,3))
377 fame3d(nuel3d) = faminf
378 type3d(nuel3d) = edtri3
381 noee3d(nuel3d,1) = nu3dno(noeele(el,3)) + nbnoto - 1
382 noee3d(nuel3d,2) = nu3dno(noeele(el,2)) + nbnoto - 1
383 noee3d(nuel3d,3) = nu3dno(noeele(el,1)) + nbnoto - 1
384 fame3d(nuel3d) = famsup
385 type3d(nuel3d) = edtri3
393 if ( codret.eq.0 ) then
395 if ( (nuel3d-nbhe3d-nbpe3d).ne.(nbqu3d+nbtr3d) ) then
396 write (ulsort,texte(langue,9)) mess14(langue,3,8), nbqu3d+nbtr3d
397 write (ulsort,texte(langue,10))
398 > mess14(langue,3,8), nuel3d-nbhe3d-nbpe3d
407 c 6. transfert des recollements des segments vers les quadrangles
409 #ifdef _DEBUG_HOMARD_
410 write (ulsort,90002) '6. transfert ; codret', codret
413 if ( codret.eq.0 ) then
415 do 61 , iaux = 1 , nparrc
417 quarec(1,iaux) = tabaux(arerec(1,iaux))
418 quarec(2,iaux) = tabaux(arerec(2,iaux))
431 #ifdef _DEBUG_HOMARD_
432 write (ulsort,90002) '7. fin ; codret', codret
436 if ( codret.ne.0 ) then
439 write (ulsort,texte(langue,1)) 'Sortie', nompro
440 write (ulsort,texte(langue,2)) codret
443 #ifdef _DEBUG_HOMARD_
444 write (ulsort,texte(langue,1)) 'Sortie', nompro