Category : Miscellaneous Language Source Code
Archive   : MATBYU.ZIP
Filename : SCREAT.FOR
C...THIS SUBROUTINE CREATES A SPARSE MATRIX.
C=======================================================================
SUBROUTINE SCREAT (MATNAM,ROW,COL,DOUB,INTE,NREC,NPG,NLIN,CPRINT)
C...ARGUMENTS
DOUBLE PRECISION DOUB(*)
INTEGER NREC,NPG,NLIN,ROW(*),COL(*),CPRINT,INTE(*)
CHARACTER*6 MATNAM(*)
C...LOCAL VARIABLES
INTEGER N,M,I,IREC,K,ISPACE
CHARACTER NAME*6,CHG*1
LOGICAL DUP,INT
C-----------------------------------------------------------------------
C...CREATE A SPARSE MATRIX
K=NREC+1
NREC=NREC+1
C...READ THE MATRIX NAME
121 CONTINUE
WRITE(*,*)'ENTER NAME OF SPARSE MATRIX TO BE CREATED'
READ(*,1017)NAME
C...CHECK FOR INTEGER NAME
CALL INTCHK (NAME,INT)
IF (INT) THEN
WRITE(*,*)'WARNING-INTEGER NAME. ABORT?'
READ(*,1018)CHG
IF(CHG .EQ.'Y'.OR. CHG .EQ. 'y')THEN
GOTO 121
END IF
END IF
C...CHECK THE FILE TO AVOID NAME DUPLICATION
CALL DUPCHK (NAME,MATNAM,DUP,IREC,NREC)
IF (DUP) THEN
WRITE(*,*)'MATRIX IS IN LIBRARY FILE. REPLACE?'
READ(*,1018)CHG
IF(CHG .EQ.'Y'.OR. CHG .EQ. 'y')THEN
K=IREC+1
NREC=NREC-1
ELSE
GOTO 121
END IF
END IF
C...ENTER THE NUMBER OF ROWS, COLUMNS, AND CALL INPUT ROUTINES
WRITE(*,*)'ENTER NUMBER OF ROWS AND NUMBER OF COLUMNS'
READ(*,*)N,M
IF (INT) THEN
C...READ A SPARSE INTEGER MATRIX AND WRITE TO THE LIBRARY FILE
CALL ISPARS(INTE(1),N,M)
WRITE(1,REC=K)NAME,N,M,(INTE(I),I=1,N*M)
C...READ A SPARSE FLOATING POINT MATRIX AND WRITE TO THE LIBRARY FILE
ELSE
CALL MSPARS(DOUB(1),N,M)
WRITE(1,REC=K)NAME,N,M,(DOUB(I),I=1,N*M)
END IF
C...UPDATE MATNAM, ROW, AND COL
MATNAM(K-1)=NAME
ROW(K-1)=N
COL(K-1)=M
WRITE(1,REC=1)NREC
C...WRITE TO THE COMMAND FILE
ISPACE=2
CALL PAGEND (NPG,NLIN,ISPACE)
WRITE(2,*)
WRITE(2,1031)NAME
NLIN=NLIN+2
C...OPTIONAL WRITE TO THE OUTPUT FILE
IF (CPRINT .EQ. 1) THEN
IF (INT) THEN
CALL IPRINT (INTE(1),N,M,NAME,NPG,NLIN)
ELSE
CALL MPRINT (DOUB(1),N,M,NAME,NPG,NLIN)
END IF
END IF
C...RETURN TO THE MATRIX I/O MENU
RETURN
C-----------------------------------------------------------------------
C...FORMATS
1017 FORMAT(A6)
1018 FORMAT(A1)
1031 FORMAT(7X,'CREATE',15X,A6)
C-----------------------------------------------------------------------
END
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/