Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0001/zneg.for
There is 1 other file named zneg.for in the archive. Click here to see a list.
C
C
C
C            COPYRIGHT (c) 1977 BY
C    DIGITAL EQUIPMENT CORPORTATION, MAYNARD, MASS.
C   
C  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
C  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
C  INCLUSION OF THE  ABOVE COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY OTHER
C  COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE  MADE AVAILABLE TO ANY
C  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
C  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 
C
C
C
C
C
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C   +                                                +
C   +            CALC    VERSION  X01-01             +
C   +                                                +
C   +  PETER BAUM  1-SEP-77                          +
C   +  DIGITAL EQUIPMENT CORPORATION                 +
C   +  146 MAIN STREET                               +
C   +  MAYNARD, MASSACHUSETTS  01754                 +
C   +                                                +
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C
C
C **************************************************
C *                                                *
C *        INTEGER*2 FUNCTION ZNEG(INDEX)          *
C *                                                *
C **************************************************
C
C DETERMINES IF VARIABLE POINTED TO BY INDEX IS ZERO OR NEGATIVE
C OR UNDEFINED AS OPPOSED TO BEING DEFINED AND POSITIVE
C
C     RETURNS      1   IF TRUE (ZERO OR NEGATIVE OR UNDEFINED)
C                  0   IF FALSE (POSITIVE)
C
C
C
C
C
C
C ZNEG CALLS ERRMSG TO PRINT ERROR MESSAGES.
C
C
C
C
C ZNEG IS CALLED BY CALC AND CMND.
C
C
C
C
C
C
C   VARIABLE       USE
C
C     INDEX      POINTER TO VARIABLE BEING TESTED
C     I,K        HOLDS TEMPORARY VALUES
C     ZNEG       RETURN VALUE
C     INT        HOLD INTEGER*4 VALUES
C     REAL       HOLD REAL*8 VALUES
C
C
C
	INTEGER FUNCTION ZNEG*2(INDEX)
	REAL*8 REAL
C
	INTEGER*4 INT
C
	INTEGER*2 TYPE(27),VLEN(9)
C
	LOGICAL*1 VBLS(100,27),FOUR(4),EIGHT(8)
C
	EQUIVALENCE (EIGHT,REAL),(FOUR,INT)
C
	COMMON/V/ TYPE,VBLS,VLEN
C
C
C
C
C
C DEFAULT SETTING OF TRUE
	ZNEG=1
	K=TYPE(INDEX)
	IF(K.GT.0)GO TO 50
C
C VARIABLE UNDEFINED
	CALL ERRMSG(16)
	GO TO 10000
C
50	GOTO(100,200,300,300,400,400,400,300,200),K
	STOP 50
C
C
C ASCII
100	IF(VBLS(1,INDEX).LE.0)GO TO 10000
	GO TO 9998
C
C
C DECIMAL AND REAL
200	DO 210 I=1,8
210	EIGHT(I)=VBLS(I,INDEX)
	IF(REAL.LE.0.D0)GO TO 10000
	GO TO 9998
C
C
C INTEGER, HEX, AND OCTAL
300	DO 310 I=1,4
310	FOUR(I)=VBLS(I,INDEX)
	IF(INT.LE.0)GO TO 10000
	GO TO 9998
C
C
C MULTIPLE PRECISION
400	IF(VBLS(100,INDEX).NE.0) GOTO 10000
	GO TO 9998
C
C
C
9998	ZNEG=0
10000	RETURN
	END