src/tool/Suivi_Frontiere/sffa05.F

   1       subroutine sffa05 ( nouvno, coopro,
   2      >                    lenoeu,
   3      >                    coonoe,
   4      >                    centor, axetor, rayrev, raypri,
   5      >                    ulsort, langue, codret )
   6 c ______________________________________________________________________
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  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
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c   Suivi de Frontiere - Frontiere Analytique - type 05 - tore
  26 c   -        -           -         -                 --
  27 c ______________________________________________________________________
  28 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                     .
  35 c .        .     . *sdim  .                                            .
  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 ______________________________________________________________________
  46 c
  47 c====
  48 c 0. declarations et dimensionnement
  49 c====
  50 c
  51 c 0.1. ==> generalites
  52 c
  53       implicit none
  54       save
  55 c
  56       character*6 nompro
  57       parameter ( nompro = 'SFFA05' )
  58 c
  59 #include "nblang.h"
  60 c
  61 c 0.2. ==> communs
  62 c
  63 #include "envex1.h"
  64 #include "envca1.h"
  65 c
  66 c 0.3. ==> arguments
  67 c
  68       integer lenoeu
  69       integer nouvno
  70 c
  71       double precision coonoe(nouvno,sdim)
  72       double precision coopro(sdim)
  73       double precision centor(sdim), axetor(sdim)
  74       double precision rayrev, raypri
  75 c
  76       integer ulsort, langue, codret
  77 c
  78 c 0.4. ==> variables locales
  79 c
  80       integer iaux
  81 c
  82       double precision vectnp(3)
  83       double precision vectca(3)
  84       double precision daux1(3)
  85       double precision daux
  86 c
  87       integer nbmess
  88       parameter ( nbmess = 10 )
  89       character*80 texte(nblang,nbmess)
  90 c
  91 c 0.5. ==> initialisations
  92 c ______________________________________________________________________
  93 c
  94 c====
  95 c 1. initialisations
  96 c====
  97 c
  98 #include "impr01.h"
  99 c
 100 #ifdef _DEBUG_HOMARD_
 101       write (ulsort,texte(langue,1)) 'Entree', nompro
 102       call dmflsh (iaux)
 103 #endif
 104 c
 105 c 1.1. ==> messages
 106 c
 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)'
 114 c
 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)'
 122 c
 123 cgn 1001 format(a,' :',3g16.9)
 124 c
 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
 130 #endif
 131 #ifdef _DEBUG_HOMARD_
 132       write (ulsort,texte(langue,8))
 133      > lenoeu, (coonoe(lenoeu,iaux),iaux=1,sdim)
 134 #endif
 135 c
 136 c 1.2. ==> Tout va bien a priori
 137 c
 138       codret = 0
 139 c
 140 c====
 141 c 2. Projection
 142 c====
 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
 147 c                        Axe
 148 c                         |
 149 c                         |
 150 c                         |
 151 c                         |
 152 c                         |                                 P
 153 c                         |                                x
 154 c                         |                          M   .
 155 c                         |                            x
 156 c                         |                          .
 157 c                         |                        .
 158 c                       C |----------------------x----------->
 159 c                                                A
 160 c
 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 )
 164 c
 165       do 21 , iaux = 1 , sdim
 166         daux1(iaux) = coonoe(lenoeu,iaux) - centor(iaux)
 167    21 continue
 168 c
 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
 173 c
 174 c 2.2. ==> Vecteur CA = vectnp x vect(axe)
 175 c
 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)
 179 c
 180       daux = 0.d0
 181       do 221 , iaux = 1 , sdim
 182         daux = daux + vectca(iaux)**2
 183   221 continue
 184       daux = rayrev / sqrt(daux)
 185 c
 186       do 222 , iaux = 1 , sdim
 187         vectca(iaux) = vectca(iaux) * daux
 188   222 continue
 189 cgn      write (ulsort,1001) 'vectca',(vectca(iaux),iaux=1,sdim)
 190 c
 191 c 2.3. ==> Vecteur AM = CM - CA = ( OmegaM - OmegaC ) - CA
 192 c
 193       do 23 , iaux = 1 , sdim
 194         daux1(iaux) = coonoe(lenoeu,iaux)
 195      >              - centor(iaux)
 196      >              - vectca(iaux)
 197    23 continue
 198 cgn      write (ulsort,1001) 'vectAM',(daux1(iaux),iaux=1,sdim)
 199 c
 200 c 2.4. ==> Rayon pour le point M avant projection
 201 c
 202       daux = 0.d0
 203       do 24 , iaux = 1 , sdim
 204         daux = daux + daux1(iaux)*daux1(iaux)
 205    24 continue
 206       daux = sqrt(daux)
 207 cgn      write (ulsort,1001) 'AM',daux
 208 c
 209 c 2.5. ==> Vecteur AP = (Rayon primaire/dist(AM)) * Vecteur AM
 210 c
 211       daux = raypri / daux
 212       do 25 , iaux = 1 , sdim
 213         daux1(iaux) = daux *daux1(iaux)
 214    25 continue
 215 cgn      write (ulsort,1001) 'vectAP',(daux1(iaux),iaux=1,sdim)
 216 c
 217 c 2.6. ==> Coordonnees projetees : OmegaP = OmegaC + CD + DP
 218 c
 219       do 26 , iaux = 1 , sdim
 220         coopro(iaux) = centor(iaux) + vectca(iaux) + daux1(iaux)
 221    26 continue
 222 #ifdef _DEBUG_HOMARD_
 223       write (ulsort,texte(langue,10)) (coopro(iaux), iaux = 1 , sdim)
 224 #endif
 225 c
 226 c====
 227 c 3. la fin
 228 c====
 229 c
 230       if ( codret.ne.0 ) then
 231 c
 232 #include "envex2.h"
 233 c
 234       write (ulsort,texte(langue,1)) 'Sortie', nompro
 235       write (ulsort,texte(langue,2)) codret
 236 c
 237       endif
 238 c
 239 #ifdef _DEBUG_HOMARD_
 240       write (ulsort,texte(langue,1)) 'Sortie', nompro
 241       call dmflsh (iaux)
 242 #endif
 243 c
 244       end