src/tool/ES_HOMARD/eslmh5.F

   1       subroutine eslmh5 ( typenh, norenu, reento, reenac, adenhn,
   2      >                    ulsort, langue, codret)
   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  Entree-Sortie : Lecture du Maillage Homard - phase 5
  24 c  -      -        -          -        -              -
  25 c ______________________________________________________________________
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . typenh . e   .   1    . code des entites au sens homard            .
  29 c .        .     .        .  -1 : noeuds                               .
  30 c .        .     .        .   0 : mailles-points                       .
  31 c .        .     .        .   1 : segments                             .
  32 c .        .     .        .   2 : triangles                            .
  33 c .        .     .        .   3 : tetraedres                           .
  34 c .        .     .        .   4 : quadrangles                          .
  35 c .        .     .        .   5 : pyramides                            .
  36 c .        .     .        .   6 : hexaedres                            .
  37 c . norenu . e   . char8  . nom de la branche Renum du maillage HOMARD .
  38 c . reento . e   .    1   . nombre d'entites                           .
  39 c . reenac . e   .    1   . nbr d'elements utiles et contenant entites .
  40 c . adenhn . e   .    1   . adresse du numero d'entite dans HOMARD     .
  41 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  42 c . langue . e   .    1   . langue des messages                        .
  43 c .        .     .        . 1 : francais, 2 : anglais                  .
  44 c . codret . es  .    1   . code de retour des modules                 .
  45 c .        .     .        . 0 : pas de probleme                        .
  46 c ______________________________________________________________________
  47 c
  48 c====
  49 c 0. declarations et dimensionnement
  50 c====
  51 c
  52 c 0.1. ==> generalites
  53 c
  54       implicit none
  55       save
  56 c
  57       character*6 nompro
  58       parameter ( nompro = 'ESLMH5' )
  59 c
  60 #include "nblang.h"
  61 c
  62 c 0.2. ==> communs
  63 c
  64 #include "gmenti.h"
  65 c
  66 #include "envex1.h"
  67 #include "enti01.h"
  68 #include "impr02.h"
  69 c
  70 c 0.3. ==> arguments
  71 c
  72       integer typenh
  73       integer reento, reenac, adenhn
  74 c
  75       character*8 norenu
  76 c
  77       integer ulsort, langue, codret
  78 c
  79 c 0.4. ==> variables locales
  80 c
  81       integer iaux, jaux, kaux
  82       integer ideb, ifin
  83       integer adencn
  84 c
  85       character*3 saux03
  86 #ifdef _DEBUG_HOMARD_
  87       character*6 saux06
  88 #endif
  89 c
  90       integer nbmess
  91       parameter ( nbmess = 10 )
  92       character*80 texte(nblang,nbmess)
  93 c
  94 c 0.5. ==> initialisations
  95 c ______________________________________________________________________
  96 c
  97 c====
  98 c 1. initialisations
  99 c====
 100 c
 101 c 1.1. ==> les messages
 102 c
 103 #include "impr01.h"
 104 c
 105 #ifdef _DEBUG_HOMARD_
 106       write (ulsort,texte(langue,1)) 'Entree', nompro
 107       call dmflsh (iaux)
 108 #endif
 109 c
 110       texte(1,4) =
 111      > '(''Mise a jour des renumerotations relatives aux '',a)'
 112       texte(1,5) = '(a3,''Calcul impossible a allouer.'')'
 113       texte(1,6) =
 114      > '(''Adresse de '',a3,''HOMARD impossible a trouver.'')'
 115 c
 116       texte(2,4) = '(''Updating of renumbering for '',a)'
 117       texte(2,5) = '(a3,''Calcul cannot be allocated.'')'
 118       texte(2,6) =
 119      > '(''Adress for '',a3,''HOMARD cannot be found.'')'
 120 c
 121 #ifdef _DEBUG_HOMARD_
 122       write(ulsort,texte(langue,4)) mess14(langue,3,typenh)
 123       saux06 = 're'//suffix(2,typenh)(1:2)//'to'
 124       write (ulsort,*) '==> ', saux06, ' = ', reento
 125       saux06 = 're'//suffix(2,typenh)(1:2)//'ac'
 126       write (ulsort,*) '==> ', saux06, ' = ', reenac
 127 #endif
 128 c
 129 c 1.2. ==> types d'entites
 130 c
 131       saux03 = '.'//suffix(3,typenh)(1:2)
 132 cgn      write(ulsort,*) saux03
 133 c
 134       codret = 0
 135 c
 136       if ( reenac.ne.0 .and. reento.ne.0 ) then
 137 c
 138 c====
 139 c 2. Numerotation dans le calcul
 140 c====
 141 c
 142         jaux = 21
 143 #ifdef _DEBUG_HOMARD_
 144       write (ulsort,texte(langue,3)) 'UTRE01', nompro
 145 #endif
 146         call utre01 ( typenh, jaux,
 147      >                norenu, reenac, reento,
 148      >                adenhn, adencn, kaux,
 149      >                ulsort, langue, codret)
 150 c
 151 c====
 152 c 3. Numerotation dans HOMARD
 153 c====
 154 c
 155         if ( codret.eq.0 ) then
 156 c
 157         ideb = adencn
 158         ifin = adencn + reento - 1
 159         do 311 , iaux = ideb , ifin
 160           imem(iaux) = 0
 161   311   continue
 162 c
 163         do 312 , iaux = 1, reenac
 164           jaux = imem(adenhn+iaux-1)
 165           if ( jaux.ne.0 ) then
 166            imem(adencn+jaux-1) = iaux
 167           endif
 168   312   continue
 169 c
 170         endif
 171 c
 172       endif
 173 c
 174 c====
 175 c 4. la fin
 176 c====
 177 c
 178       if ( codret.ne.0 ) then
 179 c
 180 #include "envex2.h"
 181 c
 182       write (ulsort,texte(langue,1)) 'Sortie', nompro
 183       write (ulsort,texte(langue,2)) codret
 184       write(ulsort,texte(langue,4)) mess14(langue,3,typenh)
 185       write(ulsort,texte(langue,4+codret)) saux03
 186 c
 187       endif
 188 c
 189 #ifdef _DEBUG_HOMARD_
 190       write (ulsort,texte(langue,1)) 'Sortie', nompro
 191       call dmflsh (iaux)
 192 #endif
 193 c
 194       end