[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / mqg / mzgarb.F.ori

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/18 16:12:32  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:20  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE MZGARB (IXGP,IXWP)

C-    Garbage collection + wiping, user called

#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/zvfaut.inc"
#include "zebra/mqsys.inc"
#include "zebra/mzct.inc"
C--------------    End CDE                             --------------
      DIMENSION    IXGP(1), IXWP(9)
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HMZGA, 4HRB   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HMZGARB /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'MZGARB  ')
#endif


      IXGARB = IXGP(1)
      IXWIPE = IXWP(1)
#include "zebra/qtrace.inc"
#if defined(CERNLIB_QDEBUG)
      IF (IQVSTA.NE.0)       CALL ZVAUTX
      JVLEV = 2
#endif

C--                Construct Memory Occupation table

      MQDVGA = 0
      MQDVWI = 0
      IF (IXGARB.EQ.0)             GO TO 16
#if defined(CERNLIB_QDEBUG)
      JVLEV = 1
#endif

      MQDVGA = MZDVAC (IXGARB)
      IF (IXWIPE.EQ.0)             GO TO 19
      JSTO   = JQSTOR
      MQDVWI = MZDVAC (IXWIPE)
      IF (JSTO.NE.JQSTOR)          GO TO 91
      GO TO 19

   16 MQDVWI = MZDVAC (IXWIPE)
   19 IF (MQDVGA+MQDVWI.EQ.0)      GO TO 999

      NQRESV = 0
      JQSTMV = -1
#if defined(CERNLIB_QDEBPRI)
      IF (NQLOGL.LT.1)             GO TO 24
      IF (MQDVGA.NE.0)             GO TO 22
      IF (NQLOGL.LT.2)             GO TO 24
   22 WRITE (IQLOG,9022) JQSTOR,MQDVGA,MQDVWI
 9022 FORMAT (' MZGARB-  User Garb.C./Wipe for store',I3,', Divs',
#endif
#if !defined(CERNLIB_HEX)
     F2(2X,O8))
#endif
#if defined(CERNLIB_HEX)
     F2(2X,Z6))
#endif
#if defined(CERNLIB_QDEBUG)
      IQVREM(1,JVLEV) = IQVID(1)
      IQVREM(2,JVLEV) = IQVID(2)
#endif
   24 CALL MZTABM

C--                Construct Link Relocation table

      CALL MZTABR

C--                Relocate + memory move

      CALL MZTABX
      CALL MZTABF
      IF (NQNOOP.NE.0)             GO TO 999
      CALL MZGSTA (NQDGAU(KQT+1))
      CALL MZRELX
      CALL MZMOVE
      IF (IQPART.NE.0)             GO TO 24
#include "zebra/qtrace99.inc"
      RETURN

C------            Error conditions

   91 NQCASE = 1
      NQFATA = 2
      IQUEST(11) = JSTO
      IQUEST(12) = JQSTOR
#include "zebra/qtofatal.inc"
      END
*      ==================================================
#include "zebra/qcardl.inc"
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
	5	* Revision 1.2 1996/04/18 16:12:32 mclareni
	6	* Incorporate changes from J.Zoll for version 3.77
	7	*
	8	* Revision 1.1.1.1 1996/03/06 10:47:20 mclareni
	9	* Zebra
	10	*
	11	*
	12	#include "zebra/pilot.h"
	13	SUBROUTINE MZGARB (IXGP,IXWP)
	14
	15	C- Garbage collection + wiping, user called
	16
	17	#include "zebra/zstate.inc"
	18	#include "zebra/zunit.inc"
	19	#include "zebra/zvfaut.inc"
	20	#include "zebra/mqsys.inc"
	21	#include "zebra/mzct.inc"
	22	C-------------- End CDE --------------
	23	DIMENSION IXGP(1), IXWP(9)
	24	#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
	25	DIMENSION NAMESR(2)
	26	DATA NAMESR / 4HMZGA, 4HRB /
	27	#endif
	28	#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
	29	DATA NAMESR / 6HMZGARB /
	30	#endif
	31	#if !defined(CERNLIB_QTRHOLL)
	32	CHARACTER NAMESR*8
	33	PARAMETER (NAMESR = 'MZGARB ')
	34	#endif
	35
	36
	37	IXGARB = IXGP(1)
	38	IXWIPE = IXWP(1)
	39	#include "zebra/qtrace.inc"
	40	#if defined(CERNLIB_QDEBUG)
	41	IF (IQVSTA.NE.0) CALL ZVAUTX
	42	JVLEV = 2
	43	#endif
	44
	45	C-- Construct Memory Occupation table
	46
	47	MQDVGA = 0
	48	MQDVWI = 0
	49	IF (IXGARB.EQ.0) GO TO 16
	50	#if defined(CERNLIB_QDEBUG)
	51	JVLEV = 1
	52	#endif
	53
	54	MQDVGA = MZDVAC (IXGARB)
	55	IF (IXWIPE.EQ.0) GO TO 19
	56	JSTO = JQSTOR
	57	MQDVWI = MZDVAC (IXWIPE)
	58	IF (JSTO.NE.JQSTOR) GO TO 91
	59	GO TO 19
	60
	61	16 MQDVWI = MZDVAC (IXWIPE)
	62	19 IF (MQDVGA+MQDVWI.EQ.0) GO TO 999
	63
	64	NQRESV = 0
65	JQSTMV = -1
66	#if defined(CERNLIB_QDEBPRI)
67	IF (NQLOGL.LT.1) GO TO 24
68	IF (MQDVGA.NE.0) GO TO 22
69	IF (NQLOGL.LT.2) GO TO 24
70	22 WRITE (IQLOG,9022) JQSTOR,MQDVGA,MQDVWI
71	9022 FORMAT (' MZGARB- User Garb.C./Wipe for store',I3,', Divs',
72	#endif
73	#if !defined(CERNLIB_HEX)
74	F2(2X,O8))
75	#endif
76	#if defined(CERNLIB_HEX)
77	F2(2X,Z6))
78	#endif
79	#if defined(CERNLIB_QDEBUG)
80	IQVREM(1,JVLEV) = IQVID(1)
81	IQVREM(2,JVLEV) = IQVID(2)
82	#endif
83	24 CALL MZTABM
84
85	C-- Construct Link Relocation table
86
87	CALL MZTABR
88
89	C-- Relocate + memory move
90
91	CALL MZTABX
92	CALL MZTABF
93	IF (NQNOOP.NE.0) GO TO 999
94	CALL MZGSTA (NQDGAU(KQT+1))
95	CALL MZRELX
96	CALL MZMOVE
97	IF (IQPART.NE.0) GO TO 24
98	#include "zebra/qtrace99.inc"
99	RETURN
100
101	C------ Error conditions
102
103	91 NQCASE = 1
104	NQFATA = 2
105	IQUEST(11) = JSTO
106	IQUEST(12) = JQSTOR
107	#include "zebra/qtofatal.inc"
108	END
109	* ==================================================
110	#include "zebra/qcardl.inc"