1 subroutine vcequ2 ( noehom, arehom,
7 > ulsort, langue, codret )
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c aVant adaptation Conversion - EQUivalence - phase 2
31 c remarque : ce traitement suppose qu'une entite ne possede pas plus
32 c d'un homologue. Si des cas plus compliques apparaissent,
33 c il faudra modifier la structure des equivalences
35 c on enrichit la structure pour pouvoir passer l'algorithme et la
36 c reconstruction future. pour chaque triangle homologue, on repere
37 c les trois aretes et on les declare homologues. Idem pour les
38 c aretes des quadrangles. Idem pour les noeuds des aretes.
39 c si on ne fait pas cette operation, on est incapable d'associer les
40 c filles des entites homologues. On ne saura pas apparier dans le
42 c attention, on ne fait pas le processus dans l'autre sens : deduire
43 c des equivalences sur des aretes a partir d'equivalences sur les
44 c noeuds reviendrait a extrapoler les informations donnees en entree.
46 c remarque importante : reperage des elements homologues
47 c on prend la convention de reperage suivante : lorsque
48 c l'on a deux faces periodiques 1 et 2, on attribue un signe a
49 c chacune des faces. pour un noeud "i", noehom(i) est alors egal
50 c a la valeur suivante :
51 c - "le numero du noeud correspondant par periodicite
52 c si i est sur la face 2"
53 c - "l'oppose du numero du noeud correspondant par periodicite
54 c si i est sur la face 1"
56 c Donc, on etend cette convention a toutes les entites noeuds,
57 c aretes et triangles :
58 c enthom(i) = abs(homologue(i)) ssi i est sur la face 2
59 c enthom(i) = -abs(homologue(i)) ssi i est sur la face 1
60 c pour une entite situee sur l'axe, on prend la convention positive.
62 c ______________________________________________________________________
64 c . nom . e/s . taille . description .
65 c .____________________________________________________________________.
66 c . noehom . es . nbnoto . liste etendue des homologues par noeuds .
67 c . arehom . es . nbarto . liste etendue des homologues par aretes .
68 c . trihom . es . nbtrto . ensemble des triangles homologues .
69 c . quahom . es . nbquto . ensemble des quadrangles homologues .
70 c . somare . e .2*nbarto. numeros des extremites d'arete .
71 c . np2are . e . nbarto . numero du noeud milieu de l'arete .
72 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
73 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
74 c . posifa . e . nbarto . pointeur sur tableau facare .
75 c . facare . e . nbfaar . liste des faces contenant une arete .
76 c . povoso . e .0:nbnoto. pointeur des voisins par sommet .
77 c . voisom . e . nvosom . elements 1d, 2d ou 3d voisins par sommet .
78 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
79 c . langue . e . 1 . langue des messages .
80 c . . . . 1 : francais, 2 : anglais .
81 c . codret . es . 1 . code de retour des modules .
82 c . . . . 0 : pas de probleme .
83 c . . . . 1 : probleme .
84 c ______________________________________________________________________
87 c 0. declarations et dimensionnement
90 c 0.1. ==> generalites
96 parameter ( nompro = 'VCEQU2' )
114 integer noehom(nbnoto), arehom(nbarto)
115 integer trihom(nbtrto), quahom(nbquto)
116 integer somare(2,nbarto), np2are(nbarto)
117 integer aretri(nbtrto,3), arequa(nbquto,4)
118 integer posifa(0:nbarto), facare(nbfaar)
119 integer povoso(0:nbnoto), voisom(nvosom)
120 integer ulsort, langue, codret
122 c 0.4. ==> variables locales
124 integer entlo1, entlo2
128 parameter ( nbmess = 10 )
129 character*80 texte(nblang,nbmess)
131 c 0.5. ==> initialisations
132 c ______________________________________________________________________
142 #ifdef _DEBUG_HOMARD_
143 write (ulsort,texte(langue,1)) 'Entree', nompro
147 texte(1,5) = '(''Infos donnees en numerotation HOMARD'')'
148 texte(1,6) = '(a,i10,'' est homologue de'',i10)'
149 texte(1,7) = '(/,''Equivalence sur les '',a)'
151 > '(''. Nombre de '',a,''homologues enregistres :'',i2)'
152 texte(1,9) = '(/,''. Analyse des '',a,i10,'' et'',i10)'
154 texte(2,5) = '(''Infos given with HOMARD #'')'
155 texte(2,6) = '(a,i10,'' is homologous with'',i10)'
156 texte(2,7) = '(/,''Equivalence for '',a)'
157 texte(2,8) = '(''. Number of known homologous '',a,'' :'',i2)'
158 texte(2,9) = '(/,''. Analysis of '',a,i10,'' and'',i10)'
163 c 2. enrichissement de la structure sur les aretes a partir de la
164 c donnee des triangles et quadrangles homologues
167 if ( homolo.ge.3 ) then
169 #ifdef _DEBUG_HOMARD_
170 if ( nbeqtr.gt.0 ) then
171 write (ulsort,texte(langue,7)) mess14(langue,3,2)
172 write (ulsort,texte(langue,5))
173 do 20001 , iaux = 1 , nbtrto
174 if ( trihom(iaux).ne.0 ) then
175 write (ulsort,texte(langue,6)) mess14(langue,2,2),
180 if ( nbeqqu.gt.0 ) then
181 write (ulsort,texte(langue,7)) mess14(langue,3,4)
182 write (ulsort,texte(langue,5))
183 do 20002 , iaux = 1 , nbquto
184 if ( quahom(iaux).ne.0 ) then
185 write (ulsort,texte(langue,6)) mess14(langue,2,4),
192 c 2.1. ==> on commence par traiter les triangles et les quadrangles
193 c qui ne sont pas dans un coin de maillage. Autrement dit, il
194 c ne faut pas que deux de leurs aretes soient au bord
196 c 2.1.1. ==> les triangles
198 if ( nbeqtr.gt.0 ) then
200 if ( codret.eq.0 ) then
203 #ifdef _DEBUG_HOMARD_
204 write (ulsort,texte(langue,3)) 'VCEQU4_tr', nompro
211 > ulsort, langue, codret )
212 cgn print *,nompro,' apres 2.1.1'
214 cgn print 1789,(arehom(iaux),iaux=1,50)
221 cgn 1789 format(10I4)
223 c 2.1.2. ==> les quadrangles
225 if ( nbeqqu.gt.0 ) then
227 if ( codret.eq.0 ) then
230 #ifdef _DEBUG_HOMARD_
231 write (ulsort,texte(langue,3)) 'VCEQU4_qu', nompro
238 > ulsort, langue, codret )
240 cgn print *,nompro,' apres 2.1.2'
242 cgn print 1789,(arehom(iaux),iaux=1,50)
247 #ifdef _DEBUG_HOMARD_
248 write (ulsort,texte(langue,7)) mess14(langue,3,1)
249 write (ulsort,texte(langue,5))
250 do 21000 , iaux = 1 , nbarto
251 if ( arehom(iaux).ne.0 ) then
252 write (ulsort,texte(langue,6)) mess14(langue,2,1),
258 c 2.2. ==> a partir de cette premiere mise en equivalence des aretes,
259 c on reporte l'information sur les noeuds
260 c on boucle uniquement sur les aretes de la face periodique 2
262 if ( codret.eq.0 ) then
264 do 22 , entlo2 = 1 , nbarto
266 if ( codret.eq.0 ) then
268 entlo1 = arehom(entlo2)
270 if ( entlo1.gt.0 ) then
273 #ifdef _DEBUG_HOMARD_
274 write (ulsort,texte(langue,3)) 'VCEQU5', nompro
276 call vcequ5 ( entlo1, jaux,
280 > ulsort, langue, codret )
287 cgn print *,nompro,' apres 2.2'
289 cgn print 1789,(noehom(iaux),iaux=1,27)
293 #ifdef _DEBUG_HOMARD_
294 write (ulsort,texte(langue,7)) mess14(langue,3,-1)
295 write (ulsort,texte(langue,5))
296 do 22000 , iaux = 1 , nbnoto
297 if ( noehom(iaux).ne.0 ) then
298 write (ulsort,texte(langue,6)) mess14(langue,2,-1),
304 c 2.3. ==> maintenant que l'on a transfere l'information sur les noeuds,
305 c on s'occupe des triangles ou quadrangles de coin
307 c 2.3.1. ==> les triangles
309 if ( nbeqtr.gt.0 ) then
311 if ( codret.eq.0 ) then
314 #ifdef _DEBUG_HOMARD_
315 write (ulsort,texte(langue,3)) 'VCEQU6_tr', nompro
320 > somare, aretri, arequa,
321 > ulsort, langue, codret )
323 cgn print *,nompro,' apres 2.3.1'
325 cgn print 1789,(arehom(iaux),iaux=1,50)
331 c 2.3.2. ==> les quadrangles
333 if ( nbeqqu.gt.0 ) then
335 if ( codret.eq.0 ) then
338 #ifdef _DEBUG_HOMARD_
339 write (ulsort,texte(langue,3)) 'VCEQU6_qu', nompro
344 > somare, aretri, arequa,
345 > ulsort, langue, codret )
347 cgn print *,nompro,' apres 2.3.2'
349 cgn print 1789,(arehom(iaux),iaux=1,50)
355 #ifdef _DEBUG_HOMARD_
356 write (ulsort,texte(langue,7)) mess14(langue,3,1)
357 write (ulsort,texte(langue,5))
358 do 23000 , iaux = 1 , nbarto
359 if ( arehom(iaux).ne.0 ) then
360 write (ulsort,texte(langue,6)) mess14(langue,2,1),
366 c 2.4. ==> on verifie que toutes les aretes bordant des triangles
367 c ou des quadrangles ont bien ete enregistrees
369 if ( codret.eq.0 ) then
371 #ifdef _DEBUG_HOMARD_
372 write (ulsort,texte(langue,3)) 'VCEQU7', nompro
374 call vcequ7 ( arehom,
377 > ulsort, langue, codret )
384 c 3. enrichissement de la structure sur les noeuds a partir de la
385 c donnee des aretes homologues. cette donnee est soit issue du
386 c maillage a analyser, soit creee/enrichie par le traitement des
387 c triangles et des quadrangles homologues.
388 c il faut faire cette etape apres celle sur les triangles et les
389 c quadrangles, sinon on oublie de l'information
392 if ( codret.eq.0 ) then
394 if ( homolo.ge.2 ) then
396 do 31 , entlo2 = 1 , nbarto
398 entlo1 = arehom(entlo2)
400 if ( entlo1.gt.0 ) then
403 #ifdef _DEBUG_HOMARD_
404 write (ulsort,texte(langue,3)) 'VCEQU5', nompro
406 call vcequ5 ( entlo1, jaux,
410 > ulsort, langue, codret )
416 cgn print *,nompro,' apres 3'
418 cgn print 1789,(noehom(iaux),iaux=1,27)
420 #ifdef _DEBUG_HOMARD_
421 write (ulsort,texte(langue,7)) mess14(langue,3,-1)
422 write (ulsort,texte(langue,5))
423 do 30000 , iaux = 1 , nbnoto
424 if ( noehom(iaux).ne.0 ) then
425 write (ulsort,texte(langue,6)) mess14(langue,2,-1),
436 c 4. decompte du nombre de paires d'entites homologues
439 if ( codret.eq.0 ) then
441 #ifdef _DEBUG_HOMARD_
442 write (ulsort,texte(langue,3)) 'UTHONH', nompro
444 call uthonh ( noehom, arehom,
446 > ulsort, langue, codret )
454 if ( codret.ne.0 ) then
458 write (ulsort,texte(langue,1)) 'Sortie', nompro
459 write (ulsort,texte(langue,2)) codret
463 #ifdef _DEBUG_HOMARD_
464 write (ulsort,texte(langue,1)) 'Sortie', nompro