src/tool/Suivi_Frontiere/sfcoi1.F

   1       subroutine sfcoi1 ( nbfran, casfre,
   2      >                    ulsort, langue, codret)
   3 c ______________________________________________________________________
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c   Suivi de Frontiere : COnversions Initiales - phase 1
  23 c   --                   --          -                 -
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . nbfran . e   .   1    . nombre de frontieres analytiques           .
  29 c . casfre . es  .13nbfran. caracteristiques des frontieres analytiques.
  30 c .        .     .        . 1 : 1., si cylindre                        .
  31 c .        .     .        .     2., si sphere                          .
  32 c .        .     .        .     3., si cone par  origine, axe et angle .
  33 c .        .     .        .     4., si cone par 2 centres et 2 rayons  .
  34 c .        .     .        .     5., si tore                            .
  35 c .        .     .        . de 2 a 13 :                                .
  36 c .        .     .        . . cylindre : 2,3,4 : xcentr, ycentr, zcentr.
  37 c .        .     .        .              5,6,7 : xaxe, yaxe, zaxe      .
  38 c .        .     .        .              8 :     rayon                 .
  39 c .        .     .        . . sphere   : 2,3,4 : xcentr, ycentr, zcentr.
  40 c .        .     .        .              8 :     rayon                 .
  41 c .        .     .        . . cone     : 2,3,4 : xcentr, ycentr, zcentr.
  42 c .        .     .        .              5,6,7 : xaxe, yaxe, zaxe      .
  43 c .        .     .        .              13 :    angle en degre        .
  44 c .        .     .        . . cone 2   : 2,3,4 : xcentr, ycentr, zcentr.
  45 c .        .     .        .              5,6,7 : xaxe, yaxe, zaxe      .
  46 c .        .     .        .              8 :     rayon                 .
  47 c .        .     .        .              9,10,11:xcent2, ycent2, zcent2.
  48 c .        .     .        .              12 :    rayon2                .
  49 c .        .     .        .              13 :    angle en degre/radian .
  50 c .        .     .        . . tore     : 2,3,4 : xcentr, ycentr, zcentr.
  51 c .        .     .        .              5,6,7 : xaxe, yaxe, zaxe      .
  52 c .        .     .        .              8 :     rayon de revolution   .
  53 c .        .     .        .              12 :    rayon primaire        .
  54 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  55 c . langue . e   .    1   . langue des messages                        .
  56 c .        .     .        . 1 : francais, 2 : anglais                  .
  57 c . codret . es  .    1   . code de retour des modules                 .
  58 c .        .     .        . 0 : pas de probleme                        .
  59 c .        .     .        . x : probleme                               .
  60 c ______________________________________________________________________
  61 c
  62 c====
  63 c 0. declarations et dimensionnement
  64 c====
  65 c
  66 c 0.1. ==> generalites
  67 c
  68       implicit none
  69       save
  70 c
  71       character*6 nompro
  72       parameter ( nompro = 'SFCOI1' )
  73 c
  74 #include "nblang.h"
  75 #include "consta.h"
  76 c
  77 c 0.2. ==> communs
  78 c
  79 #include "envex1.h"
  80 #include "precis.h"
  81 c
  82 c 0.3. ==> arguments
  83 c
  84       integer nbfran
  85 c
  86       double precision casfre(13,nbfran)
  87 c
  88       integer ulsort, langue, codret
  89 c
  90 c 0.4. ==> variables locales
  91 c
  92       integer iaux
  93       integer tyfran
  94 c
  95       double precision epsid2
  96       double precision daux
  97       double precision xa, ya, za, ra
  98       double precision xb, yb, zb, rb
  99 c
 100       integer nbmess
 101       parameter ( nbmess = 10 )
 102       character*80 texte(nblang,nbmess)
 103 c
 104       character*24 messag(nblang,4)
 105 c
 106 c 0.5. ==> initialisations
 107 c ______________________________________________________________________
 108 c
 109 c====
 110 c 1. messages
 111 c====
 112 c
 113 #include "impr01.h"
 114 c
 115 #ifdef _DEBUG_HOMARD_
 116       write (ulsort,texte(langue,1)) 'Entree', nompro
 117       call dmflsh (iaux)
 118 #endif
 119 c
 120       texte(1,4) = '(''Nombre de frontiere(s) analytique(s) :'',i8)'
 121       texte(1,5) = '(''Type de la frontiere : '',a)'
 122       texte(1,6) = '(''La definition de l''''axe est invalide.'')'
 123 c
 124       texte(2,4) = '(''Number of analytical boundarie(s):'',i8)'
 125       texte(2,5) = '(''Type of boundary: '',a)'
 126       texte(2,6) = '(''The definition of the axis is not valid.'')'
 127 c
 128 #include "impr03.h"
 129 c                    123456789012345678901234
 130       messag(1,1) = 'Cylindre                '
 131       messag(1,2) = 'Sphere                  '
 132       messag(1,3) = 'Cone (origine-axe-angle)'
 133       messag(1,4) = 'Cone (2 centres+rayons) '
 134 c
 135       messag(2,1) = 'Cylindre                '
 136       messag(2,2) = 'Sphere                  '
 137       messag(2,3) = 'Cone (o-axis-angle)     '
 138       messag(2,4) = 'Cone (2 centres+radius) '
 139 c
 140       codret = 0
 141 c
 142       epsid2 = max(1.d-14,epsima)
 143 c
 144 c====
 145 c 2. boucle sur les frontieres enregistrees
 146 c====
 147 c
 148 #ifdef _DEBUG_HOMARD_
 149       write (ulsort,texte(langue,4)) nbfran
 150 #endif
 151 c
 152       do 20 , iaux = 1 , nbfran
 153 c
 154         if ( codret.eq.0 ) then
 155 c
 156         tyfran = nint(casfre(1,iaux))
 157 #ifdef _DEBUG_HOMARD_
 158         write (ulsort,texte(langue,5)) messag(langue,tyfran)
 159 #endif
 160 c
 161 c 2.1. ==> Creation de l'origine, de l'axe et de l'angle pour un cone
 162 c          defini par deux rayons.
 163 c
 164         if ( tyfran.eq.4 ) then
 165 c
 166 c
 167 c         o
 168 c         !    .
 169 c         !        .
 170 c       RA!            .
 171 c         !                o
 172 c         !              RB!   .
 173 c         !                !       .
 174 c         A----------------B----------O
 175 c
 176 c   Thales : RA/RB = AO/BO  ==> BO = AB*RB/(RA-RB)
 177 c   Angle  : tg(alpha) = RA/AO
 178 c
 179 c 2.1.1. ==> Positionnement de A vers B, avec RA>RB
 180 c
 181           if ( casfre(8,iaux) .gt. casfre(12,iaux) ) then
 182             xa = casfre( 2,iaux)
 183             ya = casfre( 3,iaux)
 184             za = casfre( 4,iaux)
 185             ra = casfre( 8,iaux)
 186             xb = casfre( 9,iaux)
 187             yb = casfre(10,iaux)
 188             zb = casfre(11,iaux)
 189             rb = casfre(12,iaux)
 190           else
 191             xa = casfre( 9,iaux)
 192             ya = casfre(10,iaux)
 193             za = casfre(11,iaux)
 194             ra = casfre(12,iaux)
 195             xb = casfre( 2,iaux)
 196             yb = casfre( 3,iaux)
 197             zb = casfre( 4,iaux)
 198             rb = casfre( 8,iaux)
 199           endif
 200 cgn          write (ulsort,90004) 'A', xa, ya, za
 201 cgn          write (ulsort,90004) 'B', xb, yb, zb
 202 c
 203 c 2.1.2. ==> Axe : relie les deux centres, de A vers B
 204 c            L'axe est normalise
 205 c
 206           casfre(5,iaux) = xb - xa
 207           casfre(6,iaux) = yb - ya
 208           casfre(7,iaux) = zb - za
 209           daux = sqrt(casfre(5,iaux)**2
 210      >              + casfre(6,iaux)**2
 211      >              + casfre(7,iaux)**2)
 212           casfre(5,iaux) = casfre(5,iaux)/daux
 213           casfre(6,iaux) = casfre(6,iaux)/daux
 214           casfre(7,iaux) = casfre(7,iaux)/daux
 215 c
 216 c 2.1.3. ==> Origine : mise dans le centre
 217 c
 218 cgn          write (ulsort,90004) 'AB', daux
 219           daux = daux * rb / (ra-rb)
 220 cgn          write (ulsort,90004) 'AB* rb / (ra-rb)', daux
 221           casfre(2,iaux) = xb + daux*casfre(5,iaux)
 222           casfre(3,iaux) = yb + daux*casfre(6,iaux)
 223           casfre(4,iaux) = zb + daux*casfre(7,iaux)
 224 c
 225 c 2.1.4. ==> Angle en radian
 226 c
 227 cgn          write (ulsort,90004) 'AO',sqrt((casfre(2,iaux)-xa)**2
 228 cgn     >                   + (casfre(3,iaux)-ya)**2
 229 cgn     >                   + (casfre(4,iaux)-za)**2 )
 230           daux = ra / sqrt((casfre(2,iaux)-xa)**2
 231      >                   + (casfre(3,iaux)-ya)**2
 232      >                   + (casfre(4,iaux)-za)**2 )
 233           casfre(13,iaux) = atan(daux)
 234 #ifdef _DEBUG_HOMARD_
 235           write (ulsort,90004) 'X centre', casfre( 2,iaux)
 236           write (ulsort,90004) 'Y centre', casfre( 3,iaux)
 237           write (ulsort,90004) 'Z centre', casfre( 4,iaux)
 238           write (ulsort,90004) 'X axe   ', casfre(5,iaux)
 239           write (ulsort,90004) 'Y axe   ', casfre(6,iaux)
 240           write (ulsort,90004) 'Z axe   ', casfre(7,iaux)
 241           write (ulsort,90004) 'Angle   ', casfre(13,iaux)*180.d0/pi
 242 #endif
 243 c
 244         endif
 245 c
 246 c 2.2. ==> Normalisation de l'axe
 247 c
 248         if ( tyfran.eq.1 .or. tyfran.eq.3 ) then
 249 c
 250           daux = casfre(5,iaux)**2
 251      >         + casfre(6,iaux)**2
 252      >         + casfre(7,iaux)**2
 253           if ( daux.le.epsid2 ) then
 254             write (ulsort,texte(langue,6))
 255             codret = 22
 256           else
 257             daux = 1.d0/sqrt(daux)
 258             casfre(5,iaux) = casfre(5,iaux)*daux
 259             casfre(6,iaux) = casfre(6,iaux)*daux
 260             casfre(7,iaux) = casfre(7,iaux)*daux
 261           endif
 262 #ifdef _DEBUG_HOMARD_
 263           write (ulsort,90004) 'X axe   ', casfre(5,iaux)
 264           write (ulsort,90004) 'Y axe   ', casfre(6,iaux)
 265           write (ulsort,90004) 'Z axe   ', casfre(7,iaux)
 266 #endif
 267 c
 268         endif
 269 c
 270 c 2.3. ==> Angle en degre/radian
 271 c
 272         if ( tyfran.eq.3 ) then
 273 c
 274           casfre(13,iaux) = casfre(13,iaux)*pi/180.d0
 275 #ifdef _DEBUG_HOMARD_
 276           write (ulsort,90004) 'Angle   ', casfre(13,iaux)*180.d0/pi
 277 #endif
 278 c
 279         endif
 280 c
 281         endif
 282 c
 283    20 continue
 284 c
 285 c====
 286 c 3. La fin
 287 c====
 288 c
 289       if ( codret.ne.0 ) then
 290 c
 291 #include "envex2.h"
 292 c
 293       write (ulsort,texte(langue,1)) 'Sortie', nompro
 294       write (ulsort,texte(langue,2)) codret
 295 c
 296       endif
 297 c
 298 #ifdef _DEBUG_HOMARD_
 299       write (ulsort,texte(langue,1)) 'Sortie', nompro
 300       call dmflsh (iaux)
 301 #endif
 302 c
 303       end