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

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