src/tool/Decision/deinz2.F

   1       subroutine deinz2 ( option,
   2      >                    rext, rint,
   3      >                    haut,
   4      >                    xaxe, yaxe, zaxe,
   5      >                    xbas, ybas, zbas,
   6      >                    coonoe, dimcst, coocst,
   7      >                    nozone,
   8      >                    ulsort, langue, codret )
   9 c ______________________________________________________________________
  10 c
  11 c                             H O M A R D
  12 c
  13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  14 c
  15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  16 c aupres des huissiers de justice Simart et Lavoir a Clamart
  17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  18 c aupres des huissiers de justice
  19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  20 c
  21 c    HOMARD est une marque deposee d'Electricite de France
  22 c
  23 c Copyright EDF 1996
  24 c Copyright EDF 1998
  25 c Copyright EDF 2002
  26 c Copyright EDF 2020
  27 c ______________________________________________________________________
  28 c
  29 c traitement des DEcisions - INitialisation de l'indicateur
  30 c                --          --
  31 c                                defini par des Zones de raffinement
  32 c                                               -
  33 c     phase 2 : boite cylindrique/tuyau
  34 c           -
  35 c ______________________________________________________________________
  36 c .        .     .        .                                            .
  37 c .  nom   . e/s . taille .           description                      .
  38 c .____________________________________________________________________.
  39 c . option . e   .    1   . 1 : raffinement, -1 : deraffinement        .
  40 c . rext   . e   .    1   . caracteristiques du cylindre/tuyau         .
  41 c . rint   .     .        . Si <0 : cylindre                           .
  42 c . haut   .     .        .                                            .
  43 c .x,y,zaxe.     .        .                                            .
  44 c .x,y,zbas.     .        .                                            .
  45 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  46 c . dimcst . e   .    1   . dimension de la coordonnee constante       .
  47 c .        .     .        . eventuelle, 0 si toutes varient            .
  48 c . coocst . e   .   11   . 1 : coordonnee constante eventuelle        .
  49 c .        .     .        . 2, 3, 4 : xmin, ymin, zmin                 .
  50 c .        .     .        . 5, 6, 7 : xmax, ymax, zmax                 .
  51 c .        .     .        . 8, 9, 10 : -1 si constant, max-min sinon   .
  52 c .        .     .        . 11 : max des (max-min)                     .
  53 c . nozone . aux . nbnoto . auxiliaire pour le transfert zone/noeud    .
  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 .        .     .        . 2 : probleme dans le traitement            .
  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 = 'DEINZ2' )
  73 c
  74 #include "nblang.h"
  75 c
  76 c 0.2. ==> communs
  77 c
  78 #include "envex1.h"
  79 #include "envca1.h"
  80 c
  81 #include "nombno.h"
  82 #include "precis.h"
  83 c
  84 c 0.3. ==> arguments
  85 c
  86       integer option
  87       integer dimcst
  88       integer nozone(nbnoto)
  89 c
  90       double precision rext, rint
  91       double precision haut
  92       double precision xaxe, yaxe, zaxe
  93       double precision xbas, ybas, zbas
  94       double precision coonoe(nbnoto,sdim)
  95       double precision coocst(11)
  96 c
  97       integer ulsort, langue, codret
  98 c
  99 c 0.4. ==> variables locales
 100 c
 101       integer iaux
 102 c
 103       double precision epsid2
 104       double precision daux
 105       double precision vect1(3), vect2(3)
 106       double precision rint2, rext2
 107 c
 108       integer nbmess
 109       parameter (nbmess = 10 )
 110       character*80 texte(nblang,nbmess)
 111 c
 112 c 0.5. ==> initialisations
 113 c ______________________________________________________________________
 114 #ifdef _DEBUG_HOMARD_
 115       character*1 saux01(3)
 116       data saux01 / 'X', 'Y', 'Z' /
 117 #endif
 118 c
 119 c====
 120 c 1. initialisation
 121 c====
 122 c
 123 c 1.1. ==> Les messages
 124 c
 125 #include "impr01.h"
 126 c
 127 #ifdef _DEBUG_HOMARD_
 128       write (ulsort,texte(langue,1)) 'Entree', nompro
 129       call dmflsh (iaux)
 130 #endif
 131 c
 132       texte(1,4) = '(''Zone cylindrique'')'
 133       texte(1,5) = '(''Zone tuyau'')'
 134       texte(1,8) = '(''Prise en compte du noeud '',i10,3g15.7)'
 135       texte(1,9) = '(''La definition de l''''axe est invalide.'')'
 136 c
 137       texte(2,4) = '(''Cylindrical zonek'')'
 138       texte(2,5) = '(''Zone as a brick'')'
 139       texte(2,8) = '(''OK for node # '',i10,3g15.7)'
 140       texte(2,9) = '(''The definition of the axis is not valid.'')'
 141 c
 142 #include "impr03.h"
 143 c
 144 #ifdef _DEBUG_HOMARD_
 145       if ( rint.lt.0 ) then
 146         write (ulsort,texte(langue,4))
 147       else
 148         write (ulsort,texte(langue,5))
 149         write (ulsort,90004) 'Rint', rint
 150       endif
 151       write (ulsort,90004) 'Rext', rext
 152       write (ulsort,90004) 'Hauteur', haut
 153       write (ulsort,90004) 'Xaxe', xaxe
 154       write (ulsort,90004) 'Yaxe', yaxe
 155       write (ulsort,90004) 'Zaxe', zaxe
 156       write (ulsort,90004) 'Xbas', xbas
 157       write (ulsort,90004) 'Ybas', ybas
 158       write (ulsort,90004) 'Zbas', zbas
 159 cgn      write (ulsort,*) 'sdim =',sdim,', dimcst =',dimcst
 160       if ( dimcst.ne.0 ) then
 161       write (ulsort,90004) saux01(dimcst)//' constant', coocst(dimcst+1)
 162       endif
 163 #endif
 164 c
 165 c 1.2 ==> Carre des rayons
 166 c
 167       rext2 = rext*rext
 168 cgn      write (ulsort,90004) '==> rext2', rext2
 169       if ( rint.ge.0 ) then
 170         rint2 = rint*rint
 171 cgn        write (ulsort,90004) '==> rint2', rint2
 172       endif
 173 c
 174 c====
 175 c 2. Normalisation du vecteur de l'axe
 176 c====
 177 c
 178       daux = xaxe*xaxe + yaxe*yaxe + zaxe*zaxe
 179 c
 180       epsid2 = max(1.d-14,epsima)
 181       if ( daux.le.epsid2 ) then
 182         write (ulsort,texte(langue,9))
 183         codret = 2
 184       else
 185         daux = 1.d0 / sqrt( daux )
 186         vect1(1) = xaxe * daux
 187         vect1(2) = yaxe * daux
 188         vect1(3) = zaxe * daux
 189       endif
 190 c
 191 c====
 192 c 3. Du vrai 3D
 193 c====
 194 c
 195       if ( sdim.eq.3 ) then
 196 c
 197         if ( codret.eq.0 ) then
 198 c
 199         do 31 , iaux = 1, nbnoto
 200 c
 201 c          controle du positionnement sur l'axe :
 202 c          la distance a la base est egale au produit
 203 c          scalaire (base-M)xVecteur-axe
 204 c
 205           daux = ( coonoe(iaux,1)-xbas ) * vect1(1)
 206      >         + ( coonoe(iaux,2)-ybas ) * vect1(2)
 207      >         + ( coonoe(iaux,3)-zbas ) * vect1(3)
 208 c
 209           if ( daux.lt.0.d0 .or. daux.gt.haut ) then
 210             goto 31
 211           endif
 212 c
 213 c           controle du rayon :
 214 c           la distance a l'axe est egale a la norme du
 215 c           produit vectoriel (base-M)xVecteur-axe
 216 c
 217           vect2(1) = (coonoe(iaux,2)-ybas)*vect1(3)
 218      >             - (coonoe(iaux,3)-zbas)*vect1(2)
 219           vect2(2) = (coonoe(iaux,3)-zbas)*vect1(1)
 220      >             - (coonoe(iaux,1)-xbas)*vect1(3)
 221           vect2(3) = (coonoe(iaux,1)-xbas)*vect1(2)
 222      >             - (coonoe(iaux,2)-ybas)*vect1(1)
 223           daux = vect2(1)*vect2(1)
 224      >         + vect2(2)*vect2(2)
 225      >         + vect2(3)*vect2(3)
 226 c
 227           if ( daux.lt.rint2 .or. daux.gt.rext2 ) then
 228             goto 31
 229           endif
 230 c
 231 #ifdef _DEBUG_HOMARD_
 232           write(ulsort,texte(langue,8)) iaux,
 233      >    coonoe(iaux,1), coonoe(iaux,2), coonoe(iaux,3)
 234 #endif
 235           nozone(iaux) = option
 236 c
 237    31   continue
 238 c
 239         endif
 240 c
 241 c====
 242 c 4. Du vrai 2D ou du 2D defini dans un espace 3D
 243 c    . Avec du vrai 2D, on part du principe que Z est nul
 244 c    . Avec du 2D immerge, on repere
 245 c    . On verifie que la coordonnee constante est compatible,
 246 c      avec une certaine tolerance
 247 c====
 248 c
 249       else
 250 c
 251         codret = 40
 252 c
 253       endif
 254 c
 255 c====
 256 c 5. la fin
 257 c====
 258 c
 259       if ( codret.ne.0 ) then
 260 c
 261 #include "envex2.h"
 262       write (ulsort,texte(langue,1)) 'Sortie', nompro
 263       write (ulsort,texte(langue,2)) codret
 264 c
 265       endif
 266 c
 267 #ifdef _DEBUG_HOMARD_
 268       write (ulsort,texte(langue,1)) 'Sortie', nompro
 269       call dmflsh (iaux)
 270 #endif
 271 c
 272       end