mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
137 lines
3.6 KiB
Fortran
137 lines
3.6 KiB
Fortran
*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
|