src/tool/Gestion_MTU/gmalog.F

   1       subroutine gmalog ( nomtab,   adut, nbplac,   type1,
   2      >                    minmeg, ntroug, nballg, totalg,
   3      >                    ptroug, ltroug, ptallg, lgallg, adug,
   4      >                    nommxg, nomalg )
   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  memoire dynamique :
  26 c
  27 c  adut est toujours une adresse utile :
  28 c           elle peut etre utilisee sous la forme :
  29 c           ...mem(adut)=...
  30 c
  31 c
  32 c  que contient ptall :
  33 c
  34 c   En modgm 0 ( statique ) :
  35 c       decalage par rapport au debut de la zone : decal
  36 c       ptallg = decal
  37 c       adug = (ad1-ad0)/ltype+decal
  38 c       entre deux tableaux : adug1 - adug2 = ptallg1 - ptallg2
  39 c
  40 c   En modgm 1 ( semi-dynamique ) :
  41 c       decalage par rapport au debut de la zone : decal
  42 c       ptallg = decal
  43 c       adug = (ad1-ad0)/ltype+decal+1
  44 c       entre deux tableaux : adug1 - adug2 = ptallg1 - ptallg2
  45 c
  46 c   En modgm 2 ( dynamique ) :
  47 c       retour de gbalme c.a.d. adresse absolue adabs
  48 c       ptallg = adabs
  49 c       adug = (adabs-ad0)/ltype+2
  50 c       entre deux tableaux : adug1 - adug2 = (ptallg1 - ptallg2)/ltype
  51 c
  52 c       cf. commentaires dans le source pour plus de details sur
  53 c       le calcul de adresses "utiles"
  54 c       (= indices dans les tableaux ...mem) en dynamique.
  55 c
  56 c ......................................................................
  57 c .
  58 c .       programme generique d'allocation d'un tableau
  59 c .       affectation du debut du premier trou memoire suffisant
  60 c .       mise a jour du tableau des trous
  61 c .       mise a jour des tableaux des variables allouees (stats)
  62 c .
  63 c .  - arguments:
  64 c . donnees nomtab  --> nom du tableau a allouer (8 caracteres au plus)
  65 c .         nbplac  --> nombre de places demandees
  66 c .         type1   --> type du tableau :r,i,s
  67 c .modifies minmeg <--> valeur entiere memorisant la plus petite
  68 c .                     dimension du dernier trou afin de connaitre
  69 c .                     le passage le plus delicat rencontre au cours
  70 c .                     de l'allocation. cette valeur est calculee
  71 c .                     apres compression (pour statistiques)
  72 c .         ntroug <--> valeur entiere . nombre de trous presents
  73 c .         nballg <--> nombre de tableaux deja alloues
  74 c .         totalg <--> valeur entiere cumulant les demandes
  75 c .                     successives de memoire
  76 c .         ptroug <--> tableau entier contenant les pointeurs
  77 c .                     repertoriant la position des trous
  78 c .         ltroug <--> tableau entier contenant la longueur des trous
  79 c .         ptallg <--> tableau entier contenant les pointeurs
  80 c .                     repertoriant la position des tableaux
  81 c .         adug  <-->  tableau entier contenant les adresses utiles
  82 c .                     des tableaux
  83 c .         lgallg <--> tableau entier contenant la longueur des
  84 c .                     tableaux
  85 c .         nommxg <--> chaine de caractere(*8) contenant le nom du
  86 c .                     plus grand (?) tableau associe a minmeg
  87 c .         nomalg <--> tableau de chaines de caracteres contenant
  88 c .                     le nom associe a chaque tableau deja alloue
  89 c .resultat adut   <--  pointeur associe
  90 c .                     la valeur renvoyee est indefinie en cas de
  91 c .                     probleme
  92 c .
  93 c ......................................................................
  94 c
  95 c====
  96 c 0. declarations et dimensionnement
  97 c====
  98 c
  99 c 0.1. ==> generalites
 100 c
 101       implicit none
 102       save
 103 c
 104       character*6 nompro
 105       parameter ( nompro = 'GMALOG' )
 106 c
 107 #include "gmmaxt.h"
 108 #include "gmptrd.h"
 109 c
 110 #include "genbla.h"
 111 #include "gmcain.h"
 112 c
 113 c 0.2. ==> communs
 114 c
 115 #include "gmtyge.h"
 116 #include "gmtail.h"
 117 #include "gmindi.h"
 118 c
 119 #include "gmenti.h"
 120 #include "gmreel.h"
 121 #include "gmstri.h"
 122 c
 123 #include "envex1.h"
 124 #include "gmcoer.h"
 125 #include "gmimpr.h"
 126 #include "gmlang.h"
 127 c
 128 c 0.3. ==> arguments
 129 c
 130       character*(*) nomtab
 131       character*1 type1
 132       character*8 nommxg, nomalg(maxtab)
 133       integer adug(maxtab)
 134 c
 135       integer adut , nbplac
 136       integer minmeg, ntroug, nballg, totalg
 137       integer ptroug(maxtrs) , ltroug(maxtrs)
 138       integer ptallg(maxtab) , lgallg(maxtab)
 139 c
 140 c 0.4. ==> variables locales
 141 c
 142       character*16 blabla
 143       character*8 nomvar
 144 c
 145       integer i, iaux, maxo, mtoto
 146       integer pointe
 147       integer ltype, ad0, ad1, nrotab, nrotro
 148       integer nbcain, nfois, nentg
 149 c
 150       character*6 nompra
 151 c
 152       character*1 carint(1)
 153 c
 154       logical dertro
 155 c
 156       integer nbmess
 157       parameter ( nbmess = 10 )
 158 c
 159       character*80 texte(nblang,nbmess)
 160 c
 161 c 0.5. ==> initialisations
 162 c
 163       data nfois / 0 /
 164 c
 165 c ______________________________________________________________________
 166 c
 167 c====
 168 c  1. preliminaires
 169 c====
 170 c
 171 #include "impr01.h"
 172 c
 173 #ifdef _DEBUG_HOMARD_
 174       write (ulsort,texte(langue,1)) 'Entree', nompro
 175       call dmflsh (iaux)
 176 #endif
 177 c
 178       texte(1,4) = '(/,''La gestion de la memoire est statique.'')'
 179       texte(1,5) ='(/,''La gestion de la memoire est semi-dynamique.'')'
 180       texte(1,6) = '(/,''La gestion de la memoire est dynamique.'')'
 181 c
 182       texte(2,4) = '(/,''A static memory management is used.'')'
 183       texte(2,5) = '(/,''A semi-dynamic memory management is used.'')'
 184       texte(2,6) = '(/,''A dynamic memory management is used.'')'
 185 c
 186 #ifdef _DEBUG_HOMARD_
 187       write (ulsort,texte(langue,modgm+4))
 188 #endif
 189 c
 190       coergm = 0
 191 c
 192       adut = iindef
 193 c
 194       blabla = '                '
 195 c
 196 #ifdef _DEBUG_HOMARD_
 197       write (ulsort,*) 'type1 = ', type1
 198 #endif
 199       if ( type1.eq.'i' .or. type1.eq.'I' ) then
 200          nompra = 'GMALOI'
 201          blabla = 'entier          '
 202          ltype = tentie
 203          ad0 = adcom(1)
 204          ad1 = admem(1)
 205       else if ( type1.eq.'r' .or. type1.eq.'R' ) then
 206          nompra = 'GMALOR'
 207          blabla = 'reel            '
 208          ltype = treel
 209          ad0 = adcom(2)
 210          ad1 = admem(2)
 211       else if ( type1.eq.'s' .or. type1.eq.'S' ) then
 212          nompra = 'GMALOS'
 213          blabla = 'caractere       '
 214          ltype = tchain
 215          ad0 = adcom(3)
 216          ad1 = admem(3)
 217       else
 218          write(ulsort,10000) type1
 219          coergm = 1
 220 cgn         call ugstop( nompro, ulsort, 1, 1, 1 )
 221       endif
 222 #ifdef _DEBUG_HOMARD_
 223       write (ulsort,*) 'ltype = ', ltype
 224       write (ulsort,*) 'ad0 = ', ad0, ', ad1 = ', ad1
 225 #endif
 226 10000 format (//2x,' ******  spg GMALOG   *****',
 227      >        /2x,'Le type ',a1,' est inconnu.',
 228      >        /2x,'Il faut r, i ou s',
 229      >        /2x,'    ===>  arret dans le gestionnaire de memoire')
 230 c
 231 c====
 232 c  2. verifications
 233 c====
 234 #ifdef _DEBUG_HOMARD_
 235       write (ulsort,*) '2. verifications ; coergm = ', coergm
 236 #endif
 237 c
 238 c 2.1. ==> nature du nom
 239 c          aucun caractere n'est interdit, mais on met un blanc
 240 c          dans le tableau pour ne plus avoir de messages ftnchek
 241 c
 242       if ( coergm.eq.0 ) then
 243 c
 244       nbcain = 0
 245       carint(1) = ' '
 246       call gmntve ( nomtab, nomvar, nbcain, carint, coergm )
 247 c
 248       if ( coergm.ne.0 ) then
 249          write(ulsort,21100) nompra
 250          coergm = 21
 251 cgn         call ugstop( nompro, ulsort, 1, 1, 1 )
 252       endif
 253 c
 254 21100 format ( 2x,'Probleme a l''appel au spg GMALOG via ',a6,
 255      >          /,4x,'    ===>  arret dans le gestionnaire de memoire')
 256 c
 257       endif
 258 c
 259 c 2.2. ==> verification du nombre de tableaux deja alloues
 260 c          . pour un tableau "ordinaire", on s'arrete un peu avant
 261 c          le maximum pour se garder une marge dans les impressions
 262 c          d'arret du programme
 263 c          . si c'est un tableau de nom temporaire, on controle
 264 c          sur le vrai nombre maximum de tableaux car il se peut
 265 c          que ce soit dans les impressions de deboggage, donc il ne
 266 c          faudrait pas boucler en controlant trop juste.
 267 c
 268       if ( coergm.eq.0 ) then
 269 c
 270       if ( nomvar(1:1).eq.caint1 ) then
 271 c
 272         iaux = 0
 273 c
 274       else
 275         iaux = 10
 276         if ( nballg.gt.maxtab-iaux .and. nfois.eq.0 ) then
 277           nfois = 1
 278           if ( type1.eq.'r' .or. type1.eq.'R' ) then
 279             call gmdmpr ( iaux )
 280           else if ( type1.eq.'i' .or. type1.eq.'I' ) then
 281             call gmdmpi ( iaux )
 282           else if ( type1.eq.'s' .or. type1.eq.'S' ) then
 283             call gmdmps ( iaux )
 284           endif
 285           write(ulsort,21100) nompra
 286           write(ulsort,22000) nomvar, nballg, maxtab
 287           coergm = 221
 288 cgn           call ugstop( nompro, ulsort, 1, 1, 1 )
 289         endif
 290 c
 291       endif
 292 c
 293       endif
 294 c
 295       if ( coergm.eq.0 ) then
 296 c
 297       if ( nballg.eq.maxtab-iaux .and. nfois.eq.0 ) then
 298         nfois = 1
 299         if ( type1.eq.'r' .or. type1.eq.'R' ) then
 300           call gmdmpr ( iaux )
 301         else if ( type1.eq.'i' .or. type1.eq.'I' ) then
 302           call gmdmpi ( iaux )
 303         else if ( type1.eq.'s' .or. type1.eq.'S' ) then
 304           call gmdmps ( iaux )
 305         endif
 306         write(ulsort,21100) nompra
 307         write(ulsort,22000) nomvar, maxtab-iaux, maxtab
 308         coergm = 222
 309 cgn          call ugstop( nompro, ulsort, 1, 1, 1 )
 310       endif
 311 c
 312       endif
 313 c
 314 22000 format ( 2x,'GMALOG : Allocation de ',a8,
 315      >       /,4x,'C''est le tableau numero ',i8 ,
 316      >       /,4x,'Le nombre maxi de tableaux allouables vaut ',i8 ,
 317      >       /,4x,'Il faut changer maxtab dans le gestionnaire',
 318      >         1x,'(fichier a inclure gmmaxt.h)',
 319      >       /,4x,'    ===>  arret du au gestionnaire memoire gm')
 320 c
 321 c 2.3. ==> impossible d'avoir un nombre de places < 0
 322 c
 323       if ( coergm.eq.0 ) then
 324 c
 325       if (nbplac.lt.0)  then
 326         write(ulsort,21100) nompra
 327         write(ulsort,23000) nompra, nomvar, nbplac
 328         coergm = 23
 329 cgn        call ugstop( nompro, ulsort, 1, 1, 1 )
 330       endif
 331 c
 332       endif
 333 c
 334 23000 format ( 2x,'Mauvais appel au spg GMALOG via ',a6,
 335      >       /,4x,' pour le tableau ',a8,
 336      >       /,4x,'Nombre de valeurs requises negatif ( ',i15,')' ,
 337      >       /,4x,'    ===>  arret dans le gestionnaire de memoire')
 338 c
 339 c 2.4. ==> verif que le nom n'est pas deja utilise
 340 c
 341       if ( coergm.eq.0 ) then
 342 c
 343       do 24 i = 1 , nballg
 344         if ( nomalg(i).eq.nomvar ) then
 345           write(ulsort,24000) nompra, nomvar
 346           coergm = 24
 347           goto 241
 348 cgn          call ugstop( nompro, ulsort, 1, 1, 1 )
 349         endif
 350    24 continue
 351 c
 352   241 continue
 353 c
 354       endif
 355 c
 356 24000 format ( 2x,'Probleme a l''appel au spg GMALOG via ',a6,
 357      >       /,4x,'Nom du tableau (',a8,') deja utilise' ,
 358      >       /,4x,'    ===>  arret dans le gestionnaire de memoire')
 359 c
 360 c====
 361 c 3. Allocation
 362 c====
 363 #ifdef _DEBUG_HOMARD_
 364       write (ulsort,*) '3. allocations ; coergm = ', coergm
 365 #endif
 366 c
 367 c 3.1. ==> en mode statique ou semi-dynamique
 368 c
 369       if ( modgm.le.1 ) then
 370 #ifdef _DEBUG_HOMARD_
 371 cgn      if ( nomtab.eq.'MaEn002f' ) then
 372       write (ulsort,*) 'nomtab = ', nomtab
 373       write (ulsort,*) '3.1. Mode stat ou semi/dyna ; coergm = ', coergm
 374       write (ulsort,*) 'nbplac = ', nbplac
 375 cgn      endif
 376 #endif
 377 c
 378 c 3.1.1. ==> si on a demande d'allouer un tableau de longueur nulle,
 379 c            on le place en premiere position.
 380 c            l'inconvenient est que cela oblige a remanier la liste
 381 c            complete des tableaux a la fin de ce programme
 382 c            mais le gros avantage est qu'en cas de desallocation
 383 c            on ne risque pas de trouver un tableau de longueur
 384 c            nulle encadre par deux trous ; les trous sont ainsi
 385 c            toujours regroupes de maniere compacte
 386 c
 387         if ( nbplac.eq.0 ) then
 388 c
 389           if ( coergm.eq.0 ) then
 390 c
 391           nrotab = 1
 392           pointe = ptrdeb
 393 c
 394           endif
 395 c
 396         else
 397 c
 398 c 3.1.2. ==> allocation d'un tableau de longueur non nulle
 399 c
 400 c 3.1.2.1. recherche du premier trou suffisamment grand
 401 c          si aucun trou n'est disponible, impression d'un message,
 402 c          puis arret de l'execution
 403 c
 404           if ( coergm.eq.0 ) then
 405 c
 406           do 311 iaux = 1 , ntroug
 407             if ( ltroug(iaux).ge.nbplac ) then
 408               nrotro = iaux
 409               go to 312
 410             endif
 411   311     continue
 412 c
 413           call gmmaxi ( maxo , mtoto , ntroug , ltroug )
 414 c
 415           write(ulsort, 30100 ) nbplac, blabla, nomvar
 416           write(ulsort, 30200 ) maxo, ntroug, mtoto
 417           iaux = 10
 418           if ( type1.eq.'r' .or. type1.eq.'R' ) then
 419             call gmdmpr ( iaux )
 420           else if ( type1.eq.'i' .or. type1.eq.'I' ) then
 421             call gmdmpi ( iaux )
 422           else if ( type1.eq.'s' .or. type1.eq.'S' ) then
 423             call gmdmps ( iaux )
 424           endif
 425 c
 426           coergm = 312
 427 cgn          call ugstop( nompro, ulsort, 1, 2, 1 )
 428 c
 429           endif
 430 c
 431 c 3.1.2.2. ==> une place ayant ete trouvee, on met le tableau au debut
 432 c              de ce trou
 433 c              on memorise si c'etait le dernier trou ou non
 434 c
 435   312     continue
 436 c
 437           if ( coergm.eq.0 ) then
 438 c
 439           pointe = ptroug(nrotro)
 440 c
 441           if ( nrotro.eq.ntroug ) then
 442             dertro = .true.
 443           else
 444             dertro = .false.
 445           endif
 446 c
 447           endif
 448 c
 449 c 3.1.2.3. ==> gestion des trous
 450 c              . si le trou a la meme taille que le tableau a allouer,
 451 c                il doit disparaitre. il faut alors decaler d'un cran
 452 c                les eventuels trous qui suivent.
 453 c              . si le trou est plus grand que le tableau a allouer,
 454 c                il est simplement decale et raccourci.
 455 c
 456           if ( coergm.eq.0 ) then
 457 c
 458           if ( ltroug(nrotro).eq.nbplac ) then
 459 c
 460              ntroug = ntroug - 1
 461              do 313 iaux = nrotro , ntroug
 462                 ptroug(iaux) = ptroug(iaux+1)
 463                 ltroug(iaux) = ltroug(iaux+1)
 464   313        continue
 465              ptroug(ntroug+1) = iindef
 466              ltroug(ntroug+1) = iindef
 467 c
 468              if ( dertro ) then
 469                if ( minmeg.gt.0 ) then
 470                  nommxg = nomvar
 471                endif
 472                minmeg = 0
 473              endif
 474 c
 475           else
 476 c
 477             ptroug(nrotro) = ptroug(nrotro) + nbplac
 478             ltroug(nrotro) = ltroug(nrotro) - nbplac
 479 c
 480           endif
 481 c
 482           endif
 483 c
 484 c 3.1.2.4. ==> on met a jour la longueur minimale du dernier trou.
 485 c
 486           if ( coergm.eq.0 ) then
 487 c
 488           if ( ntroug.le.0 ) then
 489             minmeg = 0
 490           else if ( minmeg.gt.ltroug(ntroug) ) then
 491             nommxg = nomvar
 492             minmeg = ltroug(ntroug)
 493           endif
 494 c
 495           endif
 496 c
 497 c 3.1.2.5. ==> . si le tableau est place au debut du dernier trou,
 498 c                il vient a la suite du dernier tableau enregistre.
 499 c              . si le tableau est place dans un trou qui est au milieu
 500 c                des tableaux, il faut l'inserer entre des tableaux
 501 c                deja alloues. on recherche le premier tableau dont
 502 c                l'adresse est plus grande que l'adresse du-dit trou.
 503 c
 504           if ( coergm.eq.0 ) then
 505 c
 506           if ( dertro ) then
 507 c
 508             nrotab = nballg + 1
 509 c
 510           else
 511 c
 512             do 314 i = 1, nballg
 513               if (ptallg(i).gt.pointe) then
 514                 nrotab = i
 515                 goto 315
 516               endif
 517   314       continue
 518 c
 519 c NB: si on passe ici, c'est bizarre
 520 c     (mauvaise gestion des trous?)
 521 c
 522             nrotab = nballg + 1
 523 c
 524   315       continue
 525 c
 526           endif
 527 c
 528           endif
 529 c
 530         endif
 531 c
 532 c 3.1.3. ==> calcul de l'adresse utile
 533 c
 534         if ( coergm.eq.0 ) then
 535 c
 536         adut = ((ad1-ad0)/ltype) + pointe
 537         if ( modgm.eq.1 ) then
 538           adut = adut + 1
 539         endif
 540 c
 541         endif
 542 c
 543 c 3.1.4. ==> mise a jour des listes par decalage des informations
 544 c            relatives aux tableaux qui viennent apres le tableau
 545 c            en cours d'allocation
 546 c
 547         if ( coergm.eq.0 ) then
 548 c
 549         do 316 iaux = nballg , nrotab , -1
 550           nomalg(iaux+1) = nomalg(iaux)
 551           ptallg(iaux+1) = ptallg(iaux)
 552           lgallg(iaux+1) = lgallg(iaux)
 553           adug(iaux+1)   = adug(iaux)
 554   316   continue
 555 c
 556         endif
 557 c
 558 c 3.2. ==> cas du mode dynamique
 559 c          le tableau alloue est toujours le dernier
 560 c
 561       else
 562 #ifdef _DEBUG_HOMARD_
 563         write (ulsort,*) '3.2. Mode dynamique ; coergm = ', coergm
 564 #endif
 565 c
 566         if ( coergm.eq.0 ) then
 567 c
 568 #ifdef _DEBUG_HOMARD_
 569         write (ulsort,*) 'appel de gbalme par gmalog, avec :'
 570         write (ulsort,*) '... type1    : ', type1
 571         write (ulsort,*) '... nbplac+1 : ', nbplac+1
 572 #endif
 573         call gbalme ( type1, nbplac+1, pointe )
 574 c
 575         endif
 576 c
 577         if ( coergm.ne.0 ) then
 578 c
 579           write(ulsort,30100) nbplac+1, blabla, nomvar
 580 cgn          call ugstop( nompro, ulsort, 1, 2, 1 )
 581 c
 582         else
 583 c
 584           nrotab = nballg + 1
 585 c
 586 #ifdef _DEBUG_HOMARD_
 587       write (ulsort,*) 'pointe = ', pointe
 588       write (ulsort,*) 'pointe-ad0 = ', pointe-ad0
 589 #endif
 590           adut = (pointe-ad0)/ltype
 591 c
 592 c En particulier pour les "gros types"
 593 c on n'a pas vraiment de garantie que la division precedente
 594 c "tombe juste". Le fait d'avoir en fait alloue nbplac+1 au lieu de
 595 c nbplac (cf. appel a gbalme ci-dessus) permet de se mettre a l'abri
 596 c de ce genre de probleme (en plus d'eviter de demander au systeme
 597 c un malloc avec taille nulle, ce qui ne se passe pas toujours bien).
 598 c
 599 c Cette maniere d'evaluer l'adresse utile adut permet aussi de se
 600 c premunir du cas ( extremement rare apparemment ) ou pointe-ad0
 601 c serait negatif (habituellement, les communs -donc ad0- sont charges
 602 c en memoire a des adresses inferieures au "heap" -donc pointe-).
 603 c
 604           if ( adut*ltype .ge. pointe-ad0 ) then
 605             adut = adut + 1
 606           else
 607             adut = adut + 2
 608           endif
 609 c
 610 c  gestion des grandeurs permettant d'obtenir des statistiques globales
 611 c  (meme en mode dynamique) :
 612 c
 613           if ( minmeg.ge.nbplac ) then
 614             minmeg = minmeg - nbplac
 615             if ( minmeg.eq.0 .and. nbplac.gt.0 ) then
 616               nommxg = nomvar
 617             endif
 618           else
 619             if ( type1.eq.'r' .or. type1.eq.'R' ) then
 620               rmem(1) = rmem(1) + dble(nbplac - max( 0, minmeg ))
 621             else if ( type1.eq.'i' .or. type1.eq.'I' ) then
 622               imem(1) = imem(1) + nbplac - max( 0, minmeg )
 623             else if ( type1.eq.'s' .or. type1.eq.'S' ) then
 624               if (index(smem(1),'*').le.0) then
 625                 read(smem(1),'(i8)') nentg
 626                 nentg = nentg + nbplac - max( 0, minmeg )
 627                 write(smem(1),'(i8)') nentg
 628               endif
 629             endif
 630             if ( nbplac.gt.0 .or. minmeg.lt.0 ) then
 631               nommxg = nomvar
 632             endif
 633             minmeg = 0
 634           endif
 635 c
 636         endif
 637 c
 638       endif
 639 c
 640 c 3.3. ==> memorisation des caracteristiques du nouveau tableau
 641 c          et statistiques globales
 642 #ifdef _DEBUG_HOMARD_
 643       write (ulsort,*) '3.3. Memorisation ; coergm = ', coergm
 644 #endif
 645 c
 646       if ( coergm.eq.0 ) then
 647 c
 648       nballg = nballg + 1
 649 c
 650       nomalg(nrotab) = nomvar
 651       ptallg(nrotab) = pointe
 652       lgallg(nrotab) = nbplac
 653       adug(nrotab) = adut
 654 c
 655       totalg = totalg + nbplac
 656 c
 657       endif
 658 c
 659 c 3.5 ==> messages
 660 c
 661 #ifdef _DEBUG_HOMARD_
 662       write (ulsort,*) '3.5. messages ; coergm = ', coergm
 663 #endif
 664 30100 format(
 665      >/,78('='),
 666      >/,'Impossible d''allouer',i15,' places en ',a16,
 667      > ' pour ''',a8,'''',
 668      >/,78('='),/)
 669 30200 format(
 670      >/,10x,'Le maximum disponible est de',i15,' places ;',
 671      >/,10x,'Il y a',i5,' trous totalisant',i15,' places.'/)
 672 c
 673 c====
 674 c 4. Fin
 675 c====
 676 c
 677       if ( coergm.ne.0 ) then
 678 c
 679 #include "envex2.h"
 680 c
 681       endif
 682 c
 683 #ifdef _DEBUG_HOMARD_
 684       write (ulsort,texte(langue,1)) 'Sortie', nompro
 685       call dmflsh (iaux)
 686 #endif
 687 c
 688       end