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 SVOUT
|
|
SUBROUTINE SVOUT (N, SX, IFMT, IDIGIT)
|
|
C***BEGIN PROLOGUE SVOUT
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to SPLP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE SINGLE PRECISION (SVOUT-S, DVOUT-D)
|
|
C***AUTHOR (UNKNOWN)
|
|
C***DESCRIPTION
|
|
C
|
|
C SINGLE PRECISION VECTOR OUTPUT ROUTINE.
|
|
C
|
|
C INPUT..
|
|
C
|
|
C N,SX(*) PRINT THE SINGLE PRECISION ARRAY SX(I),I=1,...,N, ON
|
|
C OUTPUT UNIT LOUT. THE HEADING IN THE FORTRAN FORMAT
|
|
C STATEMENT IFMT(*), DESCRIBED BELOW, IS PRINTED AS A FIRST
|
|
C STEP. THE COMPONENTS SX(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 AT LEAST 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 SX(*). (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 COSTS(100)
|
|
C N = 100
|
|
C IDIGIT = -6
|
|
C CALL SVOUT(N,COSTS,'(''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 891107 Added comma after 1P edit descriptor in FORMAT
|
|
C statements. (WRB)
|
|
C 891214 Prologue converted to Version 4.0 format. (BAB)
|
|
C 900328 Added TYPE section. (WRB)
|
|
C***END PROLOGUE SVOUT
|
|
DIMENSION SX(*)
|
|
CHARACTER IFMT*(*)
|
|
C
|
|
C GET THE UNIT NUMBER WHERE OUTPUT WILL BE WRITTEN.
|
|
C***FIRST EXECUTABLE STATEMENT SVOUT
|
|
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,5
|
|
K2 = MIN(N,K1+4)
|
|
WRITE(LOUT,1000) K1,K2,(SX(I),I=K1,K2)
|
|
10 CONTINUE
|
|
RETURN
|
|
C
|
|
20 CONTINUE
|
|
IF(NDIGIT.GT.6) GO TO 40
|
|
C
|
|
DO 30 K1=1,N,4
|
|
K2 = MIN(N,K1+3)
|
|
WRITE(LOUT,1001) K1,K2,(SX(I),I=K1,K2)
|
|
30 CONTINUE
|
|
RETURN
|
|
C
|
|
40 CONTINUE
|
|
IF(NDIGIT.GT.10) GO TO 60
|
|
C
|
|
DO 50 K1=1,N,3
|
|
K2=MIN(N,K1+2)
|
|
WRITE(LOUT,1002) K1,K2,(SX(I),I=K1,K2)
|
|
50 CONTINUE
|
|
RETURN
|
|
C
|
|
60 CONTINUE
|
|
DO 70 K1=1,N,2
|
|
K2 = MIN(N,K1+1)
|
|
WRITE(LOUT,1003) K1,K2,(SX(I),I=K1,K2)
|
|
70 CONTINUE
|
|
RETURN
|
|
C
|
|
80 CONTINUE
|
|
IF(NDIGIT.GT.4) GO TO 100
|
|
C
|
|
DO 90 K1=1,N,10
|
|
K2 = MIN(N,K1+9)
|
|
WRITE(LOUT,1000) K1,K2,(SX(I),I=K1,K2)
|
|
90 CONTINUE
|
|
RETURN
|
|
C
|
|
100 CONTINUE
|
|
IF(NDIGIT.GT.6) GO TO 120
|
|
C
|
|
DO 110 K1=1,N,8
|
|
K2 = MIN(N,K1+7)
|
|
WRITE(LOUT,1001) K1,K2,(SX(I),I=K1,K2)
|
|
110 CONTINUE
|
|
RETURN
|
|
C
|
|
120 CONTINUE
|
|
IF(NDIGIT.GT.10) GO TO 140
|
|
C
|
|
DO 130 K1=1,N,6
|
|
K2 = MIN(N,K1+5)
|
|
WRITE(LOUT,1002) K1,K2,(SX(I),I=K1,K2)
|
|
130 CONTINUE
|
|
RETURN
|
|
C
|
|
140 CONTINUE
|
|
DO 150 K1=1,N,5
|
|
K2 = MIN(N,K1+4)
|
|
WRITE(LOUT,1003) K1,K2,(SX(I),I=K1,K2)
|
|
150 CONTINUE
|
|
RETURN
|
|
1000 FORMAT(1X,I4,' - ',I4,1P,10E12.3)
|
|
1001 FORMAT(1X,I4,' - ',I4,1X,1P,8E14.5)
|
|
1002 FORMAT(1X,I4,' - ',I4,1X,1P,6E18.9)
|
|
1003 FORMAT(1X,I4,' - ',I4,1X,1P,5E24.13)
|
|
END
|