src/tool/Decision/deinz0.F

   1       subroutine deinz0 ( option,
   2      >                    xmin, xmax,
   3      >                    ymin, ymax,
   4      >                    zmin, zmax,
   5      >                    coonoe, dimcst, coocst,
   6      >                    nozone,
   7      >                    ulsort, langue, codret )
   8 c ______________________________________________________________________
   9 c
  10 c                             H O M A R D
  11 c
  12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  13 c
  14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  15 c aupres des huissiers de justice Simart et Lavoir a Clamart
  16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  17 c aupres des huissiers de justice
  18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  19 c
  20 c    HOMARD est une marque deposee d'Electricite de France
  21 c
  22 c Copyright EDF 1996
  23 c Copyright EDF 1998
  24 c Copyright EDF 2002
  25 c Copyright EDF 2020
  26 c ______________________________________________________________________
  27 c
  28 c traitement des DEcisions - INitialisation de l'indicateur
  29 c                --          --
  30 c                                defini par des Zones de raffinement
  31 c                                               -
  32 c     phase 0 : boite parallelepipedique
  33 c           -
  34 c ______________________________________________________________________
  35 c .        .     .        .                                            .
  36 c .  nom   . e/s . taille .           description                      .
  37 c .____________________________________________________________________.
  38 c . option . e   .    1   . 1 : raffinement, -1 : deraffinement        .
  39 c .xmin/max. e   .    1   . caracteristiques du parallelepipede        .
  40 c .ymin/max.     .        .                                            .
  41 c .zmin/max.     .        .                                            .
  42 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  43 c . dimcst . e   .    1   . dimension de la coordonnee constante       .
  44 c .        .     .        . eventuelle, 0 si toutes varient            .
  45 c . coocst . e   .   11   . 1 : coordonnee constante eventuelle        .
  46 c .        .     .        . 2, 3, 4 : xmin, ymin, zmin                 .
  47 c .        .     .        . 5, 6, 7 : xmax, ymax, zmax                 .
  48 c .        .     .        . 8, 9, 10 : -1 si constant, max-min sinon   .
  49 c .        .     .        . 11 : max des (max-min)                     .
  50 c . nozone . aux . nbnoto . auxiliaire pour le transfert zone/noeud    .
  51 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  52 c . langue . e   .    1   . langue des messages                        .
  53 c .        .     .        . 1 : francais, 2 : anglais                  .
  54 c . codret . es  .    1   . code de retour des modules                 .
  55 c .        .     .        . 0 : pas de probleme                        .
  56 c .        .     .        . 2 : probleme dans le traitement            .
  57 c ______________________________________________________________________
  58 c
  59 c====
  60 c 0. declarations et dimensionnement
  61 c====
  62 c
  63 c 0.1. ==> generalites
  64 c
  65       implicit none
  66       save
  67 c
  68       character*6 nompro
  69       parameter ( nompro = 'DEINZ0' )
  70 c
  71 #include "nblang.h"
  72 c
  73 c 0.2. ==> communs
  74 c
  75 #include "envex1.h"
  76 c
  77 #include "envca1.h"
  78 #include "nombno.h"
  79 c
  80 c 0.3. ==> arguments
  81 c
  82       integer option
  83       integer dimcst
  84       integer nozone(nbnoto)
  85 c
  86       double precision xmin, xmax, ymin, ymax, zmin, zmax
  87       double precision coonoe(nbnoto,sdim)
  88       double precision coocst(11)
  89 c
  90       integer ulsort, langue, codret
  91 c
  92 c 0.4. ==> variables locales
  93 c
  94       integer iaux, jaux
  95 c
  96       double precision daux
  97       double precision xminlo, xmaxlo, yminlo, ymaxlo, zminlo, zmaxlo
  98 c
  99       integer nbmess
 100       parameter (nbmess = 10 )
 101       character*80 texte(nblang,nbmess)
 102 c
 103 c 0.5. ==> initialisations
 104 c ______________________________________________________________________
 105 #ifdef _DEBUG_HOMARD_
 106       character*1 saux01(3)
 107       data saux01 / 'X', 'Y', 'Z' /
 108 #endif
 109 c
 110 c====
 111 c 1. initialisation
 112 c====
 113 c
 114 #include "impr01.h"
 115 c
 116 #ifdef _DEBUG_HOMARD_
 117       write (ulsort,texte(langue,1)) 'Entree', nompro
 118       call dmflsh (iaux)
 119 #endif
 120 c
 121       texte(1,4) = '(''Zone parellepipedique'')'
 122       texte(1,5) = '(''Prise en compte du noeud '',i10,3g15.7)'
 123 c
 124       texte(2,4) = '(''Zone as a brick'')'
 125       texte(2,5) = '(''OK for node # '',i10,3g15.7)'
 126 c
 127 #include "impr03.h"
 128 c
 129 #ifdef _DEBUG_HOMARD_
 130       write (ulsort,texte(langue,4))
 131       write (ulsort,90034) 'Xmin', xmin, 'Xmax', xmax
 132       write (ulsort,90034) 'Ymin', ymin, 'Ymax', ymax
 133       write (ulsort,90034) 'Zmin', zmin, 'Zmax', zmax
 134       write (ulsort,90002) 'sdim', sdim
 135       write (ulsort,90002) 'dimcst', dimcst
 136       if ( dimcst.ne.0 ) then
 137       write (ulsort,90004) saux01(dimcst)//' constant', coocst(dimcst+1)
 138       endif
 139       write (ulsort,90002) 'maextr', maextr
 140 #endif
 141 c
 142 c====
 143 c 2. Du vrai 3D
 144 c====
 145 c
 146       if ( sdim.eq.3 ) then
 147 c
 148         do 21 , iaux = 1, nbnoto
 149 c
 150 #ifdef _DEBUG_HOMARD_
 151         write(ulsort,90004) 'X', coonoe(iaux,1), xmin, xmax
 152         write(ulsort,90004) 'Y', coonoe(iaux,2), ymin, ymax
 153         write(ulsort,90004) 'Z', coonoe(iaux,3), zmin, zmax
 154 #endif
 155           if ( coonoe(iaux,1).lt.xmin ) then
 156             goto 21
 157           elseif ( coonoe(iaux,1).gt.xmax ) then
 158             goto 21
 159           elseif ( coonoe(iaux,2).lt.ymin ) then
 160             goto 21
 161           elseif ( coonoe(iaux,2).gt.ymax ) then
 162             goto 21
 163           elseif ( coonoe(iaux,3).lt.zmin ) then
 164             goto 21
 165           elseif ( coonoe(iaux,3).gt.zmax ) then
 166             goto 21
 167           endif
 168 #ifdef _DEBUG_HOMARD_
 169           write(ulsort,texte(langue,5)) iaux,
 170      >    coonoe(iaux,1), coonoe(iaux,2), coonoe(iaux,3)
 171 #endif
 172           nozone(iaux) = option
 173 c
 174    21   continue
 175 c
 176 c====
 177 c 3. Du vrai 2D ou du 2D defini dans un espace 3D
 178 c    . Avec du vrai 2D, on part du principe que Z est nul
 179 c    . Avec du 2D immerge, on repere
 180 c    . On verifie que la coordonnee constante est compatible,
 181 c      avec une certaine tolerance
 182 c====
 183 c
 184       else
 185 c
 186         if ( ( dimcst.eq.0 .or. dimcst.eq.3 ) .and.
 187      >       ( maextr.eq.0 .or. maextr.eq.3 ) ) then
 188           xminlo = xmin
 189           xmaxlo = xmax
 190           yminlo = ymin
 191           ymaxlo = ymax
 192           zminlo = zmin
 193           zmaxlo = zmax
 194           jaux = 4
 195           daux = max(coocst(8), coocst(9))
 196         elseif ( dimcst.eq.1 .or. maextr.eq.1 ) then
 197           xminlo = ymin
 198           xmaxlo = ymax
 199           yminlo = zmin
 200           ymaxlo = zmax
 201           zminlo = xmin
 202           zmaxlo = xmax
 203           jaux = 2
 204           daux = max(coocst(9), coocst(10))
 205         elseif ( dimcst.eq.2 .or. maextr.eq.2 ) then
 206           xminlo = xmin
 207           xmaxlo = xmax
 208           yminlo = zmin
 209           ymaxlo = zmax
 210           zminlo = ymin
 211           zmaxlo = ymax
 212           jaux = 3
 213           daux = max(coocst(10), coocst(8))
 214         endif
 215 c
 216 #ifdef _DEBUG_HOMARD_
 217       write (ulsort,texte(langue,4))
 218       write (ulsort,90034) 'Xminlo', xminlo, 'Xmaxlo', xmaxlo
 219       write (ulsort,90034) 'Yminlo', yminlo, 'Ymaxlo', ymaxlo
 220       write (ulsort,90034) 'Zminlo', zminlo, 'Zmaxlo', zmaxlo
 221 #endif
 222 c
 223         daux = 1.d-4*daux
 224         if ( zminlo.gt.coocst(jaux)+daux .or.
 225      >       zmaxlo.lt.coocst(jaux)-daux ) then
 226           goto 310
 227         endif
 228 c
 229         do 31 , iaux = 1, nbnoto
 230 c
 231           if ( coonoe(iaux,1).lt.xminlo ) then
 232             goto 31
 233           elseif ( coonoe(iaux,1).gt.xmaxlo ) then
 234             goto 31
 235           elseif ( coonoe(iaux,2).lt.yminlo ) then
 236             goto 31
 237           elseif ( coonoe(iaux,2).gt.ymaxlo ) then
 238             goto 31
 239           endif
 240 #ifdef _DEBUG_HOMARD_
 241           write(ulsort,texte(langue,5)) iaux,
 242      >             coonoe(iaux,1), coonoe(iaux,2)
 243 #endif
 244           nozone(iaux) = option
 245 c
 246    31   continue
 247 c
 248   310   continue
 249 c
 250       endif
 251 c
 252 c====
 253 c 4. la fin
 254 c====
 255 c
 256       if ( codret.ne.0 ) then
 257 c
 258 #include "envex2.h"
 259       write (ulsort,texte(langue,1)) 'Sortie', nompro
 260       write (ulsort,texte(langue,2)) codret
 261 c
 262       endif
 263 c
 264 #ifdef _DEBUG_HOMARD_
 265       write (ulsort,texte(langue,1)) 'Sortie', nompro
 266       call dmflsh (iaux)
 267 #endif
 268 c
 269       end