1 subroutine cmhomo ( noehom, arehom, trihom, quahom,
2 > somare, filare, hetare, np2are,
3 > aretri, filtri, hettri,
4 > arequa, filqua, hetqua,
5 > ulsort, langue, codret )
6 c ______________________________________________________________________
10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
13 c aupres des huissiers de justice Simart et Lavoir a Clamart
14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
15 c aupres des huissiers de justice
16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
18 c HOMARD est une marque deposee d'Electricite de France
24 c ______________________________________________________________________
26 c Creation du Maillage - HOMOlogues
28 c ______________________________________________________________________
30 c but : mise a jour des tables d'homologues
32 c remarque importante : reperage des elements homologues
33 c on prend la convention de reperage suivante : lorsque
34 c l'on a deux faces periodiques 1 et 2, on attribue un signe a
35 c chacune des faces. pour un noeud "i", noehom(i) est alors egal
36 c a la valeur suivante :
37 c - "le numero du noeud correspondant par periodicite
38 c si i est sur la face 2"
39 c - "l'oppose du numero du noeud correspondant par periodicite
40 c si i est sur la face 1"
42 c Donc, on etend cette convention a toutes les entites noeuds,
43 c aretes, triangles et quadrangles :
44 c enthom(i) = abs(homologue(i)) ssi i est sur la face 2
45 c enthom(i) = -abs(homologue(i)) ssi i est sur la face 1
46 c pour une entite situee sur l'axe, on prend la convention positive.
48 c ______________________________________________________________________
50 c . nom . e/s . taille . description .
51 c .____________________________________________________________________.
52 c . noehom . es . nbnoto . ensemble des noeuds homologues .
53 c . arehom . es . nbarto . ensemble des aretes homologues .
54 c . trihom . es . nbtrto . ensemble des triangles homologues .
55 c . quahom . es . nbquto . ensemble des quadrangles homologues .
56 c . somare . e .2*nbarto. numeros des extremites d'arete .
57 c . filare . e . nbarto . premiere fille des aretes .
58 c . hetare . e . nbarto . historique de l'etat des aretes .
59 c . np2are . e . nbarto . numero des noeuds p2 milieux d'aretes .
60 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
61 c . filtri . e . nbtrto . premier fils des triangles .
62 c . hettri . e . nbtrto . historique de l'etat des triangles .
63 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
64 c . filqua . e . nbquto . premier fils des quadrangles .
65 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
66 c . ulsort . e . 1 . unite logique de la sortie generale .
67 c . langue . e . 1 . langue des messages .
68 c . . . . 1 : francais, 2 : anglais .
69 c . codret . es . 1 . code de retour des modules .
70 c . . . . 0 : pas de probleme .
71 c ______________________________________________________________________
74 c 0. declarations et dimensionnement
77 c 0.1. ==> generalites
83 parameter ( nompro = 'CMHOMO' )
99 integer noehom(nbnoto), arehom(nbarto)
100 integer trihom(nbtrto), quahom(nbquto)
101 integer somare(2,nbarto), filare(nbarto), hetare(nbarto)
102 integer np2are(nbarto)
103 integer aretri(nbtrto,3), filtri(nbtrto), hettri(nbtrto)
104 integer arequa(nbquto,4), filqua(nbquto), hetqua(nbquto)
106 integer ulsort, langue, codret
108 c 0.4. ==> variables locales
114 parameter ( nbmess = 10 )
115 character*80 texte(nblang,nbmess)
117 c 0.5. ==> initialisations
118 c ______________________________________________________________________
126 #ifdef _DEBUG_HOMARD_
127 write (ulsort,texte(langue,1)) 'Entree', nompro
134 c 2. les tables des aretes
135 c il faut commencer par les aretes pour pouvoir traiter les tables
139 cgn print *,'debut de ', nompro
141 cgn print 1788,(trihom(iaux),iaux=1,16)
143 cgn print 1787,(quahom(iaux),iaux=1,8)
145 cgn print 1789,(arehom(iaux),iaux=1,50)
147 cgn print 1789,(noehom(iaux),iaux=1,27)
150 cgn 1789 format(10I4)
151 if (codret.eq.0 ) then
153 if ( homolo.ge.2 ) then
155 call cmhoma ( noehom, arehom,
156 > somare, filare, hetare,
157 > ulsort, langue, codret )
164 c 3. les tables des triangles
167 if (codret.eq.0 ) then
169 if ( homolo.ge.3 .and. nbtrto.ne.0 ) then
171 call cmhomt ( arehom, trihom,
173 > aretri, filtri, hettri,
174 > ulsort, langue, codret )
181 c 4. les tables des quadrangles et complements sur les triangles
184 if (codret.eq.0 ) then
186 if ( homolo.ge.3 .and. nbquto.ne.0 ) then
188 call cmhomq ( noehom, arehom, trihom, quahom,
190 > arequa, filqua, hetqua,
191 > ulsort, langue, codret )
198 c 5. les noeuds milieux en degre 2
199 c on n'examine que les aretes tracees sur la face periodique 2
200 c comme d'habitude, attention a l'axe ...
203 if ( codret.eq.0 ) then
205 if ( homolo.ge.2 ) then
207 if ( degre.eq.2 ) then
209 do 51, iaux = 1, nbarto
211 if ( arehom(iaux).gt.0 ) then
215 noehom(np2are(iaux)) = np2are(areh)
216 if ( iaux.ne.areh ) then
217 noehom(np2are(areh)) = -np2are(iaux)
231 c 6. decompte du nombre de paires d'entites homologues
234 if ( codret.eq.0 ) then
236 call uthonh ( noehom, arehom,
238 > ulsort, langue, codret )
246 if ( codret.ne.0 ) then
250 write (ulsort,texte(langue,1)) 'Sortie', nompro
251 write (ulsort,texte(langue,2)) codret
255 cgn print *,'fin de ', nompro
257 cgn print 1789,(trihom(iaux),iaux=1,nbtrto)
259 cgn print 1789,(quahom(iaux),iaux=1,nbquto)
261 cgn print 1789,(arehom(iaux),iaux=1,nbarto)
263 cgn print 1789,(noehom(iaux),iaux=1,nbnoto)
265 #ifdef _DEBUG_HOMARD_
266 write (ulsort,texte(langue,1)) 'Sortie', nompro