1 subroutine utmffa ( nomail,
2 > ulsort, langue, codret)
3 c ______________________________________________________________________
7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
10 c aupres des huissiers de justice Simart et Lavoir a Clamart
11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
12 c aupres des huissiers de justice
13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
15 c HOMARD est une marque deposee d'Electricite de France
21 c ______________________________________________________________________
23 c UTilitaire - passage de Mere a Fille pour les FAces
25 c ______________________________________________________________________
27 c . nom . e/s . taille . description .
28 c .____________________________________________________________________.
29 c . nomail . e . char8 . nom de l'objet maillage homard .
30 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
31 c . langue . e . 1 . langue des messages .
32 c . . . . 1 : francais, 2 : anglais .
33 c . codret . es . 1 . code de retour des modules .
34 c . . . . 0 : pas de probleme .
35 c . . . . 1 : probleme .
36 c ______________________________________________________________________
39 c 0. declarations et dimensionnement
42 c 0.1. ==> generalites
48 parameter ( nompro = 'UTMFFA' )
61 integer ulsort, langue, codret
63 c 0.4. ==> variables locales
67 integer codre1, codre2
74 parameter ( nbmess = 10 )
75 character*80 texte(nblang,nbmess)
77 c 0.5. ==> initialisations
78 c ______________________________________________________________________
87 write (ulsort,texte(langue,1)) 'Entree', nompro
92 > '(''Reperage des fils a partir des peres pour les faces'')'
93 texte(1,5) = '(''. Type d''''entites : '',a)'
94 texte(1,6) = '(''. Nombre d''''entites :'',i10)'
96 texte(2,4) = '(''Son arrays from father arrays for faces'')'
97 texte(2,5) = '(''. Type of entities : '',a)'
98 texte(2,6) = '(''. Number of entities:'',i10)'
100 #ifdef _DEBUG_HOMARD_
101 write (ulsort,texte(langue,4))
105 c 2. recuperation des donnees du maillage d'entree
108 call gmliat ( nomail, 3, degre, codre0 )
109 codret = max ( abs(codre0), codret )
112 c 3. les triangles puis les quadrangles
115 #ifdef _DEBUG_HOMARD_
116 if ( codret.eq.0 ) then
117 call gmprsx (nompro, nomail//'.Face' )
123 c 3.1. ==> nom de la branche
125 if ( codret.eq.0 ) then
127 jaux = mod(iaux,2) + 1
128 if ( degre.eq.1 ) then
129 saux04(iaux) = 'Tr03'
130 saux04(jaux) = 'Qu04'
132 if ( mod(mailet,2).eq.0 .or. mod(mailet,3).eq.0 ) then
133 saux04(iaux) = 'Tr07'
134 saux04(jaux) = 'Qu09'
136 saux04(iaux) = 'Tr06'
137 saux04(jaux) = 'Qu08'
141 #ifdef _DEBUG_HOMARD_
142 if ( codret.eq.0 ) then
143 write (ulsort,texte(langue,5)) saux04(1)
144 cgn call gmprsx (nompro, nomail//'.Face.HOM_'//saux04(1) )
148 call gmobal ( nomail//'.Face.HOM_'//saux04(1) , codre0 )
149 if ( codre0.eq.0 ) then
151 elseif ( codre0.ne.1 ) then
157 c 3.2. ==> combien d'entites de ce type ?
159 if ( codret.eq.0 ) then
161 call gmliat ( nomail//'.Face.HOM_'//saux04(1),
162 > 1, nbenti(1), codre0 )
163 codret = max ( abs(codre0), codret )
165 #ifdef _DEBUG_HOMARD_
166 if ( codret.eq.0 ) then
167 write (ulsort,texte(langue,6)) nbenti(1)
173 c 3.3. ==> s'il y en a, on recupere la structure qui les decrit
174 c sinon, on passe a la suite
176 if ( codret.eq.0 ) then
178 if ( nbenti(1).eq.0 ) then
184 call gmnomc ( nomail//'.Face.HOM_'//saux04(1),
185 > nhenti(1), codre1 )
186 codret = max ( abs(codre0), codret )
192 c 3.4. ==> A-t-on le type frere ?
194 if ( codret.eq.0 ) then
196 call gmobal ( nomail//'.Face.HOM_'//saux04(2) , codre0 )
197 if ( codre0.eq.1 ) then
198 call gmliat ( nomail//'.Face.HOM_'//saux04(2),
199 > 1, nbenti(2), codre1 )
200 call gmnomc ( nomail//'.Face.HOM_'//saux04(2),
201 > nhenti(2), codre2 )
202 codre0 = min ( codre1, codre2 )
203 codret = max ( abs(codre0), codret,
211 c 3.5. ==> Appel du programme generique
213 if ( codret.eq.0 ) then
215 #ifdef _DEBUG_HOMARD_
216 write (ulsort,texte(langue,3)) 'UTMFEN', nompro
218 call utmfen ( nhenti(1), nhenti(2), nbenti(2),
219 > ulsort, langue, codret )
229 if ( codret.ne.0 ) then
233 write (ulsort,texte(langue,1)) 'Sortie', nompro
234 write (ulsort,texte(langue,2)) codret
238 #ifdef _DEBUG_HOMARD_
239 write (ulsort,texte(langue,1)) 'Sortie', nompro