1 subroutine sfnofl ( ntrav1, ntrav2, ntrav3,
2 > adnuno, adlino, adacno,
5 > somare, hetare, filare, np2are,
10 > ulsort, langue, codret)
11 c ______________________________________________________________________
15 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
17 c Version originale enregistree le 18 juin 1996 sous le numero 96036
18 c aupres des huissiers de justice Simart et Lavoir a Clamart
19 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
20 c aupres des huissiers de justice
21 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
23 c HOMARD est une marque deposee d'Electricite de France
29 c ______________________________________________________________________
31 c Suivi de Frontiere - NOeuds du maillage de calcul
33 c sur la Frontiere - Lignes
35 c ______________________________________________________________________
37 c . nom . e/s . taille . description .
38 c .____________________________________________________________________.
39 c . ntrav1 . s . 1 . tableau de numnoe = imem(adnuno) .
40 c . ntra2v . s . 1 . tableau de lignoe = imem(adlino) .
41 c . ntrav3 . s . 1 . tableau de abscno = rmem(adacno) .
42 c . adnuno . s . 1 . liste des noeuds de calcul sur le bord .
43 c . adlino . s . 1 . liste lignes pour ces noeuds .
44 c . adacno . s . 1 . abscisse curviligne de ces noeuds .
45 c . unst2x . e . 1 . inverse de la taille maximale au carre .
46 c . epsid2 . e . 1 . precision relative pour carre de distance .
47 c . coonoe . es . nbnoto . coordonnees des noeuds .
49 c . somare . e .2*nbarto. numeros des extremites d'arete .
50 c . hetare . e . nbarto . historique de l'etat des aretes .
51 c . filare . e . nbarto . premiere fille des aretes .
52 c . np2are . e . nbarto . noeud milieux des aretes .
53 c . cfaare . e . nctfar*. codes des familles des aretes .
54 c . . . nbfare . 1 : famille MED .
55 c . . . . 2 : type de segment .
56 c . . . . 3 : orientation .
57 c . . . . 4 : famille d'orientation inverse .
58 c . . . . 5 : numero de ligne de frontiere .
59 c . . . . > 0 si concernee par le suivi de frontiere.
60 c . . . . <= 0 si non concernee .
61 c . . . . 6 : famille frontiere active/inactive .
62 c . . . . 7 : numero de surface de frontiere .
63 c . . . . + l : appartenance a l'equivalence l .
64 c . famare . e . nbarto . famille des aretes .
65 c . geocoo . e .sfnbso**. coordonnees des sommets de la frontiere .
66 c . abscur . e . sfnbse . abscisse curviligne des somm des segments .
67 c . somseg . e . sfnbse . liste des sommets des lignes separees par .
69 c . seglig . e .0:sfnbli. pointeur dans le tableau somseg : les .
70 c . . . . segments de la ligne i sont aux places de .
71 c . . . . seglig(i-1)+1 a seglig(i)-1 inclus .
72 c . lgetco . e . 1 . longueur du tableau de l'etat courant .
73 c . taetco . e . lgetco . tableau de l'etat courant .
74 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
75 c . langue . e . 1 . langue des messages .
76 c . . . . 1 : francais, 2 : anglais .
77 c . codret . es . 1 . code de retour des modules .
78 c . . . . 0 : pas de probleme .
79 c . . . . x : probleme .
80 c ______________________________________________________________________
83 c 0. declarations et dimensionnement
86 c 0.1. ==> generalites
92 parameter ( nompro = 'SFNOFL' )
114 double precision unst2x, epsid2
115 double precision coonoe(nbnoto,sdim), geocoo(sfnbso,sdim)
116 double precision abscur(sfnbse)
118 integer adnuno, adlino, adacno
119 integer seglig(0:sfnbli), somseg(sfnbse)
120 integer famare(nbarto), cfaare(nctfar,nbfare)
121 integer somare(2,nbarto), hetare(nbarto), filare(nbarto)
122 integer np2are(nbarto)
124 character*8 ntrav1, ntrav2, ntrav3
127 integer taetco(lgetco)
129 integer ulsort, langue, codret
131 c 0.4. ==> variables locales
133 integer nretap, nrsset
138 integer codre1, codre2, codre3, codre4
144 parameter ( nbmess = 10 )
145 character*80 texte(nblang,nbmess)
147 c 0.5. ==> initialisations
148 c ______________________________________________________________________
154 c 1.3. ==> les messages
158 #ifdef _DEBUG_HOMARD_
159 write (ulsort,texte(langue,1)) 'Entree', nompro
163 texte(1,4) = '(/,a6,'' NOEUDS INITIAUX SUR LA FRONTIERE'')'
164 texte(1,5) = '(39(''=''),/)'
165 texte(1,6) = '(''. Nombre de '',a,'' :'',i10)'
166 texte(1,7) = '(''. Inverse du carre de la taille :'',g15.7)'
167 texte(1,8) = '(''. Precision relative :'',g15.7)'
169 texte(2,4) = '(/,a6,'' INITIAL NODES AND BOUNDARY'')'
170 texte(2,5) = '(33(''=''),/)'
171 texte(2,6) = '(''. Number of '',a,'' :'',i10)'
172 texte(2,7) = '(''. 1./max distance ** 2 :'',g15.7)'
173 texte(2,8) = '(''. Relative precision for equality :'',g15.7)'
175 c 1.4. ==> le numero de sous-etape
178 nrsset = taetco(2) + 1
181 call utcvne ( nretap, nrsset, saux, iaux, codret )
185 write (ulsort,texte(langue,4)) saux
186 write (ulsort,texte(langue,5))
188 #ifdef _DEBUG_HOMARD_
189 write (ulsort,texte(langue,6)) mess14(langue,3,-1), nbnoto
190 write (ulsort,texte(langue,6)) mess14(langue,3,1), nbarto
191 write (ulsort,texte(langue,7)) unst2x
192 write (ulsort,texte(langue,8)) epsid2
196 c 2. Estimation du nombre de noeuds du maillage de calcul qui sont
197 c sur une ligne de frontiere
199 #ifdef _DEBUG_HOMARD_
200 write (ulsort,*) '2. Estimation ; codret = ', codret
203 if ( codret.eq.0 ) then
205 #ifdef _DEBUG_HOMARD_
206 write (ulsort,texte(langue,3)) 'SFNNFL', nompro
208 call sfnnfl ( hetare,
210 > ulsort, langue, codret)
217 #ifdef _DEBUG_HOMARD_
218 write (ulsort,*) '3. Allocations ; codret = ', codret
221 if ( codret.eq.0 ) then
223 call gmalot ( ntrav1, 'entier ', mcnxnf, adnuno, codre1 )
224 call gmalot ( ntrav2, 'entier ', mcnxnf, adlino, codre2 )
225 call gmalot ( ntrav3, 'reel ', mcnxnf, adacno, codre3 )
226 call gmalot ( ntrava, 'entier ', nbnoto, adsegn, codre4 )
228 codre0 = min ( codre1, codre2, codre3, codre4 )
229 codret = max ( abs(codre0), codret,
230 > codre1, codre2, codre3, codre4 )
235 c 4. Etablissement du lien des sommets
238 #ifdef _DEBUG_HOMARD_
239 write (ulsort,*) '4. Liens sommets/lignes ; codret = ', codret
241 cgn 1001 format(a,' :',i10,', ',3g13.5)
242 cgn do 41 ,codre0=1,nbnoto
243 cgn write (ulsort,1001) 'n', codre0,
244 cgn >(coonoe(codre0,iaux),iaux = 1 , sdim)
247 if ( codret.eq.0 ) then
249 cgn 1001 format('Noeud ',i8,' :',3g16.9)
251 cgn write (ulsort,1001)
252 cgn > codre1,(coonoe(codre1,iaux),iaux=1,sdim)
253 #ifdef _DEBUG_HOMARD_
254 write (ulsort,texte(langue,3)) 'SFLISO', nompro
256 call sfliso ( imem(adnuno), imem(adlino), rmem(adacno),
259 > somare, hetare, filare, np2are,
262 > somseg, seglig, imem(adsegn),
263 > ulsort, langue, codret )
267 cgn write (ulsort,1001)
268 cgn > codre1,(coonoe(codre1,iaux),iaux=1,sdim)
269 cgn do 42 ,codre0=1,nbnoto
270 cgn write (ulsort,1001) 'n', codre0,
271 cgn >(coonoe(codre0,iaux),iaux = 1 , sdim)
274 cgn call gmprot ( nompro//' apres SFLISO', ntrav1, 1, mcnvnf )
275 cgn call gmprot ( nompro//' apres SFLISO', ntrav2, 1, mcnvnf )
276 cgn call gmprot ( nompro//' apres SFLISO', ntrav3, 1, mcnvnf )
281 #ifdef _DEBUG_HOMARD_
282 write (ulsort,*) '5. Menage ; codret = ', codret
285 if ( codret.eq.0 ) then
287 call gmlboj ( ntrava, codret )
295 if ( codret.ne.0 ) then
299 write (ulsort,texte(langue,1)) 'Sortie', nompro
300 write (ulsort,texte(langue,2)) codret
304 #ifdef _DEBUG_HOMARD_
305 write (ulsort,texte(langue,1)) 'Sortie', nompro