src/tool/AP_Conversion/pcsprn.F

   1       subroutine pcsprn ( typprf, numnp1,
   2      >                    hetnoe, nnoeho,
   3      >                    nbvapr, listpr )
   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    aPres adaptation - Conversion de Solution - PRofil - Noeuds
  25 c     -                 -             -          -        -
  26 c ______________________________________________________________________
  27 c .        .     .        .                                            .
  28 c .  nom   . e/s . taille .           description                      .
  29 c .____________________________________________________________________.
  30 c . typprf .  s  .    1   . type du support defini par le profil       .
  31 c .        .     .        . 0 : rien de special                        .
  32 c .        .     .        . 1 : tous les noeuds P1 et eux seuls        .
  33 c .        .     .        . 2 : une partie des noeuds P1               .
  34 c . numnp1 . e   .    1   . nombre de noeuds P1 en entree              .
  35 c . hetnoe . e   . nbnoto . historique de l'etat des noeuds            .
  36 c . nnoeho . e   . renoac . numero des noeuds en entre pour homard     .
  37 c . nbvapr . e   .   1    . nombre de valeurs du profil                .
  38 c . listpr . e   .   *    . liste des numeros de noeuds ou la fonction .
  39 c .        .     .        . est definie.                               .
  40 c ______________________________________________________________________
  41 c
  42 c====
  43 c 0. declarations et dimensionnement
  44 c====
  45 c
  46 c 0.1. ==> generalites
  47 c
  48       implicit none
  49       save
  50 c
  51 cgn      character*6 nompro
  52 cgn      parameter ( nompro = 'PCSPRN' )
  53 c
  54 c 0.2. ==> communs
  55 c
  56 #include "nomber.h"
  57 #include "nombno.h"
  58 c
  59 c 0.3. ==> arguments
  60 c
  61       integer typprf
  62       integer numnp1
  63 c
  64       integer nbvapr, listpr(*)
  65 c
  66       integer hetnoe(nbnoto)
  67       integer nnoeho(renoac)
  68 c
  69 c 0.4. ==> variables locales
  70 c
  71       integer iaux, jaux
  72       integer nbnpr1, nbnpr2
  73 c ______________________________________________________________________
  74 c
  75       nbnpr1 = 0
  76       nbnpr2 = 0
  77 c
  78 c====
  79 c 1. si le maillage est inchange ou s'il n'y a eu que du raffinement,
  80 c    chaque noeud en entree de HOMARD est encore un noeud en sortie.
  81 c    Le numero d'un noeud dans HOMARD reste inchange.
  82 c    Il suffit de tester l'etat du noeud en entree
  83 c     Numero dans le calcul en entree  <--->  Numero HOMARD
  84 c                lenoeu                <--->  nnoeho(lenoeu)
  85 c====
  86 c
  87 cgn      write(*,*) 'Dans pcsprn, nbvapr =', nbvapr
  88 cgn 1789 format(a,'(',i5,',) =',i10,', noeud',i10)
  89 c
  90         do 10 , iaux = 1 , nbvapr
  91 cgn      write (*,1789)'listpr',iaux,listpr(iaux),nnoeho(listpr(iaux))
  92           jaux = hetnoe(nnoeho(listpr(iaux)))
  93           if ( ((jaux-mod(jaux,10))/10).eq.1 ) then
  94             nbnpr1 = nbnpr1 + 1
  95           else
  96             nbnpr2 = nbnpr2 + 1
  97             goto 20
  98           endif
  99    10   continue
 100 c
 101 c====
 102 c 2. Bilan
 103 c    Si au moins un noeud non P1 est dans le profil, c'est du quelconque
 104 c    Sinon, on trie
 105 c====
 106 c
 107    20   continue
 108 c
 109 cgn      write(*,*) 'Dans pcsprn, nbnpr1 =', nbnpr1
 110 cgn      write(*,*) 'Dans pcsprn, nbnpr2 =', nbnpr2
 111 cgn      write(*,*) 'Dans pcsprn, numnp1 =', numnp1
 112       if ( nbnpr2.gt.0 ) then
 113         typprf = 0
 114       else
 115         if ( nbnpr1.eq.numnp1 ) then
 116           typprf = 1
 117         elseif ( nbnpr1.lt.numnp1 ) then
 118           typprf = 2
 119         else
 120           typprf = 0
 121         endif
 122       endif
 123 cgn      write(*,*) 'Dans pcsprn, typprf =', typprf
 124 c
 125       end