src/tool/Utilitaire/utarpe.F

   1       subroutine utarpe ( lepent,
   2      >                    nbquto, nbpecf,
   3      >                    arequa, facpen, cofape,
   4      >                    listar )
   5 c
   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     UTilitaire : ARetes d'un PEntaedre decrit par ses faces
  27 c     --           --          --
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . lepent . e   .  1     . numero du pentaedre a examiner             .
  33 c . nbquto . e   .  1     . nombre total de quadrangles                .
  34 c . nbpecf . e   .  1     . nombre total de pentaedres                 .
  35 c . arequa . e   .nbquto*4. numeros des 4 aretes des quadrangles       .
  36 c . facpen . e   .nbpecf*5. numeros des 5 faces des pentaedres         .
  37 c . cofape . e   .nbpecf*5. codes des 5 faces des pentaedres           .
  38 c . listar .  s  .   9    . les 9 aretes du pentaedre                  .
  39 c .____________________________________________________________________.
  40 c
  41 c====
  42 c 0. declarations et dimensionnement
  43 c====
  44 c
  45 c 0.1. ==> generalites
  46 c
  47       implicit none
  48       save
  49 c
  50 c 0.2. ==> communs
  51 c
  52 #include "j1234j.h"
  53 c
  54 c 0.3. ==> arguments
  55 c
  56       integer lepent
  57       integer nbquto, nbpecf
  58       integer listar(9)
  59       integer arequa(nbquto,4)
  60       integer facpen(nbpecf,5), cofape(nbpecf,5)
  61 c
  62 c 0.4. ==> variables locales
  63 c
  64       integer lafac3, lafac4, lafac5
  65       integer codfa3, codfa4, codfa5
  66 c
  67 c Sur ce croquis, semblable a la documentation sur les structures de
  68 c donnees, la droite S2-S5 est a l'arriere-plan.
  69 c
  70 c          S3                   a9                     S6
  71 c           x------------------------------------------x
  72 c          .                                          .
  73 c         .  .                                       .  .
  74 c     a3 .                                       a6 .
  75 c       .     .                                    .     .
  76 c      .                                          .
  77 c     .        .a1                               .        .a4
  78 c    .                                          .
  79 c S2.           .       a8                   S5.           .
  80 c  x - - - - - - - - - - - - - - - - - - - - -x
  81 c     .          .                               .          .
  82 c          .                                          .
  83 c        a2    .  .                                 a5    .  .
  84 c                  x------------------------------------------x
  85 c                 S1                   a7                     S4
  86 c   La face f1 est le triangle (S1,S2,S3).
  87 c   La face f2 est le triangle (S4,S6,S5).
  88 c   L'arete a1 est relie les sommets S1 et S3.
  89 c   Les aretes (a1,a2,a3) realisent une rotation entrante dans le
  90 c   pentaedre. L'arete ai+3 est parallele a l'arete ai.
  91 c   La face fi, 3<=i<=5, est le quadrangle s'appuyant sur l'arete ai-2.
  92 c
  93 c remarque : le schema de mmag35 doit etre similaire
  94 c====
  95 c 1. traitement
  96 c====
  97 c
  98       lafac3 = facpen(lepent,3)
  99       lafac4 = facpen(lepent,4)
 100       lafac5 = facpen(lepent,5)
 101 c
 102       codfa3 = cofape(lepent,3)
 103       codfa4 = cofape(lepent,4)
 104       codfa5 = cofape(lepent,5)
 105 c
 106       listar(1)  = arequa(lafac3,j1(codfa3))
 107       listar(2)  = arequa(lafac4,j1(codfa4))
 108       listar(3)  = arequa(lafac5,j1(codfa5))
 109       listar(4)  = arequa(lafac3,j3(codfa3))
 110       listar(5)  = arequa(lafac4,j3(codfa4))
 111       listar(6)  = arequa(lafac5,j3(codfa5))
 112       listar(7)  = arequa(lafac3,j4(codfa3))
 113       listar(8)  = arequa(lafac4,j4(codfa4))
 114       listar(9)  = arequa(lafac5,j4(codfa5))
 115 c
 116       end