1 subroutine deinzr ( nbzord, cazord,
2 > coonoe, dimcst, coocst,
4 > nozone, arsupp, arindi,
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 traitement des DEcisions - INitialisation de l'indicateur
28 c defini par des Zones de Raffinement
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . nbzord . e . 1 . nombre de zones a raffiner/deraffiner .
35 c . cazord . e . 20 * . caracteristiques zone a raffiner/deraffiner.
36 c . . . nbzord . 1 : >0 si a raffiner, <0 si a deraffiner .
37 c . . . . . si rectangle : .
39 c . . . . de 2 a 5 : xmin, xmax, ymin, ymax .
40 c . . . . . si parallelepipede : .
42 c . . . . de 2 a 7 : xmin, xmax, ymin, ymax .
43 c . . . . zmin, zmax .
44 c . . . . . si disque : .
46 c . . . . de 8 a 10 : rayon, xcentr, ycentr .
47 c . . . . . si sphere : .
49 c . . . . de 8 a 11 : rayon, xcentr, ycentr, zcentr .
50 c . . . . . si cylindre : .
53 c . . . . de 12 a 14 : xaxe, yaxe, zaxe .
54 c . . . . de 15 a 17 : xbase, ybase, zbase .
55 c . . . . 18 : hauteur .
56 c . . . . . si disque perce : .
58 c . . . . de 9 a 10 : xcentr, ycentr .
59 c . . . . 19 : rayon interieur .
60 c . . . . 20 : rayon exterieur .
61 c . . . . . si tuyau : .
63 c . . . . de 12 a 14 : xaxe, yaxe, zaxe .
64 c . . . . de 15 a 17 : xbase, ybase, zbase .
65 c . . . . 18 : hauteur .
66 c . . . . 19 : rayon interieur .
67 c . . . . 20 : rayon exterieur .
68 c . coonoe . e . nbnoto . coordonnees des noeuds .
69 c . dimcst . e . 1 . dimension de la coordonnee constante .
70 c . . . . eventuelle, 0 si toutes varient .
71 c . coocst . e . 11 . 1 : coordonnee constante eventuelle .
72 c . . . . 2, 3, 4 : xmin, ymin, zmin .
73 c . . . . 5, 6, 7 : xmax, ymax, zmax .
74 c . . . . 8, 9, 10 : -1 si constant, max-min sinon .
75 c . . . . 11 : max des (max-min) .
76 c . somare . e .2*nbarto. numeros des extremites d'arete .
77 c . hetare . e . nbarto . historique de l'etat des aretes .
78 c . nozone . aux . nbnoto . auxiliaire pour le transfert zone/noeud .
79 c . arsupp . s . nbarto . support pour les aretes .
80 c . arindi . s . nbarto . valeurs entieres pour les aretes .
81 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
82 c . langue . e . 1 . langue des messages .
83 c . . . . 1 : francais, 2 : anglais .
84 c . codret . es . 1 . code de retour des modules .
85 c . . . . 0 : pas de probleme .
86 c . . . . 2 : probleme dans le traitement .
87 c ______________________________________________________________________
90 c 0. declarations et dimensionnement
93 c 0.1. ==> generalites
99 parameter ( nompro = 'DEINZR' )
104 parameter ( nbmcle = 20 )
117 integer somare(2,nbarto), hetare(nbarto)
119 integer nozone(nbnoto)
120 integer arsupp(nbarto), arindi(nbarto)
122 double precision cazord(nbmcle,nbzord)
123 double precision coonoe(nbnoto,sdim)
124 double precision coocst(11)
126 integer ulsort, langue, codret
128 c 0.4. ==> variables locales
131 #ifdef _DEBUG_HOMARD_
134 integer nrzord, tyzord, tyzosg
136 character*8 saux08(nbmcle)
138 double precision daux
139 double precision rext2, rint2
142 logical mccod2(nbmcle)
145 parameter (nbmess = 20 )
146 character*80 texte(nblang,nbmess)
148 character*13 messag(nblang,8)
150 c 0.5. ==> initialisations
152 #ifdef _DEBUG_HOMARD_
153 character*1 saux01(3)
154 data saux01 / 'X', 'Y', 'Z' /
156 c ______________________________________________________________________
164 #ifdef _DEBUG_HOMARD_
165 write (ulsort,texte(langue,1)) 'Entree', nompro
169 texte(1,4) = '(''Nombre de zones a raffiner :'',i8)'
170 texte(1,5) = '(/,7x,''Zone de raffinement numero'',i3)'
171 texte(1,6) = '(/,7x,''Zone de deraffinement numero'',i3)'
172 texte(1,7) = '(10x,''Type de la zone : '',a)'
173 texte(1,8) = '(10x,''Forme de zone inconnue :'',g15.7)'
174 texte(1,9) = '(''Prise en compte du noeud '',i10,3g15.7)'
176 texte(2,4) = '(''Number of zones to refine :'',i8)'
177 texte(2,5) = '(/,7x,''Refinement zone #'',i3)'
178 texte(2,6) = '(/,7x,''Unrefinement zone #'',i3)'
179 texte(2,7) = '(10x,''Type of zone : '',a)'
180 texte(2,8) = '(10x,''Unknown zone shape :'',g15.7)'
181 texte(2,9) = '(''OK for node # '',i10,3g15.7)'
184 messag(1,1) = 'Rectangle '
185 messag(1,2) = 'Parallepipede'
186 messag(1,3) = 'Disque '
187 messag(1,4) = 'Sphere '
188 messag(1,5) = 'Cylindre '
189 messag(1,6) = 'Disque perce '
190 messag(1,7) = 'Tuyau '
192 messag(2,1) = 'Rectangle '
193 messag(2,2) = 'Parallepiped '
194 messag(2,3) = 'Disk '
195 messag(2,4) = 'Sphere '
196 messag(2,5) = 'Cylindre '
197 messag(2,6) = 'Disk '
198 messag(2,7) = 'Pipe '
200 #ifdef _DEBUG_HOMARD_
201 write (ulsort,texte(langue,4)) nbzord
202 write (ulsort,90002) 'nbnoto', nbnoto
203 write (ulsort,90002) 'sdim ', sdim
204 write (ulsort,90002) 'dimcst', dimcst
205 if ( dimcst.ne.0 ) then
206 write (ulsort,90104) saux01(dimcst)//' constant', coocst(dimcst+1)
215 c 2.1. ==> verifications
219 if ( codret.eq.0 ) then
221 do 21 , nrzord = 1 , nbzord
222 if ( cazord(1,nrzord).gt.0.d0 ) then
227 tyzord = nint(abs(cazord(1,nrzord)))
228 if ( tyzord.lt.1 .or. tyzord.gt.7 ) then
229 write (ulsort,texte(langue,5+(1-tyzosg)/2)) nrzord
230 write (ulsort,texte(langue,8)) cazord(1,nrzord)
237 c 2.2. ==> impressions
238 #ifdef _DEBUG_HOMARD_
239 write (ulsort,90002) '2.2. impressions ; codret', codret
242 if ( codret.eq.0 ) then
244 saux08( 2) = 'X min '
245 saux08( 3) = 'X max '
246 saux08( 4) = 'Y min '
247 saux08( 5) = 'Y max '
248 saux08( 6) = 'Z min '
249 saux08( 7) = 'Z max '
250 saux08( 8) = 'Rayon '
251 saux08( 9) = 'X centre'
252 saux08(10) = 'Y centre'
253 saux08(11) = 'Z centre'
254 saux08(12) = 'X axe '
255 saux08(13) = 'Y axe '
256 saux08(14) = 'Z axe '
257 saux08(15) = 'X base '
258 saux08(16) = 'Y base '
259 saux08(17) = 'Z base '
260 saux08(18) = 'Hauteur '
261 saux08(19) = 'Rayon In'
262 saux08(20) = 'Rayon Ex'
264 do 22 , nrzord = 1 , nbzord
266 if ( cazord(1,nrzord).gt.0.d0 ) then
271 tyzord = nint(abs(cazord(1,nrzord)))
272 write (ulsort,texte(langue,5+(1-tyzosg)/2)) nrzord
273 write (ulsort,texte(langue,7)) messag(langue,tyzord)
275 do 221 , iaux = 1 , nbmcle
276 mccod2(iaux) = .false.
279 if ( tyzord.eq.1 ) then
280 do 2211 , iaux = 2 , 5
281 mccod2(iaux) = .true.
283 elseif ( tyzord.eq.2 ) then
284 do 2212 , iaux = 2 , 7
285 mccod2(iaux) = .true.
287 elseif ( tyzord.eq.3 ) then
288 do 2213 , iaux = 8 , 10
289 mccod2(iaux) = .true.
291 elseif ( tyzord.eq.4 ) then
292 do 2214 , iaux = 8 , 11
293 mccod2(iaux) = .true.
295 elseif ( tyzord.eq.5 ) then
297 do 2215 , iaux = 12 , 18
298 mccod2(iaux) = .true.
300 elseif ( tyzord.eq.6 ) then
306 do 2217 , iaux = 12 , 20
307 mccod2(iaux) = .true.
311 do 222 , iaux = 2 , nbmcle
312 if ( mccod2(iaux) ) then
313 write (ulsort,90104) ' '//saux08(iaux),
314 > cazord(iaux,nrzord)
323 c 3. Creation d'un indicateur portant sur les aretes : une arete est a
324 c decouper si et seulement si ses deux extremites sont dans la meme
326 c On parcourt toutes les zones et on marque les noeuds qui sont
327 c a l'interieur de la zone. Puis on note les aretes dont les noeuds
329 c Remarque : cet algorithme de decodage n'est pas hyper performant
330 c si on a plusieurs zones. Mais c'est une maniere simple de gerer
331 c les recouvrements de zones.
332 c Remarque : attention a ne marquer que les aretes actives, comme si
333 c on avait produit un veritable indicateur d'erreur
338 c ....|.............o..|...o........|...
340 c ------A-------------o--B---o--------C-----
343 c ....|.............o..|...o........|...
346 c ------D-------------o--E---o--------F-----
350 c La zone . contient les noeuds A, B et C :
351 c ==> les aretes AB et BC sont a couper
352 c La zone o contient les noeuds B et E :
353 c ==> l'arete BE est a couper
358 c ....|................|............|...
360 c ------A----------------B------------C-----
363 c ....|.............o..|...o........|...
366 c ------D-------------o--E---o--------F-----
370 c La zone . contient les noeuds A, B et C :
371 c ==> les aretes AB et BC sont a couper
372 c La zone o contient le noeud E :
373 c ==> aucune arete n'est a couper
376 #ifdef _DEBUG_HOMARD_
377 write (ulsort,90002) '3. creation indicateur ; codret', codret
380 if ( codret.eq.0 ) then
382 cgn print 1789,0,0.,cazord(2,2),cazord(3,2),cazord(4,2)
384 c 3.1. ==> A priori, on suppose qu'aucune arete n'est concernee
386 do 31 , iaux = 1, nbarto
393 c 3.2. ==> Exploration des differentes zones
394 c Quand la zone a ete declaree 3D mais que l'espace est 2D,
395 c on change de categorie
397 do 32 , nrzord = 1 , nbzord
399 if ( cazord(1,nrzord).gt.0.d0 ) then
404 tyzord = nint(abs(cazord(1,nrzord)))
405 #ifdef _DEBUG_HOMARD_
406 write (ulsort,texte(langue,5+(1-tyzosg)/2)) nrzord
407 write (ulsort,texte(langue,7)) messag(langue,tyzord)
410 c 3.2.0. ==> A priori, aucun noeud n'est concerne
412 do 320 , iaux = 1, nbnoto
416 c 3.2.1. ==> Filtrage sur une boite rectangulaire
418 if ( tyzord.eq.1 ) then
420 do 321 , iaux = 1, nbnoto
422 cgn write(ulsort,90104) 'X',
423 cgn > coonoe(iaux,1), cazord(2,nrzord),cazord(3,nrzord)
424 cgn write(ulsort,90104) 'Y',
425 cgn > coonoe(iaux,2), cazord(4,nrzord),cazord(5,nrzord)
426 cgn write (ulsort,90014)iaux, (coonoe(iaux,jaux),jaux=1,sdim)
428 if ( coonoe(iaux,1).lt.cazord(2,nrzord) ) then
430 elseif ( coonoe(iaux,1).gt.cazord(3,nrzord) ) then
433 if ( afaire .and. sdim.ge.2 ) then
434 if ( coonoe(iaux,2).lt.cazord(4,nrzord) ) then
436 elseif ( coonoe(iaux,2).gt.cazord(5,nrzord) ) then
441 #ifdef _DEBUG_HOMARD_
442 write(ulsort,texte(langue,9)) iaux,
443 > (coonoe(iaux,jaux),jaux=1,sdim)
445 nozone(iaux) = tyzosg
450 c 3.2.2. ==> Filtrage sur une boite parallelepipedique
452 elseif ( tyzord.eq.2 ) then
454 #ifdef _DEBUG_HOMARD_
455 write (ulsort,texte(langue,3)) 'DEINZ0', nompro
457 call deinz0 ( tyzosg,
458 > cazord(2,nrzord), cazord(3,nrzord),
459 > cazord(4,nrzord), cazord(5,nrzord),
460 > cazord(6,nrzord), cazord(7,nrzord),
461 > coonoe, dimcst, coocst,
463 > ulsort, langue, codret )
465 c 3.2.3. ==> Filtrage sur une boite circulaire / circulaire percee
467 elseif ( tyzord.eq.3 .or. tyzord.eq.6 ) then
469 if ( tyzord.eq.3 ) then
471 rext2 = cazord(8,nrzord)*cazord(8,nrzord)
473 rint2 = cazord(19,nrzord)*cazord(19,nrzord)
474 rext2 = cazord(20,nrzord)*cazord(20,nrzord)
476 cgn write (ulsort,90004) 'rext2', rext2
477 cgn write (ulsort,90004) 'rint2', rint2
478 cgn write (ulsort,90004) 'centre', cazord( 9,nrzord),cazord(10,nrzord)
480 do 323 , iaux = 1, nbnoto
482 daux = ( coonoe(iaux,1)-cazord( 9,nrzord) )
483 > * ( coonoe(iaux,1)-cazord( 9,nrzord) )
484 if ( sdim.ge.2 ) then
486 > + ( coonoe(iaux,2)-cazord(10,nrzord) )
487 > * ( coonoe(iaux,2)-cazord(10,nrzord) )
489 cgn write (ulsort,90014)iaux,(coonoe(iaux,jaux),jaux=1,sdim)
491 if ( daux.ge.rint2 .and. daux.le.rext2 ) then
492 #ifdef _DEBUG_HOMARD_
493 write(ulsort,texte(langue,9)) iaux,
494 > (coonoe(iaux,jaux),jaux=1,sdim)
496 nozone(iaux) = tyzosg
501 c 3.2.4. ==> Filtrage sur une boite spherique
503 elseif ( tyzord.eq.4 ) then
505 #ifdef _DEBUG_HOMARD_
506 write (ulsort,texte(langue,3)) 'DEINZ1', nompro
508 call deinz1 ( tyzosg,
510 > cazord(9,nrzord), cazord(10,nrzord),
512 > coonoe, dimcst, coocst,
514 > ulsort, langue, codret )
516 c 3.2.5. ==> Filtrage sur une boite cylindrique/tuyau
518 elseif ( tyzord.eq.5 .or. tyzord.eq.7 ) then
520 if ( tyzord.eq.5 ) then
525 daux = cazord(19,nrzord)
527 #ifdef _DEBUG_HOMARD_
528 write (ulsort,texte(langue,3)) 'DEINZ2', nompro
530 call deinz2 ( tyzosg,
531 > cazord(iaux,nrzord), daux,
533 > cazord(12,nrzord), cazord(13,nrzord),
535 > cazord(15,nrzord), cazord(16,nrzord),
537 > coonoe, dimcst, coocst,
539 > ulsort, langue, codret )
543 c 3.2.9. ==> Transfert aux aretes
545 cgn write(ulsort,4000) (iaux, nozone(iaux) , iaux = 1, nbnoto)
546 do 329 , iaux = 1, nbarto
548 if ( nozone(somare(1,iaux)).eq.tyzosg .and.
549 > nozone(somare(2,iaux)).eq.tyzosg ) then
550 cgn write (ulsort,*) 'arete ',iaux,
551 cgn > ' de ',somare(1,iaux),' a ',somare(2,iaux)
552 if ( mod(hetare(iaux),10).eq.0 ) then
554 arindi(iaux) = tyzosg
559 #ifdef _DEBUG_HOMARD_
560 write (ulsort,90002) 'fin de 32 ; codret', codret
571 cgn write(ulsort,4000) (iaux, arindi(iaux) , iaux = 1, nbarto)
572 cgn 4000 format(5(i4,' :',i2))
573 if ( codret.ne.0 ) then
576 write (ulsort,texte(langue,1)) 'Sortie', nompro
577 write (ulsort,texte(langue,2)) codret
581 #ifdef _DEBUG_HOMARD_
582 write (ulsort,texte(langue,1)) 'Sortie', nompro