1 subroutine sfindr ( seglig, cfaare, famare,
3 > ulsort, langue, codret)
4 c ______________________________________________________________________
8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
11 c aupres des huissiers de justice Simart et Lavoir a Clamart
12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
13 c aupres des huissiers de justice
14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
16 c HOMARD est une marque deposee d'Electricite de France
22 c ______________________________________________________________________
24 c Suivi de Frontiere - INhibition du suivi sur les lignes DRoites
26 c ______________________________________________________________________
28 c but : inhiber le suivi de frontiere pour les aretes pour des
29 c aretes pointant vers des droites
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . seglig . e .0:sfnbli. pointeur dans le tableau somseg : les .
35 c . . . . segments de la ligne i sont aux places de .
36 c . . . . seglig(i-1)+1 a seglig(i)-1 inclus .
37 c . cfaare . e . nctfar*. codes des familles des aretes .
38 c . . . nbfare . 1 : famille MED .
39 c . . . . 2 : type de segment .
40 c . . . . 3 : orientation .
41 c . . . . 4 : famille d'orientation inverse .
42 c . . . . 5 : numero de ligne de frontiere .
43 c . . . . > 0 si concernee par le suivi de frontiere.
44 c . . . . <= 0 si non concernee .
45 c . . . . 6 : famille frontiere active/inactive .
46 c . . . . 7 : numero de surface de frontiere .
47 c . . . . + l : appartenance a l'equivalence l .
48 c . famare . es . nbarto . famille des aretes .
49 c . lgetco . e . 1 . longueur du tableau de l'etat courant .
50 c . taetco . e . lgetco . tableau de l'etat courant .
51 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
52 c . langue . e . 1 . langue des messages .
53 c . . . . 1 : francais, 2 : anglais .
54 c . codret . es . 1 . code de retour des modules .
55 c . . . . 0 : pas de probleme .
56 c . . . . x : probleme .
57 c ______________________________________________________________________
60 c 0. declarations et dimensionnement
63 c 0.1. ==> generalites
69 parameter ( nompro = 'SFINDR' )
85 integer seglig(0:sfnbli)
86 integer cfaare(nctfar,nbfare), famare(nbarto)
89 integer taetco(lgetco)
91 integer ulsort, langue, codret
93 c 0.4. ==> variables locales
95 integer nretap, nrsset
104 parameter ( nbmess = 10 )
105 character*80 texte(nblang,nbmess)
107 c 0.5. ==> initialisations
108 c ______________________________________________________________________
114 c 1.1. ==> les messages
118 #ifdef _DEBUG_HOMARD_
119 write (ulsort,texte(langue,1)) 'Entree', nompro
123 c 789012345678901234567890123
124 texte(1,4) = '(/,a6,'' INHIBITION SUR LES DROITES'')'
125 texte(1,5) = '(33(''=''),/)'
126 texte(1,6) = '(''La ligne '',i4,'' est une droite.'')'
128 c 7890123456789012345678901234567
129 texte(2,4) = '(/,a6,'' CANCELLATION ON STRAIGHT LINES'')'
130 texte(2,5) = '(37(''=''),/)'
131 texte(2,6) = '(''Line # '',i4,'' is a straight line.'')'
135 c 1.2. ==> le numero de sous-etape
138 nrsset = taetco(2) + 1
141 call utcvne ( nretap, nrsset, saux, iaux, codret )
145 write (ulsort,texte(langue,4)) saux
146 write (ulsort,texte(langue,5))
149 c 2. Impression des numeros des lignes qui sont droites (2 points)
150 c On le memorise temporairement en negativant le numero du premier
151 c segment decrivant cette ligne
154 cgn write (ulsort,90002) 'seglig', (seglig(iaux), iaux = 0, sfnbli)
157 do 21 , iaux = 1, sfnbli
159 #ifdef _DEBUG_HOMARD_
160 write (ulsort,90012) 'Nombre de segments de la ligne', iaux,
161 > abs(seglig(iaux))-abs(seglig(iaux-1))-2
163 if ( abs(seglig(iaux))-abs(seglig(iaux-1)).eq.3 ) then
165 write (ulsort,texte(langue,6)) iaux
166 seglig(iaux) = -seglig(iaux)
174 c 3. S'il y a des droites : les aretes qui sont situees sur de telles
175 c lignes doivent etre retirees du suivi de frontiere : inutile de
176 c faire des calculs pour rien !
181 c 3.1 ==> Pour cela, il suffit de changer leur famille : on remplace
182 c leur famille actuelle par celle qui a toutes les memes
183 c caracteristiques, sauf celle du suivi de frontiere, stockee
184 c dans cosfin (cf. vccfam)
186 do 31 , are = 1, nbarto
188 iaux = cfaare(cosfli,famare(are))
190 c 3.1 ==> l'arete est active pour le SF : elle est sur la ligne iaux
192 if ( iaux.gt.0 ) then
194 c 3.1.1 ==> la ligne iaux est une droite
196 if ( seglig(iaux).lt.0 ) then
198 famare(are) = cfaare(cosfin,famare(are))
206 c 3.2. ==> On remet les numeros positifs
208 do 32 , iaux = 1, sfnbli
210 seglig(iaux) = abs(seglig(iaux))
220 if ( codret.ne.0 ) then
224 write (ulsort,texte(langue,1)) 'Sortie', nompro
225 write (ulsort,texte(langue,2)) codret
229 #ifdef _DEBUG_HOMARD_
230 write (ulsort,texte(langue,1)) 'Sortie', nompro