src/tool/Utilitaire/utb3n0.F

   1       subroutine utb3n0 ( coonoe,
   2      >                    numcoi, coinpt, coinnn,
   3      >                    nbbomx, lglibo, ptnubo, listbo,
   4      >                    nbpbco, mess54,
   5      >                    ulbila, 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 N0
  27 c    --           -              -         --
  28 c ______________________________________________________________________
  29 c
  30 c but : controle la non coincidence des noeuds.
  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 . numcoi .  s  . nbnoto . numero de la coincidence du noeud          .
  38 c . coinpt .  s  .   *    . pointeur de la i-eme coincidence dans coinn.
  39 c . coinnn .  s  .   *    . liste des noeuds coincidents               .
  40 c . nbbomx . e   .    1   . nombre total de boites                     .
  41 c . lglibo . e   .   1    . longueur de listbo                         .
  42 c . ptnubo . e   .0:nbbomx. pointeur dans listbo                       .
  43 c . listbo . e   . lglibo . numero des noeuds dans chaque boite        .
  44 c . nbpbco . es  .  -1:7  . nombre de problemes de coincidences        .
  45 c . mess54 . e   .nblang,*. messages                                   .
  46 c . ulbila . e   .   1    . unite logique d'ecriture du bilan          .
  47 c . ulsort . e   .   1    . unite logique de la sortie generale        .
  48 c . langue . e   .    1   . langue des messages                        .
  49 c .        .     .        . 1 : francais, 2 : anglais                  .
  50 c . codret .  s  .    1   . code de retour des modules                 .
  51 c .        .     .        . 0 : pas de probleme                        .
  52 c .        .     .        . 1 : probleme                               .
  53 c .____________________________________________________________________.
  54 c
  55 c====
  56 c 0. declarations et dimensionnement
  57 c====
  58 c
  59 c 0.1. ==> generalites
  60 c
  61       implicit none
  62       save
  63 c
  64       character*6 nompro
  65       parameter ( nompro = 'UTB3N0' )
  66 c
  67       integer typenh
  68       parameter ( typenh = -1 )
  69 c
  70 #include "nblang.h"
  71 c
  72 c 0.2. ==> communs
  73 c
  74 #include "nombno.h"
  75 #include "envca1.h"
  76 #include "precis.h"
  77 c
  78 c 0.3. ==> arguments
  79 c
  80       double precision coonoe(nbnoto,sdim)
  81 c
  82       integer numcoi(nbnoto), coinpt(*), coinnn(*)
  83       integer nbpbco(-1:7)
  84       integer nbbomx, lglibo
  85       integer ptnubo(0:nbbomx), listbo(lglibo)
  86 c
  87       character*54 mess54(nblang,*)
  88 c
  89       integer ulbila
  90       integer ulsort, langue, codret
  91 c
  92 c 0.4. ==> variables locales
  93 c
  94       integer iaux, jaux, kaux
  95       integer lenoeu
  96       integer nucoin, nucoix, ptcoin, ptcode, ptcofi
  97       integer numboi, ptldeb, ptlfin
  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 c
 106 c====
 107 c 1. initialisations
 108 c====
 109 c
 110 c 1.1. ==> messages
 111 c
 112 #include "impr01.h"
 113 c
 114 #ifdef _DEBUG_HOMARD_
 115       write (ulsort,texte(langue,1)) 'Entree', nompro
 116       call dmflsh (iaux)
 117 #endif
 118 c
 119       texte(1,4) =
 120      > '(/,3x,''... Coincidence des noeuds'',/,3x,26(''-''),/)'
 121       texte(1,5) =
 122      > '(5x,''Deux noeuds sont dits coincidents si l''''ecart absolu'')'
 123       texte(1,6) =
 124      > '(5x,''entre leurs coordonnees est inferieur a :'',g9.2)'
 125 c
 126       texte(2,4) = '(/,3x,''... Coincident nodes'',/,3x,20(''-''),/)'
 127       texte(2,5) = '(5x,''Nodes are declared coincident if their'')'
 128       texte(2,6) =
 129      > '(5x,''absolute coordinate difference is lower than '',g9.2)'
 130 c
 131 #include "utb301.h"
 132 c
 133 c 1.2. ==> constantes
 134 c
 135       codret = 0
 136 c
 137       do 12 , lenoeu = 1 , nbnoto
 138         numcoi(lenoeu) = 0
 139    12 continue
 140       coinpt(1) = 0
 141       nucoin = 0
 142       ptcoin = 0
 143 c
 144 c 1.3. ==> divers
 145 c
 146 #ifdef _DEBUG_HOMARD_
 147       do 13 , iaux = 1 , 2
 148 c
 149         if ( iaux.eq.1 ) then
 150           jaux = ulbila
 151         else
 152           if ( ulbila.eq.ulsort ) then
 153             goto 13
 154           else
 155             jaux = ulsort
 156           endif
 157         endif
 158 c
 159         write (jaux,texte(langue,4))
 160         write (jaux,texte(langue,5))
 161         write (jaux,texte(langue,6)) epsima
 162 c
 163    13 continue
 164 #endif
 165 c
 166 c====
 167 c 2. controle de la coincidence des noeuds, boite par boite
 168 c    remarques :
 169 c    1. La verification est sujette a caution car le test sur la
 170 c    coincidence est un test sur une egalite de reels ...
 171 c====
 172 c
 173 cgn      call gtdems (113)
 174 cgn           print *,'nbnoto =', nbnoto
 175 cgn           print *,'nbbomx =', nbbomx
 176 c
 177       ptlfin = ptnubo(0)
 178 c
 179       do 20 , numboi = 1 , nbbomx
 180 c
 181         ptldeb = ptlfin + 1
 182         ptlfin = ptnubo(numboi)
 183 cgn           print *,numboi, ' : ',ptldeb,ptlfin
 184 c
 185 c 2.1. ==> En 1D
 186 c
 187       if ( sdim.eq.1 ) then
 188 c
 189           do 21 , iaux = ptldeb, ptlfin
 190 c
 191             lenoeu = listbo(iaux)
 192 c
 193             if ( numcoi(lenoeu).eq.0 ) then
 194 c
 195               do 211 , jaux = iaux+1 , ptlfin
 196 c
 197                 kaux = listbo(jaux)
 198 c
 199                 if (
 200      >             abs(coonoe(kaux,1)-coonoe(lenoeu,1)).le.epsima ) then
 201 c
 202                   if ( numcoi(lenoeu).eq.0 ) then
 203                     nucoin = nucoin + 1
 204                     numcoi(lenoeu) = nucoin
 205                     ptcoin = ptcoin + 1
 206                     coinnn(ptcoin) = lenoeu
 207                   endif
 208                   numcoi(kaux) = nucoin
 209                   ptcoin = ptcoin + 1
 210                   coinpt(nucoin+1) = ptcoin
 211                   coinnn(ptcoin) = kaux
 212 c
 213                 endif
 214 c
 215   211         continue
 216 c
 217             endif
 218 c
 219    21     continue
 220 c
 221 c 2.2. ==> En 2D
 222 c
 223       elseif ( sdim.eq.2 ) then
 224 c
 225           do 22 , iaux = ptldeb, ptlfin
 226 c
 227             lenoeu = listbo(iaux)
 228 c
 229             if ( numcoi(lenoeu).eq.0 ) then
 230 c
 231               do 221 , jaux = iaux+1 , ptlfin
 232 c
 233                 kaux = listbo(jaux)
 234 c
 235                 if (
 236      >             abs(coonoe(kaux,1)-coonoe(lenoeu,1)).le.epsima ) then
 237 c
 238                   if (
 239      >             abs(coonoe(kaux,2)-coonoe(lenoeu,2)).le.epsima ) then
 240 c
 241                     if ( numcoi(lenoeu).eq.0 ) then
 242                       nucoin = nucoin + 1
 243                       numcoi(lenoeu) = nucoin
 244                       ptcoin = ptcoin + 1
 245                       coinnn(ptcoin) = lenoeu
 246                     endif
 247                     numcoi(kaux) = nucoin
 248                     ptcoin = ptcoin + 1
 249                     coinpt(nucoin+1) = ptcoin
 250                     coinnn(ptcoin) = kaux
 251 c
 252                   endif
 253 c
 254                 endif
 255 c
 256   221         continue
 257 c
 258             endif
 259 c
 260    22     continue
 261 c
 262 c 2.3. ==> En 3D
 263 c
 264         else
 265 c
 266           do 23 , iaux = ptldeb, ptlfin
 267 c
 268             lenoeu = listbo(iaux)
 269 cgn              print *,'. Noeud ', lenoeu
 270 c
 271             if ( numcoi(lenoeu).eq.0 ) then
 272 c
 273               do 231 , jaux = iaux+1 , ptlfin
 274 c
 275                 kaux = listbo(jaux)
 276 c
 277                 if (
 278      >             abs(coonoe(kaux,1)-coonoe(lenoeu,1)).le.epsima ) then
 279 c
 280                   if (
 281      >             abs(coonoe(kaux,2)-coonoe(lenoeu,2)).le.epsima ) then
 282 c
 283                     if (
 284      >              abs(coonoe(kaux,3)-coonoe(lenoeu,3)).le.epsima )then
 285 c
 286                       if ( numcoi(lenoeu).eq.0 ) then
 287                         nucoin = nucoin + 1
 288                         numcoi(lenoeu) = nucoin
 289                         ptcoin = ptcoin + 1
 290                         coinnn(ptcoin) = lenoeu
 291                       endif
 292                       numcoi(kaux) = nucoin
 293                       ptcoin = ptcoin + 1
 294                       coinpt(nucoin+1) = ptcoin
 295                       coinnn(ptcoin) = kaux
 296 c
 297                     endif
 298 c
 299                   endif
 300 c
 301                 endif
 302 c
 303   231         continue
 304 c
 305             endif
 306 c
 307    23     continue
 308 c
 309         endif
 310 c
 311    20 continue
 312 c
 313       nbpbco(typenh) = nucoin
 314 cgn      call gtfims (113)
 315 c
 316 c====
 317 c 3. Impression
 318 c    nucoix = numero de la derniere coincidence imprimee
 319 c    Attention : il faut imprimer boite par boite sinon on en oublie ...
 320 c====
 321 cgn      call gtdems (114)
 322 c
 323       nucoix = 0
 324 c
 325       ptlfin = ptnubo(0)
 326 c
 327       do 31 , numboi = 1 , nbbomx
 328 c
 329         ptldeb = ptlfin + 1
 330         ptlfin = ptnubo(numboi)
 331 c
 332         do 311 , iaux = ptldeb, ptlfin
 333 c
 334           lenoeu = listbo(iaux)
 335 c
 336           nucoin = numcoi(lenoeu)
 337 c
 338           if ( nucoin.ne.0 .and. nucoin.gt.nucoix ) then
 339 c
 340             write (ulbila,10100)
 341             write (ulbila,11100) mess54(langue,4)
 342             ptcode = coinpt(nucoin)+1
 343             ptcofi = coinpt(nucoin+1)
 344             write (ulbila,12100) (coinnn(jaux),jaux = ptcode, ptcofi)
 345             if ( sdim.eq.1 ) then
 346               write (ulbila,14101) coonoe(lenoeu,1)
 347             elseif ( sdim.eq.2 ) then
 348               write (ulbila,14102) coonoe(lenoeu,1), coonoe(lenoeu,2)
 349             else
 350               write (ulbila,14103) coonoe(lenoeu,1), coonoe(lenoeu,2),
 351      >                             coonoe(lenoeu,3)
 352             endif
 353             write (ulbila,10200)
 354 c
 355             nucoix = nucoin
 356 c
 357           endif
 358 c
 359   311   continue
 360 c
 361    31 continue
 362 cgn      call gtfims (114)
 363 c
 364       end