260 lines
8.1 KiB
FortranFixed
260 lines
8.1 KiB
FortranFixed
|
c 2D XFEM Corrosion Element
|
||
|
|
|
||
|
|
subroutine uel(rhs,amatrx,svars,energy,ndofel,nrhs,nsvars,props,
|
||
|
|
1 nprops,coords,mcrd,nnode,u,du,v,a,jtype,time,dtime,kstep,kinc,
|
||
|
|
2 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 phig(8),phih(8),phi(8),phix(8),phiy(8)
|
||
|
|
dimension crdnx(4),crdny(4),dndg(4),dndh(4)
|
||
|
|
dimension theta(4),rjac(2,2),rjaci(2,2)
|
||
|
|
dimension gx(100,4),hx(100,4),xi(2),yi(2),gi(2),hi(2)
|
||
|
|
dimension c(2),gp(2,8),gm2(8,8)
|
||
|
|
c
|
||
|
|
parameter(zero=0.d0,one=1.d0)
|
||
|
|
c material property definition
|
||
|
|
thick = 1.
|
||
|
|
rho = 1.
|
||
|
|
beta=0.
|
||
|
|
dpos=0.6
|
||
|
|
c initialization (nrhs=1)
|
||
|
|
do k1=1,ndofel
|
||
|
|
rhs(k1,nrhs)=zero
|
||
|
|
do k2=1,ndofel
|
||
|
|
amatrx(k2,k1)=zero
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
if (lflags(1).eq.33) then
|
||
|
|
do icrd=1,4
|
||
|
|
crdnx(icrd)=coords(1,icrd)
|
||
|
|
crdny(icrd)=coords(2,icrd)
|
||
|
|
theta(icrd)=abs(crdnx(icrd)-dpos)*
|
||
|
|
1 sign(1.,crdnx(icrd)-dpos)
|
||
|
|
enddo
|
||
|
|
c if (sign(1.,theta(1))/=sign(1.,theta(2)))then
|
||
|
|
if (2==1)then
|
||
|
|
c possible enriched element
|
||
|
|
npart=10
|
||
|
|
rpart=float(npart)
|
||
|
|
ienr=npart*npart
|
||
|
|
do isdx=1,npart
|
||
|
|
do isdy=1,npart
|
||
|
|
rmidx=-1.-1./rpart+(2./rpart)*float(isdx)
|
||
|
|
rmidy=-1.-1./rpart+(2./rpart)*float(isdy)
|
||
|
|
isubindex=npart*(isdy-1)+isdx
|
||
|
|
gpos=1./(sqrt(3.)*rpart)
|
||
|
|
gx(isubindex,1)=rmidx-gpos
|
||
|
|
gx(isubindex,2)=rmidx+gpos
|
||
|
|
gx(isubindex,3)=rmidx+gpos
|
||
|
|
gx(isubindex,4)=rmidx-gpos
|
||
|
|
hx(isubindex,1)=rmidy-gpos
|
||
|
|
hx(isubindex,2)=rmidy-gpos
|
||
|
|
hx(isubindex,3)=rmidy+gpos
|
||
|
|
hx(isubindex,4)=rmidy+gpos
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
c check if int points are on different sides of front
|
||
|
|
icheck=0
|
||
|
|
do i=1,ienr
|
||
|
|
do j=1,4
|
||
|
|
g=gx(i,j)
|
||
|
|
h=hx(i,j)
|
||
|
|
phi(1)=0.25*(1.-g)*(1.-h)
|
||
|
|
phi(3)=0.25*(1.+g)*(1.-h)
|
||
|
|
phi(5)=0.25*(1.+g)*(1.+h)
|
||
|
|
phi(7)=0.25*(1.-g)*(1.+h)
|
||
|
|
rLS=theta(1)*phi(1)+theta(2)*phi(3)
|
||
|
|
1 +theta(3)*phi(5)+theta(4)*phi(7)
|
||
|
|
if (i==1 .and. j==1)then
|
||
|
|
sgn=sign(1.,rLS)
|
||
|
|
else
|
||
|
|
if (sign(1.,rLS)/=sgn)then
|
||
|
|
icheck=1
|
||
|
|
endif
|
||
|
|
endif
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
if (check==0)then
|
||
|
|
c regular element - fix extra dofs
|
||
|
|
ienr=1
|
||
|
|
gpos=1/sqrt(3.)
|
||
|
|
gx(1,1)=-gpos
|
||
|
|
gx(1,2)=gpos
|
||
|
|
gx(1,3)=gpos
|
||
|
|
gx(1,4)=-gpos
|
||
|
|
hx(1,1)=-gpos
|
||
|
|
hx(1,2)=-gpos
|
||
|
|
hx(1,3)=gpos
|
||
|
|
hx(1,4)=gpos
|
||
|
|
endif
|
||
|
|
else
|
||
|
|
c Normal Shp Funs
|
||
|
|
ienr=1
|
||
|
|
gpos=1/sqrt(3.)
|
||
|
|
gx(1,1)=-gpos
|
||
|
|
gx(1,2)=gpos
|
||
|
|
gx(1,3)=gpos
|
||
|
|
gx(1,4)=-gpos
|
||
|
|
hx(1,1)=-gpos
|
||
|
|
hx(1,2)=-gpos
|
||
|
|
hx(1,3)=gpos
|
||
|
|
hx(1,4)=gpos
|
||
|
|
endif
|
||
|
|
c assemble amatrx and rhs
|
||
|
|
do i=1,ienr
|
||
|
|
do j=1,4
|
||
|
|
g=gx(i,j)
|
||
|
|
h=hx(i,j)
|
||
|
|
phi(1)=0.25*(1.-g)*(1.-h)
|
||
|
|
phi(3)=0.25*(1.+g)*(1.-h)
|
||
|
|
phi(5)=0.25*(1.+g)*(1.+h)
|
||
|
|
phi(7)=0.25*(1.-g)*(1.+h)
|
||
|
|
rLS=theta(1)*phi(1)+theta(2)*phi(3)
|
||
|
|
1 +theta(3)*phi(5)+theta(4)*phi(7)
|
||
|
|
cond=1.
|
||
|
|
spec=1.
|
||
|
|
do iter=1,4
|
||
|
|
phi(2*iter)=phi(2*iter-1)*
|
||
|
|
1 (abs(rLS)-abs(theta(iter)))
|
||
|
|
enddo
|
||
|
|
phig(1)=0.25*-(1.-h)
|
||
|
|
phig(3)=0.25*(1.-h)
|
||
|
|
phig(5)=0.25*(1.+h)
|
||
|
|
phig(7)=0.25*-(1.+h)
|
||
|
|
phih(1)=0.25*-(1.-g)
|
||
|
|
phih(3)=0.25*-(1.+g)
|
||
|
|
phih(5)=0.25*(1.+g)
|
||
|
|
phih(7)=0.25*(1.-g)
|
||
|
|
diLSg=sign(1.,rLS)*(phig(1)*theta(1)+phig(3)*
|
||
|
|
1 theta(2)+phig(5)*theta(3)+phig(7)*theta(4))
|
||
|
|
diLSh=sign(1.,rLS)*(phih(1)*theta(1)+phih(3)*
|
||
|
|
1 theta(2)+phih(5)*theta(3)+phih(7)*theta(4))
|
||
|
|
do iter=1,4
|
||
|
|
phig(2*iter)=phig(2*iter-1)*(abs(rLS)-
|
||
|
|
1 abs(theta(iter)))+phi(2*iter-1)*diLSg
|
||
|
|
phih(2*iter)=phih(2*iter-1)*(abs(rLS)-
|
||
|
|
1 abs(theta(iter)))+phi(2*iter-1)*diLSh
|
||
|
|
enddo
|
||
|
|
rjac=zero
|
||
|
|
do iter=1,4
|
||
|
|
rjac(1,1)=rjac(1,1)+phig(2*iter-1)*crdnx(iter)
|
||
|
|
rjac(1,2)=rjac(1,2)+phig(2*iter-1)*crdny(iter)
|
||
|
|
rjac(2,1)=rjac(2,1)+phih(2*iter-1)*crdnx(iter)
|
||
|
|
rjac(2,2)=rjac(2,2)+phih(2*iter-1)*crdny(iter)
|
||
|
|
enddo
|
||
|
|
djac=rjac(1,1)*rjac(2,2)-rjac(1,2)*rjac(2,1)
|
||
|
|
rjaci(1,1)= rjac(2,2)/djac
|
||
|
|
rjaci(2,2)= rjac(1,1)/djac
|
||
|
|
rjaci(1,2)=-rjac(1,2)/djac
|
||
|
|
rjaci(2,1)=-rjac(2,1)/djac
|
||
|
|
do iter=1,8
|
||
|
|
phix(iter)=rjaci(1,1)*phig(iter)+
|
||
|
|
1 rjaci(1,2)*phih(iter)
|
||
|
|
phiy(iter)=rjaci(2,1)*phig(iter)+
|
||
|
|
1 rjaci(2,2)*phih(iter)
|
||
|
|
enddo
|
||
|
|
dtdx=zero
|
||
|
|
dtdy=zero
|
||
|
|
t =zero
|
||
|
|
told=zero
|
||
|
|
do iter=1,8
|
||
|
|
dtdx=u(iter)*phix(iter)+dtdx
|
||
|
|
dtdy=u(iter)*phiy(iter)+dtdy
|
||
|
|
t=u(iter)*phi(iter)+t
|
||
|
|
told=(u(iter)-du(iter,nrhs))*phi(iter)+told
|
||
|
|
end do
|
||
|
|
dtdt=(t-told)/dtime
|
||
|
|
we=djac
|
||
|
|
do ki=1,8
|
||
|
|
c loop over nodes
|
||
|
|
rhs(ki,nrhs) = rhs(ki,nrhs) -
|
||
|
|
1 (we/float(ienr))*(phi(ki)*rho*spec*dtdt+
|
||
|
|
2 cond*(phix(ki)*dtdx + phiy(ki)*dtdy))
|
||
|
|
do kj=1,8
|
||
|
|
amatrx(ki,kj)=amatrx(ki,kj)+(we/float(ienr))
|
||
|
|
1 *(phi(ki)*phi(kj)*rho*spec/dtime+cond
|
||
|
|
2 *(phix(ki)*phix(kj)+phiy(ki)*phiy(kj)))
|
||
|
|
end do
|
||
|
|
end do
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
c if interface is in the element a penalty term is needed
|
||
|
|
if(ienr>1)then
|
||
|
|
icount=0
|
||
|
|
if (sign(1.,theta(1))/=sign(1.,theta(2)))then
|
||
|
|
icount=icount+1
|
||
|
|
f=abs(theta(1))/(abs(theta(1))+abs(theta(2)))
|
||
|
|
xi(icount)=f*(crdnx(2)-crdnx(1))+crdnx(1)
|
||
|
|
yi(icount)=f*(crdny(2)-crdny(1))+crdny(1)
|
||
|
|
gi(icount)=(2.*xi(icount)-(crdnx(1)+crdnx(2)))
|
||
|
|
1 /(-crdnx(1)+crdnx(2))
|
||
|
|
hi(icount)=-1.
|
||
|
|
endif
|
||
|
|
if (sign(1.,theta(2))/=sign(1.,theta(3)))then
|
||
|
|
icount=icount+1
|
||
|
|
f=abs(theta(2))/(abs(theta(2))+abs(theta(3)))
|
||
|
|
xi(icount)=f*(crdnx(3)-crdnx(2))+crdnx(2)
|
||
|
|
yi(icount)=f*(crdny(3)-crdny(2))+crdny(2)
|
||
|
|
gi(icount)=1.
|
||
|
|
hi(icount)=(2.*yi(icount)-(crdny(2)+crdny(3)))
|
||
|
|
1 /(-crdny(2)+crdny(3))
|
||
|
|
endif
|
||
|
|
if (sign(1.,theta(3))/=sign(1.,theta(4)))then
|
||
|
|
icount=icount+1
|
||
|
|
f=abs(theta(3))/(abs(theta(3))+abs(theta(4)))
|
||
|
|
xi(icount)=f*(crdnx(4)-crdnx(3))+crdnx(3)
|
||
|
|
yi(icount)=f*(crdny(4)-crdny(3))+crdny(3)
|
||
|
|
gi(icount)=(2.*xi(icount)-(crdnx(4)+crdnx(3)))
|
||
|
|
1 /(-crdnx(4)+crdnx(3))
|
||
|
|
hi(icount)=1.
|
||
|
|
endif
|
||
|
|
if (sign(1.,theta(1))/=sign(1.,theta(4)))then
|
||
|
|
icount=icount+1
|
||
|
|
f=abs(theta(1))/(abs(theta(1))+abs(theta(4)))
|
||
|
|
xi(icount)=f*(crdnx(4)-crdnx(1))+crdnx(1)
|
||
|
|
yi(icount)=f*(crdny(4)-crdny(1))+crdny(1)
|
||
|
|
gi(icount)=-1.
|
||
|
|
hi(icount)=(2.*yi(icount)-(crdny(1)+crdny(4)))
|
||
|
|
1 /(-crdny(4)+crdny(1))
|
||
|
|
endif
|
||
|
|
c(1)=1.
|
||
|
|
c(2)=1.
|
||
|
|
do iter=1,2
|
||
|
|
Gp(iter,1)=0.25*(1.-gi(iter))*(1.-hi(iter))
|
||
|
|
Gp(iter,3)=0.25*(1.+gi(iter))*(1.-hi(iter))
|
||
|
|
Gp(iter,5)=0.25*(1.+gi(iter))*(1.+hi(iter))
|
||
|
|
Gp(iter,7)=0.25*(1.-gi(iter))*(1.+hi(iter))
|
||
|
|
Gp(iter,2)=-Gp(iter,1)*abs(theta(1))
|
||
|
|
Gp(iter,4)=-Gp(iter,3)*abs(theta(2))
|
||
|
|
Gp(iter,6)=-Gp(iter,5)*abs(theta(3))
|
||
|
|
Gp(iter,8)=-Gp(iter,7)*abs(theta(4))
|
||
|
|
enddo
|
||
|
|
do i=1,8
|
||
|
|
rhs(i,nrhs)=rhs(i,nrhs)+
|
||
|
|
1 beta*(Gp(1,i)*c(1)+Gp(2,i)*c(2))
|
||
|
|
enddo
|
||
|
|
c find GtG
|
||
|
|
gm2=0.
|
||
|
|
do i=1,8
|
||
|
|
do j=1,8
|
||
|
|
gm2(i,j)=gp(1,i)*gp(1,j)+gp(2,i)*gp(2,j)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
c add penalty stiffness
|
||
|
|
do i=1,8
|
||
|
|
do j=1,8
|
||
|
|
amatrx(i,j)=amatrx(i,j)+beta*gm2(i,j)
|
||
|
|
enddo
|
||
|
|
enddo
|
||
|
|
endif
|
||
|
|
end if
|
||
|
|
return
|
||
|
|
end
|