*dk,vorpoint
      subroutine vorpoint(n1,n2,n3,n4,xv,yv,zv,distsq)
       implicit real*8 (a-h,o-z)
C
C #####################################################################
C
C     PURPOSE -
C
C        This routine calculates the 3-D voronoi point
C
C     INPUT ARGUMENTS -
C
C        n1-n4  - the points in the tetrahedron
C
C
C     OUTPUT ARGUMENTS -
C
C        xv     - the x-coordinate of the Voronoi point
C        yv     - the y-coordinate of the Voronoi point
C        zv     - the z-coordinate of the Voronoi point
C        distsq - the Voronoi radius squared
C
C     CHANGE HISTORY -
C
C        $Log: vorpoint.f,v $
C        Revision 2.00  2007/11/09 20:04:06  spchu
C        Import to CVS
C
CPVCS    
CPVCS       Rev 1.4   Mon Apr 14 17:05:54 1997   pvcs
CPVCS    No change.
CPVCS    
CPVCS       Rev 1.3   12/02/94 15:07:22   het
CPVCS    Added an option for the "cmo" access functions
CPVCS    
CPVCS    
CPVCS       Rev 1.2   12/01/94 18:50:00   het
CPVCS    Added a data type to the "cmo" calles 
CPVCS       and added the "cmo.h" include file.
CPVCS    
CPVCS       Rev 1.1   11/17/94 21:56:00   het
CPVCS    Added include files for chydro, neibor, cmerge, comdict. Added calles and
CPVCS    pointer statements for current_mesh_object database access.
CPVCS
CPVCS       Rev 1.0   11/10/94 12:20:20   pvcs
CPVCS    Original version.
C
C ######################################################################
C
      include "cmo.h"
      include "chydro.h"
      include "neibor.h"
C
C ######################################################################
C
      crosx(a,b,c,d,e,f)=b*f-c*e
      crosy(a,b,c,d,e,f)=c*d-a*f
      crosz(a,b,c,d,e,f)=a*e-b*d
C
C ######################################################################
C
C
C
C     ******************************************************************
C     FETCH MESH OBJECT NAME AND POINTER INFORMATION.
C
      if(icmoget.eq.1) then
C
      call cmo_get_name(cmo,ierror)
C
      call cmo_get_info('xic',cmo,ipxic,lenxic,icmotype,ierror)
      call cmo_get_info('yic',cmo,ipyic,lenyic,icmotype,ierror)
      call cmo_get_info('zic',cmo,ipzic,lenzic,icmotype,ierror)
C
      endif
C
C     ******************************************************************
C
C
C
      xxsmall=1.0e-30
      xa=xic(n1)
      ya=yic(n1)
      za=zic(n1)
      xb=xic(n2)-xa
      yb=yic(n2)-ya
      zb=zic(n2)-za
      xc=xic(n3)-xa
      yc=yic(n3)-ya
      zc=zic(n3)-za
      xd=xic(n4)-xa
      yd=yic(n4)-ya
      zd=zic(n4)-za
      xn=crosx(xb,yb,zb,xc,yc,zc)
      yn=crosy(xb,yb,zb,xc,yc,zc)
      zn=crosz(xb,yb,zb,xc,yc,zc)
      x2=crosx(xn,yn,zn,xb,yb,zb)
      y2=crosy(xn,yn,zn,xb,yb,zb)
      z2=crosz(xn,yn,zn,xb,yb,zb)
      q=-0.5*(xc*xb+yc*yb+zc*zb-xc*xc-yc*yc-zc*zc)/
     *       (x2*xc+y2*yc+z2*zc+xxsmall)
      xl=q*x2+0.5*xb
      yl=q*y2+0.5*yb
      zl=q*z2+0.5*zb
      d=-0.5*(xd*xd+yd*yd+zd*zd)
      q=-(xd*xl+yd*yl+zd*zl+d)/(xd*xn+yd*yn+zd*zn+xxsmall)
      xv=q*xn+xl+xa
      yv=q*yn+yl+ya
      zv=q*zn+zl+za
      distsq=(xv-xa)**2+(yv-ya)**2+(zv-za)**2
C
      goto 9999
 9999 continue
      return
      end