      SUBROUTINE SBYTESB(JPAK,J,NBITS,IDIM)
C
C     * JUL 07/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)
C     * APR 15/92 - A.J. STACEY - REWRITTEN SBYTESB ROUTINE PACKS
C     *                           INTEGERS.
C     *
C     * PURPOSE: SBYTESB PACKS INTEGERS INTO EITHER 32- OR 64-BIT WORDS
C     *          SUCH THAT NO PACKED DATA ELEMENT SPANS EITHER A 32 OR 
C     *          64 BIT BOUNDARY. THIS ROUTINE IS COMPLETELY PORTABLE
C     *          BETWEEN 32 AND 64-BIT MACHINES.
C     * 
C     * NOTES:
C     * 1) IDIM IS THE NUMBER OF FLOATING POINT NUMBERS THAT
C     *    ARE BEING PACKED.  THE INTEGER EQUIVALENTS ARE BEING 
C     *    STORED IN J, WHICH CAN BE EITHER A 32-BIT OR 64-BIT INTEGER
C     *    ARRAY DEPENDING ON WHETHER THE NATIVE MACHINE IS A 32-BIT 
C     *    MACHINE OR A 64-BIT MACHINE.
C     * 2) NO CHECK ON INTEGERS IN J BEING VALID INTEGERS IN RANGE 
C     *    (0,2**NBITS-1)
C     * 3) IF THE NUMBER OF WORDS IN THE "J" ARRAY IS NOT DIVISIBLE
C     *    BY THE PACKING FACTOR, THEN THE LAST WORD OF THE "JPAK"
C     *    ARRAY CONTAINS PARTIAL DATA.
C     * 4) WE ADOPT THE CONVENTION THAT THE INPUT ARRAY "J" CONTAINS
C     *    SIGNIFICANT DATA ONLY IN THE LOW-ORDER 32 BITS OF EACH 64-BIT
C     *    FIELD.  ON 32-BIT MACHINES THIS MEANS THAT EACH EVEN ELEMENT
C     *    OF "J" CONTAINS THE DATA TO BE PACKED.
C
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      INTEGER J(1),JPAK(1)
      COMMON /MACHTYP/ MACHINE,INTSIZE
C-------------------------------------------------------------------------------
      NPACK32   = 32/NBITS
      MASK      = IBITS(-1,0,MIN(31,NBITS))
      IF (NPACK32 .LE. 0) THEN
         WRITE(6,6100)
 6100    FORMAT('0*** ERROR *** SBYTESB: NBITS > 32 IS ILLEGAL.')
         CALL ABORT
      END IF
      NPACK64          = 2*NPACK32
      IRMNDR           = MOD(IDIM,NPACK64)
      IF (IRMNDR .EQ. 0) THEN
          JPDIM        = IDIM/NPACK64
      ELSE
          JPDIM        = (IDIM/NPACK64) + 1
      END IF
      DO 100 K=1,JPDIM*MACHINE
        JPAK(K)        = 0
  100 CONTINUE
      LEN64          = ((IDIM/NPACK64) +
     1                 ((MOD(IDIM,NPACK64)+NPACK64-1)/NPACK64))
C
C     * THIS IS THE UNOPTIMIZED CODE.
C
C     JJ             = 1
C     II             = 1
C     DO 500 K=1,LEN64*MACHINE
C       DO 400 M=2/MACHINE-1,0,-1
C         DO 400 I=NPACK32-1,0,-1
C           IOFFSET  = M*32
C           JPAK(JJ) = IOR(
C    1                     JPAK(JJ),
C    2                     ISHFT(J(II*INTSIZE),I*NBITS+IOFFSET)
C    3                     )
C           II       = II + 1
C 400   CONTINUE
C       JJ           = JJ + 1
C 500 CONTINUE
C
C     * THIS IS THE OPTIMIZED CODE.
C
      II = 1
      INC = NPACK32*2/MACHINE
      IF (MACHINE .EQ. 1) THEN         ! 64-BIT MACHINE.
      DO 400 M=1,0,-1
        DO 400 I=NPACK32-1,0,-1
          IPT = I*NBITS + M*32
          KPT = II
          DO 500 K=1,LEN64
            JPAK(K) = IOR(
     1                     JPAK(K),
     2                     ISHFT(IAND(J(KPT),MASK),IPT)
     3                    )
            KPT     = KPT + INC
  500     CONTINUE
          II = II + 1
  400 CONTINUE
      ELSE IF (MACHINE .EQ. 2 ) THEN   ! 32-BIT MACHINE.
      LEN32 = LEN64*2
      INC2  = INC*INTSIZE
      DO 700 I=NPACK32-1,0,-1
          IPT = I*NBITS
          KPT = II*INTSIZE
          DO 800 K=1,LEN32
            JPAK(K) = IOR(
     1                     JPAK(K),
     2                     ISHFT(IAND(J(KPT),MASK),IPT)
     3                   )
            KPT     = KPT + INC2
  800     CONTINUE
          II = II + 1
  700 CONTINUE
      ELSE
         WRITE(6,6200)
 6200    FORMAT('0*** ERROR *** SBYTESB: ILLEGAL MACHINE TYPE.')
         CALL ABORT
      END IF
C
      RETURN
      END
