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

C=======================================================================
C...THIS SUBROUTINE GETS AN INTEGER MATRIX FROM THE LIBRARY AND RECORDS
C...NAME, ORDER, DESCRIPTION TO THE OUTPUT FILE
C=======================================================================

SUBROUTINE IGET (KI,KINTE,TEXT,MATNAM,NR,NC,INTE,NREC,NPG,
+NLIN,FLAG)

C...ARGUMENTS
INTEGER KINTE,KX,NREC,NPG,NLIN,NR,NC,INTE(*)
CHARACTER MATNAM(*)*6,TEXT*49
LOGICAL FLAG

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

C-----------------------------------------------------------------------
C...DATA DICTIONARY
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 FLAG-----> LOGICAL VARIABLE = .TRUE. IF IGET SUBROUTINE FAILS.
C IREC-----> ADRESS IN THE MATRIX LIBRARY FOUND BY DUPCHK
C ISPACE---> REQUIRED SPACES OR START A NEW PAGE
C KINTE----> STARTING ADDRESS OF THE NEXT MATRIX TO BE READ IN
C KX-------> STARTING ADDRESS OF THE MATRIX READ IN CURRENTLY
C MATNAM---> AN ARRAY OF THE NAMES OF THE MATRICES IN THE LIBRARY
C NAME-----> THE NAME OF THE MATRIX TO BE RETRIEVED FROM THE LIBRARY
C NC-------> NUMBER OF COLUMNS IN THE MATRIX
C NLIN-----> LINE NUMBER ON CURRENT PAGE IN OUTPUT FILE
C NPG------> NUMBER OF PAGES IN THE OUTPUT FILE
C NR-------> NUMBER OF ROWS IN THE MATRIX
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-----------------------------------------------------------------------

C...INITIALIZE FLAG = .FALSE.
FLAG=.FALSE.

C...READ IN A DOUBLE PRECISION MATRIX
WRITE(*,200)TEXT
READ(*,100)NAME
CALL INTCHK (NAME,INT)
IF (INT) THEN
CALL DUPCHK(NAME,MATNAM,DUP,IREC,NREC)
IF (DUP) THEN
KI=KINTE
READ(1,REC=IREC+1)NAME,NR,NC,(INTE(I),I=KI,KI+NR*NC)
KINTE=KI+NR*NC

C...WRITE ERROR MESSAGE; MATRIX IS NOT IN THE LIBRARY FILE
ELSE
WRITE(*,*)'MATRIX NOT IN LIBRARY FILE'
FLAG=.TRUE.
RETURN
END IF

C...WRITE ERROR MESSAGE; THE USER HAS NOT SUPPLIED AN INTEGER NAME
ELSE
WRITE(*,*)'INTEGER MATRIX REQUIRED'
FLAG=.TRUE.
RETURN
END IF

C...WRITE THE MATRIX NAME, ORDER, AND DESCRIPTION TO OUTPUT FILE
ISPACE=1
CALL PAGEND (NPG,NLIN,ISPACE)
WRITE(2,300)NAME,NR,NC,TEXT
NLIN=NLIN+1

RETURN

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

END