src/tool/AP_Conversion/pcsite.F

   1       subroutine pcsite ( nbfop2, profho, vap2ho,
   2      >                    tritet, cotrte, aretet,
   3      >                    hettet, filtet,
   4      >                    somare, np2are,
   5      >                    aretri )
   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    aPres adaptation - Conversion de Solution -
  27 c     -                 -             -
  28 c    interpolation iso-p2 sur les noeuds - decoupage des TEtraedres
  29 c                  -                                     --
  30 c ______________________________________________________________________
  31 c attention : il faut passer ce programme avant le traitement des
  32 c             nouveaux noeuds sur les triangles coupes, sinon les
  33 c             valeurs sur les noeuds des diagonales seront inconnues
  34 c remarque : on devrait optimiser cela car si le tetraedre etait dans
  35 c            un etat de decoupage de conformite similaire, on recalcule
  36 c            une valeur qui est deja presente
  37 c remarque : pcs2te et pcsite sont des clones
  38 c ______________________________________________________________________
  39 c .        .     .        .                                            .
  40 c .  nom   . e/s . taille .           description                      .
  41 c .____________________________________________________________________.
  42 c . nbfop2 . e   .    1   . nombre de fonctions P2                     .
  43 c . profho . es  .   *    . pour chaque entite en numerotation homard :.
  44 c .        .     .        . 0 : l'entite est absente du profil         .
  45 c .        .     .        . 1 : l'entite est presente dans le profil   .
  46 c . vap2ho . es  . nbfop2*. variables p2 numerotation homard           .
  47 c .        .     . nbnoto .                                            .
  48 c . tritet . e   .nbtecf*4. numeros des 4 triangles des tetraedres     .
  49 c . cotrte . e   .nbtecf*4. code des 4 triangles des tetraedres        .
  50 c . aretet . e   .nbteca*6. numeros des 6 aretes des tetraedres        .
  51 c . hettet . e   . nbteto . historique de l'etat des tetraedres        .
  52 c . filtet . e   . nbteto . premier fils des tetraedres                .
  53 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  54 c . np2are . e   . nbarto . numero des noeuds p2 milieux d'aretes      .
  55 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  56 c ______________________________________________________________________
  57 c
  58 c====
  59 c 0. declarations et dimensionnement
  60 c====
  61 c
  62 c 0.1. ==> generalites
  63 c
  64       implicit none
  65       save
  66 c
  67 #include "fracta.h"
  68 c
  69 c 0.2. ==> communs
  70 c
  71 #include "nombno.h"
  72 #include "nombar.h"
  73 #include "nombtr.h"
  74 #include "nombte.h"
  75 c
  76 c 0.3. ==> arguments
  77 c
  78       integer nbfop2
  79       integer profho(nbnoto)
  80       integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
  81       integer hettet(nbteto), filtet(nbteto)
  82       integer somare(2,nbarto), np2are(nbarto)
  83       integer aretri(nbtrto,3)
  84 c
  85       double precision vap2ho(nbfop2,*)
  86 c
  87 c 0.4. ==> variables locales
  88 c
  89       integer iaux
  90       integer letetr, adiag
  91       integer sm, nuv
  92       integer ni, nj
  93       integer listar(6), listno(10)
  94 c
  95       logical afaire
  96 c ______________________________________________________________________
  97 cgn       write (*,*) 'PCSITE'
  98 c
  99       do 10 , letetr = 1, nbteto
 100 c
 101 c====
 102 c 1. interpolation iso-p2 pour un tetraedre qui vent d'etre decoupe
 103 c    les seuls cas interessants sont ceux ou un noeud est cree a
 104 c    l'interieur du tetraedre, donc quand il y a une diagonale.
 105 c====
 106 c
 107         iaux = letetr
 108         call pcs0te ( iaux, profho,
 109      >                tritet, cotrte, aretet,
 110      >                hettet, filtet,
 111      >                aretri,
 112      >                somare, np2are,
 113      >                afaire, listar, listno, adiag )
 114 c
 115 c====
 116 c 2. le tetraedre vient d'etre decoupe et le champ est present
 117 c    interpolation au noeud milieu de la diagonale
 118 c====
 119 c
 120         if ( afaire ) then
 121 c
 122           ni = somare(1,adiag)
 123           nj = somare(2,adiag)
 124 c
 125           sm = np2are(adiag)
 126           profho(sm) = 1
 127 c
 128 c         interpolation p1 : interpolee (ui,i=1,2) = 1/2 (u1+u2)
 129 c
 130           do 22 , nuv = 1, nbfop2
 131 c
 132             vap2ho(nuv,sm) = unsde * ( vap2ho(nuv,ni) + vap2ho(nuv,nj) )
 133 c
 134    22     continue
 135 c
 136         endif
 137 c
 138    10 continue
 139 c
 140       end