Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
fortran/test/intfil.for
There are 9 other files named intfil.for in the archive. Click here to see a list.
PROGRAM INTFIL
C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
C OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
C
C COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983
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