src/tool/ES_HOMARD/eslen1.F

   1       subroutine eslen1 ( idfmed, nomamd,
   2      >                    nhnoeu,
   3      >                    dimcst,
   4      >                    ltbiau, tbiaux,
   5      >                    ulsort, langue, codret)
   6 c
   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 des Noeuds - 1
  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 . nhnoeu . e   . char8  . nom de l'objet decrivant les noeuds        .
  35 c . dimcst . e   .    1   . dimension de la coordonnee constante       .
  36 c .        .     .        . eventuelle, 0 si toutes varient            .
  37 c . ltbiau . e   .    1   . longueur allouee a tbiaux                  .
  38 c . tbiaux .     .    *   . tableau tampon entier                      .
  39 c . ulsort . e   .   1    . numero d'unite logique de la liste standard.
  40 c . langue . e   .    1   . langue des messages                        .
  41 c .        .     .        . 1 : francais, 2 : anglais                  .
  42 c . codret . es  .    1   . code de retour des modules                 .
  43 c .        .     .        . 0 : pas de probleme                        .
  44 c ______________________________________________________________________
  45 c
  46 c====
  47 c 0. declarations et dimensionnement
  48 c====
  49 c
  50 c 0.1. ==> generalites
  51 c
  52       implicit none
  53       save
  54 c
  55       character*6 nompro
  56       parameter ( nompro = 'ESLEN1' )
  57 c
  58 #include "nblang.h"
  59 #include "consts.h"
  60 c
  61 c 0.2. ==> communs
  62 c
  63 #include "envex1.h"
  64 #include "gmenti.h"
  65 #include "gmreel.h"
  66 c
  67 #include "impr02.h"
  68 #include "nombno.h"
  69 #include "envca1.h"
  70 #include "enti01.h"
  71 c
  72 c 0.3. ==> arguments
  73 c
  74       integer*8 idfmed
  75       integer dimcst
  76       integer ltbiau, tbiaux(*)
  77 c
  78       character*8 nhnoeu
  79       character*64 nomamd
  80 c
  81       integer ulsort, langue, codret
  82 c
  83 c 0.4. ==> variables locales
  84 c
  85 #include "meddc0.h"
  86 c
  87       integer nbcmax
  88       parameter ( nbcmax = 20 )
  89 c
  90       integer iaux, jaux, kaux, laux
  91       integer codre1, codre2
  92       integer codre0
  93       integer nbcomp
  94       integer typenh
  95       integer pcoono, adcocs
  96       integer numdt, numit
  97 c
  98       character*16 nomcmp(nbcmax), unicmp(nbcmax)
  99       character*64 nomcha
 100       character*64 noprof
 101 c
 102       integer nbmess
 103       parameter ( nbmess = 150 )
 104       character*80 texte(nblang,nbmess)
 105 c ______________________________________________________________________
 106 c
 107 c====
 108 c 1. initialisation
 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 #include "esimpr.h"
 119 c
 120       texte(1,4) = '(''... Lecture des complements pour les noeuds'')'
 121       texte(1,81) = '(''Longueur allouee pour tbiaux    : '',i10)'
 122       texte(1,82) = '(''Longueur necessaire pour tbiaux : '',i10)'
 123 c
 124       texte(2,4) = '(''... Readings of additional terms for nodes'')'
 125       texte(2,81) = '(''Allocated length for tbiaux    : '',i10)'
 126       texte(2,82) = '(''Used length for tbiaux : '',i10)'
 127 c
 128 #include "impr03.h"
 129 c
 130 #ifdef _DEBUG_HOMARD_
 131       write (ulsort,texte(langue,4))
 132 #endif
 133 c
 134 c====
 135 c 2. Lecture sous forme de champ pour les tableaux
 136 c====
 137 c 2.1. ==> Reperage du champ et du nombre de ses composantes
 138 c
 139       nomcha = blan64
 140       nomcha(1:8) = suffix(3,-1)
 141       iaux = 0
 142 #ifdef _DEBUG_HOMARD_
 143       write (ulsort,texte(langue,3)) 'ESLE01_no', nompro
 144 #endif
 145       call esle01 ( idfmed, nomamd, nomcha,
 146      >              nbcomp, nomcmp, unicmp,
 147      >              iaux, jaux,
 148      >              ulsort, langue, codret)
 149 c
 150       if ( codret.eq.0 ) then
 151 c
 152       if ( nbnoto*nbcomp.gt.ltbiau ) then
 153         write (ulsort,texte(langue,85)) nbcomp
 154         write (ulsort,texte(langue,81)) ltbiau
 155         write (ulsort,texte(langue,82)) nbnoto*nbcomp
 156         codret = 7
 157       endif
 158 c
 159       endif
 160 c
 161 c 2.2. ==> Lecture des valeurs du champ, en mode non entrelace.
 162 c    En fortran, cela correspond au stockage memoire suivant :
 163 c    tabaux(1,1), tabaux(2,1), tabaux(3,1), ..., tabaux(nbnoto,1),
 164 c    tabaux(1,2), tabaux(2,2), tabaux(3,2), ..., tabaux(nbnoto,2),
 165 c    ...
 166 c    tabaux(1,nbcomp), tabaux(2,nbcomp), ..., tabaux(nbnoto,nbcomp)
 167 c    on a ainsi toutes les valeurs pour la premiere composante, puis
 168 c    toutes les valeurs pour la seconde composante, etc.
 169 #ifdef _DEBUG_HOMARD_
 170       write (ulsort,90002) '2.2. Lecture ; codret', codret
 171 #endif
 172 c
 173       if ( codret.eq.0 ) then
 174 c
 175       numdt = ednodt
 176       numit = ednoit
 177       iaux = 0
 178 c                A TRAITER plus tard
 179 cgn#ifdef _DEBUG_HOMARD_
 180 cgn       write (ulsort,texte(langue,3)) 'MFDIVR', nompro
 181 cgn#endif
 182 cgn       call mfdivr ( idfmed, nomcha, numdt, numit,
 183 cgn      >              ednoeu, iaux, ednoin,
 184 cgn      >              edall,
 185 cgn      >              tbiaux, codret )
 186       noprof = blan64
 187 #ifdef _DEBUG_HOMARD_
 188       write (ulsort,texte(langue,3)) 'MFDIPR', nompro
 189 #endif
 190       call mfdipr ( idfmed, nomcha, numdt, numit,
 191      >              ednoeu, iaux, 1, noprof, ednoin,
 192      >              edall,
 193      >              tbiaux, codret )
 194 c
 195       if ( codret.ne.0 ) then
 196         write (ulsort,texte(langue,18)) nomcha
 197       endif
 198 c
 199       endif
 200 c
 201 c 2.3. ==> Transfert
 202 c
 203       if ( codret.eq.0 ) then
 204 c
 205       do 23 , iaux = 1 , nbcomp
 206 c
 207         if ( codret.eq.0 ) then
 208 c
 209         call gmaloj ( nhnoeu//'.'//nomcmp(iaux), ' ',
 210      >                nbnoto, laux, codret )
 211 c
 212         endif
 213 c
 214       if ( codret.eq.0 ) then
 215 c
 216         kaux = nbnoto*(iaux-1)
 217         laux = laux - 1
 218         do 231 , jaux = 1 , nbnoto
 219           imem(laux+jaux) = tbiaux(kaux+jaux)
 220   231   continue
 221 c
 222         endif
 223 c
 224 #ifdef _DEBUG_HOMARD_
 225         call gmprsx ( nompro, nhnoeu//'.'//nomcmp(iaux) )
 226 #endif
 227 c
 228    23 continue
 229 c
 230       endif
 231 c
 232 c====
 233 c 3. Lecture sous forme de profil pour les informations supplementaires
 234 c====
 235 #ifdef _DEBUG_HOMARD_
 236       write (ulsort,90002) '3. Lecture profil ; codret', codret
 237 #endif
 238 c
 239       if ( codret.eq.0 ) then
 240 c
 241       typenh = -1
 242       iaux = 0
 243 c
 244 #ifdef _DEBUG_HOMARD_
 245       write (ulsort,texte(langue,3)) 'ESLE02_'//mess14(langue,1,typenh),
 246      >                                nompro
 247 #endif
 248       call esle02 ( idfmed,
 249      >              typenh, nhnoeu, iaux,
 250      >              ulsort, langue, codret)
 251 c
 252       endif
 253 c
 254 c====
 255 c 4. Coordonnees extremes
 256 c====
 257 #ifdef _DEBUG_HOMARD_
 258       write (ulsort,90002) '4. coo extremes ; codret', codret
 259 #endif
 260 c
 261       if ( codret.eq.0 ) then
 262 c
 263       iaux = 11
 264       call gmaloj ( nhnoeu//'.CoorCons', ' ', iaux, adcocs, codre1 )
 265       call gmadoj ( nhnoeu//'.Coor', pcoono, iaux, codre2 )
 266 c
 267       codre0 = min ( codre1, codre2 )
 268       codret = max ( abs(codre0), codret,
 269      >               codre1, codre2 )
 270 c
 271       endif
 272 c
 273       if ( codret.eq.0 ) then
 274 c
 275 #ifdef _DEBUG_HOMARD_
 276       write (ulsort,texte(langue,3)) 'ESLE03', nompro
 277 #endif
 278       call esle03 ( idfmed,
 279      >              nbnoto, sdim, rmem(pcoono), dimcst,
 280      >              rmem(adcocs),
 281      >              ulsort, langue, codret)
 282 c
 283       endif
 284 c
 285 c====
 286 c 5. la fin
 287 c====
 288 c
 289       if ( codret.ne.0 ) then
 290 c
 291 #include "envex2.h"
 292 c
 293       write (ulsort,texte(langue,1)) 'Sortie', nompro
 294       write (ulsort,texte(langue,2)) codret
 295 c
 296       endif
 297 c
 298 #ifdef _DEBUG_HOMARD_
 299       write (ulsort,texte(langue,1)) 'Sortie', nompro
 300       call dmflsh (iaux)
 301 #endif
 302 c
 303       end