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

C=======================================================================
C...THIS SUBROUTINE PLACES THE RESULT OF AN APPLICATION INTO THE LIB.
C=======================================================================

SUBROUTINE PUT (K,N,M,TEXT,MATNAM,ROW,COL,DOUB,NREC,NPG,NLIN,
+ RTYPE,CPRINT)

C...ARGUMENTS
DOUBLE PRECISION DOUB(*)
INTEGER K,NREC,NPG,NLIN,RTYPE,CPRINT,ROW(*),COL(*),N,M
CHARACTER MATNAM(*)*6,TEXT*30

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

C-----------------------------------------------------------------------
C...DATA DICTIONARY
C COL------> NUMBER OF COLUMNS IN EACH MATRIX IN THE LIBRARY
C DOUB-----> DYNAMIC STORAGE VECTOR IN WHICH ALL MATRICES ARE PASSED
C IN AND OUT OF THE LIBRARY AND PREPARATORY SUBROUTINES
C DUP------> LOGICAL VARIABLE = .TRUE. IF THE NAME SENT TO DUPCHK HAS
C A MATCH IN THE MATRIX LIBRARY
C INT------> LOGICAL VARIABLE = .TRUE. IF THE NAME SENT TO INTCHK IS
C AN INTEGER NAME
C IREC-----> ADRESS IN THE MATRIX LIBRARY FOUND BY DUPCHK
C ISPACE---> REQUIRED SPACE OR START A NEW PAGE
C K--------> STARTING ADDRESS OF THE NEXT MATRIX TO BE WRITTEN TO LIB
C M--------> NUMBER OF COLUMNS IN THE RESULT MATRIX
C MATNAM---> AN ARRAY OF THE NAMES OF THE MATRICES IN THE LIBRARY
C N--------> NUMBER OF ROWS IN THE RESULT MATRIX
C NAME-----> THE NAME OF THE MATRIX TO BE RETRIEVED FROM THE LIBRARY
C NLIN-----> LINE NUMBER OF CURRENT PAGE IN OUTPUT FILE
C NPG------> NUMBER OF PAGES IN THE OUTPUT FILE
C NREC-----> NUMBER OF MATRICES IN THE LIBRARY +1
C ROW------> NUMBER OF ROWS FOR EACH MATRIX IN THE LIBRARY
C TEXT-----> PROMPT TO BE WRITTEN TO THE SCREEN FOR THE INPUT OF THE
C CURRENT MATRIX
C RTYPE----> EQUALS ONE IF MATRIX IS TO BE PRINTED ON MONITOR
C CPRINT---> EQUALS ONE IF MATRIX IS TO BE PRINTED TO OUTPUT FILE
C-----------------------------------------------------------------------

C...READ IN THE NAME FOR THE RESULT MATRIX
10 CONTINUE
WRITE(*,200)TEXT
READ(*,100)NAME

C...CHECK TO SEE THAT USER DID NOT SUPPLY AN INTEGER MATRIX NAME
CALL INTCHK (NAME,INT)
IF (INT) THEN
WRITE(*,*)'INTEGER MATRIX NAME NOT ALLOWED'
GOTO 10
END IF

C...CHECK TO SEE IF MATRIX NAME IS ALREADY IN LIBRARY FILE
CALL DUPCHK (NAME,MATNAM,DUP,IREC,NREC)
IF (DUP) THEN
WRITE(*,*)'MATRIX IS IN LIBRARY FILE. REPLACE?'
READ(*,101)CHG
IF(CHG .EQ. 'Y' .OR. CHG .EQ. 'y')THEN
WRITE(1,REC=IREC+1)NAME,N,M,(DOUB(I),I=K,K+N*M-1)
ROW(IREC)=N
COL(IREC)=M
ELSE
GOTO 10
END IF
ELSE
WRITE(1,REC=NREC+1)NAME,N,M,(DOUB(I),I=K,K+N*M-1)

C...UPDATE THE MATRIX FILE
NREC=NREC+1
WRITE(1,REC=1)NREC
MATNAM(NREC-1)=NAME
ROW(NREC-1)=N
COL(NREC-1)=M
END IF

C...OPTIONAL WRITE TO THE MONITOR
IF (RTYPE .EQ. 1) THEN
CALL MATWRI(DOUB(K),N,M,NAME)
END IF

C...CHECK END OF PAGE
ISPACE=1
CALL PAGEND (NPG,NLIN,ISPACE)

C...WRITE NAME, NUMBER OF ROWS, NUMBER OF COLS, HEADER TO OUTPUT FILE
WRITE(2,300)NAME,N,M,TEXT
NLIN=NLIN+1

C...OPTIONAL WRITE TO THE OUTPUT FILE
IF (CPRINT .EQ. 1) THEN
CALL NPRINT(DOUB(K),N,M,NPG,NLIN)
END IF

RETURN

C-----------------------------------------------------------------------
C...FORMATS
100 FORMAT(A6)
101 FORMAT(A1)
200 FORMAT(1X,'ENTER NAME OF ',A30)
300 FORMAT(7X,'[',A6,1X,'(',I2,',',I2,')] ',A30)
C-----------------------------------------------------------------------

END