src/tool/ES_MED/eslsm4.F

   1       subroutine eslsm4 ( idfmed,
   2      >                    nbcham, obcham,
   3      >                    nbfonc, defonc, nofonc,
   4      >                    ulsort, langue, codret )
   5 c ______________________________________________________________________
   6 c
   7 c                             H O M A R D
   8 c
   9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  10 c
  11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  12 c aupres des huissiers de justice Simart et Lavoir a Clamart
  13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  14 c aupres des huissiers de justice
  15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  16 c
  17 c    HOMARD est une marque deposee d'Electricite de France
  18 c
  19 c Copyright EDF 1996
  20 c Copyright EDF 1998
  21 c Copyright EDF 2002
  22 c Copyright EDF 2020
  23 c ______________________________________________________________________
  24 c
  25 c  Entree-Sortie - Lecture d'une Solution au format MED - phase 2
  26 c  -      -        -             -                  -           -
  27 c  remarque : on ne lit que les champs reels
  28 c  remarque : on part du principe que les elements externes sont
  29 c             numerotes ainsi : tetraedres, triangles, segments,
  30 c             mailles-points, quadrangles, hexaedres, pyramides,
  31 c             pentaedres.
  32 c             C'est ce qui se passe a la lecture d'un maillage med par
  33 c             le programme eslmm2, lors de la creation du tableau des
  34 c             connectivite par noeuds.
  35 c             C'est aussi le cas pour la conversion du maillage apres
  36 c             adaptation (pcmav1).
  37 c ______________________________________________________________________
  38 c .        .     .        .                                            .
  39 c .  nom   . e/s . taille .           description                      .
  40 c .____________________________________________________________________.
  41 c . idfmed . e   .   1    . identifiant du fichier med en entree       .
  42 c . nbcham . e   .   1    . nombre de champs dans le fichier           .
  43 c . obcham . e   . nbcham . nom des objets qui contiennent la          .
  44 c .        .     .        . description de chaque champ                .
  45 c . nbfonc . e   .   1    . nombre de fonctions                        .
  46 c . defonc . e   . nbinec*. description des fonctions en entier        .
  47 c .        .     . nbfonc . 1. type de support au sens MED             .
  48 c .        .     .        . 2. nombre de points de Gauss               .
  49 c .        .     .        . 3. nombre de valeurs                       .
  50 c .        .     .        . 4. nombre de valeurs du profil eventuel    .
  51 c .        .     .        . 5. nombre de supports associes             .
  52 c .        .     .        . 6. 1, si aux noeuds par elements           .
  53 c .        .     .        .    2, si aux points de Gauss, associe avec .
  54 c .        .     .        .       un champ aux noeuds par elements     .
  55 c .        .     .        .    3, si aux points de Gauss autonome      .
  56 c .        .     .        .    0, sinon                                .
  57 c .        .     .        . 7. nombre de tableaux de ce type           .
  58 c .        .     .        . 8. numero du tableau dans la fonction      .
  59 c .        .     .        . 9. numero de la fonction associee si champ .
  60 c .        .     .        .    aux noeuds par element ou points de Gaus.
  61 c .        .     .        . 10. numero HOMARD du champ associe         .
  62 c .        .     .        . 11. type interpolation                     .
  63 c .        .     .        .       0, si automatique                    .
  64 c .        .     .        .       1 si degre 1, 2 si degre 2,          .
  65 c .        .     .        .       3 si iso-P2                          .
  66 c .        .     .        . 12. type de champ edfl64/edin64            .
  67 c .        .     .        . 21-nbinec. type des supports associes      .
  68 c . nofonc . e   .3*nbfonc. description des fonctions en caracteres    .
  69 c .        .     .        . 1. nom de l'objet profil, blanc sinon      .
  70 c .        .     .        . 2. nom de l'objet fonction                 .
  71 c .        .     .        . 3. nom de l'objet localisation des points  .
  72 c .        .     .        . de Gauss, blanc sinon                      .
  73 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  74 c . langue . e   .    1   . langue des messages                        .
  75 c .        .     .        . 1 : francais, 2 : anglais                  .
  76 c . codret . es  .    1   . code de retour des modules                 .
  77 c .        .     .        . 0 : pas de probleme                        .
  78 c .        .     .        . 1 : probleme                               .
  79 c ______________________________________________________________________
  80 c
  81 c====
  82 c 0. declarations et dimensionnement
  83 c====
  84 c
  85 c 0.1. ==> generalites
  86 c
  87       implicit none
  88       save
  89 c
  90       character*6 nompro
  91       parameter ( nompro = 'ESLSM4' )
  92 c
  93 #include "nblang.h"
  94 #include "consts.h"
  95 c
  96 #include "meddc0.h"
  97 c
  98 c 0.2. ==> communs
  99 c
 100 #include "envex1.h"
 101 c
 102 #include "esutil.h"
 103 #include "gmenti.h"
 104 #include "gmstri.h"
 105 c
 106 c 0.3. ==> arguments
 107 c
 108       integer*8 idfmed
 109       integer nbcham, nbfonc
 110       integer defonc(nbinec,nbfonc)
 111 c
 112       character*8 obcham(nbcham)
 113       character*8 nofonc(3,nbfonc)
 114 c
 115       integer ulsort, langue, codret
 116 c
 117 c 0.4. ==> variables locales
 118 c
 119       integer iaux
 120 #ifdef _DEBUG_HOMARD_
 121       integer jaux
 122 #endif
 123       integer nrocha
 124 c
 125       integer adnocp, adcaen, adcare, adcaca
 126       integer nbcomp, nbtvch, typcha
 127 c
 128       character*64 nomcha
 129 c
 130       integer nbmess
 131       parameter ( nbmess = 150 )
 132       character*80 texte(nblang,nbmess)
 133 c
 134 c 0.5. ==> initialisations
 135 c ______________________________________________________________________
 136 c
 137 c====
 138 c 1. initialisations
 139 c====
 140 c
 141 #include "impr01.h"
 142 c
 143 #ifdef _DEBUG_HOMARD_
 144       write (ulsort,texte(langue,1)) 'Entree', nompro
 145       call dmflsh (iaux)
 146 #endif
 147 c
 148 #include "impr03.h"
 149 c
 150 #include "esimpr.h"
 151 c
 152 c====
 153 c 2. lecture des valeurs, champ par champ
 154 c====
 155 c
 156       if ( codret.eq.0 ) then
 157 c
 158       do 20 , nrocha = 1 , nbcham
 159 c
 160 c 2.1. ==> informations sur la structure decrivant le champ
 161 c
 162         if ( codret.eq.0 ) then
 163 c
 164 #ifdef _DEBUG_HOMARD_
 165         write (ulsort,*) '+++++++++++++++++++++++++++++++++++++++++++++'
 166         write (ulsort,texte(langue,37)) nompro, nrocha
 167         write (ulsort,texte(langue,51)) obcham(nrocha)
 168         call gmprsx (nompro, obcham(nrocha)//'.Cham_Ent' )
 169       write (ulsort,texte(langue,3)) 'UTCACH', nompro
 170 #endif
 171 c
 172         call utcach ( obcham(nrocha),
 173      >                nomcha,
 174      >                nbcomp, nbtvch, typcha,
 175      >                adnocp, adcaen, adcare, adcaca,
 176      >                ulsort, langue, codret )
 177 cgn      call gmprsx (nompro, obcham(nrocha)//'.Cham_Ent' )
 178 cgn      call gmprsx (nompro, obcham(nrocha)//'.Cham_Car' )
 179 c
 180 #ifdef _DEBUG_HOMARD_
 181         write (ulsort,*) 'Retour de utcach avec :'
 182         write (ulsort,texte(langue,32)) nomcha
 183         write (ulsort,texte(langue,111)) nbtvch
 184         write (ulsort,90002) 'nbcomp', nbcomp
 185         write (ulsort,90002) 'typcha', typcha
 186         write (ulsort,90002) 'codret', codret
 187 #endif
 188 c
 189         endif
 190 c
 191 c 2.2. ==> on passe en revue tous les tableaux du champ
 192 c
 193         if ( nbtvch.ne.0 ) then
 194 c
 195           if ( codret.eq.0 ) then
 196 c
 197 #ifdef _DEBUG_HOMARD_
 198         if ( codret.eq.0 ) then
 199         do 2222 , iaux = 1 , nbfonc
 200           write (ulsort,*) '.. fonction numero', iaux,' /', nbfonc
 201           write (ulsort,2220) (defonc(jaux,iaux),jaux=1,nbinec)
 202           write (ulsort,2221) (nofonc(jaux,iaux),jaux=1,3)
 203  2222   continue
 204  2220 format(11i10)
 205  2221 format(5(a8,1x))
 206         endif
 207 #endif
 208 c
 209 #ifdef _DEBUG_HOMARD_
 210       write (ulsort,texte(langue,3)) 'ESLCH4', nompro
 211 #endif
 212           iaux = nrocha
 213           call eslch4 ( idfmed,
 214      >                  iaux, nomcha, nbcomp, nbtvch,
 215      >                  obcham(nrocha), imem(adcaen), smem(adcaca),
 216      >                  nbfonc, defonc, nofonc,
 217      >                  ulsort, langue, codret )
 218 c
 219           endif
 220 c
 221         endif
 222 c
 223 #ifdef _DEBUG_HOMARD_
 224         if ( codret.eq.0 ) then
 225         call gmprsx (nompro, obcham(nrocha) )
 226         call gmprsx (nompro, obcham(nrocha)//'.Nom_Comp' )
 227         call gmprsx (nompro, obcham(nrocha)//'.Cham_Ent' )
 228         call gmprsx (nompro, obcham(nrocha)//'.Cham_Ree' )
 229         call gmprsx (nompro, obcham(nrocha)//'.Cham_Car' )
 230         endif
 231 #endif
 232 c
 233    20 continue
 234 c
 235       endif
 236 c
 237 c====
 238 c 3. la fin
 239 c====
 240 c
 241       if ( codret.ne.0 ) then
 242 c
 243 #include "envex2.h"
 244 c
 245       write (ulsort,texte(langue,1)) 'Sortie', nompro
 246       write (ulsort,texte(langue,2)) codret
 247 c
 248       endif
 249 c
 250 #ifdef _DEBUG_HOMARD_
 251       write (ulsort,texte(langue,1)) 'Sortie', nompro
 252       call dmflsh (iaux)
 253 #endif
 254 c
 255       end