1 subroutine decpte ( pilraf, pilder,
8 > ulsort, langue, codret )
10 c ______________________________________________________________________
14 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
16 c Version originale enregistree le 18 juin 1996 sous le numero 96036
17 c aupres des huissiers de justice Simart et Lavoir a Clamart
18 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
19 c aupres des huissiers de justice
20 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
22 c HOMARD est une marque deposee d'Electricite de France
28 c ______________________________________________________________________
30 c traitement des DEcisions - ComPTagE
32 c ______________________________________________________________________
34 c . nom . e/s . taille . description .
35 c .____________________________________________________________________.
36 c . pilraf . e . 1 . pilotage du raffinement .
37 c . . . . -1 : raffinement uniforme .
38 c . . . . 0 : pas de raffinement .
39 c . . . . 1 : raffinement libre .
40 c . . . . 2 : raff. libre homogene en type d'element.
41 c . pilder . e . 1 . pilotage du deraffinement .
42 c . . . . 0 : pas de deraffinement .
43 c . . . . 1 : deraffinement libre .
44 c . . . . -1 : deraffinement uniforme .
45 c . decare . e .0:nbarto. decisions des aretes .
46 c . decfac . e . -nbquto. decision sur les faces (quad. + tri.) .
48 c . hettri . e . nbtrto . historique de l'etat des triangles .
49 c . hetqua . e . nbquto . historique de l'etat des quadrangles .
50 c . tritet . e .nbtecf*4. numeros des 4 triangles des tetraedres .
51 c . hettet . e . nbteto . historique de l'etat des tetraedres .
52 c . quahex . e .nbhecf*6. numeros des 6 quadrangles des hexaedres .
53 c . hethex . e . nbheto . historique de l'etat des hexaedres .
54 c . facpyr . e .nbpycf*5. numeros des 5 faces des pyramides .
55 c . hetpyr . e . nbpyto . historique de l'etat des pyramides .
56 c . facpen . e .nbpecf*5. numeros des faces des pentaedres .
57 c . hetpen . e . nbpeto . historique de l'etat des pentaedres .
58 c . ulsort . e . 1 . unite logique de la sortie generale .
59 c . langue . e . 1 . langue des messages .
60 c . . . . 1 : francais, 2 : anglais .
61 c . codret . s . 1 . code de retour des modules .
62 c . . . . 0 : pas de probleme .
63 c . . . . 1 : probleme .
64 c ______________________________________________________________________
67 c 0. declarations et dimensionnement
70 c 0.1. ==> generalites
76 parameter ( nompro = 'DECPTE' )
96 integer pilraf, pilder
97 integer decare(0:nbarto), decfac(-nbquto:nbtrto)
98 integer hettri(nbtrto)
99 integer hetqua(nbquto)
100 integer hettet(nbteto), tritet(nbtecf,4)
101 integer hethex(nbheto), quahex(nbhecf,6)
102 integer hetpyr(nbpyto), facpyr(nbpycf,5)
103 integer hetpen(nbpeto), facpen(nbpecf,5)
105 integer ulsort, langue, codret
107 c 0.4. ==> variables locales
111 integer narde2, narra2
112 integer ntrde4, ntrra4
113 integer nqude4, nqura4
114 integer ntede8, ntera8
115 integer nhede8, nhera8
116 integer npyder, npyraf
117 integer npeder, nperaf
120 parameter (nbmess = 10 )
121 character*80 texte(nblang,nbmess)
122 c ______________________________________________________________________
130 #ifdef _DEBUG_HOMARD_
131 write (ulsort,texte(langue,1)) 'Entree', nompro
136 > '(/,7x,''Nombre de '',a,'' a decouper en '',i1,'' : '',i10)'
138 > '(/,7x,''Nombre de '',a,'' a reactiver : '',i10)'
140 > '(/,7x,''Nombre de '',a,'' a decouper : '',i10)'
143 > '(/,7x,''Number of '',a,'' to divide into '',i1,'' : '',i10)'
145 > '(/,7x,''Number of '',a,'' to reactivate : '',i10)'
147 > '(/,7x,''Number of '',a,'' to divide : '',i10)'
154 c 2. decompte des entites a decouper et a supprimer et impressions
157 #ifdef _DEBUG_HOMARD_
158 write (ulsort,texte(langue,3)) 'DECPT0', nompro
160 call decpt0 ( decare, decfac,
173 > ulsort, langue, codret )
178 #ifdef _DEBUG_HOMARD_
179 write (ulsort,90002) '3. impressions ; codret', codret
182 c 3.1. ==> raffinement
184 #ifdef _DEBUG_HOMARD_
185 if ( pilraf.ne.-100 ) then
187 if ( pilraf.ne.0 ) then
190 if ( nbteto.ne.0 ) then
191 write(ulsort,texte(langue,4)) mess14(langue,3,3), 8, ntera8
193 if ( nbheto.ne.0 ) then
194 write(ulsort,texte(langue,4)) mess14(langue,3,6), 8, nhera8
196 if ( nbpyto.ne.0 ) then
197 write(ulsort,texte(langue,6)) mess14(langue,3,5), npyraf
199 if ( nbpeto.ne.0 ) then
200 write(ulsort,texte(langue,4)) mess14(langue,3,7), 8, nperaf
202 if ( nbquto.ne.0 ) then
203 write(ulsort,texte(langue,4)) mess14(langue,3,4), 4, nqura4
205 if ( nbtrto.ne.0 ) then
206 write(ulsort,texte(langue,4)) mess14(langue,3,2), 4, ntrra4
208 write(ulsort,texte(langue,4)) mess14(langue,3,1), 2, narra2
212 c 3.2. ==> deraffinement
214 if ( nbiter.gt.0 ) then
216 #ifdef _DEBUG_HOMARD_
217 if ( pilder.ne.-100 ) then
219 if ( pilder.ne.0 ) then
222 if ( nbteto.ne.0 ) then
223 write(ulsort,texte(langue,5)) mess14(langue,3,3), ntede8
225 if ( nbheto.ne.0 ) then
226 write(ulsort,texte(langue,5)) mess14(langue,3,6), nhede8
228 if ( nbpyto.ne.0 ) then
229 write(ulsort,texte(langue,5)) mess14(langue,3,5), npyder
231 if ( nbpeto.ne.0 ) then
232 write(ulsort,texte(langue,5)) mess14(langue,3,7), npeder
234 if ( nbquto.ne.0 ) then
235 write(ulsort,texte(langue,5)) mess14(langue,3,4), nqude4
237 if ( nbtrto.ne.0 ) then
238 write(ulsort,texte(langue,5)) mess14(langue,3,2), ntrde4
240 write(ulsort,texte(langue,5)) mess14(langue,3,1), narde2
252 if ( codret.ne.0 ) then
256 write (ulsort,texte(langue,1)) 'Sortie', nompro
257 write (ulsort,texte(langue,2)) codret
261 #ifdef _DEBUG_HOMARD_
262 write (ulsort,texte(langue,1)) 'Sortie', nompro