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

C=======================================================================
C...THIS SUBROUTINE CREATES A MATRIX.
C=======================================================================

SUBROUTINE CREATE (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 NEW RECORD LOCATION
K=NREC+1
NREC=NREC+1

C...READ THE MATRIX NAME
121 CONTINUE
WRITE(*,*)'ENTER NAME OF 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 INFORMATION FOR THE NEW MATRIX
WRITE(*,*)'ENTER NUMBER OF ROWS AND NUMBER OF COLUMNS'
READ(*,*)N,M
IF (INT) THEN
CALL ICREAT(INTE(1),N,M,NAME)
WRITE(1,REC=K)NAME,N,M,(INTE(I),I=1,N*M)
ELSE
CALL MCREAT(DOUB(1),N,M,NAME)
WRITE(1,REC=K)NAME,N,M,(DOUB(I),I=1,N*M)
END IF

C...WRITE THE NEW MATRIX INTO THE LIBRARY
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