INTEGER FUNCTION ZNEG*2(INDEX) INCLUDE 'VKLUGPRM.FTN' C PARAMETER RRW = 32 C PARAMETER RCL = 32 C RRW=MAX REAL ROWS C RCL=MAX REAL COLS C RRW MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS C VBLS AND TYPE DIMENSIONED RRW,RCL 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 C INTEGER FUNCTION ZNEG*2(INDEX) REAL*8 REAL C INTEGER*4 INT C INTEGER*2 TYPE(RRW,RCL),VLEN(9),INDEX C LOGICAL*1 AVBLS(100,27),FOUR(4),EIGHT(8) LOGICAL*1 VBLS(8,RRW,RCL) C EQUIVALENCE (EIGHT,REAL),(FOUR,INT) C COMMON/V/ TYPE,AVBLS,VBLS,VLEN C C C C C C DEFAULT SETTING OF TRUE ZNEG=1 K=TYPE(INDEX,1) 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(AVBLS(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)=AVBLS(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)=AVBLS(I,INDEX) IF(INT.LE.0)GO TO 10000 GO TO 9998 C C C MULTIPLE PRECISION 400 IF(AVBLS(100,INDEX).NE.0) GOTO 10000 GO TO 9998 C C C 9998 ZNEG=0 10000 RETURN END