Google
 

Trailing-Edge - PDP-10 Archives - BB-R775B-BM - source/fd32t1.vax-for
There are 2 other files named fd32t1.vax-for in the archive. Click here to see a list.
C FD32T1
C	This program opens a remote  file named DAP.TST and writes  an
C	ASCII record into it,  closes the file,  reopens the file  and
C	reads the record back and then closes the file again.

C
C           COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982, 1983
C
C This software  is furnished  under a  license and  may be  used  and
C copied only in accordance  with the terms of  such license and  with
C the inclusion of the above  copyright notice.  This software or  any
C other copies thereof may not be provided or otherwise made available
C to any other person.  No title  to and ownership of the software  is
C hereby 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

C
C Facility: DIT-TEST
C 
C Edit History:
C 
C new_version (1, 0)
C 
C Edit (%O'1', '15-Dec-82', 'Sandy Clemens')
C %(  Add the DIT (Dap and Task-to-task) Installation Verification tests
C     for the VAX and DECSYSTEM-20 to the library.  
C     Files:  DITTHST.TXT (NEW), CD32T1.VAX-COB (NEW),
C     CT32T1.VAX-COB (NEW), FD32T1.VAX-FOR (NEW),
C     FT32T1.VAX-FOR (NEW), CD36T1.CBL (NEW), CT36T1.CBL (NEW),
C     FD6T1.FOR (NEW), FD7T1.FOR (NEW), FT6T1.FOR (NEW),
C     FT7T1.FOR (NEW) )%
C     
C Edit (%O'2', '14-Jan-83', 'Sandy Clemens')
C %(  Many edits to the Installation Verification system (ICS)  files.
C     Add SYS:  to all  the  10/20 programs  in  the COPY  or  INCLUDE
C     statement for the interface files.   Add SYS$LIBRARY to the  VAX
C     programs in  the COPY  or INCLUDE  statement for  the  interface
C     files.  Add check for INFO or  SUCCESS status return in all  ICS
C     programs.  Remove node names from all DIT programs so that local
C     node is used.  Change  directory used by 20  DAP programs to  be
C     PS:<DIL-TEST> with  password  DIL-TEST.   Remove  all  directory
C     specifications  from  VMS  programs  so  they  use  the  default
C     connected directory.   Add Lib$Match_Cond  to VMS  programs  for
C     status checking.  Change some of the symbolic variable names for
C     clarification.   Change  use  of  numeric  parameter  values  to
C     symbolic variable names.  Get rid  of use of "IMPLICIT  INTEGER"
C     in FORTRAN test programs.   Add copyright notice to  everything.
C     
C     Files: CD32T1.VAX-COB,  CD36T1.CBL, CT32T1.VAX-COB,  CT36T1.CBL,
C     FD32T1.VAX-FOR, FD6T1.FOR, FD7T1.FOR, FT32T1.VAX-FOR, FT6T1.FOR,
C     FT7T1.FOR, DITTHST.TXT )%
C     
C Edit (%O'6', '25-Jan-83', 'Sandy Clemens')
C %(  Add copyright and liability waiver to whatever needs it.
C     FILES: CD32T1.VAX-COB, CD36T1.CBL, CT32T1.VAX-COB, CT36T1.CBL,
C     FD32T1.VAX-FOR, FD6T1.FOR, FD7T1.FOR, FT32T1.VAX-FOR, FT6T1.FOR,
C     FT7T1.FOR, SUB6D1.FOR, SUB6T1.FOR, SUB7D1.FOR, SUB7T1.FOR  )%


C Include the DIL interface files
	INCLUDE 'SYS$LIBRARY:DIL.TLB (DIT$FORTRAN)'
	INCLUDE 'SYS$LIBRARY:DIL.TLB (DIL$FORTRAN)'

C File and directory description fields

	INTEGER FNAME (10), USERID (10), PASSWD (10), ACCT (10), FILNUM

C Sending and receiving data records
	INTEGER DATA1 (25), DATA2 (25)

C DIL Status code
	INTEGER DILSTS

C Record size and record unit size
	INTEGER RSIZE, RUNTSZ


	DATA FNAME /'DAP.', 'TST ', '    ', '    ', '    ',
	1	'    ', '    ', '    ', '    ', '    '/
C Note: For remote file access on the VAX, if you leave the userid and
C passwd blank, the connected directory will be used
	DATA USERID /'    ', '    ', '    ', '    ','    ',
	1	'    ', '    ', '    ', '    ', '    '/
	DATA PASSWD /'    ', '    ', '    ', '    ', '    ',
	1	'    ', '    ', '    ', '    ', '    '/
	DATA ACCT /'    ', '    ', '    ', '    ', '    ',
	1	'    ', '    ', '    ', '    ', '    '/

C Program messages

200	FORMAT (' ROPEN status return: ', I10)
201	FORMAT (' RWRITE status return: ', I10)
202	FORMAT (' RCLOSE status return: ', I10)
203	FORMAT (' RREAD status return: ', I10)
700	FORMAT ('? Invalid status returned... ')

C Open file DAP.TST for output.

	RUNTSZ = 0
	RSIZE = 100

	DILSTS = DIT$ROPEN (FILNUM, FNAME, USERID, PASSWD, ACCT,
	1	DIT$K_MODE_WRITE, DIT$K_TYPE_ASCII, DIT$K_RFM_STREAM,
	2	DIT$K_UNSPECIFIED, RSIZE, RUNTSZ)
	WRITE (6,200) DILSTS
	IF (DILSTS .EQ. SS$_NORMAL) GO TO 100
	WRITE (6,700)
	STOP

C Accept a record and write it to the file

101	FORMAT (' Enter data for the record: ')
100	WRITE (6,101)
102	FORMAT (25A4)
	ACCEPT 102, DATA1

	DILSTS = DIT$RWRITE (FILNUM, RUNTSZ, RSIZE, DATA1)

	WRITE (6,201) DILSTS
	IF (DILSTS .EQ. SS$_NORMAL) GO TO 103
	WRITE (6,700)
	STOP

C Close the file.

103	DILSTS = DIT$RCLOSE (FILNUM, DIT$K_OPT_NOTHING)

	WRITE (6,202) DILSTS
	IF (DILSTS .EQ. SS$_NORMAL) GO TO 104
	WRITE (6,700)
	STOP

104	DILSTS = DIT$ROPEN (FILNUM, FNAME, USERID, PASSWD, ACCT,
	1	DIT$K_MODE_READ, DIT$K_TYPE_ASCII, DIT$K_RFM_STREAM,
	2	DIT$K_RAT_UNSPECIFIED, RSIZE, RUNTSZ)

	WRITE (6,200) DILSTS
	IF (DILSTS .EQ. SS$_NORMAL) GO TO 105
	WRITE (6,700)
	STOP

C Read the record

105	DILSTS = DIT$RREAD (FILNUM, RUNTSZ, RSIZE, DATA2)

	WRITE (6,203) DILSTS
	IF (DILSTS .EQ. SS$_NORMAL) GO TO 106
	WRITE (6,700)
	STOP

107	FORMAT (' The record read was: ')
106	WRITE (6,107)
301	FORMAT (' ', 25A4)
	WRITE (6,301) DATA2

C Close the file

	DILSTS = DIT$RCLOSE (FILNUM, DIT$K_OPT_NOTHING)

	WRITE (6,202) DILSTS
	IF (DILSTS .EQ. SS$_NORMAL) GO TO 108
	WRITE (6,700)
	STOP

109	FORMAT (' ** FD32T1 test successful ** ')
108	WRITE (6,109)
	STOP
	END