1 subroutine utal02 ( typenh, option,
2 > nhenti, nbento, nbenca,
3 > adhist, adcode, adfill, admere,
5 > adnivo, adinsu, adins2,
6 > adnoim, adhomo, adcoar,
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 UTilitaire - ALlocations - phase 02
30 c ______________________________________________________________________
31 c Allocations des tableaux pour une entite HOM_Enti
32 c Remarque : le code de retour en entree ne doit pas etre ecrase
33 c brutalement ; il doit etre cumule avec les operations
35 c Remarque : utal02, utad02, utad06, utad08 et utad22 sont similaires
36 c ______________________________________________________________________
38 c . nom . e/s . taille . description .
39 c .____________________________________________________________________.
40 c . typenh . e . 1 . code des entites au sens homard .
41 c . . . . -1 : noeuds .
42 c . . . . 0 : mailles-points .
43 c . . . . 1 : segments .
44 c . . . . 2 : triangles .
45 c . . . . 3 : tetraedres .
46 c . . . . 4 : quadrangles .
47 c . . . . 5 : pyramides .
48 c . . . . 6 : hexaedres .
49 c . . . . 7 : pentaedres .
50 c . option . e . 1 . option de pilotage des allocations a faire .
51 c . . . . c'est un multiple des entiers suivants : .
52 c . . . . 2 : historique, connectivite descendante .
58 c . . . . 17 : isup2 .
59 c . . . . 19 : noeud interne a la maille .
60 c . . . . 29 : homologue .
61 c . nhenti . e . char8 . nom de l'objet decrivant l'entite .
62 c . nbento . e . 1 . nombre d'entites .
63 c . nbenca . e . 1 . nombre d'entites en connectivite par arete .
64 c . adhist . s . 1 . historique de l'etat .
65 c . adcode . s . 1 . connectivite descendante .
66 c . adfill . s . 1 . fille des entites .
67 c . admere . s . 1 . mere des entites .
68 c . adfami . s . 1 . famille des entites .
69 c . adcofa . s . 1 . code des familles des entites .
70 c . adnivo . s . 1 . niveau des entites .
71 c . adinsu . s . 1 . informations supplementaires .
72 c . adins2 . s . 1 . informations supplementaires numero 2 .
73 c . adnoim . s . 1 . noeud interne a la maille .
74 c . adhomo . s . 1 . homologue .
75 c . adcoar . s . 1 . connectivite par arete .
76 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
77 c . langue . e . 1 . langue des messages .
78 c . . . . 1 : francais, 2 : anglais .
79 c . codret . es . 1 . code de retour des modules .
80 c ______________________________________________________________________
83 c 0. declarations et dimensionnement
86 c 0.1. ==> generalites
92 parameter ( nompro = 'UTAL02' )
106 integer typenh, option
107 integer nbento, nbenca
108 integer adhist, adcode, adfill, admere
109 integer adfami, adcofa
117 integer ulsort, langue, codret
119 c 0.4. ==> variables locales
124 integer codre1, codre2
128 parameter ( nbmess = 10 )
129 character*80 texte(nblang,nbmess)
131 c 0.5. ==> initialisations
132 c ______________________________________________________________________
140 #ifdef _DEBUG_HOMARD_
141 write (ulsort,texte(langue,1)) 'Entree', nompro
145 texte(1,4) = '(''Allocations pour les '',a)'
146 texte(1,6) = '(''Structure : '',a)'
147 texte(1,8) = '(''Codes de retour'',20i3)'
149 texte(2,4) = '(''Allocations for '',a)'
150 texte(2,6) = '(''Structure: '',a)'
151 texte(2,8) = '(''Error codes'',20i3)'
155 #ifdef _DEBUG_HOMARD_
156 write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
157 write (ulsort,90002) 'option', option
158 write (ulsort,90002) 'nbento', nbento
159 write (ulsort,90002) 'nbenca', nbenca
160 cgn call gmprsx(nompro,nhenti)
161 cgn call gmprsx(nompro,nhenti//'.Famille')
165 do 10 , iaux = 0 , 12
187 c 2. Allocation et recuperation des adresses
190 if ( option.gt.0 ) then
192 c 2.1. ==> Historique des etats et connectivite descendante
194 if ( mod(option,2).eq.0 ) then
196 if ( codret.eq.0 ) then
198 call gmaloj ( nhenti//'.HistEtat', ' ', nbento, adhist, codre1 )
199 if ( codre1.ne.0 ) then
204 if ( typenh.eq.0 ) then
206 elseif ( typenh.eq.1 ) then
208 elseif ( typenh.eq.2 ) then
210 elseif ( typenh.eq.3 ) then
212 elseif ( typenh.eq.4 ) then
214 elseif ( typenh.eq.5 ) then
216 elseif ( typenh.eq.6 ) then
218 elseif ( typenh.eq.7 ) then
227 if ( codret.eq.0 ) then
229 iaux = (nbento-nbenca)*jaux
230 call gmaloj ( nhenti//'.ConnDesc', ' ', iaux, adcode, codre2 )
232 if ( codre2.ne.0 ) then
243 if ( mod(option,3).eq.0 ) then
245 if ( codret.eq.0 ) then
247 call gmaloj ( nhenti//'.Fille', ' ', nbento, adfill, codre0 )
249 if ( codre0.ne.0 ) then
260 if ( mod(option,5).eq.0 ) then
262 if ( codret.eq.0 ) then
264 call gmaloj ( nhenti//'.Mere', ' ', nbento, admere, codre0 )
266 if ( codre0.ne.0 ) then
275 c 2.4. ==> Les familles
277 if ( mod(option,7).eq.0 ) then
279 if ( codret.eq.0 ) then
281 call gmaloj ( nhenti//'.Famille.EntiFamm', ' ',
282 > nbento, adfami, codre0 )
284 if ( codre0.ne.0 ) then
295 if ( mod(option,11).eq.0 ) then
297 if ( codret.eq.0 ) then
299 call gmaloj ( nhenti//'.Niveau', ' ', nbento, adnivo, codre0 )
301 if ( codre0.ne.0 ) then
310 c 2.6. ==> Les informations supplementaires
312 if ( mod(option,13).eq.0 ) then
314 if ( codret.eq.0 ) then
316 if ( typenh.eq.3 ) then
317 iaux = (nbento-nbenca)*4
318 elseif ( typenh.eq.5 ) then
319 iaux = (nbento-nbenca)*5
320 elseif ( typenh.eq.6 ) then
321 iaux = (nbento-nbenca)*6
322 elseif ( typenh.eq.7 ) then
323 iaux = (nbento-nbenca)*5
327 call gmaloj ( nhenti//'.InfoSupp', ' ', iaux, adinsu, codre0 )
329 if ( codre0.ne.0 ) then
338 c 2.7. ==> Les informations supplementaires numero 2
340 if ( mod(option,17).eq.0 ) then
342 if ( codret.eq.0 ) then
344 call gmaloj ( nhenti//'.InfoSup2', ' ', nbento, adins2, codre0 )
346 if ( codre0.ne.0 ) then
355 c 2.8. ==> Le noeud supplementaire
357 if ( mod(option,19).eq.0 ) then
359 if ( codret.eq.0 ) then
361 call gmaloj ( nhenti//'.NoeuInMa', ' ', nbento, adnoim, codre0 )
363 if ( codre0.ne.0 ) then
372 c 2.9. ==> Les homologues
374 if ( mod(option,29).eq.0 ) then
376 if ( codret.eq.0 ) then
378 call gmaloj ( nhenti//'.Homologu', ' ', nbento, adhomo, codre0 )
380 if ( codre0.ne.0 ) then
389 c 2.10. ==> La connectivite par aretes
391 if ( mod(option,31).eq.0 ) then
393 if ( codret.eq.0 ) then
395 if ( typenh.eq.3 ) then
397 elseif ( typenh.eq.5 ) then
399 elseif ( typenh.eq.6 ) then
401 elseif ( typenh.eq.7 ) then
406 call gmaloj ( nhenti//'.ConnAret', ' ', iaux, adcoar, codre0 )
408 if ( codre0.ne.0 ) then
423 if ( codret.eq.0 ) then
425 call gmecat ( nhenti, 1, nbento, codre1 )
426 call gmecat ( nhenti, 2, nbenca, codre2 )
428 codre0 = min ( codre1, codre2 )
429 codret = max ( abs(codre0), codret,
432 if ( codret.ne.0 ) then
443 if ( codret.ne.0 ) then
447 write (ulsort,texte(langue,1)) 'Sortie', nompro
448 write (ulsort,texte(langue,2)) codret
449 write (ulsort,texte(langue,4)) mess14(langue,3,typenh)
450 write (ulsort,90002) 'option', option
451 write (ulsort,texte(langue,6)) nhenti
452 write (ulsort,texte(langue,8)) tabcod
460 #ifdef _DEBUG_HOMARD_
461 write (ulsort,texte(langue,1)) 'Sortie', nompro