1 subroutine deinii ( pilraf, pilder, nivmax, nivmin, iniada,
3 > somare, hetare, filare, merare, np2are,
5 > aretri, hettri, filtri, pertri, nivtri,
6 > arequa, hetqua, filqua, perqua, nivqua,
7 > tritet, hettet, filtet,
8 > quahex, hethex, filhex,
10 > facpen, hetpen, filpen,
11 > nbvpen, nbvpyr, nbvhex, nbvtet,
12 > nbvqua, nbvtri, nbvare, nbvnoe,
21 > ulsort, langue, codret)
22 c ______________________________________________________________________
26 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
28 c Version originale enregistree le 18 juin 1996 sous le numero 96036
29 c aupres des huissiers de justice Simart et Lavoir a Clamart
30 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
31 c aupres des huissiers de justice
32 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
34 c HOMARD est une marque deposee d'Electricite de France
40 c ______________________________________________________________________
42 c traitement des DEcisions - INitialisation de l'indicateur entier
44 c ______________________________________________________________________
46 c but : initialisation des decisions sur les faces et les aretes
47 c dans le cas ou les valeurs de l'indicateur sont entieres
48 c ______________________________________________________________________
50 c . nom . e/s . taille . description .
51 c .____________________________________________________________________.
52 c . pilraf . e . 1 . pilotage du raffinement .
53 c . . . . -1 : raffinement uniforme .
54 c . . . . 0 : pas de raffinement .
55 c . . . . 1 : raffinement libre .
56 c . . . . 2 : raff. libre homogene en type d'element.
57 c . pilder . e . 1 . pilotage du deraffinement .
58 c . . . . -1 : deraffinement uniforme .
59 c . . . . 0 : pas de deraffinement .
60 c . . . . 1 : deraffinement libre .
61 c . nivmax . e . 1 . niveau max a ne pas depasser en raffinement.
62 c . nivmin . e . 1 . niveau min a ne pas depasser en deraffinemt.
63 c . iniada . e . 1 . initialisation de l'adaptation .
64 c . . . . 0 : on garde tout (defaut) .
65 c . . . .-1 : reactivation des mailles ou aucun .
66 c . . . . indicateur n'est defini .
67 c . . . . 1 : raffinement des mailles ou aucun .
68 c . . . . indicateur n'est defini .
69 c . decare . s .0:nbarto. decisions des aretes .
70 c . decfac . s . -nbquto. decision sur les faces (quad. + tri.) .
72 c . somare . e .2*nbarto. numeros des extremites d'arete .
73 c . hetare . e . nbarto . historique de l'etat des aretes .
74 c . filare . e . nbarto . premiere fille des aretes .
75 c . merare . e . nbarto . mere des aretes .
76 c . np2are . e . nbarto . noeud milieux des aretes .
77 c . posifa . e . nbarto . pointeur sur tableau facare .
78 c . facare . e . nbfaar . liste des faces contenant une arete .
79 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
80 c . hettri . e . nbtrto . historique de l'etat des triangles .
81 c . filtri . e . nbtrto . premier fils des triangles .
82 c . pertri . e . nbtrto . pere des triangles .
83 c . nivtri . e . nbtrto . niveau des triangles .
84 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
85 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
86 c . filqua . e . nbquto . premier fils des quadrangles .
87 c . perqua . e . nbquto . pere des quadrangles .
88 c . nivqua . e . nbquto . niveau des quadrangles .
89 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
90 c . hettet . e . nbteto . historique de l'etat des tetraedres .
91 c . filtet . e . nbteto . premier fils des tetraedres .
92 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
93 c . hethex . e . nbheto . historique de l'etat des hexaedres .
94 c . filhex . e . nbheto . premier fils des hexaedres .
95 c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
96 c . hetpyr . e . nbpyto . historique de l'etat des pyramides .
97 c . facpen . e .nbpecf*5. numeros des faces des pentaedres .
98 c . hetpen . e . nbpeto . historique de l'etat des pentaedres .
99 c . filpen . e . nbpeto . premier fils des pentaedres .
100 c . nbvpen . e . 1 . nombre de valeurs par pentaedres .
101 c . nbvpyr . e . 1 . nombre de valeurs par pyramides .
102 c . nbvhex . e . 1 . nombre de valeurs par hexaedres .
103 c . nbvtet . e . 1 . nombre de valeurs par tetraedres .
104 c . nbvqua . e . 1 . nombre de valeurs par quadrangles .
105 c . nbvtri . e . 1 . nombre de valeurs par triangles .
106 c . nbvare . e . 1 . nombre de valeurs par aretes .
107 c . nbvnoe . e . 1 . nombre de valeurs par noeuds .
108 c . nosupp . e . nbnoto . support pour les noeuds .
109 c . noindi . e . nbnoto . valeurs entieres pour les noeuds .
110 c . arsupp . e . nbarto . support pour les aretes .
111 c . arindi . e . nbarto . valeurs entieres pour les aretes .
112 c . trsupp . e . nbtrto . support pour les triangles .
113 c . trindi . e . nbtrto . valeurs entieres pour les triangles .
114 c . qusupp . e . nbquto . support pour les quadrangles .
115 c . quindi . e . nbquto . valeurs entieres pour les quadrangles .
116 c . tesupp . e . nbteto . support pour les tetraedres .
117 c . teindi . e . nbteto . valeurs entieres pour les tetraedres .
118 c . hesupp . e . nbheto . support pour les hexaedres .
119 c . heindi . e . nbheto . valeurs entieres pour les hexaedres .
120 c . pysupp . e . nbpyto . support pour les pyramides .
121 c . pyindi . e . nbpyto . valeurs entieres pour les pyramides .
122 c . pesupp . e . nbpeto . support pour les pentaedres .
123 c . peindi . e . nbpeto . valeurs entieres pour les pentaedres .
124 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
125 c . langue . e . 1 . langue des messages .
126 c . . . . 1 : francais, 2 : anglais .
127 c . codret . es . 1 . code de retour des modules .
128 c . . . . 0 : pas de probleme .
129 c . . . . 2 : probleme dans le traitement .
130 c ______________________________________________________________________
133 c 0. declarations et dimensionnement
136 c 0.1. ==> generalites
142 parameter ( nompro = 'DEINII' )
161 integer pilraf, pilder, nivmax, nivmin, iniada
162 integer decare(0:nbarto), decfac(-nbquto:nbtrto)
163 integer somare(2,nbarto)
164 integer hetare(nbarto), filare(nbarto), merare(nbarto)
165 integer np2are(nbarto)
166 integer posifa(0:nbarto), facare(nbfaar)
167 integer aretri(nbtrto,3), hettri(nbtrto)
168 integer filtri(nbtrto), pertri(nbtrto), nivtri(nbtrto)
169 integer arequa(nbquto,4), hetqua(nbquto)
170 integer filqua(nbquto), perqua(nbquto), nivqua(nbquto)
171 integer tritet(nbtecf,4), hettet(nbteto), filtet(nbteto)
172 integer quahex(nbhecf,6), hethex(nbheto), filhex(nbheto)
173 integer facpyr(nbpycf,5), hetpyr(nbpyto)
174 integer facpen(nbpecf,5), hetpen(nbpeto), filpen(nbpeto)
175 integer nbvpen, nbvpyr, nbvhex, nbvtet
176 integer nbvqua, nbvtri, nbvare, nbvnoe
177 integer nosupp(nbnoto), noindi(nbnoto)
178 integer arsupp(nbarto), arindi(nbarto)
179 integer trsupp(nbtrto), trindi(nbtrto)
180 integer qusupp(nbquto), quindi(nbquto)
181 integer tesupp(nbteto), teindi(nbteto)
182 integer hesupp(nbheto), heindi(nbheto)
183 integer pysupp(nbpyto), pyindi(nbpyto)
184 integer pesupp(nbpeto), peindi(nbpeto)
186 integer ulsort, langue, codret
188 c 0.4. ==> variables locales
194 parameter (nbmess = 10 )
195 character*80 texte(nblang,nbmess)
196 c ______________________________________________________________________
204 #ifdef _DEBUG_HOMARD_
205 write (ulsort,texte(langue,1)) 'Entree', nompro
210 > '(/5x,''Deraffinement des mailles sans indicateur'')'
212 > '(/5x,''Raffinement des mailles sans indicateur'')'
213 texte(1,6) = '(''Apres initialisation brute'')'
214 texte(1,7) = '(''Apres prise en compte des lieux du champ'')'
215 texte(1,8) = '(5x,''Apres prise en compte du deraffinement'')'
216 texte(1,9) = '(5x,''Apres prise en compte du raffinement'')'
219 > '(/5x,''Unrefinement of the meshes without any indicator'')'
221 > '(/5x,''Refinement of the meshes without any indicator'')'
222 texte(2,6) = '(''After brute initialization'')'
223 texte(2,7) = '(''After localization of the field'')'
224 texte(2,8) = '(5x,''After unrefinement indications'')'
225 texte(2,9) = '(5x,''After refinement indications'')'
232 c 2. Initialisations des tableaux de decisions
233 c . Dans l'option 0, les decisions sont initialisees a 0, ce qui
234 c veut dire qu'a priori, rien ne se passe
235 c . Dans l'option -1, les decisions sont initialisees a -1 partout
236 c ou l'indicateur n'est pas defini ; cela force le deraffinement
237 c des regions ou rien n'a ete precise
238 c . Dans l'option 1, les decisions sont initialisees a 2 partout
239 c ou l'indicateur n'est pas defini ; cela force le raffinement
240 c des regions ou rien n'a ete precise
242 #ifdef _DEBUG_HOMARD_
243 write (ulsort,90002) '2. initialisations ; codret', codret
245 #ifdef _DEBUG_HOMARD_
246 write (ulsort,90002) 'nbiter', nbiter
247 write (ulsort,90002) 'iniada', iniada
250 if ( nbiter.gt.0 .and. iniada.ne.0 ) then
252 c 2.0. ==> initialisations au defaut
254 if ( iniada.eq.-1 ) then
256 write (ulsort,texte(langue,4))
258 cgn write(ulsort,*) 'aretes'
259 do 201 , iaux = 1, nbarto
260 if ( mod(hetare(iaux),10).ge.2 ) then
262 cgn write(ulsort,*) iaux
266 cgn write(ulsort,*) 'triangles'
267 do 202 , iaux = 1, nbtrto
268 etat = mod(hettri(iaux),10)
270 > etat.eq.6 .or. etat.eq.7 .or. etat.eq.8 .or.
273 cgn write(ulsort,*) iaux
277 cgn write(ulsort,*) 'quadrangles'
278 do 203 , iaux = 1, nbquto
279 etat = mod(hetqua(iaux),100)
286 elseif ( iniada.eq.1 ) then
288 write (ulsort,texte(langue,5))
290 cgn write(ulsort,*) 'aretes'
291 do 204 , iaux = 1, nbarto
292 if ( mod(hetare(iaux),10).eq.0 ) then
294 cgn write(ulsort,*) iaux
298 cgn write(ulsort,*) 'triangles'
299 do 205 , iaux = 1, nbtrto
300 if ( mod(hettri(iaux),10).eq.0 ) then
302 cgn write(ulsort,*) iaux
306 cgn write(ulsort,*) 'quadrangles'
307 do 206 , iaux = 1, nbquto
308 if ( mod(hetqua(iaux),100).eq.0 ) then
315 #ifdef _DEBUG_HOMARD_
317 if ( codret.eq.0 ) then
319 write (ulsort,texte(langue,6))
321 call decpte ( pilraf, pilder,
323 > hettri, hetqua, tritet, hettet,
327 > ulsort, langue, codret )
333 c 2.1. ==> traitement des indicateurs portant sur les noeuds
335 #ifdef _DEBUG_HOMARD_
336 write (ulsort,90002) '2.1. noeuds ; codret', codret
339 if ( codret.eq.0 ) then
341 if ( nbvnoe.ne.0 ) then
343 #ifdef _DEBUG_HOMARD_
344 write (ulsort,texte(langue,3)) 'DEINOI', nompro
346 call deinoi ( decare, decfac,
348 > np2are, posifa, facare,
350 > ulsort, langue, codret)
356 c 2.2. ==> traitement des indicateurs portant sur les aretes
358 #ifdef _DEBUG_HOMARD_
359 write (ulsort,90002) '2.2. aretes ; codret', codret
362 if ( codret.eq.0 ) then
364 if ( nbvare.ne.0 ) then
366 #ifdef _DEBUG_HOMARD_
367 write (ulsort,texte(langue,3)) 'DEIARI', nompro
369 call deiari ( decare, decfac,
373 > ulsort, langue, codret)
379 c 2.3. ==> traitement des indicateurs portant sur les triangles
381 #ifdef _DEBUG_HOMARD_
382 write (ulsort,90002) '2.3. Triangles ; codret', codret
385 if ( codret.eq.0 ) then
387 if ( nbvtri.ne.0 ) then
389 #ifdef _DEBUG_HOMARD_
390 write (ulsort,texte(langue,3)) 'DEITRI', nompro
392 call deitri ( decare, decfac,
395 > ulsort, langue, codret)
401 c 2.4. ==> traitement des indicateurs portant sur les quadrangles
403 #ifdef _DEBUG_HOMARD_
404 write (ulsort,90002) '2.4. Quadrangles ; codret', codret
407 if ( codret.eq.0 ) then
409 if ( nbvqua.ne.0 ) then
411 #ifdef _DEBUG_HOMARD_
412 write (ulsort,texte(langue,3)) 'DEIQUI', nompro
414 call deiqui ( decare, decfac,
417 > ulsort, langue, codret)
423 c 2.5. ==> traitement des indicateurs portant sur les tetraedres
425 #ifdef _DEBUG_HOMARD_
426 write (ulsort,90002) '2.5. Tetraedres ; codret', codret
429 if ( codret.eq.0 ) then
431 if ( nbvtet.ne.0 ) then
433 #ifdef _DEBUG_HOMARD_
434 write (ulsort,texte(langue,3)) 'DEITEI', nompro
436 call deitei ( decare, decfac,
440 > ulsort, langue, codret)
446 c 2.6. ==> traitement des indicateurs portant sur les hexaedres
448 #ifdef _DEBUG_HOMARD_
449 write (ulsort,90002) '2.6. Hexaedres ; codret', codret
452 if ( codret.eq.0 ) then
454 if ( nbvhex.ne.0 ) then
456 #ifdef _DEBUG_HOMARD_
457 write (ulsort,texte(langue,3)) 'DEIHEI', nompro
459 call deihei ( decare, decfac,
463 > ulsort, langue, codret)
469 c 2.7. ==> traitement des indicateurs portant sur les pyramides
471 #ifdef _DEBUG_HOMARD_
472 write (ulsort,90002) '2.7. Pyramides ; codret', codret
475 if ( codret.eq.0 ) then
477 if ( nbvpyr.ne.0 ) then
479 #ifdef _DEBUG_HOMARD_
480 write (ulsort,texte(langue,3)) 'DEIPYI', nompro
482 call deipyi ( decare, decfac,
487 > ulsort, langue, codret)
493 c 2.8. ==> traitement des indicateurs portant sur les pentaedres
495 #ifdef _DEBUG_HOMARD_
496 write (ulsort,90002) '2.8. pentaedres ; codret', codret
499 if ( codret.eq.0 ) then
501 if ( nbvpen.ne.0 ) then
503 #ifdef _DEBUG_HOMARD_
504 write (ulsort,texte(langue,3)) 'DEIPEI', nompro
506 call deipei ( decare, decfac,
511 > ulsort, langue, codret)
519 if ( codret.eq.0 ) then
521 #ifdef _DEBUG_HOMARD_
522 write (ulsort,texte(langue,7))
528 > hettri, hetqua, tritet, hettet,
532 > ulsort, langue, codret )
539 c 3. traitement du deraffinement
540 c il faut d'abord examiner les decisions de deraffinement exprimees
541 c sur tous les types d'entites. ensuite, on examinera les decisions
542 c de raffinement. ainsi, en cas de conflit, on est certain d'avoir
543 c ecrasement du deraffinement par le raffinement.
545 #ifdef _DEBUG_HOMARD_
546 write (ulsort,90002) '3. deraffinement ; codret', codret
548 #ifdef _DEBUG_HOMARD_
549 write (ulsort,90002) 'nbiter', nbiter
550 write (ulsort,90002) 'pilder', pilder
553 if ( pilder.ne.0 .and. nbiter.ne.0 ) then
555 c 3.1. ==> traitement des indicateurs portant sur les noeuds
557 #ifdef _DEBUG_HOMARD_
558 write (ulsort,90002) '3.1. noeuds ; codret', codret
561 if ( codret.eq.0 ) then
563 if ( nbvnoe.ne.0 ) then
565 #ifdef _DEBUG_HOMARD_
566 write (ulsort,texte(langue,3)) 'DEINOD', nompro
568 call deinod ( nivmin,
570 > somare, hetare, filare,
571 > np2are, posifa, facare,
572 > aretri, hettri, nivtri,
573 > arequa, hetqua, nivqua,
575 > ulsort, langue, codret)
581 c 3.2. ==> traitement des indicateurs portant sur les aretes
583 #ifdef _DEBUG_HOMARD_
584 write (ulsort,90002) '3.2. aretes ; codret', codret
587 if ( codret.eq.0 ) then
589 if ( nbvare.ne.0 ) then
591 #ifdef _DEBUG_HOMARD_
592 write (ulsort,texte(langue,3)) 'DEIARD', nompro
594 call deiard ( nivmin,
598 > aretri, hettri, nivtri,
599 > arequa, hetqua, nivqua,
601 > ulsort, langue, codret)
607 c 3.3. ==> traitement des indicateurs portant sur les triangles
609 #ifdef _DEBUG_HOMARD_
610 write (ulsort,90002) '3.3. Triangles ; codret', codret
613 if ( codret.eq.0 ) then
615 if ( nbvtri.ne.0 ) then
617 #ifdef _DEBUG_HOMARD_
618 write (ulsort,texte(langue,3)) 'DEITRD', nompro
620 call deitrd ( nivmin,
622 > aretri, hettri, filtri, nivtri,
624 > ulsort, langue, codret)
630 c 3.4. ==> traitement des indicateurs portant sur les quadrangles
632 #ifdef _DEBUG_HOMARD_
633 write (ulsort,90002) '3.4. Quadrangles ; codret', codret
636 if ( codret.eq.0 ) then
638 if ( nbvqua.ne.0 ) then
640 #ifdef _DEBUG_HOMARD_
641 write (ulsort,texte(langue,3)) 'DEIQUD', nompro
643 call deiqud ( nivmin,
645 > arequa, hetqua, filqua, nivqua,
647 > ulsort, langue, codret)
653 c 3.5. ==> traitement des indicateurs portant sur les tetraedres
655 #ifdef _DEBUG_HOMARD_
656 write (ulsort,90002) '3.5. Tetraedres ; codret', codret
659 if ( codret.eq.0 ) then
661 if ( nbvtet.ne.0 ) then
663 #ifdef _DEBUG_HOMARD_
664 write (ulsort,texte(langue,3)) 'DEITED', nompro
666 call deited ( nivmin,
669 > tritet, hettet, filtet,
671 > ulsort, langue, codret)
677 c 3.6. ==> traitement des indicateurs portant sur les hexaedres
679 #ifdef _DEBUG_HOMARD_
680 write (ulsort,90002) '3.6. Hexaedres ; codret', codret
683 if ( codret.eq.0 ) then
685 if ( nbvhex.ne.0 ) then
687 #ifdef _DEBUG_HOMARD_
688 write (ulsort,texte(langue,3)) 'DEIHED', nompro
690 call deihed ( nivmin,
693 > quahex, hethex, filhex,
695 > ulsort, langue, codret)
701 c 3.7. ==> traitement des indicateurs portant sur les pyramides
703 #ifdef _DEBUG_HOMARD_
704 write (ulsort,90002) '3.7. Pyramides ; codret', codret
707 if ( codret.eq.0 ) then
709 if ( nbvpyr.ne.0 ) then
711 #ifdef _DEBUG_HOMARD_
712 write (ulsort,texte(langue,3)) 'DEIPYD', nompro
714 call deipyd ( nivmin,
716 > ulsort, langue, codret)
722 c 3.8. ==> traitement des indicateurs portant sur les pentaedres
724 #ifdef _DEBUG_HOMARD_
725 write (ulsort,90002) '3.8. pentaedres ; codret', codret
728 if ( codret.eq.0 ) then
730 if ( nbvpen.ne.0 ) then
732 #ifdef _DEBUG_HOMARD_
733 write (ulsort,texte(langue,3)) 'DEIPED', nompro
735 call deiped ( nivmin,
739 > facpen, hetpen, filpen,
741 > ulsort, langue, codret)
748 if ( codret.eq.0 ) then
750 write (ulsort,texte(langue,8))
755 > hettri, hetqua, tritet, hettet,
759 > ulsort, langue, codret )
766 c 4. traitement du raffinement
768 #ifdef _DEBUG_HOMARD_
769 write (ulsort,90002) '4. raffinement ; codret', codret
771 #ifdef _DEBUG_HOMARD_
772 write (ulsort,90002) 'pilraf', pilraf
775 if ( pilraf.ne.0 ) then
777 c 4.1. ==> traitement des indicateurs portant sur les noeuds
779 #ifdef _DEBUG_HOMARD_
780 write (ulsort,90002) '4.1. noeuds ; codret', codret
783 if ( codret.eq.0 ) then
785 if ( nbvnoe.ne.0 ) then
787 #ifdef _DEBUG_HOMARD_
788 write (ulsort,texte(langue,3)) 'DEINOR', nompro
790 call deinor ( nivmax,
793 > np2are, posifa, facare,
797 > ulsort, langue, codret)
803 c 4.2. ==> traitement des indicateurs portant sur les aretes
805 #ifdef _DEBUG_HOMARD_
806 write (ulsort,90002) '4.2. aretes ; codret', codret
809 if ( codret.eq.0 ) then
811 if ( nbvare.ne.0 ) then
813 #ifdef _DEBUG_HOMARD_
814 write (ulsort,texte(langue,3)) 'DEIARR', nompro
816 call deiarr ( nivmax,
823 > ulsort, langue, codret)
829 c 4.3. ==> traitement des indicateurs portant sur les triangles
831 #ifdef _DEBUG_HOMARD_
832 write (ulsort,90002) '4.3. Triangles ; codret', codret
835 if ( codret.eq.0 ) then
837 if ( nbvtri.ne.0 ) then
839 #ifdef _DEBUG_HOMARD_
840 write (ulsort,texte(langue,3)) 'DEITRR', nompro
842 call deitrr ( nivmax,
845 > aretri, hettri, nivtri,
847 > ulsort, langue, codret)
853 c 4.4. ==> traitement des indicateurs portant sur les quadrangles
855 #ifdef _DEBUG_HOMARD_
856 write (ulsort,90002) '4.4. Quadrangles ; codret', codret
859 if ( codret.eq.0 ) then
861 if ( nbvqua.ne.0 ) then
863 #ifdef _DEBUG_HOMARD_
864 write (ulsort,texte(langue,3)) 'DEIQUR', nompro
866 call deiqur ( nivmax,
869 > arequa, hetqua, nivqua,
871 > ulsort, langue, codret)
877 c 4.5. ==> traitement des indicateurs portant sur les tetraedres
879 #ifdef _DEBUG_HOMARD_
880 write (ulsort,90002) '4.5. Tetraedres ; codret', codret
883 if ( codret.eq.0 ) then
885 if ( nbvtet.ne.0 ) then
887 #ifdef _DEBUG_HOMARD_
888 write (ulsort,texte(langue,3)) 'DEITER', nompro
890 call deiter ( nivmax,
893 > aretri, hettri, nivtri,
896 > ulsort, langue, codret)
902 c 4.6. ==> traitement des indicateurs portant sur les hexaedres
904 #ifdef _DEBUG_HOMARD_
905 write (ulsort,90002) '4.6. Hexaedres ; codret', codret
908 if ( codret.eq.0 ) then
910 if ( nbvhex.ne.0 ) then
912 #ifdef _DEBUG_HOMARD_
913 write (ulsort,texte(langue,3)) 'DEIHER', nompro
915 call deiher ( nivmax,
918 > arequa, hetqua, nivqua,
921 > ulsort, langue, codret)
927 c 4.7. ==> traitement des indicateurs portant sur les pyramides
929 #ifdef _DEBUG_HOMARD_
930 write (ulsort,90002) '4.7. Pyramides ; codret', codret
933 if ( codret.eq.0 ) then
935 if ( nbvpyr.ne.0 ) then
937 #ifdef _DEBUG_HOMARD_
938 write (ulsort,texte(langue,3)) 'DEIPYR', nompro
940 call deipyr ( nivmax,
943 > aretri, hettri, nivtri,
947 > ulsort, langue, codret)
953 c 4.8. ==> traitement des indicateurs portant sur les pentaedres
955 #ifdef _DEBUG_HOMARD_
956 write (ulsort,90002) '4.8. pentaedres ; codret', codret
959 if ( codret.eq.0 ) then
961 if ( nbvpen.ne.0 ) then
963 #ifdef _DEBUG_HOMARD_
964 write (ulsort,texte(langue,3)) 'DEIPER', nompro
966 call deiper ( nivmax,
969 > aretri, hettri, nivtri,
973 > ulsort, langue, codret)
979 if ( codret.eq.0 ) then
981 write (ulsort,texte(langue,9))
986 > hettri, hetqua, tritet, hettet,
990 > ulsort, langue, codret )
996 #ifdef _DEBUG_HOMARD_
997 cgn write (ulsort,*) 'en sortie de ', nompro
998 cgn do 1105 , iaux = 1 , nbquto
999 cgn write (ulsort,90001) 'decision quadrangle', iaux,decfac(-iaux)
1000 cgn write (ulsort,90001) 'quadrangle', iaux,
1001 cgn > arequa(iaux,1), arequa(iaux,2),
1002 cgn > arequa(iaux,3), arequa(iaux,4)
1006 cgn write (ulsort,90002) 'quadrangle ', iaux
1007 cgn write (ulsort,*) 'decfac(',iaux,') =',decfac(-iaux)
1008 cgn write (ulsort,*) arequa(iaux,1),arequa(iaux,2),
1009 cgn >arequa(iaux,3),arequa(iaux,4)
1010 cgn write (ulsort,*) decare(arequa(iaux,1)),decare(arequa(iaux,2)),
1011 cgn >decare(arequa(iaux,3)),decare(arequa(iaux,4))
1012 cgn write (ulsort,*) hetare(arequa(iaux,1)),hetare(arequa(iaux,2)),
1013 cgn >hetare(arequa(iaux,3)),hetare(arequa(iaux,4))
1014 cgn write (ulsort,*) ' '
1015 cgn print 1789,(iaux, decfac(iaux),iaux = 0, nbtrto)
1016 cgn print 1789,(iaux, decfac(iaux),iaux = -nbquto,0)
1017 cgn print 1789,(iaux, decare(iaux),iaux = 1, nbarto)
1019 cgn write (ulsort,*) 'decision triangle'
1020 cgn write (ulsort,91030) (decfac(iaux),iaux= 1 , nbtrto)
1021 cgn write (ulsort,*) 'decision quadrangle'
1022 cgn write (ulsort,91030) (decfac(-iaux),iaux= 1 , nbquto)
1028 if ( codret.ne.0 ) then
1032 write (ulsort,texte(langue,1)) 'Sortie', nompro
1033 write (ulsort,texte(langue,2)) codret
1037 #ifdef _DEBUG_HOMARD_
1038 write (ulsort,texte(langue,1)) 'Sortie', nompro