phd-scripts/Unpublished/XFEM2/XFEM/UEL2_TRANHTX.f

202 lines
5.6 KiB
FortranFixed
Raw Normal View History

2024-05-13 19:50:21 +00:00
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