src/tool/Gestion_MTU/gmalos.F

   1       subroutine gmalos( nomtab, pointe, nb)
   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 ......................................................................
  23 c .  creation juin 93 jyb
  24 c ......................................................................
  25 c .       allocation d'un tableau character*8 dans le common gmstri
  26 c .
  27 c .  - arguments:
  28 c .       donnees a l'appel  nomtab -->  nom de la variable a allouer
  29 c .                                      de 8 caracteres au plus
  30 c .                            nb   -->  nombre de character*8  demandes
  31 c .       resultat          pointe  <--  pointeur associe
  32 c ......................................................................
  33 c====
  34 c 0. declarations et dimensionnement
  35 c====
  36 c 0.1. ==> generalites
  37 c----
  38 c
  39       implicit none
  40       save
  41 c
  42       character*6 nompro
  43       parameter ( nompro = 'GMALOS' )
  44 c
  45 #include "genbla.h"
  46 #include "gmmaxt.h"
  47 c
  48 c 0.2. ==> communs
  49 c
  50 #include "gmstri.h"
  51 #include "gmadus.h"
  52 #include "gmtrst.h"
  53 #include "gmalst.h"
  54 #include "gmindf.h"
  55 #include "gminds.h"
  56 #include "gmimpr.h"
  57 c
  58 #include "envex1.h"
  59 #include "gmcoer.h"
  60 #include "gmlang.h"
  61 c
  62 c 0.3. ==> arguments
  63 c
  64       integer pointe , nb
  65 c
  66       character*(*) nomtab
  67 c
  68 c 0.4. ==> variables locales
  69 c
  70       integer iaux
  71       integer ideb, ifin
  72 c
  73       character*1 typtab
  74 c
  75       integer nbmess
  76       parameter ( nbmess = 10 )
  77       character*80 texte(nblang,nbmess)
  78 c
  79 c====
  80 c 1. initialisations
  81 c====
  82 c
  83 #include "impr01.h"
  84 c
  85 #ifdef _DEBUG_HOMARD_
  86       write (ulsort,texte(langue,1)) 'Entree', nompro
  87       call dmflsh (iaux)
  88 #endif
  89 c
  90 c ----
  91 c  2. allocation du tableau par le programme generique
  92 c----
  93 c
  94 #ifdef _DEBUG_HOMARD_
  95       write (ulsort,*) 'Appel de gmalog par gmalos, nb = ', nb
  96 #endif
  97       typtab = 's'
  98       call gmalog ( nomtab, pointe, nb, typtab,
  99      >      minmes, ntrous, nballs, totals,
 100      >      ptrous, ltrous, ptalls, lgalls,adus,
 101      >      nommxs, nomals )
 102 #ifdef _DEBUG_HOMARD_
 103       write (ulsort,*) '==> pointe = ', pointe
 104 #endif
 105 c
 106 c---
 107 c 3. au depart, le tableau sera mis a une valeur indefinie, vues
 108 c    les options de compilation.
 109 c    si on alloue apres avoir fait des desallocations, on peut
 110 c    se retrouver dans le tableau smem a un endroit qui etait occupe
 111 c    autrefois par quelque chose : on recupere alors les valeurs
 112 c    de l'epoque.
 113 c    toutefois cela n'est pas possible en compression car on risque
 114 c    de detruire le debut du tableau que l'on deplace
 115 c    tout ceci est pilote par lindef
 116 c---
 117 c
 118 #ifdef _DEBUG_HOMARD_
 119       write (ulsort,*) 'Etape 3 de gmalos , coergm = ', coergm
 120 #endif
 121 c
 122       if ( coergm.eq.0 ) then
 123 c
 124       if ( lindef.eq.0 ) then
 125         ideb = pointe
 126         ifin = pointe + nb - 1
 127 cgn      write (ulsort,*) 'ideb , ifin = ', ideb , ifin
 128         do 30 , iaux = ideb , ifin
 129 cgn      write (ulsort,*) 'iaux = ', iaux
 130            smem(iaux) = sindef
 131    30   continue
 132       endif
 133 c
 134       endif
 135 c
 136 c====
 137 c 4. Fin
 138 c====
 139 c
 140 #ifdef _DEBUG_HOMARD_
 141       write (ulsort,*) 'Fin de gmalos'
 142 #endif
 143 c
 144       if ( coergm.ne.0 ) then
 145 c
 146 #include "envex2.h"
 147 c
 148       endif
 149 c
 150       end