mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
137 lines
3.7 KiB
Fortran
137 lines
3.7 KiB
Fortran
*DECK DVOUT
|
|
SUBROUTINE DVOUT (N, DX, IFMT, IDIGIT)
|
|
C***BEGIN PROLOGUE DVOUT
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to DSPLP
|
|
C***LIBRARY SLATEC
|
|
C***TYPE DOUBLE PRECISION (SVOUT-S, DVOUT-D)
|
|
C***AUTHOR Hanson, R. J., (SNLA)
|
|
C Wisniewski, J. A., (SNLA)
|
|
C***DESCRIPTION
|
|
C
|
|
C DOUBLE PRECISION VECTOR OUTPUT ROUTINE.
|
|
C
|
|
C INPUT..
|
|
C
|
|
C N,DX(*) PRINT THE DOUBLE PRECISION ARRAY DX(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 DX(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 DX(*). (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 DOUBLE PRECISION COSTS(100)
|
|
C N = 100
|
|
C IDIGIT = -6
|
|
C CALL DVOUT(N,COSTS,'(''1COSTS OF PURCHASES'')',IDIGIT)
|
|
C
|
|
C***SEE ALSO DSPLP
|
|
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 910403 Updated AUTHOR section. (WRB)
|
|
C***END PROLOGUE DVOUT
|
|
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
|
|
DOUBLE PRECISION DX(*)
|
|
CHARACTER IFMT*(*)
|
|
C***FIRST EXECUTABLE STATEMENT DVOUT
|
|
LOUT=I1MACH(2)
|
|
WRITE(LOUT,IFMT)
|
|
IF(N.LE.0) RETURN
|
|
NDIGIT = IDIGIT
|
|
IF(IDIGIT.EQ.0) NDIGIT = 6
|
|
IF(IDIGIT.GE.0) GO TO 80
|
|
C
|
|
NDIGIT = -IDIGIT
|
|
IF(NDIGIT.GT.6) GO TO 20
|
|
C
|
|
DO 10 K1=1,N,4
|
|
K2 = MIN(N,K1+3)
|
|
WRITE(LOUT,1000) K1,K2,(DX(I),I = K1, K2)
|
|
10 CONTINUE
|
|
RETURN
|
|
C
|
|
20 CONTINUE
|
|
IF(NDIGIT.GT.14) GO TO 40
|
|
C
|
|
DO 30 K1=1,N,2
|
|
K2 = MIN(N,K1+1)
|
|
WRITE(LOUT,1001) K1,K2,(DX(I),I = K1, K2)
|
|
30 CONTINUE
|
|
RETURN
|
|
C
|
|
40 CONTINUE
|
|
IF(NDIGIT.GT.20) GO TO 60
|
|
C
|
|
DO 50 K1=1,N,2
|
|
K2=MIN(N,K1+1)
|
|
WRITE(LOUT,1002) K1,K2,(DX(I),I = K1, K2)
|
|
50 CONTINUE
|
|
RETURN
|
|
C
|
|
60 CONTINUE
|
|
DO 70 K1=1,N
|
|
K2 = K1
|
|
WRITE(LOUT,1003) K1,K2,(DX(I),I = K1, K2)
|
|
70 CONTINUE
|
|
RETURN
|
|
C
|
|
80 CONTINUE
|
|
IF(NDIGIT.GT.6) GO TO 100
|
|
C
|
|
DO 90 K1=1,N,8
|
|
K2 = MIN(N,K1+7)
|
|
WRITE(LOUT,1000) K1,K2,(DX(I),I = K1, K2)
|
|
90 CONTINUE
|
|
RETURN
|
|
C
|
|
100 CONTINUE
|
|
IF(NDIGIT.GT.14) GO TO 120
|
|
C
|
|
DO 110 K1=1,N,5
|
|
K2 = MIN(N,K1+4)
|
|
WRITE(LOUT,1001) K1,K2,(DX(I),I = K1, K2)
|
|
110 CONTINUE
|
|
RETURN
|
|
C
|
|
120 CONTINUE
|
|
IF(NDIGIT.GT.20) GO TO 140
|
|
C
|
|
DO 130 K1=1,N,4
|
|
K2 = MIN(N,K1+3)
|
|
WRITE(LOUT,1002) K1,K2,(DX(I),I = K1, K2)
|
|
130 CONTINUE
|
|
RETURN
|
|
C
|
|
140 CONTINUE
|
|
DO 150 K1=1,N,3
|
|
K2 = MIN(N,K1+2)
|
|
WRITE(LOUT,1003) K1,K2,(DX(I),I = K1, K2)
|
|
150 CONTINUE
|
|
RETURN
|
|
1000 FORMAT(1X,I4,3H - ,I4,1X,1P,8D14.5)
|
|
1001 FORMAT(1X,I4,3H - ,I4,1X,1P,5D22.13)
|
|
1002 FORMAT(1X,I4,3H - ,I4,1X,1P,4D28.19)
|
|
1003 FORMAT(1X,I4,3H - ,I4,1X,1P,3D36.27)
|
|
END
|