1 subroutine gmstop ( gmimp )
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 ______________________________________________________________________
22 c but : arrete le programme proprement
23 c ______________________________________________________________________
25 c . nom . e/s . taille . description .
26 c .____________________________________________________________________.
27 c . gmimp . e . 1 . 0 => pas d'impression .
28 c . . . . 1 => bilan d'utilisation de la memoire .
29 c . . . . 2 => impressions des tables des objets .
30 c . . . . dans l'etat courant .
31 c ______________________________________________________________________
34 c 0. declarations et dimensionnement
37 c 0.1. ==> generalites
67 c 0.4. ==> variables locales
70 integer iaux, nbrobj, letype
72 character*8 obrepc, obterc, chterc
73 character*8 nomost(nobjx), nomosi(maxtab)
75 c 0.5. ==> initialisations
76 c ______________________________________________________________________
80 c en deboggage, on imprime quelle que soit la valeur de gmimp
81 c em mode standard, on n'imprime que si gmimp est superieur a 1
87 if ( gmimp.le.2 ) then
94 if ( gmimp.ge.iaux ) then
97 call gmdmp ( nomtyb(1), gmimp )
98 call gmdmp ( nomtyb(2), gmimp )
99 call gmdmp ( nomtyb(3), gmimp )
100 call gmdmp ( nomtyb(4), gmimp )
106 c 2. desallocation de tous les objets presents en memoire centrale
107 c il est plus rapide de commencer par tous les simples. Ainsi,
108 c quand on desallouera les structures, il n'y aura que des problemes
109 c de graphes a regler
112 c 2.1. ==> liberation des objets simples
114 #ifdef _DEBUG_HOMARD_
115 write(ulsort,*) 'Debut etape 2.1'
119 c 2.1.1. ==> les entiers
121 #ifdef _DEBUG_HOMARD_
122 write(ulsort,*) 'Debut etape 2.1.1 avec nbrobj = ',nballi
127 do 2111 , iaux = 1 , nbrobj
128 nomosi(iaux) = nomali(iaux)
131 do 2112 , iaux = nbrobj , 1 , -1
132 call gmdesa ( nomosi(iaux) )
135 c 2.1.2. ==> les reels
137 #ifdef _DEBUG_HOMARD_
138 write(ulsort,*) 'Debut etape 2.1.2 avec nbrobj = ',nballr
143 do 2121 , iaux = 1 , nbrobj
144 nomosi(iaux) = nomalr(iaux)
147 do 2122 , iaux = nbrobj , 1 , -1
148 call gmdesa ( nomosi(iaux) )
151 c 2.1.3. ==> les chaines
153 #ifdef _DEBUG_HOMARD_
154 write(ulsort,*) 'Debut etape 2.1.3 avec nbrobj = ',nballs
159 do 2131 , iaux = 1 , nbrobj
160 nomosi(iaux) = nomals(iaux)
163 do 2132 , iaux = nbrobj , 1 , -1
164 call gmdesa ( nomosi(iaux) )
169 #ifdef _DEBUG_HOMARD_
170 write(ulsort,*) 'Debut etape 2.1.6'
174 c 2.2. ==> les objets structures
175 c en fait il suffit de s'interesser aux tetes
176 c attention : la liberation d'un objet structure conduit au
177 c compactage des listes. Il faut donc boucler sur le
178 c nombre initial d'objets structures et s'interesser
179 c a la liste initiale. En effet la liste courante
182 #ifdef _DEBUG_HOMARD_
183 write(ulsort,*) 'Debut etape 2.2'
188 do 221 , iaux = 1 , nbrobj
189 nomost(iaux) = nomobj(iaux)
192 do 222 , iaux = nbrobj , 1 , -1
194 call gbdnoe (nomost(iaux),obrepc,obterc,chterc,codret)
196 if ( codret.ge.0 .and. nomost(iaux).ne.sindef ) then
198 call gbobal ( nomost(iaux) , letype , codret )
200 if ( codret.ne.0) then
201 call gmsgoj ( nomost(iaux) , codret )
202 if ( codret.ne.0) then
203 write(ulsort,20000) nomost(iaux), codret
209 write(ulsort,*) 'gmstop --> gbdnoe : codret = ',codret
215 20000 format(' GMSTOP pb a la suppression de l''objet ',a8,
216 > /,' Code retour de la suppression : ',i5)
218 #ifdef _DEBUG_HOMARD_
219 call gmdmp ( nomtyb(4), gmimp )
226 #ifdef _DEBUG_HOMARD_
227 write(ulsort,*) '3. statistiques gm'
231 call gmstat ( gmimp )
233 #ifdef _DEBUG_HOMARD_
234 write(ulsort,*) 'Fin de gmstop'