src/tool/Gestion_MTU/gminge.F

   1       subroutine gminge ( ulmess, langdf, nfconf, lfconf )
   2 c ______________________________________________________________________
   3 c
   4 c                             H O M A R D
   5 c
   6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
   7 c
   8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
   9 c aupres des huissiers de justice Simart et Lavoir a Clamart
  10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
  11 c aupres des huissiers de justice
  12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
  13 c
  14 c    HOMARD est une marque deposee d'Electricite de France
  15 c
  16 c Copyright EDF 1996
  17 c Copyright EDF 1998
  18 c Copyright EDF 2002
  19 c Copyright EDF 2020
  20 c ______________________________________________________________________
  21 c
  22 c     Gestion de la Memoire : INitialiation de la GEstion
  23 c     -             -         --                  --
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . ulmess . e   .   1    . unite logique des messages                 .
  29 c . langdf . e   .   1    . langue des messages par defaut             .
  30 c .        .     .        . 1 : francais                               .
  31 c .        .     .        . 2 : anglais                                .
  32 c . nfconf . e   . ch<200 . nom du fichier de configuration            .
  33 c . lfconf . e   .    1   . longueur du nom du fichier                 .
  34 c ______________________________________________________________________
  35 c
  36 c .  - interet:
  37 c .       initialisation de la gestion de la memoire des tableaux
  38 c .       entiers, reels et character*8.
  39 c .
  40 c ......................................................................
  41 c .
  42 c .  - description des commons -
  43 c . la structure des communs est identique pour les reels, les
  44 c .   entiers et les character*8.
  45 c .   seul l'intitule rappele le type :
  46 c .   reel ( "r") entier ("i") character*8 ("s")
  47 c .
  48 c . commun  gmreel
  49 c .   rmem  : tableau de travail reel dans lequel seront gerees les
  50 c .           allocations.
  51 c . commun  gmenti
  52 c .   imem  : tableau de travail entier dans lequel seront gerees les
  53 c .           allocations.
  54 c . commun  gmstri
  55 c .   smem  : tableau de travail character*8 dans lequel seront gerees
  56 c .           les allocations.
  57 c .
  58 c . commun  gmtrrl
  59 c .   minmer: valeur entiere memorisant la plus petite dimension
  60 c .           du dernier trou afin de connaitre le passage le plus
  61 c .           delicat rencontre au cours de l'allocation. cette valeur
  62 c .           est calculee apres compression (voir minler)
  63 c .   ntrour: valeur entiere . nombre de trous present dans le tableau
  64 c .           reel
  65 c .   ptrour: tableau entier  contenant les pointeurs repertoriant la
  66 c .           position des trous.
  67 c .   ltrour: tableau entier  contenant la longueur des differents trous
  68 c .   nballr: valeur entiere contenant le nombre de tableaux deja alloue
  69 c .   ptallr: tableau entier  contenant les pointeurs repertoriant la
  70 c .           position des tableaux deja alloues
  71 c .   lgallr: tableau entier  contenant la longueur des differents
  72 c             tableaux deja alloues
  73 c .   totalr: valeur entiere cumulant les demandes successives de
  74 c .           memoire pour les tableaux reels
  75 c .   minler: valeur entiere memorisant la plus petite dimension
  76 c .           du dernier trou. en cas de compression cette valeur
  77 c .           qui sera en general differente de celle de minmer
  78 c .           permettra de connaitre la plus petite taille atteinte
  79 c .           par le dernier trou et donc la taille maximum que peut
  80 c .           atteindre le common (voir gmfin)
  81 c .
  82 c . commun  gmtren
  83 c .   structure rigoureusement identique  a celle de gmtrrl, sa fonction
  84 c .   etant de gerer les trous et les tableaux presents dans le tableau
  85 c .   entier. ses elements se terminent par un "i" au lieu d'un "r".
  86 c .
  87 c . commun  gmtrst
  88 c .   structure rigoureusement identique  a celle de gmtrrl, sa fonction
  89 c .   etant de gerer les trous et les tableaux presents dans le tableau
  90 c .   character*8. ses elements se terminent par un "s" au lieu d'un "r"
  91 c .
  92 c . commun  gmalrl
  93 c .   nommxr: chaine de caractere(*8) contenant le nom du plus grand
  94 c .           tableau associe a minmer
  95 c .   nomalr: tableau de chaines de caracteres contenant le nom associe
  96 c .           a chaque tableau deja alloue.
  97 c .
  98 c . commun  gmalen
  99 c .   structure rigoureusement identique a celle de gmalrl, sa fonction
 100 c .   etant de gerer les chaines de caracteres associees au tableau
 101 c .   entier. ses elements se terminent par un "i" au lieu d'un "r".
 102 c .
 103 c . commun  gmalst
 104 c .   structure rigoureusement identique a celle de gmalrl, sa fonction
 105 c .   etant de gerer les chaines de caracteres associees au tableau
 106 c .   character*8. ses elements se terminent par un "s" au lieu d'un "r"
 107 c .
 108 c . commun gmindf
 109 c .   memorise un indicateur d'utilisation : 0 on initialise,
 110 c .   1 on n'initialise pas
 111 c .
 112 c ......................................................................
 113 c
 114 c====
 115 c 0. declarations et dimensionnement
 116 c====
 117 c
 118 c 0.1. ==> generalites
 119 c
 120       implicit none
 121       save
 122 c
 123       character*6 nompro
 124       parameter ( nompro = 'GMINGE' )
 125 c
 126 #include "genbla.h"
 127 #include "gelggt.h"
 128 c
 129 #include "gmgmve.h"
 130 c
 131 #include "gmmaxt.h"
 132 #include "gmptrd.h"
 133 #include "gmmatc.h"
 134 #include "gmlgen.h"
 135 c
 136 c 0.2. ==> communs
 137 c
 138 #include "gmtail.h"
 139 #include "gmtyge.h"
 140 #include "gmtyar.h"
 141 #include "gmindf.h"
 142 c
 143 #include "envex1.h"
 144 #include "gmcoer.h"
 145 #include "gmimpr.h"
 146 #include "gmlang.h"
 147 #include "gmopim.h"
 148 c
 149 #include "gmenti.h"
 150 #include "gmreel.h"
 151 #include "gmstri.h"
 152 c
 153 #include "gmtrrl.h"
 154 #include "gmtren.h"
 155 #include "gmtrst.h"
 156 c
 157 #include "gmalrl.h"
 158 #include "gmalen.h"
 159 #include "gmalst.h"
 160 c
 161 #include "gmadui.h"
 162 #include "gmadur.h"
 163 #include "gmadus.h"
 164 c
 165 #include "gmindi.h"
 166 #include "gmindr.h"
 167 #include "gminds.h"
 168 c
 169 #include "gmtenb.h"
 170 #include "gmteno.h"
 171 c
 172 c 0.3. ==> arguments
 173 c
 174       character *(*) nfconf
 175 c
 176       integer ulmess, langdf, lfconf
 177 c
 178 c 0.4. ==> variables locales
 179 c
 180 #include "gedita.h"
 181 c
 182       integer iaux, code
 183 c
 184       integer ad0, ad1, ntrou0, i
 185       integer nenti, nreel, nch08
 186       integer guimp, gmimp, raison
 187       integer codret
 188 c
 189       character *200 nfdico
 190 c
 191       integer lfdico, nfois
 192 c
 193       integer nbmess
 194       parameter ( nbmess = 20 )
 195       character*80 texte(nblang,nbmess)
 196 c
 197 #include "motcle.h"
 198 c
 199 c 0.5. ==> initialisations
 200 c
 201       data nfois / 1 /
 202 c ______________________________________________________________________
 203 c
 204 #include "impr01.h"
 205 c
 206 #ifdef _DEBUG_HOMARD_
 207       if ( langdf.ge.1 .and. langdf.le.nblang ) then
 208         langue = langdf
 209       else
 210         langue = 1
 211       endif
 212       write (ulmess,texte(langue,1)) 'Entree', nompro
 213 #endif
 214 c
 215       texte(1,4) = '(/,''La gestion de la memoire est statique.'')'
 216       texte(1,5) =
 217      > '(/,''La gestion de la memoire est semi-dynamique.'')'
 218       texte(1,6) = '(/,''La gestion de la memoire est dynamique.'')'
 219       texte(1,7) = '(/,a12,/,''... Adresse du commun : '',i19)'
 220       texte(1,8) = '(''... Adresse de la memoire : '',i15)'
 221       texte(1,9) = '(''... Place reservee : '',i15)'
 222       texte(1,10) = '(/,''Programmes du gestionnaire de memoire :'')'
 223       texte(1,11) =
 224      > '(''. Version : '',i11,/,''. Sous-version : '',i6)'
 225 c
 226       texte(2,4) = '(/,''A static memory management is used.'')'
 227       texte(2,5) =
 228      >        '(/,''A semi-dynamic memory management is used.'')'
 229       texte(2,6) = '(/,''A dynamic memory management is used.'')'
 230       texte(2,7) = '(/,a12,/,''... Common address : '',i19)'
 231       texte(2,8) = '(''... Memory address : '',i15)'
 232       texte(2,9) = '(''... Reserved space : '',i15)'
 233       texte(2,10) = '(/,''Programms of memory manager :'')'
 234       texte(2,11) = '(''. Version : '',i11,/,''. Release : '',i6)'
 235 c
 236 c====
 237 c 1. mise en place
 238 c====
 239 cgn       write (*,*) 'nfois = ', nfois
 240 c
 241 c 1.1. ==> On commence par arreter brutalement s'il y a une erreur
 242 c          avant la connaissance de l'option retenue
 243 c
 244       typarr = 0
 245 c
 246       if ( nfois.le.1 ) then
 247         nfois = nfois + 1
 248 c
 249 c pour les cas ou tout se passe mal, on initialise
 250 c pour entrer dans ugstop dans des conditions moins catastrophiques:
 251 c
 252         modgm = 1
 253         ntroui = 0
 254         nballi = 0
 255         totali = 0
 256         imem(1) = 0
 257         ntrour = 0
 258         nballr = 0
 259         totalr = 0
 260         rmem(1) = 0.0d0
 261         ntrous = 0
 262         nballs = 0
 263         totals = 0
 264         write(smem(1),'(i8)') 0
 265       endif
 266 c
 267 c 1.2. ==> initialisation du numero d'unite logique associee aux
 268 c          messages du gestionnaire de memoire et de la langue associee
 269 c          par defaut
 270 c
 271       call gmmess (ulmess)
 272 c
 273       call gmlanm (langdf)
 274 c
 275 c 1.3. ==> initialisation de l'option supplementaire d'impression :
 276 c          rien par defaut
 277 c
 278       imprgm = 1
 279 c
 280 c 1.4. ==> recuperation du nom du fichier qui contient le
 281 c          dictionnaire des objets structures
 282 c
 283 #ifdef _DEBUG_HOMARD_
 284       write (*,texte(langue,3)) 'UGFINO', nompro
 285 #endif
 286       call ugfino ( mcdico, nfdico, lfdico,
 287      >              nfconf, lfconf,
 288      >              ulsort , langdf, coergm )
 289 c
 290       if ( coergm.ne.0 .and. lfdico.gt.0 ) then
 291         guimp = 1
 292         gmimp = 0
 293         raison = 1
 294         call ugstop( nompro, ulsort, guimp, gmimp, raison)
 295       endif
 296 c
 297 c 1.5. ==> mode de gestion de la memoire
 298 c
 299 #ifdef _DEBUG_HOMARD_
 300       write (*,texte(langue,3)) 'GMMOGE', nompro
 301 #endif
 302 c
 303       call gmmoge ( modgm, typarr,
 304      >              nenti, nreel, nch08,
 305      >              nfconf, lfconf,
 306      >              coergm )
 307 c
 308       if ( coergm.ne.0 ) then
 309          guimp = 1
 310          gmimp = 0
 311          raison = 1
 312          call ugstop( nompro, ulsort, guimp, gmimp, raison)
 313       endif
 314 c
 315 c 1.6. ==> initialisations et memorisation
 316 c
 317 #ifdef _DEBUG_HOMARD_
 318       write (*,texte(langue,3)) 'DMSIZE', nompro
 319 #endif
 320       call dmsize(tentie,treel,tchain)
 321 c
 322       if (modgm.eq.2) then
 323         ntrou0 = 0
 324         do 16 , i = 1 , 8
 325           admem(i) = 0
 326    16   continue
 327       else
 328         ntrou0 = 1
 329       endif
 330 c
 331 c====
 332 c 2. valeurs non definies
 333 c====
 334 c
 335 #ifdef _DEBUG_HOMARD_
 336       write (*,texte(langue,3)) 'DMINDF', nompro
 337 #endif
 338       call dmindf ( iindef, rindef, sindef )
 339 c
 340       lindef = 0
 341 c
 342 c====
 343 c 3. initialisations globales
 344 c====
 345 c
 346 c 3.1. ==> aucun tableau n'est encore alloue
 347 c
 348       do 31 , iaux = 1 , maxtab
 349 c
 350          nomali(iaux) = sindef
 351          ptalli(iaux) = iindef
 352          lgalli(iaux) = iindef
 353          adui(iaux)   = iindef
 354 c
 355          nomalr(iaux) = sindef
 356          ptallr(iaux) = iindef
 357          lgallr(iaux) = iindef
 358          adur(iaux)   = iindef
 359 c
 360          nomals(iaux) = sindef
 361          ptalls(iaux) = iindef
 362          lgalls(iaux) = iindef
 363          adus(iaux)   = iindef
 364 c
 365    31 continue
 366 c
 367 c 3.2. ==> aucun trou n'est encore present
 368 c
 369       do 32 , iaux = 1 , maxtrs
 370 c
 371          ptroui(iaux) = iindef
 372          ltroui(iaux) = iindef
 373 c
 374          ptrour(iaux) = iindef
 375          ltrour(iaux) = iindef
 376 c
 377          ptrous(iaux) = iindef
 378          ltrous(iaux) = iindef
 379 c
 380    32 continue
 381 c
 382 c 3.3. ==> initialisation du nombre de tableaux temporaires alloues
 383 c
 384       mxtbtp = 0
 385 c
 386 c    NB: il y a 3 types possibles d'objets simples, et maxtab objets
 387 c        simples au maximum dans chaque type. Par ailleurs, il y a
 388 c        au maximum nobjx objets structures.
 389 c
 390       do 33 iaux = 1 , (3*maxtab) + nobjx
 391          numete(iaux) = 0
 392          nomalt(iaux) = sindef
 393    33 continue
 394 c
 395 c====
 396 c 4. initialisation associee aux grandeurs entieres
 397 c====
 398 #ifdef _DEBUG_HOMARD_
 399       write (*,*) 'Etape 4 ; entier'
 400 #endif
 401 c
 402       call dmloci (imem,ad0)
 403 c
 404       if ( modgm.eq.0) then
 405         ad1 = ad0
 406         coergm = 0
 407         iaux = nenti - ptrdeb + 1
 408       elseif ( modgm.eq.1) then
 409         call gbalme('i',nenti+ptrdeb,ad1)
 410         iaux = nenti
 411       else
 412         ad1 = 0
 413         coergm = 0
 414         iaux = nenti - ptrdeb + 1
 415       endif
 416 c
 417       if ( coergm.ne.0) then
 418         write (ulsort,texte(langue,1)) 'Sortie', nompro
 419       call dmflsh (iaux)
 420         write (ulsort,*) ' allocation de ',nenti,' entiers'
 421         write (ulsort,*) ' impossible '
 422         call ugstop( nompro,ulsort,1,1,1)
 423       endif
 424 c
 425       adcom(1) = ad0
 426       admem(1) = ad1
 427 CGN   imem(0) = iindef
 428       imem(1) = nenti
 429       ntroui    = ntrou0
 430       ptroui(1) = ptrdeb
 431       ltroui(1) = iaux
 432 c
 433       minmei    = ltroui(1)
 434       minlei    = ltroui(1)
 435       nommxi    = '        '
 436       nballi    = 0
 437       totali    = nenti - iaux
 438 c
 439 c====
 440 c 5. initialisation des grandeurs reelles
 441 c====
 442 #ifdef _DEBUG_HOMARD_
 443       write (*,*) 'Etape 5 ; reel'
 444 #endif
 445 c
 446       call dmlocr (rmem,ad0)
 447 c
 448       if ( modgm.eq.0) then
 449         ad1 = ad0
 450         coergm = 0
 451         iaux = nreel - ptrdeb + 1
 452       elseif ( modgm.eq.1) then
 453         call gbalme('r',nreel+ptrdeb,ad1)
 454         iaux = nreel
 455       else
 456         ad1 = 0
 457         coergm = 0
 458         iaux = nreel - ptrdeb + 1
 459       endif
 460 c
 461       if ( coergm.ne.0) then
 462         write (ulsort,texte(langue,1)) 'Sortie', nompro
 463         write (ulsort,*) ' allocation de ',nreel,' reels'
 464         write (ulsort,*) ' impossible '
 465         call ugstop( nompro,ulsort,1,1,1)
 466       endif
 467 c
 468       adcom(2) = ad0
 469       admem(2) = ad1
 470 CGN   rmem(0) = rindef
 471       rmem(1) = dble(nreel)
 472       ntrour    = ntrou0
 473       ptrour(1) = ptrdeb
 474       ltrour(1) = iaux
 475 c
 476       minmer    = ltrour(1)
 477       minler    = ltrour(1)
 478       nommxr    = '        '
 479       nballr    = 0
 480       totalr    = nreel - iaux
 481 c
 482 c====
 483 c 6. initialisation associee aux grandeurs character*8
 484 c====
 485 #ifdef _DEBUG_HOMARD_
 486       write (*,*) 'Etape 6 ; caracteres'
 487 #endif
 488 c
 489       call dmlocs (smem,ad0)
 490 c
 491       if ( modgm.eq.0) then
 492         ad1 = ad0
 493         coergm = 0
 494         iaux = nch08 - ptrdeb + 1
 495       elseif ( modgm.eq.1) then
 496         call gbalme('s',nch08+ptrdeb,ad1)
 497         iaux = nch08
 498       else
 499         ad1 = 0
 500         coergm = 0
 501         iaux = nch08 - ptrdeb + 1
 502       endif
 503 c
 504       if ( coergm.ne.0) then
 505         write (ulsort,texte(langue,1)) 'Sortie', nompro
 506         write (ulsort,*) ' allocation de ',nch08,' ch*8'
 507         write (ulsort,*) ' impossible '
 508         call ugstop( nompro,ulsort,1,1,1)
 509       endif
 510 c
 511       adcom(3) = ad0
 512       admem(3) = ad1
 513 CGN   write(smem(0),'(i8)') sindef
 514       write(smem(1),'(i8)') nch08
 515       ntrous    = ntrou0
 516       ptrous(1) = ptrdeb
 517       ltrous(1) = iaux
 518 c
 519       minmes    = ltrous(1)
 520       minles    = ltrous(1)
 521       nommxs    = '        '
 522       nballs    = 0
 523       totals    = nch08 - iaux
 524 c
 525 c====
 526 c 8. initialisation des tables des types d'objet structure
 527 c====
 528 #ifdef _DEBUG_HOMARD_
 529       write (*,*) 'Etape 8 ; objet structure'
 530 #endif
 531 c
 532       call gbitos ( nfdico, lfdico, coergm)
 533 c
 534       if (coergm.ne.0) then
 535         write (ulsort,*) nompro,' -> gbitos -> coergm : ',coergm
 536         call ugstop( nompro,ulsort,1,1,1)
 537       endif
 538 c
 539 c====
 540 c 9.  on archive l'information pour le gestionnaire global
 541 c====
 542 #ifdef _DEBUG_HOMARD_
 543       write (*,*) 'Etape 9 ; archivage'
 544 #endif
 545 c
 546       code = 1
 547       call ugtabl ( code, tabges, ulsort)
 548 c
 549       tabges(3) = 1
 550 c
 551       code = 0
 552       call ugtabl ( code, tabges, ulsort)
 553 c
 554 c====
 555 c 10. Impression recapitulative
 556 c====
 557 c
 558 #ifdef _DEBUG_HOMARD_
 559       write (ulsort,texte(langue,modgm+4))
 560 #endif
 561 c
 562 #ifdef _DEBUG_HOMARD_
 563       write (ulsort,texte(langue,10))
 564       write (ulsort,texte(langue,11)) nuvegm, nusvgm
 565 c
 566       if ( modgm.le.1 ) then
 567 c
 568          iaux = imem(1)
 569          write (ulsort,texte(langue,7)) 'Entiers     ', adcom(1)
 570          write (ulsort,texte(langue,8)) admem(1)
 571          write (ulsort,texte(langue,9)) iaux
 572 c
 573          iaux = int(rmem(1))
 574          write (ulsort,texte(langue,7)) 'Reels       ', adcom(2)
 575          write (ulsort,texte(langue,8)) admem(2)
 576          write (ulsort,texte(langue,9)) iaux
 577 c
 578          read(smem(1),'(i8)') iaux
 579          write (ulsort,texte(langue,7)) 'Caracteres*8', adcom(3)
 580          write (ulsort,texte(langue,8)) admem(3)
 581          write (ulsort,texte(langue,9)) iaux
 582 c
 583       else
 584 c
 585          write (ulsort,texte(langue,7)) 'Entiers     ', adcom(1)
 586 c
 587          write (ulsort,texte(langue,7)) 'Reels       ', adcom(2)
 588 c
 589          write (ulsort,texte(langue,7)) 'Caracteres*8', adcom(3)
 590 c
 591       endif
 592 #endif
 593 c
 594 c====
 595 c 11. la fin
 596 c====
 597 c
 598       codret = coergm
 599 c
 600       if ( codret.ne.0 ) then
 601 c
 602 #include "envex2.h"
 603 c
 604         write (ulsort,texte(langue,1)) 'Sortie', nompro
 605         write (ulsort,texte(langue,2)) codret
 606 c
 607       endif
 608 c
 609 #ifdef _DEBUG_HOMARD_
 610       write (ulsort,texte(langue,1)) 'Sortie', nompro
 611       call dmflsh (iaux)
 612 #endif
 613 c
 614       end