*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