src/tool/Utilitaire/utnpen.F

   1       subroutine utnpen ( lepent, niveau,
   2      >                    facpen, perpen,
   3      >                    nivtri, nivqua )
   4 c ______________________________________________________________________
   5 c
   6 c                             H O M A R D
   7 c
   8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   9 c
  10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  11 c aupres des huissiers de justice Simart et Lavoir a Clamart
  12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  13 c aupres des huissiers de justice
  14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  15 c
  16 c    HOMARD est une marque deposee d'Electricite de France
  17 c
  18 c Copyright EDF 1996
  19 c Copyright EDF 1998
  20 c Copyright EDF 2002
  21 c Copyright EDF 2020
  22 c ______________________________________________________________________
  23 c
  24 c     UTilitaire : Niveau d'un PENtaedre
  25 c     --           -           ---
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . lepent . e   .  1     . numero du pentaedre a examiner             .
  31 c . niveau .  s  .  1     . niveau                                     .
  32 c . facpen . e   .nbpecf*5. numeros des 5 faces des pentaedres         .
  33 c . perpen . e   . nbpeto . pere des pentaedres                        .
  34 c . nivtri . e   . nbtrto . niveau dans le raffinement/deraffinement   .
  35 c . nivqua . e   . nbquto . niveau dans le raffinement/deraffinement   .
  36 c ______________________________________________________________________
  37 c
  38 c====
  39 c 0. declarations et dimensionnement
  40 c====
  41 c
  42 c 0.1. ==> generalites
  43 c
  44       implicit none
  45       save
  46 c
  47 c 0.2. ==> communs
  48 c
  49 #include "nombtr.h"
  50 #include "nombqu.h"
  51 #include "nombpe.h"
  52 c
  53 c 0.3. ==> arguments
  54 c
  55       double precision niveau
  56 c
  57       integer lepent
  58       integer facpen(nbpecf,5), perpen(nbpeto)
  59       integer nivtri(nbtrto), nivqua(nbquto)
  60 c
  61 c 0.4. ==> variables locales
  62 c
  63       integer lafac1, lafac2, lafac3, lafac4, lafac5
  64       integer lepere
  65       integer iaux, jaux
  66 c
  67 c 0.5. ==> initialisations
  68 c
  69 #include "impr03.h"
  70 c
  71 cgn      write(*,90002) 'nbpema, nbpecf, nbpeto', nbpema, nbpecf, nbpeto
  72 cgn      write(*,90002) 'nbheco', nbheco
  73 c
  74 c====
  75 c 1. Du maillage initial
  76 c====
  77 c
  78       if ( lepent.le.nbpema ) then
  79 c
  80         niveau = 0.d0
  81 c
  82 c====
  83 c 2. Au dela
  84 c====
  85 c
  86       else
  87 c
  88 c 2.1. ==> Si le pentaedre est decrit par faces :
  89 c            le plus haut niveau de ses faces
  90 c
  91         if ( lepent.le.nbpecf ) then
  92 c
  93           lafac1 = facpen(lepent,1)
  94           lafac2 = facpen(lepent,2)
  95           lafac3 = facpen(lepent,3)
  96           lafac4 = facpen(lepent,4)
  97           lafac5 = facpen(lepent,5)
  98           jaux = max(nivtri(lafac1),nivtri(lafac2),
  99      >               nivqua(lafac3),nivqua(lafac4),nivqua(lafac5))
 100 c
 101 c 2.2. ==> Si le pentaedre est decrit par aretes :
 102 c            son niveau est le niveau du pere augmente d'un cran
 103 c
 104         else
 105 c
 106           iaux = perpen(lepent)
 107 c
 108           if ( iaux.gt.0 ) then
 109             lepere = iaux
 110           else
 111             write(*,90002) 'lepent, iaux', lepent, iaux
 112             write(*,*) 'arret dans utnpen'
 113             STOP
 114           endif
 115 cgn      write(*,90002) 'iaux, lepere', iaux, lepere
 116 c
 117           if ( iaux.gt.0 ) then
 118 c
 119             lafac1 = facpen(lepere,1)
 120             lafac2 = facpen(lepere,2)
 121             lafac3 = facpen(lepere,3)
 122             lafac4 = facpen(lepere,4)
 123             lafac5 = facpen(lepere,5)
 124             jaux = max(nivtri(lafac1),nivtri(lafac2),
 125      >                 nivqua(lafac3),nivqua(lafac4),nivqua(lafac5))
 126 c
 127           endif
 128 c
 129           jaux = jaux + 1
 130 c
 131         endif
 132 c
 133 cgn      write(*,90002) '==> jaux',jaux
 134         niveau = dble(jaux)
 135 c
 136 c====
 137 c 3. Si le pentaedre est de conformite, on prend le niveau
 138 c            intermediaire immediatement inferieur
 139 c====
 140 c
 141         if ( lepent.gt.nbpepe ) then
 142           niveau = niveau - 0.5d0
 143         endif
 144 c
 145       endif
 146 cgn      write(*,90004) '==> niveau',niveau
 147 c
 148       end