src/tool/ES_HOMARD/eslee0.F

   1       subroutine eslee0 ( idfmed, nomamd,
   2      >                    typenh, typgeo, typent,
   3      >                    nbencf, nbenca, nbrfma, nbrama,
   4      >                    codeen, coaren,
   5      >                    tabaux,
   6      >                    ulsort, langue, codret )
   7 c ______________________________________________________________________
   8 c
   9 c                             H O M A R D
  10 c
  11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
  12 c
  13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
  14 c aupres des huissiers de justice Simart et Lavoir a Clamart
  15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  16 c aupres des huissiers de justice
  17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  18 c
  19 c    HOMARD est une marque deposee d'Electricite de France
  20 c
  21 c Copyright EDF 1996
  22 c Copyright EDF 1998
  23 c Copyright EDF 2002
  24 c Copyright EDF 2020
  25 c ______________________________________________________________________
  26 c
  27 c  Entree-Sortie : LEcture d'une Entite - 0
  28 c  -      -        --            -        -
  29 c ______________________________________________________________________
  30 c .  nom   . e/s . taille .           description                      .
  31 c .____________________________________________________________________.
  32 c . idfmed . e   .   1    . identificateur du fichier MED              .
  33 c . nomamd . e   . char64 . nom du maillage MED voulu                  .
  34 c . typenh . e   .   1    . code des entites                           .
  35 c .        .     .        .  -1 : noeuds                               .
  36 c .        .     .        .   0 : mailles-points                       .
  37 c .        .     .        .   1 : aretes                               .
  38 c .        .     .        .   2 : triangles                            .
  39 c .        .     .        .   3 : tetraedres                           .
  40 c .        .     .        .   4 : quadrangles                          .
  41 c .        .     .        .   5 : pyramides                            .
  42 c .        .     .        .   6 : hexaedres                            .
  43 c .        .     .        .   7 : pentaedres                           .
  44 c . typgeo . e   .   1    . type geometrique au sens MED               .
  45 c . typent . e   .   1    . type d'entite au sens MED                  .
  46 c . nbencf . e   .   1    . nombre d'entites decrites par faces        .
  47 c . nbenca . e   .   1    . nombre d'entites decrites par aretes       .
  48 c . nbrfma . e   .   1    . nbre noeuds par maille si connec. par noeud.
  49 c .        .     .        . nbre faces par maille si connectivite desce.
  50 c . nbrama . e   .   1    . nbre aretes par maille si volume           .
  51 c . codeen .  s  .nbencf**. connectivite descendante des mailles       .
  52 c . coaren .  s  .nbenca**. connectivite des mailles par aretes        .
  53 c . tabaux .     .    *   . tableau tampon                             .
  54 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  55 c . langue . e   .    1   . langue des messages                        .
  56 c .        .     .        . 1 : francais, 2 : anglais                  .
  57 c . codret . es  .    1   . code de retour des modules                 .
  58 c .        .     .        . 0 : pas de probleme                        .
  59 c ______________________________________________________________________
  60 c
  61 c====
  62 c 0. declarations et dimensionnement
  63 c====
  64 c
  65 c 0.1. ==> generalites
  66 c
  67       implicit none
  68       save
  69 c
  70       character*6 nompro
  71       parameter ( nompro = 'ESLEE0' )
  72 c
  73 #include "nblang.h"
  74 #include "consts.h"
  75 c
  76 c 0.2. ==> communs
  77 c
  78 #include "envex1.h"
  79 c
  80 #include "impr02.h"
  81 c
  82 c 0.3. ==> arguments
  83 c
  84       integer*8 idfmed
  85       integer typenh, typgeo, typent
  86       integer nbencf, nbenca, nbrfma, nbrama
  87       integer codeen(*), coaren(*)
  88       integer tabaux(*)
  89 c
  90       character*64 nomamd
  91 c
  92       integer ulsort, langue, codret
  93 c
  94 c 0.4. ==> variables locales
  95 c
  96 #include "meddc0.h"
  97 c
  98       integer iaux
  99       integer dim1
 100       integer typcon
 101 c
 102       integer nbmess
 103       parameter ( nbmess = 150 )
 104       character*80 texte(nblang,nbmess)
 105 c ______________________________________________________________________
 106 c
 107 c====
 108 c 1. messages
 109 c====
 110 c
 111 #include "impr01.h"
 112 c
 113 #ifdef _DEBUG_HOMARD_
 114       write (ulsort,texte(langue,1)) 'Entree', nompro
 115       call dmflsh (iaux)
 116 #endif
 117 c
 118       texte(1,4) = '(''... Lecture des '',i10,1x,a)'
 119 c
 120       texte(2,4) = '(''... Readings of '',i10,1x,a)'
 121 c
 122 #include "impr03.h"
 123 c
 124 #include "esimpr.h"
 125 c
 126 #ifdef _DEBUG_HOMARD_
 127       write (ulsort,texte(langue,4)) nbencf, mess14(langue,3,typenh)
 128 #endif
 129 c
 130 c====
 131 c 2. Lecture des connectivites
 132 c====
 133 c
 134       if ( codret.eq.0 ) then
 135 c
 136       if ( typenh.eq.1 ) then
 137         iaux = -nbrfma
 138         dim1 = 2
 139       else
 140         iaux = 1
 141         dim1 = nbencf
 142       endif
 143       if ( typenh.eq.0 ) then
 144         typcon = ednoda
 145       else
 146         typcon = eddesc
 147       endif
 148 ccc      write (ulsort,90002) 'typent', typent
 149 ccc      write (ulsort,90002) 'typgeo', typgeo
 150 ccc      write (ulsort,90002) 'iaux  ', iaux
 151 ccc      write (ulsort,90002) 'nbencf', nbencf
 152 ccc      write (ulsort,90002) 'nbrfma, nbrama', nbrfma, nbrama
 153 ccc      write (ulsort,90002) 'dim1  ', dim1
 154 c
 155 #ifdef _DEBUG_HOMARD_
 156       write (ulsort,texte(langue,3)) 'ESLMMC', nompro
 157 #endif
 158         call eslmmc ( idfmed, nomamd,
 159      >                typenh, typent, typgeo,
 160      >                iaux, nbencf, dim1, nbrfma,
 161      >                typcon,
 162      >                codeen,
 163      >                tabaux,
 164      >                ulsort, langue, codret )
 165 c
 166       endif
 167 c
 168 c====
 169 c 3. Mise en place de la connectivite des volumes
 170 c====
 171 c
 172       if ( codret.eq.0 ) then
 173 c
 174       if ( typenh.eq.3 .or. typenh.eq.5 .or.
 175      >     typenh.eq.6 .or. typenh.eq.7 ) then
 176 c
 177 #ifdef _DEBUG_HOMARD_
 178         write (ulsort,texte(langue,3)) 'ESLEE1', nompro
 179 #endif
 180         call eslee1 ( typenh, nbencf, nbenca, nbrfma, nbrama,
 181      >                codeen, coaren, tabaux,
 182      >                ulsort, langue, codret )
 183 c
 184       endif
 185 c
 186       endif
 187 c
 188 c====
 189 c 4. la fin
 190 c====
 191 c
 192       if ( codret.ne.0 ) then
 193 c
 194 #include "envex2.h"
 195 c
 196       write (ulsort,texte(langue,1)) 'Sortie', nompro
 197       write (ulsort,texte(langue,2)) codret
 198 c
 199       endif
 200 c
 201 #ifdef _DEBUG_HOMARD_
 202       write (ulsort,texte(langue,1)) 'Sortie', nompro
 203       call dmflsh (iaux)
 204 #endif
 205 c
 206       end