      SUBROUTINE GSBITE_MF(KS,KD,KSKST,KSIZE,KSKBTW,K,KBPW,KMASK,YADIR)
C
C     GSBITE: VECTORISING EXTRACTION/INSERTION OF BITS FROM/TO BITSTREAM
C
C INPUT:
C     KS:     IF YADIR='D', INPUT BIT STREAM, ELSE OUTPUT BIT STREAM
C     KD:     IF YADIR='D', OUTPUT WORDS, ELSE INPUT WORDS
C     KSKST:  NUMBER OF BITS SKIPPED AT BEGINNING OF KS
C     KSIZE:  NUMBER OF BITS TO BE EXTRACTED TO ONE WORD OF KD
C     KSKBTW: NUMBER OF BITS SKIPPED BETWEEN TWO WORDS TO BE EXTRACTED
C     K:      NUMBER OF WORDS TO BE EXTRACTED INTO KD (IF .LE.0, ONLY
C             CALCULATE KBPW AND KMASK
C     KBPW:   NUMBER OF BITS PER WORD IN KS, CALCULATED IF 0
C     KMASK:  MASKS FOR BIT PATTERNS, CALCULATED IF KMASK(2).EQ.0
C     YADIR:  DIRECTION OF CONVERSION: 'D' FOR DECODING, I.E.
C             EXTRACT WORDS KD(1...K)  FROM BITS KS(KSKST+1....)
C             IF NOT 'D', ENCODE, I.E. PACK WORDS KD(1....K) INTO BITS
C             KS(KSKST+1.....KSKST+K*(KSIZE+KSKBTW))
C
C OUTPUT:
C     KS,KD:  SEE ABOVE
C     KSKST:  UPDATED TO NR OF BITS USED, I.E. TO KSKST+K*(KSIZE+KSKBTW)
C     KBPW:   (IF 0 ON INPUT): NUMBER OF BITS IN EACH WORD OF KS
C     KMASK:  (IF (KMASK(2) WAS 0 ON INPUT): BIT PATTERN MASKS
C
C                                                     G.J.CATS 08 DEC 87
C
#include "precision.h"
      INTEGER (KIND=JPDBLE) KS(*) , KD(*) , KMASK(*)
      INTEGER (KIND=JPDBLE) IS , ISHFT, ISH, IMASK
      CHARACTER*1 YADIR
C
C     STATEMENT FUNCTIONS TO MANIPULATE BITS IN WORDS OF 64 BITS
C
C     DATA ONES/7777777777777777B/
C     DATA OOOS/0B/
C
C     1.  SINGLE BIT MANIPULATIONS
C
C     1.1 SET BIT KBIT IN WORD PW
C
CCRAY  IBSET(KW,KBIT)=OR(KW,SHIFT(1B,KBIT))
C
C     2.  WORD MANIPULATIONS, BIT BY BIT
C
C     2.1 ARE WORDS PW1 AND PW2 EQUAL?
C
C      LOGICAL NLEQAL
C     NLEQAL(PW1,PW2)=(PW1.XOR.PW2).EQ.0B
C
C     2.2 BITWISE AND AND OR
C
CCRAY  IAND(K1,K2)=AND(K1,K2)
CCRAY  IOR (K1,K2)= OR(K1,K2)
C
C     2.3 BITWISE NEGATION
C
CCRAY  NOT(K)=COMPL(K)
C
C     2.4 SHIFT (LEFT FOR KSH POSITIVE, RIGHT FOR KSH NEGATIVE)
C
CCRAY  ISHFT(K,KSH)=CVMGP(SHIFTL(K,KSH),SHIFTR(K,-KSH),KSH)
C
C     3.  SPECIAL PURPOSE
C
C     3.1 TAKE 4 LAST BITS OF KW, PUT THEM IN PW AT POS K*4-1
C
C     SETLEV(PW,KW,K)=OR(AND(PW,SHIFT(0B.EQV.17B,K*4-4)),
C    +SHIFT(AND(17B,KW),K*4-4))
C
C     3.2 EXTRACT FIELD [K*4-1:4] FROM PW
C
C     MGTLEV(PW,K)=AND(17B,SHIFT(PW,68-K*4))
C
C     1.  COMPLETE KBPW AND KMASK, RETURN IF 0 WORDS ARE TO BE EXTRACTED
C
      IF(KBPW.EQ.0)THEN
         IS=KS(1)
         KS(1)=1
 1101    CONTINUE
         IF(KS(1).NE.0)THEN
            KBPW=KBPW+1
            KS(1)=ISHFT(KS(1),1)
            GOTO 1101
         ENDIF
         KS(1)=IS
      ENDIF
      IF(KMASK(2).EQ.0)THEN
         KMASK(KBPW+1)=0
         DO 1110 J=KBPW,1,-1
         KMASK(J)=IBSET(KMASK(J+1),KBPW-J)
 1110    CONTINUE
      ENDIF
      IF(K.LE.0)RETURN
C
C     2.  PRESET KD TO 0 IF KD IS OUTPUT I.E. WHEN DECODING
C
      IF(YADIR.EQ.'D')THEN
         DO 2101 J=1,K
         KD(J)=0
 2101    CONTINUE
      ENDIF
C
C     3.  CALCULATE SEVERAL PARAMETERS FOR LOOPING (FOR EFFICIENCY, THE
C         CODE OF SECTIONS 3.3 AND 3.4 FOR K=1 IS SEPARATED INTO 3.2)
C
C     3.1 NUMBER OF BITS USED PER WORD, INITIAL NR OF SKIPPED BITS
C
      ISTEP=KSIZE+KSKBTW
      ISKWS=KSKST
C
C     3.2 VECTOR LOOP LENGTH AND STEP SIZE IN KD IF K=1;KS STEP IRRELVNT
C
      IF(K.EQ.1)THEN
         ILL=1
         IBDL=2
         ISTD=1
      ELSE
C
C     3.3 STEP SIZES IN KS,KD: INVERSE OF LARGEST FACTOR OF ISTEP,KBPW
C
         ILCF=KBPW
         ISHF=ISTEP
 331     CONTINUE
         IF(ILCF.EQ.ISHF)GOTO 332
         IF(ILCF.EQ.1)GOTO 332
         IF(ILCF.GT.ISHF)THEN
            ILCF=ILCF-ISHF
         ELSE
            ISHF=ISHF-ILCF
         ENDIF
         GOTO 331
 332     CONTINUE
         ISTD=KBPW/ILCF
         ISTS=ISTEP/ILCF
C
C     3.4 VECTOR LOOP LENGTH AND SWITCH-OVER POINT FOR SMALLER LOOP
C
         ILL=(K-1)/ISTD+1
         IBDL=K-(ILL-1)*ISTD
      ENDIF
C
C     3.5 SWAP BYTES ON VAX WHEN DECODING
C
C
C     4.  LOOP OVER FIRST ISTD WORDS OF KD (TRAILS THE VECTOR LOOP)
C
      DO 790 JBD=1,ISTD
C
C     4.1 LAST BIT IN KS TO BE TREATED
C
      IENBS=ISKWS+KSIZE
C
C     4.2 NR OF WORDS OF KS TO BE SKIPPED, NR OF BITS IN THOSE AND THIS
C
      ISKW=ISKWS/KBPW
      ISTA=ISKW*KBPW
      ISKB=ISKWS-ISTA
C
C     4.3 MASK AND LEFT SHIFT FOR THE REMAINING BITS
C
      IMASK=KMASK(ISKB+1)
      ISH=KSIZE+ISKB
C
C     4.4 POSITION OF CURRENT WORD OF KS
C
      IBS=ISKW+1
C
C     5.  LOOP OVER WORDS OF KS CONTRIBUTING TO ONE WORD OF KD
C
 500  CONTINUE
C
C     5.1 UPDATE SHIFT AND LAST BIT IN CURRENT WORD
C
      ISH=ISH-KBPW
      IEND=ISTA+KBPW
C
C     5.2 IS LAST BIT OF CURRENT WORD OUTSIDE RANGE TO BE EXTRACTED
C
      IF(IEND.GT.IENBS)THEN
         ISH=IENBS-IEND
         IMASK=IAND(IMASK,NOT(KMASK(KBPW+ISH+1)))
      ENDIF
C
C     5.3 INITIAL OFFSETS FOR VECTOR ELEMENTS IN VECTOR LOOP
C
      IOS=0
      IOD=0
C
C     6.  VECTOR LOOP IS OVER REPEATEDLY OCCURRING BITPATTERNS/MASKS
C
      IF(YADIR.EQ.'D')THEN
CDIR$ IVDEP
         DO 611 JI=1,ILL
         KD(JBD+IOD)=IOR(KD(JBD+IOD),ISHFT(IAND(IMASK,KS(IBS+IOS)),ISH))
         IOD=IOD+ISTD
         IOS=IOS+ISTS
 611     CONTINUE
      ELSE
CDIR$ IVDEP
         DO 612 JI=1,ILL
         KS(IBS+IOS)=IOR(
     +   IAND(      KS(IBS+IOS),      NOT(IMASK)),
     +   IAND(ISHFT(KD(JBD+IOD),-ISH),    IMASK ))
         IOD=IOD+ISTD
         IOS=IOS+ISTS
 612     CONTINUE
      ENDIF
C
C     7.  END LOOPS
C
C     7.1 PREPARE FOR END OF LOOP OVER WORDS OF KS WITIHN ONE KD WORD
C
      ISTA=ISTA+KBPW
C
C     7.2 NEXT WORD OF KD IF EXTRACTION NOT COMPLETED
C
      IF(ISTA.LT.IENBS)THEN
         IMASK=KMASK(1)
         IBS=IBS+1
         GOTO 500
      ENDIF
C
C     7.8 PREPARE FOR END OF LOOP OVER FIRST WORDS OF KD
C
      IF(JBD.EQ.IBDL)ILL=ILL-1
      ISKWS=ISKWS+ISTEP
C
C     7.9 END LOOP OVER FIRST WORDS OF KD
C
 790  CONTINUE
C
C     8.  FINISHED: UPDATE KSKST AND RETURN
C
      KSKST=KSKST+K*ISTEP
C
C     8.5 SWAP BYTES ON VAX
C
      RETURN
      END
