MINICERN/packlib/zebra/mqg/mzgarb.F

   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"