src/tool/Suivi_Frontiere/sffa01.F

   1       subroutine sffa01 ( nouvno, coopro,
   2      >                    lenoeu,
   3      >                    coonoe,
   4      >                    cencyl, axecyl, raycyl,
   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 01 - cylindre
  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 . cencyl . e   .  sdim  . origine de l'axe du cylindre               .
  37 c . axecyl . e   .  sdim  . axe du cylindre                            .
  38 c . raycyl . e   .    1   . rayon du cylindre                          .
  39 c . langue . e   .    1   . langue des messages                        .
  40 c .        .     .        . 1 : francais, 2 : anglais                  .
  41 c . codret . es  .    1   . code de retour des modules                 .
  42 c .        .     .        . 0 : pas de probleme                        .
  43 c .        .     .        . x : probleme                               .
  44 c ______________________________________________________________________
  45 c
  46 c====
  47 c 0. declarations et dimensionnement
  48 c====
  49 c
  50 c 0.1. ==> generalites
  51 c
  52       implicit none
  53       save
  54 c
  55       character*6 nompro
  56       parameter ( nompro = 'SFFA01' )
  57 c
  58 #include "nblang.h"
  59 c
  60 c 0.2. ==> communs
  61 c
  62 #include "envex1.h"
  63 #include "envca1.h"
  64 c
  65 c 0.3. ==> arguments
  66 c
  67       integer lenoeu
  68       integer nouvno
  69 c
  70       double precision coonoe(nouvno,sdim)
  71       double precision coopro(sdim)
  72       double precision cencyl(sdim), axecyl(sdim), raycyl
  73 c
  74       integer ulsort, langue, codret
  75 c
  76 c 0.4. ==> variables locales
  77 c
  78       integer iaux
  79 c
  80       double precision vectca(3)
  81       double precision daux1(3)
  82       double precision daux
  83 c
  84       integer nbmess
  85       parameter ( nbmess = 10 )
  86       character*80 texte(nblang,nbmess)
  87 c
  88 c 0.5. ==> initialisations
  89 c ______________________________________________________________________
  90 c
  91 c====
  92 c 1. initialisations
  93 c====
  94 c
  95 #include "impr01.h"
  96 c
  97 #ifdef _DEBUG_HOMARD_
  98       write (ulsort,texte(langue,1)) 'Entree', nompro
  99       call dmflsh (iaux)
 100 #endif
 101 c
 102 c 1.1. ==> messages
 103 c
 104       texte(1,4) = '(''Axe du cylindre    :'',3g17.9)'
 105       texte(1,5) = '(''Centre du cylindre :'',3g17.9)'
 106       texte(1,6) = '(''Rayon du cylindre  :'',g17.9)'
 107       texte(1,7) = '(''Noeud '',i8,'' :'',3g17.9)'
 108       texte(1,8) = '(''Coordonnees initiales :'',3g17.9)'
 109       texte(1,9) = '(''Coordonnees projetees :'',3g17.9)'
 110 c
 111       texte(2,4) = '(''Axis of the cylindre  :'',3g17.9)'
 112       texte(2,5) = '(''Center of the cylindre:'',3g17.9)'
 113       texte(2,6) = '(''Radius of the cylindre:'',g17.9)'
 114       texte(2,7) = '(''Node '',i8,'' :'',3g17.9)'
 115       texte(2,8) = '(''Initial coordonnates:'',3g17.9)'
 116       texte(2,9) = '(''Moved coordonnates  :'',3g17.9)'
 117 c
 118 #include "impr03.h"
 119 c
 120 #ifdef _DEBUG_HOMARD_
 121       if ( lenoeu.eq.-113 .or.lenoeu.eq.-13 ) then
 122       write (ulsort,texte(langue,4)) (axecyl(iaux), iaux = 1 , sdim)
 123       write (ulsort,texte(langue,5)) (cencyl(iaux), iaux = 1 , sdim)
 124       write (ulsort,texte(langue,6)) raycyl
 125       endif
 126 #endif
 127 #ifdef _DEBUG_HOMARD_
 128       if ( lenoeu.eq.-113 .or.lenoeu.eq.-13 ) then
 129       write (ulsort,texte(langue,7))
 130      > lenoeu, (coonoe(lenoeu,iaux),iaux=1,sdim)
 131       endif
 132 #endif
 133 c
 134 c 1.2. ==> Tout va bien a priori
 135 c
 136       codret = 0
 137 c
 138 c====
 139 c 2. Projection
 140 c====
 141 c 2.1. ==> daux = produit scalaire de CM avec l'axe
 142 c          daux = CM * axe = ( OmegaM - OmegaC ) * axe
 143 c
 144 c                             x  M
 145 c                          .  .
 146 c                       .     .
 147 c                    .        .
 148 c                 .           .
 149 c              .              .
 150 c       C   .                 . A
 151 c     ---x--------------------x------------------
 152 c        <-------------------->
 153 c              daux
 154 c
 155 cgn      if ( lenoeu.eq.-113 .or.lenoeu.eq.-13 ) then
 156 cgn        write (ulsort,90004) 'vectcm',
 157 cgn     >((coonoe(lenoeu,iaux)-cencyl(iaux)),iaux=1,sdim)
 158 cgn      endif
 159       daux = 0.d0
 160       do 21 , iaux = 1 , sdim
 161         daux = daux
 162      >       + (coonoe(lenoeu,iaux)-cencyl(iaux)) * axecyl(iaux)
 163    21 continue
 164 cgn      if ( lenoeu.eq.-113 .or.lenoeu.eq.-13 ) then
 165 cgn        write (ulsort,90004) 'daux',daux
 166 cgn      endif
 167 c
 168 c 2.2. ==> Vecteur CA = daux * vect(axe)
 169 c
 170       do 22 , iaux = 1 , sdim
 171         vectca(iaux) = daux * axecyl(iaux)
 172    22 continue
 173 cgn      if ( lenoeu.eq.-113 .or.lenoeu.eq.-13 ) then
 174 cgn        write (ulsort,90004) 'vectca',(vectca(iaux),iaux=1,sdim)
 175 cgn      endif
 176 c
 177 c 2.3. ==> Vecteur AM = CM - CA = ( OmegaM - OmegaC ) - CA
 178 c
 179       do 23 , iaux = 1 , sdim
 180         daux1(iaux) = coonoe(lenoeu,iaux)
 181      >              - cencyl(iaux)
 182      >              - vectca(iaux)
 183    23 continue
 184 cgn      if ( lenoeu.eq.-113 .or.lenoeu.eq.-13 ) then
 185 cgn        write (ulsort,90004) 'vectAM',(daux1(iaux),iaux=1,sdim)
 186 cgn      endif
 187 c
 188 c 2.4. ==> Rayon pour le point M avant projection
 189 c
 190       daux = 0.d0
 191       do 24 , iaux = 1 , sdim
 192         daux = daux + daux1(iaux)*daux1(iaux)
 193    24 continue
 194       daux = sqrt(daux)
 195 cgn      if ( lenoeu.eq.-113 .or.lenoeu.eq.-13 ) then
 196 cgn        write (ulsort,90004) 'AM',daux
 197 cgn      endif
 198 c
 199 c 2.5. ==> Vecteur AP = (Rayon cylindre/dist(AM)) * Vecteur AM
 200 c
 201       daux = raycyl / daux
 202       do 25 , iaux = 1 , sdim
 203         daux1(iaux) = daux *daux1(iaux)
 204    25 continue
 205 cgn      if ( lenoeu.eq.-113 .or.lenoeu.eq.-13 ) then
 206 cgn        write (ulsort,90004) 'vectAP',(daux1(iaux),iaux=1,sdim)
 207 cgn      endif
 208 c
 209 c 2.6. ==> Coordonnees projetees : OmegaP = OmegaC + CD + DP
 210 c
 211       do 26 , iaux = 1 , sdim
 212         coopro(iaux) = cencyl(iaux) + vectca(iaux) + daux1(iaux)
 213    26 continue
 214 #ifdef _DEBUG_HOMARD_
 215       if ( lenoeu.eq.-113 .or.lenoeu.eq.-13 ) then
 216       write (ulsort,texte(langue,9)) (coopro(iaux), iaux = 1 , sdim)
 217       endif
 218 #endif
 219 c
 220 c====
 221 c 3. la fin
 222 c====
 223 c
 224       if ( codret.ne.0 ) then
 225 c
 226 #include "envex2.h"
 227 c
 228       write (ulsort,texte(langue,1)) 'Sortie', nompro
 229       write (ulsort,texte(langue,2)) codret
 230 c
 231       endif
 232 c
 233 #ifdef _DEBUG_HOMARD_
 234       write (ulsort,texte(langue,1)) 'Sortie', nompro
 235       call dmflsh (iaux)
 236 #endif
 237 c
 238       end