Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
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