src/tool/Utilitaire/utsrc2.F

   1       subroutine utsrc2 ( nbtafo, ngauss, nbento,
   2      >                    profil, vafott, vafosc )
   3 c ______________________________________________________________________
   4 c
   5 c                             H O M A R D
   6 c
   7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   8 c
   9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  10 c aupres des huissiers de justice Simart et Lavoir a Clamart
  11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  12 c aupres des huissiers de justice
  13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  14 c
  15 c    HOMARD est une marque deposee d'Electricite de France
  16 c
  17 c Copyright EDF 1996
  18 c Copyright EDF 1998
  19 c Copyright EDF 2002
  20 c Copyright EDF 2020
  21 c ______________________________________________________________________
  22 c
  23 c    UTilitaire - Solution - Renumeration du Calcul - option 2
  24 c    --           -          -               -               -
  25 c  remarque : utsrc2 et utsrc4 sont des clones
  26 c             2 : double precision
  27 c             4 : entier
  28 c ______________________________________________________________________
  29 c .        .     .        .                                            .
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . nbtafo . e   .    1   . nombre de tableaux de la fonction          .
  33 c . nbento . e   .    1   . nombre d'entites                           .
  34 c . ngauss . e   .   1    . nbre de points de Gauss des fonctions pg   .
  35 c . profil . e   . nbento . pour chaque entite :                       .
  36 c .        .     .        . 0 : l'entite est absente du profil         .
  37 c .        .     .        . 1 : l'entite est presente dans le profil   .
  38 c . vafott .   a . nbtafo*. tableau temporaire de la solution          .
  39 c .        .     .    *   .                                            .
  40 c . vafosc .  s  . nbtafo*. variables en sortie pour le calcul         .
  41 c .        .     .   *    .                                            .
  42 c ______________________________________________________________________
  43 c
  44 c====
  45 c 0. declarations et dimensionnement
  46 c====
  47 c
  48 c 0.1. ==> generalites
  49 c
  50       implicit none
  51       save
  52 c
  53 c 0.2. ==> communs
  54 c
  55 c 0.3. ==> arguments
  56 c
  57       integer nbtafo, ngauss, nbento
  58       integer profil(nbento)
  59 c
  60       double precision vafott(nbtafo,ngauss,*)
  61       double precision vafosc(nbtafo,ngauss,*)
  62 c
  63 c 0.4. ==> variables locales
  64 c
  65       integer nuv, nugaus
  66       integer iaux, jaux
  67 c ______________________________________________________________________
  68 c
  69 c====
  70 c 1. on compacte
  71 c====
  72 c
  73       do 11 , nuv = 1, nbtafo
  74         jaux = 0
  75         do 111 , iaux = 1, nbento
  76           if ( profil(iaux).gt.0 ) then
  77             jaux = jaux + 1
  78             do 1111 , nugaus = 1 , ngauss
  79               vafosc(nuv,nugaus,jaux) = vafott(nuv,nugaus,iaux)
  80  1111       continue
  81           endif
  82   111   continue
  83    11 continue
  84 c
  85       end