Trailing-Edge
-
PDP-10 Archives
-
BB-D875A-SM
-
dx/sources/fsubs1.for
There is 1 other file named fsubs1.for in the archive. Click here to see a list.
C PACKAGE : DX/TOPS20
C VERSION : V1.0
C OP. SYSTEM : TOPS20 V3.0
C
C PROGRAM : WFLX
C MODULE : FSUBS1.FOR
C MODULE # : 16 OF 17
C EDIT : 002
C EDIT DATE : 14-AUG-78
C
C
C
C**********************************************************************
C
C C O P Y R I G H T
C
C
C COPYRIGHT (C) 1978
C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS
C
C
C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
C SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE
C INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR
C ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE
C MADE AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH
C SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO
C AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN
C DIGITAL.
C
C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
C NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
C EQUIPMENT CORPORATION.
C
C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
C OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
C
C**********************************************************************
C
C
C E D I T H I S T O R Y
C
C
C EDIT #000 5/4/78 GARTH REID
C INITIAL IMPLEMENTATION.
C
C EDIT #001 5/8/78 J. COHEN
C INITIAL CHANGES FOR TOPS20.
C
C EDIT #002 8/14/78 J. COHEN
C ADD SUBROUTINE DEC WHICH WILL DECODE THE NUMBER OF RANDOM
C ACCESS RECORDS IN THE HEADER AND PLACE THE RESULT IN AN
C INTEGER VARIABLE.
C
C********************************************************************
C
C
C
SUBROUTINE GETNUM(K,LEN)
INCLUDE 'SPCFLX.FTN'
C
C GETNUM SCANS 'TTYIN' ACCEPTING ONLY NUMERICS UNTIL A
C COMMA, SEMICOLON, OR SPACE IS ENCOUNTERED. A MAXIMUM
C OF FOUR NUMERICS CAN BE ACCEPTED AND CONVERTED INTO
C AN INTEGER.
C
C CALLING PROCEDURE:
C
C CALL GETNUM(K,LEN)
C
C WHERE:
C
C LEN IS THE NUMBER OF CHARACTERS IN 'TTYIN'
C K WILL ACCEPT THE INTEGER VALUE
C
C
K = 0
OK = .TRUE.
DO 10 I = IPOS,IPOS+4
IF (TTYIN(I) .EQ. 0 .OR.
1 TTYIN(I) .EQ. 59 .OR.
2 TTYIN(I) .EQ. 44) GO TO 20
IF (TTYIN(I) .LT. "060 .OR.
1 TTYIN(I) .GT. "071) GO TO 30
K = K * 10 + (TTYIN(I) - "60)
10 CONTINUE
C
C IF WE FALL THROUGH THE DO LOOP, MORE THAN FOUR NUMERICS WERE
C TYPED.
C
30 OK = .FALSE.
RETURN
20 IF (I .EQ. IPOS) GO TO 30
IPOS = I + 1
RETURN
END
SUBROUTINE AOUT
INCLUDE 'SPCFLX.FTN'
C
C
C
C S U B R O U T I N E A O U T
C
C
C AOUT puts the characters in buffer A out to the disk file.
C
IF (ACNT .EQ. 0) RETURN
DO 10 I = 1,ACNT
OUTCHR = A(I)
CALL WP8OUT
10 CONTINUE
ACNT = 0
RETURN
END
SUBROUTINE DEFRUL
INCLUDE 'SPCFLX.FTN'
C
C INITI