src/tool/Utilitaire/utcntr.F

   1       subroutine utcntr ( option,
   2      >                    hettri, famtri, decfac, nivtri,
   3      >                    filtri, pertri,
   4      >                    pentri, nintri, homtri,
   5      >                    ntreca, ntreho,
   6      >                    anctri, noutri, nouare, aretri,
   7      >                    nbtrre,
   8      >                    ancfil, ancper )
   9 c ______________________________________________________________________
  10 c
  11 c                             H O M A R D
  12 c
  13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  14 c
  15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  16 c aupres des huissiers de justice Simart et Lavoir a Clamart
  17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  18 c aupres des huissiers de justice
  19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  20 c
  21 c    HOMARD est une marque deposee d'Electricite de France
  22 c
  23 c Copyright EDF 1996
  24 c Copyright EDF 1998
  25 c Copyright EDF 2002
  26 c Copyright EDF 2020
  27 c ______________________________________________________________________
  28 c
  29 c    UTilitaire - Compactage de la Numerotation des TRiangles
  30 c    --           -                -                --
  31 c ______________________________________________________________________
  32 c
  33 c  remarque hyper-importante :
  34 c             quelle que soit l'entite (noeud, arete, triangle ou
  35 c             tetraedre) son ancien numero est toujours superieur ou
  36 c             egal a son numero courant : ancent(i) >= i. En effet, la
  37 c             suppression d'entites entraine des trous dans
  38 c             la numerotation et tout le but des programmes utcnxx est
  39 c             de supprimer ces trous.
  40 c             donc quand on fait tab(i) = tab(ancent(i)), on est certain
  41 c             que tab(ancent(i)) n'a pas encore ete modifie dans
  42 c             la boucle sur i croissant. c'est donc bien la bonne
  43 c             valeur, c'est-a-dire l'ancienne, que l'on met a la
  44 c             nouvelle place.
  45 c ______________________________________________________________________
  46 c .        .     .        .                                            .
  47 c .  nom   . e/s . taille .           description                      .
  48 c .____________________________________________________________________.
  49 c . option . e   .   1    . option de pilotage des compactages         .
  50 c .        .     .        . c'est un multiple des entiers suivants :   .
  51 c .        .     .        .  2 : noeuds internes aux triangles         .
  52 c .        .     .        .  5 : homologues                            .
  53 c .        .     .        .  7 : renumerotation                        .
  54 c .        .     .        . 11 : relation volu/face pour l'extrusion   .
  55 c . hettri . e/s . nouvtr . historique de l'etat des triangles         .
  56 c . famtri . e/s . nouvtr . famille des triangles                      .
  57 c . decfac . e/s . -nbquto. decision sur les faces (quad. + tri.)      .
  58 c .        .     . :nbtrto.                                            .
  59 c . nivtri . e/s . nouvtr . niveau des triangles                       .
  60 c . filtri . e/s . nouvtr . premier fils des triangles                 .
  61 c . pertri . e/s . nouvtr . pere des triangles                         .
  62 c . pentri . e/s . nouvtr . pentaedre sur un triangle de la face avant .
  63 c . nintri . e/s . nouvtr . noeud interne au triangle                  .
  64 c . homtri . e/s . nouvtr . ensemble des triangles homologues          .
  65 c . anctri . e   . nouvtr . anciens numeros des triangles conserves    .
  66 c . noutri . e   .0:nouvtr. nouveaux numeros des triangles conserves   .
  67 c . nouare . e   .0:nouvar. nouveaux numeros des aretes conservees     .
  68 c . aretri . e/s .nouvtr*3. numeros des 3 aretes des triangles         .
  69 c . nbtrre . e   .   1    . nombre de triangles restants               .
  70 c . ancfil . aux . nbtrto . ancien tableau des fils                    .
  71 c . ancper . aux . nbtrto . ancien tableau des peres                   .
  72 c ______________________________________________________________________
  73 c
  74 c====
  75 c 0. declarations et dimensionnement
  76 c====
  77 c
  78 c 0.1. ==> generalites
  79 c
  80       implicit none
  81       save
  82 c
  83       character*6 nompro
  84       parameter ( nompro = 'UTCNTR' )
  85 c
  86 c 0.2. ==> communs
  87 c
  88 #include "nomber.h"
  89 #include "nombtr.h"
  90 #include "nombqu.h"
  91 #include "nouvnb.h"
  92 c
  93 c 0.3. ==> arguments
  94 c
  95       integer option
  96       integer nbtrre
  97 c
  98       integer decfac(-nbquto:nbtrto)
  99       integer hettri(nouvtr), famtri(nouvtr)
 100       integer nivtri(nouvtr)
 101       integer filtri(nouvtr), pertri(nouvtr)
 102       integer pentri(nouvtr), nintri(nouvtr), homtri(nouvtr)
 103       integer ntreca(nouvtr), ntreho(retrac)
 104       integer anctri(nouvtr), noutri(0:nouvtr)
 105       integer nouare(0:nouvar),  aretri(nouvtr,3)
 106       integer ancfil(nbtrto), ancper(nbtrto)
 107 c
 108 c 0.4. ==> variables locales
 109 c
 110       integer iaux
 111       integer letria, larete
 112 c
 113 c 0.5. ==> initialisations
 114 c
 115 c====
 116 c 1. messages
 117 c====
 118 c
 119 #include "impr03.h"
 120 c
 121 cgn        print 90002,nompro//' - option',option
 122 cgn        print 90002,'nbtrre',nbtrre
 123 cgn        print 90002,'retrac',retrac
 124 cgn        print 91020,anctri
 125 c
 126 c ______________________________________________________________________
 127 c
 128 c a partir de maintenant, on travaille avec le nouveau nombre d'entites
 129 c du maillage, i.e. uniquement le nombre d'entites n'ayant pas ete
 130 c marquees "a disparaitre". il faut neanmoins conserver le nombre
 131 c d'entites avant disparitions pour pouvoir, a la fin des remises a
 132 c jours des numerotations, compacter les tableaux en memoire.
 133 c
 134 c Remarque : si on est parti d'un macro-maillage non conforme,
 135 c            certains triangles ont des peres adoptifs de numero
 136 c            negatif. Il ne faut pas transferer leur numero
 137 c            Le cas des peres negatif parce que quadrangle de conformite
 138 c            n'existe plus a ce stade : ces triangles ont ete detruits
 139 c            en amont
 140 c
 141 c====
 142 c 1. remise a jour des numerotations des triangles
 143 c    reconstruction des correspondances directes
 144 c====
 145 c
 146 c 1.1. ==> stockage des anciens tableaux de filiation
 147 c
 148       do 11 ,letria = 1 , nbtrto
 149         ancfil(letria) = filtri(letria)
 150         ancper(letria) = pertri(letria)
 151    11 continue
 152 c
 153 c 1.2. ==> transfert
 154 c
 155       do 12 , letria = 1 , nbtrre
 156 c
 157         do 121, larete = 1 , 3
 158           aretri(letria,larete) = nouare(aretri(anctri(letria),larete))
 159   121   continue
 160 c
 161         if ( anctri(letria).ne.letria ) then
 162 c
 163           hettri(letria) = hettri(anctri(letria))
 164           famtri(letria) = famtri(anctri(letria))
 165           decfac(letria) = decfac(anctri(letria))
 166           nivtri(letria) = nivtri(anctri(letria))
 167 c
 168         endif
 169 c
 170         filtri(letria) = noutri(ancfil(anctri(letria)))
 171         if ( ancper(anctri(letria)).gt.0 ) then
 172           pertri(letria) = noutri(ancper(anctri(letria)))
 173         else
 174           pertri(letria) = ancper(anctri(letria))
 175         endif
 176 c
 177    12 continue
 178 c
 179 c 1.3. ==> traitement des noeuds internes
 180 c
 181       if ( mod(option,2).eq.0 ) then
 182 c
 183         do 13 , letria = 1 , nbtrre
 184 c
 185           if ( anctri(letria).ne.letria ) then
 186             nintri(letria) = nintri(anctri(letria))
 187           endif
 188 c
 189    13   continue
 190 c
 191       endif
 192 c
 193 c 1.4. ==> traitement des homologues
 194 c
 195       if ( mod(option,5).eq.0 ) then
 196 c
 197         do 14 , letria = 1 , nbtrre
 198           if ( homtri(anctri(letria)) .ge. 0 ) then
 199             homtri(letria) =   noutri(homtri(anctri(letria)))
 200           else
 201             homtri(letria) = - noutri(abs(homtri(anctri(letria))))
 202           endif
 203    14   continue
 204 c
 205       endif
 206 c
 207 c 1.5. ==> traitement des renumerotations
 208 c
 209       if ( mod(option,7).eq.0 ) then
 210 c
 211         do 151 , iaux = 1 , retrac
 212           ntreho(iaux) = 0
 213   151   continue
 214 c
 215         do 152 , letria = 1 , nbtrre
 216 c
 217           if ( anctri(letria).ne.letria ) then
 218             ntreca(letria) = ntreca(anctri(letria))
 219           endif
 220           if ( ntreca(letria).gt.0 ) then
 221             ntreho(ntreca(letria)) = letria
 222           endif
 223 c
 224   152   continue
 225 c
 226       endif
 227 c
 228 c 1.6. ==> traitement des pentaedres pour l'extrusion
 229 c
 230       if ( mod(option,11).eq.0 ) then
 231 c
 232         do 16 , letria = 1 , nbtrre
 233 c
 234           if ( anctri(letria).ne.letria ) then
 235             pentri(letria) = pentri(anctri(letria))
 236           endif
 237 c
 238    16   continue
 239 c
 240       endif
 241 c
 242       end