Google
 

Trailing-Edge - PDP-10 Archives - bb-h137f-bm - uetp/lib/mtaskf.for
There are 18 other files named mtaskf.for in the archive. Click here to see a list.
C			MTASKF.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	MAGTAPE SKIP FILE TESTING,  WRITES IFLMAX NUMBER OF FILES
CONTO MAG TAPE, REWINDS, LOOPS (LOOP NUMBER 830) DOING REWIND, SKIP FILE
C1 THROUGH IFLMAX TIMES AND READS THE FILE CHECKING DATA AGINST THE
CEXPECTED DATA. 
	DIMENSION IARRAY(10,10),JARRAY(10,10)
	IMAX=10
	JMAX=10
	DEV='MAG'
	IFLMAX=8

	WRITE(5,12345)
12345	FORMAT(' ENTER NUMBER OF FILES TO USE IN TEST (XXXXX):')
	READ (5,12346) IFLMAX
12346	FORMAT(I5)

CMAGTAPE 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   ON UNIT 1.  DEV IS ALSO READ FROM  PARAMS


	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 FILE TESTS FOLLOW
C   TESTSCONTINUE IF FAILURE.  THERE MAY BE PARTIAL SUCCESS.


	REWIND 1
	DO 830 IFL=1,IFLMAX
	DO 800 I=1,IMAX
	READ(1,910,END=840,ERR=850) IFILE,(JARRAY(I,J),J=1,JMAX)
	TYPE 961,IFL,I,J
800	CONTINUE
801	CONTINUE

	IF(IFILE.NE.IFL) WRITE(2,970)DEV,IFL,IFILE

	DO 810 I=1,IMAX
	DO 810 J=1,JMAX
	IF (IARRAY(I,J).NE.JARRAY(I,J)) WRITE(2,980)DEV,IFL,I,J,
	1 IARRAY(I,J),JARRAY(I,J),IMAX,JMAX
810	CONTINUE

	REWIND 1

	DO 820 K=1,IFL
	SKIP FILE 1
	TYPE 962,K
820	CONTINUE
830	CONTINUE
	GO TO 9999

C   END= COMES HERE
840	WRITE(2,1020)
	WRITE(2,990)DEV
	WRITE(2, 1010)IFL,IFILE,I,J,JARRAY(I,J)
	GO TO 801

C   ERR= COMES HERE
850	WRITE(2,1020)
	WRITE(2, 1000)DEV
	WRITE(2, 1010)IFL,IFILE,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(' ***** ***** 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(' +++++TEST MTASKF.FOR MAGTAPE SKIPFILE TEST+++++',/,
	1 ' ***** ***** SKIP FILE ERROR ON',A5,/
	1 T13,'EXPECTED FILE NUMBER',I5,/
	2 T13,'FOUND FILE NUMBER   ',I5)
980	FORMAT(' +++++TEST MTASKF.FOR MAGTAPE SKIPFILE TEST+++++'/
	1 ' ***** ***** 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 MTASKF.FOR MAGTAPE SKIPFILE TEST+++++')
9999	END