This commit was generated by cvs2svn to compensate for changes in r2,

[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / fq / fzoapk.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/18 16:10:44  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:14  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
#if defined(CERNLIB_FZALFA)
      SUBROUTINE FZOAPK (LBUFCP,LBUFEP)

C-    Unpack the set of words LQ(LBUFC) to LQ(LBUFE-1) at most
C-    into LQ(LUPKA) to LQ(LUPKE-1) at most;
C-    service routine to FZOASC.

C-    Return LUPKE the adr of the first word after the unpack vector.
C-    For each word unpacked recognise the type and store 8 numbers:
C-
C-           normal number          repetition N+1 times
C-         L + 0  type            L + 0  -43 to signal repeat
C-           + 1  sub-type          + 1  N for N+2 numbers in all
C-           + 2  bits 26-30
C-           + 3  bits 21-25
C-           ...
C-           + 7  bits  1- 5

#include "zebra/zstate.inc"
#include "zebra/mqsysh.inc"
C--------------    End CDE                             --------------
      DIMENSION    LBUFCP(9), LBUFEP(9)

      EQUIVALENCE (LUPKA,IQUEST(93)), (LUPKE, IQUEST(94))


#include "zebra/q_jbyt.inc"


      LBUFC = LBUFCP(1)
      LBUFE = LBUFEP(1)
      LUPK  = LUPKA
      LUPKE = LUPKE - 10
#if defined(CERNLIB_QDEVZE)
      IF (NQDEVZ.NE.0)  CALL VZERO (LQ(LUPK),LUPKE+8-LUPK)
#endif

   11 IWORD = LQ(LBUFC)
      LBUFC = LBUFC + 1
      JTYPS = 0
      M31   = JBYT (IWORD,31,2)

C--                Short cut if integer 0->9

      IF (M31.NE.0)                GO TO 14
      IF (IWORD.GE.10)             GO TO 14
          JTYPE = 0
          JTYPS = IWORD + 26
          LQ(LUPK+7) = IWORD
          GO TO 38
   14 CONTINUE

C--                Unpack all bytes

      LQ(LUPK+2) = JBYT (IWORD,26,5)
      LQ(LUPK+3) = JBYT (IWORD,21,5)
      LQ(LUPK+4) = JBYT (IWORD,16,5)
      LQ(LUPK+5) = JBYT (IWORD,11,5)
      LQ(LUPK+6) = JBYT (IWORD, 6,5)
      LQ(LUPK+7) = JBYT (IWORD, 1,5)

C--                Type : small +ve integer

      IF (M31.NE.0)                GO TO 21
      IF (LQ(LUPK+2).NE.0)         GO TO 31
      JTYPE = 5
      DO 16  J=3,6
      IF (LQ(LUPK+J).NE.0)         GO TO 38
   16 JTYPS = JTYPS + 1
      GO TO 38

C--                Type : small negative integer

   21 IF (M31.NE.3)                GO TO 31
      IF (LQ(LUPK+2).NE.31)        GO TO 31
      JTYPE = 6
      DO 24  J=3,6
      IF (LQ(LUPK+J).NE.31)        GO TO 38
   24 JTYPS = JTYPS + 1
      GO TO 38

C--                Type : normal words, check short mantissa

   31 JTYPE = M31 + 1
      DO 36  J=7,4,-1
      IF (LQ(LUPK+J).NE.0)         GO TO 38
   36 JTYPS = JTYPS + 1

C--                Store Main type and sub-type, check repeat

   38 LQ(LUPK)   = JTYPE
      LQ(LUPK+1) = JTYPS
      LUPK = LUPK + 8
      IF (LBUFC.EQ.LBUFE)          GO TO 49
      IF (LQ(LBUFC).EQ.IWORD)      GO TO 61
   39 IF (LUPK.LT.LUPKE)           GO TO 11

   49 LQ(LUPK) = -1
      LUPKE = LUPK
      RETURN

C----              Check set of identical words

   61 NL = LBUFE - LBUFC - 1
      NC = 0
      DO 63  J=1,NL
      IF (LQ(LBUFC+J).NE.IWORD)    GO TO 64
   63 NC = NC + 1

   64 IF     (NC.LT.2)  THEN
          IF (JTYPE.EQ.0)          GO TO 39
        ENDIF
      LQ(LUPK)   = -43
      LQ(LUPK+1) = NC
      LUPKE = LUPK + 2
      RETURN
      END
*      ==================================================
#include "zebra/qcardl.inc"
#endif