src/tool/ES_HOMARD/eslmh6.F

   1       subroutine eslmh6 ( idfmed,
   2      >                    nhelig,
   3      >                    tbiaux,
   4      >                    ulsort, langue, codret)
   5 c
   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  Entree-Sortie : Lecture du Maillage Homard - phase 6
  27 c  -      -        -          -        -              -
  28 c ______________________________________________________________________
  29 c .  nom   . e/s . taille .           description                      .
  30 c .____________________________________________________________________.
  31 c . idfmed . e   .   1    . identificateur du fichier MED              .
  32 c . nhelig . e   . char8  . nom de l'objet decrivant les ignores       .
  33 c . tbiaux .     .    *   . tableau tampon entier                      .
  34 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  35 c . langue . e   .    1   . langue des messages                        .
  36 c .        .     .        . 1 : francais, 2 : anglais                  .
  37 c . codret . es  .    1   . code de retour des modules                 .
  38 c .        .     .        . 0 : pas de probleme                        .
  39 c ______________________________________________________________________
  40 c
  41 c====
  42 c 0. declarations et dimensionnement
  43 c====
  44 c
  45 c 0.1. ==> generalites
  46 c
  47       implicit none
  48       save
  49 c
  50       character*6 nompro
  51       parameter ( nompro = 'ESLMH6' )
  52 c
  53 #include "nblang.h"
  54 #include "consts.h"
  55 c
  56 c 0.2. ==> communs
  57 c
  58 #include "gmenti.h"
  59 c
  60 #include "envca1.h"
  61 #include "envex1.h"
  62 #include "nbutil.h"
  63 c
  64 c 0.3. ==> arguments
  65 c
  66       integer*8 idfmed
  67       integer tbiaux(0:*)
  68 c
  69       character*8 nhelig
  70 c
  71       integer ulsort, langue, codret
  72 c
  73 c 0.4. ==> variables locales
  74 c
  75 #include "meddc0.h"
  76 c
  77       integer iaux, jaux
  78       integer hfmdel, hnoeel
  79       integer nbnoel
  80       integer codre1, codre2, codre3
  81       integer codre0
  82 c
  83       character*64 noprof
  84 c
  85       integer nbmess
  86       parameter ( nbmess = 150 )
  87       character*80 texte(nblang,nbmess)
  88 c ______________________________________________________________________
  89 c
  90 c====
  91 c 1. intialisations
  92 c====
  93 c 1.1. ==> messages
  94 c
  95 #include "impr01.h"
  96 c
  97 #ifdef _DEBUG_HOMARD_
  98       write (ulsort,texte(langue,1)) 'Entree', nompro
  99       call dmflsh (iaux)
 100 #endif
 101 c
 102 #include "esimpr.h"
 103 c
 104 #include "impr03.h"
 105 c
 106 c====
 107 c 2. les elements ignores
 108 c====
 109 c 2.1. ==> Lecture
 110 c
 111       if ( codret.eq.0 ) then
 112 c
 113       noprof = blan64
 114 c                     1234567890123456
 115       noprof(1:16) = 'Elements_Ignores'
 116 c
 117 #ifdef _DEBUG_HOMARD_
 118       write (ulsort,texte(langue,3)) 'MPFPRR', nompro
 119 #endif
 120       call mpfprr ( idfmed, noprof, tbiaux, codret )
 121 c
 122       endif
 123 #ifdef _DEBUG_HOMARD_
 124       write (ulsort,texte(langue,61)) noprof
 125 #endif
 126 c
 127 c 2.2. ==> Allocations
 128 c
 129       if ( codret.eq.0 ) then
 130 c
 131       nbelig = tbiaux(0)
 132 c
 133       if ( degre.eq.1 ) then
 134         nbnoel = 5
 135       else
 136         nbnoel = 13
 137       endif
 138 c
 139       iaux = nbelig * nbnoel
 140       call gmaloj ( nhelig//'.ConnNoeu', ' ', iaux ,  hnoeel, codre1 )
 141       call gmaloj ( nhelig//'.FamilMED', ' ', nbelig, hfmdel, codre2 )
 142       call gmecat ( nhelig, 1, nbelig, codre3 )
 143 c
 144       codre0 = min ( codre1, codre2, codre3 )
 145       codret = max ( abs(codre0), codret,
 146      >               codre1, codre2, codre3 )
 147 c
 148       endif
 149 cgn      write (ulsort,90002) 'tbiaux', (tbiaux(iaux),iaux=1,14)
 150 c
 151 c 2.3. ==> Transfert
 152 c
 153       if ( codret.eq.0 ) then
 154 c
 155       do 231 , iaux = 1 , nbelig
 156         imem(hfmdel+iaux-1) = tbiaux(iaux)
 157   231 continue
 158       jaux = nbelig*nbnoel
 159       do 232 , iaux = 1 , jaux
 160         imem(hnoeel+iaux-1) = tbiaux(nbelig+iaux)
 161   232 continue
 162 c
 163       endif
 164 cgn      call gmprsx ( nompro, nhelig )
 165 cgn      call gmprsx ( nompro, nhelig//'.ConnNoeu' )
 166 cgn      call gmprsx ( nompro, nhelig//'.FamilMED' )
 167 c
 168 c====
 169 c 4. la fin
 170 c====
 171 c
 172       if ( codret.ne.0 ) then
 173 c
 174 #include "envex2.h"
 175 c
 176       write (ulsort,texte(langue,1)) 'Sortie', nompro
 177       write (ulsort,texte(langue,2)) codret
 178 c
 179       endif
 180 c
 181 #ifdef _DEBUG_HOMARD_
 182       write (ulsort,texte(langue,1)) 'Sortie', nompro
 183       call dmflsh (iaux)
 184 #endif
 185 c
 186       end