1 subroutine vcequ3 ( option,
2 > nbento, nbeqen, ibenti,
3 > nuenex, enthom, nensho, eqenti,
4 > ulsort, langue, codret )
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c aVant adaptation Conversion - EQUivalence - phase 3
28 c remarque : ce traitement suppose qu'une entite ne possede pas plus
29 c d'un homologue. Si des cas plus compliques apparaissent,
30 c il faudra modifier la structure des equivalences
32 c on fait une traduction bete des donnees en entree.
33 c pour chaque couple d'entite (e1,e2) donnees comme homologue, on
34 c note entequ(e1)=+-e2 et entequ(e2)=+-e1
35 c on fait evidemment les changements de numerotation appropries.
37 c remarque importante : reperage des elements homologues
38 c on prend la convention de reperage suivante : lorsque
39 c l'on a deux faces periodiques 1 et 2, on attribue un signe a
40 c chacune des faces. pour un noeud "i", noehom(i) est alors egal
41 c a la valeur suivante :
42 c - "le numero du noeud correspondant par periodicite
43 c si i est sur la face 2"
44 c - "l'oppose du numero du noeud correspondant par periodicite
45 c si i est sur la face 1"
47 c Donc, on etend cette convention a toutes les entites noeuds,
48 c aretes, triangles et quadrangles :
49 c enthom(i) = abs(homologue(i)) ssi i est sur la face 2
50 c enthom(i) = -abs(homologue(i)) ssi i est sur la face 1
52 c pour une entite situee sur l'axe, on prend la convention positive
54 c ______________________________________________________________________
56 c . nom . e/s . taille . description .
57 c .____________________________________________________________________.
58 c . option . e . 1 . variantes .
59 c . . . . -1 : noeuds .
60 c . . . . 1 : aretes .
61 c . . . . 2 : triangles .
62 c . . . . 4 : quadrangles .
63 c . nbento . e . 1 . nombre d'entites total .
64 c . nbeqen . e . 1 . nombre d'equivalence pour cette entite .
65 c . ibenti . e . 1 . reperage dans la numerotation contigue .
66 c . . . . des entites .
67 c . nuenex . e . * . numerotation des entites en exterieur .
68 c . enthom . s . nbento . liste etendue des entites homologues .
69 c . . . . enthom(i) = abs(hom(i)) ssi i sur face 2 .
70 c . . . . enthom(i) = -abs(hom(i)) ssi i sur face 1 .
71 c . nensho . e . rstrac . numero des entites dans HOMARD .
72 c . eqenti . e .2*nbeqen. ensemble des entites homologues ; leurs .
73 c . . . . numeros sont dans la numerotation du code .
75 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
76 c . langue . e . 1 . langue des messages .
77 c . . . . 1 : francais, 2 : anglais .
78 c . codret . es . 1 . code de retour des modules .
79 c . . . . 0 : pas de probleme .
80 c . . . . 1 : probleme .
81 c ______________________________________________________________________
84 c 0. declarations et dimensionnement
87 c 0.1. ==> generalites
93 parameter ( nompro = 'VCEQU3' )
106 integer nbento, nbeqen, ibenti
108 integer enthom(nbento), nensho(*), eqenti(2*nbeqen)
109 integer ulsort, langue, codret
111 c 0.4. ==> variables locales
113 integer entlo1, entlo2
117 parameter ( nbmess = 10 )
118 character*80 texte(nblang,nbmess)
120 c 0.5. ==> initialisations
121 c ______________________________________________________________________
131 #ifdef _DEBUG_HOMARD_
132 write (ulsort,texte(langue,1)) 'Entree', nompro
136 texte(1,4) = '(''Il/Elle devrait l''''etre aussi de'',i10,'' ?'')'
137 texte(1,5) = '(''Infos donnees en numerotation calcul'',/)'
138 texte(1,6) = '(''Infos donnees en numerotation HOMARD :'')'
139 texte(1,7) = '(a,i10,'' : est homologue de'',i10)'
140 texte(1,8) = '(''Equivalence sur les '',a)'
142 >'(''Raffinement impossible pour des equivalences multiples.'')'
144 texte(2,4) = '(''It also should be with #'',i10)'
145 texte(2,5) = '(''Infos given with calculation #'',/)'
146 texte(2,6) = '(''Infos given with HOMARD # :'')'
147 texte(2,7) = '(a,i10,'' : is homologous with'',i10)'
148 texte(2,8) = '(''Equivalence for '',a)'
149 texte(2,9) = '(''Refinement cannot be done.'')'
153 #ifdef _DEBUG_HOMARD_
154 write(ulsort,texte(langue,8)) mess14(langue,3,option)
158 c 2. prise en compte des donnees sur les entites homologues
159 c on complete la liste, en verifiant que si il y a deja un
160 c homologue, c'est le bon !
163 c 2.1. ==> tableaux etendus des entites homologues
164 c a priori aucun pour le moment
165 c remarque : on n'initialise les tableaux a 0 que si ils seront
166 c utilises. comme cela, s'ils le sont sans etre
167 c passes par ici, il y aura carton. Youpi.
169 if ( nbeqen.ne.0 ) then
170 do 21 , iaux = 1 , nbento
175 c 2.2. ==> prise en compte des donnees sur les entites homologues
176 c on complete la liste, en verifiant que si il y a deja un
177 c homologue, c'est le bon !
178 c pour une entite situee sur l'axe, c'est-a-dire homologues
179 c d'elle-meme, on prend la convention positive
181 do 22 , iaux = 1 , 2*nbeqen , 2
183 entlo1 = nensho(nuenex(ibenti+eqenti(iaux)))
184 entlo2 = nensho(nuenex(ibenti+eqenti(iaux+1)))
186 if ( enthom(entlo1).eq.0 ) then
187 if ( entlo1.eq.entlo2 ) then
188 enthom(entlo1) = entlo2
190 enthom(entlo1) = - entlo2
193 if ( abs(enthom(entlo1)).ne.entlo2 ) then
194 write(ulsort,texte(langue,7)) mess14(langue,1,option),
195 > entlo1, abs(enthom(entlo1))
196 write(ulsort,texte(langue,4)) entlo2
197 write(ulsort,texte(langue,5))
202 if ( enthom(entlo2).eq.0 ) then
203 enthom(entlo2) = entlo1
205 if ( abs(enthom(entlo2)).ne.entlo1 ) then
206 write(ulsort,texte(langue,7)) mess14(langue,1,option),
207 > entlo2, enthom(entlo2)
208 write(ulsort,texte(langue,4)) entlo1
209 write(ulsort,texte(langue,5))
220 #ifdef _DEBUG_HOMARD_
221 if ( nbeqen.ne.0 ) then
222 write(ulsort,texte(langue,6))
223 do 31 , iaux = 1 , nbento
224 if ( enthom(iaux).ne.0 ) then
225 write(ulsort,texte(langue,7)) mess14(langue,1,option),
232 if ( codret.ne.0 ) then
236 write (ulsort,texte(langue,1)) 'Sortie', nompro
237 write (ulsort,texte(langue,2)) codret
238 write (ulsort,texte(langue,9))
242 #ifdef _DEBUG_HOMARD_
243 write (ulsort,texte(langue,1)) 'Sortie', nompro