1 subroutine utb13d ( coonoe,
5 > grfmpo, grfmtl, grfmtb,
6 > nbgrfm, nomgro, lgnogr,
10 > ulsort, langue, codret )
11 c ______________________________________________________________________
15 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
17 c Version originale enregistree le 18 juin 1996 sous le numero 96036
18 c aupres des huissiers de justice Simart et Lavoir a Clamart
19 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
20 c aupres des huissiers de justice
21 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
23 c HOMARD est une marque deposee d'Electricite de France
29 c ______________________________________________________________________
31 c UTilitaire - Bilan sur le maillage - option 13 - phase d
33 c ______________________________________________________________________
35 c longueurs des sous-domaines du maillage de calcul
36 c ______________________________________________________________________
38 c . nom . e/s . taille . description .
39 c .____________________________________________________________________.
40 c . coonoe . e . nbnoto . coordonnees des noeuds .
42 c . somare . e .2*nbarto. numeros des extremites d'arete .
43 c . hetare . e . nbarto . historique de l'etat des aretes .
44 c . famare . e . nbarto . famille des aretes .
45 c . cfaare . e . nctfar*. codes des familles des aretes .
46 c . . . nbfare . 1 : famille MED .
47 c . . . . 2 : type de segment .
48 c . . . . 3 : orientation .
49 c . . . . 4 : famille d'orientation inverse .
50 c . . . . 5 : numero de ligne de frontiere .
51 c . . . . > 0 si concernee par le suivi de frontiere.
52 c . . . . <= 0 si non concernee .
53 c . . . . 6 : famille frontiere active/inactive .
54 c . . . . 7 : numero de surface de frontiere .
55 c . . . . + l : appartenance a l'equivalence l .
56 c . famtri . e . nbtrto . famille des triangles .
57 c . nbfmed . e . 1 . nombre de familles au sens MED .
58 c . numfam . e . nbfmed . numero des familles au sens MED .
59 c . grfmpo . e .0:nbfmed. pointeur des groupes des familles .
60 c . grfmtl . e . * . taille des groupes des familles .
61 c . grfmtb . e .10ngrouc. table des groupes des familles .
62 c . nbgrfm . e . 1 . nombre de groupes .
63 c . nomgro . e .char*(*). noms des groupes (paquets de 10char8) .
64 c . lgnogr . e . nbgrfm . longueur des noms des groupes .
65 c . famnum . a . * . famille : numero avec une valeur .
66 c . famval . a . * . famille : la valeur .
67 c . lifagr . a . * . liste des familles contenant le groupe .
68 c . ulbila . e . 1 . unite logique d'ecriture du bilan .
69 c . ulsort . e . 1 . unite logique de la sortie generale .
70 c . langue . e . 1 . langue des messages .
71 c . . . . 1 : francais, 2 : anglais .
72 c . codret . s . 1 . code de retour des modules .
73 c . . . . 0 : pas de probleme .
74 c . . . . 1 : probleme .
75 c .____________________________________________________________________.
78 c 0. declarations et dimensionnement
81 c 0.1. ==> generalites
87 parameter ( nompro = 'UTB13D' )
104 double precision coonoe(nbnoto,sdim)
106 integer somare(2,nbarto), hetare(nbarto)
108 integer famare(nbarto), cfaare(nctfar,nbfare)
110 integer nbfmed, numfam(nbfmed)
111 integer grfmpo(0:nbfmed)
113 integer nbgrfm, lgnogr(nbgrfm)
115 character*8 grfmtb(*)
116 character*8 nomgro(*)
119 double precision famval(*)
124 integer ulsort, langue, codret
126 c 0.4. ==> variables locales
128 integer iaux, jaux, kaux
133 double precision daux
136 parameter (nbmess = 20 )
137 character*80 texte(nblang,nbmess)
139 c 0.5. ==> initialisations
140 c ______________________________________________________________________
148 #ifdef _DEBUG_HOMARD_
149 write (ulsort,texte(langue,1)) 'Entree', nompro
153 texte(1,4) = '(''Nombre de '',a,'' actifs : '',i8)'
154 texte(1,5) = '(''. Examen du '',a,i8)'
155 texte(1,6) = '(''... Longueur du '',a,i8,'' :'',g14.6)'
156 texte(1,7) = '(''..... Stockage'',i8,'' pour la famille '',i8)'
158 texte(2,4) = '(''Number of active '',a,'' : '',i8)'
159 texte(2,5) = '(''. Examination of '',a,''#'',i8)'
160 texte(2,6) = '(''... Length of '',a,''#'',i8,'' :'',g14.6)'
161 texte(2,7) = '(''..... Save'',i8,'' for familiy # '',i8)'
165 #ifdef _DEBUG_HOMARD_
166 write (ulsort,texte(langue,4)) mess14(langue,3,1), nbarac
172 c 2. calcul des longueurs des aretes
175 c 2.1. ==> initialisation
179 if ( nbarac.gt.0 ) then
181 do 21 , iaux = 1 , nbarac
186 do 22 , larete = 1, nbarto
188 #ifdef _DEBUG_HOMARD_
189 write (ulsort,texte(langue,5)) mess14(langue,1,1), larete
192 if ( cfaare(cotyel,famare(larete)).ne.0 ) then
194 etat = mod( hetare(larete) , 10 )
196 if ( etat.eq.0 ) then
198 c 2.2.1. ==> longueur de l'arete courante
200 #ifdef _DEBUG_HOMARD_
201 write (ulsort,texte(langue,3)) 'UTLGAR', nompro
203 call utlgar ( larete, coonoe, somare,
205 > ulsort, langue, codret )
207 #ifdef _DEBUG_HOMARD_
208 write (ulsort,texte(langue,6)) mess14(langue,1,1), larete, daux
211 c 4.2.2. ==> stockage dans la bonne famille
214 do 222 , iaux = 1 , famnbv
215 if ( famnum(iaux).eq.cfaare(cofamd,famare(larete)) ) then
222 famnum(jaux) = cfaare(cofamd,famare(larete))
223 #ifdef _DEBUG_HOMARD_
224 write (ulsort,texte(langue,7)) jaux, famnum(jaux)
229 famval(jaux) = famval(jaux) + daux
242 #ifdef _DEBUG_HOMARD_
243 write (ulsort,*) '3. impression ; codret =', codret
244 write (ulsort,90002) 'famnbv', famnbv
247 if ( famnbv.ne.0 ) then
251 #ifdef _DEBUG_HOMARD_
252 write (ulsort,texte(langue,3)) 'UTB13E_are', nompro
254 call utb13e ( kaux, iaux,
256 > grfmpo, grfmtl, grfmtb,
257 > nbgrfm, nomgro, lgnogr,
258 > famnbv, famnum, famval,
261 > ulsort, langue, codret )