1 subroutine utcote ( letetr, bilan,
5 > tritet, cotrte, aretet,
7 > ulsort, langue, codret)
8 c ______________________________________________________________________
11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
14 c aupres des huissiers de justice Simart et Lavoir a Clamart
15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
16 c aupres des huissiers de justice
17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
19 c HOMARD est une marque deposee d'Electricite de France
25 c ______________________________________________________________________
27 c UTilitaire - COntroles de TEtraedres
29 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . letetr . e . 1 . numero du tetraedre a examiner .
34 c . bilan . s . 1 . 0 : tout va bien .
35 c . . . . 1 : probleme .
36 c . coonoe . e . nbnoto . coordonnees des noeuds .
38 c . somare . e .2*nbarto. numeros des extremites d'arete .
39 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
40 c . tritet . e .nbtecf*4. numeros des triangles des tetraedres .
41 c . cotrte . e .nbtecf*4. codes des triangles des tetraedres .
42 c . aretet . e .nbteca*6. numeros des 6 aretes des tetraedres .
43 c . hettet . e . nbteto . historique de l'etat des tetraedres .
44 c . filtet . e . nbteto . premier fils des tetraedres .
45 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
46 c . langue . e . 1 . langue des messages .
47 c . . . . 1 : francais, 2 : anglais .
48 c . codret . es . 1 . code de retour des modules .
49 c . . . . 0 : pas de probleme .
50 c . . . . x : probleme .
51 c ______________________________________________________________________
54 c 0. declarations et dimensionnement
57 c 0.1. ==> generalites
63 parameter ( nompro = 'UTCOTE' )
81 integer somare(2,nbarto)
82 integer aretri(nbtrto,3)
83 integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
84 integer hettet(nbteto)
85 integer filtet(nbteto)
87 double precision coonoe(nbnoto,sdim)
89 integer ulsort, langue, codret
91 c 0.4. ==> variables locales
97 double precision prmixt, prmixf
100 parameter ( nbmess = 10 )
101 character*80 texte(nblang,nbmess)
103 c 0.5. ==> initialisations
104 c ______________________________________________________________________
114 #ifdef _DEBUG_HOMARD_
115 write (ulsort,texte(langue,1)) 'Entree', nompro
119 texte(1,4) = '(''.. Examen du '',a,i10)'
120 texte(1,5) = '(''.. Le '',a,i10,'' est actif.'')'
122 texte(2,4) = '(''.. Examination of '',a,'' # '',i10)'
123 texte(2,5) = '(''.. The '',a,'' # '',i10,'' is active.'')'
128 c 2. Controle du tetraedre
129 c Le tetraedre et ses fils doivent avoir la meme orientation,
130 c sinon c'est que un des noeuds a traverse le bord
132 #ifdef _DEBUG_HOMARD_
133 write (ulsort,*) '2. Controle tetraedre ; codret = ', codret
136 #ifdef _DEBUG_HOMARD_
137 write (ulsort,texte(langue,4)) mess14(langue,1,3), letetr
140 etat = mod(hettet(letetr),100)
141 cgn write (ulsort,90002) 'etat', etat
143 if ( etat.eq.0 ) then
151 c 2.1. ==> Produit mixte du tetraedre
153 #ifdef _DEBUG_HOMARD_
154 write (ulsort,texte(langue,3)) 'UTPMTE', nompro
156 call utpmte ( letetr, prmixt,
157 > coonoe, somare, aretri,
158 > tritet, cotrte, aretet )
159 cgn write(ulsort,*) letetr,prmixt
163 if ( etat.le.26 ) then
165 elseif ( etat.le.47 ) then
170 cgn write(ulsort,*) ' ',etat
171 freain = filtet(letetr)
172 do 221 , iaux = freain , freain+nbfils
174 call utpmte ( jaux, prmixf,
175 > coonoe, somare, aretri,
176 > tritet, cotrte, aretet )
177 cgn write(ulsort,*) ' ',iaux,prmixf
178 if ( prmixt*prmixf.le.0.d0 ) then
192 if ( codret.ne.0 ) then
196 write (ulsort,texte(langue,1)) 'Sortie', nompro
197 write (ulsort,texte(langue,2)) codret
198 write (ulsort,texte(langue,5)) mess14(langue,1,3), letetr
202 #ifdef _DEBUG_HOMARD_
203 write (ulsort,texte(langue,1)) 'Sortie', nompro