Google
 

Trailing-Edge - PDP-10 Archives - red405a2 - uetp/lib/mtaskr.for
There are 18 other files named mtaskr.for in the archive. Click here to see a list.
C		MTASKR.FOR
CTHIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
C  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
C
CCOPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
C	THIS TEST WAS TAKEN FROM THE EXERCISER ON OCTOBER 30,1977
C
C
	DIMENSION IARRAY(10,10),JARRAY(10,10)
	IMAX=10
	JMAX=10
	DEV='MAG'
	IFLMAX=15
	WRITE(5,12345)
12345	FORMAT(' ENTER NUMBER OF FILES TO USE IN TEST (XXXXX):')
	READ (5,12346) IFLMAX
12346	FORMAT(I5)

C		MTASKR.FOR
C
C	MAGTAPE SKIP RECORD TEST.  READS FIRST FILE ON MTAGTAPE
C	SEQUENTIALY BY REWINDING AND SKIPPING THE RECORDS THAT HAVE
C	BEEN READ ALREADY FOR EACH RECORD READ.
C   MAGTAPE TESTING. WRITES OUT IFILE NUMBER OF FILES ON MAGTAPE
C  "DEV". THE FILES ARE INTIGER ASCII OF THE SIZE IMAX*JMAX
C   WHERE IMAX AND JMAX ARE READ IN AT RUNTIME FROM FILE PARAMS.DAT,
C   ERRORS ARE LOGGED IN FILE MTA.ERR.



	DO 100 I=1,IMAX
	DO 100 J=1,JMAX
	IARRAY(I,J)=I*JMAX+J-JMAX
100	CONTINUE

	OPEN(UNIT=1,DEVICE=DEV)
	REWIND 1

	DO 300 IFILE=1,IFLMAX
	OPEN(UNIT=1,DEVICE=DEV)

	DO 200 I=1,IMAX
	WRITE(1,910)IFILE,(IARRAY(I,J),J=1,JMAX)
200	CONTINUE

	ENDFILE 1
	NOW=300
	TYPE 960,NOW
300	CONTINUE

C   SKIP RECORD TESTS
	REWIND 1

	DO 6000 IFILE=1,IFLMAX
	DO 600 K=1,IMAX-1
	REWIND 1
	IF(IFILE.EQ.1) GO TO 6002
	DO 6001 KKK=1,IFILE-1
6001	SKIP FILE 1
6002	CONTINUE
	DO 400 I=1,K
	SKIPRECORD 1
400	CONTINUE

	READ(1,910,END=840,ERR=850)JFILE,(JARRAY(I,J),J=1,JMAX)
	IF(JFILE.NE.IFILE)TYPE 930,DEV

	DO 500 J=1,JMAX
	IF(IARRAY(I,J).NE.JARRAY(I,J))WRITE(5,940)DEV,JFILE,I,J,
	1 IARRAY(I,J),JARRAY(I,J),IMAX,JMAX
500	CONTINUE

600	CONTINUE
6000	CONTINUE
699	GO TO 9999

C   END= COMES HERE
840	WRITE(5,1020)
	WRITE(5, 990)DEV
	WRITE(5, 1010)JFILE,I,J,JARRAY(I,J)
	GO TO 9999


C   ERR= COMES HERE
850	WRITE(5,1020)
	WRITE(5, 1000)DEV
	WRITE(5, 1010)JFILE,I,J,JARRAY(I,J)
	GO TO 9999

910	FORMAT(I5,(10I5))
920	FORMAT(' ?**** ***** BACKSPACE FILES ON',A5,'FAILED'/
	1 13X,'FILE',I5,'FOUND, FILE',I5,'EXPECTED.')
930	FORMAT(' ?**** ***** REWIND DIDNOT END UP AT FIRST 
	1 FILE ON ',A5)
940	FORMAT(' ?++++TEST MTASKR.FOR MAGTAPE SKIPRECORD TEST+++++'/
	1 ' ***** ***** SKIP RECORD PROBLEM ON ',A5/
	1 T13,'WHILE READING FILE NUMBER ',I5/
	2 T13, 'DURING COMPARE OF INPUT RECORD WITH RECORD WRITTEN'/
	3 T13,'RECORD ',I5,' ITEM',I5/
	4 T13,'EXPECTED VALUE',I5,' FOUND',I5/
	5 T13,'ARRAY IS ',I5,' BY',I5/
	6 ' ***** *****'/)
950	FORMAT(' IFL=',I5,' BACKFILE')
951	FORMAT(' OK')
952	FORMAT(' IFL=',I5,'I=',I5,'JFILE=',I5,'ARRAY=',I5)
960	FORMAT(' NOW=',I5)
961	FORMAT(' 800 DONE, IFL=',I5,' I=',I5,' J=',I5)
962	FORMAT(' 820 DONE, K= ',I5)
970	FORMAT(' ?**** ***** SKIP FILE ERROR ON',A5,/
	1 T13,'EXPECTED FILE NUMBER',I5,/
	2 T13,'FOUND FILE NUMBER   ',I5)
980	FORMAT(' ?**** ***** FORTRAN SKIP FILE MTA ERROR ON ',A5/
	1 T13,'WHILE READING FILE NUMBER ',I5/
	2 T13,' DURING ARRAY READ, COMPARING INPUT WITH ARRAY WRITTEN'/
	3 T13,'RECORD ',I5,'ITEM ',I5/
	4 T13,'EXPECTED VALUE ',I5,'FOUND 'I5/
	5 T13,'ARRAY IS',I5,' BY',I5/' ***** *****')
990	FORMAT(' "END=" ON ',A5)
1000	FORMAT(' "ERR=" ON ',A5)
1010	FORMAT(' EXPECTED FILE NUMBER 1, FOUND',I5/
	1 'RECORD',I5,' ITEM',I5,' VALUE',I5)

1020	FORMAT('+++++TEST MTASKR.FOR MAGTAPE SKIPRECORD TEST+++++')
9999	END