mirror of
https://git.planet-casio.com/Lephenixnoir/OpenLibm.git
synced 2025-01-01 06:23:39 +01:00
161 lines
4.6 KiB
Fortran
161 lines
4.6 KiB
Fortran
*DECK SMOUT
|
|
SUBROUTINE SMOUT (M, N, LDA, A, IFMT, IDIGIT)
|
|
C***BEGIN PROLOGUE SMOUT
|
|
C***SUBSIDIARY
|
|
C***PURPOSE Subsidiary to FC and SBOCLS
|
|
C***LIBRARY SLATEC
|
|
C***TYPE SINGLE PRECISION (SMOUT-S, DMOUT-D)
|
|
C***AUTHOR (UNKNOWN)
|
|
C***DESCRIPTION
|
|
C
|
|
C SINGLE PRECISION MATRIX OUTPUT ROUTINE.
|
|
C
|
|
C INPUT..
|
|
C
|
|
C M,N,LDA,A(*,*) PRINT THE SINGLE 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,10, OR 14
|
|
C 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 DIMENSION TABLEU(20,20)
|
|
C M = 10
|
|
C N = 20
|
|
C LDTABL = 20
|
|
C IDIGIT = -6
|
|
C CALL SMOUT(M,N,LDTABL,TABLEU,21H(16H1SIMPLEX TABLEAU),IDIGIT)
|
|
C
|
|
C***SEE ALSO FC, SBOCLS
|
|
C***ROUTINES CALLED I1MACH
|
|
C***REVISION HISTORY (YYMMDD)
|
|
C 780801 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 SMOUT
|
|
DIMENSION A(LDA,*)
|
|
CHARACTER IFMT*(*),ICOL*3
|
|
SAVE ICOL
|
|
DATA ICOL /'COL'/
|
|
C***FIRST EXECUTABLE STATEMENT SMOUT
|
|
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 20
|
|
C
|
|
DO 10 K1=1,N,5
|
|
K2 = MIN(N,K1+4)
|
|
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.6) GO TO 40
|
|
C
|
|
DO 30 K1=1,N,4
|
|
K2 = MIN(N,K1+3)
|
|
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.10) GO TO 60
|
|
C
|
|
DO 50 K1=1,N,3
|
|
K2=MIN(N,K1+2)
|
|
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,2
|
|
K2 = MIN(N,K1+1)
|
|
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 100
|
|
C
|
|
DO 90 K1=1,N,10
|
|
K2 = MIN(N,K1+9)
|
|
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.6) GO TO 120
|
|
C
|
|
DO 110 K1=1,N,8
|
|
K2 = MIN(N,K1+7)
|
|
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.10) GO TO 140
|
|
C
|
|
DO 130 K1=1,N,6
|
|
K2 = MIN(N,K1+5)
|
|
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,5
|
|
K2 = MIN(N,K1+4)
|
|
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,10(4X,A,I4,1X))
|
|
1001 FORMAT(10X,8(5X,A,I4,2X))
|
|
1002 FORMAT(10X,6(7X,A,I4,4X))
|
|
1003 FORMAT(10X,5(9X,A,I4,6X))
|
|
1004 FORMAT(1X,3HROW,I4,2X,1P,10E12.3)
|
|
1005 FORMAT(1X,3HROW,I4,2X,1P,8E14.5)
|
|
1006 FORMAT(1X,3HROW,I4,2X,1P,6E18.9)
|
|
1007 FORMAT(1X,3HROW,I4,2X,1P,5E22.13)
|
|
END
|