Google
 

Trailing-Edge - PDP-10 Archives - BB-J712A-BM - uetp/lib/mtabak.for
There are 18 other files named mtabak.for in the archive. Click here to see a list.
C THIS TEST CAME FROM THE EXERCISER ON OCTOBER 12,1977
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
C			MTABAK.FOR

CMAGTAPE TESTING. WRITES OUT IFILE NUMBER OF FILES ON MAGTAPE
C  "DEV". THE FILES ARE INTEGER ASCII OF THE SIZE IMAX*JMAX
C   WHERE IMAX AND JMAX ARE READ IN AT RUNTIME FROM FILE PARAMS.DAT
C   ON UNIT 1.  DEV IS ALSO READ FROM  PARAMS

	DIMENSION IARRAY(10,10),JARRAY(10,10)
	IMAX=10
	JMAX=10
	DEV='MAG'
	WRITE(5,12345)
12345	FORMAT(' ENTER NUMBER OF FILES TO USE IN TEST (XXXXX):')
	READ (5,12346) IFLMAX
12346	FORMAT(I5)


	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   DEV SHOULD BE POSITIONED AT END OF LAST FILE REQUESTED.
C   WILL READ THROUGE DEV BACKWARDS A FILE AT A TIME, THE FILES
C   THEMSELVES READ FORWARD.

	DO 500 IFL=IFLMAX,1,-1
	TYPE 950,IFL
	BACKFILE 1
	TYPE 951

	DO 400 I=1,IMAX
	READ(1,910,END=840,ERR=850)JFILE,(JARRAY(I,J),J=1,JMAX)
	TYPE 952,IFL,I,JFILE,JARRAY(I,1)
	IF(JFILE.EQ.IFL) GO TO 444
	WRITE(5,1020)
	WRITE(5, 920)DEV,JFILE,IFL
	WRITE (5,1030)
	GO TO 500

444	NOW=400
	TYPE 960,NOW
400	CONTINUE
	NOW=500
	TYPE 960,NOW
500	CONTINUE
599	GO TO 9999


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

C   ERR= COMES HERE
850	OPEN(UNIT=2,DEVICE='DSK',FILE='MTA.ERR',ACCESS='APPEND',
	1 RECORD SIZE=240)
	WRITE(5, 1020)
	WRITE (5, 1000) DEV
	WRITE(5, 1010)IFL,JFILE,I,J,JARRAY(I,J)
	WRITE (5,1030)
	GO TO 9999


910	FORMAT(I5,(10I5))
920	FORMAT(' 	BACKSPACE FILES ON ',A5,' FAILED'/
	1 '	FILE ',I5,' FOUND, FILE ',I5,' EXPECTED.')
930	FORMAT(' ?***** ***** REWIND DIDNOT END UP AT FIRST 
	1 FILE ON ',A5)
940	FORMAT(' ?***** ***** SKIP RECORD PROBLEM ON ',A5)
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 ',I5,' FOUND',I5/
	1 ' RECORD',I5,' ITEM ',I5,' VALUE ',I5)

1020	FORMAT (' ++++	TEST MTABAK.FOR - BACKSPACE FILE TEST ++++')
1030	FORMAT (' ++++	[END OF MTABAK.FOR ERROR]	      ++++'/)
9999	END