1 subroutine utcoq3 ( hetare, somare, filare, a1, a2, a3, a4,
2 > numdec, ai, aj, ak, al, afij, afil,
3 > saiaj, sajak, sakal, salai, ni,
4 > ulsort, langue, codret )
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c UTilitaire - decoupage de COnformite d'un Quadrangle
29 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . hetare . e . nbaret . historique de l'etat des aretes .
34 c . somare . e .2*nbaret. numeros des extremites d'arete .
35 c . filare . e . nbaret . premiere fille des aretes .
36 c .a1,..,a4. e . 1 . les numeros d'arete du quadrangle .
37 c . numdec . s . 1 . numero local de l'arete decoupee .
38 c . ai . s . 1 . l'arete du quadrangle qui est decoupee .
39 c .aj,ak,al. s . 1 . les 3 autres aretes dans l'ordre oriente .
40 c . afij . s . 1 . fille de ai allant vers saiaj .
41 c . afil . s . 1 . fille de ai allant vers salai .
42 c . saiaj . s . 1 . sommet commun aux aretes i et j .
43 c . sajak . s . 1 . sommet commun aux aretes j et k .
44 c . sakal . s . 1 . sommet commun aux aretes k et l .
45 c . salai . s . 1 . sommet commun aux aretes l et i .
46 c . ni . s . 1 . milieu de l'arete ai .
47 c . ulsort . e . 1 . unite logique de la sortie generale .
48 c . langue . e . 1 . langue des messages .
49 c . . . . 1 : francais, 2 : anglais .
50 c . codret . es . 1 . code de retour des modules .
51 c . . . . 0 : pas de probleme .
52 c ______________________________________________________________________
54 c saiaj afij ai/ni afil salai
55 c ._____________________________________________.
78 c ._____________________________________________.
83 c 0. declarations et dimensionnement
86 c 0.1. ==> generalites
92 parameter ( nompro = 'UTCOQ3' )
104 integer hetare(*), somare(2,*), filare(*)
106 integer a1, a2, a3, a4
107 integer ai, aj, ak, al
109 integer saiaj, sajak, sakal, salai
112 integer ulsort, langue, codret
114 c 0.4. ==> variables locales
120 parameter ( nbmess = 10 )
121 character*80 texte(nblang,nbmess)
122 c 0.5. ==> initialisations
123 c ______________________________________________________________________
131 #ifdef _DEBUG_HOMARD_
132 write (ulsort,texte(langue,1)) 'Entree', nompro
136 texte(1,10) ='(''Impossible de trouver l''''arete coupee.''))'
138 texte(2,10) ='(''Cut edge cannot be found.'')'
145 c 2. recherche du numero local de l'arete coupee
154 if ( mod(hetare(arete(iaux)),10).eq.2 ) then
160 write (ulsort,texte(langue,10))
164 cgn write (ulsort,90002) 'numdec', numdec
167 c 3. les numeros globaux des noeuds et des aretes
170 if ( codret.eq.0 ) then
172 c 3.1. ==> l'arete coupee
176 c 3.2. ==> les autres aretes sont dans le meme ordre de rotation
178 iaux = per1a4(1,numdec)
181 iaux = per1a4(1,iaux)
184 iaux = per1a4(1,iaux)
187 c 3.3. ==> les sommets du quadrangle
189 call utsoqu ( somare, ai, aj, ak, al,
190 > saiaj, sajak, sakal, salai )
192 c 3.4. ==> le decoupage de l'arete ai
195 if ( somare(1,iaux).eq.saiaj ) then
211 if ( codret.ne.0 ) then
215 write (ulsort,texte(langue,1)) 'Sortie', nompro
216 write (ulsort,texte(langue,2)) codret
220 #ifdef _DEBUG_HOMARD_
221 write (ulsort,texte(langue,1)) 'Sortie', nompro