Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-BB_1985_short
-
ascii.for
There are 11 other files named ascii.for in the archive. Click here to see a list.
PROGRAM ASCII
!COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985
!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.
! Version 7 ASCII.FOR
! Basic ASCII I/O test.
DOUBLE PRECISION D,DD,DHIGH,DLOW
COMPLEX COMP1,COMP2
LOGICAL LOG1,LOG2
DOUBLE PRECISION DVAR1,DVAR2
!--- Data to be written out.
I=1234; X=456.789; D=123456789.0123
XLOW=456.7885; XHIGH=456.7895
DLOW=123456789.012299995; DHIGH=123456789.012300005
!--- No OPEN statement (Implicit OPEN)
100 WRITE(20,105) I,X,D
CLOSE(20)
READ(20,105) II,XX,DD
IF (I.NE.II) TYPE 110,I,II
IF (XX.LT.XLOW .OR. XX.GT.XHIGH) TYPE 120,X,XX
IF (DD.LT.DLOW .OR. DD.GT.DHIGH) TYPE 130,D,DD
105 FORMAT(I,F,D)
110 FORMAT(' ?Error line 100. Implicit OPEN.',/
1 ' I='I' II='I)
120 FORMAT(' ?Error line 100. Implicit OPEN.',/
1 ' X='F' XX='F)
130 FORMAT(' ?Error line 100. Implicit OPEN.',/
1 ' D='D' DD='D)
!--- OPEN statement, no MODE= specified.
OPEN(UNIT=21)
200 WRITE(21,205) I,X,D
CLOSE(21)
OPEN(UNIT=21)
READ(21,205) II,XX,DD
IF (I.NE.II) TYPE 210,I,II
IF (XX.LT.XLOW .OR. XX.GT.XHIGH) TYPE 220,X,XX
IF (DD.LT.DLOW .OR. DD.GT.DHIGH) TYPE 230,D,DD
205 FORMAT(I,F,D)
210 FORMAT(' ?Error line 200. Default OPEN statement.',/
1 ' I='I' II='I)
220 FORMAT(' ?Error line 200. Default OPEN statement.',/
1 ' X='F' XX='F)
230 FORMAT(' ?Error line 200. Default OPEN statement.',/
1 ' D='D' DD='D)
CLOSE(UNIT=21)
!--- OPEN statement with MODE= and ACCESS= specified.
OPEN(22,MODE='ASCII',ACCESS='SEQOUT')
300 WRITE(22,305) I,X,D
CLOSE(22)
OPEN(22,MODE='ASCII',ACCESS='SEQIN')
READ(22,305)
IF (I.NE.II) TYPE 310,I,II
IF (XX.LT.XLOW .OR. XX.GT.XHIGH) TYPE 320,X,XX
IF (DD.LT.DLOW .OR. DD.GT.DHIGH) TYPE 330,D,DD
305 FORMAT(I,F,D)
310 FORMAT(' ?Error line 300. MODE= and ACCESS=.',/
1 ' I='I' II='I)
320 FORMAT(' ?Error line 300. MODE= and ACCESS=.',/
1 ' X='F' XX='F)
330 FORMAT(' ?Error line 300. MODE= and ACCESS=.',/
1 ' D='D' DD='D)
CLOSE(22)
!--- One of each variable type in I/O
COMP1=(1.5,-1.5)
LOG1=.TRUE.
IVAR1=21
DVAR1=20.5555555555D0
RVAR1=19.5
WRITE(23,400) COMP1,LOG1,IVAR1,DVAR1,RVAR1
400 FORMAT(F,F,L,I,D,F)
CLOSE(23)
READ(23,400) COMP2,LOG2,IVAR2,DVAR2,RVAR2
CLOSE(23)
IERR='Complx'
IF (COMP2 .NE. COMP1) TYPE 410, IERR,COMP1,COMP2
IERR='Logicl'
IF (LOG2 .NE. LOG1) TYPE 410, IERR,LOG1,LOG2
IERR='Integr'
IF (IVAR2 .NE. IVAR1) TYPE 410, IERR,IVAR1,IVAR2
IERR='D Prec'
IF (DVAR2 .NE. DVAR1) TYPE 410, IERR,DVAR1,DVAR2
IERR='Real'
IF (RVAR2 .NE. RVAR1) TYPE 410, IERR,RVAR1,RVAR2
410 FORMAT(' ?Error 410. 'A5' type variables 'GGGG)
STOP 'ASCII I/O test'
END