Google
 

Trailing-Edge - PDP-10 Archives - bb-d857a-sm_dx_tops20_v1_src - 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