*DECK DMOUT SUBROUTINE DMOUT (M, N, LDA, A, IFMT, IDIGIT) C***BEGIN PROLOGUE DMOUT C***SUBSIDIARY C***PURPOSE Subsidiary to DBOCLS and DFC C***LIBRARY SLATEC C***TYPE DOUBLE PRECISION (SMOUT-S, DMOUT-D) C***AUTHOR Hanson, R. J., (SNLA) C Wisniewski, J. A., (SNLA) C***DESCRIPTION C C DOUBLE PRECISION MATRIX OUTPUT ROUTINE. C C INPUT.. C C M,N,LDA,A(*,*) PRINT THE DOUBLE PRECISION ARRAY A(I,J),I = 1,...,M, C J=1,...,N, ON OUTPUT UNIT LOUT=6. LDA IS THE DECLARED C FIRST DIMENSION OF A(*,*) AS SPECIFIED IN THE CALLING C PROGRAM. THE HEADING IN THE FORTRAN FORMAT STATEMENT C IFMT(*), DESCRIBED BELOW, IS PRINTED AS A FIRST STEP. C THE COMPONENTS A(I,J) ARE INDEXED, ON OUTPUT, IN A C PLEASANT FORMAT. C IFMT(*) A FORTRAN FORMAT STATEMENT. THIS IS PRINTED ON C OUTPUT UNIT LOUT=6 WITH THE VARIABLE FORMAT FORTRAN C 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,14,20 OR C 28 WHICH WILL PRINT AT LEAST ABS(IDIGIT) NUMBER OF C PLACES. IF IDIGIT.LT.0, 72 PRINTING COLUMNS ARE C UTILIZED TO WRITE EACH LINE OF OUTPUT OF THE ARRAY C A(*,*). (THIS CAN BE USED ON MOST TIME-SHARING C TERMINALS). IF IDIGIT.GE.0, 133 PRINTING COLUMNS ARE C UTILIZED. (THIS CAN BE USED ON MOST LINE PRINTERS). C C EXAMPLE.. C C PRINT AN ARRAY CALLED (SIMPLEX TABLEAU ) OF SIZE 10 BY 20 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 TABLEU(20,20) C M = 10 C N = 20 C LDTABL = 20 C IDIGIT = -6 C CALL DMOUT(M,N,LDTABL,TABLEU,21H(16H1SIMPLEX TABLEAU),IDIGIT) C C***SEE ALSO DBOCLS, DFC C***ROUTINES CALLED I1MACH C***REVISION HISTORY (YYMMDD) C 821220 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 DMOUT DOUBLE PRECISION A(LDA,*) CHARACTER IFMT*(*),ICOL*3 SAVE ICOL DATA ICOL /'COL'/ C***FIRST EXECUTABLE STATEMENT DMOUT LOUT=I1MACH(2) WRITE(LOUT,IFMT) IF(M.LE.0.OR.N.LE.0.OR.LDA.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 9 C DO 5 K1=1,N,5 K2 = MIN(N,K1+4) WRITE(LOUT,1010) (ICOL,I,I = K1, K2) DO 5 I = 1, M WRITE(LOUT,1009) I,(A(I,J),J = K1, K2) 5 CONTINUE RETURN C 9 CONTINUE IF(NDIGIT.GT.6) GO TO 20 C DO 10 K1=1,N,4 K2 = MIN(N,K1+3) WRITE(LOUT,1000) (ICOL,I,I = K1, K2) DO 10 I = 1, M WRITE(LOUT,1004) I,(A(I,J),J = 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) (ICOL,I,I = K1, K2) DO 30 I = 1, M WRITE(LOUT,1005) I,(A(I,J),J = 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) (ICOL,I,I = K1, K2) DO 50 I = 1, M WRITE(LOUT,1006) I,(A(I,J),J = K1, K2) 50 CONTINUE RETURN C 60 CONTINUE DO 70 K1=1,N K2 = K1 WRITE(LOUT,1003) (ICOL,I,I = K1, K2) DO 70 I = 1, M WRITE(LOUT,1007) I,(A(I,J),J = K1, K2) 70 CONTINUE RETURN C 80 CONTINUE IF(NDIGIT.GT.4) GO TO 86 C DO 85 K1=1,N,10 K2 = MIN(N,K1+9) WRITE(LOUT,1000) (ICOL,I,I = K1, K2) DO 85 I = 1, M WRITE(LOUT,1009) I,(A(I,J),J = K1, K2) 85 CONTINUE C 86 IF (NDIGIT.GT.6) GO TO 100 C DO 90 K1=1,N,8 K2 = MIN(N,K1+7) WRITE(LOUT,1000) (ICOL,I,I = K1, K2) DO 90 I = 1, M WRITE(LOUT,1004) I,(A(I,J),J = 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) (ICOL,I,I = K1, K2) DO 110 I = 1, M WRITE(LOUT,1005) I,(A(I,J),J = 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) (ICOL,I,I = K1, K2) DO 130 I = 1, M WRITE(LOUT,1006) I,(A(I,J),J = K1, K2) 130 CONTINUE RETURN C 140 CONTINUE DO 150 K1=1,N,3 K2 = MIN(N,K1+2) WRITE(LOUT,1003) (ICOL,I,I = K1, K2) DO 150 I = 1, M WRITE(LOUT,1007) I,(A(I,J),J = K1, K2) 150 CONTINUE RETURN 1000 FORMAT(10X,8(5X,A,I4,2X)) 1001 FORMAT(10X,5(9X,A,I4,6X)) 1002 FORMAT(10X,4(12X,A,I4,9X)) 1003 FORMAT(10X,3(16X,A,I4,13X)) 1004 FORMAT(1X,3HROW,I4,2X,1P,8D14.5) 1005 FORMAT(1X,3HROW,I4,2X,1P,5D22.13) 1006 FORMAT(1X,3HROW,I4,2X,1P,4D28.19) 1007 FORMAT(1X,3HROW,I4,2X,1P,3D36.27) 1009 FORMAT(1X,3HROW,I4,2X,1P,10D12.3) 1010 FORMAT(10X,10(4X,A,I4,1X)) END