SUBROUTINE APRNTI(A, NITEMS, IOUT, MCOL, W)
C
C  THIS SUBROUTINE PRINTS OUT NITEMS FROM THE INTEGER ARRAY, A, ON
C  OUTPUT UNIT IOUT, USING A MAXIMUM OF MCOL PRINT SPACES.
C  THE OUTPUT FORMAT IS IW.
C  THE PROGRAM PUTS AS MANY VALUES ON A LINE AS POSSIBLE.
C  W SHOULD BE INPUT AS THE ACTUAL WIDTH +1 FOR A SPACE BETWEEN VALUES.
C
C  DUPLICATE LINES ARE NOT ALL PRINTED, BUT ARE INDICATED BY ASTERISKS.
C
C  WRITTEN BY DAN WARNER, REVISED BY PHYL FOX, OCTOBER 21, 1982.
C
C  THE LINE WIDTH IS COMPUTED AS THE MINIMUM OF THE INPUT MCOL AND 160.
C  IF THE LINE WIDTH IS TO BE INCREASED ABOVE 160, THE BUFFERS LINE()
C  AND LAST(), WHICH THE VALUES TO BE PRINTED ON ONE LINE, MUST
C  BE DIMENSIONED ACCORDINGLY.
C
C  INPUT PARAMETERS -
C
C    A        - THE START OF THE INTEGER ARRAY TO BE PRINTED
C
C    NITEMS   - THE NUMBER OF ITEMS TO BE PRINTED
C
C    IOUT     - THE OUTPUT UNIT FOR PRINTING
C
C    MCOL     - THE NUMBER OF SPACES ACROSS THE LINE
C
C    W        - THE WIDTH OF THE PRINTED VALUE (IW)
C
C
C  ERROR STATES -
C
C    1 - NITEMS .LE. ZERO
C
C    2 - W .GT. MCOL
C
      INTEGER  NITEMS, IOUT, MCOL, W
      INTEGER  A(NITEMS)
C
      INTEGER  MAX0, MIN0, WW
C/6S
C     INTEGER  IFMT1(20), IFMT1C(20), IFMT2(14), IFMT2C(14), BLANK, STAR
C     EQUIVALENCE (IFMT1(1),IFMT1C(1)), (IFMT2(1),IFMT2C(1))
C/7S
      CHARACTER*1  IFMT1(20), IFMT2(14), BLANK, STAR
      CHARACTER*20 IFMT1C
      CHARACTER*14 IFMT2C
      EQUIVALENCE (IFMT1(1),IFMT1C), (IFMT2(1),IFMT2C)
C/
      INTEGER  INDW, NCOL, COUNT, I, J, K, ILINE, ILAST
      LOGICAL  DUP
      INTEGER  LINE(40), LAST(40)
C
C/6S
C     DATA BLANK/1H /, STAR/1H*/, INDW/7/
C/7S
      DATA BLANK/' '/, STAR/'*'/, INDW/7/
C/
C
C  IFMT1 IS FOR THE ASTERISK LINES, IFMT2 FOR THE DATA LINES
C
C/6S
C     DATA IFMT1( 1) /1H(/,  IFMT2( 1) /1H(/
C     DATA IFMT1( 2) /1H1/,  IFMT2( 2) /1H1/
C     DATA IFMT1( 3) /1HA/,  IFMT2( 3) /1HA/
C     DATA IFMT1( 4) /1H1/,  IFMT2( 4) /1H1/
C     DATA IFMT1( 5) /1H,/,  IFMT2( 5) /1H,/
C     DATA IFMT1( 6) /1H5/,  IFMT2( 6) /1HI/
C     DATA IFMT1( 7) /1HX/,  IFMT2( 7) /1H7/
C     DATA IFMT1( 8) /1H,/,  IFMT2( 8) /1H,/
C     DATA IFMT1( 9) /1H2/,  IFMT2( 9) /1H /
C     DATA IFMT1(10) /1HA/,  IFMT2(10) /1H /
C     DATA IFMT1(11) /1H1/,  IFMT2(11) /1HI/
C     DATA IFMT1(12) /1H,/,  IFMT2(12) /1H /
C     DATA IFMT1(13) /1H /,  IFMT2(13) /1H /
C     DATA IFMT1(14) /1H /,  IFMT2(14) /1H)/
C     DATA IFMT1(15) /1HX/
C     DATA IFMT1(16) /1H,/
C     DATA IFMT1(17) /1H2/
C     DATA IFMT1(18) /1HA/
C     DATA IFMT1(19) /1H1/
C     DATA IFMT1(20) /1H)/
C/7S
      DATA IFMT1( 1) /'('/,  IFMT2( 1) /'('/
      DATA IFMT1( 2) /'1'/,  IFMT2( 2) /'1'/
      DATA IFMT1( 3) /'A'/,  IFMT2( 3) /'A'/
      DATA IFMT1( 4) /'1'/,  IFMT2( 4) /'1'/
      DATA IFMT1( 5) /','/,  IFMT2( 5) /','/
      DATA IFMT1( 6) /'5'/,  IFMT2( 6) /'I'/
      DATA IFMT1( 7) /'X'/,  IFMT2( 7) /'7'/
      DATA IFMT1( 8) /','/,  IFMT2( 8) /','/
      DATA IFMT1( 9) /'2'/,  IFMT2( 9) /' '/
      DATA IFMT1(10) /'A'/,  IFMT2(10) /' '/
      DATA IFMT1(11) /'1'/,  IFMT2(11) /'I'/
      DATA IFMT1(12) /','/,  IFMT2(12) /' '/
      DATA IFMT1(13) /' '/,  IFMT2(13) /' '/
      DATA IFMT1(14) /' '/,  IFMT2(14) /')'/
      DATA IFMT1(15) /'X'/
      DATA IFMT1(16) /','/
      DATA IFMT1(17) /'2'/
      DATA IFMT1(18) /'A'/
      DATA IFMT1(19) /'1'/
      DATA IFMT1(20) /')'/
C/
C
C/6S
C     IF (NITEMS .LE. 0) CALL
C    1  SETERR(27H  APRNTI - NITEMS .LE. ZERO, 27, 1, 2)
C/7S
      IF (NITEMS .LE. 0) CALL
     1  SETERR('  APRNTI - NITEMS .LE. ZERO', 27, 1, 2)
C/
C
C/6S
C     IF (W .GT. MCOL) CALL
C    1  SETERR(22H  APRNTI - W .GT. MCOL, 22, 2, 2)
C/7S
      IF (W .GT. MCOL) CALL
     1  SETERR('  APRNTI - W .GT. MCOL', 22, 2, 2)
C/
C
C     COMPUTE THE FORMATS.
C
        WW = MIN0(99, MAX0(W, 2))
        CALL S88FMT(2, WW, IFMT2(12))
        NCOL = MAX0(1, MIN0(99, (MIN0(MCOL,160) - INDW)/WW))
        CALL S88FMT(2, NCOL, IFMT2(9))
        WW = WW-2
        CALL S88FMT(2, WW, IFMT1(13))
C
C  THE ASTERISKS ARE POSITIONED RIGHT-ADJUSTED IN THE W-WIDTH SPACE.
      CALL S88FMT(2, WW, IFMT1(13))
C
C  I COUNTS THE NUMBER OF ITEMS TO BE PRINTED,
C  J COUNTS THE NUMBER ON A GIVEN LINE,
C  COUNT COUNTS THE NUMBER OF DUPLICATE LINES.
C
  10  I = 1
      J = 0
      COUNT = 0
C
C  THE LOGICAL OF THE FOLLOWING IS ROUGHLY THIS -
C  IF THERE ARE STILL MORE ITEMS TO BE PRINTED, A LINE-
C  FULL IS PUT INTO THE ARRAY, LINE.
C  WHENEVER A LINE IS PRINTED OUT, IT IS ALSO STUFFED INTO
C  THE ARRAY, LAST, TO COMPARE WITH THE NEXT ONE COMING IN
C  TO CHECK FOR REPEAT OR DUPLICATED LINES.
C  ALSO WHENEVER A LINE IS WRITTEN OUT, THE DUPLICATION
C  COUNTER, COUNT, IS SET TO ONE.
C  THE ONLY MILDLY TRICKY PART IS TO NOTE THAT COUNT HAS TO
C  GO TO 3 BEFORE A LINE OF ASTERISKS IS PRINTED BECAUSE
C  OF COURSE NO SUCH LINE IS PRINTED FOR JUST A PAIR OF
C  DUPLICATE LINES.
C
C  ILINE IS PRINTED AS THE INDEX OF THE FIRST ARRAY ELEMENT
C  IN A LINE.
C
   20 IF (I .GT. NITEMS)  GO TO 90
        J = J+1
        LINE(J) = A(I)
        IF (J .EQ. 1) ILINE = I
        IF (J .LT. NCOL .AND. I .LT. NITEMS) GO TO 80
          IF (COUNT .EQ. 0) GO TO 50
            DUP = .TRUE.
            DO 30 K=1,NCOL
   30         IF (LAST(K) .NE. LINE(K)) DUP = .FALSE.
            IF (I .EQ. NITEMS  .AND.  J .LT. NCOL) DUP = .FALSE.
            IF (.NOT. DUP .AND. COUNT .EQ. 1) GO TO 50
              IF (.NOT. DUP) GO TO 40
                COUNT = COUNT+1
                IF (COUNT .EQ. 3) WRITE(IOUT, IFMT1C) BLANK,
     1                                 STAR, STAR, STAR, STAR
                IF (I .EQ. NITEMS)  GO TO 50
                  GO TO 70
   40         WRITE(IOUT, IFMT2C) BLANK, ILAST, (LAST(K), K=1,NCOL)
   50     WRITE(IOUT, IFMT2C) BLANK, ILINE, (LINE(K), K=1,J)
          COUNT = 1
          DO 60 K=1,NCOL
   60       LAST(K) = LINE(K)
   70     ILAST = ILINE
          J = 0
   80   I = I+1
        GO TO 20
   90 RETURN
      END

.