src/tool/Gestion_MTU/gblibe.F

   1       subroutine gblibe (typtab,n,iad,codret)
   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     liberation
  23 c   remarque : pour l'instant la taille, n, ne sert a rien
  24 c ______________________________________________________________________
  25 c .        .     .        .                                            .
  26 c .  nom   . e/s . taille .           description                      .
  27 c .____________________________________________________________________.
  28 c . typtab . e   . char*1 . type du tableau a allouer                  .
  29 c . n      . e   .    1   . longueur du tableau                        .
  30 c . iad    .  s  .    1   . adresse du premier element du tableau      .
  31 c . codret .  s  .    1   . 0  : tout va bien                          .
  32 c ______________________________________________________________________
  33 c
  34 c====
  35 c 0. declarations et dimensionnement
  36 c====
  37 c
  38 c 0.1. ==> generalites
  39 c
  40       implicit none
  41       save
  42 c
  43 c 0.2. ==> communs
  44 c
  45 #include "gmtail.h"
  46 c
  47 #include "gmimpr.h"
  48 c
  49 c 0.3. ==> arguments
  50 c
  51       character*1 typtab
  52       integer n, iad
  53       integer codret
  54 c
  55 c 0.4. ==> variables locales
  56 c
  57       integer ltype
  58 c
  59       character*60 texte(5)
  60 c
  61 c 0.5. ==> initialisations
  62 c ______________________________________________________________________
  63 c
  64 c====
  65 c 1. messages
  66 c====
  67 c
  68 c                 12345678901234567890123456789012345678901234567890
  69       texte(3) = 'L''adresse est hors des limites de la pile (heap). '
  70       texte(4) = 'La zone a deja ete liberee.                       '
  71       texte(5) = 'L''adresse n''est pas au debut d''un bloc.           '
  72 c
  73 c====
  74 c 2. liberation effective
  75 c====
  76 c
  77 cgn      print *,'appel de dmlibe : ',iad
  78       call dmlibe (iad,codret)
  79 cgn      print *,'retour de dmlibe'
  80 c
  81 c====
  82 c 3. message d'erreur
  83 c====
  84 c
  85       if ( codret.ne.0) then
  86 c
  87       if ( typtab.eq.'i'.or.typtab.eq.'I') then
  88        ltype = tentie
  89       elseif ( typtab.eq.'s'.or.typtab.eq.'S') then
  90        ltype = tchain
  91       elseif ( typtab.eq.'r'.or.typtab.eq.'R') then
  92        ltype = treel
  93       else
  94         write(ulsort,*) ' gblibe type inconnu ', typtab
  95         call ugstop('gblibe',ulsort,0,1,1)
  96       endif
  97 c
  98       write (ulsort,*) ' GBLIBE : erreur a la liberation'
  99       write (ulsort,*) 'Code de retour de DMLIBE : ', codret
 100       if ( codret.ge.-5 .and. codret.le.-3 ) then
 101          write (ulsort,*) texte(abs(codret))
 102       endif
 103       write (ulsort,*) 'Type          : ', typtab
 104       write (ulsort,*) 'Adresse       : ', iad
 105       write (ulsort,*) 'Taille voulue : ', n
 106 c
 107       endif
 108 c
 109       end