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 elseif ( sdim.eq.2 ) then
308 if ( dimcst.eq.0 .or. dimcst.eq.3 ) then
311 elseif ( dimcst.eq.1 ) then
314 elseif ( dimcst.eq.2 ) then
318 write (ulsort,texte(langue,6)) dimcst
322 if ( codret.eq.0 ) then
324 do 222 , lenoeu = 1 , nbnoto
325 lenolo = nnosho(lenoeu)
326 coonca(lenoeu,iaux) = coonoe(lenolo,1)
327 coonca(lenoeu,jaux) = coonoe(lenolo,2)
330 if ( dimcst.ne.0 ) then
331 do 2221 , lenoeu = 1 , nbnoto
332 coonca(lenoeu,dimcst) = coocst(1)
340 do 223 , lenoeu = 1 , nbnoto
341 #ifdef _DEBUG_HOMARD_
342 if ( lenoeu.eq.-12 ) then
348 #ifdef _DEBUG_HOMARD_
349 if ( glop.ne.0 ) then
350 write (ulsort,texte(langue,11)) mess14(langue,2,-1), lenoeu
353 lenolo = nnosho(lenoeu)
354 coonca(lenoeu,1) = coonoe(lenolo,1)
355 coonca(lenoeu,2) = coonoe(lenolo,2)
356 coonca(lenoeu,3) = coonoe(lenolo,3)
362 c 3. la famille des noeuds
364 #ifdef _DEBUG_HOMARD_
365 write (ulsort,*) '3. la famille des noeuds ; codret = ', codret
368 do 31, lenoeu = 1, rsnoto
369 #ifdef _DEBUG_HOMARD_
370 if ( lenoeu.eq.-12 ) then
376 #ifdef _DEBUG_HOMARD_
377 if ( glop.ne.0 ) then
378 write (ulsort,texte(langue,11)) mess14(langue,2,-1), lenoeu
379 write (ulsort,*) 'nnosho(lenoeu) =', nnosho(lenoeu)
380 write (ulsort,*) 'famnoe =', famnoe(nnosho(lenoeu))
381 c write (ulsort,texte(langue,16)) cofamd
384 fameno(lenoeu) = cfanoe(cofamd,famnoe(nnosho(lenoeu)))
391 if ( codret.ne.0 ) then
395 write (ulsort,texte(langue,1)) 'Sortie', nompro
396 write (ulsort,texte(langue,2)) codret
400 #ifdef _DEBUG_HOMARD_
401 write (ulsort,texte(langue,1)) 'Sortie', nompro