261 lines
8.5 KiB
Fortran
Executable File
261 lines
8.5 KiB
Fortran
Executable File
subroutine delaunay_connect(npoints,ntets,epsilon,
|
|
* ntetmax,nlsttts)
|
|
C
|
|
C#######################################################################
|
|
C
|
|
C PURPOSE -
|
|
C
|
|
C This routine does grid generation by calling a
|
|
C point insertion algorithm
|
|
C
|
|
C INPUT ARGUMENTS -
|
|
C
|
|
C npoints -- number of nodes in the mesh
|
|
C ntets -- number of elements in the mesh
|
|
c epsilon --
|
|
c ntetmax -- max number of elements
|
|
c nlstts -- number of nodes to add
|
|
C
|
|
C OUTPUT ARGUMENTS -
|
|
C
|
|
C connected mesh (itet)
|
|
C
|
|
C
|
|
C CHANGE HISTORY -
|
|
C
|
|
C $Log: delaunay_connect.f,v $
|
|
C Revision 2.00 2007/11/05 19:45:51 spchu
|
|
C Import to CVS
|
|
C
|
|
CPVCS
|
|
CPVCS Rev 1.10 02 Aug 2005 08:00:28 gable
|
|
CPVCS Changed variable ifadd to lifadd.
|
|
CPVCS
|
|
CPVCS Rev 1.9 18 Jul 2002 11:20:38 dcg
|
|
CPVCS change definitions of smalarea to be used by delaunay in
|
|
CPVCS constructing the insertion cavity
|
|
CPVCS remove idrastic condition
|
|
CPVCS reinstate istep=5
|
|
CPVCS
|
|
CPVCS Rev 1.8 11 Apr 2001 16:43:44 dcg
|
|
CPVCS fix format
|
|
CPVCS
|
|
CPVCS Rev 1.7 08 Mar 2001 16:33:58 dcg
|
|
CPVCS change format statements and warning message
|
|
CPVCS
|
|
CPVCS Rev 1.6 07 Dec 2000 13:40:10 dcg
|
|
CPVCS correct error in not setting nnodes after adding nodes to
|
|
CPVCS fix small elements
|
|
CPVCS
|
|
CPVCS Rev 1.5 25 Oct 2000 11:22:26 dcg
|
|
CPVCS restore new calculations of smaldist and smalarea
|
|
CPVCS
|
|
CPVCS Rev 1.3 Tue Apr 04 14:45:04 2000 dcg
|
|
CPVCS make 'smal' variable definitions consistent with
|
|
CPVCS dimensions of problem
|
|
CPVCS
|
|
CPVCS Rev 1.2 03 Feb 2000 09:21:20 dcg
|
|
CPVCS
|
|
CPVCS Rev 1.1 13 Jan 2000 14:47:46 dcg
|
|
CPVCS No change.
|
|
CPVCS
|
|
CPVCS Rev 1.0 04 Jan 2000 16:47:32 dcg
|
|
CPVCS
|
|
CPVCS
|
|
CPVCS Rev 1.5 Fri Oct 31 10:47:24 1997 dcg
|
|
CPVCS declare ipcmoprm as a pointer
|
|
CPVCS
|
|
CPVCS Rev 1.4 Fri Oct 03 17:23:00 1997 dcg
|
|
CPVCS fix looping in multi-material - quit if all points
|
|
CPVCS that were attempted to be added failed
|
|
CPVCS
|
|
CPVCS Rev 1.3 Thu Aug 28 10:17:44 1997 dcg
|
|
CPVCS disable step 4 in the point insertion algorithm
|
|
CPVCS it was causing disconnected points and non-delaunay grids
|
|
CPVCS
|
|
CPVCS Rev 1.0 Mon Aug 18 14:55:44 1997 dcg
|
|
CPVCS Initial revision.
|
|
C
|
|
C#######################################################################
|
|
C
|
|
implicit none
|
|
include 'search.h'
|
|
include 'cmo.h'
|
|
include 'chydro.h'
|
|
integer limithih,limitlow,it,i,j,ierr,k,leni,icmotype,
|
|
* npoints,ntets,ntetmax,nlsttts
|
|
real*8 epsilon
|
|
pointer (iplstptl,lstptl)
|
|
integer lstptl(1000000)
|
|
character*132 logmess
|
|
C
|
|
C#######################################################################
|
|
C
|
|
90 continue
|
|
c smalluse=small*amin0(istep,2)
|
|
smalluse=small
|
|
c if(idrastic.ne.0) smalluse=200.0*small
|
|
smaldist=smalluse*(boxsizex*boxsizey*boxsizez)**(1.d0/3.d0)
|
|
c smalarea=2.0*smalluse*(boxsizex*boxsizey*boxsizez)**(2.d0/3.d0)
|
|
c smalvol=3.0*smalluse*boxsizex*boxsizey*boxsizez
|
|
smalarea=smalluse*(boxsizex*boxsizey*boxsizez)**(2.d0/3.d0)
|
|
smalvol=smalluse*boxsizex*boxsizey*boxsizez
|
|
C
|
|
C __________________________________________________________________
|
|
C
|
|
C NOTES:
|
|
C
|
|
C istep=1 DEGENERATE POINTS ARE ADDED TO THE FAIL
|
|
C LIST.
|
|
C
|
|
C istep=2--nstepdgn+1 ATTEMPT IS MADE TO CONNECT DEGENERATE
|
|
C POINTS.
|
|
C FOR istep=2, TETRAHEDRA THAT LIE WITHIN
|
|
C AN EPSILON OF ANY CIRCUMBALL ARE EXCLUDED
|
|
C FROM THE LIST.
|
|
C FOR istep=3, TETRAHEDRA THAT LIE ON THE
|
|
C CIRCUMBALLS AND ALL TETRAHEDRA INSIDE THE
|
|
C CIRCUMBALLS ARE INCLUDED IN THE LIST.
|
|
C FOR istep=4, TETRAHEDRA THAT LIE BEYOND
|
|
C AN EPSILON FROM THE CIRCUMBALLS ALSO ARE
|
|
C INCLUDED.
|
|
C istep=4 currently disabled as can generate
|
|
C non-delaunay meshes.
|
|
C
|
|
C __________________________________________________________________
|
|
C
|
|
C
|
|
C ******************************************************************
|
|
C
|
|
C CONSTRUCT THE DELAUNAY TETRAHEDRALIZATION BY INSERTING THE MASS
|
|
C POINTS INTO THE EXISTING TETRAHEDRAL STRUCTURE, ONE AT A TIME.
|
|
C
|
|
|
|
nlstfail=0
|
|
limitlow=1
|
|
limithih=nlstptl
|
|
call mmfindbk('ibint',nname,ipibint,leni,ierr)
|
|
if (ierr.ne.0) then
|
|
call mmgetblk('ibint',nname,ipibint,ntetmaxl,1,ierr)
|
|
else
|
|
if(leni.lt.ntetmaxl)
|
|
* call mmnewlen('ibint',nname,ipibint,ntetmaxl,ierr)
|
|
endif
|
|
do it=1,ntetmaxl
|
|
ibint(it)=ntetexcl+it
|
|
enddo
|
|
ifailv=0
|
|
ifailr=0
|
|
ifailc=0
|
|
call delaunay(ntetmax,ntets)
|
|
C
|
|
C refresh pointers
|
|
C
|
|
call mmfindbk('lstptl',nname,iplstptl,leni,ierr)
|
|
call mmfindbk('lstfail',nname,iplstfal,leni,ierr)
|
|
C
|
|
C MAKE A NEW LIST OF POINTS THAT COULD NOT BE CONNECTED DURING THE
|
|
C PREVIOUS PASS, AND PREPARE FOR THE NEXT PASS.
|
|
C
|
|
if(nlstfail.ne.0) then
|
|
C
|
|
C ITERATIONS INVOLVING THE SAME STEP.
|
|
C
|
|
if(nlstfail.lt.nlstptl) then
|
|
do i=1,nlstfail
|
|
lstptl(i)=lstfail(i)
|
|
enddo
|
|
nlstptl=nlstfail
|
|
goto 90
|
|
C
|
|
C JUST COMPLETED STEP istep. PREPARE FOR NEXT STEP.
|
|
C
|
|
elseif(istep.le.nstepdgn+1) then
|
|
do i=1,nlstfail
|
|
lstptl(i)=lstfail(i)
|
|
enddo
|
|
nlstptl=nlstfail
|
|
write(logmess,6200) nlstfail,istep
|
|
6200 format(' There are',i10,
|
|
$ ' points that failed step ',i10)
|
|
call writloga('default',1,logmess,0,ierr)
|
|
do i=1,nlstfail,10
|
|
write(logmess,6400) (lstfail(j),j=i,min(i+9,nlstfail))
|
|
6400 format(2x,10i10)
|
|
call writloga('bat',0,logmess,0,ierr)
|
|
enddo
|
|
if (ifailr+ifailv.ne.0) then
|
|
write(logmess,6501) istep,ifailr
|
|
6501 format(' At step ',i3,1x,i10,
|
|
$ ' Points failed volume ratio test ')
|
|
call writloga('default',1,logmess,0,ierr)
|
|
write(logmess,6503) ifailv
|
|
6503 format(13x,i10,' points failed min volume test.')
|
|
call writloga('default',1,logmess,0,ierr)
|
|
endif
|
|
if (ifailc.ne.0)then
|
|
write(logmess,6502) ifailc
|
|
6502 format( 'Circumsphere problems ',
|
|
* 'for ',i10,' points')
|
|
call writloga('default',1,logmess,0,ierr)
|
|
endif
|
|
c if (istep.eq.nstepdgn) then
|
|
c istep=1
|
|
c idrastic=1
|
|
c else
|
|
istep=istep+1
|
|
goto 90
|
|
endif
|
|
c endif
|
|
C
|
|
C COMPLETED THE LAST STEP, nstepdgn1. WHATEVER POINTS COULD
|
|
C NOT BE CONNECTED, CANNOT BE CONNECTED FOR THIS CONFIGURATION.
|
|
C IF THE DUD FLAG IS ON, DUD THESE POINTS. OTHERWISE, SIMPLY
|
|
C RESET idrastic BACK TO ZERO FOR THE NEXT PASS (PASS WITH THE
|
|
C SURROUNDING TETRAHEDRON REMOVED).
|
|
C
|
|
if(idud.ne.0) then
|
|
call cmo_get_name(cmo,ierr)
|
|
call cmo_get_info('itp1',cmo,ipitp1,leni,icmotype,ierr)
|
|
call cmo_get_info('xic',cmo,ipxic,leni,icmotype,ierr)
|
|
call cmo_get_info('yic',cmo,ipyic,leni,icmotype,ierr)
|
|
call cmo_get_info('zic',cmo,ipzic,leni,icmotype,ierr)
|
|
write(logmess,7600) nlstfail
|
|
7600 format(i10,' points are being marked because they could',
|
|
$ ' not be connected.')
|
|
call writloga('default',1,logmess,0,ierr)
|
|
do i=1,nlstfail
|
|
k=lstfail(i)
|
|
write(logmess,7700) k,imt1(k),xic(k),yic(k),zic(k)
|
|
7700 format(x,2i10,x,3e15.7)
|
|
call writloga('default',0,logmess,0,ierr)
|
|
enddo
|
|
do i=1,nlstfail
|
|
itp1(lstfail(i))=itp1(lstfail(i))+1000
|
|
enddo
|
|
idrastic=0
|
|
else
|
|
idrastic=0
|
|
endif
|
|
C nlstfail=0
|
|
endif
|
|
C
|
|
C CHECK FOR SMALL TETRAHEDRA, AND IF NECESSARY, ADD MORE POINTS TO
|
|
C ELIMINATE THEM.
|
|
C
|
|
if(iaddpts.ne.0.and.lifadd) then
|
|
iaddpts=0
|
|
iaddpass=iaddpass+1
|
|
idelaun=1
|
|
C
|
|
call fix_small_tets(npoints,ntets,epsilon,nlsttts)
|
|
if (nlsttts.ne.0) then
|
|
call cmo_set_info('nnodes',cmo,npoints,1,1,ierr)
|
|
istep=1
|
|
go to 90
|
|
endif
|
|
endif
|
|
return
|
|
end
|
|
C
|