Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	PROGRAM ARRAYS

!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

!	Version 7	ARRAYS.FOR

!	Basic test of arrays.
!	Assignments are made to several arrays of different
!	dimensions, then checked for their accuracy.

	INTEGER IN(5),IIII(5,5)
	REAL XX(5,5,5)
	DOUBLE PRECISION DD(5)

	DO 100 I=1,5		!Assignment
		IN(I)=I
		DD(I)=I+.0000000001
		DO 200 J=1,5
			IIII(I,J)=J+I
			DO 300 K=1,5
				XX(I,J,K)=IN(I)+K
300			CONTINUE
200		CONTINUE
100	CONTINUE

!	Check assignments to the arrays

	DO 500 I=1,5
		IF (IN(I).NE.I) TYPE 710,I,IN(I),I
		D=I+.0000000001
		IF (DD(I).NE.(I+.0000000001)) TYPE 720,I,DD(I),D
		DO 600 J=1,5
			KK=J+I
			IF (IIII(I,J).NE.KK) TYPE 730,I,J,IIII(I,J),KK
			DO 700 K=1,5
				KKK=IN(I)+K
				IF (XX(I,J,K).NE.KKK) TYPE 740,
	1			I,J,K,XX(I,J,K),KK
700			CONTINUE
600		CONTINUE
500	CONTINUE

710	FORMAT(' ?Error IN('I2')='I', should ='I2)
720	FORMAT(' ?Error DD('I2')='D', Should ='D)
730	FORMAT(' ?Error IIII('I2','I2')='I', should = 'I)
740	FORMAT(' ?Error DD('I2','I2','I2')='D', should = 'D)

	STOP
	END