MINICERN/packlib/zebra/rz/rzfrf1.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:51  mclareni
   6 * Extend the include file cleanup to dzebra, rz and tq, and also add
   7 * dependencies in some cases.
   8 *
   9 * Revision 1.1.1.1  1996/03/06 10:47:23  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZFRF1(LUNFZ,IOPTH)
  15 *
  16 ************************************************************************
  17 *
  18 *        Copy into current directory from  a sequential FZ file
  19 * Input:
  20 *   LUNFZ   Logical unit number of the FZ sequential access file
  21 *   IOPTH   1 read only the highest cycle from LUNFZ
  22 *           0 read all cycles
  23 *
  24 * Called by <RZFRFZ>
  25 *
  26 *  Author  : R.Brun DD/US/PD
  27 *  Written : 14.05.86
  28 *  Last mod: 08.12.92 JDS. Change chopt to char*3
  29 *          : 04.03.94 S.Banerjee (Change in cycle structure)
  30 *
  31 ************************************************************************
  32 #include "zebra/rzcl.inc"
  33 #include "zebra/rzk.inc"
  34 #include "zebra/rzckey.inc"
  35 #include "zebra/rzcycle.inc"
  36       CHARACTER*1 CHOPTA
  37       CHARACTER*3 CHOPT
  38 *
  39 *-----------------------------------------------------------------------
  40 *
  41 #include "zebra/q_jbit.inc"
  42 #include "zebra/q_jbyt.inc"
  43
  44 *
  45 *            Read next key
  46 *
  47   10  NH=KNSIZE
  48       CALL FZIN(LUNFZ,JQPDVS,LRZ0,-1,' ',NH,IHEAD)
  49       IF(IQUEST(1).NE.0)GO TO 99
  50       IF(NH.EQ.1.AND.IHEAD(1).EQ.77)GO TO 99
  51       IF(IOPTH.NE.0.AND.IHEAD(2).NE.1)GO TO 10
  52       LFROM=LQ(KQSP+LRZ0-1)
  53       IBIT4=JBIT(IHEAD(3),4)
  54       IFORM=JBYT(IHEAD(3),1,3)
  55       NWKEY=IQ(KQSP+LCDIR+KNWKEY)
  56       DO 20 I=1,NWKEY
  57          IKDES=(I-1)/10
  58          IKBIT1=3*I-30*IKDES-2
  59          IF(JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3).GE.3)THEN
  60             CALL ZITOH(KEY(I),KEY(I),1)
  61          ENDIF
  62   20  CONTINUE
  63 *
  64 *            Data structure
  65 *
  66       IF(IBIT4.NE.0)THEN
  67          CHOPTA='A'
  68       ELSE
  69          CHOPTA=' '
  70       ENDIF
  71       IF(IFORM.EQ.0)THEN
  72          CHOPT='LW'//CHOPTA
  73          CALL RZOUT(JQPDVS,LFROM,KEY,ICY,CHOPT)
  74       ELSE
  75 *
  76 *            Vector
  77 *
  78          CHOPT=CHOPTA
  79          IF(IFORM.EQ.1)CHOPT='B'//CHOPTA
  80          IF(IFORM.EQ.2)CHOPT='I'//CHOPTA
  81          IF(IFORM.EQ.5)CHOPT='H'//CHOPTA
  82          NDATA=IQ(KQSP+LFROM-1)
  83          LTEMP=LQ(KQSP+LFROM)
  84          IF(LTEMP.NE.0)THEN
  85             NTOT=0
  86             NEW=1
  87   55        IF(NTOT.LT.NDATA)THEN
  88                CALL RZLINC(IQ(KQSP+LFROM+1),NTOT,IQ(KQSP+LTEMP+1),NEW)
  89                NEW=NEW+1
  90                GO TO 55
  91             ENDIF
  92          ENDIF
  93          CALL RZVOUT(IQ(KQSP+LFROM+1),NDATA,KEY,ICY,CHOPT)
  94       ENDIF
  95       IF(IQUEST(1).NE.0)THEN
  96         CALL MZDROP(JQPDVS,LFROM,'L')
  97         GO TO 99
  98       ENDIF
  99       LC=IQ(KQSP+LCDIR+KLC)
 100       IQ(KQSP+LCDIR+LC+KFLCYC)=IHEAD(3)
 101       CALL MZDROP(JQPDVS,LFROM,'L')
 102       GO TO 10
 103 *
 104   99  RETURN
 105       END