1 subroutine utafqu ( somare, filare, a1, a2, a3, a4,
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 UTilitaire - Aretes Filles - QUadrangle
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . somare . e .2*nbaret. numeros des extremites d'arete .
33 c . filare . e . nbaret . premiere fille des aretes .
34 c .a1,..,a4. e . 1 . les numeros des aretes du quadrangle .
35 c . asinj . s . 1 . arete entre le sommet i et le milieu de .
36 c . . . . l'arete j du triangle .
37 c ______________________________________________________________________
40 c 0. declarations et dimensionnement
43 c 0.1. ==> generalites
52 integer somare(2,*), filare(*)
53 integer a1, a2, a3, a4
59 c 0.4. ==> variables locales
61 integer s1, s2, s3, s4
65 c 1. on cherche les numeros des sommets du quadrangle defini par ses
68 cgn10000 format('arete a',i1,' :',i2,' de',i3,' a',i3)
69 cgn20000 format('sommet S',i1,' :',i3)
70 cgn write(1,10000) 1, a1, somare(1,a1), somare(2,a1)
71 cgn write(1,10000) 2, a2, somare(1,a2), somare(2,a2)
72 cgn write(1,10000) 3, a3, somare(1,a3), somare(2,a3)
73 cgn write(1,10000) 4, a4, somare(1,a4), somare(2,a4)
74 call utsoqu ( somare, a1, a2, a3, a4,
76 cgn write(1,20000) 1, s1
77 cgn write(1,20000) 2, s2
78 cgn write(1,20000) 3, s3
79 cgn write(1,20000) 4, s4
82 c 2. Filles des aretes
83 c On s'appuie sur le fait que le second noeud des aretes filles
84 c de ak est, par construction, le noeud au milieu de ak.
85 c Donc le premier est l'un des 2 noeuds de ak.
88 cgn30000 format('arete ',a5,' :',i3,' de',i3,' a',i3)
90 if ( somare(1,iaux).eq.s1 ) then
97 cgn write(1,30000) 'as2n1', as2n1, somare(1,as2n1), somare(2,as2n1)
98 cgn write(1,30000) 'as3n1', as3n1, somare(1,as3n1), somare(2,as3n1)
101 if ( somare(1,iaux).eq.s2 ) then
108 cgn write(1,30000) 'as1n2', as1n2, somare(1,as1n2), somare(2,as1n2)
109 cgn write(1,30000) 'as3n2', as3n2, somare(1,as3n2), somare(2,as3n2)
112 if ( somare(1,iaux).eq.s3 ) then
119 cgn write(1,30000) 'as1n3', as1n3, somare(1,as1n3), somare(2,as1n3)
120 cgn write(1,30000) 'as2n3', as2n3, somare(1,as2n3), somare(2,as2n3)
123 if ( somare(1,iaux).eq.s4 ) then
130 cgn write(1,30000) 'as1n3', as1n3, somare(1,as1n3), somare(2,as1n3)
131 cgn write(1,30000) 'as2n3', as2n3, somare(1,as2n3), somare(2,as2n3)