Google
 

Trailing-Edge - PDP-10 Archives - FORTRAN-10_Alpha_31-jul-86 - chario.for
There are 9 other files named chario.for in the archive. Click here to see a list.
	PROGRAM CHARIO

C COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1983, 1986
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	CDM
C	November 1981

C	Simple test for character IO, testing Forots to make
C	sure that character I/O is done.

	CHARACTER CHAR1*7,CHAR2*7
	CHARACTER CHAR3(4)*6
	CHARACTER CHAR4(1)*4,CHAR5(-2:0)*10

	CHARACTER CHAR30*8,CHAR31(-3:-2)*8, CHAR32(2)*5,CHAR33*7
	CHARACTER CHAR34(4)*9

C Formatted I/O.
C Uses FOR20.DAT for reading and writing.

	CHAR1='ABCDEFG'
	WRITE(20,100) CHAR1
100	FORMAT(A7)
	CLOSE(20)
	READ(20,100) CHAR2

	IF (CHAR2 .NE. 'ABCDEFG') WRITE 110,CHAR2,CHAR1
110	FORMAT(' ?Error 110.  CHAR1='''A7''', should = '''A7'''')

C Formatted I/O with SLIST's

	CHAR3(1)='Now is'
	CHAR3(2)=' the t'
	CHAR3(3)='ime fo'
	CHAR3(4)='r all '

	OPEN(21,FILE='CHARIO.DAT')
	WRITE(21,200) CHAR3
200	FORMAT(4A6)
	CLOSE(21)

	OPEN(22,FILE='CHARIO.DAT')
	READ(22,210) CHAR4(1),CHAR5
210	FORMAT(A4,3A10)

	IF (CHAR4(1) .NE. 'Now ') WRITE 220,CHAR4(1)
	IF (CHAR5(-2) .NE. 'is the tim') WRITE 230,CHAR5(-2)
	IF (CHAR5(-1) .NE. 'e for all ') WRITE 240,CHAR5(-1)
	IF (CHAR5(0) .NE. ' ') WRITE 250,CHAR5(0)
220	FORMAT(' ?Error 220. CHAR4(1)= '''A4''', should = ''Now ''')
230	FORMAT(' ?Error 230. CHAR5(-2)='''A10''', should = '
	1 'is the tim''')
240	FORMAT(' ?Error 240. CHAR5(-1)='''A10''', should = '
	1 'e for all ')
250	FORMAT(' ?Error 250. CHAR5(0)='''A10''', should = '' ''')

C-300-	Binary I/O

	CHAR30='MNOPQRST'
	CHAR31(-3)='NEGTWO'
	CHAR31(-2)='NEGTHREE'

	OPEN(23,FILE='CHARIO.DAT',MODE='BINARY')
	WRITE(23) CHAR30,'ABCD',CHAR31
	CLOSE(23)

C	NMOPQRSTABCDNEGTWO  NEGTHREE

	OPEN(23,FILE='CHARIO.DAT',MODE='BINARY')
	I=4
	CHAR34(I)='zyx'
	READ (23) CHAR32,CHAR33,CHAR34(I)(3:)

	IF (CHAR32(1) .NE. 'MNOPQ') TYPE 310, CHAR32(1)
	IF (CHAR32(2) .NE. 'RSTAB') TYPE 320, CHAR32(2)
	IF (CHAR33 .NE. 'CDNEGTW') TYPE 330, CHAR33
	IF (CHAR34(4) .NE. 'zyO  NEGT') TYPE 340, CHAR34(4)
310	FORMAT(' ?Error 310. Is = 'A5', should = ''MNOPQ''')
320	FORMAT(' ?Error 320. Is = 'A5', should = ''RSTNE''')
330	FORMAT(' ?Error 330. Is = 'A7', should = ',
	1 '''CDNEGTW''')
340	FORMAT(' ?Error 340. Is = 'A9', should = ''zyO  NEGT''')

	STOP 'Character I/O'
	END