src/tool/Gestion_MTU/gmalor.F

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