Category : Miscellaneous Language Source Code
Archive   : MATBYU.ZIP
Filename : DELETE.FOR

C=======================================================================
C...THIS SUBROUTINE DELETES A MATRIX FROM THE LIBRARY.
C=======================================================================

SUBROUTINE DELETE (MATNAM,ROW,COL,DOUB,INTE,NREC,NPG,NLIN)

C...ARGUMENTS
DOUBLE PRECISION DOUB(*)
INTEGER ROW(*),COL(*),NREC,NPG,NLIN,INTE(*)
CHARACTER MATNAM(*)*6

C...LOCAL VARIABLES
INTEGER N,M,IREC,I,ISPACE
CHARACTER NAME*6,CHG*1,ANAME*6
LOGICAL DUP,INT

C-----------------------------------------------------------------------

C...DELETE A MATRIX
WRITE(*,*)'ENTER NAME OF MATRIX TO BE DELETED FROM LIBRARY FILE'
WRITE(*,*)'(ENTER *.* TO DELETE ALL MATRICES FROM LIBRARY FILE)'
READ(*,1017)ANAME
IF(ANAME .EQ. '*.*')THEN
WRITE(*,*)'ARE YOU CERTAIN?'
READ(*,1018)CHG
IF(CHG .EQ.'Y' .OR. CHG .EQ. 'y')THEN

C...WRITE OVER ALL MATRIX FILES AND UPDATE MATNAM VECTOR
DO 181 I=2,NREC
WRITE(1,REC=I)
181 CONTINUE
DO 182 I=1,NREC-1
MATNAM(I)=' '
ROW(I)=0
COL(I)=0
182 CONTINUE

C...UPDATE NREC FOR AN EMPTY LIBRARY
NREC=1
WRITE(1,REC=1)NREC
ELSE
RETURN
END IF
ELSE
CALL DUPCHK (ANAME,MATNAM,DUP,IREC,NREC)
IF (DUP) THEN

C...UPDATE MATNAM VECTOR
DO 184 I=IREC,NREC-2
MATNAM(I)=MATNAM(I+1)
ROW(I)=ROW(I+1)
COL(I)=COL(I+1)
184 CONTINUE
MATNAM(NREC-1)=' '
ROW(NREC-1)=0
COL(NREC-1)=0

C...UPDATE THE MATRIX LIBRARY
DO 185 I=IREC+1,NREC-1
READ(1,REC=I+1)NAME
CALL INTCHK (NAME,INT)
IF (INT) THEN
READ(1,REC=I+1)NAME,N,M,(INTE(K),K=1,N*M)
WRITE(1,REC=I)NAME,N,M,(INTE(K),K=1,N*M)
ELSE
READ(1,REC=I+1)NAME,N,M,(DOUB(K),K=1,N*M)
WRITE(1,REC=I)NAME,N,M,(DOUB(K),K=1,N*M)
END IF
185 CONTINUE
WRITE(1,REC=NREC)

C...UPDATE NREC
NREC=NREC-1
WRITE(1,REC=1)NREC
ELSE
WRITE(*,*)'MATRIX NOT IN LIBRARY FILE'
RETURN
END IF
END IF

C...WRITE TO THE COMMAND FILE
ISPACE=2
CALL PAGEND(NPG,NLIN,ISPACE)
WRITE(2,*)
WRITE(2,1033)ANAME
NLIN=NLIN+2

C...RETURN TO THE MATRIX I/O MENU
RETURN

C-----------------------------------------------------------------------
C...FORMAT
1017 FORMAT(A6)
1018 FORMAT(A1)
1033 FORMAT(7X,'DELETE',15X,A6)
C-----------------------------------------------------------------------

END