Trailing-Edge
-
PDP-10 Archives
-
BB-R775A-BM
-
sources/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