c************
c  Description:	Main routines for Array Operator facilities
c
c  Author:	JGS 8/95
c
c  $Revision: 1.3 $
c  $Modtime:   11 Sep 1995 14:26:22  $
c
c************

	function M$AOP_FIND (op,symbol,modes,type)

	implicit none
	include 'types.inc'
	include 'aop.inc'
	include 'aopdef.inc'		! file generated by AOPMAKE
	record /AOPSTRUCT/ op
	character symbol*(*),modes*(*),type
	character symc*8,tmp*8
	integer*4 n,indx,ls,lm,i,ioff

	M$AOP_FIND = P_AOP_INVALID
	symc = symbol
	ls = INDEX(symc,' ')
	if (ls.eq.0) return	! all valid OPS are <= 7chars
	symc(ls:ls) = ','
	lm = INDEX(modes,' ')-1
	if (lm.eq.-1) lm = LEN(modes)

	do n = 1,L_maxaop
	  if (aopdef(n)(1:1) .eq. symc(1:1) .and.	! speed up search
     &	      aopdef(n)(1:ls) .eq. symc(1:ls)) then
	    M$AOP_FIND = P_AOP_BADSTK
	    op.outputs = 1
	    op.type = type
	    op.class = 1
	    op.inplace = 1
	    i = M$PARSE(aopdef(n),5,tmp)
	    if (i.gt.0) then
	      if (tmp.eq.'ALIAS') then
		ls = M$PARSE(aopdef(n),6,symc)+1
		symc(ls:ls) = ','
		goto 9
	      endif
	      op.outputs = ICHAR(tmp(1:1)) - 48
	      if (tmp(2:2).ne.'#') op.type = tmp(2:2)
	      op.class = ICHAR(tmp(3:3)) - 48
	      if (tmp(4:4).eq.'N') op.inplace = 0
	    endif
	    i = M$PARSE(aopdef(n),2,tmp) - op.outputs
	    if (lm.ge.i) then
	     M$AOP_FIND = P_AOP_BADMODE
	     if (tmp(1:i) .eq. modes(lm-i+1:lm)) then
	      M$AOP_FIND = P_AOP_BADTYPE
	      op.inputs = i
	      op.mode = tmp(i+1:i+1)
	      i = M$PARSE(aopdef(n),3,tmp)
	      ioff = INDEX(tmp(1:i),type)
	      if (ioff.gt.0) then
	        i = M$PARSE(aopdef(n),6,tmp)
		if (i.eq.1) then
		  indx = ICHAR(tmp(1:1))-48
		elseif (i.eq.2) then
		  indx = 10*(ICHAR(tmp(1:1))-48) + ICHAR(tmp(2:2))-48
		else
		  read (tmp(1:i),*) indx
		endif
		indx = indx+ioff
	        i = M$PARSE(aopdef(n),4,tmp)
		op.precedence = ICHAR(tmp(1:1))-48
		op.index = indx
		op.func.p = M$AOP_ADDR (indx)
		if (op.func.p .eq. 0) call M$ERROR
     &		  ('Bad index into AOP functions')
		M$AOP_FIND = P_AOP_VALID
		return
	      endif
	     endif
	    endif
	  endif
  9	  continue
	enddo
	return
	end


#if _64BIT
	integer*8 function M$AOP_ADDR (indx)
#else
	integer*4 function M$AOP_ADDR (indx)
#endif
	include 'aopaddr.inc'		! file generated by AOPMAKE
	M$AOP_ADDR = 0
	if (indx.le.0) then
! jph -- change for Portland Group compiler to work
!	include 'aopaddr.for'		! file generated by AOPMAKE
#include "aopaddr.forp"
	endif
	return
	end

	subroutine M$AOP_ERROR (errno,mode)
	integer*4 errno,mode
	character*40 errstr
	if (errno.eq.-1) then
	  errstr = 'Divide by zero check'
	elseif (errno.eq.-2) then
	  errstr = 'Log of negative number check'
	else
	  errstr = 'Unrecognized error number'
	endif
	if (mode.eq.0) then
	   call M$WARNING (errstr//' in M$AOP routine')
	elseif (mode.eq.1) then
	   call M$ERROR (errstr//' in M$AOP routine')
	endif
	return
	end

	function M$AOP (op,n,v1,k1,v2,k2,v3,k3,v4,k4)
	include 'types.inc'
	include 'aop.inc'
	record /AOPSTRUCT/ op
	M$AOP = M$AOPF (%val(op.func.p),n,v1,k1,v2,k2,v3,k3,v4,k4)
	return
	end

	function M$AOPF (func,n,v1,k1,v2,k2,v3,k3,v4,k4)
	external func
	integer*4 errno
	common /AOPERROR/ errno
	call func (n,v1,k1,v2,k2,v3,k3,v4,k4)
	M$AOPF = errno
	return
	end

