Google
 

Trailing-Edge - PDP-10 Archives - BB-4171H-BM - uetp/lib/ranfor.for
There are 15 other files named ranfor.for in the archive. Click here to see a list.
C		RANFOR.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	RANDOM ACCESS TEST DONE ON BINARY AND ASCII FILES.  THE FILES
C	ARE WRITTEN, READ AND THE DATA CHECKED.  IF THE CHECK FAILS THE
C	ERROR IS LOGGED.

	PARAMETER IMAX=10,JMAX=10




C	INTEGER RECSZ

	DIMENSION IARRAY(IMAX,JMAX),KARRAY(IMAX,JMAX)
C	DIMENSION IARRAY(10,10),KARRAY(10,10)
	IRECSZ=5*JMAX
	OPEN(UNIT=1,ACCESS='RANDOM',FILE='RANTST.DAT',
	1 DEVICE='DSK',RECORD SIZE=IRECSZ,ASSOCIATED VARIABLE=IVAR,
	2 FORM='FORMATTED')
	OPEN(UNIT=2,ACCESS='APPEND',DEVICE='DSK')
	OPEN(UNIT=3,ACCESS='APPEND',DEVICE='DSK')
	OPEN(UNIT=4,FILE='RANFOR.ERR',ACCESS='APPEND',DEVICE='DSK',
	1 RECORD SIZE=250)
	DO 100 I=1,IMAX
	DO 100 J=1,JMAX

	IARRAY(I,J)=I*JMAX+J-JMAX
C	TYPE 930,I,J,IARRAY(I,J)
100	CONTINUE

	DO 200 I=1,IMAX
	WRITE(3,910)(IARRAY(I,J),J=1,JMAX)
	K=IMAX-I+1
	WRITE(1'K,910)(IARRAY(I,J),J=1,JMAX)
200	CONTINUE

	CLOSE (1)
	N=1
	K=1
	L=1

	OPEN(UNIT=1,ACCESS='RANDOM',FILE='RANTST.DAT',
	1 DEVICE='DSK',RECORD SIZE=IRECSZ,ASSOCIATED VARIABLE=IVAR,
	2 FORM='FORMATTED')
	DO 300 I=IMAX,1,-1
	M=IMAX-I+1

	READ (1'I,920)(KARRAY(M,L),L=1,JMAX)
	WRITE(2,910)(KARRAY(M,L),L=1,JMAX)

300	CONTINUE

	DO 400 I=1,IMAX
	DO 400 J=1,JMAX
C	TYPE 931,I,J,IARRAY(I,J),KARRAY(I,J)
	IF(IARRAY(I,J).NE.KARRAY(I,J)) GO TO 500
400	CONTINUE
410	GO TO 599
500	WRITE(4,940)




C   BINARY RANDOM WRITE AND READ AND CHECK.  SAME ARRAY SIZE.

599	CLOSE (1)
	OPEN(UNIT=1,ACCESS='RANDOM',FILE='RANBIN.DAT',RECORD SIZE=
	1 JMAX,DEVICE='DSK',ASSOCIATED VARIABLE=IVAR)

	DO 600 I=1,IMAX
	WRITE(1'IMAX-I+1)(IARRAY(I,J),J=1,JMAX)
	TYPE 960,IVAR
600	CONTINUE

960	FORMAT(I5)


	DO 700 I=IMAX,1,-1
	M=IMAX-I+1
	READ(1'I)(KARRAY(M,J),J=1,JMAX)
	TYPE 960,IVAR
700	CONTINUE

	DO 800 I=1,IMAX
	DO 800 J=1,JMAX
	IF(IARRAY(I,J).NE.KARRAY(I,J)) GO TO 810
800	CONTINUE
	GO TO 9999
810	WRITE(4,950)
	WRITE(4, 931)I,J,IARRAY(I,J),KARRAY(I,J)



C   FORMATS AND END


910	FORMAT(10I5)
920	FORMAT(10I5)
930	FORMAT(' I= ',I2,' J= ',I2,' ARRAY= ',I3)
931	FORMAT(' I= ',I5,' J=',I5,' IARRAY=',I5,' KARRAY=',I5)
940	FORMAT(1H ,
	1'++++	ERROR TEST RANTST.FOR FILE RANFOR.CTL		++++',/,' ',
	2'++++	FAILURE IN FORTRAN RANDOM ASCII INTEGER  IO	++++',/,' ',
	3'++++	ERROR TEST RANTST.FOR				++++',/)
950	FORMAT(' ',
	1'++++	ERROR TEST RANTST.FOR FILE RANFOR.CTL		++++',/,' ',
	2'++++	FAILURE IN FORTRAN RANDOM BINARY IO		++++',/,' ',
	3'++++	ERROR TEST RANTST.FOR END MESSAGE		++++',/)

9999	END