C	SUBROUTINE TO PERFORM AN OPERATION ON THE TOP OF THE STACK
C
C  Submitted by:
C  
C  	R. N. Stillwell
C  	Institute for Lipid Research
C  	Baylor College of Medicine
C  	Houston, Texas 77030
C  	
C  (who would be glad to receive comments, suggestions, bug fixes, etc., but
C  who promises no support whatever).
C  
C  Literature reference:
C  
C  	R. N. Stillwell.  A low-overhead laboratory data management system
C  	for the PDP11.  Comput. Biomed. Res., 15, 29-38(1982).
C  
C  Acknowledgement:
C
C  	This software was developed under National Institutes of Health grants
C  	GM-13901 and GM-26611.
C 
C  General permission is hereby granted to copy, modify, or distribute this
C  program, but not for profit.  Copyright to this software is and shall
C  remain in the public domain.
C
C	REVISED JAN 1982: SEQUENCE OF COMPUTED GOTO ALTERED TO FIT
C	NEW ORDER OF ATSYM IN EVAL
C
	SUBROUTINE DOIT(ATOM,ISTACK,STACK,MAXSTK,STKERR,OPERR)
	LOGICAL*1 STKERR,OPERR
	LOGICAL*1 LOGIC1,LOGIC2
C
	INTEGER ATOM
C
C	ATOM MUST BE AN INTEGER WITH ONE OF THE FOLLOWING VALUES:
C
C	DATA ADD,SUBTR,MUL,DIV,IDIV,MOD,LESSEQ,GREQ,NOTEQ,
C	1 LESS,GREAT,EQU,LAND,LOR,MINUS,NOT,ABSF
C	1 /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17/
C
C	MINSTK IS 2 FOR BINARY OPERATORS, 1 FOR UNARY
	INTEGER MINSTK(17)
	DATA MINSTK /14*2,3*1/
C
	DATA NATOM/17/
	REAL*4 STACK(MAXSTK)
	INTEGER ISTACK
C
D	WRITE (5,9901) ATOM,ISTACK,(STACK(I),I=1,ISTACK)
D9901	FORMAT (' ENTERING DOIT WITH ATOM, ISTACK,STACK:',2I7/(4G15.5))
	STKERR = .FALSE.
	OPERR = .FALSE.
C
C	CHECK FOR INVALID ATOM
	IF (ATOM.LE.0 .OR. ATOM.GT.NATOM) REPORT-OPERATOR-ERROR
C
C	CHECK STACK
	ISTACK = ISTACK-MINSTK(ATOM)+1
	IF (ISTACK.LT.1) REPORT-STACK-ERROR
C
C	CASE (ATOM)
	GOTO (1,2,13,14,3,4,5,6,7,8,9,10,11,12,15,16,17),ATOM
C
C	(OTHERWISE)
	REPORT-OPERATOR-ERROR
	RETURN
C
C	NORMAL RETURN
100	CONTINUE
D	WRITE (5,9902) ISTACK,(STACK(I),I=1,ISTACK)
D9902	FORMAT (' LEAVING DOIT WITH STACK:',I7/(4G15.5))
	RETURN
C
C	ADD
1	STACK(ISTACK) = STACK(ISTACK) + STACK(ISTACK+1)
	GO TO 100
C
C	SUBTRACT
2	STACK(ISTACK) = STACK(ISTACK) - STACK(ISTACK+1)
	GO TO 100
C
C	MULTIPLY
3	STACK(ISTACK) = STACK(ISTACK) * STACK(ISTACK+1)
	GO TO 100
C
C	DIVIDE
4	STACK(ISTACK) = STACK(ISTACK) / STACK(ISTACK+1)
	GO TO 100
C
C	INTEGER-DIVIDE
5	STACK(ISTACK) = IFIX(STACK(ISTACK)) / IFIX(STACK(ISTACK+1))
	GO TO 100
C
C
C	MODULO
6	STACK(ISTACK) = AMOD(STACK(ISTACK) , STACK(ISTACK+1))
	GO TO 100
C
C	LESSEQ
7	LOGIC1 = STACK(ISTACK) .LE. STACK(ISTACK+1)
	STACK-LOGICAL
	GO TO 100
C
C	GREQ
8	LOGIC1 = STACK(ISTACK) .GE. STACK(ISTACK+1)
	STACK-LOGICAL
	GO TO 100
C
C	NOTEQ
9	LOGIC1 = STACK(ISTACK) .NE. STACK(ISTACK+1)
	STACK-LOGICAL
	GO TO 100
C
C	LESS
10	LOGIC1 = STACK(ISTACK) .LT. STACK(ISTACK+1)
	STACK-LOGICAL
	GO TO 100
C
C	GREAT
11	LOGIC1 = STACK(ISTACK) .GT. STACK(ISTACK+1)
	STACK-LOGICAL
	GO TO 100
C
C	EQU
12	LOGIC1 = STACK(ISTACK) .EQ. STACK(ISTACK+1)
	STACK-LOGICAL
	GO TO 100
C
C	LAND
13	LOGIC1 = STACK(ISTACK) .NE. 0.0
	LOGIC2 = STACK(ISTACK+1) .NE. 0.0
	LOGIC1 = LOGIC1 .AND. LOGIC2
	STACK-LOGICAL
	GO TO 100
C
C	LOR
14	LOGIC1 = STACK(ISTACK) .NE. 0.0
	LOGIC2 = STACK(ISTACK+1) .NE. 0.0
	LOGIC1 = LOGIC1 .OR. LOGIC2
	STACK-LOGICAL
	GO TO 100
C
C	MINUS
15	STACK(ISTACK) = -STACK(ISTACK)
	GO TO 100
C
C	NOT
16	LOGIC1 = STACK(ISTACK) .NE. 0.0
	LOGIC1 = .NOT. LOGIC1
	STACK-LOGICAL
	GO TO 100
C
C	ABS
17	STACK(ISTACK) = ABS(STACK(ISTACK))
	GO TO 100
C
	TO REPORT-OPERATOR-ERROR
	OPERR = .TRUE.
	RETURN
	FIN
	TO REPORT-STACK-ERROR
	STKERR = .TRUE.
	RETURN
	FIN
	TO STACK-LOGICAL
	WHEN (LOGIC1) STACK(ISTACK) = -1.0
	ELSE          STACK(ISTACK) =  0.0
	FIN
	END