Trailing-Edge
-
PDP-10 Archives
-
BB-D867D-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