1 subroutine gblibe (typtab,n,iad,codret)
2 c ______________________________________________________________________
6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
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
14 c HOMARD est une marque deposee d'Electricite de France
20 c ______________________________________________________________________
23 c remarque : pour l'instant la taille, n, ne sert a rien
24 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 ______________________________________________________________________
35 c 0. declarations et dimensionnement
38 c 0.1. ==> generalites
55 c 0.4. ==> variables locales
61 c 0.5. ==> initialisations
62 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. '
74 c 2. liberation effective
77 cgn print *,'appel de dmlibe : ',iad
78 call dmlibe (iad,codret)
79 cgn print *,'retour de dmlibe'
85 if ( codret.ne.0) then
87 if ( typtab.eq.'i'.or.typtab.eq.'I') then
89 elseif ( typtab.eq.'s'.or.typtab.eq.'S') then
91 elseif ( typtab.eq.'r'.or.typtab.eq.'R') then
94 write(ulsort,*) ' gblibe type inconnu ', typtab
95 call ugstop('gblibe',ulsort,0,1,1)
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))
103 write (ulsort,*) 'Type : ', typtab
104 write (ulsort,*) 'Adresse : ', iad
105 write (ulsort,*) 'Taille voulue : ', n