      SUBROUTINE W3FI32(LARRAY,KIDNT)
C$$$  SUBPROGRAM DOCUMENTATION BLOCK
C                .      .    .                                       .
C SUBPROGRAM:    W3FI32      PACK ID'S INTO OFFICE NOTE 84 FORMAT
C   PRGMMR: NIEROW, A.       ORG: W345       DATE: 86-02-07
C
C ABSTRACT: CONVERTS AN ARRAY OF THE 27 DATA FIELD IDENTIFIERS INTO
C   AN ARRAY OF THE FIRST 8 IDENTIFICATION WORDS OF THE FORMAT DE-
C   SCRIBED IN NMC OFFICE NOTE 84 (89-06-15, PAGE-35). ON A CRAY
C   THEY WILL FIT INTO FOUR 64 BIT INTEGER WORDS.
C
C PROGRAM HISTORY LOG:
C   86-02-07  A.NIEROW
C   89-10-24  R.E.JONES   CONVERT TO CRAY CFT77 FORTRAN
C   91-03-19  R.E.JONES   CHANGES FOR BIG RECORDS
C   98-03-10  B. VUONG    REMOVE THE CDIR$ INTEGER=64 DIRECTIVE
C 1999-03-15  Gilbert     Specified 8-byte integer array explicitly
C
C USAGE:    CALL W3FI32(LARRAY, KIDNT)
C   INPUT ARGUMENT LIST:
C     LARRAY   - INTEGER ARRAY CONTAINING 27 DATA FIELD
C                IDENTIFIERS (SEE O.N. 84)
C
C   OUTPUT ARGUMENT LIST:
C     KIDNT    - INTEGER ARRAY OF 6 WORDS, 12 OFFICE NOTE 84 32 BIT
C                WORDS, FIRST 4 WORDS ARE MADE BY W3FI32, IF YOU ARE
C                USING PACKER W3AI00, IT WILL COMPUTE WORD 5 AND 6.
C                (OFFICE NOTE 84 WORDS 9,10, 11 AND 12). IF J THE
C                WORD COUNT IN WORD 27 OF LARRAY IS GREATER THAN
C                32743 THEN BITS 15-0 OF THE 4TH ID WORD ARE SET TO
C                ZERO, J IS STORED IN BITS 31-0 OF THE 6TH ID WORD.
C                ID WORD 5 IS SET ZERO, BIT 63-32 OF THE 6TH ID
C                WORD ARE SET ZERO. NOTE: BIS ARE NUMBER LEFT TO
C                RIGHT ON THE CRAY AS 63-0.
C
C   OUTPUT FILES:
C     UNIT6    - STANDARD FORTRAN PRINT FILE
C
C   SUBPROGRAMS CALLED:
C     LIBRARY:
C       BIT MANIPULATION - IAND, IOR ISHFT
C
C   REMARKS: EXIT STATES PRINTED MESSAGES:
C     IF ANY NUMBER N IN (LARRAY(I),I=1,27) IS ERRONEOUSLY LARGE:
C       'VALUE IN LARRAY(I)=N IS TOO LARGE TO PACK'
C     IF ANY NUMBER N IN (LARRAY(I),I=1,27) IS ERRONEOUSLY NEGATIVE:
C       'VALUE IN LARRAY(I)=N SHOULD NOT BE NEGATIVE'
C     IN EITHER OF THE ABOVE SITUATIONS, THAT PORTION OF THE PACKED
C     WORD CORRESPONDING TO LARRAY(I) WILL BE SET TO BINARY ONES.
C
C ATTRIBUTES:
C   LANGUAGE: CRAY CFT77 FORTRAN    INTEGER=64
C   MACHINE:  CRAY Y-MP8/864
C
C$$$
C
       INTEGER(8)        LARRAY(27)
       INTEGER(8)        ITABLE(27)
       INTEGER(8)        KIDNT(*)
       INTEGER(8)        KX,MASK,MASK16,ISC,ITEMP8
C
       SAVE
C
       DATA  ITABLE/X'0000000000340C01',X'0000000000280C01',
     &              X'0000000000200801',X'00000000001C0401',
     &              X'0000000001081401',X'0000000001000801',
     &              X'00000000003C0402',X'0000000000340802',
     &              X'0000000000280C02',X'0000000000200802',
     &              X'00000000001C0402',X'0000000001081402',
     &              X'0000000001000802',X'0000000000380803',
     &              X'0000000000300803',X'0000000000280803',
     &              X'0000000000200803',X'00000000001C0403',
     &              X'0000000000100C03',X'0000000000001003',
     &              X'0000000000380804',X'0000000000300804',
     &              X'0000000000280804',X'0000000000200804',
     &              X'0000000000180804',X'0000000000100804',
     &              X'0000000000001004'/
       DATA  KX    /X'00000000FFFFFFFF'/
       DATA  MASK  /X'00000000000000FF'/
       DATA  MASK16/X'FFFFFFFFFFFF0000'/
C
C     MAKE KIDNT = 0
C
      DO 10 I = 1,4
        KIDNT(I) = 0
 10   CONTINUE
C
      ISIGN = 0
C
      DO 90 I = 1,27
        ISC = ITABLE(I)
        I1  = IAND(ISC,MASK)
        I2  = IAND(ISHFT(ISC,-8_8), MASK)
        I3  = IAND(ISHFT(ISC,-16_8),MASK)
        I4  = IAND(ISHFT(ISC,-24_8),MASK)
C
C     SIGN TEST
C
       IV = LARRAY(I)
       IF (IV.GE.0) GO TO 50
       IF (I4.NE.0) GO TO 30
       WRITE (6,20) I, IV
 20    FORMAT(/,1X,' W3FI32 - VALUE IN LARRAY(',I2,') =',I11,
     & ' SHOULD NOT BE NEGATIVE',/)
       GO TO 70
C
 30   CONTINUE
        IV    = IABS(IV)
        MSIGN = 1
        ISIGN = MSIGN
        K     = I2 / 4
C
      DO 40 M = 1,K
        ISIGN = ISHFT(ISIGN,4)
 40   CONTINUE
C
        ISIGN = ISHFT(ISIGN,-1)
        IV    = IOR(IV,ISIGN)
C
 50   CONTINUE
C
C     MAG TEST
C
        IF (ISHFT(IV,-I2).EQ.0) GO TO 80
        IF (LARRAY(27).GT.32743) GO TO 70
        PRINT 60, I , IV
 60     FORMAT(/,1X,' W3FI32 - VALUE IN LARRAY(',I2,') =',I11,
     &  ' IS TOO LARGE TO PACK',/)
C
 70   CONTINUE
        IV = KX
        IA = 32 - I2
        IV = ISHFT(IV,-IA)
C
C     SHIFT
C
 80   CONTINUE
        ITEMP=ISHFT(IV,I3)
        ITEMP8=ITEMP
        KIDNT(I1) = IOR(KIDNT(I1),ITEMP8)
C
 90   CONTINUE
C
C     TEST FOR BIG RECORDS, STORE J THE WORD COUNT IN THE 6TH
C     ID WORD IF GREATER THAN 32743.
C
      IF (LARRAY(27).EQ.0) THEN
        PRINT *,' W3FI32 - ERROR, WORD COUNT J = 0'
      ELSE IF (LARRAY(27).GT.32743) THEN
        KIDNT(4) = IAND(KIDNT(4),MASK16)
        KIDNT(5) = 0
        KIDNT(6) = LARRAY(27)
      END IF
C
      RETURN
      END
