1 subroutine mmag91 ( larete, ordre, nujois,
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 9.1
28 c Reperage des aretes liees aux joints simples formant
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . larete . e . 1 . arete support du joint multiple .
35 c . ordre . e . 1 . ordre du joint a explorer .
36 c . nujois . e . ordre . numeros des joints simples associes .
37 c . nbduno . e . 1 . nombre de duplication de noeuds .
38 c . tbau30 . e .8*nbduno. Pour la i-eme duplication de noeud : .
39 c . . . . (1,i) : noeud a dupliquer .
40 c . . . . (2,i) : arete construite sur le noeud .
41 c . . . . (3,i) : noeud cree cote min(fammed) .
42 c . . . . (4,i) : noeud cree cote max(fammed) .
43 c . . . . (5,i) : numero du joint simple cree .
44 c . . . . (6,i) : arete entrant dans le cote 1 .
45 c . . . . (7,i) : arete entrant dans le cote 2 .
46 c . . . . (8,i) : ordre de multiplicite .
47 c . somare . e .2*nbarto. numeros des extremites d'arete .
48 c . aredup . s .2*nbduno. aretes issues de la duplication .
49 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
50 c . langue . e . 1 . langue des messages .
51 c . . . . 1 : francais, 2 : anglais .
52 c . codret . es . 1 . code de retour des modules .
53 c . . . . 0 : pas de probleme .
54 c ______________________________________________________________________
57 c 0. declarations et dimensionnement
60 c 0.1. ==> generalites
66 parameter ( nompro = 'MMAG91' )
80 integer ordre, nujois(ordre)
81 integer nbduno, tbau30(8,nbduno)
82 integer somare(2,nbarto)
83 integer aredup(2*ordre)
85 integer ulsort, langue, codret
87 c 0.4. ==> variables locales
89 integer iaux, jaux, kaux
93 parameter ( nbmess = 40 )
94 character*80 texte(nblang,nbmess)
96 c 0.5. ==> initialisations
97 c ______________________________________________________________________
106 #ifdef _DEBUG_HOMARD_
107 write (ulsort,texte(langue,1)) 'Entree', nompro
118 c 2. On explore tous les noeuds qui ont ete dupliques
120 c . le noeud duplique est un des sommets de l'arete triple
121 c . la duplication a lieu pour un des joints simples associes
123 c On stocke les aretes qui partent de chacun des noeuds.
128 do 21 , iaux = 1 , nbduno
130 do 211 , jaux = 1 , 2
132 #ifdef _DEBUG_HOMARD_
133 write (ulsort,texte(langue,4)) '. ', mess14(langue,1,-1),
134 > somare(jaux,larete)
137 if ( tbau30(1,iaux).eq.somare(jaux,larete) ) then
139 do 2111 , kaux = 1 , ordre
141 c write (ulsort,*) 'nujois(kaux) =', nujois(kaux)
143 if ( tbau30(5,iaux).eq.nujois(kaux) ) then
144 aredup(ordre*(jaux-1)+kaux) = tbau30(2,iaux)
145 #ifdef _DEBUG_HOMARD_
146 write (ulsort,texte(langue,40)) mess14(langue,1,-1),
147 > tbau30(1,iaux),mess14(langue,1,1),tbau30(2,iaux)
150 if ( nbarlo.eq.2*ordre ) then
165 c Si on arrive ici, c'est que les aretes n'ont pas ete trouvees
167 write (ulsort,texte(langue,4)) ' ', mess14(langue,1,1), larete
168 write (ulsort,texte(langue,38)) mess14(langue,3,-1)
177 if ( codret.ne.0 ) then
181 write (ulsort,texte(langue,1)) 'Sortie', nompro
182 write (ulsort,texte(langue,2)) codret
186 #ifdef _DEBUG_HOMARD_
187 write (ulsort,texte(langue,1)) 'Sortie', nompro