src/tool/Creation_Maillage/cmcpya.F

   1       subroutine cmcpya ( arepyr, fampyr,
   2      >                    hetpyr, filpyr, perpyr,
   3      >                    naret1, naret2, naret3, naret4,
   4      >                    naret5, naret6, naret7, naret8,
   5      >                    nupere, famill, nupyra )
   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    Creation du Maillage - Creation d'une PYramide par ses Aretes
  27 c    -           -          -              --               -
  28 c ______________________________________________________________________
  29 c
  30 c but : creation effective d'une pyramide etant donne :
  31 c       - le numero de la pyramide
  32 c       - les numeros globaux des aretes
  33 c       - le numero du pere
  34 c       - la famille a attribuer
  35 c ______________________________________________________________________
  36 c .        .     .        .                                            .
  37 c .  nom   . e/s . taille .           description                      .
  38 c .____________________________________________________________________.
  39 c . arepyr . es  .provya*8. numeros des aretes des pyramides           .
  40 c . fampyr . es  . nouvpy . famille des pyramides                      .
  41 c . hetpyr . es  . nouvpy . historique de l'etat des pyramides         .
  42 c . filpyr . es  . nouvpy . premier fils des pyramides                 .
  43 c . perpyr . es  . nouvpy . pere des pyramides                         .
  44 c .        .     .        . si perpyr(i) > 0 : numero de la pyramide   .
  45 c .        .     .        . si perpyr(i) < 0 : -numero dans pphepe     .
  46 c . nareti . e   . 1      . arete de numero local i dans la pyramide   .
  47 c . nupere . e   . 1      . numero du pere de la pyramide              .
  48 c . famill . e   . 1      . famille a attribuer a la pyramide          .
  49 c . nupyra . e   . 1      . numero de la pyramide a creer              .
  50 c ______________________________________________________________________
  51 c
  52 c====
  53 c 0. declarations et dimensionnement
  54 c====
  55 c
  56 c 0.1. ==> generalites
  57 c
  58       implicit none
  59       save
  60 c
  61 c 0.2. ==> communs
  62 c
  63 #include "nouvnb.h"
  64 c
  65 c 0.3. ==> arguments
  66 c
  67       integer arepyr(provya,8), fampyr(nouvpy)
  68       integer hetpyr(nouvpy), filpyr(nouvpy), perpyr(nouvpy)
  69       integer naret1, naret2, naret3, naret4
  70       integer naret5, naret6, naret7, naret8
  71       integer nupere, famill, nupyra
  72 c
  73 c 0.4. ==> variables locales
  74 c
  75       integer iaux
  76 c ______________________________________________________________________
  77 c
  78 #include "impr03.h"
  79 c
  80 c====
  81 c 1. creation effective d'une pyramide
  82 c====
  83 #ifdef _DEBUG_HOMARD_
  84       write (*,90002) 'nupyra', nupyra
  85       write (*,90002) 'nouvya', nouvya
  86       write (*,90002) 'nouvyf', nouvyf
  87       write (*,90015) 'Pyramide', nupyra,
  88      >                ', aretes', naret1, naret2, naret3, naret4,
  89      >                            naret5, naret6, naret7, naret8
  90 #endif
  91 c
  92       iaux = nupyra - nouvyf
  93       arepyr(iaux,1) = naret1
  94       arepyr(iaux,2) = naret2
  95       arepyr(iaux,3) = naret3
  96       arepyr(iaux,4) = naret4
  97       arepyr(iaux,5) = naret5
  98       arepyr(iaux,6) = naret6
  99       arepyr(iaux,7) = naret7
 100       arepyr(iaux,8) = naret8
 101 c
 102       fampyr(nupyra) = famill
 103 c
 104       hetpyr(nupyra) = 5500
 105       filpyr(nupyra) = 0
 106       perpyr(nupyra) = nupere
 107 c
 108       end