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

	PROGRAM INTFIL

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

C	Feb-82
C	CDM

C	Tests internal files

	CHARACTER CHAR1*4,CHAR2*4,CHAR3(4,4)*8
	CHARACTER*17 CHAR5
	CHARACTER CHAR6(4,2)*26,CHAR7(3)*2
	CHARACTER CHAR8(4)*9,CHAR9*3,CHAR10(3)*10,CHAR11*2,
	1 CHAR12*2

C-100-	Simple scallar variable for file.

	WRITE(UNIT=CHAR1,FMT=110) 'ABC'
110	FORMAT(A4)
	IF (CHAR1.NE.' ABC') TYPE 120, CHAR1
120	FORMAT(' ?Error 110. CHAR1='A4', should = '' ABC''')

	CHAR1='DCBA'
	READ(CHAR1,110) CHAR2
	IF (CHAR2.NE.'DCBA') TYPE 130, CHAR2
130	FORMAT(' ?Error 120. CHAR2='A4', should = ''DCBA''')

C-200-	Array element
C	Mix in numeric and character data

	N1=-1234; CHAR2='ABCD'
	WRITE(CHAR3(2,3),FMT=210) IABS(N1),CHAR2
210	FORMAT(I4,A4)

	READ(CHAR3(2,3),FMT=220) CHAR3(3,2)
220	FORMAT(A8)

	IF (CHAR3(3,2) .NE. '1234ABCD') TYPE 230,CHAR3(3,2)
230	FORMAT(' ?Error 230. CHAR3(3,2)='A8', should = ''1234ABCD''')

C-300-	Substing.  Should only write where told to.

	CHAR1='MARY'
	CHAR5='**XXXXXXXXXXXXX**'
	F1=1.5

	WRITE(UNIT=CHAR5(3:15),FMT=310) CHAR1,F1,3+5,'AB'
310	FORMAT(A4,'@',f4.1,I1,A2)

	IF (CHAR5 .NE. '**MARY@ 1.58AB **') TYPE 320,CHAR5
320	FORMAT(' ?Error 320. CHAR5='A14', should = ',
	1 '''**MARY@ 1.58AB **''')

C	12345678901234567890123456
C	ABCDEFGHIJKLMNOPQRSTUVWXYZ
C	      |
	CHAR6(1,2)='ABCDEFGHIJKLMNOPQRSTUVWXYZ'

C	Read into array name, some fun transfer stuff.

	READ(CHAR6(1,2)(7:22) ,330) CHAR1,CHAR7
330	FORMAT(X,A4,T10,3A2)

	IF (CHAR1.NE.'HIJK') TYPE 340,CHAR1
	IF (CHAR7(1).NE.'PQ') TYPE 350,1,CHAR7(1),'PQ'
	IF (CHAR7(2).NE.'RS') TYPE 350,2,CHAR7(2),'RS'
	IF (CHAR7(3).NE.'TU') TYPE 350,3,CHAR7(3),'TU'
340	FORMAT(' ?Error 340. CHAR1 = 'A4', should = ''HIJK''')
350	FORMAT(' ?Error 350. CHAR6('I1')='A2', should ='A2)

C-400-	Multi-record with array

	K1=1234; K2=98
	CHAR9='tever'	! truncates

400	WRITE(CHAR8,410) K1,'ABC',K2,23,CHAR9
410	FORMAT(I4,A3,/,'no'X,I2)

	IF (CHAR8(1).NE.'1234ABC  ') TYPE 420,1,CHAR8(1),'1234ABC  '
	IF (CHAR8(2).NE.'no 98    ') TYPE 420,2,CHAR8(2),'no 98    '
	IF (CHAR8(3).NE.'  23tev  ') TYPE 420,3,CHAR8(3),'  23tev  '
	IF (CHAR8(4).NE.'no       ') TYPE 430,4,CHAR8(4),'no       '
420	FORMAT(' ?Error 410. CHAR8('I1')='A9', should = 'A9)

C	Read from

	CHAR10(1)='ABC1234ABC'
	CHAR10(2)='5678DEF901'
	CHAR10(3)='GHI234JKLI'
	CHAR2='****'

	READ (UNIT=CHAR10,FMT=430) CHAR1,K3,CHAR2(2:4),
	1 K4,CHAR11,CHAR12
430	FORMAT(A3,X,I3,A3,/,T2,I2,2x,A1/,A2)

	IF (CHAR1 .NE. 'ABC ') TYPE 440, CHAR1
	IF (K3 .NE. 234) TYPE 450, K3
	IF (CHAR2 .NE. '*ABC') TYPE 460, CHAR2
	IF (K4 .NE. 67) TYPE 470, K4
	IF (CHAR11 .NE. 'E ') TYPE 480, CHAR11
	IF (CHAR12 .NE. 'GH') TYPE 490, CHAR12
440	FORMAT(' ?Error 440.  CHAR1 = 'A4', should = '' ABC''')
450	FORMAT(' ?Error 450.  K3 = 'I3', should = 234')
460	FORMAT(' ?Error 460.  CHAR2 = 'A4', should = ''*ABC''')
470	FORMAT(' ?Error 470.  K4 = 'I4', should = 67')
480	FORMAT(' ?Error 480.  CHAR11 = 'A2', should = '' E''')
490	FORMAT(' ?Error 490.  CHAR12 = 'A2', should = ''GH''')

	STOP 'Internal files'
	END