1 subroutine sffa05 ( nouvno, coopro,
4 > centor, axetor, rayrev, raypri,
5 > ulsort, langue, codret )
6 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 Suivi de Frontiere - Frontiere Analytique - type 05 - tore
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . nouvno . e . 1 . dernier numero de noeud cree .
32 c . coopro . s . sdim . nouvelles coordonnees du noeud .
33 c . lenoeu . e . 1 . noeud en cours d'examen .
34 c . coonoe . e . nouvno . coordonnees des noeuds .
36 c . centor . e . sdim . origine de l'axe du tore .
37 c . axetor . e . sdim . axe du tore .
38 c . rayrev . e . 1 . rayon de revolution du tore .
39 c . raypri . e . 1 . rayon primaire du tore .
40 c . langue . e . 1 . langue des messages .
41 c . . . . 1 : francais, 2 : anglais .
42 c . codret . es . 1 . code de retour des modules .
43 c . . . . 0 : pas de probleme .
44 c . . . . x : probleme .
45 c ______________________________________________________________________
48 c 0. declarations et dimensionnement
51 c 0.1. ==> generalites
57 parameter ( nompro = 'SFFA05' )
71 double precision coonoe(nouvno,sdim)
72 double precision coopro(sdim)
73 double precision centor(sdim), axetor(sdim)
74 double precision rayrev, raypri
76 integer ulsort, langue, codret
78 c 0.4. ==> variables locales
82 double precision vectnp(3)
83 double precision vectca(3)
84 double precision daux1(3)
88 parameter ( nbmess = 10 )
89 character*80 texte(nblang,nbmess)
91 c 0.5. ==> initialisations
92 c ______________________________________________________________________
100 #ifdef _DEBUG_HOMARD_
101 write (ulsort,texte(langue,1)) 'Entree', nompro
107 texte(1,4) = '(''Axe du tore :'',3g16.9)'
108 texte(1,5) = '(''Centre du tore :'',3g16.9)'
109 texte(1,6) = '(''Rayon de revolution :'',g16.9)'
110 texte(1,7) = '(''Rayon primaire :'',g16.9)'
111 texte(1,8) = '(''Noeud '',i8,'' :'',3g16.9)'
112 texte(1,9) = '(''Coordonnees initiales :'',3g16.9)'
113 texte(1,10) = '(''Coordonnees projetees :'',3g16.9)'
115 texte(2,4) = '(''Axis of the torus :'',3g16.9)'
116 texte(2,5) = '(''Center of the torus:'',3g16.9)'
117 texte(2,6) = '(''Revolution radius :'',g16.9)'
118 texte(2,7) = '(''Primary radius :'',g16.9)'
119 texte(2,8) = '(''Node '',i8,'' :'',3g16.9)'
120 texte(2,9) = '(''Initial coordonnates:'',3g16.9)'
121 texte(2,10) = '(''Moved coordonnates :'',3g16.9)'
123 cgn 1001 format(a,' :',3g16.9)
125 #ifdef _DEBUG_HOMARD_
126 write (ulsort,texte(langue,4)) (axetor(iaux), iaux = 1 , sdim)
127 write (ulsort,texte(langue,5)) (centor(iaux), iaux = 1 , sdim)
128 write (ulsort,texte(langue,6)) rayrev
129 write (ulsort,texte(langue,7)) raypri
131 #ifdef _DEBUG_HOMARD_
132 write (ulsort,texte(langue,8))
133 > lenoeu, (coonoe(lenoeu,iaux),iaux=1,sdim)
136 c 1.2. ==> Tout va bien a priori
143 c La figure est dans le plan de l'axe et du point M.
144 c Le vecteur normal qui s'enfonce dans le plan est : u = axe x CM
145 c Le point A est l'intersection de ce plan avec le cercle de revolution
146 c Le vecteur CA est colineaire au produit vectoriel u x axe
158 c C |----------------------x----------->
161 c 2.1. ==> vectnp = vecteur normal au plan
162 c produit vectoriel de l'axe avec CM
163 c = axe x CM = axe x ( OmegaM - OmegaC )
165 do 21 , iaux = 1 , sdim
166 daux1(iaux) = coonoe(lenoeu,iaux) - centor(iaux)
169 vectnp(1) = axetor(2)*daux1(3) - axetor(3)*daux1(2)
170 vectnp(2) = axetor(3)*daux1(1) - axetor(1)*daux1(3)
171 vectnp(3) = axetor(1)*daux1(2) - axetor(2)*daux1(1)
172 cgn write (ulsort,1001) 'vectnp',vectnp
174 c 2.2. ==> Vecteur CA = vectnp x vect(axe)
176 vectca(1) = vectnp(2)*axetor(3) - vectnp(3)*axetor(2)
177 vectca(2) = vectnp(3)*axetor(1) - vectnp(1)*axetor(3)
178 vectca(3) = vectnp(1)*axetor(2) - vectnp(2)*axetor(1)
181 do 221 , iaux = 1 , sdim
182 daux = daux + vectca(iaux)**2
184 daux = rayrev / sqrt(daux)
186 do 222 , iaux = 1 , sdim
187 vectca(iaux) = vectca(iaux) * daux
189 cgn write (ulsort,1001) 'vectca',(vectca(iaux),iaux=1,sdim)
191 c 2.3. ==> Vecteur AM = CM - CA = ( OmegaM - OmegaC ) - CA
193 do 23 , iaux = 1 , sdim
194 daux1(iaux) = coonoe(lenoeu,iaux)
198 cgn write (ulsort,1001) 'vectAM',(daux1(iaux),iaux=1,sdim)
200 c 2.4. ==> Rayon pour le point M avant projection
203 do 24 , iaux = 1 , sdim
204 daux = daux + daux1(iaux)*daux1(iaux)
207 cgn write (ulsort,1001) 'AM',daux
209 c 2.5. ==> Vecteur AP = (Rayon primaire/dist(AM)) * Vecteur AM
212 do 25 , iaux = 1 , sdim
213 daux1(iaux) = daux *daux1(iaux)
215 cgn write (ulsort,1001) 'vectAP',(daux1(iaux),iaux=1,sdim)
217 c 2.6. ==> Coordonnees projetees : OmegaP = OmegaC + CD + DP
219 do 26 , iaux = 1 , sdim
220 coopro(iaux) = centor(iaux) + vectca(iaux) + daux1(iaux)
222 #ifdef _DEBUG_HOMARD_
223 write (ulsort,texte(langue,10)) (coopro(iaux), iaux = 1 , sdim)
230 if ( codret.ne.0 ) then
234 write (ulsort,texte(langue,1)) 'Sortie', nompro
235 write (ulsort,texte(langue,2)) codret
239 #ifdef _DEBUG_HOMARD_
240 write (ulsort,texte(langue,1)) 'Sortie', nompro