1 subroutine sfctri ( somseg, seglig,
3 > ulsort, langue, codret)
4 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 Suivi de Frontiere - ConTRole des Intersections enter les lignes
25 c ______________________________________________________________________
27 c . nom . e/s . taille . description .
28 c .____________________________________________________________________.
29 c . somseg . e . sfnbse . liste des sommets des lignes separees par .
31 c . seglig . e .0:sfnbli. pointeur dans le tableau somseg : les .
32 c . . . . segments de la ligne i sont aux places de .
33 c . . . . seglig(i-1)+1 a seglig(i)-1 inclus .
34 c . tbiaux . e . sfnbso . tableau auxiliaire .
35 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
36 c . langue . e . 1 . langue des messages .
37 c . . . . 1 : francais, 2 : anglais .
38 c . codret . es . 1 . code de retour des modules .
39 c . . . . 0 : pas de probleme .
40 c . . . . !=0 : nombre d'intersections .
41 c ______________________________________________________________________
44 c 0. declarations et dimensionnement
47 c 0.1. ==> generalites
53 parameter ( nompro = 'SFCTRI' )
66 integer somseg(sfnbse), seglig(0:sfnbli)
67 integer tbiaux(sfnbso)
69 integer ulsort, langue, codret
71 c 0.4. ==> variables locales
73 integer iaux, jaux, kaux
75 integer extred, extref
78 parameter ( nbmess = 10 )
79 character*80 texte(nblang,nbmess)
81 c 0.5. ==> initialisations
82 c ______________________________________________________________________
91 write (ulsort,texte(langue,1)) 'Entree', nompro
95 texte(1,4) = '(''. Ligne numero'',i4)'
97 > '(''.. Le noeud'',i10,'' appartient a'',i3,'' lignes.'')'
99 > '(''.. Les lignes forment'',i3,'' intersection(s).'')'
101 > '(''.. Le noeud'',i10,'' est une extremite de la ligne'',i4)'
102 texte(1,8) = '(''.. Il appartient aussi a la ligne'',i4,/)'
104 texte(2,4) = '(''. Line #"'',i4)'
106 > '(''.. The vertex #'',i10,'' belongs to'',i3,'' lines.'')'
108 > '(''.. The lines make'',i3,'' intersection(s).'')'
110 > '(''.. The vertex #'',i10,'' is end of the line #'',i4)'
111 texte(2,8) = '(''.. It belongs to the line #'',i4,/)'
118 c 2. Recherche des points communs qui ne sont pas des extremites
120 #ifdef _DEBUG_HOMARD_
121 write (ulsort,90002) '2. points communs ; codret', codret
124 c 2.1. ==> Aucun noeud n'appartient a une ligne
126 do 21 , iaux = 1 , sfnbso
132 c 2.2. ==> Parcours des lignes
133 c Pour chacun de ses noeuds, sauf les extremites, on
134 c cumule le nombre de ligne d'appartenance.
136 do 22 , iaux = 1 , sfnbli
138 #ifdef _DEBUG_HOMARD_
139 write (ulsort,texte(langue,4)) iaux
142 jdeb = seglig(iaux-1)+2
143 jfin = seglig(iaux)-2
144 #ifdef _DEBUG_HOMARD_
145 write (ulsort,90002) 'extremites', somseg(jdeb-1), somseg(jfin+1)
146 write (ulsort,90002) 'jdeb, jfin', jdeb, jfin
148 do 221 , jaux = jdeb, jfin
150 tbiaux(somseg(jaux)) = tbiaux(somseg(jaux)) + 1
156 c 2.3. ==> Aucun noeud ne doit appartenir a plus d'une ligne
158 do 23 , iaux = 1 , sfnbso
160 if ( tbiaux(iaux).gt.1 ) then
161 write (ulsort,texte(langue,5)) iaux, tbiaux(iaux)
168 c 3. Recherche des extremites qui sont des points interieurs
170 #ifdef _DEBUG_HOMARD_
171 write (ulsort,90002) '3. extremites ; codret', codret
174 c 3.1. ==> Parcours des lignes
175 c On repere les deux extremites et on
176 c cherche si elles appartiennent a une autre ligne
178 do 31 , iaux = 1 , sfnbli
180 #ifdef _DEBUG_HOMARD_
181 write (ulsort,texte(langue,4)) iaux
184 jdeb = seglig(iaux-1)+1
185 jfin = seglig(iaux)-1
186 extred = somseg(jdeb)
187 extref = somseg(jfin)
188 #ifdef _DEBUG_HOMARD_
189 write (ulsort,90002) 'extremites', extred, extref
192 do 311 , kaux = 1 , sfnbli
194 if ( kaux.ne.iaux ) then
195 #ifdef _DEBUG_HOMARD_
196 write (ulsort,texte(langue,4)) kaux
199 jdeb = seglig(kaux-1)+2
200 jfin = seglig(kaux)-2
201 #ifdef _DEBUG_HOMARD_
202 write (ulsort,90002) 'extremites', somseg(jdeb-1), somseg(jfin+1)
203 write (ulsort,90002) 'jdeb, jfin', jdeb, jfin
205 do 3111 , jaux = jdeb, jfin
207 if ( somseg(jaux).eq.extred .or.
208 > somseg(jaux).eq.extref ) then
210 write (ulsort,texte(langue,7)) somseg(jaux), iaux
211 write (ulsort,texte(langue,8)) kaux
226 if ( codret.ne.0 ) then
228 write (ulsort,texte(langue,6)) codret
236 if ( codret.ne.0 ) then
240 write (ulsort,texte(langue,1)) 'Sortie', nompro
241 write (ulsort,texte(langue,2)) codret
245 #ifdef _DEBUG_HOMARD_
246 write (ulsort,texte(langue,1)) 'Sortie', nompro