MINICERN/packlib/zebra/rz/rzlind.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:26:59  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:25  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZLIND(IDATA,NTOT,INEW,NEW)
  15 *
  16 ************************************************************************
  17 *
  18 *        To convert packed vectors into a portable format.
  19 *        To extract integers from IDATA into bit pattern array INEW
  20 *        The original IDATA are modified into characters.
  21 *
  22 * Called by RZTOF1
  23 *
  24 *  Author  : R.Brun DD/US/PD
  25 *  Written : 08.09.89
  26 *  Last mod: 08.09.89
  27 *
  28 ************************************************************************
  29 *
  30       DIMENSION IDATA(*),INEW(*)
  31       CHARACTER*4 KWORD
  32 *
  33
  34 #include "zebra/q_jbit.inc"
  35 #include "zebra/q_jbyt.inc"
  36
  37       NTOLD=NTOT
  38       KWORD=' '
  39       IWORD=IDATA(NTOT+1)
  40       INEW(NEW)=IWORD
  41       IF(IWORD.EQ.0)THEN
  42           NTOT=NTOT+1
  43          GO TO 90
  44       ENDIF
  45 *
  46       IBIT31=JBIT(IWORD,31)
  47       IBIT32=JBIT(IWORD,32)
  48       IF(IBIT31.NE.0)THEN
  49          NWI=2
  50       ELSE
  51          NWI=1
  52       ENDIF
  53       KCODE=JBYT(IWORD,1,8)
  54       IF(IBIT32.NE.0)THEN
  55 *
  56 *  Comment cards
  57 *
  58          ICODE=KCODE
  59          ICADRE=MOD(ICODE,2)
  60 *
  61 *   Is there a frame ?
  62 *
  63          IF(ICADRE.NE.0)THEN
  64             NWI=NWI+1
  65             NEW=NEW+1
  66             INEW(NEW)=IDATA(NTOT+NWI)
  67             KWORD(1:1)=CHAR(JBYT(IDATA(NTOT+NWI),1,8))
  68             IPOS1=JBYT(IDATA(NTOT+NWI),25,8)
  69             IF(IPOS1.NE.0)THEN
  70                KWORD(2:2)=CHAR(JBYT(IDATA(NTOT+NWI),17,8))
  71             ENDIF
  72          ENDIF
  73 *
  74 *   Is there a character to repeat?
  75 *
  76          ICAR=JBYT(IWORD,9,8)
  77          IF(ICAR.EQ.0)THEN
  78 *
  79 *   No character to repeat.
  80 *
  81             IFWORD=JBYT(IWORD,17,7)
  82             ILASTW=JBYT(IWORD,24,7)
  83             IF(ILASTW.EQ.1) THEN
  84                NTOT=NTOT+NWI
  85                GO TO 90
  86             ENDIF
  87 *
  88             IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100
  89 *
  90             NTOT=NTOT+NWI+ILASTW-IFWORD+1
  91             GO TO 90
  92          ELSE
  93 *
  94 *   Character must be repeated.
  95 *
  96             KWORD(3:3)=CHAR(ICAR)
  97             IFIRST=JBYT(IWORD,17,7)
  98             ILAST =JBYT(IWORD,24,7)
  99 *
 100             IF (ILAST.GT.80 .OR. IFIRST.GT.ILAST)GO TO 100
 101 *
 102             NTOT =NTOT+NWI
 103             GO TO 90
 104          ENDIF
 105       ELSE
 106 *
 107 *  Other particular cases
 108 *
 109          ICODE = JBYT(IWORD,24,7)
 110          ICOD  = ICODE-114
 111 *
 112          IF(ICOD.LE.0)GO TO 40
 113          IF (ICOD.LT.6 .OR. ICOD.GT.11) THEN
 114             IF (ICOD.EQ.1 .OR. ICOD.EQ.3 .OR. ICOD.EQ.5) THEN
 115                 KWORD(1:1)=CHAR(KCODE)
 116                 KWORD(2:2)=CHAR(JBYT(IWORD,9,8))
 117             ENDIF
 118             NTOT=NTOT+NWI
 119             GO TO 90
 120          ENDIF
 121 *
 122          IF (ICOD .EQ. 6) THEN
 123             NTOT=NTOT+1
 124             GO TO 90
 125          ENDIF
 126 *
 127          ILASTW=JBYT(IWORD,17,7)
 128          NTOT=NTOT+ILASTW
 129          GO TO 90
 130       ENDIF
 131 *
 132    40 CONTINUE
 133 *
 134 *   Case of a normal line
 135 *
 136       KWORD(1:1)=CHAR(KCODE)
 137       ILASTW=ICODE
 138       IF(ILASTW.LT.2) THEN
 139          NTOT=NTOT+NWI
 140          GO TO 90
 141       ENDIF
 142       IFWORD=JBYT(IWORD,17,7)
 143 *
 144       IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100
 145 *
 146       NTOT=NTOT+NWI+ILASTW-IFWORD+1
 147 *
 148    90 CONTINUE
 149       CALL UCTOH(KWORD,IDATA(NTOLD+1),4,4)
 150       RETURN
 151 *
 152   100 NTOT=1000000
 153   999 END