src/tool/AP_Conversion/pcmaig.F

   1       subroutine pcmaig ( nbele0, nbelig,
   2      >                    coueig, noeeig,
   3      >                    elemen, typele, fameel, noeele,
   4      >                    nnosca, ancnoe, trav1a, deraff,
   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 .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . nbele0 . e   .   1    . estimation du nombre d'elements            .
  29 c . nbelig . e   .   1    . nombre d'elements elimines                 .
  30 c . noeeig .  s  .nbelig**. noeuds des elements                        .
  31 c . coueig .  s  . nbelig . famille med des elements                   .
  32 c . elemen . es  .   1    . numero de l'element en cours               .
  33 c . noeele . es  . nbele0 . noeuds des elements                        .
  34 c .        .     .*nbmane .                                            .
  35 c . typele . es  . nbele0 . type des elements                          .
  36 c . fameel . es  . nbele0 . famille med des elements                   .
  37 c . nnosca . e   .   *    . numero des noeuds dans le calcul           .
  38 c . ancnoe . e   . nbnoto . ancien numero de noeud si deraffinement    .
  39 c . deraff . e   .    1   . vrai, s'il y a eu du deraffinement en      .
  40 c .        .     .        . passant de l'iteration n a n+1 ; faux sinon.
  41 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  42 c . langue . e   .    1   . langue des messages                        .
  43 c .        .     .        . 1 : francais, 2 : anglais                  .
  44 c . codret . es  .    1   . code de retour des modules                 .
  45 c .        .     .        . 0 : pas de probleme                        .
  46 c .        .     .        . 1 : probleme                               .
  47 c ______________________________________________________________________
  48 c
  49 c====
  50 c 0. declarations et dimensionnement
  51 c====
  52 c
  53 c 0.1. ==> generalites
  54 c
  55       implicit none
  56       save
  57 c
  58       character*6 nompro
  59       parameter ( nompro = 'PCMAIG' )
  60 c
  61 #include "nblang.h"
  62 #include "referx.h"
  63 #include "consts.h"
  64 c
  65 c 0.2. ==> communs
  66 c
  67 #include "envex1.h"
  68 c
  69 #include "meddc0.h"
  70 #include "nombno.h"
  71 #include "envca1.h"
  72 c
  73 c 0.3. ==> arguments
  74 c
  75       integer nbele0, nbelig
  76       integer coueig(nbelig)
  77       integer noeeig(nbelig,*)
  78       integer elemen, typele(nbele0), fameel(nbele0)
  79       integer noeele(nbele0,nbmane)
  80       integer nnosca(*), ancnoe(*), trav1a(*)
  81 c
  82       logical deraff
  83 c
  84       integer ulsort, langue, codret
  85 c
  86 c 0.4. ==> variables locales
  87 c
  88       integer iaux
  89       integer noeud, typeig
  90       integer nbnoel
  91 c
  92       integer nbmess
  93       parameter ( nbmess = 10 )
  94       character*80 texte(nblang,nbmess)
  95 c
  96 c 0.5. ==> initialisations
  97 c ______________________________________________________________________
  98 c
  99 c====
 100 c 1. messages
 101 c====
 102 c
 103 #include "impr01.h"
 104 c
 105 #ifdef _DEBUG_HOMARD_
 106       write (ulsort,texte(langue,1)) 'Entree', nompro
 107       call dmflsh (iaux)
 108 #endif
 109 c
 110 #ifdef _DEBUG_HOMARD_
 111       write (ulsort,*) 'deraff = ',deraff
 112       write (ulsort,*) 'nbele0, nbmane = ', nbele0,nbmane
 113 #endif
 114 c
 115 c====
 116 c 2. s'il y a eu du deraffinement, il faut construire la table qui faitc
 117 c    passer de l'ancien au nouveau numero de noeud HOMARD. Cela permet
 118 c    de trouver le bon numero pour la connectivite.
 119 c    remarque : cela aurait pu etre fait dans cmdcno, mais on prefere
 120 c    le mettre ici pour ne pas polluer la phase d'adaptation avec des
 121 c    informations sur les elemenst exotiques.
 122 c====
 123 c
 124       if ( deraff ) then
 125 c
 126         do 21 , noeud = 1 , nbnoto
 127           if ( ancnoe(noeud).gt.0 ) then
 128             trav1a(ancnoe(noeud)) = noeud
 129           endif
 130    21   continue
 131 c
 132       endif
 133 c
 134 c====
 135 c 3. on passe en revue chaque maille.
 136 c    quand c'est un element qui doit etre ignore on memorise son
 137 c    nombre de noeuds et on transfere sa description dans la structure
 138 c    HOMARD
 139 c====
 140 c
 141       if ( degre.eq.1 ) then
 142         typeig = edpyr5
 143         nbnoel = 5
 144       else
 145         typeig = edpy13
 146         nbnoel = 13
 147       endif
 148 c
 149       do 31 , iaux = 1 , nbelig
 150 c
 151 #ifdef _DEBUG_HOMARD_
 152       write (ulsort,*) ' '
 153       write (ulsort,*) 'Element ',iaux
 154 #endif
 155 c
 156         elemen = elemen + 1
 157         typele(elemen) = typeig
 158         fameel(elemen) = coueig(iaux)
 159 #ifdef _DEBUG_HOMARD_
 160       write (ulsort,*) '==> elemen = ',elemen
 161       write (ulsort,*) '    noeeig : ',
 162      >                 (noeeig(iaux,noeud),noeud=1,nbnoel)
 163 #endif
 164 c
 165         if ( deraff ) then
 166           do 311 , noeud = 1 , nbnoel
 167             noeele(elemen,noeud) = trav1a(nnosca(noeeig(iaux,noeud)))
 168   311     continue
 169         else
 170           do 312 , noeud = 1 , nbnoel
 171             noeele(elemen,noeud) = nnosca(noeeig(iaux,noeud))
 172   312     continue
 173         endif
 174 #ifdef _DEBUG_HOMARD_
 175       write (ulsort,*) '    noeele : ',
 176      > (noeele(elemen,noeud),noeud=1,nbnoel)
 177 #endif
 178 c
 179    31 continue
 180 c
 181 c====
 182 c 4. la fin
 183 c====
 184 c
 185       if ( codret.ne.0 ) then
 186 c
 187 #include "envex2.h"
 188 c
 189       write (ulsort,texte(langue,1)) 'Sortie', nompro
 190       write (ulsort,texte(langue,2)) codret
 191 c
 192       endif
 193 c
 194 #ifdef _DEBUG_HOMARD_
 195       write (ulsort,texte(langue,1)) 'Sortie', nompro
 196       call dmflsh (iaux)
 197 #endif
 198 c
 199       end