1 subroutine sfpop2 ( typsfr,
6 > ulsort, langue, codret)
7 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 Suivi de Frontiere - POsition des noeuds P2
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . typsfr . s . 1 . type du suivi de frontiere .
34 c . . . . 1 : maillage de degre 1, avec projection .
35 c . . . . des nouveaux sommets .
36 c . . . . 2 : maillage de degre 2, seuls les noeuds .
37 c . . . . P1 sont sur la frontiere ; les noeuds .
38 c . . . . P2 restent au milieu des P1 .
39 c . . . . 3 : maillage de degre 2, les noeuds P2 .
40 c . . . . etant sur la frontiere .
41 c . coonoe . es . nbnoto . coordonnees des noeuds .
43 c . somare . es .2*nbarto. numeros des extremites d'arete .
44 c . np2are . e . nbarto . noeud milieux des aretes .
45 c . cfaare . e . nctfar*. codes des familles des aretes .
46 c . . . nbfare . 1 : famille MED .
47 c . . . . 2 : type de segment .
48 c . . . . 3 : orientation .
49 c . . . . 4 : famille d'orientation inverse .
50 c . . . . 5 : numero de ligne de frontiere .
51 c . . . . > 0 si concernee par le suivi de frontiere.
52 c . . . . <= 0 si non concernee .
53 c . . . . 6 : famille frontiere active/inactive .
54 c . . . . 7 : numero de surface de frontiere .
55 c . . . . + l : appartenance a l'equivalence l .
56 c . famare . es . nbarto . famille des aretes .
57 c . lgetco . e . 1 . longueur du tableau de l'etat courant .
58 c . taetco . e . lgetco . tableau de l'etat courant .
59 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
60 c . langue . e . 1 . langue des messages .
61 c . . . . 1 : francais, 2 : anglais .
62 c . codret . es . 1 . code de retour des modules .
63 c . . . . 0 : pas de probleme .
64 c . . . . x : probleme .
65 c ______________________________________________________________________
68 c 0. declarations et dimensionnement
71 c 0.1. ==> generalites
77 parameter ( nompro = 'SFPOP2' )
95 integer somare(2,nbarto), np2are(nbarto)
96 integer cfaare(nctfar,nbfare), famare(nbarto)
98 double precision coonoe(nbnoto,2)
101 integer taetco(lgetco)
103 integer ulsort, langue, codret
105 c 0.4. ==> variables locales
107 integer nretap, nrsset
110 integer larete, noeud1, noeud2
115 double precision daux, daux1, daux2
116 double precision xmil, ymil
119 parameter ( nbmess = 20 )
120 character*80 texte(nblang,nbmess)
122 c 0.5. ==> initialisations
123 c ______________________________________________________________________
131 c 1.3. ==> les messages
135 #ifdef _DEBUG_HOMARD_
136 write (ulsort,texte(langue,1)) 'Entree', nompro
140 texte(1,4) = '(/,a6,'' REPERAGE DES POSITIONS DE NOEUDS P2'')'
141 texte(1,5) = '(42(''=''),/)'
143 >'(''. Examen de l''''arete '',i10,'' (ligne '',i8,'')'')'
144 texte(1,7) ='(''Ecart au carre :'',g12.5)'
145 texte(1,8) ='(''1/2 arete au carre :'',g12.5)'
146 texte(1,9) ='(''Ecart maximal :'',g12.5)'
147 texte(1,10) ='(''1/2 arete maximale :'',g12.5)'
148 texte(1,11) ='(''Millieme de la 1/2 arete maximale :'',g12.5)'
149 texte(1,12) ='(''Les noeuds P2 sont au milieu des aretes.'')'
150 texte(1,13) ='(''Les noeuds P2 sont sur la frontiere.'')'
152 texte(2,4) = '(/,a6,'' LOCALIZATION OF P2 NODES'')'
153 texte(2,5) = '(31(''=''),/)'
155 >'(''. Examination of edge #'',i10,'' (line #'',i8,'')'')'
156 texte(2,7) ='(''Squared distance :'',g12.5)'
157 texte(2,8) ='(''Squared half edge :'',g12.5)'
158 texte(2,9) ='(''Maximum distance :'',g12.5)'
159 texte(2,10) ='(''Maximum half edge :'',g12.5)'
160 texte(2,11) ='(''1.e-3 maximum half edge :'',g12.5)'
161 texte(2,12) ='(''P2 nodes are centers of edges.'')'
162 texte(2,13) ='(''P2 nodes are located over border.'')'
164 c 1.4. ==> le numero de sous-etape
167 nrsset = taetco(2) + 1
170 call utcvne ( nretap, nrsset, saux, iaux, codret )
174 write (ulsort,texte(langue,4)) saux
175 write (ulsort,texte(langue,5))
178 c 2. On ne s'interesse qu'aux aretes qui font partie d'une frontiere
180 c Il suffit de le faire sur les aretes du macro-maillage
182 #ifdef _DEBUG_HOMARD_
183 write (ulsort,*) '2. ; codret = ', codret
186 c 2.1. ==> Recherche de l'ecart maximum entre le noeud central et le
187 c milieu des 2 extremites, pour chacune des aretes de frontiere
192 do 21 , larete = 1 , nbarma
194 if ( codret.eq.0 ) then
196 numlig = cfaare(cosfli,famare(larete))
198 if ( numlig.gt.0 ) then
199 #ifdef _DEBUG_HOMARD_
200 write(ulsort,texte(langue,6)) larete, numlig
202 noeud1 = somare(1,larete)
203 noeud2 = somare(2,larete)
205 xmil = unsde * ( coonoe(noeud1,1) + coonoe(noeud2,1) )
206 ymil = unsde * ( coonoe(noeud1,2) + coonoe(noeud2,2) )
208 daux = ( coonoe(np2are(larete),1) - xmil ) **2 +
209 > ( coonoe(np2are(larete),2) - ymil ) **2
210 daux1 = max(daux1, daux)
211 #ifdef _DEBUG_HOMARD_
212 write(ulsort,texte(langue,7)) daux
215 daux = ( coonoe(noeud1,1) - xmil ) **2 +
216 > ( coonoe(noeud1,2) - ymil ) **2
217 daux2 = max(daux2, daux)
218 #ifdef _DEBUG_HOMARD_
219 write(ulsort,texte(langue,8)) daux
228 c 2.2. ==> diagnostic : si l'ecart est superieur au millieme de la
229 c demi-arete, on considere que les noeuds P2 ont ete mis sur
233 #ifdef _DEBUG_HOMARD_
234 write(ulsort,texte(langue,9)) sqrt(daux1)
235 write(ulsort,texte(langue,10)) sqrt(daux2)
236 write(ulsort,texte(langue,11)) 1.d-3*sqrt(daux2)
238 if ( daux1.gt.1.d-6*daux2 ) then
244 write(ulsort,texte(langue,10+typsfr))
250 if ( codret.ne.0 ) then
254 write (ulsort,texte(langue,1)) 'Sortie', nompro
255 write (ulsort,texte(langue,2)) codret
259 #ifdef _DEBUG_HOMARD_
260 write (ulsort,texte(langue,1)) 'Sortie', nompro