MINICERN/packlib/zebra/mq/mzdred.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:19  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE MZDRED (IXDIVP)
  11
  12 C-    Reduce space reserved for division to initial size,
  13 C-    but not smaller than current occupation
  14
  15 #include "zebra/zstate.inc"
  16 #include "zebra/zunit.inc"
  17 #include "zebra/zvfaut.inc"
  18 #include "zebra/mqsys.inc"
  19 #include "zebra/mzct.inc"
  20 C--------------    End CDE                             --------------
  21       DIMENSION    IXDIVP(9)
  22 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  23       DIMENSION    NAMESR(2)
  24       DATA  NAMESR / 4HMZDR, 4HED   /
  25 #endif
  26 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  27       DATA  NAMESR / 6HMZDRED /
  28 #endif
  29 #if !defined(CERNLIB_QTRHOLL)
  30       CHARACTER    NAMESR*8
  31       PARAMETER   (NAMESR = 'MZDRED  ')
  32 #endif
  33
  34
  35 #include "zebra/qtrace.inc"
  36
  37       CALL MZSDIV (IXDIVP,4)
  38       IF (JQDIVI.LT.3)             GO TO 999
  39       CALL MZRESV
  40
  41 #if defined(CERNLIB_QDEBPRI)
  42       IF (NQLOGL.GE.1)  WRITE (IQLOG,9028) JQSTOR,JQDIVI,NQRESV
  43  9028 FORMAT (' MZDRED-  called for Store/Div',2I3,' Free',I7)
  44 #endif
  45 #if defined(CERNLIB_QDEVZE)
  46       IF (NQDEVZ.NE.0)  WRITE (IQLOG,9829) JQDIVI,JQSHAR,NQRESV
  47  9829 FORMAT (1X/' DEVZE MZDRED entered,  JQDIVI,JQSHAR,NQRESV= ',3I8)
  48 #endif
  49 #if defined(CERNLIB_QDEBUG)
  50       IF (IQVSTA.NE.0)       CALL ZVAUTX
  51 #endif
  52 C----              Construct Memory Occupation table
  53
  54       MQDVGA = 0
  55       MQDVWI = 0
  56       JQSTMV = -1
  57       CALL MZTABM
  58
  59 C----              Shift divisions
  60
  61       IF (JQSHAR.NE.0)  THEN
  62           NFREE = MIN (NQRESV,
  63      +                 LQEND(KQT+JQSHR2)-LQSTA(KQT+JQSHR1)
  64      +                 - (NQDINI(KQT+JQDIVI)+NQDINI(KQT+JQDIVN)) )
  65         ELSE
  66           NFREE = NQRESV - MAX (0, NQDINI(KQT+JQDIVI) -
  67      +                   (LQEND(KQT+JQDIVI)-LQSTA(KQT+JQDIVI)) )
  68         ENDIF
  69
  70       IF (NFREE.LE.24)             GO TO 999
  71
  72 C--                Forward division
  73
  74       IF (JQMODE.EQ.0)  THEN
  75           JQDVM2 = JQDIVI
  76         ELSE
  77
  78 C--                Reverse division
  79
  80           JQDVM2 = JQDIVN
  81         ENDIF
  82
  83       JQDVM1 = 2
  84       JQSTMV = JQSTOR
  85       NQDVMV = NFREE
  86
  87 #if defined(CERNLIB_QDEVZE)
  88       IF (NQDEVZ.NE.0)  WRITE (IQLOG,9836) JQDVM1,JQDVM2,NQDVMV
  89  9836 FORMAT (' DEVZE MZDRED,  JQDVM1,JQDVM2,NQDVMV=    ',3I8)
  90 #endif
  91 C--                Construct Link Relocation table
  92
  93       CALL MZTABR
  94       CALL MZTABS
  95
  96 C----              Relocate + memory move
  97
  98       CALL MZTABX
  99       CALL MZTABF
 100       CALL MZRELX
 101       CALL MZMOVE
 102       NQDRED(KQT+JQDIVI) = NQDRED(KQT+JQDIVI) + 1
 103 #include "zebra/qtrace99.inc"
 104       RETURN
 105       END
 106 *      ==================================================
 107 #include "zebra/qcardl.inc"