1 subroutine infve4 ( fotrva, foquva,
2 > coonoe, somare, aretri, arequa,
5 > ulsort, langue, codret )
6 c ______________________________________________________________________
10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
13 c aupres des huissiers de justice Simart et Lavoir a Clamart
14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
15 c aupres des huissiers de justice
16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
18 c HOMARD est une marque deposee d'Electricite de France
24 c ______________________________________________________________________
26 c INformation : Fichiers VEctoriel - 4eme partie
28 c ______________________________________________________________________
30 c recherche des qualites
31 c ______________________________________________________________________
33 c . nom . e/s . taille . description .
34 c .____________________________________________________________________.
35 c . fotrva . s . nbtrvi . fonctions triangles : valeur .
36 c . foquva . s . nbquvi . fonctions quadrangles : valeur .
37 c . coonoe . e . nbnoto . coordonnees des noeuds .
39 c . somare . e .2*nbarto. numeros des extremites d'arete .
40 c . aretri . e .nbtrto*3. numeros des 3 aretes des triangles .
41 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
42 c . nbtrvi . e . 1 . nombre triangles visualisables .
43 c . nbquvi . e . 1 . nombre de quadrangles visualisables .
44 c . nntrvi . e .10nbtrvi. 1 : niveau du triangle a afficher .
45 c . . . . 2 : numero HOMARD du triangle .
46 c . . . . 3, 4, 5 : numeros des noeuds p1 .
47 c . . . . 6 : famille du triangle .
48 c . . . . 7, 8, 9 : numeros des noeuds p2 .
49 c . . . . 10 : numero du noeud interne .
50 c . nnquvi . e .12nbquvi. 1 : niveau du quadrangle a afficher .
51 c . . . . 2 : numero HOMARD du quadrangle .
52 c . . . . 3, 4, 5, 6 : numeros des noeuds p1 .
53 c . . . . 7 : famille du quadrangle .
54 c . . . . 8, 9, 10, 11 : numeros des noeuds p2 .
55 c . . . . 12 : numero du noeud interne .
56 c . ulsort . e . 1 . unite logique de la sortie generale .
57 c . langue . e . 1 . langue des messages .
58 c . . . . 1 : francais, 2 : anglais .
59 c . codret . s . 1 . code de retour des modules .
60 c . . . . 0 : pas de probleme .
61 c ______________________________________________________________________
64 c 0. declarations et dimensionnement
67 c 0.1. ==> generalites
73 parameter ( nompro = 'INFVE4' )
91 integer nbtrvi, nbquvi
92 integer nntrvi(10,nbtrvi)
93 integer nnquvi(12,nbquvi)
94 integer somare(2,nbarto)
95 integer aretri(nbtrto,3), arequa(nbquto,4)
97 double precision fotrva(*), foquva(*)
98 double precision coonoe(nbnoto,sdim)
100 integer ulsort, langue, codret
102 c 0.4. ==> variables locales
105 integer letria, lequad
107 double precision qual, daux
110 parameter ( nbmess = 10 )
111 character*80 texte(nblang,nbmess)
112 c_______________________________________________________________________
122 #ifdef _DEBUG_HOMARD_
123 write (ulsort,texte(langue,1)) 'Entree', nompro
127 texte(1,4) = '(''Recherche des qualites des mailles'')'
129 texte(2,4) = '(''Research of mesh qualities'')'
131 #ifdef _DEBUG_HOMARD_
132 write (ulsort,texte(langue,4))
134 cgn 1789 format(i4,12f13.6)
137 c 2. Parcours des differentes mailles
139 c 2.1. ==> les triangles
141 do 21 , iaux = 1 , nbtrvi
143 letria = nntrvi(2,iaux)
145 call utqtri ( letria, qual, daux,
146 > coonoe, somare, aretri )
149 cgn print 1789,iaux,fotrva(iaux)
153 c 2.2. ==> les quadrangles
155 do 22 , iaux = 1 , nbquvi
157 lequad = nnquvi(2,iaux)
159 call utqqua ( lequad, qual, daux,
160 > coonoe, somare, arequa )
163 cgn print 1789,iaux,fotrva(iaux)
171 if ( codret.ne.0 ) then
175 write (ulsort,texte(langue,1)) 'Sortie', nompro
176 write (ulsort,texte(langue,2)) codret
180 #ifdef _DEBUG_HOMARD_
181 write (ulsort,texte(langue,1)) 'Sortie', nompro