src/tool/AP_Conversion/pcsi00.F

   1       subroutine pcsi00 ( nbfop2, profho, vap2ho,
   2      >                    somare, np2are,
   3      >                    nbarco, nuaret )
   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 -
  25 c     -                 -             -
  26 c    interpolation iso/p2 sur les noeuds - phase 00
  27 c                  -                             --
  28 c    Moyenne des valeurs aux extremites d'un ensmble d'aretes
  29 c ______________________________________________________________________
  30 c .        .     .        .                                            .
  31 c .  nom   . e/s . taille .           description                      .
  32 c .____________________________________________________________________.
  33 c . nbfop2 . e   .    1   . nombre de fonctions P2                     .
  34 c . profho . es  .   *    . pour chaque entite en numerotation homard :.
  35 c .        .     .        . 0 : l'entite est absente du profil         .
  36 c .        .     .        . 1 : l'entite est presente dans le profil   .
  37 c . vap2ho . es  . nbfop2*. variables p2 numerotation homard           .
  38 c .        .     . nbnoto .                                            .
  39 c . somare . e   .2*nbarto. numeros des extremites d'arete             .
  40 c . np2are . e   . nbarto . numero des noeuds p2 milieux d'aretes      .
  41 c . nbarco . e   .   1    . nombre d'aretes concernees                 .
  42 c . nuaret . e   . nbarco . numero des aretes a traiter                .
  43 c ______________________________________________________________________
  44 c
  45 c====
  46 c 0. declarations et dimensionnement
  47 c====
  48 c
  49 c 0.1. ==> generalites
  50 c
  51       implicit none
  52       save
  53 c
  54 #include "fracta.h"
  55 c
  56 c 0.2. ==> communs
  57 c
  58 #include "nombar.h"
  59 c
  60 c 0.3. ==> arguments
  61 c
  62       integer nbfop2
  63       integer profho(*)
  64       integer somare(2,nbarto), np2are(nbarto)
  65       integer nbarco, nuaret(nbarco)
  66 c
  67       double precision vap2ho(nbfop2,*)
  68 c
  69 c 0.4. ==> variables locales
  70 c
  71       integer iaux
  72       integer larete
  73       integer s1, s2, sm, nuv
  74 c ______________________________________________________________________
  75 c
  76 #include "impr03.h"
  77 c
  78 cgn      write(1,90002) 'Aretes', (nuaret(iaux),iaux=1,nbarco)
  79 c
  80       do 10 , iaux = 1 , nbarco
  81 c
  82 c====
  83 c 1. L'arete concernee
  84 c====
  85         larete = nuaret(iaux)
  86 cgn      write(1,90002) 'larete',larete
  87 c
  88 c====
  89 c 2. Interpolation
  90 c====
  91 c
  92         s1 = somare(1,larete)
  93         s2 = somare(2,larete)
  94         sm = np2are(larete)
  95 cgn      write(1,90002) 'sm =',sm
  96 c
  97         profho(sm) = 1
  98 c
  99         do 21 , nuv = 1, nbfop2
 100 c
 101 cgn        write(1,90002) 'sommets',s1, s2)
 102           vap2ho(nuv,sm) = unsde * ( vap2ho(nuv,s1) + vap2ho(nuv,s2) )
 103 cgn          write(1,*) 'vap2ho(nuv,',sm,') =',vap2ho(nuv,sm)
 104    21   continue
 105 c
 106    10 continue
 107 c
 108       end