1 subroutine pcmaar ( elemen, nbele0,
2 > somare, np2are, hetare,
4 > nnosca, narsca, narsho,
5 > famele, noeele, typele,
6 > ulsort, langue, codret )
7 c ______________________________________________________________________
11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
14 c aupres des huissiers de justice Simart et Lavoir a Clamart
15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
16 c aupres des huissiers de justice
17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
19 c HOMARD est une marque deposee d'Electricite de France
25 c ______________________________________________________________________
27 c aPres adaptation - Conversion - MAillage connectivite - ARetes
29 c ______________________________________________________________________
31 c remarque : voir vcorie pour la definition des orientations
32 c remarque : pcmaar et pcmaa0 sont des clones
33 c ______________________________________________________________________
35 c . nom . e/s . taille . description .
36 c .____________________________________________________________________.
37 c . elemen . es . 1 . numero du dernier element cree .
38 c . nbele0 . e . 1 . estimation du nombre d'elements .
39 c . somare . e .2*nbarto. numeros des extremites d'arete .
40 c . np2are . e . nbarto . numero du noeud p2 milieu d'arete .
41 c . hetare . e . nbarto . historique de l'etat des aretes .
42 c . famare . e . nbarto . famille des aretes .
43 c . cfaare . e . nctfar*. codes des familles des aretes .
44 c . . . nbfare . 1 : famille MED .
45 c . . . . 2 : type de segment .
46 c . . . . 3 : orientation .
47 c . . . . 4 : famille d'orientation inverse .
48 c . . . . 5 : numero de ligne de frontiere .
49 c . . . . > 0 si concernee par le suivi de frontiere.
50 c . . . . <= 0 si non concernee .
51 c . . . . 6 : famille frontiere active/inactive .
52 c . . . . 7 : numero de surface de frontiere .
53 c . . . . + l : appartenance a l'equivalence l .
54 c . nnosca . e . rsnoto . numero des noeuds du code de calcul .
55 c . narsca . s . rsarto . numero des aretes du calcul .
56 c . narsho . s . nbele0 . numero des aretes dans HOMARD .
57 c . famele . es . nbele0 . famille med des elements .
58 c . noeele . es . nbele0 . noeuds des elements .
60 c . typele . es . nbele0 . type des elements .
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 . . . . 1 : probleme .
67 c ______________________________________________________________________
70 c 0. declarations et dimensionnement
73 c 0.1. ==> generalites
79 parameter ( nompro = 'PCMAAR' )
104 integer somare(2,nbarto), np2are(nbarto)
105 integer hetare(nbarto)
107 integer cfaare(nctfar,nbfare), famare(nbarto)
109 integer nnosca(rsnoto)
110 integer narsca(rsarto), narsho(nbele0)
112 integer famele(nbele0), noeele(nbele0,nbmane)
113 integer typele(nbele0)
115 integer ulsort, langue, codret
117 c 0.4. ==> variables locales
124 parameter ( nbmess = 20 )
125 character*80 texte(nblang,nbmess)
127 c 0.5. ==> initialisations
128 c ______________________________________________________________________
136 #ifdef _DEBUG_HOMARD_
137 write (ulsort,texte(langue,1)) 'Entree', nompro
145 #ifdef _DEBUG_HOMARD_
146 write (ulsort,90002) 'nbarto', nbarto
147 write (ulsort,90002) 'rsarto', rsarto
148 write (ulsort,90002) 'nbele0', nbele0
152 c 2. initialisations des renumerotations
155 do 21 , iaux = 1 , rsarto
159 do 22 , iaux = 1 , nbele0
164 c 3. Conversion en lineaire
167 if ( degre.eq.1 ) then
170 c n1*-------------*n2
172 do 31 , larete = 1 , nbarto
174 #ifdef _DEBUG_HOMARD_
175 write (ulsort,texte(langue,11)) mess14(langue,2,1), larete
176 write (ulsort,texte(langue,12))
177 > cotyel, cfaare(cotyel,famare(larete))
180 if ( cfaare(cotyel,famare(larete)).ne.0 ) then
182 etat = mod( hetare(larete) , 10 )
184 #ifdef _DEBUG_HOMARD_
185 write (ulsort,texte(langue,13)) hetare(larete), etat
188 if ( etat.eq.0 .or. hierar.ne.0 ) then
191 #ifdef _DEBUG_HOMARD_
192 write (ulsort,texte(langue,14)) elemen
194 narsho(elemen) = larete
195 narsca(larete) = elemen
197 if ( cfaare(coorfa,famare(larete)).eq.1 ) then
198 noeele(elemen,1) = nnosca(somare(1,larete))
199 noeele(elemen,2) = nnosca(somare(2,larete))
201 noeele(elemen,1) = nnosca(somare(2,larete))
202 noeele(elemen,2) = nnosca(somare(1,larete))
205 famele(elemen) = cfaare(cofamd,famare(larete))
206 typele(elemen) = cfaare(cotyel,famare(larete))
208 #ifdef _DEBUG_HOMARD_
209 if ( elemen.eq.-12 ) then
210 write (ulsort,90002) 'famare', famare(larete)
211 write (ulsort,texte(langue,14)) elemen
212 write (ulsort,texte(langue,15))
213 > (noeele(elemen,iaux),iaux=1,2)
214 write (ulsort,90002) 'Famille MED',famele(elemen)
215 write (ulsort,90002) 'Type MED ',typele(elemen)
225 c 4. Conversion en quadratique
230 c n1*------*------*n4
233 do 41 , larete = 1 , nbarto
235 #ifdef _DEBUG_HOMARD_
236 write (ulsort,texte(langue,11)) mess14(langue,2,1), larete
237 write (ulsort,texte(langue,12))
238 > cotyel, cfaare(cotyel,famare(larete))
241 if ( cfaare(cotyel,famare(larete)).ne.0 ) then
243 etat = mod( hetare(larete) , 10)
245 #ifdef _DEBUG_HOMARD_
246 write (ulsort,texte(langue,13)) hetare(larete), etat
249 if ( etat.eq.0 .or. hierar.ne.0 ) then
251 #ifdef _DEBUG_HOMARD_
252 write (ulsort,texte(langue,14)) elemen
254 narsho(elemen) = larete
255 narsca(larete) = elemen
257 if ( cfaare(coorfa,famare(larete)).eq.1 ) then
258 noeele(elemen,1) = nnosca(somare(1,larete))
259 noeele(elemen,2) = nnosca(somare(2,larete))
261 noeele(elemen,1) = nnosca(somare(2,larete))
262 noeele(elemen,2) = nnosca(somare(1,larete))
264 noeele(elemen,3) = nnosca(np2are(larete))
266 famele(elemen) = cfaare(cofamd,famare(larete))
267 typele(elemen) = cfaare(cotyel,famare(larete))
280 if ( codret.ne.0 ) then
284 write (ulsort,texte(langue,1)) 'Sortie', nompro
285 write (ulsort,texte(langue,2)) codret
289 #ifdef _DEBUG_HOMARD_
290 write (ulsort,texte(langue,1)) 'Sortie', nompro