202 lines
5.6 KiB
FortranFixed
202 lines
5.6 KiB
FortranFixed
|
c 1-D Moving Interface User Element - JGrogan 2012.
|
||
|
|
c Subroutine UEXTERNALDB
|
||
|
|
c Calculates interface velocity and position at the start of each increment
|
||
|
|
c and passes it to UEL via common block. It requires a list of current nodal
|
||
|
|
c coordinates, and 'T' and 'a' degrees of freedom.
|
||
|
|
|
||
|
|
subroutine uexternaldb(lop,lrestart,time,dtime,kstep,kinc)
|
||
|
|
c
|
||
|
|
include 'aba_param.inc'
|
||
|
|
c
|
||
|
|
real dpos, npos(6), ndof(6)
|
||
|
|
common dpos,npos,ndof
|
||
|
|
dimension time(2)
|
||
|
|
c
|
||
|
|
if (lop==0)then
|
||
|
|
c initialise common blocks
|
||
|
|
dpos=0.
|
||
|
|
npos=0.
|
||
|
|
tn=0.
|
||
|
|
an=0.
|
||
|
|
print *,'npos',npos,'extrn1',time
|
||
|
|
print *,'ndof',ndof,'extrn1',time
|
||
|
|
else
|
||
|
|
print *,'npos',npos,'extrn',time
|
||
|
|
print *,'ndof',ndof,'extrn',time
|
||
|
|
endif
|
||
|
|
return
|
||
|
|
end
|
||
|
|
c
|
||
|
|
c Subroutine UEL
|
||
|
|
c Calculates element mass and stiffness matrices and residual flux
|
||
|
|
c vector for Abaqus NR Solver.
|
||
|
|
|
||
|
|
subroutine uel(rhs,amatrx,svars,energy,ndofel,nrhs,nsvars,props
|
||
|
|
1 ,nprops,coords,mcrd,nnode,u,du,v,a,jtype,time,dtime,kstep,
|
||
|
|
2 kinc,jelem,params,ndload,jdltyp,adlmag,predef,npredf,lflags
|
||
|
|
3 ,mlvarx,ddlmag,mdload,pnewdt,jprops,njprop,period)
|
||
|
|
c
|
||
|
|
include 'aba_param.inc'
|
||
|
|
c
|
||
|
|
dimension rhs(mlvarx,*),amatrx(ndofel,ndofel),svars(nsvars),
|
||
|
|
1 energy(8),props(*),coords(mcrd,nnode),
|
||
|
|
2 u(ndofel),du(mlvarx,*),v(ndofel),a(ndofel),time(2),
|
||
|
|
3 params(3),jdltyp(mdload,*),adlmag(mdload,*),
|
||
|
|
4 ddlmag(mdload,*),predef(2,npredf,nnode),lflags(*),jprops(*)
|
||
|
|
c
|
||
|
|
dimension gpx(4),gwei(4),phi(4),phix(4),phic(4),gm(4),gm2(4,4)
|
||
|
|
dimension theta(2)
|
||
|
|
real dpos, npos(6), ndof(6)
|
||
|
|
common dpos,npos,ndof
|
||
|
|
c
|
||
|
|
c level set calculation
|
||
|
|
c store nodal positions and temperatures
|
||
|
|
npos(jelem)=coords(1,1)
|
||
|
|
npos(jelem+1)=coords(1,2)
|
||
|
|
ndof(2*jelem-1)=u(1)
|
||
|
|
ndof(2*jelem)=u(2)
|
||
|
|
dpos1=0.2+0.4*time(1)
|
||
|
|
c print *,'npos',npos,'uel',time
|
||
|
|
c print *,'ndof',ndof,'uel',time
|
||
|
|
c material property definition
|
||
|
|
rho = 1.
|
||
|
|
spec = 1.
|
||
|
|
c penalty term
|
||
|
|
beta=40.
|
||
|
|
c initialization (nrhs=1)
|
||
|
|
do k1=1,ndofel
|
||
|
|
rhs(k1,nrhs)=0.
|
||
|
|
do k2=1,ndofel
|
||
|
|
amatrx(k2,k1)=0.
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
if (lflags(3).eq.4) return
|
||
|
|
c transient analysis
|
||
|
|
if (lflags(1).eq.33) then
|
||
|
|
c determine node level set params
|
||
|
|
crdn1=coords(1,1)
|
||
|
|
crdn2=coords(1,2)
|
||
|
|
theta(1)=abs(crdn1-dpos1)*sign(1.,crdn1-dpos1)
|
||
|
|
theta(2)=abs(crdn2-dpos1)*sign(1.,crdn2-dpos1)
|
||
|
|
enr=2
|
||
|
|
elen=abs(crdn2-crdn1)
|
||
|
|
ajacob=elen/2.
|
||
|
|
if (sign(1.,theta(1))/=sign(1.,theta(2)))then
|
||
|
|
c enriched element
|
||
|
|
enr=4
|
||
|
|
point=(dpos1-crdn1)/ajacob-1.
|
||
|
|
rlen1=abs(-point-1.)
|
||
|
|
rlen2=abs(1.-point)
|
||
|
|
rmid1=-1.+rlen1/2.
|
||
|
|
rmid2=1.-rlen2/2.
|
||
|
|
c Get int point locations and weights
|
||
|
|
gpx(1)=-(rlen1/2.)/sqrt(3.)+rmid1
|
||
|
|
gpx(2)=(rlen1/2.)/sqrt(3.)+rmid1
|
||
|
|
gpx(3)=-(rlen2/2.)/sqrt(3.)+rmid2
|
||
|
|
gpx(4)=(rlen2/2.)/sqrt(3.)+rmid2
|
||
|
|
gwei(1)=(rlen1/2.)
|
||
|
|
gwei(2)=(rlen1/2.)
|
||
|
|
gwei(3)=(rlen2/2.)
|
||
|
|
gwei(4)=(rlen2/2.)
|
||
|
|
else
|
||
|
|
c regular element
|
||
|
|
gpx(1)=-1./sqrt(3.)
|
||
|
|
gpx(2)=1./sqrt(3.)
|
||
|
|
gwei(1)=1.
|
||
|
|
gwei(2)=1.
|
||
|
|
endif
|
||
|
|
c assemble amatrx and rhs
|
||
|
|
do k=1,enr
|
||
|
|
c loop through gauss pts: i
|
||
|
|
c=gpx(k)
|
||
|
|
c get ip level set value: Oi
|
||
|
|
c get shape functions and derivatives
|
||
|
|
c Ni
|
||
|
|
phi(1)=(1.-c)/2.
|
||
|
|
phi(3)=(1.+c)/2.
|
||
|
|
term=theta(1)*phi(1)+theta(2)*phi(3)
|
||
|
|
if (term<0.)then
|
||
|
|
cond=0.
|
||
|
|
spec=0.1
|
||
|
|
else
|
||
|
|
cond=1.
|
||
|
|
spec=1.
|
||
|
|
endif
|
||
|
|
if(enr==4)then
|
||
|
|
phi(2)=phi(1)*(abs(term)-abs(theta(1)))
|
||
|
|
phi(4)=phi(3)*(abs(term)-abs(theta(2)))
|
||
|
|
else
|
||
|
|
phi(2)=0.
|
||
|
|
phi(4)=0.
|
||
|
|
endif
|
||
|
|
c dNdci
|
||
|
|
phic(1)=-0.5
|
||
|
|
phic(3)=0.5
|
||
|
|
dterm=sign(1.,term)*(phic(1)*theta(1)+phic(3)*theta(2))
|
||
|
|
if(enr==4)then
|
||
|
|
phic(2)=phic(1)*(abs(term)-abs(theta(1)))
|
||
|
|
1 +phi(1)*dterm
|
||
|
|
phic(4)=phic(3)*(abs(term)-abs(theta(2)))
|
||
|
|
1 +phi(3)*dterm
|
||
|
|
else
|
||
|
|
phic(2)=0.
|
||
|
|
phic(4)=0.
|
||
|
|
endif
|
||
|
|
c dNdxi
|
||
|
|
phix(1)=phic(1)*(1./ajacob)
|
||
|
|
phix(2)=phic(2)*(1./ajacob)
|
||
|
|
phix(3)=phic(3)*(1./ajacob)
|
||
|
|
phix(4)=phic(4)*(1./ajacob)
|
||
|
|
c interpolate temperatures Tbar to int point: i
|
||
|
|
dtdx=u(1)*phix(1)+u(2)*phix(2)
|
||
|
|
1 +u(3)*phix(3)+u(4)*phix(4)
|
||
|
|
t=u(1)*phi(1)+u(2)*phi(2)
|
||
|
|
1 +u(3)*phi(3)+u(4)*phi(4)
|
||
|
|
told=(u(1)-du(1,nrhs))*phi(1)+(u(2)-du(2,nrhs))*phi(2)+
|
||
|
|
1 (u(3)-du(3,nrhs))*phi(3)+(u(4)-du(4,nrhs))*phi(4)
|
||
|
|
c other housekeeping
|
||
|
|
dtdt=(t-told)/dtime
|
||
|
|
we=gwei(k)*ajacob
|
||
|
|
c Assemble Element Stiffness Matrix and Add to Global
|
||
|
|
do ki=1,4
|
||
|
|
c loop over nodes
|
||
|
|
rhs(ki,nrhs)=rhs(ki,nrhs)-we*(phi(ki)*rho*spec*dtdt
|
||
|
|
1 + cond*(phix(ki)*dtdx))
|
||
|
|
do kj=1,4
|
||
|
|
amatrx(ki,kj)=amatrx(ki,kj)+we*(phi(ki)*phi(kj)
|
||
|
|
1 *rho*spec/dtime+cond*(phix(ki)*phix(kj)))
|
||
|
|
end do
|
||
|
|
end do
|
||
|
|
enddo
|
||
|
|
end if
|
||
|
|
c if interface is in the element an penalty term is needed
|
||
|
|
if(enr==4)then
|
||
|
|
xi=point
|
||
|
|
gm(1)=(1.-xi)/2.
|
||
|
|
gm(3)=(1.+xi)/2.
|
||
|
|
term=theta(1)*gm(1)+theta(2)*gm(3)
|
||
|
|
gm(2)=gm(1)*(abs(term)-abs(theta(1)))
|
||
|
|
gm(4)=gm(3)*(abs(term)-abs(theta(2)))
|
||
|
|
term2=gm(1)*u(1)+gm(2)*u(2)+gm(3)*u(3)+gm(4)*u(4)
|
||
|
|
diff=abs(term2-1.)
|
||
|
|
c add penalty flux/force: BGtc
|
||
|
|
targetT=1.
|
||
|
|
do i=1,4
|
||
|
|
rhs(i,nrhs)=rhs(i,nrhs)+beta*gm(i)*diff
|
||
|
|
enddo
|
||
|
|
c find GtG
|
||
|
|
gm2=0.
|
||
|
|
do i=1,4
|
||
|
|
do j=1,4
|
||
|
|
gm2(i,j)=gm(i)*gm(j)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
c add penalty stiffness
|
||
|
|
do i=1,4
|
||
|
|
do j=1,4
|
||
|
|
amatrx(i,j)=amatrx(i,j)+beta*gm2(i,j)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
return
|
||
|
|
end
|