MINICERN/packlib/zebra/rz/rzsave.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:26  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE RZSAVE
  11 *
  12 ************************************************************************
  13 *
  14 *        Write all directories which have been modified in memory
  15 *        Write current output buffer
  16 *        Update list of used/unused records in top-directory
  17 *
  18 * Called by <USER>,RZCDIR,RZCOPY,RZEND,RZFILE,RZMAKE
  19 *
  20 *  Author  : R.Brun DD/US/PD
  21 *  Written : 02.04.86
  22 *  Last mod: 04.10.90
  23 *
  24 ************************************************************************
  25 #include "zebra/rzcl.inc"
  26 #include "zebra/rzclun.inc"
  27 #include "zebra/rzk.inc"
  28 *
  29 *-----------------------------------------------------------------------
  30 *
  31 #include "zebra/q_jbit.inc"
  32       IF(LQRS.EQ.0)GO TO 99
  33       IF(LTOP.EQ.0)GO TO 99
  34 *
  35 *           Mark used records in BITMAP
  36 *
  37       IF(JBIT(IQ(KQSP+LTOP),2).NE.0)THEN
  38          IF(ISAVE.NE.2)THEN
  39             IDTIME=0
  40             CALL RZDATE(IDTIME,IDATE,ITIME,2)
  41             IQ(KQSP+LTOP+KDATEM)=IDTIME
  42          ENDIF
  43          LUNC= IQ(KQSP+LTOP-5)
  44          LB  = IQ(KQSP+LTOP+KLB)
  45          LREK= IQ(KQSP+LTOP+LB+1)
  46          LUS = LQ(KQSP+LTOP-3)
  47          IF(LUS.NE.0)THEN
  48             NUSED=IQ(KQSP+LUS+1)
  49             IF(NUSED.GT.0)THEN
  50                DO 40 I=1,NUSED
  51                   IR1=IQ(KQSP+LUS+2*(I-1)+2)
  52                   IRL=IQ(KQSP+LUS+2*(I-1)+3)
  53                   DO 30 J=IR1,IRL
  54                      IWORD = (J-1)/32 + 1
  55                      IBIT  = J-32*(IWORD-1)
  56                      CALL SBIT1(IQ(KQSP+LTOP+LB+2+IWORD),IBIT)
  57   30              CONTINUE
  58   40           CONTINUE
  59                IQ(KQSP+LUS+1)=0
  60             ENDIF
  61          ENDIF
  62 *
  63 *           Mark purged records in BITMAP
  64 *
  65          LPU = LQ(KQSP+LTOP-5)
  66          IF(LPU.NE.0)THEN
  67             NPURG=IQ(KQSP+LPU+1)
  68             IF(NPURG.GT.0)THEN
  69                DO 60 I=1,NPURG
  70                   IR1=IQ(KQSP+LPU+2*(I-1)+2)
  71                   IRL=IQ(KQSP+LPU+2*(I-1)+3)
  72                   DO 50 J=IR1,IRL
  73                      IWORD = (J-1)/32 + 1
  74                      IBIT  = J-32*(IWORD-1)
  75                      CALL SBIT0(IQ(KQSP+LTOP+LB+2+IWORD),IBIT)
  76   50              CONTINUE
  77   60           CONTINUE
  78                IQ(KQSP+LPU+1)=0
  79             ENDIF
  80          ENDIF
  81 *
  82 *               Write current buffer
  83 *
  84          LROUT=LQ(KQSP+LTOP-6)
  85          IF(LROUT.NE.0)THEN
  86             IROUT=IQ(KQSP+LTOP+KIROUT)
  87             IF(IROUT.NE.0)THEN
  88                CALL RZIODO(LUNC,LREK,IROUT,IQ(KQSP+LROUT+1),2)
  89                IF(IQUEST(1).NE.0)GO TO 99
  90             ENDIF
  91          ENDIF
  92 *
  93 *               Write TOP directory
  94 *
  95          LDS =IQ(KQSP+LTOP+KLD)
  96          NRD =IQ(KQSP+LTOP+LDS)
  97          IF(ISAVE.NE.2)THEN
  98             IF(LTOP.EQ.LCDIR)IQ(KQSP+LTOP+KDATEM)=IDTIME
  99          ENDIF
 100          CALL SBIT0(IQ(KQSP+LTOP),2)
 101          DO 70 J=NRD,1,-1
 102             IREC=IQ(KQSP+LTOP+LDS+J)
 103             L=(J-1)*LREK+1
 104             CALL RZIODO(LUNC,LREK,IREC,IQ(KQSP+LTOP+L),2)
 105             IF(IQUEST(1).NE.0)THEN
 106                CALL SBIT1(IQ(KQSP+LTOP),2)
 107                GO TO 99
 108             ENDIF
 109   70     CONTINUE
 110 *
 111 *               Write current directory if modified
 112 *
 113          IF(LCDIR.EQ.0.OR.LTOP.EQ.LCDIR)GO TO 99
 114          IF(JBIT(IQ(KQSP+LCDIR),2).NE.0)THEN
 115             LDS =IQ(KQSP+LCDIR+KLD)
 116             NRD =IQ(KQSP+LCDIR+LDS)
 117             IF(ISAVE.NE.2)THEN
 118                IQ(KQSP+LCDIR+KDATEM)=IDTIME
 119             ENDIF
 120             CALL SBIT0(IQ(KQSP+LCDIR),2)
 121             DO 80 J=NRD,1,-1
 122                IREC=IQ(KQSP+LCDIR+LDS+J)
 123                L=(J-1)*LREK+1
 124                CALL RZIODO(LUNC,LREK,IREC,IQ(KQSP+LCDIR+L),2)
 125                IF(IQUEST(1).NE.0)THEN
 126                   CALL SBIT1(IQ(KQSP+LCDIR),2)
 127                   GO TO 99
 128                ENDIF
 129   80        CONTINUE
 130          ENDIF
 131       ENDIF
 132 *
 133   99  RETURN
 134       END