src/tool/Utilitaire/utb3n4.F

   1       subroutine utb3n4 ( 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 N4
  26 c    --           -              -         --
  27 c ______________________________________________________________________
  28 c
  29 c Retourne la liste des boites d'un noeud - 2D
  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  .   8    . 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 = 'UTB3N4' )
  54 c
  55 #ifdef _DEBUG_HOMARD_
  56       integer ulsort
  57       parameter ( ulsort = 1 )
  58       integer langue
  59       parameter ( langue = 1 )
  60 #endif
  61 c
  62       integer sdim
  63       parameter ( sdim = 2 )
  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(8)
  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 c 1.1. ==> messages
  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       do 11 , iaux = 1 , 8
 103         boinoe(iaux) = 0
 104    11 continue
 105 c
 106 c====
 107 c 2. Pour une dimension iaux donnee, on passe en revue tous les
 108 c    intervalles.
 109 c    . Quand on rencontre la premiere limite qui est superieure a
 110 c      la coordonnee, on stocke le numero de l'intervalle
 111 c      dans numint(1,iaux)
 112 c    . Sachant que les limites sont legerement recouvrantes, on
 113 c      regarde si la coordonnee n'est pas superieure au minima de
 114 c      l'intervalle suivant. Si oui, on stocke le numero de
 115 c      l'intervalle suivant dans numint(2,iaux). Sinon,
 116 c      numint(2,iaux) vaut numint(1,iaux).
 117 c
 118 c      numint :       1         2         3         4
 119 c                |         |         |         |         |
 120 c                               x --> 2/0
 121 c                                    x --> 2/3
 122 c====
 123 cgn 3000 format(i10,3g12.5)
 124 cgn 3001 format(10i4)
 125 cgn 3002 format(a,' :',3i10)
 126 c
 127 cgn      write (ulsort,3002) 'sdim', sdim
 128       nombbo = 1
 129       do 21 , iaux = 1 , sdim
 130 cgn        write (ulsort,3002) '. Dimension', iaux
 131 cgn        write (ulsort,3002) '. nbinte(iaux)', nbinte(iaux)
 132 c
 133         numint(1,iaux) = 0
 134 c
 135         do 211 , jaux = 1 , nbinte(iaux)
 136 cgn          write (ulsort,3000) jaux,boimax(iaux,jaux)
 137           if ( coonoe(iaux).le.boimax(iaux,jaux) ) then
 138             if ( numint(1,iaux).eq.0 ) then
 139               numint(1,iaux) = jaux
 140               numint(2,iaux) = jaux
 141               if ( coonoe(iaux).ge.boimin(iaux,jaux+1) ) then
 142                 numint(2,iaux) = jaux + 1
 143                 nombbo = nombbo*2
 144               endif
 145               goto 21
 146             endif
 147           endif
 148   211   continue
 149         numint(1,iaux) = nbboit(iaux)
 150         numint(2,iaux) = nbboit(iaux)
 151 c
 152    21 continue
 153 cgn      write (ulsort,3002) 'numint(1,*)',(numint(1,iaux),iaux=1,sdim)
 154 cgn      write (ulsort,3002) 'numint(2,*)',(numint(2,iaux),iaux=1,sdim)
 155 cgn      write (ulsort,3002) 'nombre de boites', nombbo
 156 c
 157 c 2.2. ==>  Increment des pointeurs
 158 c 2.2.1. ==>  La boite principale
 159       iaux = nbboit(1)*(numint(1,2)-1)
 160      >     + numint(1,1)
 161 cgn      write (ulsort,3002) 'boite principale',iaux
 162       lgboin = 1
 163       boinoe(lgboin) = iaux
 164 c
 165 c 2.2.2. ==>  Les boites secondaires
 166 c
 167       if ( nombbo.gt.1 ) then
 168 c       recouvrement en x
 169         iaux = nbboit(1)*(numint(1,2)-1)
 170      >       + numint(2,1)
 171         if ( iaux.ne.boinoe(1) ) then
 172 cgn          write (ulsort,3002) 'b1',iaux
 173           lgboin = lgboin + 1
 174           boinoe(lgboin) = iaux
 175         endif
 176 cgn          write (ulsort,3001) (boinoe(jaux),jaux = 1,lgboin)
 177 c
 178 c       recouvrement en y
 179         iaux = nbboit(1)*(numint(2,2)-1)
 180      >       + numint(1,1)
 181         do 221 , jaux = 1 , lgboin
 182           if ( iaux.eq.boinoe(jaux) ) then
 183             goto 2211
 184           endif
 185   221   continue
 186 cgn        write (ulsort,3002) 'b2',iaux
 187         lgboin = lgboin + 1
 188         boinoe(lgboin) = iaux
 189 cgn        write (ulsort,3001) (boinoe(jaux),jaux = 1,lgboin)
 190  2211   continue
 191 c
 192 c       recouvrement en x et y
 193         iaux = nbboit(1)*(numint(2,2)-1)
 194      >       + numint(2,1)
 195         do 222 , jaux = 1 , lgboin
 196           if ( iaux.eq.boinoe(jaux) ) then
 197             goto 2221
 198           endif
 199   222   continue
 200         lgboin = lgboin + 1
 201         boinoe(lgboin) = iaux
 202 cgn        write (ulsort,3002) 'b3',iaux
 203  2221   continue
 204 c
 205       endif
 206 c
 207 c====
 208 c 3. la fin
 209 c====
 210 c
 211 #ifdef _DEBUG_HOMARD_
 212       write (ulsort,texte(langue,1)) 'Sortie', nompro
 213       call dmflsh (iaux)
 214 #endif
 215 c
 216       end