244 lines
8.1 KiB
Fortran
Executable File
244 lines
8.1 KiB
Fortran
Executable File
subroutine smoothedgetriple(an1,an2,bn1,bn2,coord,axcycle,aycycle,
|
|
* azcycle,bxcycle,bycycle,bzcycle,nx0,nx3,
|
|
* weight,ierr2)
|
|
c
|
|
c #####################################################################
|
|
c
|
|
c PURPOSE -
|
|
c
|
|
c This subroutine does volume-conserving smoothing of a triple
|
|
c line using edge relaxations.
|
|
c
|
|
c INPUT ARGUMENTS -
|
|
c
|
|
c an1 (bn1) - number of nodes on the surface of material a (b)
|
|
c that surround x1
|
|
c
|
|
c an2 (bn2) - number of nodes on the surface of material a (b)
|
|
c that surround x2
|
|
c
|
|
c coord - array of size 6 containing the x-coordinate of x1,
|
|
c y-coordinate of x1, z-coordinate of x1, x-coordinate of x2,
|
|
c y-coordinate of x2, z-coordinate of x2
|
|
c
|
|
c axcycle (bxcycle) - array of size an1+an2-4 (bn1+bn2-4)
|
|
c containing the x-coordinates of the counterclockwise cycle of
|
|
c nodes on the surface of material a (b) that surround the edge
|
|
c x1-x2, starting with the first node counterclockwise of x2 when
|
|
c rotating around x1
|
|
c
|
|
c aycycle (bycycle) - same as axcycle (bxcycle) except contains
|
|
c y-coordinates
|
|
c
|
|
c azcycle (bzcycle) - same as axcycle (bxcycle) except contains
|
|
c z-coordinates
|
|
c
|
|
c nx0 (nx3) - index of x0 (x3) in axcycle, aycycle, azcycle
|
|
c
|
|
c weight - number between 0 and 1, inclusive, which controls the
|
|
c amount of smoothing
|
|
c
|
|
c ierr2 - error flag
|
|
c
|
|
c OUTPUT ARGUMENTS -
|
|
c
|
|
c coord, ierr2
|
|
c
|
|
c CHANGE HISTORY -
|
|
c
|
|
c $Log: smooth_vconserve_triple.f,v $
|
|
c Revision 2.00 2007/11/09 20:04:03 spchu
|
|
c Import to CVS
|
|
c
|
|
CPVCS
|
|
CPVCS Rev 1.2 18 Feb 2001 16:29:58 nnc
|
|
CPVCS Trivial constant change to satisfy Absoft compiler.
|
|
CPVCS
|
|
CPVCS Rev 1.1 16 Aug 2000 08:48:20 dcg
|
|
CPVCS change subroutine name to match call from cycle_lg
|
|
CPVCS
|
|
CPVCS Rev 1.0 10 Aug 2000 11:58:32 dcg
|
|
CPVCS Initial revision.
|
|
c
|
|
c #####################################################################
|
|
c
|
|
implicit none
|
|
integer an1,an2,bn1,bn2
|
|
real*8 coord(6)
|
|
real*8 axcycle(an1+an2-4),aycycle(an1+an2-4),azcycle(an1+an2-4)
|
|
real*8 bxcycle(bn1+bn2-4),bycycle(bn1+bn2-4),bzcycle(bn1+bn2-4)
|
|
integer nx0,nx3
|
|
real*8 weight
|
|
integer ierr2
|
|
c
|
|
real*8 small
|
|
integer it
|
|
real*8 ae(3,204),be(3,204)
|
|
c The first an1 (bn1) columns of ae (be) are vectors from x1 to
|
|
c surrounding nodes, starting with x2, rotating counterclockwise on
|
|
c the surface of material a (b). The next an2 (bn2) columns of ae
|
|
c (be) are vectors from x2 to surrounding nodes, starting with x1,
|
|
c rotating counterclockwise on the surface of material a (b).
|
|
real*8 aA1(3),aA2(3),av(3)
|
|
real*8 bA1(3),bA2(3),bv(3)
|
|
real*8 temp1,dx1s(3),dx2s(3)
|
|
real*8 diff(3),aA(3),bA(3)
|
|
real*8 normaAsquared,normbAsquared,aAdotbA,det,ag,bg,h,k
|
|
real*8 n(3)
|
|
c
|
|
ierr2=0
|
|
c small should actually be computed
|
|
small=1.0e-13
|
|
c
|
|
c compute ae
|
|
do it=1,3
|
|
ae(it,1)=coord(3+it)-coord(it)
|
|
ae(it,an1+1)=-ae(it,1)
|
|
enddo
|
|
do it=2,an1
|
|
ae(1,it)=axcycle(it-1)-coord(1)
|
|
ae(2,it)=aycycle(it-1)-coord(2)
|
|
ae(3,it)=azcycle(it-1)-coord(3)
|
|
enddo
|
|
do it=an1+2,an1+an2-1
|
|
ae(1,it)=axcycle(it-3)-coord(4)
|
|
ae(2,it)=aycycle(it-3)-coord(5)
|
|
ae(3,it)=azcycle(it-3)-coord(6)
|
|
enddo
|
|
ae(1,an1+an2)=axcycle(1)-coord(4)
|
|
ae(2,an1+an2)=aycycle(1)-coord(5)
|
|
ae(3,an1+an2)=azcycle(1)-coord(6)
|
|
c
|
|
c compute be
|
|
do it=1,3
|
|
be(it,1)=coord(3+it)-coord(it)
|
|
be(it,bn1+1)=-be(it,1)
|
|
enddo
|
|
do it=2,bn1
|
|
be(1,it)=bxcycle(it-1)-coord(1)
|
|
be(2,it)=bycycle(it-1)-coord(2)
|
|
be(3,it)=bzcycle(it-1)-coord(3)
|
|
enddo
|
|
do it=bn1+2,bn1+bn2-1
|
|
be(1,it)=bxcycle(it-3)-coord(4)
|
|
be(2,it)=bycycle(it-3)-coord(5)
|
|
be(3,it)=bzcycle(it-3)-coord(6)
|
|
enddo
|
|
be(1,bn1+bn2)=bxcycle(1)-coord(4)
|
|
be(2,bn1+bn2)=bycycle(1)-coord(5)
|
|
be(3,bn1+bn2)=bzcycle(1)-coord(6)
|
|
c
|
|
c compute aA1 and aA2
|
|
do it=1,3
|
|
aA1(it)=0
|
|
aA2(it)=0
|
|
enddo
|
|
do it=1,an1-1
|
|
aA1(1)=aA1(1)+ae(2,it)*ae(3,it+1)-ae(3,it)*ae(2,it+1)
|
|
aA1(2)=aA1(2)+ae(3,it)*ae(1,it+1)-ae(1,it)*ae(3,it+1)
|
|
aA1(3)=aA1(3)+ae(1,it)*ae(2,it+1)-ae(2,it)*ae(1,it+1)
|
|
enddo
|
|
aA1(1)=aA1(1)+ae(2,an1)*ae(3,1)-ae(3,an1)*ae(2,1)
|
|
aA1(2)=aA1(2)+ae(3,an1)*ae(1,1)-ae(1,an1)*ae(3,1)
|
|
aA1(3)=aA1(3)+ae(1,an1)*ae(2,1)-ae(2,an1)*ae(1,1)
|
|
do it=an1+1,an1+an2-1
|
|
aA2(1)=aA2(1)+ae(2,it)*ae(3,it+1)-ae(3,it)*ae(2,it+1)
|
|
aA2(2)=aA2(2)+ae(3,it)*ae(1,it+1)-ae(1,it)*ae(3,it+1)
|
|
aA2(3)=aA2(3)+ae(1,it)*ae(2,it+1)-ae(2,it)*ae(1,it+1)
|
|
enddo
|
|
aA2(1)=aA2(1)+ae(2,an1+an2)*ae(3,an1+1)-ae(3,an1+an2)*ae(2,an1+1)
|
|
aA2(2)=aA2(2)+ae(3,an1+an2)*ae(1,an1+1)-ae(1,an1+an2)*ae(3,an1+1)
|
|
aA2(3)=aA2(3)+ae(1,an1+an2)*ae(2,an1+1)-ae(2,an1+an2)*ae(1,an1+1)
|
|
c
|
|
c compute av
|
|
do it=1,3
|
|
av(it)=ae(it,an1+an2)-ae(it,an1+2)
|
|
enddo
|
|
c
|
|
c compute bA1 and bA2
|
|
do it=1,3
|
|
bA1(it)=0
|
|
bA2(it)=0
|
|
enddo
|
|
do it=1,bn1-1
|
|
bA1(1)=bA1(1)+be(2,it)*be(3,it+1)-be(3,it)*be(2,it+1)
|
|
bA1(2)=bA1(2)+be(3,it)*be(1,it+1)-be(1,it)*be(3,it+1)
|
|
bA1(3)=bA1(3)+be(1,it)*be(2,it+1)-be(2,it)*be(1,it+1)
|
|
enddo
|
|
bA1(1)=bA1(1)+be(2,bn1)*be(3,1)-be(3,bn1)*be(2,1)
|
|
bA1(2)=bA1(2)+be(3,bn1)*be(1,1)-be(1,bn1)*be(3,1)
|
|
bA1(3)=bA1(3)+be(1,bn1)*be(2,1)-be(2,bn1)*be(1,1)
|
|
do it=bn1+1,bn1+bn2-1
|
|
bA2(1)=bA2(1)+be(2,it)*be(3,it+1)-be(3,it)*be(2,it+1)
|
|
bA2(2)=bA2(2)+be(3,it)*be(1,it+1)-be(1,it)*be(3,it+1)
|
|
bA2(3)=bA2(3)+be(1,it)*be(2,it+1)-be(2,it)*be(1,it+1)
|
|
enddo
|
|
bA2(1)=bA2(1)+be(2,bn1+bn2)*be(3,bn1+1)-be(3,bn1+bn2)*be(2,bn1+1)
|
|
bA2(2)=bA2(2)+be(3,bn1+bn2)*be(1,bn1+1)-be(1,bn1+bn2)*be(3,bn1+1)
|
|
bA2(3)=bA2(3)+be(1,bn1+bn2)*be(2,bn1+1)-be(2,bn1+bn2)*be(1,bn1+1)
|
|
c
|
|
c compute bv
|
|
do it=1,3
|
|
bv(it)=be(it,bn1+bn2)-be(it,bn1+2)
|
|
enddo
|
|
c
|
|
c compute dx1s and dx2s
|
|
temp1=2.d0/3.d0
|
|
dx1s(1)=axcycle(nx3)/3.d0+temp1*axcycle(nx0)-coord(1)
|
|
dx1s(2)=aycycle(nx3)/3.d0+temp1*aycycle(nx0)-coord(2)
|
|
dx1s(3)=azcycle(nx3)/3.d0+temp1*azcycle(nx0)-coord(3)
|
|
dx2s(1)=temp1*axcycle(nx3)+axcycle(nx0)/3.d0-coord(4)
|
|
dx2s(2)=temp1*aycycle(nx3)+aycycle(nx0)/3.d0-coord(5)
|
|
dx2s(3)=temp1*azcycle(nx3)+azcycle(nx0)/3.d0-coord(6)
|
|
do it=1,3
|
|
dx1s(it)=weight*dx1s(it)
|
|
dx2s(it)=weight*dx2s(it)
|
|
enddo
|
|
c
|
|
c compute aA
|
|
do it=1,3
|
|
diff(it)=dx1s(it)-dx2s(it)
|
|
enddo
|
|
aA(1)=aA1(1)+aA2(1)+av(2)*diff(3)-av(3)*diff(2)
|
|
aA(2)=aA1(2)+aA2(2)+av(3)*diff(1)-av(1)*diff(3)
|
|
aA(3)=aA1(3)+aA2(3)+av(1)*diff(2)-av(2)*diff(1)
|
|
c
|
|
c compute bA
|
|
bA(1)=bA1(1)+bA2(1)+bv(2)*diff(3)-bv(3)*diff(2)
|
|
bA(2)=bA1(2)+bA2(2)+bv(3)*diff(1)-bv(1)*diff(3)
|
|
bA(3)=bA1(3)+bA2(3)+bv(1)*diff(2)-bv(2)*diff(1)
|
|
c
|
|
normaAsquared=aA(1)**2+aA(2)**2+aA(3)**2
|
|
normbAsquared=bA(1)**2+bA(2)**2+bA(3)**2
|
|
aAdotbA=aA(1)*bA(1)+aA(2)*bA(2)+aA(3)*bA(3)
|
|
det=normaAsquared*normbAsquared-aAdotbA**2
|
|
if (det.le.small) then
|
|
print *, 'det <= small, nodes not moved'
|
|
elseif (det/(normaAsquared*normbAsquared).le.small) then
|
|
print *, 'sin2theta <= small, nodes not moved'
|
|
else
|
|
ag=dx2s(1)*(av(2)*dx1s(3)-av(3)*dx1s(2))+
|
|
* dx2s(2)*(av(3)*dx1s(1)-av(1)*dx1s(3))+
|
|
* dx2s(3)*(av(1)*dx1s(2)-av(2)*dx1s(1))
|
|
do it=1,3
|
|
ag=ag+dx1s(it)*aA1(it)+dx2s(it)*aA2(it)
|
|
enddo
|
|
ag=-ag
|
|
bg=dx2s(1)*(bv(2)*dx1s(3)-bv(3)*dx1s(2))+
|
|
* dx2s(2)*(bv(3)*dx1s(1)-bv(1)*dx1s(3))+
|
|
* dx2s(3)*(bv(1)*dx1s(2)-bv(2)*dx1s(1))
|
|
do it=1,3
|
|
bg=bg+dx1s(it)*bA1(it)+dx2s(it)*bA2(it)
|
|
enddo
|
|
bg=-bg
|
|
h=(normbAsquared*ag-aAdotbA*bg)/det
|
|
k=(normaAsquared*bg-aAdotbA*ag)/det
|
|
do it=1,3
|
|
n(it)=h*aA(it)+k*bA(it)
|
|
coord(it)=coord(it)+dx1s(it)+n(it)
|
|
coord(it+3)=coord(it+3)+dx2s(it)+n(it)
|
|
enddo
|
|
endif
|
|
return
|
|
end
|