*dk,flp3to2i
      subroutine flp3to2i(it1,it2,it3,id,jd,
     *                    npoints,ntets)
C
C ######################################################################
C
C      PURPOSE -
C
C        This routine completes the flip set up by the routine
C        "fnd3to2i."   The result is a flip of connections on
C        the material interface.
C
C      INPUT ARGUMENTS -
C
C         it1   - the first tet
C         it2   - the second tet
C         it3   - the third tet
C         id    - "itet" coordinates of the two new tets
C         jd    - "jtet" coordinates of the two new tets
C
C      OUTPUT ARGUMENTS -
C
C         none
C
C      CHANGE HISTORY -
C
C        $Log: flp3to2i.f,v $
C        Revision 2.00  2007/11/05 19:45:55  spchu
C        Import to CVS
C
CPVCS    
CPVCS       Rev 1.6   Wed Feb 03 15:23:44 1999   dcg
CPVCS    remove calls to fluxing routines and associated memory.
CPVCS
CPVCS       Rev 1.5   Thu Apr 17 16:14:00 1997   dcg
CPVCS    reset itetclr for first remaining tet
CPVCS
CPVCS       Rev 1.3   12/02/94 15:05:42   het
CPVCS    Added an option for the "cmo" access functions
CPVCS
CPVCS
CPVCS       Rev 1.2   12/01/94 18:47:40   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:52:12   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:13:28   pvcs
CPVCS    Original version.
C
C ######################################################################
      implicit none
C
      include "cmo.h"
      include "chydro.h"
      include "neibor.h"
      include "cmerge.h"

C arguments (it1,it2,it3,id,jd,npoints,ntets)
      integer it1,it2,it3,npoints,ntets
      integer id(12),jd(12)

C variables
      integer i,j,k,i1,i2,i3,i4
      integer ierror,icmotype,jtemp,length,lenimt1,lenxic,
     *      lenyic,lenzic,lenitetclr,ier,lenitet,lenjtet,ione,k1,k2
C
C ######################################################################
C
C     DEFINE THE STATEMENT FUNCTIONS NEEDED TO CALCULATE TET VOLUMES.
C
      real*8 crosx1,crosy1,crosz1,volume
      crosx1(i,j,k)=(yic(j)-yic(i))*(zic(k)-zic(i))-
     *              (yic(k)-yic(i))*(zic(j)-zic(i))
      crosy1(i,j,k)=(xic(k)-xic(i))*(zic(j)-zic(i))-
     *              (xic(j)-xic(i))*(zic(k)-zic(i))
      crosz1(i,j,k)=(xic(j)-xic(i))*(yic(k)-yic(i))-
     *              (xic(k)-xic(i))*(yic(j)-yic(i))
      volume(i1,i2,i3,i4)=(xic(i4)-xic(i1))*crosx1(i1,i2,i3)+
     *                    (yic(i4)-yic(i1))*crosy1(i1,i2,i3)+
     *                    (zic(i4)-zic(i1))*crosz1(i1,i2,i3)
C
C ######################################################################
C BEGIN begin
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('mbndry',cmo,mbndry,length,icmotype,ierror)
      call cmo_get_info('imt1',cmo,ipimt1,lenimt1,icmotype,ierror)
      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)
      call cmo_get_info('itetclr',cmo,ipitetclr,lenitetclr,icmotype,ier)
      call cmo_get_info('itet',cmo,ipitet,lenitet,icmotype,ierror)
      call cmo_get_info('jtet',cmo,ipjtet,lenjtet,icmotype,ierror)
C
      endif
C
C     ******************************************************************
C
C
      ione=1
C
C
C     MAKE THE NEW TETRAHEDRON ASSIGNMENTS.
C
      itet(1,it3)=-itet(1,it3)
C
      itet(1,it1)=id(1)
      jtet(1,it1)=jd(1)
      itet(2,it1)=id(2)
      jtet(2,it1)=jd(2)
      itet(3,it1)=id(3)
      jtet(3,it1)=jd(3)
      itet(4,it1)=id(4)
      jtet(4,it1)=jd(4)
      itet(1,it2)=id(5)
      jtet(1,it2)=jd(5)
      itet(2,it2)=id(6)
      jtet(2,it2)=jd(6)
      itet(3,it2)=id(7)
      jtet(3,it2)=jd(7)
      itet(4,it2)=id(8)
      jtet(4,it2)=jd(8)
      itetclr(it1) = imt1(id(1))
C     ******************************************************************
C
C     MAKE THE JTET ARRAY CONSISTENT
C
      k1=4*(it1-1)
      k2=4*(it2-1)
      do 20 i=1,4
         if(jd(i).lt.mbndry) then
            jtet1(jd(i))=k1+i
         elseif(jd(i).gt.mbndry) then
            jtemp=jd(i)-mbndry
            jtet1(jtemp)=k1+i+mbndry
         endif
         if(jd(i+4).lt.mbndry) then
            jtet1(jd(i+4))=k2+i
         elseif(jd(i+4).gt.mbndry) then
            jtemp=jd(i+4)-mbndry
            jtet1(jtemp)=k2+i+mbndry
         endif
 20   continue
C
C     *****************************************************************
C
C     UPDATE THE LIST OF HOLES IN THE "ijtet" ARRAY
C
      nvacnt=nvacnt+1
      if(nvacnt.ge.lenvacnt) then
         lenvacnt=nvacnt+100
         call mflip(ione,lenvacnt,'ivacnt')
      endif
      ivacnt(nvacnt)=it3
C
C     ******************************************************************
C
      goto 9999
 9999 continue
      return
      end