Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
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, 1985
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