588 lines
20 KiB
Fortran
Executable File
588 lines
20 KiB
Fortran
Executable File
subroutine intersect_elements(imsgin,xmsgin,cmsgin,
|
|
& msgtype,nwds,ierror)
|
|
C
|
|
C######################################################################
|
|
C
|
|
C PURPOSE -
|
|
C
|
|
C The Purpose of this subroutine is to take the intersection of
|
|
C the two mesh objects and note in which elements of mesh object
|
|
C one the elements of mesh object two intersect.
|
|
C
|
|
C NOTES -
|
|
C
|
|
C Syntax for this command:
|
|
C intersect_elements/sink_mesh_object/source_mesh_object/
|
|
C [attrib_name]
|
|
C See web documentation for limitations and supported features.
|
|
C
|
|
C INPUT ARGUMENTS -
|
|
C
|
|
C xmsgin() - REAL ARRAY OF COMMAND INPUT VALUES
|
|
C cmsgin() - CHARACTER ARRAY OF COMMAND INPUT VALUES
|
|
C imsgin() - INTEGER ARRAY OF COMMAND INPUT VALUES
|
|
C msgtype() - INTEGER ARRAY OF COMMAND INPUT TYPE
|
|
C nwds - NO. OF WORDS OF COMMAND INPUT VALUES
|
|
C
|
|
C $Log: intersect_elements.f,v $
|
|
C Revision 2.00 2007/11/05 19:45:59 spchu
|
|
C Import to CVS
|
|
C
|
|
CPVCS
|
|
CPVCS Rev 1.10 23 Jun 2006 08:27:16 tam
|
|
CPVCS check for incoming attribute containing negative values
|
|
CPVCS
|
|
CPVCS Rev 1.9 12 Oct 2005 14:42:06 gable
|
|
CPVCS Minor changes to log messages.
|
|
CPVCS
|
|
CPVCS Rev 1.8 23 Mar 2005 08:57:44 dcg
|
|
CPVCS fix declarations for linux
|
|
CPVCS
|
|
CPVCS Rev 1.7 23 Feb 2005 08:32:00 tam
|
|
CPVCS changed to implicit none
|
|
CPVCS added code to report progress of the element search
|
|
CPVCS
|
|
CPVCS Rev 1.6 30 Sep 2004 11:18:48 dcg
|
|
CPVCS make epsln double precision
|
|
CPVCS
|
|
CPVCS Rev 1.5 09 Nov 2001 12:11:16 gable
|
|
CPVCS Fixed error in declaration if itetkid array. It was set
|
|
CPVCS to real*8 when it should be integer. This caused errors
|
|
CPVCS when the input mesh was an AMR type mesh.
|
|
CPVCS
|
|
CPVCS Rev 1.4 Tue Feb 22 14:33:10 2000 dcg
|
|
CPVCS get rid of capital letters HP loader did something weird
|
|
CPVCS
|
|
CPVCS Rev 1.3 08 Feb 2000 08:37:32 dcg
|
|
CPVCS remove comdict
|
|
CPVCS
|
|
CPVCS Rev 1.2 28 Jan 2000 10:03:36 gable
|
|
CPVCS Code was not releasing the kdtree data structure. Now it does.
|
|
CPVCS
|
|
CPVCS Rev 1.1 18 Jan 2000 10:56:28 gable
|
|
CPVCS Fixed header to insure log information goes into source code.
|
|
C
|
|
C There is a name change from the old routine
|
|
C xsectelementscmo.f to intersect_elements.f
|
|
C
|
|
C Log:/pvcs.config/t3d/src/xsectelementscmo.f_a
|
|
CPVCS
|
|
CPVCS Rev 1.3 07 Jan 2000 14:31:50 bap
|
|
CPVCS Changed the default prefix for the intersection attribute from xsect_ to in_
|
|
CPVCS
|
|
CPVCS Rev 1.2 06 Jan 2000 14:30:16 bap
|
|
CPVCS Added support for X3D AMR grids. Removed extra diagnostic statements.
|
|
CPVCS
|
|
CPVCS Rev 1.1 Wed Aug 04 10:44:32 1999 bap
|
|
CPVCS Added PVCS Header information
|
|
C
|
|
C
|
|
C######################################################################
|
|
C
|
|
C
|
|
implicit none
|
|
C
|
|
C preprocess machine.h does not appear to be used, commented out
|
|
C include "machine.h"
|
|
include "local_element.h"
|
|
C
|
|
integer lenptr
|
|
parameter (lenptr=1000000)
|
|
real*8 epsln
|
|
parameter (epsln=1.0d-10)
|
|
C
|
|
C
|
|
C######################################################################
|
|
C
|
|
C Variable Declarations
|
|
C
|
|
C######################################################################
|
|
C
|
|
C Subroutine Input Variables
|
|
C
|
|
integer nwds
|
|
character*(*) cmsgin(nwds)
|
|
integer imsgin(nwds), msgtype(nwds)
|
|
real*8 xmsgin(nwds)
|
|
integer ierror, ineg, init_attrib
|
|
C
|
|
C Routine Variables and Message Variables
|
|
C
|
|
character*32 isubname, cmoin, cmoout
|
|
character*64 attribname
|
|
character*132 logmess
|
|
character*256 cmdmess
|
|
C
|
|
C
|
|
integer i,j,k,l,m,n,orig_nwds,ipt,istep,iwrite,nwrite,
|
|
* num_snk,totsrchd,totfind,ierror2,nnodesin,ilen,icmotype,
|
|
* nelementsin,nenin,lenitettyp,lenitetoff,nnodesout,
|
|
* nenout,num_src,totflag,iperc,iflag,numfound,ifound,iisrc,
|
|
* ierrw,nelementsout,iomrgrid,ifoundstep,ireport,ierr
|
|
|
|
integer icharlnf, strlen
|
|
|
|
real*8 xperc, zero, xtrans,ytrans,ztrans,
|
|
* xmin,ymin,zmin,xmax,ymax,zmax,local_epsilon
|
|
|
|
C Variables used to store temporary info and indices
|
|
|
|
real*8 xnodes1(12),ynodes1(12),znodes1(12)
|
|
real*8 xnodes2(12),ynodes2(12),znodes2(12)
|
|
C
|
|
C Pointers for incoming CMO
|
|
C
|
|
C Node Based Attributes
|
|
pointer (ipxic, xic)
|
|
pointer (ipyic, yic)
|
|
pointer (ipzic, zic)
|
|
real*8 xic(lenptr), yic(lenptr), zic(lenptr)
|
|
C
|
|
C Element Based Attributes
|
|
C The 8 is used to ensure the itet array can handle any element
|
|
pointer (ipitettyp, itettyp)
|
|
pointer (ipitetoff, itetoff)
|
|
pointer (ipitet, itet)
|
|
integer itettyp(lenptr), itetoff(lenptr), itet(8*lenptr)
|
|
C
|
|
C Pointers for outgoing CMO
|
|
C
|
|
C Node Based Attributes
|
|
pointer (ipxico, xico)
|
|
pointer (ipyico, yico)
|
|
pointer (ipzico, zico)
|
|
real*8 xico(lenptr), yico(lenptr), zico(lenptr)
|
|
C
|
|
C Element Based Attributes
|
|
pointer (ipitettypo, itettypo)
|
|
pointer (ipiteto, iteto)
|
|
pointer (ipitetoffo, itetoffo)
|
|
integer itettypo(lenptr), iteto(8*lenptr), itetoffo(lenptr)
|
|
|
|
pointer (ipitetkido, itetkido)
|
|
pointer (ipitetxsecto, itetxsecto)
|
|
integer itetkido(lenptr), itetxsecto(lenptr)
|
|
|
|
C
|
|
C K-d tree type stuff
|
|
pointer (iplinkto,linkto)
|
|
pointer (ipitfound,itfound)
|
|
integer linkto(lenptr), itfound(lenptr)
|
|
|
|
pointer (ipsboxo,sboxo)
|
|
real*8 sboxo(2,3,lenptr)
|
|
|
|
parameter(local_epsilon=1.0d-10)
|
|
C
|
|
C
|
|
C#####################################################################
|
|
C
|
|
C Initialize Error Flag and other assorted goodies
|
|
C
|
|
orig_nwds = nwds
|
|
ierror = 0
|
|
ineg = 0
|
|
init_attrib = 0
|
|
ierror2 = 0
|
|
zero = 0.0
|
|
cmoin = '-cmo-'
|
|
cmoout = '-none-'
|
|
isubname = 'intersect_elements'
|
|
|
|
|
|
C
|
|
C######################################################################
|
|
C
|
|
C Check the gross syntax of the command entered
|
|
C
|
|
C Check for optional -init- to initialize the intersect attribute
|
|
if(msgtype(orig_nwds).eq.3 .and. orig_nwds.gt.3) then
|
|
strlen=icharlnf(cmsgin(orig_nwds))
|
|
if (cmsgin(orig_nwds)(1:strlen).eq.'-init-') then
|
|
init_attrib = 1
|
|
orig_nwds = orig_nwds-1
|
|
endif
|
|
endif
|
|
if((orig_nwds.ne.4).and.(orig_nwds.ne.3)) then
|
|
write(logmess,'(a)')
|
|
& 'Error in subroutine intersect_elements: The Syntax is:'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
write(logmess,'(a)')
|
|
& 'intersect_elements/mesh_sink/mesh_source/[attrib_name][-init-]'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ierror = 1
|
|
go to 9999
|
|
endif
|
|
C
|
|
C######################################################################
|
|
C
|
|
C Initialize the Mesh Objects (Harder than it sounds)
|
|
C
|
|
C *****************************************************************
|
|
C Ensure that the incoming MO name is a valid one, and if it is
|
|
C the default, get the real name.
|
|
C
|
|
strlen=icharlnf(cmsgin(3))
|
|
cmoin=cmsgin(3)(1:strlen)
|
|
if((cmoin.eq.'-cmo-').or.(cmoin.eq.'-def-')) then
|
|
call cmo_get_name(cmoin,ierror)
|
|
endif
|
|
C
|
|
C *****************************************************************
|
|
C Check if the incoming MO exists
|
|
C
|
|
call cmo_exist(cmoin,ierror)
|
|
if(ierror.ne.0) then
|
|
write(logmess,'(a)')
|
|
& 'Error in intersect_elements: input MO does not exist'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ierror = 1
|
|
go to 9999
|
|
endif
|
|
C
|
|
C *****************************************************************
|
|
C Check if the outgoing MO exists
|
|
C
|
|
strlen=icharlnf(cmsgin(2))
|
|
cmoout=cmsgin(2)(1:strlen)
|
|
call cmo_exist(cmoout,ierror)
|
|
if(ierror.ne.0) then
|
|
write(logmess,'(a)')
|
|
& 'Error in intersect_elements: output MO does not exist'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ierror = 1
|
|
go to 9999
|
|
endif
|
|
C
|
|
C *****************************************************************
|
|
C Ensure that the incoming and outgoing MOs aren't the same.
|
|
if(cmoin.eq.cmoout) then
|
|
write(logmess,'(a)')
|
|
& 'Error in intersect_elements: input and output MOs'
|
|
& // ' are the same!'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ierror = 1
|
|
goto 9999
|
|
endif
|
|
C
|
|
C *****************************************************************
|
|
C Get the pointers for cmoin pointing to some valid data
|
|
call cmo_get_info('nnodes',cmoin,nnodesin,ilen,icmotype,ierror)
|
|
|
|
call cmo_get_info('nelements',cmoin,
|
|
& nelementsin,ilen,icmotype,ierror)
|
|
call cmo_get_info('nodes_per_element',cmoin,
|
|
& nenin,ilen,icmotype,ierror)
|
|
call cmo_get_info('xic',cmoin,ipxic,ilen,icmotype,ierror)
|
|
call cmo_get_info('yic',cmoin,ipyic,ilen,icmotype,ierror)
|
|
call cmo_get_info('zic',cmoin,ipzic,ilen,icmotype,ierror)
|
|
call cmo_get_info('itettyp',cmoin,ipitettyp,lenitettyp,icmotype
|
|
& ,ierror)
|
|
call cmo_get_info('itetoff',cmoin,ipitetoff,lenitetoff,icmotype
|
|
& ,ierror)
|
|
call cmo_get_info('itet',cmoin,ipitet,ilen,icmotype,ierror)
|
|
C
|
|
C *****************************************************************
|
|
C Get the pointers for cmoout pointing to some valid data
|
|
call cmo_get_info('nnodes',cmoout,nnodesout,ilen,icmotype,ierror)
|
|
call cmo_get_info('nelements',cmoout,
|
|
& nelementsout,ilen,icmotype,ierror)
|
|
call cmo_get_info('nodes_per_element',cmoin,
|
|
& nenout,ilen,icmotype,ierror)
|
|
call cmo_get_info('xic',cmoout,ipxico,ilen,icmotype,ierror)
|
|
call cmo_get_info('yic',cmoout,ipyico,ilen,icmotype,ierror)
|
|
call cmo_get_info('zic',cmoout,ipzico,ilen,icmotype,ierror)
|
|
call cmo_get_info('itettyp',cmoout,ipitettypo,lenitettyp,icmotype
|
|
& ,ierror)
|
|
call cmo_get_info('itetoff',cmoout,ipitetoffo,lenitetoff,icmotype
|
|
& ,ierror)
|
|
call cmo_get_info('itet',cmoout,ipiteto,ilen,icmotype,ierror)
|
|
C
|
|
C *****************************************************************
|
|
C Make sure that we got what we wanted.
|
|
if(ierror.ne.0) then
|
|
write(logmess,'(a)')
|
|
& 'Error in intersect_elements: a cmo_get_info failed'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ierror = 1
|
|
go to 9999
|
|
endif
|
|
if (nelementsout.lt.1) then
|
|
write(logmess,'(a,a,a)')
|
|
& 'Warning: ',cmoout(1:icharlnf(cmoout)),
|
|
& ' has no elements for intersect.'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
endif
|
|
if (nelementsin.lt.1) then
|
|
write(logmess,'(a,a,a)')
|
|
& 'Warning: ',cmoin(1:icharlnf(cmoin)),
|
|
& ' has no elements for intersect.'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ierror = -1
|
|
goto 9999
|
|
endif
|
|
|
|
C
|
|
C *****************************************************************
|
|
C Figure out if we have an AMR code (this is based on the itetkid
|
|
C attribute)
|
|
call cmo_get_info('itetkid',cmoout,ipitetkido,ilen,icmotype
|
|
& ,ierror)
|
|
if(ierror.ne.0) then
|
|
iomrgrid = 0
|
|
ierror = 0
|
|
else
|
|
iomrgrid = 1
|
|
endif
|
|
C
|
|
C
|
|
C *****************************************************************
|
|
C Create the appropriate attribute for intersection.
|
|
if(orig_nwds.eq.4) then
|
|
strlen = icharlnf(cmsgin(4))
|
|
attribname = cmsgin(4)(1:strlen)
|
|
strlen = icharlnf(attribname)
|
|
else
|
|
strlen = icharlnf(cmoin)
|
|
attribname = 'in_' // cmoin(1:strlen)
|
|
strlen = icharlnf(attribname)
|
|
endif
|
|
|
|
c setup for writing progress messeges
|
|
c note, this routine does not check pntlim for mpno
|
|
num_src = nelementsin
|
|
num_snk = nelementsout
|
|
iwrite = 0
|
|
ireport = 0
|
|
totsrchd = 0
|
|
totfind = 0
|
|
totflag = 0
|
|
istep = 1
|
|
if ( max(num_snk,num_src) .gt. 500000 ) then
|
|
xperc = 50.
|
|
iperc = 2
|
|
elseif ( max(num_snk,num_src) .gt. 10000 ) then
|
|
xperc = 20.
|
|
iperc = 5
|
|
else
|
|
xperc = 4.
|
|
iperc = 25
|
|
endif
|
|
nwrite = nint(dble(num_src)/ xperc )
|
|
|
|
C
|
|
C
|
|
C *****************************************************************
|
|
C Find out if the output cmo has a K-d tree built already, if it
|
|
C doesn't, build one for it via the kdtree command.
|
|
ierror = 0
|
|
call cmo_get_info('linkt',cmoout,iplinkto,ilen,icmotype,ierror)
|
|
call cmo_get_info('sbox',cmoout,ipsboxo,ilen,icmotype,ierror2)
|
|
if((ierror.ne.0).or.(ierror2.ne.0)) then
|
|
ierror = 0
|
|
strlen = icharlnf(cmoout)
|
|
cmdmess = 'cmo/select/' // cmoout(1:strlen) // '; finish'
|
|
call dotaskx3d(cmdmess,ierror)
|
|
cmdmess = 'kdtree/build; finish'
|
|
call dotaskx3d(cmdmess,ierror)
|
|
endif
|
|
C
|
|
C *****************************************************************
|
|
C Get the K-d tree attributes (again, if necessary)
|
|
ierror = 0
|
|
call cmo_get_info('linkt',cmoout,iplinkto,ilen,icmotype,ierror)
|
|
call cmo_get_info('sbox',cmoout,ipsboxo,ilen,icmotype,ierror)
|
|
if (ierror.ne.0) then
|
|
write(logmess,'(a)')
|
|
& 'Error in intersect_elements: subsidiary addatt commands'
|
|
& // ' failed'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ierror = 1
|
|
goto 9999
|
|
endif
|
|
C
|
|
C Check to see if the attribute exists already, if it doesn't,
|
|
C create it.
|
|
call cmo_get_info(attribname(1:icharlnf(attribname)),
|
|
& cmoout,ipitetxsecto,
|
|
& ilen,icmotype,ierror)
|
|
if (ierror.ne.0) then
|
|
cmdmess = 'cmo/addatt/' // cmoout(1:icharlnf(cmoout))
|
|
& // '/' // attribname(1:icharlnf(attribname))
|
|
& // '/VINT/scalar/nelements/linear/permanent/ /0/'
|
|
& // '; finish'
|
|
ierror = 0
|
|
call dotaskx3d(cmdmess,ierror)
|
|
if(ierror.ne.0) then
|
|
write(logmess,'(a)')
|
|
& 'Error in intersect_elements: subsidiary addatt commands'
|
|
& // ' failed'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ierror = 1
|
|
goto 9999
|
|
endif
|
|
call cmo_get_info(attribname(1:icharlnf(attribname)),
|
|
& cmoout,ipitetxsecto,
|
|
& ilen,icmotype,ierror)
|
|
else
|
|
if (init_attrib.eq.0) then
|
|
write(logmess,'(a,a)')
|
|
& 'intersect_elements using previously defined attribute: '
|
|
& // attribname(1:icharlnf(attribname))
|
|
call writloga('default',0,logmess,0,ierror)
|
|
else
|
|
write(logmess,'(a,a)')
|
|
& 'intersect_elements initializing previously defined attribute: '
|
|
& // attribname(1:icharlnf(attribname))
|
|
call writloga('default',0,logmess,0,ierror)
|
|
cmdmess = 'cmo/setatt/' // cmoout(1:icharlnf(cmoout))
|
|
& // '/' // attribname(1:icharlnf(attribname))
|
|
& // '/1,0,0/0/ ; finish'
|
|
ierror = 0
|
|
call dotaskx3d(cmdmess,ierror)
|
|
if(ierror.ne.0) then
|
|
write(logmess,'(a)')
|
|
& 'Error in intersect_elements: subsidiary setatt command'
|
|
& // ' failed'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ierror = 1
|
|
goto 9999
|
|
endif
|
|
endif
|
|
endif
|
|
C
|
|
C *****************************************************************
|
|
C This is the QUICK AND DIRTY METHOD, NEEDS OPTIMIZATION
|
|
C Now that we have the tree set up, run through the elements of
|
|
C cmoin, and then have the intersect_elements subroutine tell us
|
|
C whether or not the elements intersect, and how many times they do
|
|
C
|
|
C Allocate memory for the kdtree search results
|
|
call mmgetblk('itfound',isubname,ipitfound,nelementsout,1,iflag)
|
|
ifound = 0
|
|
ifoundstep = 0
|
|
|
|
C loop through each element of cmoin
|
|
do i=1,nelementsin
|
|
C
|
|
C Run through the nodes in the current element and create a
|
|
C bounding box that specifies the search area for the
|
|
C k-D tree subroutine.
|
|
C
|
|
do j = 1,nelmnen(itettyp(i))
|
|
k = itet(itetoff(i)+j)
|
|
xnodes1(j) = xic(k)
|
|
ynodes1(j) = yic(k)
|
|
znodes1(j) = zic(k)
|
|
enddo
|
|
C
|
|
C At this point, we have the bounding box, as well as the
|
|
C element filled in; the next step is to find the elements that
|
|
C are "close" to the element in question using the k-D tree.
|
|
call kDtreeselect(itettyp(i),xnodes1,ynodes1,znodes1,
|
|
& linkto,sboxo,numfound,itfound,iflag)
|
|
|
|
ifound = 0
|
|
do l = 1,numfound
|
|
if(iomrgrid.eq.1) then
|
|
if(itetkido(itfound(l)).gt.0.0) then
|
|
goto 100
|
|
endif
|
|
endif
|
|
do m = 1,nelmnen(itettypo(itfound(l)))
|
|
n = iteto(itetoffo(itfound(l))+m)
|
|
xnodes2(m) = xico(n)
|
|
ynodes2(m) = yico(n)
|
|
znodes2(m) = zico(n)
|
|
enddo
|
|
|
|
C Detirmine if the two elements intersect
|
|
call xsectelements(itettyp(i),xnodes1,ynodes1,znodes1,
|
|
& itettypo(itfound(l)),xnodes2,ynodes2,znodes2,
|
|
& iflag)
|
|
|
|
C increment attribute each time intersection is found
|
|
C check for negative values in the added attribute
|
|
C this can happen if an attribute is used for something other
|
|
C than intersect and is not reset before being used again here
|
|
if (iflag.ge.0) then
|
|
if (itetxsecto(itfound(l)).eq. zero) ifound = ifound + 1
|
|
itetxsecto(itfound(l)) = itetxsecto(itfound(l)) + 1
|
|
if (itetxsecto(itfound(l)).lt.0 .and. ineg.eq.0) then
|
|
write(logmess,'(a,a,a)')
|
|
& 'Warning: ',attribname(1:icharlnf(attribname)),
|
|
& ' has negative value(s) assigned outside this routine.'
|
|
call writloga('default',0,logmess,0,ierror)
|
|
ineg=1
|
|
endif
|
|
endif
|
|
100 continue
|
|
|
|
C End loop through search elements
|
|
enddo
|
|
totsrchd = totsrchd + numfound
|
|
totfind = totfind + ifound
|
|
ifoundstep = ifoundstep + ifound
|
|
|
|
C Report progress of element search
|
|
num_snk = nelementsin
|
|
ipt = i
|
|
iisrc = l
|
|
if(ipt.eq.1) then
|
|
write(logmess,"(a)")
|
|
*' Element Elems Searched Elements Found Percent Done'
|
|
call writloga('default',1,logmess,0,ierrw)
|
|
endif
|
|
if((iwrite.eq.nwrite).and.(ipt.ne.num_snk)) then
|
|
iwrite = 0
|
|
write(logmess,"(i15,i17,i15,i9,a2)")
|
|
* ipt,totsrchd,ifoundstep,istep*iperc,' %'
|
|
call writloga('default',0,logmess,0,ierrw)
|
|
istep = istep + 1
|
|
ifoundstep = 0
|
|
elseif(ipt .eq. num_snk) then
|
|
write(logmess,"(i15,i17,i15,a)")
|
|
* ipt,totsrchd,totfind,' Total Done'
|
|
call writloga('default',0,logmess,1,ierrw)
|
|
endif
|
|
|
|
iwrite = iwrite+1
|
|
|
|
c End i Loop through all sink elements
|
|
enddo
|
|
C
|
|
C *****************************************************************
|
|
C Deallocate Memory
|
|
C
|
|
C *****************************************************************
|
|
C Remove kdtree data structure from the CMO
|
|
C
|
|
ierror = 0
|
|
strlen = icharlnf(cmoout)
|
|
cmdmess = 'cmo/select/' // cmoout(1:strlen) // '; finish'
|
|
call dotaskx3d(cmdmess,ierror)
|
|
cmdmess = 'kdtree/release; finish'
|
|
call dotaskx3d(cmdmess,ierror)
|
|
C
|
|
C *****************************************************************
|
|
C
|
|
9995 call mmrelprt(isubname,ierror)
|
|
C
|
|
C We're done...
|
|
9999 continue
|
|
if (ierror .eq. -1) then
|
|
write(logmess,'(a,a)')
|
|
& 'intersect_elements exiting with no search.'
|
|
call writloga('default',0,logmess,1,ierror)
|
|
else if (ierror .ne. 0) then
|
|
write(logmess,'(a,a,i5)')
|
|
& 'intersect_elements ',
|
|
& ' exiting with error: ',ierror
|
|
call writloga('default',0,logmess,1,ierror)
|
|
endif
|
|
|
|
return
|
|
end
|
|
|
|
|