1 subroutine utal00 ( option, optimp,
2 > nomail, ndecar, ndecfa,
3 > indnoe, indnp2, indnim, indare,
5 > indtet, indhex, indpen,
15 > ulsort, langue, codret )
16 c ______________________________________________________________________
20 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
22 c Version originale enregistree le 18 juin 1996 sous le numero 96036
23 c aupres des huissiers de justice Simart et Lavoir a Clamart
24 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
25 c aupres des huissiers de justice
26 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
28 c HOMARD est une marque deposee d'Electricite de France
34 c ______________________________________________________________________
36 c UTilitaire : ALlocations - 00
38 c ______________________________________________________________________
40 c . nom . e/s . taille . description .
41 c .____________________________________________________________________.
42 c . option . e . 1 . type de traitement .
43 c . . . . 0 : raffinement .
44 c . . . . 1 : deraffinement .
45 c . . . . 2 : conformite .
46 c . optimp . e . 1 . impressions 0:non, 1:oui .
47 c . nomail . e . ch8 . nom de l'objet contenant le maillage .
48 c . ndecar . e . ch8 . nom de l'objet des decisions sur les aretes.
49 c . ndecfa . e . ch8 . nom de l'objet des decisions sur les faces .
50 c . indnoe . es . 1 . indice du dernier noeud cree .
51 c . indnp2 . es . 1 . nombre de noeuds p2 en vigueur .
52 c . indnim . es . 1 . nombre de noeuds internes en vigueur .
53 c . indare . es . 1 . indice de la derniere arete creee .
54 c . indtri . es . 1 . indice du dernier triangle cree .
55 c . indqua . es . 1 . indice du dernier quadrangle cree .
56 c . indtet . es . 1 . indice du dernier tetraedre cree .
57 c . indhex . es . 1 . indice du dernier hexaedre cree .
58 c . indpen . es . 1 . indice du dernier pentaedre cree .
59 c . nbsoan . s . 1 . nombre de sommets - ancien .
60 c . nbsono . s . 1 . nombre de sommets - nouveau .
61 c . nbnoan . e . 1 . nombre de noeuds - ancien .
62 c . nbnono . e . 1 . nombre de noeuds - nouveau .
63 c . nbaran . e . 1 . nombre d'aretes - ancien .
64 c . nbarno . e . 1 . nombre d'aretes - nouveau .
65 c . nbtran . e . 1 . nombre de triangles - ancien .
66 c . nbtrno . e . 1 . nombre de triangles - nouveau .
67 c . nbquan . e . 1 . nombre de quadrangles - ancien .
68 c . nbquno . e . 1 . nombre de quadrangles - nouveau .
69 c . nbtean . e . 1 . nombre de tetraedres - ancien .
70 c . nbteno . e . 1 . nombre de tetraedres - nouveau .
71 c . nbhean . e . 1 . nombre d'hexaedres - ancien .
72 c . nbheno . e . 1 . nombre d'hexaedres - nouveau .
73 c . nbpean . e . 1 . nombre de pentaedres - ancien .
74 c . nbpeno . e . 1 . nombre de pentaedres - nouveau .
75 c . nbpyan . e . 1 . nombre de pyramides - ancien .
76 c . nbpyno . e . 1 . nombre de pyramides - nouveau .
77 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
78 c . langue . e . 1 . langue des messages .
79 c . . . . 1 : francais, 2 : anglais .
80 c . codret . e/s . 1 . code de retour des modules .
81 c . . . . 0 : pas de probleme .
82 c ______________________________________________________________________
85 c 0. declarations et dimensionnement
88 c 0.1. ==> generalites
94 parameter ( nompro = 'UTAL00' )
110 character*8 ndecar, ndecfa
112 integer indnoe, indnp2, indnim, indare, indtri, indqua
113 integer indtet, indhex, indpen
114 integer nbsoan, nbsono
115 integer nbnoan, nbnono
116 integer nbaran, nbarno
117 integer nbtran, nbtrno
118 integer nbquan, nbquno
119 integer nbtean, nbteno
120 integer nbhean, nbheno
121 integer nbpean, nbpeno
122 integer nbpyan, nbpyno
124 integer ulsort, langue, codret
126 c 0.4. ==> variables locales
131 integer codre1, codre2, codre3
132 integer pdecfa, pdecar
133 integer phettr, paretr
134 integer phetqu, parequ
135 integer phette, ptrite
136 integer phethe, pquahe
137 integer phetpe, pfacpe
138 cgn integer phetpy, pfacpy
141 character*8 nhnoeu, nhmapo, nharet, nhtria, nhquad
142 character*8 nhtetr, nhhexa, nhpyra, nhpent
144 character*8 nhvois, nhsupe, nhsups
147 parameter ( nbmess = 10 )
148 character*80 texte(nblang,nbmess)
150 c 0.5. ==> initialisations
151 c ______________________________________________________________________
159 #ifdef _DEBUG_HOMARD_
160 write (ulsort,texte(langue,1)) 'Entree', nompro
166 #ifdef _DEBUG_HOMARD_
167 write (ulsort,90002) 'option', option
171 c 2. recuperation des pointeurs
174 if ( codret.eq.0 ) then
176 #ifdef _DEBUG_HOMARD_
177 write (ulsort,texte(langue,3)) 'UTNOMH', nompro
180 call utnomh ( nomail,
182 > degre, maconf, homolo, hierar,
183 > rafdef, nbmane, typcca, typsfr, maextr,
186 > nhnoeu, nhmapo, nharet,
188 > nhtetr, nhhexa, nhpyra, nhpent,
190 > nhvois, nhsupe, nhsups,
191 > ulsort, langue, codret)
196 c 3. recuperation des adresses
198 #ifdef _DEBUG_HOMARD_
199 write (ulsort,90002) '3. recuperation ; codret', codret
202 if ( option.eq.0 ) then
204 c 3.1. ==> Quelques nombres
206 if ( codret.eq.0 ) then
208 call gmliat ( nhtetr, 1, nbtean, codre1 )
209 call gmliat ( nhhexa, 1, nbhean, codre2 )
210 call gmliat ( nhpent, 1, nbpean, codre3 )
212 codre0 = min ( codre1, codre2, codre3 )
213 codret = max ( abs(codre0), codret,
214 > codre1, codre2, codre3 )
216 #ifdef _DEBUG_HOMARD_
217 write (ulsort,90002) 'nbtean', nbtean
218 write (ulsort,90002) 'nbhean', nbhean
219 write (ulsort,90002) 'nbpean', nbpean
226 if ( codret.eq.0 ) then
228 if ( nbtean.ne.0 .or. nbpean.ne.0 ) then
230 #ifdef _DEBUG_HOMARD_
231 write (ulsort,texte(langue,3)) 'UTAD02_tr', nompro
234 call utad02 ( iaux, nhtria,
235 > phettr, paretr, jaux, jaux,
239 > ulsort, langue, codret )
243 if ( nbhean.ne.0 .or. nbpean.ne.0 ) then
245 #ifdef _DEBUG_HOMARD_
246 write (ulsort,texte(langue,3)) 'UTAD02_qu', nompro
249 call utad02 ( iaux, nhquad,
250 > phetqu, parequ, jaux, jaux,
254 > ulsort, langue, codret )
258 if ( nbtean.ne.0 ) then
260 #ifdef _DEBUG_HOMARD_
261 write (ulsort,texte(langue,3)) 'UTAD02_te', nompro
264 call utad02 ( iaux, nhtetr,
265 > phette, ptrite, jaux, jaux,
269 > ulsort, langue, codret )
273 if ( nbhean.ne.0 ) then
275 #ifdef _DEBUG_HOMARD_
276 write (ulsort,texte(langue,3)) 'UTAD02_he', nompro
279 call utad02 ( iaux, nhhexa,
280 > phethe, pquahe, jaux, jaux,
284 > ulsort, langue, codret )
288 if ( nbpean.ne.0 ) then
290 #ifdef _DEBUG_HOMARD_
291 write (ulsort,texte(langue,3)) 'UTAD02_pe', nompro
294 call utad02 ( iaux, nhpent,
295 > phetpe, pfacpe, jaux, jaux,
299 > ulsort, langue, codret )
307 if ( codret.eq.0 ) then
309 call gmadoj ( ndecar, pdecar, iaux, codre1 )
310 call gmadoj ( ndecfa, pdecfa, iaux, codre2 )
312 codre0 = min ( codre1, codre2 )
313 codret = max ( abs(codre0), codret,
320 write (ulsort,*) 'Arret dans ', nompro
326 c 4. decompte des nouvelles entites a creer
328 #ifdef _DEBUG_HOMARD_
329 write (ulsort,90002) '4. decompte ; codret', codret
332 if ( option.eq.0 ) then
334 if ( codret.eq.0 ) then
336 #ifdef _DEBUG_HOMARD_
337 write (ulsort,texte(langue,3)) 'UTPLRA', nompro
340 call utplra ( optimp,
341 > indnoe, indnp2, indnim, indare,
342 > indtri, indqua, indtet, indhex, indpen,
343 > imem(pdecar), imem(pdecfa),
346 > imem(ptrite), imem(phette),
347 > imem(pquahe), imem(phethe),
348 > imem(pfacpe), imem(phetpe),
358 > ulsort, langue, codret )
368 if ( codret.ne.0 ) then
372 write (ulsort,texte(langue,1)) 'Sortie', nompro
373 write (ulsort,texte(langue,2)) codret
377 #ifdef _DEBUG_HOMARD_
378 write (ulsort,texte(langue,1)) 'Sortie', nompro