src/tool/Utilitaire/utarpy.F

   1       subroutine utarpy ( lapyra,
   2      >                    nbtrto, nbpycf,
   3      >                    aretri, facpyr, cofapy,
   4      >                    listar )
   5
   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'une PYramide decrite par ses faces
  27 c     --           --           --
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . lapyra . e   .  1     . numero de la pyramide a examiner           .
  33 c . nbtrto . e   .  1     . nombre total de triangles                  .
  34 c . nbpycf . e   .  1     . nombre total de pyramides                  .
  35 c . aretri . e   .nbtrto*3. numeros des 3 aretes des triangles         .
  36 c . facpyr . e   .nbpycf*5. numeros des 5 faces des pyramides          .
  37 c . cofapy . e   .nbpycf*5. codes des 5 faces des pyramides            .
  38 c . listar .  s  .   8    . les 8 aretes de la pyramide                .
  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 "i1i2i3.h"
  53 c
  54 c 0.3. ==> arguments
  55 c
  56       integer lapyra
  57       integer nbtrto, nbpycf
  58       integer listar(8)
  59       integer aretri(nbtrto,3)
  60       integer facpyr(nbpycf,5), cofapy(nbpycf,5)
  61 c
  62 c 0.4. ==> variables locales
  63 c
  64       integer lafac1, lafac2, lafac3, lafac4
  65       integer codfa1, codfa2, codfa3, codfa4
  66 c
  67 c 0.5. ==> initialisations
  68 c ______________________________________________________________________
  69 c
  70 c                            S5
  71 c                            x
  72 c                         . . . .
  73 c                       .  .   .   .
  74 c                     .   .   a4.     .
  75 c                   .    .       .       .
  76 c                 .     .        x .         .
  77 c            a1 .      .     .   S4    .        .a3
  78 c             .       .  .                 .       .
  79 c           .        .                         .      .
  80 c         .      .  .                           a7 .     .
  81 c       .    .a8   .                                   .    .
  82 c     .  .        .                                        .   .
  83 c S1 .           .a2                                           .  .
  84 c  x .         .                                                  .  .
  85 c     a5  .    .                                                      .
  86 c             x--------------------------------------------------------x
  87 c           S2                            a6                          S3
  88 c   La face f5 est le quadrangle.
  89 c   La face fi, i<5, est le triangle s'appuyant sur l'arete ai.
  90 c
  91 c====
  92 c 1. traitement
  93 c====
  94 c
  95       lafac1 = facpyr(lapyra,1)
  96       lafac2 = facpyr(lapyra,2)
  97       lafac3 = facpyr(lapyra,3)
  98       lafac4 = facpyr(lapyra,4)
  99 c
 100       codfa1 = cofapy(lapyra,1)
 101       codfa4 = cofapy(lapyra,4)
 102       codfa2 = cofapy(lapyra,2)
 103       codfa3 = cofapy(lapyra,3)
 104 cgn      print 1789, 'triangles ',lafac1, lafac2, lafac3, lafac4
 105 cgn      print 1789, 'codes     ',codfa1, codfa2, codfa3, codfa4
 106 cgn 1789 format(a,5i10)
 107 c
 108       listar(1)  = aretri(lafac1,i1(codfa1))
 109       listar(2)  = aretri(lafac1,i2(codfa1))
 110       listar(3)  = aretri(lafac2,i2(codfa2))
 111       listar(4)  = aretri(lafac3,i2(codfa3))
 112       listar(5)  = aretri(lafac1,i3(codfa1))
 113       listar(6)  = aretri(lafac2,i3(codfa2))
 114       listar(7)  = aretri(lafac3,i3(codfa3))
 115       listar(8)  = aretri(lafac4,i2(codfa4))
 116 c
 117       end