Trailing-Edge
-
PDP-10 Archives
-
bb-4157j-bm_fortran20_v11_16mt9
-
fortran-test/rmsio.for
There are no other files named rmsio.for in the archive.
PROGRAM RMSIO
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
!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.
! Basic RMS I/O test.
DOUBLE PRECISION D,DD
!--- Data to be written out.
I=1234; X=456.789; D=123456789.0123
!--- SEQUENTIAL ASCII I/O--SEQUENTIAL ORGANIZATION,FIXED RECORDTYPE
OPEN(30,MODE='ASCII',ACCESS='SEQUENTIAL',RECORD SIZE=40,
1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='FIXED')
100 WRITE(30,105) D
WRITE(30,106) I
WRITE(30,107) X
CLOSE(30)
OPEN(30,MODE='ASCII',ACCESS='SEQUENTIAL',RECORD SIZE=40,
1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='FIXED')
READ(30,105) DD
READ(30,106) II
READ(30,107) XX !Read back in
105 FORMAT(D)
106 FORMAT(I)
107 FORMAT(F)
IF (I.NE.II) TYPE 110,I,II !Check results
IF (X.NE.XX) TYPE 120,X,XX
IF (D.NE.DD) TYPE 130,D,DD
110 FORMAT(' ?Error line 100. SEQUENTIAL I/O.',/
1 ' I='I' II='I)
120 FORMAT(' ?Error line 100. SEQUENTIAL I/O.',/
1 ' X='F' XX='F)
130 FORMAT(' ?Error line 100. SEQUENTIAL I/O.',/
1 ' D='D' DD='D)
CLOSE(30)
!--- SEQUENTIAL ASCII I/O--SEQUENTIAL ORGANIZATION,VARIABLE RECORDTYPE
OPEN(32,MODE='ASCII',ACCESS='SEQINOUT',
1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='VARIABLE')
200 WRITE(32,205) D
WRITE(32,206) I
WRITE(32,207) X
CLOSE(32)
OPEN(32,MODE='ASCII',ACCESS='SEQINOUT',
1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='VARIABLE')
READ(32,205) DD
READ(32,206) II
READ(32,207) XX !Read back in
205 FORMAT(D)
206 FORMAT(I)
207 FORMAT(F)
IF (I.NE.II) TYPE 210,I,II !Check results
IF (X.NE.XX) TYPE 220,X,XX
IF (D.NE.DD) TYPE 230,D,DD
210 FORMAT(' ?Error line 200. SEQUENTIAL I/O.',/
1 ' I='I' II='I)
220 FORMAT(' ?Error line 200. SEQUENTIAL I/O.',/
1 ' X='F' XX='F)
230 FORMAT(' ?Error line 200. SEQUENTIAL I/O.',/
1 ' D='D' DD='D)
CLOSE(32)
!--- RANDOM ASCII I/O--RELATIVE ORGANIZATION,FIXED RECORDTYPE
OPEN(33,MODE='ASCII',ACCESS='RANDOM',RECORD SIZE=40,
1 ORGANIZATION='RELATIVE',RECORDTYPE='FIXED')
300 WRITE(33'3,305) D
WRITE(33'1,306) I
WRITE(33'2,307) X
CLOSE(33)
OPEN(33,MODE='ASCII',ACCESS='RANDOM',RECORD SIZE=40,
1 ORGANIZATION='RELATIVE',RECORDTYPE='FIXED')
READ(33'2,307) XX !Read back in
READ(33'3,305) DD
READ(33'1,306) II
305 FORMAT(D)
306 FORMAT(I)
307 FORMAT(F)
IF (I.NE.II) TYPE 310,I,II !Check results
IF (X.NE.XX) TYPE 320,X,XX
IF (D.NE.DD) TYPE 330,D,DD
310 FORMAT(' ?Error line 300. RANDOM I/O.',/
1 ' I='I' II='I)
320 FORMAT(' ?Error line 300. RANDOM I/O.',/
1 ' X='F' XX='F)
330 FORMAT(' ?Error line 300. RANDOM I/O.',/
1 ' D='D' DD='D)
CLOSE(33)
!--- RANDOM ASCII I/O--RELATIVE ORGANIZATION,VARIABLE RECORDTYPE
OPEN(34,MODE='ASCII',ACCESS='RANDOM',RECORD SIZE=40,
1 ORGANIZATION='RELATIVE',RECORDTYPE='VARIABLE')
400 WRITE(34'3,405) D
WRITE(34'1,406) I
WRITE(34'2,407) X
CLOSE(34)
OPEN(34,MODE='ASCII',ACCESS='RANDOM',RECORD SIZE=40,
1 ORGANIZATION='RELATIVE',RECORDTYPE='VARIABLE')
READ(34'2,407) XX !Read back in
READ(34'3,405) DD
READ(34'1,406) II
405 FORMAT(D)
406 FORMAT(I)
407 FORMAT(F)
IF (I.NE.II) TYPE 410,I,II !Check results
IF (X.NE.XX) TYPE 420,X,XX
IF (D.NE.DD) TYPE 430,D,DD
410 FORMAT(' ?Error line 400. RANDOM I/O.',/
1 ' I='I' II='I)
420 FORMAT(' ?Error line 400. RANDOM I/O.',/
1 ' X='F' XX='F)
430 FORMAT(' ?Error line 400. RANDOM I/O.',/
1 ' D='D' DD='D)
CLOSE(34)
!--- Image Sequential I/O. SEQUENTIAL ORGANIZATION, FIXED RECORDTYPE
OPEN(35,MODE='IMAGE',ACCESS='SEQOUT',RECL=50,
1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='FIXED')
500 WRITE(35) I,X,D
CLOSE(35)
OPEN(35,MODE='IMAGE',ACCESS='SEQIN',RECL=50,
1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='FIXED')
READ(35) II,XX,DD
IF (I.NE.II) TYPE 510,I,II
IF (X.NE.XX) TYPE 520,X,XX
IF (D.NE.DD) TYPE 530,D,DD
510 FORMAT(' ?Error line 500. IMAGE I/O.',/
1 ' I='I' II='I)
520 FORMAT(' ?Error line 500. IMAGE I/O.',/
1 ' X='F' XX='F)
530 FORMAT(' ?Error line 500. IMAGE I/O.',/
1 ' D='D' DD='D)
CLOSE(35)
!--- Image Sequential I/O. SEQUENTIAL ORGANIZATION, VARIABLE RECORDTYPE
OPEN(36,MODE='IMAGE',ACCESS='SEQOUT',
1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='VARIABLE')
600 WRITE(36) I,X,D
CLOSE(36)
OPEN(36,MODE='IMAGE',ACCESS='SEQIN',
1 ORGANIZATION='SEQUENTIAL',RECORDTYPE='VARIABLE')
READ(36) II,XX,DD
IF (I.NE.II) TYPE 610,I,II
IF (X.NE.XX) TYPE 620,X,XX
IF (D.NE.DD) TYPE 630,D,DD
610 FORMAT(' ?Error line 600. IMAGE I/O.',/
1 ' I='I' II='I)
620 FORMAT(' ?Error line 600. IMAGE I/O.',/
1 ' X='F' XX='F)
630 FORMAT(' ?Error line 600. IMAGE I/O.',/
1 ' D='D' DD='D)
CLOSE(36)
!--- Image Random I/O. RELATIVE ORGANIZATION, FIXED RECORDTYPE
OPEN(37,MODE='IMAGE',ACCESS='RANDOM',RECORD SIZE=50,
1 ORGANIZATION='RELATIVE',RECORDTYPE='FIXED')
700 WRITE(37'2) I
WRITE(37'1) X
WRITE(37'3) D
CLOSE(37)
OPEN(37,MODE='IMAGE',ACCESS='RANDOM',RECORD SIZE=50,
1 ORGANIZATION='RELATIVE',RECORDTYPE='FIXED')
READ(37'3) DD !Read back in
READ(37'2) II
READ(37'1) XX
IF (I.NE.II) TYPE 710,I,II !Check results
IF (X.NE.XX) TYPE 720,X,XX
IF (D.NE.DD) TYPE 730,D,DD
710 FORMAT(' ?Error line 700. Image RANDOM I/O.',/
1 ' I='I' II='I)
720 FORMAT(' ?Error line 700. Image RANDOM I/O.',/
1 ' X='F' XX='F)
730 FORMAT(' ?Error line 700. Image RANDOM I/O.',/
1 ' D='D' DD='D)
CLOSE(37)
!--- Image Random I/O. RELATIVE ORGANIZATION, VARIABLE RECORDTYPE
OPEN(38,MODE='IMAGE',ACCESS='RANDOM',RECORD SIZE=50,
1 ORGANIZATION='RELATIVE',RECORDTYPE='VARIABLE')
800 WRITE(38'2) I
WRITE(38'1) X
WRITE(38'3) D
CLOSE(38)
OPEN(38,MODE='IMAGE',ACCESS='RANDOM',RECORD SIZE=50,
1 ORGANIZATION='RELATIVE',RECORDTYPE='VARIABLE')
READ(38'3) DD !Read back in
READ(38'2) II
READ(38'1) XX
IF (I.NE.II) TYPE 810,I,II !Check results
IF (X.NE.XX) TYPE 820,X,XX
IF (D.NE.DD) TYPE 830,D,DD
810 FORMAT(' ?Error line 800. Image RANDOM I/O.',/
1 ' I='I' II='I)
820 FORMAT(' ?Error line 800. Image RANDOM I/O.',/
1 ' X='F' XX='F)
830 FORMAT(' ?Error line 800. Image RANDOM I/O.',/
1 ' D='D' DD='D)
CLOSE(38)
STOP
END