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