initial upload
This commit is contained in:
180
src/tangent_plane.f
Executable file
180
src/tangent_plane.f
Executable file
@@ -0,0 +1,180 @@
|
||||
subroutine tangent_plane(xic,yic,zic,it,inode,int1,itetoff,
|
||||
* jtetoff,itet,jtet,itettyp,itetclr,iparent,nef,mbndry,epsln,
|
||||
* a,b,c,d)
|
||||
C
|
||||
C #####################################################################
|
||||
C
|
||||
C PURPOSE -
|
||||
C
|
||||
C This routine computes the (angle-weighted) synthetic normal
|
||||
C around INODE in a triangular mesh (a,b,c). It then computes
|
||||
C the equation of the tangent plane at this node (a,b,c,d)
|
||||
C
|
||||
C INPUT ARGUMENTS -
|
||||
C
|
||||
C XIC,YIC,ZIC -- x,y,z node coordinate arrays.
|
||||
C IT -- tet number one of whose vertices is inode.
|
||||
C INODE -- local central node number wrt. it.
|
||||
C INT1 -- node indexed array =1 if node is on query surface
|
||||
C =0 if node is not on surface.
|
||||
C ITETOFF,JTETOFF,ITET1,JTET1 - connectivity of mesh object
|
||||
C ITETTYP -- array of element types
|
||||
C IPARENT -- parent node array.
|
||||
C NEF -- number of faces for this mesh object - must be 4.
|
||||
C MBNDRY -- interface/boundary flag value
|
||||
C EPSLN -- mesh object epsilon
|
||||
C
|
||||
C OUTPUT ARGUMENTS -
|
||||
C
|
||||
C A,B,C -- synthetic normal.
|
||||
C A,B,C,D -- equation of plane is Ax+By+Cz+D=0.
|
||||
C
|
||||
C CHANGE HISTORY -
|
||||
C
|
||||
C $Log: tangent_plane.f,v $
|
||||
C Revision 2.00 2007/11/09 20:04:04 spchu
|
||||
C Import to CVS
|
||||
C
|
||||
CPVCS
|
||||
CPVCS Rev 1.5 Tue Feb 23 15:20:52 1999 dcg
|
||||
CPVCS check for matching colors of elements when accepting
|
||||
CPVCS contributions for the tangent plane
|
||||
CPVCS
|
||||
CPVCS Rev 1.4 Thu Dec 24 13:55:26 1998 dcg
|
||||
CPVCS allow for parent/child chains
|
||||
CPVCS
|
||||
CPVCS Rev 1.3 Wed Dec 23 13:59:12 1998 jtg
|
||||
CPVCS removed duplicate declaration of a
|
||||
CPVCS
|
||||
CPVCS Rev 1.2 Thu Dec 03 13:00:46 1998 dcg
|
||||
CPVCS fix complicated nested if
|
||||
CPVCS
|
||||
CPVCS Rev 1.1 Thu Dec 03 12:39:22 1998 dcg
|
||||
CPVCS fix tests for inclusion of boundary faces
|
||||
C
|
||||
implicit none
|
||||
include 'local_element.h'
|
||||
include 'consts.h'
|
||||
|
||||
integer inode,nelts,ielts(*),iparent(*),itet(*),itetoff(*),
|
||||
* jtet(*),jtetoff(*),int1(*),it,itettyp(*),nef,ityp,mbndry,
|
||||
* nf,itetclr(*),iclref
|
||||
real*8 xic(*),yic(*),zic(*),a,b,c,d
|
||||
|
||||
pointer (ipielts,ielts)
|
||||
real*8 ax,ay,az
|
||||
|
||||
real*8 epsln,asumx,asumy,asumz,top,bot,ang,atot
|
||||
integer ind1,ind2,ind3,ielt,i1,i2,i3,j,itest,
|
||||
* ipari1,ipari2,ipari3,ipartest
|
||||
character*32 isubname
|
||||
character*132 logmess
|
||||
integer icscode,len_nelts
|
||||
save len_nelts
|
||||
|
||||
include 'statementfunctions.h'
|
||||
|
||||
data len_nelts/0/
|
||||
|
||||
isubname='tangent_plane'
|
||||
if(nef.ne.4) then
|
||||
write(logmess,10) nef
|
||||
10 format ('tangent_plane calculation valid only for tet meshes ',
|
||||
* 'number of faces not = 4 ',i5)
|
||||
call writloga('default',0,logmess,0,icscode)
|
||||
endif
|
||||
C
|
||||
C get all elements that surround inode
|
||||
C
|
||||
nelts=100
|
||||
call mmgetblk('ielts',isubname,ipielts,nelts,1,icscode)
|
||||
call get_elements_around_node(it,inode,nelts,ipielts,
|
||||
* itetoff,jtetoff,itet,jtet,itettyp,iparent,nef,mbndry)
|
||||
C
|
||||
C restrict calculation to faces on surface or faces containing
|
||||
C requested edges on external boundaries
|
||||
C
|
||||
asumx=0.
|
||||
asumy=0.
|
||||
asumz=0.
|
||||
iclref=itetclr(it)
|
||||
itest=itet(itetoff(it)+inode)
|
||||
ipartest= iparent(itest)
|
||||
do j=1,nelts
|
||||
ielt=ielts(j)
|
||||
ityp = itettyp(ielt)
|
||||
if(ityp.ne.ifelmtet) then
|
||||
write(logmess,12) ityp
|
||||
12 format(
|
||||
* 'tangent_plane calculation valid only for tet meshes ',
|
||||
* 'element type not = 5 ',i5)
|
||||
call writloga('default',0,logmess,0,icscode)
|
||||
endif
|
||||
if(itetclr(ielt).eq.iclref) then
|
||||
do nf = 1,4
|
||||
i1=itet(itetoff(ielt)+ielmface1(1,nf,ityp))
|
||||
i2=itet(itetoff(ielt)+ielmface1(2,nf,ityp))
|
||||
i3=itet(itetoff(ielt)+ielmface1(3,nf,ityp))
|
||||
ipari1=iparent(i1)
|
||||
ipari2=iparent(i2)
|
||||
ipari3=iparent(i3)
|
||||
if (((int1(i1)+int1(i2)+int1(i3).eq.3).or.
|
||||
* ((int1(i1)+int1(i2)+int1(i3).ge.1).and.
|
||||
* (jtet(jtetoff(ielt)+nf).eq.mbndry)))
|
||||
* .and.
|
||||
* (ipari1.eq.ipartest.or.ipari2.eq.ipartest.or.
|
||||
* ipari3.eq.ipartest))
|
||||
* then
|
||||
if(ipari1.eq.ipartest) then
|
||||
ind1=i1
|
||||
ind2=i2
|
||||
ind3=i3
|
||||
elseif(ipari2.eq.ipartest) then
|
||||
ind1=i2
|
||||
ind2=i3
|
||||
ind3=i1
|
||||
elseif(ipari3.eq.ipartest) then
|
||||
ind1=i3
|
||||
ind2=i1
|
||||
ind3=i2
|
||||
endif
|
||||
C
|
||||
C this face is a contributor
|
||||
C
|
||||
ax=dcrosx(xic(ind1),yic(ind1),zic(ind1),xic(ind2),
|
||||
& yic(ind2),zic(ind2),xic(ind3),yic(ind3),zic(ind3))
|
||||
ay=dcrosy(xic(ind1),yic(ind1),zic(ind1),xic(ind2),
|
||||
& yic(ind2),zic(ind2),xic(ind3),yic(ind3),zic(ind3))
|
||||
az=dcrosz(xic(ind1),yic(ind1),zic(ind1),xic(ind2),
|
||||
& yic(ind2),zic(ind2),xic(ind3),yic(ind3),zic(ind3))
|
||||
top=(xic(ind2)-xic(ind1))*(xic(ind3)-xic(ind1))+
|
||||
* (yic(ind2)-yic(ind1))*(yic(ind3)-yic(ind1))+
|
||||
& (zic(ind2)-zic(ind1))*(zic(ind3)-zic(ind1))
|
||||
bot=sqrt((xic(ind2)-xic(ind1))**2+
|
||||
* (yic(ind2)-yic(ind1))**2+
|
||||
& (zic(ind2)-zic(ind1))**2)*
|
||||
* sqrt((xic(ind3)-xic(ind1))**2+
|
||||
& (yic(ind3)-yic(ind1))**2+
|
||||
* (zic(ind3)-zic(ind1))**2)
|
||||
if (bot.lt.epsln**2) then
|
||||
ang=1.5707963267948966
|
||||
else
|
||||
ang=acos(top/bot)
|
||||
endif
|
||||
a=max(epsln,sqrt(ax**2+ay**2+az**2))
|
||||
asumx=asumx+ax*ang/a
|
||||
asumy=asumy+ay*ang/a
|
||||
asumz=asumz+az*ang/a
|
||||
endif
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
atot=max(epsln,sqrt(asumx**2+asumy**2+asumz**2))
|
||||
a=asumx/atot
|
||||
b=asumy/atot
|
||||
c=asumz/atot
|
||||
i1=itet(itetoff(it)+inode)
|
||||
d=-a*xic(i1)-b*yic(i1)-c*zic(i1)
|
||||
call mmrelprt(isubname,icscode)
|
||||
return
|
||||
end
|
||||
Reference in New Issue
Block a user