C.hr DGMPNT C@ C....*...1.........2.........3.........4.........5.........6.........7.* C DGMPNT 7/16/87 C C PURPOSE C PRINT A MATRIX. C C USAGE C CALL DGMPNT(A,M,N) C C ARGUMENTS C A - AN M BY N MATRIX STORED COLUMNWISE (STORAGE MODE 0). C REAL*8 C M - NUMBER OF ROWS IN A C INTEGER*4 C N - NUMBER OF COLUMNS IN A C INTEGER*4 C C COMMENT C THE DEFAULT LINESIZE IS 133, 132 PLUS CARRIAGE CONTROL CHARACTER. C THE USAGE: C COMMON /ZLNSIZ/ LNSIZE C LNSIZE=80 C WILL CHANGE THE LINESIZE TO 80. LINESIZES BETWEEN 72 AND 133 ARE C PERMITTED. C C PROGRAMMER C DR. A. RONALD GALLANT C DEPARTMENT OF STATISTICS C NORTH CAROLINA STATE UNIVERSITY C RALEIGH, NORTH CAROLINA 27695-8203 C C SUBROUTINE DGMPNT(A,M,N) IMPLICIT REAL*8 (A-H,O-Z) save INTEGER*4 START,STOP,NOUT REAL*8 A(M,N),F CHARACTER*1 DIGIT(10),DUMMY(8),COL(9) CHARACTER*8 TYPE(14),FMT(13) CHARACTER*104 CFMT COMMON /ZLNSIZ/ LNSIZE EQUIVALENCE (FMT(1),DUMMY(1)),(FMT(1),CFMT) DATA FMT /'( X, ',11*' ',' )'/ DATA DIGIT /'0','1','2','3','4','5','6','7','8','9'/ DATA COL /6*' ','C','O','L'/ DATA TYPE /',0PF12.1',',1PD12.4',',0PF12.8',',0PF12.7', & ',0PF12.6',',0PF12.5',',0PF12.4',',0PF12.3', & ',0PF12.2',',0PF12.1',',0PF12.0',',9A1,I3 ', & ' 6X ','''ROW'',I3'/ NOUT=3 LNSIZ=LNSIZE IF((LNSIZE.LT.72).OR.(LNSIZE.GT.133)) LNSIZ=133 MAXCOL=(LNSIZ-8)/12 IF(N.LT.MAXCOL) MAXCOL=N IPAD=(LNSIZ-8-12*MAXCOL)/2+1 IPAD10=IPAD/10 IPAD1=IPAD-10*IPAD10 DUMMY(3)=DIGIT(IPAD10+1) DUMMY(4)=DIGIT(IPAD1+1) START=1 11 STOP=START-1+MAXCOL IF(STOP.GT.N) STOP=N K=2 DO 13 J=START,STOP K=K+1 13 FMT(K)=TYPE(12) FMT(2)=TYPE(13) WRITE(NOUT,3001) WRITE(NOUT,3001) WRITE(NOUT,CFMT) (COL,J,J=START,STOP) WRITE(NOUT,3001) FMT(2)=TYPE(14) DO 19 I=1,M K=2 DO 18 J=START,STOP K=K+1 FMT(K)=TYPE(2) F=DABS(A(I,J)) IF(F.LT.1.D+8 ) FMT(K)=TYPE(11) IF(F.LT.1.D+5 ) FMT(K)=TYPE(10) IF(F.LT.1.D+4 ) FMT(K)=TYPE( 9) IF(F.LT.1.D+3 ) FMT(K)=TYPE( 8) IF(F.LT.1.D+2 ) FMT(K)=TYPE( 7) IF(F.LT.1.D+1 ) FMT(K)=TYPE( 6) C IF(F.LT.1.D+0 ) FMT(K)=TYPE( 6) IF(F.LT.1.D-1 ) FMT(K)=TYPE( 5) IF(F.LT.1.D-2 ) FMT(K)=TYPE( 3) IF(F.LT.1.D-4 ) FMT(K)=TYPE( 2) IF(F.LT.1.D-38) FMT(K)=TYPE( 1) 18 CONTINUE 19 WRITE(NOUT,CFMT) I,(A(I,J),J=START,STOP) IF(STOP.EQ.N) RETURN START=STOP+1 GO TO 11 3001 FORMAT(' ') END