src/tool/Utilitaire/utb3n3.F

   1       subroutine utb3n3 ( lgboin, boinoe,
   2      >                    coonoe,
   3      >                    nbboit, nbinte,
   4      >                    boimin, boimax )
   5 c ______________________________________________________________________
   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    UTilitaire - Bilan - option 3 - phase N3
  26 c    --           -              -         --
  27 c ______________________________________________________________________
  28 c
  29 c Retourne la liste des boites d'un noeud - 3D
  30 c ______________________________________________________________________
  31 c .        .     .        .                                            .
  32 c .  nom   . e/s . taille .           description                      .
  33 c .____________________________________________________________________.
  34 c . lgboin .  s  .   1    . longueur de boinoe                         .
  35 c . boinoe .  s  .    *   . liste des boites du noeud en cours         .
  36 c . coonoe . e   .  sdim  . coordonnees du noeud                       .
  37 c . nbboit . e   .  sdim  . nombre de boites dans chaque dimension     .
  38 c . nbinte . e   .  sdim  . nombre d'intervalles dans chaque dimension .
  39 c . boimin .  a  .0:nbintx. limite minimale de chaque boite            .
  40 c . boimax .  a  .0:nbintx. limite maximale de chaque boite            .
  41 c .____________________________________________________________________.
  42 c
  43 c====
  44 c 0. declarations et dimensionnement
  45 c====
  46 c
  47 c 0.1. ==> generalites
  48 c
  49       implicit none
  50       save
  51 c
  52       character*6 nompro
  53       parameter ( nompro = 'UTB3N3' )
  54 c
  55 #ifdef _DEBUG_HOMARD_
  56       integer ulsort
  57       parameter ( ulsort = 6 )
  58       integer langue
  59       parameter ( langue = 1 )
  60 #endif
  61 c
  62       integer sdim
  63       parameter ( sdim = 3 )
  64 c
  65 #include "nblang.h"
  66 c
  67 c 0.2. ==> communs
  68 c
  69 c 0.3. ==> arguments
  70 c
  71       integer lgboin, boinoe(*)
  72       integer nbboit(sdim), nbinte(sdim)
  73 c
  74       double precision coonoe(sdim)
  75       double precision boimin(3,0:*), boimax(3,0:*)
  76 c
  77 c 0.4. ==> variables locales
  78 c
  79       integer iaux, jaux
  80       integer nombbo
  81       integer numint(2,3)
  82 c
  83       integer nbmess
  84       parameter (nbmess = 10 )
  85       character*80 texte(nblang,nbmess)
  86 c
  87 c 0.5. ==> initialisations
  88 c
  89 c====
  90 c 1. initialisations
  91 c====
  92 c
  93 #include "impr01.h"
  94 c
  95 #ifdef _DEBUG_HOMARD_
  96       write (ulsort,texte(langue,1)) 'Entree', nompro
  97       call dmflsh (iaux)
  98 #endif
  99 c
 100 #include "impr03.h"
 101 c
 102 c====
 103 c 2. Pour une dimension iaux donnee, on passe en revue tous les
 104 c    intervalles.
 105 c      . Quand on rencontre la premiere limite qui est superieure a
 106 c        la coordonnee, on stocke le numero de l'intervalle
 107 c        dans numint(1,iaux)
 108 c      . Sachant que les limites sont legerement recouvrantes, on
 109 c        regarde si la coordonnee n'est pas superieure au minima de
 110 c        l'intervalle suivant. Si oui, on stocke le numero de
 111 c        l'intervalle suivant dans numint(2,iaux). Sinon,
 112 c        numint(2,iaux) vaut numint(1,iaux).
 113 c
 114 c      numint :       1         2         3         4
 115 c                |         |         |         |         |
 116 c                               x --> 2/0
 117 c                                    x --> 2/3
 118 c====
 119 c
 120       nombbo = 1
 121       do 21 , iaux = 1 , sdim
 122 c
 123         numint(1,iaux) = 0
 124 c
 125         do 211 , jaux = 1 , nbinte(iaux)
 126 cgn     write (ulsort,90014) jaux,boimax(iaux,jaux)
 127           if ( coonoe(iaux).le.boimax(iaux,jaux) ) then
 128             if ( numint(1,iaux).eq.0 ) then
 129               numint(1,iaux) = jaux
 130               numint(2,iaux) = jaux
 131               if ( coonoe(iaux).ge.boimin(iaux,jaux+1) ) then
 132                 numint(2,iaux) = jaux + 1
 133                 nombbo = nombbo*2
 134               endif
 135               goto 21
 136             endif
 137           endif
 138   211   continue
 139         numint(1,iaux) = nbboit(iaux)
 140         numint(2,iaux) = nbboit(iaux)
 141 c
 142    21 continue
 143 cgn          write (ulsort,91020) (numint(1,iaux),iaux=1,sdim)
 144 cgn          write (ulsort,91020) (numint(2,iaux),iaux=1,sdim)
 145 cgn          write (ulsort,90002) 'nombre de boites', nombbo
 146 c
 147 c 2.2. ==>  Increment des pointeurs
 148 c
 149       jaux = nbboit(1)*nbboit(2)
 150 c
 151 c 2.2.1. ==>  La boite principale
 152 c
 153       iaux = jaux*(numint(1,3)-1)
 154      >     + nbboit(1)*(numint(1,2)-1)
 155      >     + numint(1,1)
 156 cgn             write (ulsort,90002) 'b',iaux
 157       lgboin = 1
 158       boinoe(lgboin) = iaux
 159 c
 160 c 2.2.2. ==>  Les boites secondaires
 161 c
 162       if ( nombbo.gt.1 ) then
 163 c
 164         lgboin = 1
 165         boinoe(lgboin) = iaux
 166 c
 167 c           recouvrement en x
 168         iaux = jaux*(numint(1,3)-1)
 169      >       + nbboit(1)*(numint(1,2)-1)
 170      >       + numint(2,1)
 171         if ( iaux.ne.boinoe(1) ) then
 172 cgn          write (ulsort,90002) 'n1',lenoeu
 173 cgn          write (ulsort,90002) 'b1',iaux
 174           lgboin = lgboin + 1
 175           boinoe(lgboin) = iaux
 176         endif
 177 cgn              write (ulsort,91020) (boinoe(jaux),jaux = 1,lgboin)
 178 c
 179 c           recouvrement en y
 180         iaux = jaux*(numint(1,3)-1)
 181      >       + nbboit(1)*(numint(2,2)-1)
 182      >       + numint(1,1)
 183         do 221 , jaux = 1 , lgboin
 184           if ( iaux.eq.boinoe(jaux) ) then
 185             goto 2211
 186           endif
 187   221   continue
 188 cgn            write (ulsort,90002) 'n2',lenoeu
 189 cgn            write (ulsort,90002) 'b2',iaux
 190         lgboin = lgboin + 1
 191         boinoe(lgboin) = iaux
 192 cgn              write (ulsort,91020) (boinoe(jaux),jaux = 1,lgboin)
 193  2211   continue
 194 c
 195 c           recouvrement en z
 196         iaux = jaux*(numint(2,3)-1)
 197      >       + nbboit(1)*(numint(1,2)-1)
 198      >       + numint(1,1)
 199         do 222 , jaux = 1 , lgboin
 200           if ( iaux.eq.boinoe(jaux) ) then
 201             goto 2221
 202           endif
 203   222   continue
 204 cgn            write (ulsort,90002) 'n3',lenoeu
 205 cgn            write (ulsort,90002) 'b3',iaux
 206         lgboin = lgboin + 1
 207         boinoe(lgboin) = iaux
 208  2221   continue
 209 c
 210 c           recouvrement en x et y
 211         iaux = jaux*(numint(1,3)-1)
 212      >       + nbboit(1)*(numint(2,2)-1)
 213      >       + numint(2,1)
 214         do 223 , jaux = 1 , lgboin
 215           if ( iaux.eq.boinoe(jaux) ) then
 216             goto 2231
 217           endif
 218   223   continue
 219 cgn            write (ulsort,90002) 'n3',lenoeu
 220 cgn            write (ulsort,90002) 'b3',iaux
 221         lgboin = lgboin + 1
 222         boinoe(lgboin) = iaux
 223  2231   continue
 224 c
 225 c           recouvrement en y et z
 226         iaux = jaux*(numint(2,3)-1)
 227      >       + nbboit(1)*(numint(2,2)-1)
 228      >       + numint(1,1)
 229         do 224 , jaux = 1 , lgboin
 230           if ( iaux.eq.boinoe(jaux) ) then
 231             goto 2241
 232           endif
 233   224   continue
 234 cgn            write (ulsort,90002) 'n3',lenoeu
 235 cgn            write (ulsort,90002) 'b3',iaux
 236         lgboin = lgboin + 1
 237         boinoe(lgboin) = iaux
 238  2241   continue
 239 c
 240 c           recouvrement en z et x
 241         iaux = jaux*(numint(2,3)-1)
 242      >       + nbboit(1)*(numint(1,2)-1)
 243      >       + numint(2,1)
 244         do 225 , jaux = 1 , lgboin
 245           if ( iaux.eq.boinoe(jaux) ) then
 246             goto 2251
 247           endif
 248   225   continue
 249 cgn            write (ulsort,90002) 'n3',lenoeu
 250 cgn            write (ulsort,90002) 'b3',iaux
 251         lgboin = lgboin + 1
 252         boinoe(lgboin) = iaux
 253  2251   continue
 254 c
 255 c           recouvrement en x, y et z
 256         iaux = jaux*(numint(2,3)-1)
 257      >       + nbboit(1)*(numint(2,2)-1)
 258      >       + numint(2,1)
 259         do 226 , jaux = 1 , lgboin
 260           if ( iaux.eq.boinoe(jaux) ) then
 261             goto 2261
 262           endif
 263   226   continue
 264 cgn            write (ulsort,90002) 'n3',lenoeu
 265 cgn            write (ulsort,90002) 'b3',iaux
 266  2261   continue
 267 c
 268       endif
 269 c
 270 #ifdef _DEBUG_HOMARD_
 271        write (ulsort,90002) 'lgboin', lgboin
 272        write (ulsort,91010) (boinoe(jaux),jaux = 1 , lgboin)
 273 #endif
 274 c====
 275 c 3. la fin
 276 c====
 277 c
 278 #ifdef _DEBUG_HOMARD_
 279       write (ulsort,texte(langue,1)) 'Sortie', nompro
 280       call dmflsh (iaux)
 281 #endif
 282 c
 283       end