1 subroutine mmagr0 ( voltri,
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 Modification de Maillage - AGRegat - phase 0
28 c Reperage des triangles a l'interface entre deux grains
29 c . Memorisation des familles MED de part et d'autre d'un joint
30 c . Decompte du nombre de pentaedres a creer
31 c ______________________________________________________________________
33 c . nom . e/s . taille . description .
34 c .____________________________________________________________________.
35 c . voltri . e .2*nbtrto. numeros des 2 volumes par triangle .
36 c . . . . voltri(i,k) definit le i-eme voisin de k .
37 c . . . . 0 : pas de voisin .
38 c . . . . j>0 : tetraedre j .
39 c . . . . j<0 : pyramide/pentaedre dans pypetr(1/2,j).
40 c . famtet . e . nbteto . famille des tetraedres .
41 c . cfatet . e . nctfte. codes des familles des tetraedres .
42 c . . . nbftet . 1 : famille MED .
43 c . . . . 2 : type de tetraedres .
44 c . tbaux1 . s . 4** . Pour le i-eme pentaedre de joint simple : .
45 c . . . . (1,i) : numero du triangle a dupliquer .
46 c . . . . (2,i) : numero du joint simple cree .
47 c . . . . (3,i) : tetraedre du cote min(fammed) .
48 c . . . . (4,i) : tetraedre du cote max(fammed) .
49 c . tbaux2 . s . 4** . Pour le i-eme joint : .
50 c . . . . Numeros des familles MED des volumes .
51 c . . . . jouxtant le pentaedre/hexaedre, classes du .
52 c . . . . plus petit (1,i) au plus grand .
53 c . . . . 0, si pas de volume voisin .
54 c . nbjois . s . 1 . nombre de joints simples .
55 c . nbpejs . s . 1 . nombre de pentaedres de joints simples .
56 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
57 c . langue . e . 1 . langue des messages .
58 c . . . . 1 : francais, 2 : anglais .
59 c . codret . es . 1 . code de retour des modules .
60 c . . . . 0 : pas de probleme .
61 c ______________________________________________________________________
64 c 0. declarations et dimensionnement
67 c 0.1. ==> generalites
73 parameter ( nompro = 'MMAGR0' )
90 integer voltri(2,nbtrto)
91 integer famtet(nbteto), cfatet(nctfte,nbftet)
92 integer tbaux1(4,nbtrto), tbaux2(4,*)
94 integer nbjois, nbpejs
96 integer ulsort, langue, codret
98 c 0.4. ==> variables locales
102 integer famhom(2), fammed(2)
103 integer letet1, letet2
107 parameter ( nbmess = 30 )
108 character*80 texte(nblang,nbmess)
110 c 0.5. ==> initialisations
111 c ______________________________________________________________________
119 #ifdef _DEBUG_HOMARD_
120 write (ulsort,texte(langue,1)) 'Entree', nompro
127 #ifdef _DEBUG_HOMARD_
128 write (ulsort,texte(langue,19)) mess14(langue,3,3), nbftet
134 c 2. Parcours des triangles
135 c Si les caracteristiques des deux tetraedres voisins sont les
136 c memes, on ne fait rien.
137 c Si le groupe des deux tetraedres voisins est different, on
138 c memorise l'information : pentaedre a creer et famille
139 c Remarque : on part du principe qu'une famille MED est identifiee
140 c a un groupe, donc un grain
142 #ifdef _DEBUG_HOMARD_
143 write (ulsort,texte(langue,5)) mess14(langue,3,2)
149 do 21 , iaux = 1 , nbtrto
151 if ( voltri(2,iaux).ne.0 ) then
153 #ifdef _DEBUG_HOMARD_
154 write (ulsort,texte(langue,4)) ' ', mess14(langue,1,2), iaux
157 c 2.1. ==> Comparaison des familles HOMARD
159 #ifdef _DEBUG_HOMARD_
160 write (ulsort,90002) mess14(langue,3,3),
161 > voltri(1,iaux),voltri(2,iaux)
163 famhom(1) = famtet(voltri(1,iaux))
164 famhom(2) = famtet(voltri(2,iaux))
165 cgn write(ulsort,*) famhom(1),famhom(2)
166 if ( famhom(1).eq.famhom(2) ) then
170 c 2.2. ==> Comparaison des familles MED
172 fammed(1) = cfatet(cofamd,famhom(1))
173 fammed(2) = cfatet(cofamd,famhom(2))
174 cgn write(ulsort,*) fammed(1),fammed(2)
175 if ( fammed(1).eq.fammed(2) ) then
179 c 2.4. ==> Si on arrive ici, un pentaedre de joint simple est a creer.
180 c Quel joint pour ce pentaedre ?
182 do 24 , jaux = 1 , nbjois
183 cgn write(ulsort,*) jaux,tbaux2(1,jaux),tbaux2(2,jaux)
184 if ( ( tbaux2(1,jaux).eq.fammed(1) .and.
185 > tbaux2(2,jaux).eq.fammed(2) ) .or.
186 > ( tbaux2(1,jaux).eq.fammed(2) .and.
187 > tbaux2(2,jaux).eq.fammed(1) ) ) then
193 c Il faut creer un nouveau joint
196 cgn write (ulsort,texte(langue,6)) nbjois
197 cgn write (ulsort,texte(langue,20)) fammed(1),fammed(2)
198 tbaux2(1,nbjois) = min(fammed(1),fammed(2))
199 tbaux2(2,nbjois) = max(fammed(1),fammed(2))
204 c 2.5. ==> Reperage du positionnement du triangle pour le tetraedre
207 if ( fammed(1).eq.tbaux2(1,nujoin) ) then
208 letet1 = voltri(1,iaux)
209 letet2 = voltri(2,iaux)
211 letet1 = voltri(2,iaux)
212 letet2 = voltri(1,iaux)
214 cgn if ( iaux.eq.33 .or. iaux.eq.56 ) then
215 cgn write (ulsort,90001)'triangle', iaux,
216 cgn > fammed(1),fammed(2),tbaux2(1,nbjois)
217 cgn write (ulsort,90002)' voltri', voltri(1,iaux),voltri(2,iaux)
218 cgn write (ulsort,90002)'=> letet1', letet1
221 c 2.6. ==> Pour ce pentaedre :
222 c 1 : son triangle de base est le courant
223 c 2 : son joint simple
224 c 3 : le tetraedre du cote 1
225 c 4 : le tetraedre du cote 2
229 tbaux1(1,nbpejs) = iaux
230 tbaux1(2,nbpejs) = nujoin
231 tbaux1(3,nbpejs) = letet1
232 tbaux1(4,nbpejs) = letet2
242 if ( codret.eq.0 ) then
244 write (ulsort,texte(langue,12)) nbjois
245 if ( nbjois.gt.0 ) then
246 write (ulsort,texte(langue,11)) mess14(langue,3,7), nbpejs
249 #ifdef _DEBUG_HOMARD_
253 do 31 , nujoin = iaux, jaux
254 write (ulsort,1001) nujoin, tbaux2(1,nujoin), tbaux2(2,nujoin)
258 1000 format( /,5x,31('*'),
259 > /,5x,'* Joint *',2(' MED *'),
261 1001 format(4x,3(' *',i8),' *')
262 1002 format(5x,31('*'),/)
271 if ( codret.ne.0 ) then
275 write (ulsort,texte(langue,1)) 'Sortie', nompro
276 write (ulsort,texte(langue,2)) codret
280 #ifdef _DEBUG_HOMARD_
281 write (ulsort,texte(langue,1)) 'Sortie', nompro