MINICERN/packlib/zebra/rz/rzkeep.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:24  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE RZKEEP(KEYU,ICYCLE,CHOPT)
  11 *
  12 ************************************************************************
  13 *
  14 *         To mark KEYU,ICYCLE to be kept in a PURGE operation
  15 * Input:
  16 *   KEYU    Keyword vector
  17 *   ICYCLE  Cycle number of the key
  18 *           ICYCLE > highest cycle number means the highest cycle
  19 *           ICYCLE = 0 means read the lowest cycle
  20 *   CHOPT =' '  Keep this cycle
  21 *         ='U'  Unkeep
  22 *
  23 * Called by USER
  24 *
  25 *  Author  : R.Brun DD/US/PD
  26 *  Written : 19.11.88
  27 *  Last mod: 08.12.88
  28 *          : 04.03.94 S.Banerjee (Change in cycle structure)
  29 *
  30 ************************************************************************
  31 #include "zebra/rzcl.inc"
  32 #include "zebra/rzcycle.inc"
  33       DIMENSION KEYU(*)
  34       CHARACTER*(*) CHOPT
  35 *
  36 *-----------------------------------------------------------------------
  37 *
  38 *           Check permission
  39 *
  40       IFLAG=1
  41       CALL RZMODS('RZKEEP',IFLAG)
  42       IF(IFLAG.NE.0)GO TO 99
  43 *
  44 *           Find KEY,CYCLE
  45 *
  46       CALL RZINK(KEYU,ICYCLE,' ')
  47 *
  48       IF(IQUEST(1).NE.0)GO TO 99
  49 *
  50       LCYC=IQUEST(15)
  51       IF(CHOPT(1:1).NE.'U')THEN
  52          CALL SBIT1(IQ(KQSP+LCDIR+LCYC+KFLCYC),5)
  53       ELSE
  54          CALL SBIT0(IQ(KQSP+LCDIR+LCYC+KFLCYC),5)
  55       ENDIF
  56 *
  57   99  RETURN
  58       END