subroutine excavate & (main_mo, surf_mo, ierror_return) C C###################################################################### C C PURPOSE - C C This routine takes as input the names of a mesh and a surface. C It then automatically excavates the mesh around the surface, and C inserts the surface into the mesh, saving the result into a new C mesh specified by the user. The surface mesh must be triangular. C If it is not, it will be converted to a triangular mesh. The C circumcircles of each element of the surface are computed. Then, C any point of the mesh that falls within the equivalent C circumsphere of an element of the surface is removed (making an C area for good tets to be formed). C C NOTES - C C Syntax for this command: C addmesh / excavate / sink_name / mesh_name / surface_name C / [bfs] / [connect] C C If the optional 'connect' argument is given, the surface will be C addmesh/appended into the background mesh, and connect will be C called on the resulting point cloud. If the optional bfs C argument is specified, then that algorithm will be used to C search for points. By default, it chooses the KD-tree algorithm. C C###################################################################### C C CHANGE HISTORY - C C This is the first version. C 6 / 23 / 2010 C agable C C###################################################################### C implicit none C include 'chydro.h' include 'local_element.h' C C Subroutine input variables character*32 main_mo, surf_mo integer ierror_return, bfs_flag C C Local variables character*32 isubname, dual_mo C character*132 mess character*256 cmd real*8 x1,x2,x3,y1,y2,y3,z1,z2,z3,ax4,ay4,az4, & ds1,ds2,ds3,farea,maxrad, & curr_crad,curr_dist integer nmnodes,nmelems,nsnodes,nselems,ndnodes, & ncnodes,ncelems, & lnode1,lnode2,lnode3, & gdim,tdim,mbndry, & i,i2,i3,nrem,counter, & curr_cnode,curr_dnode,next_dnode, & ilen, itype,ierror, ierrw character*32 cmaxrad, qname character*512 ndnodlist real*8 bboxx(8), bboxy(8), bboxz(8) C C Variables for calls to subroutines pointer (ipitets, itets) integer itets(*) pointer (iptetoffs, itetoffs) integer itetoffs(*) pointer (ipitetm, itetm) integer itetm(*) pointer (iptetoffm, itetoffm) integer itetoffm(*) pointer (ipxics, xics) real*8 xics(*) pointer (ipyics, yics) real*8 yics(*) pointer (ipzics, zics) real*8 zics(*) pointer (ipxicm, xicm) real*8 xicm(*) pointer (ipyicm, yicm) real*8 yicm(*) pointer (ipzicm, zicm) real*8 zicm(*) pointer (ipxicd, xicd) real*8 xicd(*) pointer (ipyicd, yicd) real*8 yicd(*) pointer (ipzicd, zicd) real*8 zicd(*) pointer (ipcrad, crad) real*8 crad(*) pointer (ipxvcen, xvcen) real*8 xvcen(*) pointer (ipyvcen, yvcen) real*8 yvcen(*) pointer (ipzvcen, zvcen) real*8 zvcen(*) pointer (iplinkt, linkt) integer linkt(*) pointer (ipsbox, sbox) real*8 sbox(*) pointer (ipfound, elemfound) integer elemfound(*) pointer (iptettyp, itettyp) integer itettyp(*) pointer (ipclosepts,closepts) integer closepts(*) pointer (ipdist, dist) real*8 dist(*) pointer (ipnearnode,nearnodes) integer nearnodes(*) pointer (ipitp1, itp1) integer itp1(*) pointer (ipisetwd, isetwd) integer isetwd(*) pointer (ipjtet, jtet) integer jtet(*) pointer (ipjtetoff, jtetoff) integer jtetoff(*) pointer (ippushval, pushval) integer pushval pointer (ippopval, popval) integer popval pointer (ipvisited, visited) integer visited(*) C C C###################################################################### C isubname = 'excavate' C print *, 'IN EXCAVATE: ', main_mo, surf_mo C The flag for which algorithm to use is passed in through C ierror_return. Save it into a flag value, so we can use C ierror_return for output. bfs_flag = 0 if (ierror_return .eq. 1) then bfs_flag = 1 ierror_return = 0 endif C Get access to all basic attributes of the primary and surface C meshes, for use later on. call cmo_get_info('nnodes',surf_mo,nsnodes,ilen,itype,ierror) call cmo_get_info('nelements',surf_mo,nselems,ilen,itype,ierror) call cmo_get_info('itet',surf_mo,ipitets,ilen,itype,ierror) call cmo_get_info('itetoff',surf_mo,iptetoffs,ilen,itype,ierror) call cmo_get_info('xic',surf_mo,ipxics,ilen,itype,ierror) call cmo_get_info('yic',surf_mo,ipyics,ilen,itype,ierror) call cmo_get_info('zic',surf_mo,ipzics,ilen,itype,ierror) call cmo_get_info('nnodes',main_mo,nmnodes,ilen,itype,ierror) call cmo_get_info('nelements',main_mo,nmelems,ilen,itype,ierror) call cmo_get_info('itet',main_mo,ipitetm,ilen,itype,ierror) call cmo_get_info('itetoff',main_mo,iptetoffm,ilen,itype,ierror) call cmo_get_info('xic',main_mo,ipxicm,ilen,itype,ierror) call cmo_get_info('yic',main_mo,ipyicm,ilen,itype,ierror) call cmo_get_info('zic',main_mo,ipzicm,ilen,itype,ierror) call cmo_get_info('itp1',main_mo,ipitp1,ilen,itype,ierror) C Add coordinates of voronoi centers to every element of the surface cmd = 'cmo/addatt/' // surf_mo // '/voronoi/' & // '-xvcen- -yvcen- -zvcen-; finish' call dotask(cmd, ierror) C Add circumradius attribute to surface mesh, to be filled manually cmd = 'cmo/addatt/' // surf_mo // '/-cradius-/' & // 'VDOUBLE/scalar/nelements; finish' call dotask(cmd, ierror) C Loop through every element of surface. For each element: C * compute circumradius C * paint radius onto surface mesh C IMPORTANT: Assumes surface mesh is triangular - this is necessary C for finding circumcircle, and makes other math easier. call cmo_get_info('-xvcen-',surf_mo,ipxvcen,ilen,itype,ierror) !print *, 'xvcen', ipxvcen, ilen, itype, ierror call cmo_get_info('-yvcen-',surf_mo,ipyvcen,ilen,itype,ierror) !print *, 'yvcen', ipyvcen, ilen, itype, ierror call cmo_get_info('-zvcen-',surf_mo,ipzvcen,ilen,itype,ierror) !print *, 'zvcen', ipzvcen, ilen, itype, ierror call cmo_get_info('-cradius-',surf_mo,ipcrad,ilen,itype,ierror) !print *, 'crad ', ipcrad, ilen, itype, ierror maxrad = 0 do i=1,nselems !print *, ! & "--------------------------------------------------------------" !print *, "ELEMENT: ", i C Get information about locations of element vertices lnode1 = itets(itetoffs(i)+1) lnode2 = itets(itetoffs(i)+2) lnode3 = itets(itetoffs(i)+3) !print *, "LNODES: ", lnode1, lnode2, lnode3 x1 = xics(lnode1) x2 = xics(lnode2) x3 = xics(lnode3) y1 = yics(lnode1) y2 = yics(lnode2) y3 = yics(lnode3) z1 = zics(lnode1) z2 = zics(lnode2) z3 = zics(lnode3) !print *, " Node1: ", x1, y1, z1 !print *, " Node2: ", x2, y2, z2 !print *, " Node3: ", x3, y3, z3 C Calculate circumradius of element ax4 = (y3 - y1)*(z2 - z1)-(z3-z1)*(y2-y1) ay4 = -((x3 - x1)*(z2 - z1)-(z3 - z1)*(x2 - x1)) az4 = (x3 - x1)*(y2 - y1)-(y3 - y1)*(x2 - x1) farea=.5*sqrt(ax4**2+ay4**2+az4**2) ds1 = sqrt((x3 - x2)**2 + (y3 - y2)**2 + (z3 - z2)**2) ds2 = sqrt((x1 - x3)**2 + (y1 - y3)**2 + (z1 - z3)**2) ds3 = sqrt((x2 - x1)**2 + (y2 - y1)**2 + (z2 - z1)**2) curr_crad = ds1*ds2*ds3/(4.0d0*farea) !print *, "RADIUS: ", curr_crad C Fill circumradius attribute crad(i) = curr_crad if (curr_crad > maxrad) maxrad = curr_crad enddo print *,"Done filling radii." call mmverify() C############################ C PRIMARY ALGORITHM: Compute a KD-tree on the main background mesh, C and use intersections of the KD elements with the circumspheres of C the elements in the surface to find candidate nodes. Then, C compute explicit distances from candidate nodes to the circumcenters C of the surface elements (the dual nodes) and remove any nodes whose C distance is less than the circumradius. C if (bfs_flag .eq. 0) then print *,"IN KD-TREE SEARCH" C Create the KD-tree on the background mesh cmd = 'cmo/select/' // main_mo // '; finish' call dotask(cmd, ierror) cmd = 'kdtree/build; finish' call dotask(cmd, ierror) C Get access to the kd-tree attributes, so we can pass them into the C intersection function call cmo_get_info('linkt',main_mo,iplinkt,ilen,itype,ierror) call cmo_get_info('sbox',main_mo,ipsbox,ilen,itype,ierror) call mmgetblk('elemfound',isubname,ipfound,nmelems,1,ierror) call cmo_get_info('itettyp',main_mo,iptettyp,ilen,itype,ierror) C Loop through all the elements in the surface. For each element, C compute its bounding box, intersect this box with the kd-tree, and C examine the resulting elements for nodes that fall within the C circumradius of the element. nrem = 0 do i=1,nselems C Get current circumcenter coordinates and radius x1 = xvcen(i) y1 = yvcen(i) z1 = zvcen(i) curr_crad = crad(i) C Construct bounding box of circumsphere do i2=1,8 if (i2 .le. 4) then bboxx(i2) = x1 - curr_crad else bboxx(i2) = x1 + curr_crad endif if (MOD(i2, 2) .eq. 1) then bboxy(i2) = y1 - curr_crad else bboxy(i2) = y1 + curr_crad endif if (i2 .ge. 3 .and. i2 .le. 6) then bboxz(i2) = z1 - curr_crad else bboxz(i2) = z1 + curr_crad endif enddo C Intersect the bounding cube with the kd-tree call kDtreeselect(8, bboxx, bboxy, bboxz, linkt, sbox, & ncelems, elemfound, ierror) !print *,"Candidate elements: ", ncelems C Loop through the found elements do i2=1,ncelems C Loop through the nodes of the element do i3=1,nelmnen(itettyp(elemfound(i2))) curr_cnode = itetm(itetoffm(elemfound(i2))+i3) x2 = xicm(curr_cnode) y2 = yicm(curr_cnode) z2 = zicm(curr_cnode) !print *,"Node: ", curr_cnode, x2,y2,z2 curr_dist = sqrt((x1-x2)**2+(y1-y2)**2+(z1-z2)**2) !print *,curr_dist, curr_crad if (curr_dist .le. (curr_crad+curr_crad*1e-9)) then C Dud the node - 21 is a special value for itp that signifies dudding if (itp1(curr_cnode) .ne. 21) then itp1(curr_cnode) = 21 nrem = nrem + 1 !print *,"Dudded." endif endif enddo enddo enddo print *,"Number of nodes dudded total: ", nrem C############################ C SECONDARY ALGORITHM: (Used only if bfs_flag is set to 1). Get a set C of candidate nodes for deletion by finding all nodes within the C maximum circumradius of the surface. Then, for each of these nodes, C starting at the element to which it is closest, perform a C breadth-first search across the surface, searching for an element C whose circumradius is large enough to contain the candidate node. C elseif (bfs_flag .eq. 1) then print *,"IN BFS SEARCH" C Create dual mesh to hold dual points of surface dual_mo = '-dual_mo-' call cmo_create(dual_mo,ierror) ndnodes = nselems call cmo_set_info('nnodes',dual_mo,ndnodes,1,1,ierror) call cmo_newlen(dual_mo, ierror) call cmo_get_info('ndimensions_geom',surf_mo,gdim,ilen,itype, & ierror) call cmo_set_info('ndimensions_geom',dual_mo,gdim,1,1,ierror) call cmo_get_info('ndimensions_topo',surf_mo,tdim,ilen,itype, & ierror) call cmo_set_info('ndimensions_topo',dual_mo,tdim,1,1,ierror) C Loop through every element of surface. For each element, create C corresponding element of dual mesh. call cmo_get_info('xic',dual_mo,ipxicd,ilen,itype,ierror) call cmo_get_info('yic',dual_mo,ipyicd,ilen,itype,ierror) call cmo_get_info('zic',dual_mo,ipzicd,ilen,itype,ierror) do i=1,nselems C Set coordinates of ith point from circumcenter coords of ith C element xicd(i) = xvcen(i) yicd(i) = yvcen(i) zicd(i) = zvcen(i) enddo C Compute distance field from every point of the main mesh to the C elements of the surface - i.e. the nodes of the dual mesh cmd = 'compute/distance_field/' // main_mo // '/' & // dual_mo // '/-dist-/keepatt; finish' call dotask(cmd, ierror) C Put the 'nearest element' attribute in a safe place. cmd = 'cmo/addatt/' // main_mo // '/-nearnode-/VINT; finish;' call dotask(cmd, ierror) cmd = 'cmo/copyatt/' // main_mo // '/' // main_mo // '/' & // '-nearnode-/pt_gtg; finish' call dotask(cmd, ierror) C Create set of points with distance less than max cradius. write(cmaxrad, '(F20.10)') maxrad !print *, "cmaxrad: ", maxrad, cmaxrad cmd = 'pset/-close-/attribute/-dist-/1,0,0/' // cmaxrad & // '/le; finish' call dotask(cmd, ierror) C Get array of nodes in this pset so we can iterate through it call cmo_get_info('isetwd',main_mo,ipisetwd,ilen,itype,ierror) call mmgetblk('closepts',isubname,ipclosepts,nmnodes,1,ierror) call pntlimc('pset','get','-close-',ipclosepts,ncnodes,nmnodes, & isetwd,itp1) C Get access to -nearnode- attribute array so we can get to the C dual_mo from the main_mo. Get access to -dist- attribute array so we C can test it against -cradius- values. call cmo_get_info('-nearnode-',main_mo,ipnearnode, & ilen,itype,ierror) call cmo_get_info('-dist-',main_mo,ipdist,ilen,itype,ierror) C Get the necessary information to use jtet, so we can perform the BFS call cmo_get_info('jtet',surf_mo,ipjtet,ilen,itype,ierror) call cmo_get_info('jtetoff',surf_mo,ipjtetoff,ilen,itype,ierror) call cmo_get_info('mbndry',surf_mo,mbndry,ilen,itype,ierror) C Initialize memory for breadth-first search. Need a place to put data C so it can be pushed onto the queue, we need a place to put the data C returned by pop calls, and we need an array to keep track of C which nodes the BFS has visited. qname = 'is_bfs' call queue_c(qname,ndnodes,1,ierror) call mmgetblk('pushval',isubname,ippushval,1,1,ierror) call mmgetblk('popval',isubname,ippopval,1,1,ierror) call mmgetblk('visited',isubname,ipvisited,ndnodes,1,ierror) !call mmverify() !call mmprint() C Loop through all nodes in main mesh that are "close" (i.e. inside C the max_radius of a circumsphere. Test their distance against the C radius of the nearest sphere. If they fall inside the sphere, mark C the node for deletion. If the nearest node fails, perform a C breadth-first search outward from that node, to see if the point C falls within the radius of any other dual node. nrem = 0 do i=1,ncnodes !print *,'----------------------------------------' C Clear the 'visited' array for use with the current node do i2=1,ndnodes visited(i2)=0 enddo C Set get node numbers of current node and first dual node to check curr_cnode = closepts(i) curr_dnode = nearnodes(curr_cnode) !print *,"INDEX:", i, "CNODE:", curr_cnode !print *,"First dnode:", curr_dnode !print *,"Nearest distance: ", dist(curr_cnode) C Push first dual node onto queue to initialize the BFS pushval = curr_dnode !call mmverify() !call mmprint() call queue_push(qname,ippushval,1,ierror) visited(curr_dnode) = 1 C This is the actual breadth-first search loop: counter = 0 do call queue_pop(qname,ippopval,1,ierror) C Finish the search if the queue is empty - every node has been hit if (ierror .ne. 0) then !print *,"QUEUE is empty." exit endif curr_dnode = popval counter = counter + 1 !print *,"DNODE:",curr_dnode C Compute the distance from the current node to the current dual node x1 = xicm(curr_cnode) y1 = yicm(curr_cnode) z1 = zicm(curr_cnode) x2 = xicd(curr_dnode) y2 = yicd(curr_dnode) z2 = zicd(curr_dnode) !print *,x1,y1,z1,x2,y2,z2,(x1-x2),(y1-y2),(z1-z2) curr_dist = sqrt((x1-x2)**2 + (y1-y2)**2 + (z1-z2)**2) curr_crad = crad(curr_dnode) !print *,"DIST: ", curr_dist, "CRAD: ", curr_crad C See if the current node is within the dual-node's circumradius if (curr_dist .le. (curr_crad+curr_crad*1e-9)) then !print *,"This node will be removed." C Dud the node - 21 is a special value for itp that signifies dudding itp1(curr_cnode) = 21 nrem = nrem + 1 exit else C Otherwise, push the dual-node's neighbors onto the queue do i2=1,3 if (jtet(jtetoff(curr_dnode)+i2).lt.mbndry) & then next_dnode = & 1+(jtet(jtetoff(curr_dnode)+i2)-1)/3 elseif (jtet(jtetoff(curr_dnode)+i2).gt.mbndry) & then next_dnode = & 1+(jtet(jtetoff(curr_dnode)+i2)-mbndry-1)/3 else next_dnode = -1 endif if (visited(next_dnode) .eq. 0 .and. & next_dnode .ne. -1) then !print *,counter,":About to push node", C & next_dnode,jtet(jtetoff(curr_dnode)+i2), C & 1+(jtet(jtetoff(curr_dnode)+i2)-1)/3, C & visited(next_dnode) pushval = next_dnode call queue_push(qname,ippushval,1,ierror) visited(next_dnode) = 1 endif enddo endif enddo !print *,"Num nodes checked: ", counter if (counter .ne. ndnodes .and. & counter .ne. 1) then C & itp1(curr_cnode) .ne. 21) then !print *,"INDEX:", i, "CNODE:", curr_cnode !print *,"Only ", counter, " nodes were visited!" !if (itp1(curr_cnode) .eq. 21) print *,"Removed!" !print *,"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" ndnodlist = '' do i2=1,ndnodes if (visited(i2) .eq. 0) then !print *,i2 !write(ndnodlist, '(a, i4.4)') ndnodlist, i2 endif enddo !print *,ndnodlist endif enddo C Release the memory held by the queue call queue_d(qname,ierror) if (ierror .ne. 0) then write(cmd,'(a,i5)')'excavate Error: from queue_d: ',ierror call writloga('default',1,cmd,1,ierrw) endif write(cmd,'(a,i15)') & 'EXCAVATE total number of dudded nodes: ',nrem call writloga('default',1,cmd,1,ierrw) C############################ C Done with either the KD-Tree or the BFS method. Either way, we have C now dudded a selection of points that are too close to the surface. C Time to get rid of them once and for all. endif C Return error flag C Note from TAM, ierror_return is used as input flag at entry C then ignored. I assign error value here so error may be captured. ierror_return = ierror C Release the temporary memory call mmrelprt(isubname,ierror) if (ierror .ne. 0) then write(cmd,'(a,i5)')'mmrelprt Error: ',ierror call writloga('default',1,cmd,1,ierrw) endif C Final clean up C Remove all the points we just dudded. cmd = ' ' cmd = 'cmo/select/' // main_mo // '; finish' call dotask(cmd, ierror) cmd = 'geniee; finish' call dotask(cmd, ierror) cmd = 'rmpoint/compress; finish' call dotask(cmd, ierror) return end