1 subroutine pcmano ( coonoe, hetnoe,
4 > dimcst, coocst, sdimca, coonca,
7 > ulsort, langue, codret )
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c aPres adaptation - Conversion - MAillage connectivite - NOeud
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . coonoe . e . nbnoto . coordonnees des noeuds .
36 c . hetnoe . e . nbnoto . historique de l'etat des noeuds .
37 c . famnoe . e . nbnoto . famille des noeuds .
38 c . cfanoe . e . nctfno*. codes des familles des noeuds .
39 c . . . nbnoto . 1 : famille MED .
40 c . . . . + l : appartenance a l'equivalence l .
41 c . nnosca . s . rsnoto . numero des noeuds du code de calcul .
42 c . nnosho . s . rsnoac . numero des noeuds dans HOMARD .
43 c . dimcst . e . 1 . dimension de la coordonnee constante .
44 c . . . . eventuelle, 0 si toutes varient .
45 c . coocst . e . 11 . 1 : coordonnee constante eventuelle .
46 c . . . . 2, 3, 4 : xmin, ymin, zmin .
47 c . . . . 5, 6, 7 : xmax, ymax, zmax .
48 c . . . . 8, 9, 10 : -1 si constant, max-min sinon .
49 c . . . . 11 : max des (max-min) .
50 c . sdimca . e . 1 . dimension de l'espace de calcul .
51 c . coonca . s . nbnoto . coordonnees des noeuds dans le calcul .
53 c . noeord . e . 1 . vrai si les noeuds sont ordonnes .
54 c . . . . faux si sans importance .
55 c . fameno . s . nbnoto . famille med des noeuds .
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 . . . . 1 : probleme .
62 c ______________________________________________________________________
65 c 0. declarations et dimensionnement
68 c 0.1. ==> generalites
74 parameter ( nompro = 'PCMANO' )
92 integer dimcst, sdimca
94 double precision coocst(11)
95 double precision coonoe(nbnoto,sdim), coonca(nbnoto,sdimca)
97 integer hetnoe(nbnoto)
98 integer cfanoe(nctfno,nbfnoe), famnoe(nbnoto)
99 integer nnosca(rsnoto), nnosho(rsnoac)
100 integer fameno(nbnoto)
104 integer ulsort, langue, codret
106 c 0.4. ==> variables locales
108 integer lenoeu, lenolo
110 integer iaux, jaux, kaux, laux, maux
111 #ifdef _DEBUG_HOMARD_
116 parameter ( nbmess = 20 )
117 character*80 texte(nblang,nbmess)
119 c 0.5. ==> initialisations
120 c ______________________________________________________________________
130 #ifdef _DEBUG_HOMARD_
131 write (ulsort,texte(langue,1)) 'Entree', nompro
135 texte(1,4) = '(''Nombre de noeuds '',a2,'' calcule :'',i10)'
136 texte(1,5) = '(''Nombre de noeuds '',a2,'' estime :'',i10)'
137 texte(1,6) = '(''Coordonnee constante incorrecte :'',i7)'
138 texte(1,10) = '(''Les deux doivent etre egaux ...'')'
140 texte(2,4) = '(''Computed number of '',a2,'' nodes :'',i10)'
141 texte(2,5) = '(''Estimated number of '',a2,'' nodes :'',i10)'
142 texte(2,6) = '(''Constant coordinate is wrong :'',i7)'
143 texte(2,10) = '(''Both numbers oUGht to be equal ...'')'
153 c 2.1. ==> renumerotation eventuelle des noeuds pour placer les
154 c noeuds dans l'ordre suivant :
156 c . noeuds d'elements ignores
157 c . noeuds uniquement support de maille-point
160 c sinon, pas de changement de renumerotation
161 cgn write(6,*) 'noeord = ',noeord
162 cgn write(6,*) 'nbnois, nbnoei, nbnomp, nbnop1, nbnoto = ',
163 cgn >nbnois, nbnoei, nbnomp, nbnop1, nbnoto
173 do 211 , lenoeu = 1 , nbnoto
175 #ifdef _DEBUG_HOMARD_
176 if ( lenoeu.eq.-12 ) then
182 #ifdef _DEBUG_HOMARD_
183 if ( glop.ne.0 ) then
184 write (ulsort,texte(langue,11)) mess14(langue,2,-1), lenoeu
187 if ( hetnoe(lenoeu).eq.0) then
189 nnosho(iaux) = lenoeu
190 nnosca(lenoeu) = iaux
192 etat = mod ( hetnoe(lenoeu), 10 )
193 if ( etat.eq.7 ) then
195 nnosho(jaux) = lenoeu
196 nnosca(lenoeu) = jaux
197 elseif ( etat.eq.3 ) then
199 nnosho(kaux) = lenoeu
200 nnosca(lenoeu) = kaux
201 elseif ( etat.eq.1 ) then
203 nnosho(laux) = lenoeu
204 nnosca(lenoeu) = laux
205 elseif ( etat.eq.2 ) then
207 nnosho(maux) = lenoeu
208 nnosca(lenoeu) = maux
215 if ( iaux.ne.nbnois ) then
216 write(ulsort,texte(langue,4)) 'is', iaux
217 write(ulsort,texte(langue,5)) 'is', nbnois
218 write(ulsort,texte(langue,10))
222 if ( kaux-nbnois.ne.nbnoei ) then
223 write(ulsort,texte(langue,4)) 'IG', jaux-nbnois
224 write(ulsort,texte(langue,5)) 'IG', nbnoei
225 write(ulsort,texte(langue,10))
229 if ( kaux-nbnois-nbnoei.ne.nbnomp ) then
230 write(ulsort,texte(langue,4)) 'MP', jaux-nbnois-nbnoei
231 write(ulsort,texte(langue,5)) 'MP', nbnomp
232 write(ulsort,texte(langue,10))
236 if ( laux-nbnois-nbnoei-nbnomp.ne.nbnop1 ) then
237 write(ulsort,texte(langue,4)) 'P1', kaux-nbnois-nbnoei-nbnomp
238 write(ulsort,texte(langue,5)) 'P1', nbnop1
239 write(ulsort,texte(langue,10))
243 if ( maux-nbnois-nbnoei-nbnomp-nbnop1.ne.nbnop2 ) then
244 write(ulsort,texte(langue,4)) 'P2',
245 > laux-nbnois-nbnoei-nbnomp-nbnop1
246 write(ulsort,texte(langue,5)) 'P2', nbnop2
247 write(ulsort,texte(langue,10))
253 do 212 , lenoeu = 1 , nbnoto
254 #ifdef _DEBUG_HOMARD_
255 if ( lenoeu.eq.-12 ) then
261 #ifdef _DEBUG_HOMARD_
262 if ( glop.ne.0 ) then
263 write (ulsort,texte(langue,11)) mess14(langue,2,-1), lenoeu
266 nnosho(lenoeu) = lenoeu
267 nnosca(lenoeu) = lenoeu
292 CGN do 219 , lenoeu = 1 , nbnoto
293 CGN write(6,5555) lenoeu, nnosho(lenoeu), nnosca(lenoeu)
297 c 2.2. ==> les coordonnees
299 if ( sdim.eq.1 ) then
301 do 221 , lenoeu = 1 , nbnoto
302 lenolo = nnosho(lenoeu)
303 coonca(lenoeu,1) = coonoe(lenolo,1)
306 do 2223 , lenoeu = 1 , nbnoto
307 coonca(lenoeu,2) = 0.d0
311 elseif ( sdim.eq.2 ) then
313 if ( dimcst.eq.0 .or. dimcst.eq.3 ) then
316 elseif ( dimcst.eq.1 ) then
319 elseif ( dimcst.eq.2 ) then
323 write (ulsort,texte(langue,6)) dimcst
327 if ( codret.eq.0 ) then
329 do 222 , lenoeu = 1 , nbnoto
330 lenolo = nnosho(lenoeu)
331 coonca(lenoeu,iaux) = coonoe(lenolo,1)
332 coonca(lenoeu,jaux) = coonoe(lenolo,2)
335 if ( dimcst.ne.0 ) then
336 do 2221 , lenoeu = 1 , nbnoto
337 coonca(lenoeu,dimcst) = coocst(1)
345 do 223 , lenoeu = 1 , nbnoto
346 #ifdef _DEBUG_HOMARD_
347 if ( lenoeu.eq.-12 ) then
353 #ifdef _DEBUG_HOMARD_
354 if ( glop.ne.0 ) then
355 write (ulsort,texte(langue,11)) mess14(langue,2,-1), lenoeu
358 lenolo = nnosho(lenoeu)
359 coonca(lenoeu,1) = coonoe(lenolo,1)
360 coonca(lenoeu,2) = coonoe(lenolo,2)
361 coonca(lenoeu,3) = coonoe(lenolo,3)
367 c 3. la famille des noeuds
369 #ifdef _DEBUG_HOMARD_
370 write (ulsort,*) '3. la famille des noeuds ; codret = ', codret
373 do 31, lenoeu = 1, rsnoto
374 #ifdef _DEBUG_HOMARD_
375 if ( lenoeu.eq.-12 ) then
381 #ifdef _DEBUG_HOMARD_
382 if ( glop.ne.0 ) then
383 write (ulsort,texte(langue,11)) mess14(langue,2,-1), lenoeu
384 write (ulsort,*) 'nnosho(lenoeu) =', nnosho(lenoeu)
385 write (ulsort,*) 'famnoe =', famnoe(nnosho(lenoeu))
386 c write (ulsort,texte(langue,16)) cofamd
389 fameno(lenoeu) = cfanoe(cofamd,famnoe(nnosho(lenoeu)))
396 if ( codret.ne.0 ) then
400 write (ulsort,texte(langue,1)) 'Sortie', nompro
401 write (ulsort,texte(langue,2)) codret
405 #ifdef _DEBUG_HOMARD_
406 write (ulsort,texte(langue,1)) 'Sortie', nompro