src/tool/AP_Conversion/pcs0te.F

   1       subroutine pcs0te ( letetr, profho,
   2      >                    tritet, cotrte, aretet,
   3      >                    hettet, filtet,
   4      >                    aretri,
   5      >                    somare, np2are,
   6      >                    afaire, listar, listno, adiag )
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c    aPres adaptation - Conversion de Solution -
  28 c     -                 -             -
  29 c    interpolation p2 sur les noeuds - phase 0
  30 c                                            -
  31 c    decoupage des TEtraedres
  32 c                  --
  33 c ______________________________________________________________________
  34 c .        .     .        .                                            .
  35 c .  nom   . e/s . taille .           description                      .
  36 c .____________________________________________________________________.
  37 c . letetr . e   .    1   . tetraedre a examiner                       .
  38 c . profho . e   .   *    . pour chaque entite en numerotation homard :.
  39 c .        .     .        . 0 : l'entite est absente du profil         .
  40 c .        .     .        . 1 : l'entite est presente dans le profil   .
  41 c . tritet . e   .nbtecf*4. numeros des 4 triangles des tetraedres     .
  42 c . cotrte . e   .nbtecf*4. code des 4 triangles des tetraedres        .
  43 c . aretet . e   .nbteca*6. numeros des 6 aretes des tetraedres        .
  44 c . hettet . e   . nbteto . historique de l'etat des tetraedres        .
  45 c . filtet . e   . nbteto . premier fils des tetraedres                .
  46 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  47 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  48 c . np2are . e   . nbarto . numero des noeuds p2 milieux d'aretes      .
  49 c . afaire .  s  .    1   . vrai si l'interpolation est a faire        .
  50 c . listar .  s  .    6   . liste des aretes du tetraedre              .
  51 c . listno .  s  .   10   . liste des noeuds du tetraedre              .
  52 c . adiag  .  s  .    1   . arete diagonale si interpolation           .
  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 c 0.2. ==> communs
  65 c
  66 #include "nombno.h"
  67 #include "nombar.h"
  68 #include "nombtr.h"
  69 #include "nombte.h"
  70 c
  71 c 0.3. ==> arguments
  72 c
  73       integer letetr
  74       integer profho(nbnoto)
  75       integer tritet(nbtecf,4), cotrte(nbtecf,4), aretet(nbteca,6)
  76       integer hettet(nbteto), filtet(nbteto)
  77       integer aretri(nbtrto,3)
  78       integer somare(2,nbarto), np2are(nbarto)
  79       integer listar(6), listno(10)
  80       integer adiag
  81 c
  82       logical afaire
  83 c
  84 c 0.4. ==> variables locales
  85 c
  86       integer iaux
  87       integer typdec
  88       integer t16ff1, t25ff1, t34ff1, td16a2, td25a1, td34a1
  89       integer fd16n4, fd25n4, fd34n5, fd16s3, fd25s2, fd34s2
  90 c
  91 c     etan   = ETAt du tetraedre a l'iteration N
  92 c     etanp1 = ETAt du tetraedre a l'iteration N+1
  93 c
  94       integer etan, etanp1
  95 c ______________________________________________________________________
  96 c
  97 c====
  98 c 1. les seuls cas interessants sont ceux ou un noeud est cree a
  99 c    l'interieur du tetraedre, donc quand il y a une diagonale.
 100 c====
 101 c
 102       etanp1 = mod( hettet(letetr), 100 )
 103       etan   = (hettet(letetr)-etanp1) / 100
 104 c
 105 c     type de decoupage
 106 c          8 : en 8 standard
 107 c          45, 46, 47 : en 4 par 2 fois 2 selon l'arete 5, 6, 7
 108 c
 109       if ( ( etanp1.eq.85 .or. etanp1.eq.86 .or. etanp1.eq.87 ) .and.
 110      >     ( etan.ne.etanp1 ) ) then
 111         typdec = 8
 112 c
 113       elseif (
 114      >     etanp1.eq.45 .or. etanp1.eq.46 .or. etanp1.eq.47 ) then
 115         typdec = etanp1
 116 c
 117       else
 118         typdec = 0
 119 c
 120       endif
 121 c
 122 c====
 123 c 2. Caracteristiques du tetraedre
 124 c====
 125 c
 126       if ( typdec.ne.0 ) then
 127 c
 128 c 2.1. ==> reperage des aretes et des sommets du tetraedre
 129 c
 130         call utaste ( letetr,
 131      >                nbtrto, nbtecf, nbteca,
 132      >                somare, aretri,
 133      >                tritet, cotrte, aretet,
 134      >                listar, listno )
 135 c
 136 c 2.2. ==> recuperation des 6 noeuds milieux
 137 c
 138         do 22  , iaux = 1 , 6
 139           listno(4+iaux) = np2are(listar(iaux))
 140    22   continue
 141 c
 142       endif
 143 c
 144 c====
 145 c 3. on verifie que le champ est present sur tous les noeuds
 146 c    du tetraedre
 147 c====
 148 c
 149       if ( typdec.ne.0 ) then
 150 c
 151         afaire = .true.
 152         do 31  , iaux = 1 , 10
 153           if ( profho(listno(iaux)).eq.0 ) then
 154             afaire = .false.
 155             goto 32
 156           endif
 157    31   continue
 158 c
 159    32   continue
 160 c
 161       else
 162 c
 163         afaire = .false.
 164 c
 165       endif
 166 c
 167 c====
 168 c 4. S'il faudra interpoler, on cherche la diagonale
 169 c====
 170 c
 171       if ( afaire ) then
 172 c
 173 c 4.1. ==> le tetraedre vient d'etre decoupee en 8 par (1,6)
 174 c
 175         if ( etanp1.eq.85 ) then
 176 c
 177           t16ff1 = filtet(letetr) + 4
 178           fd16n4 = tritet(t16ff1,3)
 179           adiag = aretri(fd16n4,1)
 180 c
 181 c 4.2. ==> le tetraedre vient d'etre decoupee en 8 par (2,5)
 182 c
 183         elseif ( etanp1.eq.86 ) then
 184 c
 185           t25ff1 = filtet(letetr) + 4
 186           fd25n4 = tritet(t25ff1,2)
 187           adiag = aretri(fd25n4,1)
 188 c
 189 c 4.3. ==> le tetraedre vient d'etre decoupee en 8 par (3,4)
 190 c
 191         elseif ( etanp1.eq.87 ) then
 192 c
 193           t34ff1 = filtet(letetr) + 4
 194           fd34n5 = tritet(t34ff1,2)
 195           adiag = aretri(fd34n5,2)
 196 c
 197 c 4.4. ==> le tetraedre vient d'etre decoupee en 4 par (1,6)
 198 c
 199         elseif ( etanp1.eq.45 ) then
 200 c
 201           td16a2 = filtet(letetr)
 202           fd16s3 = tritet(td16a2,1)
 203           adiag = aretri(fd16s3,2)
 204 c
 205 c 4.5. ==> le tetraedre vient d'etre decoupee en 4 par (2,5)
 206 c
 207         elseif ( etanp1.eq.46 ) then
 208 c
 209           td25a1 = filtet(letetr)
 210           fd25s2 = tritet(td25a1,1)
 211           adiag = aretri(fd25s2,3)
 212 c
 213 c 4.6. ==> le tetraedre vient d'etre decoupee en 4 par (3,4)
 214 c
 215         elseif ( etanp1.eq.47 ) then
 216 c
 217           td34a1 = filtet(letetr)
 218           fd34s2 = tritet(td34a1,1)
 219           adiag = aretri(fd34s2,3)
 220 c
 221         endif
 222 c
 223       endif
 224 c
 225       end