MINICERN/packlib/zebra/rz/rzlinc.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 RZLINC(IDATA,NTOT,INEW,NEW)
  15 *
  16 ************************************************************************
  17 *
  18 *        To convert portable packed vectors into a local format.
  19 *        Merges the IDATA and INEW modified by RZLIND into IDATA
  20 *
  21 * Called by RZFRF1
  22 *
  23 *  Author  : R.Brun DD/US/PD
  24 *  Written : 08.09.89
  25 *  Last mod: 08.09.89
  26 *
  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       IWORD=INEW(NEW)
  39       CALL UHTOC(IDATA(NTOT+1),4,KWORD,4)
  40       IDATA(NTOT+1)=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 lines
  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             IDATA(NTOT+NWI)=INEW(NEW)
  67             IK1=ICHAR(KWORD(1:1))
  68             CALL SBYT(IK1,IDATA(NTOT+NWI),1,8)
  69             IPOS1=JBYT(IDATA(NTOT+NWI),25,8)
  70             IF(IPOS1.NE.0)THEN
  71                IK2=ICHAR(KWORD(2:2))
  72                CALL SBYT(IK2,IDATA(NTOT+NWI),17,8)
  73             ENDIF
  74          ENDIF
  75 *
  76 *   Is there a character to repeat?
  77 *
  78          ICAR=JBYT(IWORD,9,8)
  79          IF(ICAR.EQ.0)THEN
  80 *
  81 *   No character to repeat.
  82 *
  83             IFWORD=JBYT(IWORD,17,7)
  84             ILASTW=JBYT(IWORD,24,7)
  85             IF(ILASTW.EQ.1) THEN
  86                NTOT=NTOT+NWI
  87                GO TO 90
  88             ENDIF
  89 *
  90             IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100
  91 *
  92             NTOT=NTOT+NWI+ILASTW-IFWORD+1
  93             GO TO 90
  94          ELSE
  95 *
  96 *   Character must be repeated.
  97 *
  98             IK3=ICHAR(KWORD(3:3))
  99             CALL SBYT(IK3,IDATA(NTOT+1),9,8)
 100             NTOT =NTOT+NWI
 101             GO TO 90
 102          ENDIF
 103       ELSE
 104 *
 105 *  Other particular cases
 106 *
 107          ICODE = JBYT(IWORD,24,7)
 108          ICOD  = ICODE-114
 109 *
 110          IF(ICOD.LE.0)GO TO 40
 111          IF (ICOD.LT.6 .OR. ICOD.GT.11) THEN
 112             IF (ICOD.EQ.1 .OR. ICOD.EQ.3 .OR. ICOD.EQ.5) THEN
 113                 KCODE=ICHAR(KWORD(1:1))
 114                 IK2=ICHAR(KWORD(2:2))
 115                 CALL SBYT(KCODE,IDATA(NTOT+1),1,8)
 116                 CALL SBYT(IK2,IDATA(NTOT+1),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 *   Normal instruction case
 135 *
 136       KCODE=ICHAR(KWORD(1:1))
 137       CALL SBYT(KCODE,IDATA(NTOLD+1),1,8)
 138       ILASTW=ICODE
 139       IF(ILASTW.LT.2) THEN
 140          NTOT=NTOT+NWI
 141          GO TO 90
 142       ENDIF
 143       IFWORD=JBYT(IWORD,17,7)
 144 *
 145       IF (ILASTW.GT.20 .OR. IFWORD.GT.ILASTW)GO TO 100
 146 *
 147       NTOT=NTOT+NWI+ILASTW-IFWORD+1
 148 *
 149    90 CONTINUE
 150       RETURN
 151 *
 152   100 NTOT=1000000
 153   999 END