src/tool/Utilitaire/utcnar.F

   1       subroutine utcnar ( somare, hetare, famare, decare,
   2      >                    filare, merare, arehom, np2are,
   3      >                    aretri, arequa,
   4      >                    posifa, facare,
   5      >                    ancare, nouare, nounoe,
   6      >                    nbtrre, nbqure, nbarre,
   7      >                    ancfil, ancmer )
   8 c ______________________________________________________________________
   9 c
  10 c                             H O M A R D
  11 c
  12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  13 c
  14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  15 c aupres des huissiers de justice Simart et Lavoir a Clamart
  16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  17 c aupres des huissiers de justice
  18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  19 c
  20 c    HOMARD est une marque deposee d'Electricite de France
  21 c
  22 c Copyright EDF 1996
  23 c Copyright EDF 1998
  24 c Copyright EDF 2002
  25 c Copyright EDF 2020
  26 c ______________________________________________________________________
  27 c
  28 c    UTilitaire - Compactage de la Numerotation des ARetes
  29 c    --           -                -                --
  30 c ______________________________________________________________________
  31 c
  32 c  remarque hyper-importante :
  33 c             quelle que soit l'entite (noeud, arete, triangle ou
  34 c             tetraedre) son ancien numero est toujours superieur ou
  35 c             egal a son numero courant : ancent(i) >= i. En effet, la
  36 c             suppression d'entites entraine des trous dans
  37 c             la numerotation et tout le but des programmes utcnxx est
  38 c             de supprimer ces trous.
  39 c             donc quand on fait tab(i) = tab(ancent(i)), on est certain
  40 c             que tab(ancent(i)) n'a pas encore ete modifie dans
  41 c             la boucle sur i croissant. c'est donc bien la bonne
  42 c             valeur, c'est-a-dire l'ancienne, que l'on met a la
  43 c             nouvelle place.
  44 c
  45 c ______________________________________________________________________
  46 c .        .     .        .                                            .
  47 c .  nom   . e/s . taille .           description                      .
  48 c .____________________________________________________________________.
  49 c . somare . e/s .2*nouvar. numeros des extremites d'arete             .
  50 c . hetare . e/s . nouvar . historique de l'etat des aretes            .
  51 c . decare . e/s .0:nbarto. table des decisions sur les aretes         .
  52 c . famare . e/s . nouvar . famille des aretes                         .
  53 c . filare . e/s . nouvar . premiere fille des aretes                  .
  54 c . merare . e/s . nouvar . mere des aretes                            .
  55 c . arehom . e   . nouvar . ensemble des aretes homologues             .
  56 c . np2are . e/s . nouvar . numero des noeuds p2 milieux d'aretes      .
  57 c . aretri . e/s .nouvtr*3. numeros des 3 aretes des triangles         .
  58 c . arequa . e/s .nouvqu*4. numeros des 4 aretes des quadrangles       .
  59 c . posifa . e/s .0:nbarto. pointeur sur tableau facare                .
  60 c . facare . e/s . nbfaar . liste des faces contenant une arete        .
  61 c . ancare . e   . nouvar . anciens numeros des aretes conservees      .
  62 c . nouare . e   .0:nouvar. nouveaux numeros des aretes conservees     .
  63 c . nounoe . e   .0:nouvno. nouveaux numeros des noeuds conserves      .
  64 c . nbtrre . e   .   1    . nombre de triangles restants               .
  65 c . nbqure . e   .   1    . nombre de quadrangles restants             .
  66 c . nbarre . e   .   1    . nombre d'aretes restantes                  .
  67 c . ancfil . aux . nbarto . ancien tableau des filles                  .
  68 c . ancmer . aux . nbarto . ancien tableau des meres                   .
  69 c ______________________________________________________________________
  70 c
  71 c====
  72 c 0. declarations et dimensionnement
  73 c====
  74 c
  75 c 0.1. ==> generalites
  76 c
  77       implicit none
  78       save
  79 c
  80 c 0.2. ==> communs
  81 c
  82 #include "nombar.h"
  83 #include "envca1.h"
  84 #include "nouvnb.h"
  85 c
  86 c 0.3. ==> arguments
  87 c
  88       integer nbtrre, nbqure, nbarre
  89 c
  90       integer somare(2,nouvar), hetare(nouvar)
  91       integer famare(nouvar), decare(0:nbarto)
  92 c
  93       integer filare(nouvar), merare(nouvar)
  94       integer arehom(nouvar)
  95       integer np2are(nouvar)
  96 c
  97       integer aretri(nouvtr,3), arequa(nouvqu,4)
  98       integer posifa(0:nbarto), facare(nbfaar)
  99 c
 100       integer ancare(nouvar), nouare(0:nouvar)
 101       integer nounoe(0:nouvno)
 102 c
 103       integer ancfil(nbarto), ancmer(nbarto)
 104 c
 105 c 0.4. ==> variables locales
 106 c
 107       integer larete
 108 c
 109 c 0.5. ==> initialisations
 110 c ______________________________________________________________________
 111 c
 112 c a partir de maintenant, on travaille avec le nouveau nombre d'entites
 113 c du maillage, i.e. uniquement le nombre d'entites n'ayant pas ete
 114 c marquees "a disparaitre". il faut neanmoins conserver le nombre
 115 c d'entites avant disparitions pour pouvoir, a la fin des remises a
 116 c jours des numerotations, compacter les tableaux en memoire.
 117 c
 118 c====
 119 c 1. remise a jour des numerotations des aretes
 120 c    reconstruction des correspondances directes
 121 c====
 122 c
 123 c 1.1. ==> stockage des anciens tableaux de filiation
 124 c
 125       do 11 ,larete = 1 , nbarto
 126         ancfil(larete) = filare(larete)
 127         ancmer(larete) = merare(larete)
 128    11 continue
 129 c
 130 c 1.2. ==> transfert
 131 c
 132       do 12 , larete = 1 , nbarre
 133 c
 134         somare(1,larete) = nounoe(somare(1,ancare(larete)))
 135         somare(2,larete) = nounoe(somare(2,ancare(larete)))
 136 c
 137         if ( ancare(larete).ne.larete ) then
 138 c
 139           hetare(larete) = hetare(ancare(larete))
 140           famare(larete) = famare(ancare(larete))
 141           decare(larete) = decare(ancare(larete))
 142 c
 143         endif
 144 c
 145         filare(larete) = nouare(ancfil(ancare(larete)))
 146         merare(larete) = nouare(ancmer(ancare(larete)))
 147 c
 148         if ( degre .eq. 2 ) then
 149           np2are(larete) = nounoe(np2are(ancare(larete)))
 150         endif
 151 c
 152    12 continue
 153 c
 154 c 1.3. ==> traitement des homologues
 155 c
 156       if ( homolo.ge.2 ) then
 157 c
 158         do 13 , larete = 1 , nbarre
 159           if ( arehom(ancare(larete)) .ge. 0 ) then
 160             arehom(larete) =   nouare(arehom(ancare(larete)))
 161           else
 162             arehom(larete) = - nouare(abs(arehom(ancare(larete))))
 163           endif
 164    13   continue
 165 c
 166       endif
 167 c
 168 c====
 169 c 2. reconstruction des correspondances inverses
 170 c====
 171 c
 172       call utfaa1 ( nbarre, nbtrre, nbqure,
 173      >              nouvar, nouvtr, nouvqu,
 174      >              aretri, arequa,
 175      >              nbfaar, posifa )
 176 c
 177       call utfaa2 ( nbtrre, nbqure,
 178      >              nouvtr, nouvqu,
 179      >              aretri, arequa,
 180      >              nbfaar, posifa, facare )
 181 c
 182       end