subroutine eslch5 ( nrtafo,
     >                    nbtafo, nbpg, nbvalc, nbcomp,
     >                    vafonc, trav1,
     >                    obcham, objech,
     >                    ulsort, langue, codret )
c ______________________________________________________________________
c
c                             H O M A R D
c
c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
c
c Version originale enregistree le 18 juin 1996 sous le numero 96036
c aupres des huissiers de justice Simart et Lavoir a Clamart
c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
c aupres des huissiers de justice
c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
c
c    HOMARD est une marque deposee d'Electricite de France
c
c Copyright EDF 1996
c Copyright EDF 1998
c Copyright EDF 2002
c Copyright EDF 2020
c ______________________________________________________________________
c
c  Entree-Sortie - Lecture d'un CHamp au format MED - phase 5
c  -      -        -            --                          -
c  Ce programme est le symetrique de ESECH2
c  Remarque : eslch5 et eslch8 sont des clones
c             5 : double precision
c             8 : entier
c ______________________________________________________________________
c .        .     .        .                                            .
c .  nom   . e/s . taille .           description                      .
c .____________________________________________________________________.
c . nrtafo . es  .   1    . numero courant du tableau de la fonction   .
c . nbtafo . e   .   1    . nombre de tableaux de la fonction          .
c . nbpg   . e   .   1    . nombre de points de Gauss, s'il y en a     .
c .        .     .        . si le champ est sans point de Gauss, nbpg  .
c .        .     .        . vaut 1 pour aider au traitement            .
c . nbvalc . e   .   1    . nombre de valeurs par composante           .
c . nbcomp . e   .   1    . nombre de composantes du champ             .
c . vafonc . es  .   *    . valeurs de la fonction                     .
c . trav1  . e   .   *    . valeurs lues                               .
c . obcham . e   . char8  . nom de l'objet de type 'InfoCham' associe  .
c . objech . es  . nbtafo . nom de l'objet de type 'InfoCham' associe  .
c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
c . langue . e   .    1   . langue des messages                        .
c .        .     .        . 1 : francais, 2 : anglais                  .
c . codret . es  .    1   . code de retour des modules                 .
c .        .     .        . 0 : pas de probleme                        .
c .        .     .        . 1 : probleme                               .
c ______________________________________________________________________
c
c====
c 0. declarations et dimensionnement
c====
c
c 0.1. ==> generalites
c
      implicit none
      save
c
      character*6 nompro
      parameter ( nompro = 'ESLCH5' )
c
#include "nblang.h"
c
c 0.2. ==> communs
c
#include "envex1.h"
c
c 0.3. ==> arguments
c
      integer nrtafo
      integer nbtafo
      integer nbpg, nbvalc, nbcomp
c
      double precision trav1(nbpg,nbvalc,nbcomp)
      double precision vafonc(nbtafo,nbpg,*)
c
      character*8 obcham
      character*8 objech(*)
c
      integer ulsort, langue, codret
c
c 0.4. ==> variables locales
c
      integer iaux
      integer nrcomp, nugaus
c
      integer nbmess
      parameter ( nbmess = 10 )
      character*80 texte(nblang,nbmess)
c
c 0.5. ==> initialisations
c ______________________________________________________________________
c
c====
c 1. initialisations
c====
c
#include "impr01.h"
c
#ifdef _DEBUG_HOMARD_
      write (ulsort,texte(langue,1)) 'Entree', nompro
      call dmflsh (iaux)
#endif
c
      texte(1,4) = '(''. '',a,'' = '',i8)'
      texte(1,5) = '(''. Premiere valeur : '',g14.7)'
      texte(1,6) = '(''. Derniere valeur : '',g14.7)'
      texte(1,7) = '(''... Composante numero '',i8)'
c
      texte(2,4) = '(''. '',a,'' = '',i8)'
      texte(2,5) = '(''. First value : '',g14.7)'
      texte(2,6) = '(''. Last value  : '',g14.7)'
      texte(2,7) = '(''... Composante # '',i8)'
c
#ifdef _DEBUG_HOMARD_
      write (ulsort,texte(langue,4)) 'nbtafo', nbtafo
      write (ulsort,texte(langue,4)) 'nbpg  ', nbpg
      write (ulsort,texte(langue,4)) 'nbvalc', nbvalc
      write (ulsort,texte(langue,4)) 'nbcomp', nbcomp
      write (ulsort,texte(langue,4)) 'nrtafo au depart', nrtafo
#endif
c
c====
c 2. Transfert
c====
c
      codret = 0
c
      do 20 , nrcomp = 1 , nbcomp
c
#ifdef _DEBUG_HOMARD_
      write (ulsort,texte(langue,7)) nrcomp
      write (ulsort,texte(langue,4)) '==> nrtafo', nrtafo
#endif
c
cgn             print *,'nrcomp,nrtafo, nbvalc = ',nrcomp,nrtafo, nbvalc
c
c 2.1. ==> les valeurs numeriques
c
        if ( nbpg.eq.1 ) then
c
          do 21 , iaux = 1 , nbvalc
cgn            write(11,*) 'trav1 = ',trav1(1,iaux,nrcomp)
            vafonc(nrtafo,1,iaux) = trav1(1,iaux,nrcomp)
 21       continue
c
        else
c
          do 22 , iaux = 1 , nbvalc
cgn            print *,'trav1(...,',iaux,',',nrcomp,') = ',
cgn     >             (trav1(nugaus,iaux,nrcomp),nugaus=1,nbpg)
            do 221 , nugaus = 1 , nbpg
              vafonc(nrtafo,nugaus,iaux) = trav1(nugaus,iaux,nrcomp)
  221       continue
   22     continue
c
        endif
c
#ifdef _DEBUG_HOMARD_
      write (ulsort,texte(langue,5)) vafonc(nrtafo,1,1)
      write (ulsort,texte(langue,6)) vafonc(nrtafo,nbpg,nbvalc)
#endif
c
c 2.2. ==> les caracteristiques du champ associe
c
        objech(nrtafo) = obcham
c
c 2.3. ==> tableau suivant dans la fonction
c
        nrtafo = nrtafo + 1
c
   20 continue
c
#ifdef _DEBUG_HOMARD_
      write (ulsort,texte(langue,4)) 'nrtafo a la fin ', nrtafo
#endif
c
c====
c 3. la fin
c====
c
      if ( codret.ne.0 ) then
c
#include "envex2.h"
c
      write (ulsort,texte(langue,1)) 'Sortie', nompro
      write (ulsort,texte(langue,2)) codret
c
      endif
c
#ifdef _DEBUG_HOMARD_
      write (ulsort,texte(langue,1)) 'Sortie', nompro
      call dmflsh (iaux)
#endif
c
      end