src/tool/Utilitaire/utb3n2.F

   1       subroutine utb3n2 ( coonoe,
   2      >                    nbintx, nbbomx,
   3      >                    lglibo, ptnubo, listbo,
   4      >                    nbboit, boimin, boimax,
   5      >                    ulsort, langue, codret )
   6 c ______________________________________________________________________
   7 c
   8 c                             H O M A R D
   9 c
  10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  11 c
  12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  13 c aupres des huissiers de justice Simart et Lavoir a Clamart
  14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  15 c aupres des huissiers de justice
  16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  17 c
  18 c    HOMARD est une marque deposee d'Electricite de France
  19 c
  20 c Copyright EDF 1996
  21 c Copyright EDF 1998
  22 c Copyright EDF 2002
  23 c Copyright EDF 2020
  24 c ______________________________________________________________________
  25 c
  26 c    UTilitaire - Bilan - option 3 - phase N2
  27 c    --           -              -         --
  28 c ______________________________________________________________________
  29 c
  30 c Classe les noeuds par boite
  31 c ______________________________________________________________________
  32 c .        .     .        .                                            .
  33 c .  nom   . e/s . taille .           description                      .
  34 c .____________________________________________________________________.
  35 c . coonoe . e   . nbnoto . coordonnees des noeuds                     .
  36 c .        .     . * sdim .                                            .
  37 c . nbintx . e   .    1   . nombre maximal d'intervalle                .
  38 c . nbbomx . e   .    1   . nombre total de boites                     .
  39 c . lglibo . e   .   1    . longueur de listbo                         .
  40 c . ptnubo . es  .0:nbbomx. pointeur dans listbo                       .
  41 c . listbo .  s  . lglibo . numero des noeuds dans chaque boite        .
  42 c . nbboit .  s  .  sdim  . nombre de boite dans chaque direction      .
  43 c . boimin . e   .0:nbintx. limite minimale de chaque boite            .
  44 c . boimax . e   .0:nbintx. limite maximale de chaque boite            .
  45 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  46 c . langue . e   .    1   . langue des messages                        .
  47 c .        .     .        . 1 : francais, 2 : anglais                  .
  48 c . codret .  s  .    1   . code de retour des modules                 .
  49 c .        .     .        . 0 : pas de probleme                        .
  50 c .        .     .        . 1 : probleme                               .
  51 c .____________________________________________________________________.
  52 c
  53 c====
  54 c 0. declarations et dimensionnement
  55 c====
  56 c
  57 c 0.1. ==> generalites
  58 c
  59       implicit none
  60       save
  61 c
  62       character*6 nompro
  63       parameter ( nompro = 'UTB3N2' )
  64 c
  65 #include "nblang.h"
  66 c
  67 c 0.2. ==> communs
  68 c
  69 #include "envex1.h"
  70 c
  71 #include "nombno.h"
  72 #include "envca1.h"
  73 c
  74 c 0.3. ==> arguments
  75 c
  76       integer nbintx, nbbomx
  77       integer lglibo
  78       integer ptnubo(0:nbbomx), listbo(lglibo)
  79       integer nbboit(3)
  80 c
  81       double precision coonoe(nbnoto,sdim)
  82       double precision boimin(3,0:nbintx), boimax(3,0:nbintx)
  83 c
  84       integer ulsort, langue, codret
  85 c
  86 c 0.4. ==> variables locales
  87 c
  88       integer iaux
  89       integer lgboin, boinoe(8)
  90       integer lenoeu, noedeb
  91       integer nbinte(3)
  92 c
  93       double precision coord(3)
  94 c
  95       integer nbmess
  96       parameter (nbmess = 10 )
  97       character*80 texte(nblang,nbmess)
  98 c
  99 c 0.5. ==> initialisations
 100 c ______________________________________________________________________
 101 c
 102 c====
 103 c 1. initialisations
 104 c====
 105 c
 106 c 1.1. ==> messages
 107 c
 108 #include "impr01.h"
 109 c
 110 #ifdef _DEBUG_HOMARD_
 111       write (ulsort,texte(langue,1)) 'Entree', nompro
 112       call dmflsh (iaux)
 113 #endif
 114 c
 115       texte(1,2) = '(''Nombre maximal de boites : '',i10)'
 116 c
 117       texte(2,2) = '(''Maximum number of boxes : '',i10)'
 118 c
 119 #ifdef _DEBUG_HOMARD_
 120       write (ulsort,texte(langue,2)) nbbomx
 121 #endif
 122 c
 123       codret = 0
 124 c
 125 c 1.2. ==> Nombre d'intervalles
 126 c
 127       do 12 , iaux = 1 , sdim
 128         nbinte(iaux) = nbboit(iaux) - 1
 129    12 continue
 130 c
 131 c====
 132 c 2. Creation des listes
 133 c====
 134 c    au depart :
 135 c    ptnubo(i) = position du dernier noeud de la boite i-1
 136 c              = nombre cumule de noeuds pour les (i-1) premieres boites
 137 c    a l'arrivee :
 138 c    ptnubo(i) = position du dernier noeud de la boite i
 139 c              = nombre cumule de noeuds pour les i premieres boites
 140 c
 141 c 2.0. ==> On controle tous les noeuds, sauf dans un cas : si le code
 142 c          de calcul associe est Saturne_2D ou Neptune_2D, le maillage
 143 c          est une couche 2D du maillage 3D. Dans ce cas, un noeud
 144 c          supplementaire a ete cree pour memoriser les cotes mini
 145 c          et maxi du maillage. Ce noeud etant isole se trouve en
 146 c          premiere position. Il doit etre retire du controle car il
 147 c          n'a pas de sens du point de vue du maillage.
 148 c
 149       if ( typcca.eq.26 .or.
 150      >     typcca.eq.46 ) then
 151         noedeb = 2
 152       else
 153         noedeb = 1
 154       endif
 155 c
 156 cgn 3000 format(i10,3g12.5)
 157 c
 158 c 2.1. ==> en dimension 1
 159 c
 160       if ( sdim.eq.1 ) then
 161 c
 162         do 21 , lenoeu = noedeb , nbnoto
 163 c
 164           coord(1) = coonoe(lenoeu,1)
 165 cgn          write (ulsort,3000) lenoeu,coord(1)
 166 c
 167 #ifdef _DEBUG_HOMARD_
 168       write (ulsort,texte(langue,3)) 'UTB3N5', nompro
 169 #endif
 170           call utb3n5 ( lgboin, boinoe,
 171      >                  coord,
 172      >                  nbboit, nbinte,
 173      >                  boimin, boimax )
 174 c
 175 cgn          write(ulsort,*) 'lgboin =', lgboin
 176           do 211 , iaux = 1 , lgboin
 177 cgn            write(ulsort,*) 'boinoe(',iaux,') =', boinoe(iaux)
 178             ptnubo(boinoe(iaux)) = ptnubo(boinoe(iaux)) + 1
 179             listbo(ptnubo(boinoe(iaux))) = lenoeu
 180   211     continue
 181 c
 182    21   continue
 183 cgn        write(ulsort,*) ptnubo
 184 cgn        write(ulsort,*) listbo
 185 c
 186 c 2.2. ==> en dimension 2
 187 c
 188       elseif ( sdim.eq.2 ) then
 189 c
 190         do 22 , lenoeu = noedeb , nbnoto
 191 c
 192           coord(1) = coonoe(lenoeu,1)
 193           coord(2) = coonoe(lenoeu,2)
 194 cgn          write (ulsort,3000) lenoeu,coord(1), coord(2)
 195 c
 196 #ifdef _DEBUG_HOMARD_
 197       write (ulsort,texte(langue,3)) 'UTB3N4', nompro
 198 #endif
 199           call utb3n4 ( lgboin, boinoe,
 200      >                  coord,
 201      >                  nbboit, nbinte,
 202      >                  boimin, boimax )
 203 c
 204 cgn          write(ulsort,*) 'lgboin =', lgboin
 205           do 221 , iaux = 1 , lgboin
 206 cgn            write(ulsort,*) 'boinoe(',iaux,') =', boinoe(iaux)
 207             ptnubo(boinoe(iaux)) = ptnubo(boinoe(iaux)) + 1
 208             listbo(ptnubo(boinoe(iaux))) = lenoeu
 209   221     continue
 210 c
 211    22   continue
 212 cgn        write(ulsort,*) ptnubo
 213 cgn        write(ulsort,*) listbo
 214 c
 215 c 2.3. ==> en dimension 3
 216 c
 217       else
 218 c
 219         do 23 , lenoeu = noedeb , nbnoto
 220 cgn      write (ulsort,*) lenoeu,(coonoe(lenoeu,iaux) , iaux = 1 , sdim)
 221 c
 222           coord(1) = coonoe(lenoeu,1)
 223           coord(2) = coonoe(lenoeu,2)
 224           coord(3) = coonoe(lenoeu,3)
 225 cgn          write (ulsort,3000) lenoeu,coord
 226 c
 227 #ifdef _DEBUG_HOMARD_
 228       write (ulsort,texte(langue,3)) 'UTB3N3', nompro
 229 #endif
 230           call utb3n3 ( lgboin, boinoe,
 231      >                  coord,
 232      >                  nbboit, nbinte,
 233      >                  boimin, boimax )
 234 c
 235           do 231 , iaux = 1 , lgboin
 236             ptnubo(boinoe(iaux)) = ptnubo(boinoe(iaux)) + 1
 237             listbo(ptnubo(boinoe(iaux))) = lenoeu
 238   231     continue
 239 c
 240    23   continue
 241 c
 242       endif
 243 c
 244 c====
 245 c 3. la fin
 246 c====
 247 c
 248       if ( codret.ne.0 ) then
 249 c
 250 #include "envex2.h"
 251 c
 252 #ifdef _DEBUG_HOMARD_
 253       write (ulsort,texte(langue,1)) 'Sortie', nompro
 254       write (ulsort,texte(langue,2)) codret
 255 #endif
 256 c
 257       endif
 258 c
 259 #ifdef _DEBUG_HOMARD_
 260       write (ulsort,texte(langue,1)) 'Sortie', nompro
 261       call dmflsh (iaux)
 262 #endif
 263 c
 264       end