relibc_openlibm/slatec/ivout.f

*DECK IVOUT
      SUBROUTINE IVOUT (N, IX, IFMT, IDIGIT)
C***BEGIN PROLOGUE  IVOUT
C***SUBSIDIARY
C***PURPOSE  Subsidiary to SPLP
C***LIBRARY   SLATEC
C***TYPE      INTEGER (IVOUT-I)
C***AUTHOR  Hanson, R. J., (SNLA)
C           Wisniewski, J. A., (SNLA)
C***DESCRIPTION
C
C     INTEGER VECTOR OUTPUT ROUTINE.
C
C  INPUT..
C
C  N,IX(*) PRINT THE INTEGER ARRAY IX(I),I=1,...,N, ON OUTPUT
C          UNIT LOUT. THE HEADING IN THE FORTRAN FORMAT
C          STATEMENT IFMT(*), DESCRIBED BELOW, IS PRINTED AS A FIRST
C          STEP. THE COMPONENTS IX(I) ARE INDEXED, ON OUTPUT,
C          IN A PLEASANT FORMAT.
C  IFMT(*) A FORTRAN FORMAT STATEMENT. THIS IS PRINTED ON OUTPUT
C          UNIT LOUT WITH THE VARIABLE FORMAT FORTRAN STATEMENT
C                WRITE(LOUT,IFMT)
C  IDIGIT  PRINT UP TO ABS(IDIGIT) DECIMAL DIGITS PER NUMBER.
C          THE SUBPROGRAM WILL CHOOSE THAT INTEGER 4,6,10 OR 14
C          WHICH WILL PRINT AT LEAST ABS(IDIGIT) NUMBER OF
C          PLACES.  IF IDIGIT.LT.0, 72 PRINTING COLUMNS ARE UTILIZED
C          TO WRITE EACH LINE OF OUTPUT OF THE ARRAY IX(*). (THIS
C          CAN BE USED ON MOST TIME-SHARING TERMINALS). IF
C          IDIGIT.GE.0, 133 PRINTING COLUMNS ARE UTILIZED. (THIS CAN
C          BE USED ON MOST LINE PRINTERS).
C
C  EXAMPLE..
C
C  PRINT AN ARRAY CALLED (COSTS OF PURCHASES) OF LENGTH 100 SHOWING
C  6 DECIMAL DIGITS PER NUMBER. THE USER IS RUNNING ON A TIME-SHARING
C  SYSTEM WITH A 72 COLUMN OUTPUT DEVICE.
C
C     DIMENSION ICOSTS(100)
C     N = 100
C     IDIGIT = -6
C     CALL IVOUT(N,ICOSTS,'(''1COSTS OF PURCHASES'')',IDIGIT)
C
C***SEE ALSO  SPLP
C***ROUTINES CALLED  I1MACH
C***REVISION HISTORY  (YYMMDD)
C   811215  DATE WRITTEN
C   890531  Changed all specific intrinsics to generic.  (WRB)
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900402  Added TYPE section.  (WRB)
C   910403  Updated AUTHOR section.  (WRB)
C***END PROLOGUE  IVOUT
      DIMENSION IX(*)
      CHARACTER IFMT*(*)
C
C     GET THE UNIT NUMBER WHERE OUTPUT WILL BE WRITTEN.
C***FIRST EXECUTABLE STATEMENT  IVOUT
      J=2
      LOUT=I1MACH(J)
      WRITE(LOUT,IFMT)
      IF(N.LE.0) RETURN
      NDIGIT = IDIGIT
      IF(IDIGIT.EQ.0) NDIGIT = 4
      IF(IDIGIT.GE.0) GO TO 80
C
      NDIGIT = -IDIGIT
      IF(NDIGIT.GT.4) GO TO 20
C
      DO 10 K1=1,N,10
      K2 = MIN(N,K1+9)
      WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
   10 CONTINUE
      RETURN
C
   20 CONTINUE
      IF(NDIGIT.GT.6) GO TO 40
C
      DO 30 K1=1,N,7
      K2 = MIN(N,K1+6)
      WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
   30 CONTINUE
      RETURN
C
   40 CONTINUE
      IF(NDIGIT.GT.10) GO TO 60
C
      DO 50 K1=1,N,5
      K2=MIN(N,K1+4)
      WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
   50 CONTINUE
      RETURN
C
   60 CONTINUE
      DO 70 K1=1,N,3
      K2 = MIN(N,K1+2)
      WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
   70 CONTINUE
      RETURN
C
   80 CONTINUE
      IF(NDIGIT.GT.4) GO TO 100
C
      DO 90 K1=1,N,20
      K2 = MIN(N,K1+19)
      WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
   90 CONTINUE
      RETURN
C
  100 CONTINUE
      IF(NDIGIT.GT.6) GO TO 120
C
      DO 110 K1=1,N,15
      K2 = MIN(N,K1+14)
      WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
  110 CONTINUE
      RETURN
C
  120 CONTINUE
      IF(NDIGIT.GT.10) GO TO 140
C
      DO 130 K1=1,N,10
      K2 = MIN(N,K1+9)
      WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
  130 CONTINUE
      RETURN
C
  140 CONTINUE
      DO 150 K1=1,N,7
      K2 = MIN(N,K1+6)
      WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
  150 CONTINUE
      RETURN
 1000 FORMAT(1X,I4,' - ',I4,20(1X,I5))
 1001 FORMAT(1X,I4,' - ',I4,15(1X,I7))
 1002 FORMAT(1X,I4,' - ',I4,10(1X,I11))
 1003 FORMAT(1X,I4,' - ',I4,7(1X,I15))
      END