1 subroutine cmrda1 ( coonoe, hetnoe, arenoe, somare,
2 > hetare, filare, merare, decare,
3 > cfaare, famare, famnoe,
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 - DEcoupage des Aretes en degre 1
28 c ______________________________________________________________________
30 c but : decoupage des aretes en degre 1
31 c creation de 2 aretes et de 1 noeud
32 c les coordonnees des nouveaux noeuds sont calculees par
33 c interpolation lineaire sur les deux noeuds voisins
34 c ______________________________________________________________________
36 c . nom . e/s . taille . description .
37 c .____________________________________________________________________.
38 c . coonoe . es .nouvno*3. coordonnees des noeuds .
39 c . hetnoe . es . nouvno . historique de l'etat des noeuds .
40 c . arenoe . es . nouvno . arete liee a un nouveau noeud .
41 c . somare . es .2*nouvar. numeros des extremites d'arete .
42 c . hetare . es . nouvar . historique de l'etat des aretes .
43 c . filare . es . nouvar . premiere fille des aretes .
44 c . merare . es . nouvar . mere des aretes .
45 c . decare . es .0:nbarto. decision des aretes .
46 c . cfaare . e . nctfar*. codes des familles des aretes .
47 c . . . nbfare . 1 : famille MED .
48 c . . . . 2 : type de segment .
49 c . . . . 3 : orientation .
50 c . . . . 4 : famille d'orientation inverse .
51 c . . . . 5 : numero de ligne de frontiere .
52 c . . . . > 0 si concernee par le suivi de frontiere.
53 c . . . . <= 0 si non concernee .
54 c . . . . 6 : famille frontiere active/inactive .
55 c . . . . 7 : numero de surface de frontiere .
56 c . . . . + l : appartenance a l'equivalence l .
57 c . famare . es . nouvar . famille des aretes .
58 c . famnoe . es . nouvno . caracteristiques des noeuds .
59 c . indnoe . es . 1 . indice du dernier noeud cree .
60 c . indare . es . 1 . indice de la derniere arete creee .
61 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
62 c . langue . e . 1 . langue des messages .
63 c . . . . 1 : francais, 2 : anglais .
64 c . codret . es . 1 . code de retour des modules .
65 c . . . . 0 : pas de probleme .
66 c ______________________________________________________________________
69 c 0. declarations et dimensionnement
72 c 0.1. ==> generalites
78 parameter ( nompro = 'CMRDA1' )
96 double precision coonoe(nouvno,sdim)
98 integer hetnoe(nouvno), arenoe(nouvno)
99 integer somare(2,nouvar), hetare(nouvar)
100 integer filare(nouvar), merare(nouvar), decare(0:nbarto)
101 integer famare(nouvar), cfaare(nctfar,nbfare), famnoe(nouvno)
102 integer indare, indnoe
104 integer ulsort, langue, codret
106 c 0.4. ==> variables locales
108 integer etat, larete, mere, na1, na2, s1, s2
112 parameter ( nbmess = 10 )
113 character*80 texte(nblang,nbmess)
114 c ______________________________________________________________________
122 #ifdef _DEBUG_HOMARD_
123 write (ulsort,texte(langue,1)) 'Entree', nompro
127 texte(1,4) = '(''Decoupage de l''''arete'',i10)'
128 texte(1,5) = '(''... Noeud milieu'',i10,'', aretes filles'',2i10)'
130 texte(2,4) = '(''Splitting of edge #'',i10)'
131 texte(2,5) = '(''... Node'',i10,'', edges'',2i10)'
134 c 2. decoupage en 2 des aretes de decision 2
137 do 200 , larete = 1 , nbarpe
139 if ( decare(larete).eq.2 ) then
140 #ifdef _DEBUG_HOMARD_
141 write (ulsort,texte(langue,4)) larete
144 c 2.1. ==> creation du noeud milieu : nouveau sommet
147 arenoe(indnoe) = larete
148 s1 = somare(1,larete)
149 s2 = somare(2,larete)
150 coonoe(indnoe,1) = ( coonoe(s1,1) + coonoe(s2,1) ) * unsde
151 if ( sdim.ge.2 ) then
152 coonoe(indnoe,2) = ( coonoe(s1,2) + coonoe(s2,2) ) * unsde
153 if ( sdim.eq.3 ) then
154 coonoe(indnoe,3) = ( coonoe(s1,3) + coonoe(s2,3) ) * unsde
160 c 2.2. ==> creation de la premiere arete
164 somare(2,na1) = indnoe
166 c 2.3. ==> creation de la seconde arete
170 somare(2,na2) = indnoe
172 c 2.4. ==> mise a jour de la mere et de la grand-mere eventuelle
175 hetare(larete) = hetare(larete) + 2
176 mere = merare(larete)
177 if ( mere .ne. 0 ) then
179 hetare(mere) = etat - mod(etat,10) + 9
182 c 2.5. ==> caracteristiques des deux filles
184 famare(na1) = famare(larete)
185 c correction pour l'orientation de la deuxieme fille
186 famare(na2) = cfaare(cofifa,famare(larete))
197 #ifdef _DEBUG_HOMARD_
198 write (ulsort,texte(langue,5)) indnoe, na1, na2
209 if ( codret.ne.0 ) then
213 write (ulsort,texte(langue,1)) 'Sortie', nompro
214 write (ulsort,texte(langue,2)) codret
218 #ifdef _DEBUG_HOMARD_
219 write (ulsort,texte(langue,1)) 'Sortie', nompro