jgrogan/phd-scripts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add scripts and inp files.

Browse source
This commit is contained in:
James Grogan 2024-05-13 20:50:21 +01:00
parent ad937f2602
commit e19f869a1e
390 changed files with 6580687 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

234
Unpublished/XFEM2/1D_Solver/2DLevelSet.m Normal file
View file

@ -0,0 +1,234 @@
function [] = 2DLevelSet()
clear all
% Define Main Solution Mesh
NumX=8;
NumY=8;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
centx=4.;
centy=4.;
rad=2.1;
for i=1:numNodes;
dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
lSet(i)=dist-rad;
end
%for i=1:numNodes;
% dist=Node(i,1)-0.1;
% lSet(i)=dist;
%end
% Plot initial level set
[X Y]=meshgrid(0:1.:8);
Z=zeros(9);
for i=1:81
Z(i)=lSet(i);
end
surf(X,Y,Z)
% LS Algorithm Parameters
lSet'
bandwidth=10.;
% Loop through timesteps
for tstep=1:100
% Identify Narrow Band Elements
NBindex=0;
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,2);
NBelem(NBindex,3)=Element(i,3);
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,3);
NBelem(NBindex,3)=Element(i,4);
end
end
% Velocity BC
F=zeros(numNodes,1);
for i=1:NBindex
if sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,2)))||sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,3)))
F(NBelem(i,1))= 1.;
F(NBelem(i,2))= 1.;
F(NBelem(i,3))= 1.;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(numNodes);
for i=1:NBindex
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
% Apply BCs
RHS=zeros(numNodes,1);
Sub=A*F;
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:numNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(numNodes);
mMatGLS=zeros(numNodes);
f1=zeros(numNodes,1);
f2=zeros(numNodes,1);
f3=zeros(numNodes,1);
h2=0.00001;
visc=0.0005;
for i=1:NBindex
mMatL=zeros(3);
mMatGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
mMatL=mMatL+(phi'*phi)/3.;
mMatGLSL=mMatGLSL+((delphi'*(delset/norm(delset)))*Floc*(h2/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(h2/abs(Floc))*Floc*norm(delset)/3.;
vs=h2*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+h2));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
mMat(NBelem(i,j),NBelem(i,k))=mMat(NBelem(i,j),NBelem(i,k))+mMatL(j,k);
mMatGLS(NBelem(i,j),NBelem(i,k))=mMatGLS(NBelem(i,j),NBelem(i,k))+mMatGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
dt=0.01;
lSet=lSet-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))';
end
lSet'
%[X Y]=meshgrid(0:1.:8);
%Z=zeros(9);
%for i=1:81
% Z(i)=lSet(i);
%end
%surf(X,Y,Z)

234
Unpublished/XFEM2/1D_Solver/2DLevelSetFMM.m Normal file
View file

@ -0,0 +1,234 @@
function [] = 2DLevelSetFMM()
clear all
% Define Main Solution Mesh
NumX=3;
NumY=1;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
%centx=4.;
%centy=4.;
%rad=2.1;
%for i=1:numNodes;
% dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
% lSet(i)=dist-rad;
%end
for i=1:numNodes;
dist=Node(i,1)-0.1;
lSet(i)=dist;
end
% Plot initial level set
%[X Y]=meshgrid(0:1.:8);
%Z=zeros(9);
%for i=1:81
% Z(i)=lSet(i);
%end
%surf(X,Y,Z)
% LS Algorithm Parameters
lSet'
bandwidth=10.;
% Loop through timesteps
for tstep=1:1
% Identify Narrow Band Elements
NBindex=0;
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,2);
NBelem(NBindex,3)=Element(i,3);
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,3);
NBelem(NBindex,3)=Element(i,4);
end
end
% Velocity BC
F=zeros(numNodes,1);
for i=1:NBindex
if sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,2)))||sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,3)))
F(NBelem(i,1))= 1.;
F(NBelem(i,2))= 1.;
F(NBelem(i,3))= 1.;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(numNodes);
for i=1:NBindex
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
% Apply BCs
RHS=zeros(numNodes,1);
Sub=A*F;
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:numNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(numNodes);
mMatGLS=zeros(numNodes);
f1=zeros(numNodes,1);
f2=zeros(numNodes,1);
f3=zeros(numNodes,1);
h2=0.00001;
visc=0.0005;
for i=1:NBindex
mMatL=zeros(3);
mMatGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
mMatL=mMatL+(phi'*phi)/3.;
mMatGLSL=mMatGLSL+((delphi'*(delset/norm(delset)))*Floc*(h2/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(h2/abs(Floc))*Floc*norm(delset)/3.;
vs=h2*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+h2));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
mMat(NBelem(i,j),NBelem(i,k))=mMat(NBelem(i,j),NBelem(i,k))+mMatL(j,k);
mMatGLS(NBelem(i,j),NBelem(i,k))=mMatGLS(NBelem(i,j),NBelem(i,k))+mMatGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
dt=0.01;
lSet=lSet-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))';
end
lSet'
%[X Y]=meshgrid(0:1.:8);
%Z=zeros(9);
%for i=1:81
% Z(i)=lSet(i);
%end
%surf(X,Y,Z)

322
Unpublished/XFEM2/1D_Solver/F2DLevelSetFMM.asv Normal file
View file

@ -0,0 +1,322 @@
function [] = F2DLevelSetFMM()
clear all
% Define Main Solution Mesh
NumX=5;
NumY=1;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
%centx=4.;
%centy=4.;
%rad=2.1;
%for i=1:numNodes;
% dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
% lSet(i)=dist-rad;
%end
for i=1:numNodes;
dist=Node(i,1)-0.1;
lSet(i)=dist;
end
% Plot initial level set
%[X Y]=meshgrid(0:1.:8);
%Z=zeros(9);
%for i=1:81
% Z(i)=lSet(i);
%end
%surf(X,Y,Z)
% LS Algorithm Parameters
lSet'
bandwidth=3.;
% Loop through timesteps
for tstep=1:1
% Identify Narrow Band Elements
NBElems=0;
NBNodes=0;
NGlobal=zeros(NumNodes);
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
for j=1:4
if NewNums(Element(i,j))==0
NBNodes=NBNodes+1
NGlobal(Element(i,j))=NBNodes;
NLocal(NBNodes)=Element(i,j);
end
end
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,2));
NBelem(NBElems,3)=NGlobal(Element(i,3));
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,3));
NBelem(NBElems,3)=NGlobal(Element(i,4));
end
end
% Get local Level Set
for i=1:NBNodes
lSetLocal(i)=lSet(NLocal(i));
end
% Velocity BC
F=zeros(NBNodes,1);
for i=1:NBElems
L1=sign(lSetLocal(NBelem(i,1)));
L2=sign(lSetLocal(NBelem(i,2)));
L3=sign(lSetLocal(NBelem(i,3)));
if L1 ~= L2 || L1 ~= L3
F(NBelem(i,1))= 1.;
F(NBelem(i,2))= 1.;
F(NBelem(i,3))= 1.;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(NBNodes);
for i=1:NBElems
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSetLocal(NBelem(i,1));lSetLocal(NBelem(i,2));lSetLocal(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
% Apply BCs
RHS=zeros(NBNodes,1);
Sub=A*F;
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:NBNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(NBNodes);
mMatGLS=zeros(NBNodes);
f1=zeros(NBNodes,1);
f2=zeros(NBNodes,1);
f3=zeros(NBNodes,1);
h2=0.00001;
visc=0.0005;
for i=1:NBElems
mMatL=zeros(3);
mMatGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSetLocal(NBelem(i,1));lSetLocal(NBelem(i,2));lSetLocal(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
mMatL=mMatL+(phi'*phi)/3.;
mMatGLSL=mMatGLSL+((delphi'*(delset/norm(delset)))*Floc*(h2/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(h2/abs(Floc))*Floc*norm(delset)/3.;
vs=h2*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+h2));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
mMat(NBelem(i,j),NBelem(i,k))=mMat(NBelem(i,j),NBelem(i,k))+mMatL(j,k);
mMatGLS(NBelem(i,j),NBelem(i,k))=mMatGLS(NBelem(i,j),NBelem(i,k))+mMatGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
dt=0.01;
lSetLocal=lSetLocal-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))';
newlSet=lSetLocal;
% Reinitialize LS
nstat=zeros(NBNodes,1);
for i=1:NBelems
L1=sign(lSetLocal(NBelem(i,1)));
L2=sign(lSetLocal(NBelem(i,2)));
L3=sign(lSetLocal(NBelem(i,3)));
if L1 ~= L2 || L1 ~= L3
for j=1:3
nstat(NBelem(i,j))=1;
end
end
end
maincheck=0;
while(maincheck==0)
lmin=1000.;
avlmin=1000.;
eindex=0;
nindex=0;
maincheck=1;
for i=1:NBindex
if nstat(NBelem(i,1))+nstat(NBelem(i,2))+nstat(NBelem(i,3))==2
maincheck=0;
check=0;
ltot=0.;
for j=1:3
if nstat(NBelem(i,j))==0
if abs(lSet(NBelem(i,j)))<=lmin
check=1;
tempindex=j;
end
end
ltot=ltot+abs(lSet(NBelem(i,j)));
end
if check==1 & ltot/3.<=avlmin
eindex=i;
nindex=tempindex;
lmin=lSet(NBelem(eindex,nindex));
avlmin=ltot/3.;
end
end
end
if maincheck==0
% Find New LS for point
xp=Node(NBelem(eindex,nindex),1);
yp=Node(NBelem(eindex,nindex),2);
count=0;
for i=1:3
if i~=nindex
count=count+1;
x(count)=Node(NBelem(eindex,i),1);
y(count)=Node(NBelem(eindex,i),2);
lloc(count)=newlSet(NBelem(eindex,i));
end
end
delxa=x(1)-xp;
delya=y(1)-yp;
delxb=x(2)-xp;
delyb=y(2)-yp;
N=[delxa delya; delxb delyb];
M=N^-1;
A=(M(1)*M(1)+M(2)*M(2));
B=(M(3)*M(3)+M(4)*M(4));
C=2.*(M(1)*M(3)+M(2)*M(4));
a=A+B+C;
b=-2.*lloc(1)*A-2.*lloc(2)*B-C*(lloc(1)+lloc(2));
c=lloc(1)*lloc(1)*A+lloc(2)*lloc(2)*B+lloc(1)*lloc(2)*C-1.;
templ1=(-b+sqrt(b*b-4.*a*c))/(2.*a);
templ2=(-b-sqrt(b*b-4.*a*c))/(2.*a);
if abs(templ1)>abs(templ2)
newlSet(NBelem(eindex,nindex))=templ1;
else
newlSet(NBelem(eindex,nindex))=templ2;
end
nstat(NBelem(eindex,nindex))=1;
end
end
% lSet=newlSet;
end
lSet'

331
Unpublished/XFEM2/1D_Solver/F2DLevelSetFMM.m Normal file
View file

@ -0,0 +1,331 @@
function [] = F2DLevelSetFMM()
clear all
% Define Main Solution Mesh
NumX=32;
NumY=32;
delX=0.25;
delY=0.25;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
centx=4.;
centy=4.;
rad=2.1;
for i=1:numNodes;
dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
lSet(i)=dist-rad;
end
%for i=1:numNodes;
% dist=Node(i,1)-0.1;
% lSet(i)=dist;
%end
% Plot initial level set
[X Y]=meshgrid(0:0.25:8);
Z=zeros(33);
for i=1:1089
Z(i)=lSet(i);
end
surf(X,Y,Z)
% LS Algorithm Parameters
lSet'
bandwidth=10;
% Loop through timesteps
for tstep=1:10
% Identify Narrow Band Elements
NBElems=0;
NBNodes=0;
NGlobal=zeros(numNodes);
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
for j=1:4
if NGlobal(Element(i,j))==0
NBNodes=NBNodes+1;
NGlobal(Element(i,j))=NBNodes;
NLocal(NBNodes)=Element(i,j);
end
end
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,2));
NBelem(NBElems,3)=NGlobal(Element(i,3));
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,3));
NBelem(NBElems,3)=NGlobal(Element(i,4));
end
end
% Get local Level Set
for i=1:NBNodes
lSetLocal(i)=lSet(NLocal(i));
end
% Velocity BC
F=zeros(NBNodes,1);
for i=1:NBElems
L1=sign(lSetLocal(NBelem(i,1)));
L2=sign(lSetLocal(NBelem(i,2)));
L3=sign(lSetLocal(NBelem(i,3)));
if L1 ~= L2 || L1 ~= L3
F(NBelem(i,1))= 1.;
F(NBelem(i,2))= 1.;
F(NBelem(i,3))= 1.;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(NBNodes);
for i=1:NBElems
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSetLocal(NBelem(i,1));lSetLocal(NBelem(i,2));lSetLocal(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
% Apply BCs
RHS=zeros(NBNodes,1);
Sub=A*F;
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:NBNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(NBNodes);
mMatGLS=zeros(NBNodes);
f1=zeros(NBNodes,1);
f2=zeros(NBNodes,1);
f3=zeros(NBNodes,1);
h2=0.00001;
visc=0.0005;
for i=1:NBElems
mMatL=zeros(3);
mMatGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSetLocal(NBelem(i,1));lSetLocal(NBelem(i,2));lSetLocal(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
mMatL=mMatL+(phi'*phi)/3.;
mMatGLSL=mMatGLSL+((delphi'*(delset/norm(delset)))*Floc*(h2/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(h2/abs(Floc))*Floc*norm(delset)/3.;
vs=h2*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+h2));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
mMat(NBelem(i,j),NBelem(i,k))=mMat(NBelem(i,j),NBelem(i,k))+mMatL(j,k);
mMatGLS(NBelem(i,j),NBelem(i,k))=mMatGLS(NBelem(i,j),NBelem(i,k))+mMatGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
dt=0.01;
lSetLocal=lSetLocal-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))';
newlSet=lSetLocal;
% Reinitialize LS
nstat=zeros(NBNodes,1);
for i=1:NBElems
L1=sign(lSetLocal(NBelem(i,1)));
L2=sign(lSetLocal(NBelem(i,2)));
L3=sign(lSetLocal(NBelem(i,3)));
if L1 ~= L2 || L1 ~= L3
for j=1:3
nstat(NBelem(i,j))=1;
end
end
end
maincheck=0;
while(maincheck==0)
lmin=1000.;
avlmin=1000.;
eindex=0;
nindex=0;
maincheck=1;
for i=1:NBElems
if nstat(NBelem(i,1))+nstat(NBelem(i,2))+nstat(NBelem(i,3))==2
maincheck=0;
check=0;
ltot=0.;
for j=1:3
if nstat(NBelem(i,j))==0
if abs(lSetLocal(NBelem(i,j)))<=lmin
check=1;
tempindex=j;
end
end
ltot=ltot+abs(lSetLocal(NBelem(i,j)));
end
if check==1 & ltot/3.<=avlmin
eindex=i;
nindex=tempindex;
lmin=lSetLocal(NBelem(eindex,nindex));
avlmin=ltot/3.;
end
end
end
if maincheck==0
% Find New LS for point
xp=Node(NLocal(NBelem(eindex,nindex)),1);
yp=Node(NLocal(NBelem(eindex,nindex)),2);
count=0;
for i=1:3
if i~=nindex
count=count+1;
x(count)=Node(NLocal(NBelem(eindex,i)),1);
y(count)=Node(NLocal(NBelem(eindex,i)),2);
lloc(count)=newlSet(NBelem(eindex,i));
end
end
delxa=x(1)-xp;
delya=y(1)-yp;
delxb=x(2)-xp;
delyb=y(2)-yp;
N=[delxa delya; delxb delyb];
M=N^-1;
A=(M(1)*M(1)+M(2)*M(2));
B=(M(3)*M(3)+M(4)*M(4));
C=2.*(M(1)*M(3)+M(2)*M(4));
a=A+B+C;
b=-2.*lloc(1)*A-2.*lloc(2)*B-C*(lloc(1)+lloc(2));
c=lloc(1)*lloc(1)*A+lloc(2)*lloc(2)*B+lloc(1)*lloc(2)*C-1.;
templ1=(-b+sqrt(b*b-4.*a*c))/(2.*a);
templ2=(-b-sqrt(b*b-4.*a*c))/(2.*a);
if abs(templ1)>abs(templ2)
newlSet(NBelem(eindex,nindex))=templ1;
else
newlSet(NBelem(eindex,nindex))=templ2;
end
nstat(NBelem(eindex,nindex))=1;
end
end
% lSetLocal=newlSet;
% Update Global Level Set
for i=1:NBNodes
lSet(NLocal(i))=lSetLocal(i);
end
end
lSet'
[X Y]=meshgrid(0:0.25:8);
Z=zeros(33);
for i=1:1089
Z(i)=lSet(i);
end
surf(X,Y,Z)

221
Unpublished/XFEM2/1D_Solver/FESolveX.m Normal file
View file

@ -0,0 +1,221 @@
function [] = FESolveX()
% MATLAB based XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=10.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=10;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=5.;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
if crdn1<=dpos
Tnew(2*elemNodes(e,1)-1)=1.;
end
end
% Define Time Step
dtime=0.05;
tsteps=20;
time=0.;
% penalty term
beta=40.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
fdofs(1)=2*elemNodes(e,1);
fdofs(2)=2*elemNodes(e,2);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
if term<0
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
tpos=gm(1)*Tnew(1)+gm(2)*Tnew(2)+gm(3)*Tnew(3)+gm(4)*Tnew(4);
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove inactive DOFs(Reduce Matrices)
T1=1;
RHS=M*Tnew;
iindex=0;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
jindex=0;
iindex=iindex+1;
for j=1:ndof*numNodes;
check=1;
if j==fdofs(1)|j==fdofs(2)
check=0;
elseif mod(j,2)~=0 & j~=1
check=0;
end
if check==0
jindex=jindex+1;
Kred(iindex,jindex)=K(i,j);
Mred(iindex,jindex)=M(i,j);
end
end
Subr(iindex)=(K(i,1)+M(i,1))*T1;
RHSr(iindex)=RHS(i);
pforcer(iindex)=pforce(i);
end
end
%Solve
Mred+Kred;
StiffI=(Mred+Kred)^-1;
Tnewr=StiffI*(RHSr'-Subr'+pforcer');
iindex=0.;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
else
Tnew(i)=0.;
end
end
Tnew(1)=1.;
Tnew
end
stored'

128
Unpublished/XFEM2/1D_Solver/GetF.m Normal file
View file

@ -0,0 +1,128 @@
function [] = GetF()
% set up grid
gd=0.;
numElem=4;
eLen=0.25;
for i=1:numElem+1
ndCrd(i)=gd;
gd=gd+eLen;
end
for i=1:numElem
elemNod(i,1)=i;
elemNod(i,2)=i+1;
end
% Initial level set
dpos=0.1;
for i=1:numElem+1
lSet(i)=sign(ndCrd(i)-dpos)*abs(dpos-ndCrd(i));
end
lSet'
for tstep=1:1
% Velocity BC
F=zeros(numElem+1,1);
for i=1:numElem
if sign(lSet(elemNod(i,1)))~=sign(lSet(elemNod(i,2)))
F(elemNod(i,1))= 0.0005;
F(elemNod(i,2))= 0.0005;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(numElem+1);
for i=1:numElem
pos(1)=-1/sqrt(3);
pos(2)=1/sqrt(3);
AfL=zeros(2);
AfLGLS=zeros(2);
for j=1:2
shp(1)=(1-pos(j))/2.;
shp(2)=(1+pos(j))/2.;
dshp(1)=-0.5;
dshp(2)=0.5;
rset=shp(1)*lSet(elemNod(i,1))+shp(2)*lSet(elemNod(i,2));
dls=dshp(1)*lSet(elemNod(i,1))+dshp(2)*lSet(elemNod(i,2));
AfL=AfL+shp'*sign(rset)*(dls*dshp);
AfLGLS=AfLGLS+(dshp'*dls)*(0.25/abs(dls))*(dls*dshp);
end
for k=1:2;
for j=1:2;
A(elemNod(i,j),elemNod(i,k))=A(elemNod(i,j),elemNod(i,k))+AfL(j,k)+AfLGLS(j,k)
end
end
end
% Apply BCs
RHS=zeros(numElem+1,1);
Sub=A*F;
iindex=0;
for i=1:numElem+1
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:numElem+1
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:numElem+1
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(numElem+1);
mMatGLS=zeros(numElem+1);
f1=zeros(numElem+1,1);
f2=zeros(numElem+1,1);
f3=zeros(numElem+1,1);
h=0.25;
visc=0.000;
for i=1:numElem
pos(1)=-1/sqrt(3);
pos(2)=1/sqrt(3);
mMatL=zeros(2);
mMatGLSL=zeros(2);
f1L=zeros(2,1);
f2L=zeros(2,1);
f3L=zeros(2,1);
for j=1:2
shp(1)=(1-pos(j))/2.;
shp(2)=(1+pos(j))/2.;
dshp(1)=-0.5;
dshp(2)=0.5;
Floc=shp(1)*F(elemNod(i,1))+shp(2)*F(elemNod(i,2));
rset=shp(1)*lSet(elemNod(i,1))+shp(2)*lSet(elemNod(i,2));
dls=dshp(1)*lSet(elemNod(i,1))+dshp(2)*lSet(elemNod(i,2));
mMatL=mMatL+shp'*shp;
mMatGLSL=mMatGLSL+((dshp'*(dls/abs(dls)))*Floc*(h/abs(Floc)))*shp;
f1L=f1L+shp'*Floc*abs(dls);
f2L=f2L+(dshp'*(dls/abs(dls))*Floc)*(h/abs(Floc))*Floc*abs(dls);
vs=h*((abs(visc+Floc*abs(dls)))/(abs(Floc*dls)+h));
f3L=f3L+vs*dshp'*dls;
end
for k=1:2;
for j=1:2;
mMat(elemNod(i,j),elemNod(i,k))=mMat(elemNod(i,j),elemNod(i,k))+mMatL(j,k);
mMatGLS(elemNod(i,j),elemNod(i,k))=mMatGLS(elemNod(i,j),elemNod(i,k))+mMatGLSL(j,k);
end
f1(elemNod(i,k))=f1(elemNod(i,k))+f1L(k);
f2(elemNod(i,k))=f2(elemNod(i,k))+f2L(k);
f3(elemNod(i,k))=f3(elemNod(i,k))+f3L(k);
end
end
dt=0.01;
lSet=lSet-((((mMat+mMatGLS)^-1)/dt)*(f1+f2+f3))';
lSet';
end

200
Unpublished/XFEM2/1D_Solver/GetF2D.asv Normal file
View file

@ -0,0 +1,200 @@
function [] = GetF2D_()
clear all
% Define Main Solution Mesh
NumX=10;
NumY=10;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
centx=5.;
centy=5.;
rad=2.5;
for i=1:numNodes;
dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
lSet(i)=dist-rad;
end
% Plot initial level set
[X,Y]=meshgrid(0:1.:10);
Z=zeros(11);
for i=1:numNodes
Z(i)=lSet(i);
end
surf(X,Y,Z)
% LS Algorithm Parameters
bandwith=10.;
% Loop through timesteps
for tstep=1:1
% Identify Narrow Band Elements
NBindex=0;
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,2);
NBelem(NBindex,3)=Element(i,3);
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,3);
NBelem(NBindex,3)=Element(i,4);
end
end
% Velocity BC
F=zeros(numNodes,1);
for i=1:NBindex
if lSet(NBelem(i,1))~=lSet(NBelem(i,2)) || lSet(NBelem(i,1))~=lSet(NBelem(i,3))
F(NBelem(i,1))= 0.0005;
F(NBelem(i,2))= 0.0005;
F(NBelem(i,3))= 0.0005;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(numNodes);
for i=1:NBindex
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
AfL=zeros(4);
AfLGLS=zeros(4);
for j=1:4
g=gx(j);
h=hx(j);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
rset=phi(1)*lSet(Element(i,1))+phi(2)*lSet(Element(i,2))+phi(3)*lSet(Element(i,3))+phi(4)*lSet(Element(i,4));
dls=phig(1)*lSet(Element(i,1))+phig(2)*lSet(Element(i,2))+phig(3)*lSet(Element(i,3))+phig(4)*lSet(Element(i,4));
AfL=AfL+(phi'*sign(rset))*(dls*phig);
AfLGLS=AfLGLS+(phig'*dls)*(1./abs(dls))*(dls*phig);
end
for k=1:4;
for j=1:4;
A(Element(i,j),Element(i,k))=A(Element(i,j),Element(i,k))+AfL(j,k)+AfLGLS(j,k);
end
end
end
% Apply BCs
RHS=zeros(numNodes,1);
Sub=A*F;
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:numNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(numNodes);
mMatGLS=zeros(numNodes);
f1=zeros(numNodes,1);
f2=zeros(numNodes,1);
f3=zeros(numNodes,1);
h=1.;
visc=0.000;
for i=1:numElem
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
mMatL=zeros(4);
mMatGLSL=zeros(4);
f1L=zeros(4,1);
f2L=zeros(4,1);
f3L=zeros(4,1);
for j=1:4
g=gx(j);
h=hx(j);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
Floc=phi(1)*F(Element(i,1))+phi(2)*F(Element(i,2))+phi(3)*F(Element(i,3))+phi(4)*F(Element(i,4));
rset=phi(1)*lSet(Element(i,1))+phi(2)*lSet(Element(i,2))+phi(3)*lSet(Element(i,3))+phi(4)*lSet(Element(i,4));
dls=phig(1)*lSet(Element(i,1))+phig(2)*lSet(Element(i,2))+phig(3)*lSet(Element(i,3))+phig(4)*lSet(Element(i,4));
mMatL=mMatL+phi'*phi;
mMatGLSL=mMatGLSL+((phig'*(dls/abs(dls)))*Floc*(h/abs(Floc)))*phi;
f1L=f1L+phi'*Floc*abs(dls);
f2L=f2L+(phig'*(dls/abs(dls))*Floc)*(h/abs(Floc))*Floc*abs(dls);
vs=h*((abs(visc+Floc*abs(dls)))/(abs(Floc*dls)+h));
f3L=f3L+vs*phig'*dls;
end
for k=1:4;
for j=1:4;
mMat(Element(i,j),Element(i,k))=mMat(Element(i,j),Element(i,k))+mMatL(j,k);
mMatGLS(Element(i,j),Element(i,k))=mMatGLS(Element(i,j),Element(i,k))+mMatGLSL(j,k);
end
f1(Element(i,k))=f1(Element(i,k))+f1L(k);
f2(Element(i,k))=f2(Element(i,k))+f2L(k);
f3(Element(i,k))=f3(Element(i,k))+f3L(k);
end
end
dt=0.01;
lSet=lSet-((((mMat+mMatGLS)^-1)/dt)*(f1+f2+f3))';
end
%scatter3(Node(:,1), Node(:,2), lSet');

200
Unpublished/XFEM2/1D_Solver/GetF2D.m Normal file
View file

@ -0,0 +1,200 @@
function [] = GetF2D()
clear all
% Define Main Solution Mesh
NumX=10;
NumY=10;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
centx=5.;
centy=5.;
rad=2.5;
for i=1:numNodes;
dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
lSet(i)=dist-rad;
end
% Plot initial level set
[X,Y]=meshgrid(0:1.:10);
Z=zeros(11);
for i=1:numNodes
Z(i)=lSet(i);
end
surf(X,Y,Z)
% LS Algorithm Parameters
bandwith=10.;
% Loop through timesteps
for tstep=1:1
% Identify Narrow Band Elements
NBindex=0;
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,2);
NBelem(NBindex,3)=Element(i,3);
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,3);
NBelem(NBindex,3)=Element(i,4);
end
end
% Velocity BC
F=zeros(numNodes,1);
for i=1:NBindex
if lSet(NBelem(i,1))~=lSet(NBelem(i,2)) || lSet(NBelem(i,1))~=lSet(NBelem(i,3))
F(NBelem(i,1))= 0.0005;
F(NBelem(i,2))= 0.0005;
F(NBelem(i,3))= 0.0005;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(numNodes);
for i=1:NBindex
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
AfL=zeros(4);
AfLGLS=zeros(4);
for j=1:4
g=gx(j);
h=hx(j);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
rset=phi(1)*lSet(Element(i,1))+phi(2)*lSet(Element(i,2))+phi(3)*lSet(Element(i,3))+phi(4)*lSet(Element(i,4));
dls=phig(1)*lSet(Element(i,1))+phig(2)*lSet(Element(i,2))+phig(3)*lSet(Element(i,3))+phig(4)*lSet(Element(i,4));
AfL=AfL+(phi'*sign(rset))*(dls*phig);
AfLGLS=AfLGLS+(phig'*dls)*(1./abs(dls))*(dls*phig);
end
for k=1:4;
for j=1:4;
A(Element(i,j),Element(i,k))=A(Element(i,j),Element(i,k))+AfL(j,k)+AfLGLS(j,k)
end
end
end
% Apply BCs
RHS=zeros(numNodes,1);
Sub=A*F;
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:numNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(numNodes);
mMatGLS=zeros(numNodes);
f1=zeros(numNodes,1);
f2=zeros(numNodes,1);
f3=zeros(numNodes,1);
h=1.;
visc=0.000;
for i=1:numElem
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
mMatL=zeros(4);
mMatGLSL=zeros(4);
f1L=zeros(4,1);
f2L=zeros(4,1);
f3L=zeros(4,1);
for j=1:4
g=gx(j);
h=hx(j);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
Floc=phi(1)*F(Element(i,1))+phi(2)*F(Element(i,2))+phi(3)*F(Element(i,3))+phi(4)*F(Element(i,4));
rset=phi(1)*lSet(Element(i,1))+phi(2)*lSet(Element(i,2))+phi(3)*lSet(Element(i,3))+phi(4)*lSet(Element(i,4));
dls=phig(1)*lSet(Element(i,1))+phig(2)*lSet(Element(i,2))+phig(3)*lSet(Element(i,3))+phig(4)*lSet(Element(i,4));
mMatL=mMatL+phi'*phi;
mMatGLSL=mMatGLSL+((phig'*(dls/abs(dls)))*Floc*(h/abs(Floc)))*phi;
f1L=f1L+phi'*Floc*abs(dls);
f2L=f2L+(phig'*(dls/abs(dls))*Floc)*(h/abs(Floc))*Floc*abs(dls);
vs=h*((abs(visc+Floc*abs(dls)))/(abs(Floc*dls)+h));
f3L=f3L+vs*phig'*dls;
end
for k=1:4;
for j=1:4;
mMat(Element(i,j),Element(i,k))=mMat(Element(i,j),Element(i,k))+mMatL(j,k);
mMatGLS(Element(i,j),Element(i,k))=mMatGLS(Element(i,j),Element(i,k))+mMatGLSL(j,k);
end
f1(Element(i,k))=f1(Element(i,k))+f1L(k);
f2(Element(i,k))=f2(Element(i,k))+f2L(k);
f3(Element(i,k))=f3(Element(i,k))+f3L(k);
end
end
dt=0.01;
lSet=lSet-((((mMat+mMatGLS)^-1)/dt)*(f1+f2+f3))';
end
%scatter3(Node(:,1), Node(:,2), lSet');

232
Unpublished/XFEM2/1D_Solver/GetF2D_T.asv Normal file
View file

@ -0,0 +1,232 @@
function [] = GetF2D_T()
clear all
% Define Main Solution Mesh
NumX=2;
NumY=1;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
%centx=5.;
%centy=5.;
%rad=2.5;
%for i=1:numNodes;
% dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
% lSet(i)=dist-rad;
%end
for i=1:numNodes;
dist=Node(i,1)-0.1;
lSet(i)=dist;
end
% Plot initial level set
%[X]=meshgrid(0:1.:10);
%Z=zeros(11);
%for i=1:numNodes
% Z(i)=lSet(i);
%end
%surf(X,Z)
% LS Algorithm Parameters
bandwidth=10.;
% Loop through timesteps
for tstep=1:1
% Identify Narrow Band Elements
NBindex=0;
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,2);
NBelem(NBindex,3)=Element(i,3);
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,3);
NBelem(NBindex,3)=Element(i,4);
end
end
% Velocity BC
F=zeros(numNodes,1);
for i=1:NBindex
if sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,2)))||sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,3)))
F(NBelem(i,1))= 0.05;
F(NBelem(i,2))= 0.05;
F(NBelem(i,3))= 0.05;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(numNodes);
for i=1:NBindex
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
% Apply BCs
RHS=zeros(numNodes,1);
Sub=A*F;
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:numNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(numNodes);
mMatGLS=zeros(numNodes);
f1=zeros(numNodes,1);
f2=zeros(numNodes,1);
f3=zeros(numNodes,1);
h=1.;
visc=0.001;
for i=1:NBindex
mMatL=zeros(3);
mMatGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
mMatL=mMatL+(phi'*phi)/3.;
mMatGLSL=mMatGLSL+((delphi'*(delset/norm(delset)))*Floc*(h/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(h/abs(Floc))*Floc*norm(delset)/3.;
vs=h*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+h));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
mMat(NBelem(i,j),NBelem(i,k))=mMat(NBelem(i,j),NBelem(i,k))+mMatL(j,k);
mMatGLS(NBelem(i,j),NBelem(i,k))=mMatGLS(NBelem(i,j),NBelem(i,k))+mMatGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
(mMat+mMatGLS)^-1
f1+f2+f3
dt=0.0001;
-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))'
lSet=lSet-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))';
end
lSet';
%scatter3(Node(:,1), Node(:,2), lSet');

233
Unpublished/XFEM2/1D_Solver/GetF2D_T.m Normal file
View file

@ -0,0 +1,233 @@
function [] = GetF2D_T()
clear all
% Define Main Solution Mesh
NumX=2;
NumY=1;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
%centx=5.;
%centy=5.;
%rad=2.5;
%for i=1:numNodes;
% dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
% lSet(i)=dist-rad;
%end
for i=1:numNodes;
dist=Node(i,1)-1.5;
lSet(i)=dist;
end
% Plot initial level set
%[X]=meshgrid(0:1.:10);
%Z=zeros(11);
%for i=1:numNodes
% Z(i)=lSet(i);
%end
%surf(X,Z)
% LS Algorithm Parameters
bandwidth=10.;
% Loop through timesteps
for tstep=1:1
% Identify Narrow Band Elements
NBindex=0;
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,2);
NBelem(NBindex,3)=Element(i,3);
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,3);
NBelem(NBindex,3)=Element(i,4);
end
end
% Velocity BC
F=zeros(numNodes,1);
for i=1:NBindex
if sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,2)))||sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,3)))
F(NBelem(i,1))= 0.05;
F(NBelem(i,2))= 0.05;
F(NBelem(i,3))= 0.05;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(numNodes);
for i=1:NBindex
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
% Apply BCs
RHS=zeros(numNodes,1);
Sub=A*F;
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:numNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(numNodes);
mMatGLS=zeros(numNodes);
f1=zeros(numNodes,1);
f2=zeros(numNodes,1);
f3=zeros(numNodes,1);
h=1.;
visc=0.0005;
for i=1:NBindex
mMatL=zeros(3);
mMatGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
mMatL=mMatL+(phi'*phi)/3.;
mMatGLSL=mMatGLSL+((delphi'*(delset/norm(delset)))*Floc*(h/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(h/abs(Floc))*Floc*norm(delset)/3.;
vs=h*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+h));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
mMat(NBelem(i,j),NBelem(i,k))=mMat(NBelem(i,j),NBelem(i,k))+mMatL(j,k);
mMatGLS(NBelem(i,j),NBelem(i,k))=mMatGLS(NBelem(i,j),NBelem(i,k))+mMatGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
mMat
mMatGLS
(mMat+mMatGLS)^-1
f1+f2+f3
dt=0.1;
-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))'
lSet=lSet-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))';
end
lSet';
%scatter3(Node(:,1), Node(:,2), lSet');

234
Unpublished/XFEM2/1D_Solver/GetF2D_Z.m Normal file
View file

@ -0,0 +1,234 @@
function [] = GetF2D_Z()
clear all
% Define Main Solution Mesh
NumX=8;
NumY=8;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
centx=4.;
centy=4.;
rad=2.1;
for i=1:numNodes;
dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
lSet(i)=dist-rad;
end
%for i=1:numNodes;
% dist=Node(i,1)-0.1;
% lSet(i)=dist;
%end
% Plot initial level set
[X Y]=meshgrid(0:1.:8);
Z=zeros(9);
for i=1:81
Z(i)=lSet(i);
end
surf(X,Y,Z)
% LS Algorithm Parameters
lSet'
bandwidth=10.;
% Loop through timesteps
for tstep=1:100
% Identify Narrow Band Elements
NBindex=0;
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,2);
NBelem(NBindex,3)=Element(i,3);
NBindex=NBindex+1;
NBelem(NBindex,1)=Element(i,1);
NBelem(NBindex,2)=Element(i,3);
NBelem(NBindex,3)=Element(i,4);
end
end
% Velocity BC
F=zeros(numNodes,1);
for i=1:NBindex
if sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,2)))||sign(lSet(NBelem(i,1)))~=sign(lSet(NBelem(i,3)))
F(NBelem(i,1))= 1.;
F(NBelem(i,2))= 1.;
F(NBelem(i,3))= 1.;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(numNodes);
for i=1:NBindex
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
% Apply BCs
RHS=zeros(numNodes,1);
Sub=A*F;
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:numNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:numNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(numNodes);
mMatGLS=zeros(numNodes);
f1=zeros(numNodes,1);
f2=zeros(numNodes,1);
f3=zeros(numNodes,1);
h2=0.00001;
visc=0.0005;
for i=1:NBindex
mMatL=zeros(3);
mMatGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NBelem(i,1),1);
y1=Node(NBelem(i,1),2);
x2=Node(NBelem(i,2),1);
y2=Node(NBelem(i,2),2);
x3=Node(NBelem(i,3),1);
y3=Node(NBelem(i,3),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSet(NBelem(i,1));lSet(NBelem(i,2));lSet(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
mMatL=mMatL+(phi'*phi)/3.;
mMatGLSL=mMatGLSL+((delphi'*(delset/norm(delset)))*Floc*(h2/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(h2/abs(Floc))*Floc*norm(delset)/3.;
vs=h2*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+h2));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
mMat(NBelem(i,j),NBelem(i,k))=mMat(NBelem(i,j),NBelem(i,k))+mMatL(j,k);
mMatGLS(NBelem(i,j),NBelem(i,k))=mMatGLS(NBelem(i,j),NBelem(i,k))+mMatGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
dt=0.01;
lSet=lSet-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))';
end
lSet'
%[X Y]=meshgrid(0:1.:8);
%Z=zeros(9);
%for i=1:81
% Z(i)=lSet(i);
%end
%surf(X,Y,Z)

2
Unpublished/XFEM2/1D_Solver/testGrid.asv Normal file
View file

@ -0,0 +1,2 @@
function [] = testGrid()

4
Unpublished/XFEM2/1D_Solver/testGrid.m Normal file
View file

@ -0,0 +1,4 @@
function [] = testGrid()
[X,Y]=meshgrid(1:1:10);
Z=2*X+Y
surf(X,Y,Z)

159
Unpublished/XFEM2/2DSimp.asv Normal file
View file

@ -0,0 +1,159 @@
function [] = 2DSimp()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=3;
NumY=3;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j);
Element(index,4)=i+(NumX+1)*(j)+1;
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=1;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.25;
% Initial temperatures
Tnew=zeros(numNodes,1);
Bound=zeros(numNodes,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(Element(e,n))=1.;
Bound(Element(e,n))=1.;
end
end
end
% Define Time Step
dtime=0.05;
tsteps=20;
time=0.;
% Loop through time steps
for ts=1:tsteps
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
end
% regular element - fix extra dofs
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=-gpos;
hx(4)=gpos;
% Loop Through Int Points
for i=1:4;
g=gx(i);
h=hx(i);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
cond=1.;
spec=1.;
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
phih(1)=0.25*-(1.-g);
phih(2)=0.25*-(1.+g);
phih(3)=0.25*(1.+g);
phih(4)=0.25*(1.-g);
rjac=zeros(2,2);
for iter=1:4
rjac(1,1)=rjac(1,1)+phig(iter)*crdnx(iter);
rjac(1,2)=rjac(1,2)+phig(iter)*crdny(iter);
rjac(2,1)=rjac(2,1)+phih(iter)*crdnx(iter);
rjac(2,2)=rjac(2,2)+phih(iter)*crdny(iter);
end
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 ;
for iter=1:4
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
% Assemble Global Matrices
gnum(1)=Element(e,1);
gnum(2)=Element(e,2);
gnum(3)=Element(e,3);
gnum(4)=Element(e,4);
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(j,2*i-1);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=M*Tnew;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i)+pforce(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
StiffI=Ared^-1;
Tnewr=(Ared^-1)*RHSred';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end
stored'

154
Unpublished/XFEM2/2DSimp.m Normal file
View file

@ -0,0 +1,154 @@
function [] = 2DSimp()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=3;
NumY=3;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j);
Element(index,4)=i+(NumX+1)*(j)+1;
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=1;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.25;
% Initial temperatures
Tnew=zeros(numNodes,1);
Bound=zeros(numNodes,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(Element(e,n))=1.;
Bound(Element(e,n))=1.;
end
end
end
% Define Time Step
dtime=0.05;
tsteps=20;
time=0.;
% Loop through time steps
for ts=1:tsteps
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
end
% regular element - fix extra dofs
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=-gpos;
hx(4)=gpos;
% Loop Through Int Points
for i=1:4;
g=gx(i);
h=hx(i);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
cond=1.;
spec=1.;
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
phih(1)=0.25*-(1.-g);
phih(2)=0.25*-(1.+g);
phih(3)=0.25*(1.+g);
phih(4)=0.25*(1.-g);
rjac=zeros(2,2);
for iter=1:4
rjac(1,1)=rjac(1,1)+phig(iter)*crdnx(iter);
rjac(1,2)=rjac(1,2)+phig(iter)*crdny(iter);
rjac(2,1)=rjac(2,1)+phih(iter)*crdnx(iter);
rjac(2,2)=rjac(2,2)+phih(iter)*crdny(iter);
end
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 ;
for iter=1:4
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
% Assemble Global Matrices
gnum(1)=Element(e,1);
gnum(2)=Element(e,2);
gnum(3)=Element(e,3);
gnum(4)=Element(e,4);
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(j,i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(j,i);
end
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=M*Tnew;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
StiffI=Ared^-1;
Tnewr=(Ared^-1)*RHSred';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end
stored'

91
Unpublished/XFEM2/AbInp.inp Normal file
View file

@ -0,0 +1,91 @@
*Heading
** Job name: Job-1 Model name: Model-1
** Generated by: Abaqus/CAE 6.12-1
*Preprint, echo=NO, model=NO, history=NO, contact=NO
**
** PARTS
**
*Part, name=Part-1
*Node
1, 0., 0., 0.
2, 0.2, 0., 0.
3, 0.4, 0., 0.
4, 0.6, 0., 0.
5, 0.8, 0., 0.
6, 1., 0., 0.
7, 1.2, 0., 0.
8, 1.4, 0., 0.
9, 1.6, 0., 0.
10, 1.8, 0., 0.
11, 2., 0., 0.
*USER ELEMENT,NODES=2,TYPE=U8008,PROP=1,COORDINATES=1,VAR=2,unsymm
11,12
*Element, type=U8008,ELSET=UEL
1, 1, 2
2, 2, 3
3, 3, 4
4, 4, 5
5, 5, 6
6, 6, 7
7, 7, 8
8, 8, 9
9, 9, 10
10, 10, 11
*UEL Property, Elset=UEL
1.
*End Part
**
**
** ASSEMBLY
**
*Assembly, name=Assembly
**
*Instance, name=Part-1-1, part=Part-1
*End Instance
**
*Nset, nset=_PickedSet16, internal, instance=Part-1-1
1,
*Nset, nset=_PickedSet17, internal, instance=Part-1-1
2,
*Nset, nset=Set-6, instance=Part-1-1
1,
*End Assembly
**
** MATERIALS
**
*Material, name=Material-1
*Conductivity
1.,
*Density
1.,
*Specific Heat
1.,
** ----------------------------------------------------------------
**
** Name: Predefined Field-1 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet16, 1.,0.
** Name: Predefined Field-2 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet17, 0.,0.
** STEP: Step-1
**
*Step, name=Step-1
*Heat Transfer, end=PERIOD, deltmx=100.
0.1, 1.6, 1e-09, 0.1,
**
** BOUNDARY CONDITIONS
**
** Name: BC-1 Type: Temperature
*Boundary
Set-6, 11, 11, 1.
**
** OUTPUT REQUESTS
**
*Restart, write, frequency=0
**
** FIELD OUTPUT: F-Output-1
**
*Output, field, variable=PRESELECT
*Output, history, frequency=0
*End Step

91
Unpublished/XFEM2/Backup/AbInp.inp Normal file
View file

@ -0,0 +1,91 @@
*Heading
** Job name: Job-1 Model name: Model-1
** Generated by: Abaqus/CAE 6.12-1
*Preprint, echo=NO, model=NO, history=NO, contact=NO
**
** PARTS
**
*Part, name=Part-1
*Node
1, 0., 0., 0.
2, 0.2, 0., 0.
3, 0.4, 0., 0.
4, 0.6, 0., 0.
5, 0.8, 0., 0.
6, 1., 0., 0.
7, 1.2, 0., 0.
8, 1.4, 0., 0.
9, 1.6, 0., 0.
10, 1.8, 0., 0.
11, 2., 0., 0.
*USER ELEMENT,NODES=2,TYPE=U8008,PROP=1,COORDINATES=1,VAR=2,unsymm
11,12
*Element, type=U8008,ELSET=UEL
1, 1, 2
2, 2, 3
3, 3, 4
4, 4, 5
5, 5, 6
6, 6, 7
7, 7, 8
8, 8, 9
9, 9, 10
10, 10, 11
*UEL Property, Elset=UEL
1.
*End Part
**
**
** ASSEMBLY
**
*Assembly, name=Assembly
**
*Instance, name=Part-1-1, part=Part-1
*End Instance
**
*Nset, nset=_PickedSet16, internal, instance=Part-1-1
1,
*Nset, nset=_PickedSet17, internal, instance=Part-1-1
2,
*Nset, nset=Set-6, instance=Part-1-1
1,
*End Assembly
**
** MATERIALS
**
*Material, name=Material-1
*Conductivity
1.,
*Density
1.,
*Specific Heat
1.,
** ----------------------------------------------------------------
**
** Name: Predefined Field-1 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet16, 1.,0.
** Name: Predefined Field-2 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet17, 0.,0.
** STEP: Step-1
**
*Step, name=Step-1
*Heat Transfer, end=PERIOD, deltmx=100.
0.1, 1.6, 1e-09, 0.1,
**
** BOUNDARY CONDITIONS
**
** Name: BC-1 Type: Temperature
*Boundary
Set-6, 11, 11, 1.
**
** OUTPUT REQUESTS
**
*Restart, write, frequency=0
**
** FIELD OUTPUT: F-Output-1
**
*Output, field, variable=PRESELECT
*Output, history, frequency=0
*End Step

80
Unpublished/XFEM2/Backup/FESolve.m Normal file
View file

@ -0,0 +1,80 @@
function [] = FESolve()
% MATLAB based FE Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
spec=1.;
cond=1.;
% Generate Mesh
numElem=10;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% Initialize Conditions
Tnew=zeros(numNodes,1);
Tnew(1)=1.;
% Define Time Step
dtime=.1;
tsteps=10;
time=0.;
% Loop through time steps
for ts=1:tsteps;
time=time+dtime;
K=zeros(numNodes,numNodes);
M=zeros(numNodes,numNodes);
% Loop Through Elements
for e=1:numElem;
Ke=zeros(2);
Me=zeros(2);
gpx(1)=-1./sqrt(3.);
gpx(2)=1./sqrt(3.);
ajacob=abs(ndCoords(elemNodes(e,2))-ndCoords(elemNodes(e,1)))/2.;
% Loop Through Int Points
for i=1:2;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(2)=(1.+c)/2.;
phic(1)=-0.5;
phic(2)=0.5;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
we=ajacob;
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Assemble Global Matrices
K(elemNodes(e,1),elemNodes(e,1))=K(elemNodes(e,1),elemNodes(e,1))+Ke(1,1);
K(elemNodes(e,1),elemNodes(e,2))=K(elemNodes(e,1),elemNodes(e,2))+Ke(1,2);
K(elemNodes(e,2),elemNodes(e,1))=K(elemNodes(e,2),elemNodes(e,1))+Ke(2,1);
K(elemNodes(e,2),elemNodes(e,2))=K(elemNodes(e,2),elemNodes(e,2))+Ke(2,2);
M(elemNodes(e,1),elemNodes(e,1))=M(elemNodes(e,1),elemNodes(e,1))+Me(1,1);
M(elemNodes(e,1),elemNodes(e,2))=M(elemNodes(e,1),elemNodes(e,2))+Me(1,2);
M(elemNodes(e,2),elemNodes(e,1))=M(elemNodes(e,2),elemNodes(e,1))+Me(2,1);
M(elemNodes(e,2),elemNodes(e,2))=M(elemNodes(e,2),elemNodes(e,2))+Me(2,2);
end
%Apply Boundary Conditions (Reduce Matrices)
T1=1;
RHS=M*Tnew;
for i=1:numNodes-1;
for j=1:numNodes-1;
Kred(i,j)=K(i+1,j+1);
Mred(i,j)=M(i+1,j+1);
end
Subr(i)=(K(i+1,1)+M(i+1,1))*T1;
RHSr(i)=RHS(i+1);
end
%Solve
StiffI=(Mred+Kred)^-1;
Tnewr=StiffI*(RHSr'-Subr');
for i=1:numNodes-1;
Tnew(i+1)=Tnewr(i);
end
Tnew(1)=1.;
Tnew
end

221
Unpublished/XFEM2/Backup/FESolveX.m Normal file
View file

@ -0,0 +1,221 @@
function [] = FESolveX()
% MATLAB based XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=10.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=10;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=5.;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
if crdn1<=dpos
Tnew(2*elemNodes(e,1)-1)=1.;
end
end
% Define Time Step
dtime=0.05;
tsteps=20;
time=0.;
% penalty term
beta=40.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
fdofs(1)=2*elemNodes(e,1);
fdofs(2)=2*elemNodes(e,2);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
if term<0
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
tpos=gm(1)*Tnew(1)+gm(2)*Tnew(2)+gm(3)*Tnew(3)+gm(4)*Tnew(4);
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove inactive DOFs(Reduce Matrices)
T1=1;
RHS=M*Tnew;
iindex=0;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
jindex=0;
iindex=iindex+1;
for j=1:ndof*numNodes;
check=1;
if j==fdofs(1)|j==fdofs(2)
check=0;
elseif mod(j,2)~=0 & j~=1
check=0;
end
if check==0
jindex=jindex+1;
Kred(iindex,jindex)=K(i,j);
Mred(iindex,jindex)=M(i,j);
end
end
Subr(iindex)=(K(i,1)+M(i,1))*T1;
RHSr(iindex)=RHS(i);
pforcer(iindex)=pforce(i);
end
end
%Solve
Mred+Kred;
StiffI=(Mred+Kred)^-1;
Tnewr=StiffI*(RHSr'-Subr'+pforcer');
iindex=0.;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
else
Tnew(i)=0.;
end
end
Tnew(1)=1.;
Tnew
end
stored'

238
Unpublished/XFEM2/Backup/FESolveX2D.asv Normal file
View file

@ -0,0 +1,238 @@
function [] = FESolveX2D()
% MATLAB based XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
Lx=1;
Ly=1;
% Generate Mesh
numElemX=1;
numElemY=1;
numElem=numElemX*numElemY;
gapX=Lx/numElemX;
gapY=Ly/numElemY;
tmpX=0.
tmpY=0.
for i=1:numElemX+1
for j=1:numElemY+1
ndCrdX=
[ndCrds,elemNodes]=rectangularMesh(Lx,Ly,numElemX,numElemY);
xx=ndCrds(:,1);
yy=ndCrds(:,2);
drawingMesh(ndCrds,elemNodes,'Q4','k-');
numNodes=size(xx,1);
ndCrds
elemNodes
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=5.;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
if crdn1<=dpos
Tnew(2*elemNodes(e,1)-1)=1.;
end
end
% Define Time Step
dtime=0.05;
tsteps=20;
time=0.;
% penalty term
beta=40.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
fdofs(1)=2*elemNodes(e,1);
fdofs(2)=2*elemNodes(e,2);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
if term<0
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
tpos=gm(1)*Tnew(1)+gm(2)*Tnew(2)+gm(3)*Tnew(3)+gm(4)*Tnew(4);
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove inactive DOFs(Reduce Matrices)
T1=1;
RHS=M*Tnew;
iindex=0;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
jindex=0;
iindex=iindex+1;
for j=1:ndof*numNodes;
check=1;
if j==fdofs(1)|j==fdofs(2)
check=0;
elseif mod(j,2)~=0 & j~=1
check=0;
end
if check==0
jindex=jindex+1;
Kred(iindex,jindex)=K(i,j);
Mred(iindex,jindex)=M(i,j);
end
end
Subr(iindex)=(K(i,1)+M(i,1))*T1;
RHSr(iindex)=RHS(i);
pforcer(iindex)=pforce(i);
end
end
%Solve
Mred+Kred;
StiffI=(Mred+Kred)^-1;
Tnewr=StiffI*(RHSr'-Subr'+pforcer');
iindex=0.;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
else
Tnew(i)=0.;
end
end
Tnew(1)=1.;
Tnew
end
stored'

228
Unpublished/XFEM2/Backup/FESolveX2D.m Normal file
View file

@ -0,0 +1,228 @@
function [] = FESolveX2D()
% MATLAB based XFEM Solver
% J. Grogan (2012)
clear all
% Import Abaqus Mesh from INP File
AbaFile=fopen('AbInp.inp');
AbaContent=zeros(1,5);
while AbaContent(1:5)~='*Node'
AbaContent=fgets(AbaFile)
AbaContent
end
[ndCrds,elemNodes]=rectangularMesh(Lx,Ly,numElemX,numElemY);
xx=ndCrds(:,1);
yy=ndCrds(:,2);
drawingMesh(ndCrds,elemNodes,'Q4','k-');
numNodes=size(xx,1);
ndCrds
elemNodes
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=5.;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
if crdn1<=dpos
Tnew(2*elemNodes(e,1)-1)=1.;
end
end
% Define Time Step
dtime=0.05;
tsteps=20;
time=0.;
% penalty term
beta=40.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
fdofs(1)=2*elemNodes(e,1);
fdofs(2)=2*elemNodes(e,2);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
if term<0
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
tpos=gm(1)*Tnew(1)+gm(2)*Tnew(2)+gm(3)*Tnew(3)+gm(4)*Tnew(4);
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove inactive DOFs(Reduce Matrices)
T1=1;
RHS=M*Tnew;
iindex=0;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
jindex=0;
iindex=iindex+1;
for j=1:ndof*numNodes;
check=1;
if j==fdofs(1)|j==fdofs(2)
check=0;
elseif mod(j,2)~=0 & j~=1
check=0;
end
if check==0
jindex=jindex+1;
Kred(iindex,jindex)=K(i,j);
Mred(iindex,jindex)=M(i,j);
end
end
Subr(iindex)=(K(i,1)+M(i,1))*T1;
RHSr(iindex)=RHS(i);
pforcer(iindex)=pforce(i);
end
end
%Solve
Mred+Kred;
StiffI=(Mred+Kred)^-1;
Tnewr=StiffI*(RHSr'-Subr'+pforcer');
iindex=0.;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
else
Tnew(i)=0.;
end
end
Tnew(1)=1.;
Tnew
end
stored'

95
Unpublished/XFEM2/Backup/Tst.m Normal file
View file

@ -0,0 +1,95 @@
function [] = Tst()
% set up grid
gd=0.;
numElem=4;
eLen=0.25;
for i=1:numElem+1
ndCrd(i)=gd;
gd=gd+eLen;
end
for i=1:numElem
elemNod(i,1)=i;
elemNod(i,2)=i+1;
end
% initial level set
dpos=0.1;
for i=1:numElem+1
lSet(i)=sign(ndCrd(i)-dpos)*abs(dpos-ndCrd(i));
end
% force vector BC
fVect=zeros(12,1);
for i=1:numElem
if sign(lSet(elemNod(i,1)))~=sign(lSet(elemNod(i,2)))
fVect(elemNod(i,1))= 1.;
fVect(elemNod(i,2))= 1.;
end
end
% solve for velocity vector
Af=zeros(numElem+1);
% Assemble 'Stiffness' Matrices
for i=1:numElem
pos(1)=-1/sqrt(3);
pos(2)=1/sqrt(3);
AfL=zeros(2);
AfLGLS=zeros(2);
for j=1:2
shp(1)=(1-pos(j))/2.;
shp(2)=(1+pos(j))/2.;
dshp(1)=-0.5;
dshp(2)=0.5;
rset=shp(1)*lSet(elemNod(i,1))+shp(2)*lSet(elemNod(i,2));
dls=dshp(1)*lSet(elemNod(i,1))+dshp(2)*lSet(elemNod(i,2));
AfL=AfL+shp'*sign(rset)*(dls*dshp);
AfLGLS=AfLGLS+(dshp'*dls)*(1./abs(dls))*(dls*dshp);
end
for k=1:2;
for j=1:2;
Af(elemNod(i,j),elemNod(i,k))=Af(elemNod(i,j),elemNod(i,k))+AfL(j,k)+AfLGLS(j,k);
end
end
end
% Update level set
mMat=zeros(numElem+1);
mMatGLS=zeros(numElem+1);
f1=zeros(numElem+1,1);
f2=zeros(numElem+1,1);
f3=zeros(numElem+1,1);
for i=1:numElem
pos(1)=-1/sqrt(3);
pos(2)=1/sqrt(3);
mMatL=zeros(2);
mMatGLSL=zeros(2);
f1L=zeros(2,1);
f2L=zeros(2,1);
f3L=zeors(2,1);
for j=1:2
shp(1)=(1-pos(j))/2.;
shp(2)=(1+pos(j))/2.;
dshp(1)=-0.5;
dshp(2)=0.5;
Floc=shp(1)*fVect(elemNod(i,1))+shp(2)*fVect(elemNod(i,2));
rset=shp(1)*lSet(elemNod(i,1))+shp(2)*lSet(elemNod(i,2));
dls=dshp(1)*lSet(elemNod(i,1))+dshp(2)*lSet(elemNod(i,2));
mMatL=mMatL+shp'*shp;
mMatGLS=mMatGLS+dshp'*(dls/abs(dls))*Floc*1.*shp;
f1L=f1L+shp'*Floc*abs(dls);
f2L=f2L+dshp'*(dls/abs(dls))*Floc*1.*Floc*abs(dls);
vs=1.*((abs(0.1+Floc*abs(dls)))/(abs(Floc*abs(dls))+1.));
f3L=f3L+vs*dshp'*dls;
end
for k=1:2;
for j=1:2;
mMat(elemNod(i,j),elemNod(i,k))=mMat(elemNod(i,j),elemNod(i,k))+mMatL(j,k);
mMatGLS(elemNod(i,j),elemNod(i,k))=mMatGLS(elemNod(i,j),elemNod(i,k))+mMatGLSL(j,k);
end
f1(elemNod(i,k))=f1(elemNod(i,k))+f1L(k);
f2(elemNod(i,k))=f2(elemNod(i,k))+f2L(k);
f3(elemNod(i,k))=f3(elemNod(i,k))+f3L(k);
end
end
dt=0.1;
lSet=lSet-(((mMat+mMatGLS)^-1)/dt)*(f1+f2+f3);
lSet

80
Unpublished/XFEM2/FESolve.m Normal file
View file

@ -0,0 +1,80 @@
function [] = FESolve()
% MATLAB based FE Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
spec=1.;
cond=1.;
% Generate Mesh
numElem=10;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% Initialize Conditions
Tnew=zeros(numNodes,1);
Tnew(1)=1.;
% Define Time Step
dtime=.1;
tsteps=10;
time=0.;
% Loop through time steps
for ts=1:tsteps;
time=time+dtime;
K=zeros(numNodes,numNodes);
M=zeros(numNodes,numNodes);
% Loop Through Elements
for e=1:numElem;
Ke=zeros(2);
Me=zeros(2);
gpx(1)=-1./sqrt(3.);
gpx(2)=1./sqrt(3.);
ajacob=abs(ndCoords(elemNodes(e,2))-ndCoords(elemNodes(e,1)))/2.;
% Loop Through Int Points
for i=1:2;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(2)=(1.+c)/2.;
phic(1)=-0.5;
phic(2)=0.5;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
we=ajacob;
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Assemble Global Matrices
K(elemNodes(e,1),elemNodes(e,1))=K(elemNodes(e,1),elemNodes(e,1))+Ke(1,1);
K(elemNodes(e,1),elemNodes(e,2))=K(elemNodes(e,1),elemNodes(e,2))+Ke(1,2);
K(elemNodes(e,2),elemNodes(e,1))=K(elemNodes(e,2),elemNodes(e,1))+Ke(2,1);
K(elemNodes(e,2),elemNodes(e,2))=K(elemNodes(e,2),elemNodes(e,2))+Ke(2,2);
M(elemNodes(e,1),elemNodes(e,1))=M(elemNodes(e,1),elemNodes(e,1))+Me(1,1);
M(elemNodes(e,1),elemNodes(e,2))=M(elemNodes(e,1),elemNodes(e,2))+Me(1,2);
M(elemNodes(e,2),elemNodes(e,1))=M(elemNodes(e,2),elemNodes(e,1))+Me(2,1);
M(elemNodes(e,2),elemNodes(e,2))=M(elemNodes(e,2),elemNodes(e,2))+Me(2,2);
end
%Apply Boundary Conditions (Reduce Matrices)
T1=1;
RHS=M*Tnew;
for i=1:numNodes-1;
for j=1:numNodes-1;
Kred(i,j)=K(i+1,j+1);
Mred(i,j)=M(i+1,j+1);
end
Subr(i)=(K(i+1,1)+M(i+1,1))*T1;
RHSr(i)=RHS(i+1);
end
%Solve
StiffI=(Mred+Kred)^-1;
Tnewr=StiffI*(RHSr'-Subr');
for i=1:numNodes-1;
Tnew(i+1)=Tnewr(i);
end
Tnew(1)=1.;
Tnew
end

174
Unpublished/XFEM2/FESolveSimp.asv Normal file
View file

@ -0,0 +1,174 @@
function [] = FESolveSimp()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=10;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=1;
% Initial temperatures
Tnew=zeros(numNodes,1);
Bound=zeros(numNodes,1);
Tnew(1)=1.;
Bound(1)=1.;
% Define Time Step
dtime=0.0001;
tsteps=100;
time=0.;
% Loop through time steps
for ts=1:tsteps
K=zeros(numNodes,numNodes);
M=zeros(numNodes,numNodes);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
% Loop Through Int Points
for i=1:2;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(2)=(1.+c)/2.;
cond=1.;
spec=1.;
phic(1)=-0.5;
phic(2)=0.5;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
if enr==5;
Ke(1,2)=0.;
Me(1,2)=0.;
Ke(2,1)=0.;
Me(2,1)=0.;
Ke(1,4)=0.;
Me(1,4)=0.;
Ke(4,1)=0.;
Me(4,1)=0.;
Ke(3,2)=0.;
Me(3,2)=0.;
Ke(2,3)=0.;
Me(2,3)=0.;
Ke(4,3)=0.;
Me(4,3)=0.;
Ke(3,4)=0.;
Me(3,4)=0.;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove NON-ENHANCED DOFs(Reduce Matrices)
iindex=0.;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
TR1(iindex)=Tnew(i);
BR1(iindex)=Bound(i);
pforceR1(iindex)=pforce(i);
jindex=0;
for j=1:ndof*numNodes;
check=0;
if mod(j,2)==0 && eNodes(j)~=1
check=1;
end
if check==0
jindex=jindex+1;
MR1(iindex,jindex)=M(i,j);
KR1(iindex,jindex)=K(i,j);
end
end
end
end
AR1=KR1+MR1
SubR1=AR1*BR1'
MR1
TR1'
MR1*TR1'
pforceR1'
RHSR1=MR1*TR1'-SubR1+pforceR1'
% Apply Boundary Conditions
Biindex=0.;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
RHSR2(Biindex)=RHSR1(i);
jindex=0;
for j=1:iindex;
check=0;
if BR1(j)==0.;
jindex=jindex+1;
AR2(Biindex,jindex)=AR1(i,j);
end
end
end
end
%Solve
Tnewr=(AR2^-1)*RHSR2'
% Restore Matrices
Biindex=0;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
TR1(i)=Tnewr(Biindex);
end
end
iindex=0;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
Tnew(i)=TR1(iindex);
end
end
Tnew
end
stored'

98
Unpublished/XFEM2/FESolveSimp.m Normal file
View file

@ -0,0 +1,98 @@
function [] = FESolveSimp()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=10.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=10;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=1;
% Initial temperatures
Tnew=zeros(numNodes,1);
Bound=zeros(numNodes,1);
Tnew(1)=1.;
Bound(1)=1.;
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% Loop through time steps
for ts=1:tsteps
K=zeros(numNodes,numNodes);
M=zeros(numNodes,numNodes);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
% Loop Through Int Points
for i=1:2;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(2)=(1.+c)/2.;
cond=1.;
spec=1.;
phic(1)=-0.5;
phic(2)=0.5;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Assemble Global Matrices
gnum=elemNodes(e,1);
for i=1:2;
for j=1:2;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
end
end
%Remove NON-ENHANCED DOFs(Reduce Matrices)
iindex=0.;
A=K+M;
Sub=A*Bound;
RHS=M*Tnew-Sub;
% Apply Boundary Conditions
for i=1:numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSR(iindex)=RHS(i);
jindex=0;
for j=1:numNodes;
if Bound(j)==0.;
jindex=jindex+1;
AR(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(AR^-1)*RHSR';
% Restore Matrices
iindex=0;
for i=1:numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end

224
Unpublished/XFEM2/FESolveX.asv Normal file
View file

@ -0,0 +1,224 @@
function [] = FESolveX()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=3.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=3;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=0.1;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
if crdn1<=dpos
Tnew(2*elemNodes(e,1)-1)=1.;
end
end
% Define Time Step
dtime=0.01;
tsteps=1;
time=0.;
% penalty term
beta=200.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=1.*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
vel=0.;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
fdofs(1)=2*elemNodes(e,1);
fdofs(2)=2*elemNodes(e,2);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
if term<0
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
tpos=gm(1)*Tnew(1)+gm(2)*Tnew(2)+gm(3)*Tnew(3)+gm(4)*Tnew(4);
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove inactive DOFs(Reduce Matrices)
T1=1;
RHS=M*Tnew;
iindex=0;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
% elseif mod(i,2)~=0 & i~=1
elseif i~=1
check=0;
end
if check==0
jindex=0;
iindex=iindex+1;
for j=1:ndof*numNodes;
check=1;
if j==fdofs(1)|j==fdofs(2)
check=0;
% elseif mod(j,2)~=0 & j~=1
elseif j~=1
check=0;
end
if check==0
jindex=jindex+1;
Kred(iindex,jindex)=K(i,j);
Mred(iindex,jindex)=M(i,j);
end
end
Subr(iindex)=(K(i,1)+M(i,1))*T1;
RHSr(iindex)=RHS(i);
pforcer(iindex)=pforce(i);
end
end
%Solve
StiffI=(Mred+Kred)^-1;
Tnewr=StiffI*(RHSr'-Subr'+pforcer');
iindex=0.;
for i=1:ndof*numNodes;
% check=1;
% if i==fdofs(1)|i==fdofs(2)
check=0;
% elseif mod(i,2)~=0 & i~=1
elseif i~=1
check=0;
end
if check==0
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
else
Tnew(i)=0.;
end
end
Tnew(1)=1.;
Tnew
end
stored'

221
Unpublished/XFEM2/FESolveX.m Normal file
View file

@ -0,0 +1,221 @@
function [] = FESolveX()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=10.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=40;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=4.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
if crdn1<=dpos
Tnew(2*elemNodes(e,1)-1)=1.;
end
end
% Define Time Step
dtime=0.1;
tsteps=10;
time=0.;
% penalty term
beta=200.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=1.*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
vel=0.;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
fdofs(1)=2*elemNodes(e,1);
fdofs(2)=2*elemNodes(e,2);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
if term<0
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
tpos=gm(1)*Tnew(1)+gm(2)*Tnew(2)+gm(3)*Tnew(3)+gm(4)*Tnew(4);
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove inactive DOFs(Reduce Matrices)
T1=1;
RHS=M*Tnew;
iindex=0;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
jindex=0;
iindex=iindex+1;
for j=1:ndof*numNodes;
check=1;
if j==fdofs(1)|j==fdofs(2)
check=0;
elseif mod(j,2)~=0 & j~=1
check=0;
end
if check==0
jindex=jindex+1;
Kred(iindex,jindex)=K(i,j);
Mred(iindex,jindex)=M(i,j);
end
end
Subr(iindex)=(K(i,1)+M(i,1))*T1;
RHSr(iindex)=RHS(i);
pforcer(iindex)=pforce(i);
end
end
%Solve
StiffI=(Mred+Kred)^-1;
Tnewr=StiffI*(RHSr'-Subr'+pforcer');
iindex=0.;
for i=1:ndof*numNodes;
check=1;
if i==fdofs(1)|i==fdofs(2)
check=0;
elseif mod(i,2)~=0 & i~=1
check=0;
end
if check==0
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
else
Tnew(i)=0.;
end
end
Tnew(1)=1.;
Tnew
end
stored'

270
Unpublished/XFEM2/FESolveX2D.asv Normal file
View file

@ -0,0 +1,270 @@
function [] = FESolveX2D()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=3;
NumY=1;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.25;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(2*Element(e,n)-1)=1.;
Bound(2*Element(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.1;
tsteps=1;
time=0.;
% penalty term
beta=0.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+delX;
d(2)=dpos+3*delX/4;
d(3)=dpos+delX/4;
d(4)=dpos;
for e=1:numElem
crdn1=Node(Element(e,1),1);
crdn2=Node(Element(e,2),1);
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(Element(e,1)*2-1);
tmp1b=Tnew(Element(e,1)*2);
tmp2a=Tnew(Element(e,2)*2-1);
tmp2b=Tnew(Element(e,1)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=(0.5/delX)*(2*t(1)+t(2)-t(3)-2*t(4));
% vel=0.1;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=abs(crdnx(icrd)-dpos)*sign(crdnx(icrd)-dpos);
end
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=8;
% get interface position on element
elen=abs(crdnx(2)-crdnx(1));
frac=abs(dpos-crdnx(1))/elen;
len1=2.*frac;
len2=2.*(1.-frac);
% devide element for sub integration
mid1=-1+len1/2.;
mid2=1-len2/2.;
gx(1)=mid1-(len1/2.)/sqrt(3.);
gx(2)=mid1+(len1/2.)/sqrt(3.);
gx(3)=mid1+(len1/2.)/sqrt(3.);
gx(4)=mid1-(len1/2.)/sqrt(3.);
gx(5)=mid2-(len2/2.)/sqrt(3.);
gx(6)=mid2+(len2/2.)/sqrt(3.);
gx(7)=mid2+(len2/2.)/sqrt(3.);
gx(8)=mid2-(len2/2.)/sqrt(3.);
gpos=1/sqrt(3.);
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=+gpos;
hx(4)=+gpos;
hx(5)=-gpos;
hx(6)=-gpos;
hx(7)=+gpos;
hx(8)=+gpos;
for iw=1:4
w(iw)=frac/2.;
w(iw+4)=(1.-frac)/2.;
end
else
% regular element - fix extra dofs
enr=4;
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
for iw=1:4
w(iw)=1.;
end
end
% Loop Through Int Points
for i=1:enr;
g=gx(i);
h=hx(i);
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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
if iLS<0.
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
for iter=1:4
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=w(i)*djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==8;
xi=2.*frac-1;
yi=-1.;
gm(1)=0.25*(1.-xi)*(1.-yi);
gm(3)=0.25*(1.+xi)*(1.-yi);
gm(5)=0.25*(1.+xi)*(1.+yi);
gm(7)=0.25*(1.-xi)*(1.+yi);
term=theta(1)*gm(1)+theta(2)*gm(3);
gm(2)=gm(1)*(abs(iLS)-abs(theta(1)));
gm(4)=gm(3)*(abs(iLS)-abs(theta(2)));
gm(6)=gm(5)*(abs(iLS)-abs(theta(3)));
gm(8)=gm(7)*(abs(iLS)-abs(theta(4)));
pen=beta*(gm'*gm);
pfL=beta*1.*gm';
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=M*Tnew;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i)+pforce(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
StiffI=Ared^-1;
Tnewr=(Ared^-1)*RHSred';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end
stored'

269
Unpublished/XFEM2/FESolveX2D.m Normal file
View file

@ -0,0 +1,269 @@
function [] = FESolveX2D()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=4;
NumY=1;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.1;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(2*Element(e,n)-1)=1.;
Bound(2*Element(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.1;
tsteps=10;
time=0.;
% penalty term
beta=80.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+delX;
d(2)=dpos+3*delX/4;
d(3)=dpos+delX/4;
d(4)=dpos;
for e=1:numElem
crdn1=Node(Element(e,1),1);
crdn2=Node(Element(e,2),1);
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(Element(e,1)*2-1);
tmp1b=Tnew(Element(e,1)*2);
tmp2a=Tnew(Element(e,2)*2-1);
tmp2b=Tnew(Element(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
% vel=-0.1*(0.5/delX)*(2*t(1)+t(2)-t(3)-2*t(4))
vel=0.0;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=abs(crdnx(icrd)-dpos)*sign(crdnx(icrd)-dpos);
end
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=8;
% get interface position on element
elen=abs(crdnx(2)-crdnx(1));
frac=abs(dpos-crdnx(1))/elen;
len1=2.*frac;
len2=2.*(1.-frac);
% devide element for sub integration
mid1=-1+len1/2.;
mid2=1-len2/2.;
gx(1)=mid1-(len1/2.)/sqrt(3.);
gx(2)=mid1+(len1/2.)/sqrt(3.);
gx(3)=mid1+(len1/2.)/sqrt(3.);
gx(4)=mid1-(len1/2.)/sqrt(3.);
gx(5)=mid2-(len2/2.)/sqrt(3.);
gx(6)=mid2+(len2/2.)/sqrt(3.);
gx(7)=mid2+(len2/2.)/sqrt(3.);
gx(8)=mid2-(len2/2.)/sqrt(3.);
gpos=1/sqrt(3.);
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=+gpos;
hx(4)=+gpos;
hx(5)=-gpos;
hx(6)=-gpos;
hx(7)=+gpos;
hx(8)=+gpos;
for iw=1:4
w(iw)=frac/2.;
w(iw+4)=(1.-frac)/2.;
end
else
% regular element - fix extra dofs
enr=4;
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
for iw=1:4
w(iw)=1.;
end
end
% Loop Through Int Points
for i=1:enr;
g=gx(i);
h=hx(i);
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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
if iLS<0.
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
for iter=1:4
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=w(i)*djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==8;
xi=2.*frac-1;
yi=0.;
gm(1)=0.25*(1.-xi)*(1.-yi);
gm(3)=0.25*(1.+xi)*(1.-yi);
gm(5)=0.25*(1.+xi)*(1.+yi);
gm(7)=0.25*(1.-xi)*(1.+yi);
gm(2)=gm(1)*(-abs(theta(1)));
gm(4)=gm(3)*(-abs(theta(2)));
gm(6)=gm(5)*(-abs(theta(3)));
gm(8)=gm(7)*(-abs(theta(4)));
pen=beta*(gm'*gm);
pfL=beta*1.*gm';
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=M*Tnew;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i)+pforce(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
StiffI=Ared^-1;
Tnewr=(Ared^-1)*RHSred';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end
stored';

269
Unpublished/XFEM2/FESolveX2DLS.m Normal file
View file

@ -0,0 +1,269 @@
function [] = FESolveX2DLS()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=3;
NumY=1;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.1;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(2*Element(e,n)-1)=1.;
Bound(2*Element(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.1;
tsteps=20;
time=0.;
% penalty term
beta=80.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+delX;
d(2)=dpos+3*delX/4;
d(3)=dpos+delX/4;
d(4)=dpos;
for e=1:numElem
crdn1=Node(Element(e,1),1);
crdn2=Node(Element(e,2),1);
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(Element(e,1)*2-1);
tmp1b=Tnew(Element(e,1)*2);
tmp2a=Tnew(Element(e,2)*2-1);
tmp2b=Tnew(Element(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
% vel=-0.1*(0.5/delX)*(2*t(1)+t(2)-t(3)-2*t(4))
vel=0.0;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=abs(crdnx(icrd)-dpos)*sign(crdnx(icrd)-dpos);
end
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=8;
% get interface position on element
elen=abs(crdnx(2)-crdnx(1));
frac=abs(dpos-crdnx(1))/elen;
len1=2.*frac;
len2=2.*(1.-frac);
% devide element for sub integration
mid1=-1+len1/2.;
mid2=1-len2/2.;
gx(1)=mid1-(len1/2.)/sqrt(3.);
gx(2)=mid1+(len1/2.)/sqrt(3.);
gx(3)=mid1+(len1/2.)/sqrt(3.);
gx(4)=mid1-(len1/2.)/sqrt(3.);
gx(5)=mid2-(len2/2.)/sqrt(3.);
gx(6)=mid2+(len2/2.)/sqrt(3.);
gx(7)=mid2+(len2/2.)/sqrt(3.);
gx(8)=mid2-(len2/2.)/sqrt(3.);
gpos=1/sqrt(3.);
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=+gpos;
hx(4)=+gpos;
hx(5)=-gpos;
hx(6)=-gpos;
hx(7)=+gpos;
hx(8)=+gpos;
for iw=1:4
w(iw)=frac/2.;
w(iw+4)=(1.-frac)/2.;
end
else
% regular element - fix extra dofs
enr=4;
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
for iw=1:4
w(iw)=1.;
end
end
% Loop Through Int Points
for i=1:enr;
g=gx(i);
h=hx(i);
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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
if iLS<0.
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
for iter=1:4
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=w(i)*djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==8;
xi=2.*frac-1;
yi=0.;
gm(1)=0.25*(1.-xi)*(1.-yi);
gm(3)=0.25*(1.+xi)*(1.-yi);
gm(5)=0.25*(1.+xi)*(1.+yi);
gm(7)=0.25*(1.-xi)*(1.+yi);
gm(2)=gm(1)*(-abs(theta(1)));
gm(4)=gm(3)*(-abs(theta(2)));
gm(6)=gm(5)*(-abs(theta(3)));
gm(8)=gm(7)*(-abs(theta(4)));
pen=beta*(gm'*gm);
pfL=beta*1.*gm';
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=M*Tnew;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i)+pforce(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
StiffI=Ared^-1;
Tnewr=(Ared^-1)*RHSred';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end
stored'

199
Unpublished/XFEM2/FESolveXT.m Normal file
View file

@ -0,0 +1,199 @@
function [] = FESolveXT()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=10.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=10;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=4.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
for n=1:2
crdn1=ndCoords(elemNodes(e,n));
if crdn1<=dpos
Tnew(2*elemNodes(e,n)-1)=1.;
Bound(2*elemNodes(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% penalty term
beta=50.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=1.*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
vel=0.
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
if term<0
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
tpos=gm(1)*Tnew(1)+gm(2)*Tnew(2)+gm(3)*Tnew(3)+gm(4)*Tnew(4);
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=M*Tnew;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i)+pforce(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(Ared^-1)*RHSred';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end
stored'

272
Unpublished/XFEM2/FESolveXT2.asv Normal file
View file

@ -0,0 +1,272 @@
function [] = FESolveXT2()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=4;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=0.9;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
%for e=1:numElem
% for n=1:2
% crdn1=ndCoords(elemNodes(e,n));
% if crdn1<=dpos
% Tnew(2*elemNodes(e,n)-1)=1.;
% end
% end
%end
Tnew(1)=1.;
Bound(1)=1.;
% Define Time Step
dtime=0.01;
tsteps=1;
time=0.;
% penalty term
beta=0.;
% Loop through time steps
for ts=1:tsteps
eNodes=zeros(2*numNodes,1);
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=0.05*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
vel=0.;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
eNodes(2*elemNodes(e,1))=1;
eNodes(2*elemNodes(e,2))=1;
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
% if term<0
% cond=0.00;
% spec=0.001;
% else
cond=1.;
spec=1.;
% end
if enr==4
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
else
phi(2)=0.0;
phi(4)=0.0;
end
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
if enr==4
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
else
phic(2)=0.0;
phic(4)=0.0;
end
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
if enr==5;
Ke(1,2)=0.;
Me(1,2)=0.;
Ke(2,1)=0.;
Me(2,1)=0.;
Ke(1,4)=0.;
Me(1,4)=0.;
Ke(4,1)=0.;
Me(4,1)=0.;
Ke(3,2)=0.;
Me(3,2)=0.;
Ke(2,3)=0.;
Me(2,3)=0.;
Ke(4,3)=0.;
Me(4,3)=0.;
Ke(3,4)=0.;
Me(3,4)=0.;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
Ke;
Me;
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove NON-ENHANCED DOFs(Reduce Matrices)
iindex=0.;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
TR1(iindex)=Tnew(i);
BR1(iindex)=Bound(i);
pforceR1(iindex)=pforce(i);
jindex=0;
for j=1:ndof*numNodes;
check=0;
if mod(j,2)==0 && eNodes(j)~=1
check=1;
end
if check==0
jindex=jindex+1;
MR1(iindex,jindex)=M(i,j);
KR1(iindex,jindex)=K(i,j);
end
end
end
end
AR1=KR1+MR1;
SubR1=AR1*BR1';
RHSR1=MR1*TR1'-SubR1+pforceR1';
% Apply Boundary Conditions
Biindex=0.;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
RHSR2(Biindex)=RHSR1(i);
jindex=0;
for j=1:iindex;
check=0;
if BR1(j)==0.;
jindex=jindex+1;
AR2(Biindex,jindex)=AR1(i,j);
end
end
end
end
%Solve
Tnewr=(AR2^-1)*RHSR2';
% Restore Matrices
Biindex=0;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
TR1(i)=Tnewr(Biindex);
end
end
iindex=0;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
Tnew(i)=TR1(iindex);
end
end
Tnew
end
stored';

269
Unpublished/XFEM2/FESolveXT2.m Normal file
View file

@ -0,0 +1,269 @@
function [] = FESolveXT2()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=16;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=0.4;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
for n=1:2
crdn1=ndCoords(elemNodes(e,n));
if crdn1<=dpos
Tnew(2*elemNodes(e,n)-1)=1.;
end
end
end
Bound(1)=1.;
% Define Time Step
dtime=0.001;
tsteps=100;
time=0.;
% penalty term
beta=100.;
% Loop through time steps
for ts=1:tsteps
eNodes=zeros(2*numNodes,1);
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=0.5*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
eNodes(2*elemNodes(e,1))=1;
eNodes(2*elemNodes(e,2))=1;
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
% if term<0
% cond=0.00;
% spec=0.001;
% else
cond=1.;
spec=1.;
% end
if enr==4
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
else
phi(2)=0.0;
phi(4)=0.0;
end
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
if enr==4
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
else
phic(2)=0.0;
phic(4)=0.0;
end
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
if enr==5;
Ke(1,2)=0.;
Me(1,2)=0.;
Ke(2,1)=0.;
Me(2,1)=0.;
Ke(1,4)=0.;
Me(1,4)=0.;
Ke(4,1)=0.;
Me(4,1)=0.;
Ke(3,2)=0.;
Me(3,2)=0.;
Ke(2,3)=0.;
Me(2,3)=0.;
Ke(4,3)=0.;
Me(4,3)=0.;
Ke(3,4)=0.;
Me(3,4)=0.;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
Ke;
Me;
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove NON-ENHANCED DOFs(Reduce Matrices)
iindex=0.;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
TR1(iindex)=Tnew(i);
BR1(iindex)=Bound(i);
pforceR1(iindex)=pforce(i);
jindex=0;
for j=1:ndof*numNodes;
check=0;
if mod(j,2)==0 && eNodes(j)~=1
check=1;
end
if check==0
jindex=jindex+1;
MR1(iindex,jindex)=M(i,j);
KR1(iindex,jindex)=K(i,j);
end
end
end
end
AR1=KR1+MR1;
SubR1=AR1*BR1';
RHSR1=MR1*TR1'-SubR1+pforceR1';
% Apply Boundary Conditions
Biindex=0.;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
RHSR2(Biindex)=RHSR1(i);
jindex=0;
for j=1:iindex;
check=0;
if BR1(j)==0.;
jindex=jindex+1;
AR2(Biindex,jindex)=AR1(i,j);
end
end
end
end
%Solve
Tnewr=(AR2^-1)*RHSR2';
% Restore Matrices
Biindex=0;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
TR1(i)=Tnewr(Biindex);
end
end
iindex=0;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
Tnew(i)=TR1(iindex);
end
end
Tnew
end
stored'

202
Unpublished/XFEM2/Full2D/2D_XCor.for Normal file
View file

@ -0,0 +1,202 @@
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),w(8),dndg(4),dndh(4)
dimension theta(4),rjac(2,2),rjaci(2,2)
c
parameter(zero=0.d0,one=1.d0)
c material property definition
thick = 1.
rho = 1.
beta=40.
vel=0.0
dpos=0.25+vel*time(2)
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
if sign(1.,theta(1))/=sign(1.,theta(2))then
c Enriched
ienr=8
elen=abs(crdnx(2)-crdnx(1))
frac=abs(dpos-crdnx(1))/elen
rlen1=2.*frac
rlen2=2.*(1.-frac)
rmid1=-1+rlen1/2.
rmid2=1-rlen2/2.
gx(1)=rmid1-(rlen1/2.)/sqrt(3.)
gx(2)=rmid1+(rlen1/2.)/sqrt(3.)
gx(3)=rmid1+(rlen1/2.)/sqrt(3.)
gx(4)=rmid1-(rlen1/2.)/sqrt(3.)
gx(5)=rmid2-(rlen2/2.)/sqrt(3.)
gx(6)=rmid2+(rlen2/2.)/sqrt(3.)
gx(7)=rmid2+(rlen2/2.)/sqrt(3.)
gx(8)=rmid2-(rlen2/2.)/sqrt(3.)
gpos=1/sqrt(3.)
hx(1)=-gpos
hx(2)=-gpos
hx(3)=+gpos
hx(4)=+gpos
hx(5)=-gpos
hx(6)=-gpos
hx(7)=+gpos
hx(8)=+gpos
do iw=1,4
w(iw)=frac/2.;
w(iw+4)=(1.-frac)/2.;
enddo
else
c Normal Shp Funs
ienr=4
gpos=1./sqrt(3.)
gx(1)=-gpos
gx(2)=gpos
gx(3)=gpos
gx(4)=-gpos
hx(1)=-gpos
hx(2)=-gpos
hx(3)=gpos
hx(4)=gpos
do iw=1,4
w(iw)=1.
enddo
endif
c assemble amatrx and rhs
do k=1,ienr
c loop through gauss pts
g=gx(k)
h=hx(k)
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)
riLS=theta(1)*phi(1)+theta(2)*phi(3)+
1 theta(3)*phi(5)+theta(4)*phi(7)
if (riLS<0.)then
cond=0.
spec=0.01
else
cond=1.
spec=1.
endif
do iter=1,4
phi(2*iter)=phi(2*iter-1)*
1 (abs(riLS)-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.,iLS)*(phig(1)*theta(1)+phig(3)*
1 theta(2)+phig(5)*theta(3)+phig(7)*theta(4))
diLSh=sign(1.,iLS)*(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(iLS)-
1 abs(theta(iter)))+phi(2*iter-1)*diLSg
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-
1 abs(theta(iter)))+phi(2*iter-1)*diLSh
enddo
rjac=0.
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)+rjaci(1,2)*phih(iter)
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter)
enddo
dtdx=zero
dtdy=zero
t =zero
told=zero
do i=1,8
dtdx=u(i)*phix(i)+dtdx
dtdy=u(i)*phiy(i)+dtdy
t=u(i)*phi(i)+t
told=(u(i)-du(i,nrhs))*phi(i)+told
end do
dtdt=(t-told)/dtime
we=w(k)*djac
do ki=1,8
c loop over nodes
rhs(ki,nrhs) = rhs(ki,nrhs) -
1 we*(phi(ki)*rho*spec*dtdt +
2 cond*(phix(ki)*dtdx + phiy(ki)*dtdy))
do kj=1,8
amatrx(ki,kj)= amatrx(ki,kj) +
1 we*(phi(ki)*phi(kj)*rho*spec/dtime +
1 cond*(phix(ki)*phix(kj)+phiy(ki)*phiy(kj)))
end do
end do
enddo
c if interface is in the element a 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
end if
return
end

78
Unpublished/XFEM2/Full2D/AbInp.inp Normal file
View file

@ -0,0 +1,78 @@
*Heading
** Job name: Job-1 Model name: Model-1
** Generated by: Abaqus/CAE 6.12-1
*Preprint, echo=NO, model=NO, history=NO, contact=NO
**
** PARTS
**
*Part, name=Part-1
*Node
1, 0., 0., 0.
2, 1., 0., 0.
3, 1., 1., 0.
4, 0., 1., 0.
5, 1., 2., 0.
6, 0., 2., 0.
*USER ELEMENT,NODES=4,TYPE=U1,PROP=1,COORDINATES=2,VAR=2,unsymm
11,
*Element, type=U1,ELSET=UEL
1, 1, 2,3,4
2, 4, 3,5,6
*UEL Property, Elset=UEL
1.
*End Part
**
**
** ASSEMBLY
**
*Assembly, name=Assembly
**
*Instance, name=Part-1-1, part=Part-1
*End Instance
**
*Nset, nset=_PickedSet16, internal, instance=Part-1-1
1,3,5
*Nset, nset=_PickedSet17, internal, instance=Part-1-1
2,4,6
*Nset, nset=Set-6, instance=Part-1-1
1,3,5
*End Assembly
**
** MATERIALS
**
*Material, name=Material-1
*Conductivity
1.,
*Density
1.,
*Specific Heat
1.,
** ----------------------------------------------------------------
**
** Name: Predefined Field-1 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet16, 1.,0.
** Name: Predefined Field-2 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet17, 0.,0.
** STEP: Step-1
**
*Step, name=Step-1
*Heat Transfer, end=PERIOD, deltmx=100.
0.1, 1., 1e-09, 0.1,
**
** BOUNDARY CONDITIONS
**
** Name: BC-1 Type: Temperature
*Boundary
Set-6, 11, 11, 1.
**
** OUTPUT REQUESTS
**
*Restart, write, frequency=0
**
** FIELD OUTPUT: F-Output-1
**
*Output, field, variable=PRESELECT
*Output, history, frequency=0
*End Step

331
Unpublished/XFEM2/Full2D/F2DLevelSetFMM.m Normal file
View file

@ -0,0 +1,331 @@
function [] = F2DLevelSetFMM()
clear all
% Define Main Solution Mesh
NumX=32;
NumY=32;
delX=0.25;
delY=0.25;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Initial Level Set
centx=4.;
centy=4.;
rad=2.1;
for i=1:numNodes;
dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
lSet(i)=dist-rad;
end
%for i=1:numNodes;
% dist=Node(i,1)-0.1;
% lSet(i)=dist;
%end
% Plot initial level set
[X Y]=meshgrid(0:0.25:8);
Z=zeros(33);
for i=1:1089
Z(i)=lSet(i);
end
surf(X,Y,Z)
% LS Algorithm Parameters
lSet'
bandwidth=10;
% Loop through timesteps
for tstep=1:10
% Identify Narrow Band Elements
NBElems=0;
NBNodes=0;
NGlobal=zeros(numNodes);
for i=1:numElem
check=0;
for iNd=1:4
if abs(lSet(Element(i,iNd)))<=bandwidth*delX
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
for j=1:4
if NGlobal(Element(i,j))==0
NBNodes=NBNodes+1;
NGlobal(Element(i,j))=NBNodes;
NLocal(NBNodes)=Element(i,j);
end
end
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,2));
NBelem(NBElems,3)=NGlobal(Element(i,3));
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,3));
NBelem(NBElems,3)=NGlobal(Element(i,4));
end
end
% Get local Level Set
for i=1:NBNodes
lSetLocal(i)=lSet(NLocal(i));
end
% Velocity BC
F=zeros(NBNodes,1);
for i=1:NBElems
L1=sign(lSetLocal(NBelem(i,1)));
L2=sign(lSetLocal(NBelem(i,2)));
L3=sign(lSetLocal(NBelem(i,3)));
if L1 ~= L2 || L1 ~= L3
F(NBelem(i,1))= 1.;
F(NBelem(i,2))= 1.;
F(NBelem(i,3))= 1.;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(NBNodes);
for i=1:NBElems
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSetLocal(NBelem(i,1));lSetLocal(NBelem(i,2));lSetLocal(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
% Apply BCs
RHS=zeros(NBNodes,1);
Sub=A*F;
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:NBNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(NBNodes);
mMatGLS=zeros(NBNodes);
f1=zeros(NBNodes,1);
f2=zeros(NBNodes,1);
f3=zeros(NBNodes,1);
h2=0.00001;
visc=0.0005;
for i=1:NBElems
mMatL=zeros(3);
mMatGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[lSetLocal(NBelem(i,1));lSetLocal(NBelem(i,2));lSetLocal(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
mMatL=mMatL+(phi'*phi)/3.;
mMatGLSL=mMatGLSL+((delphi'*(delset/norm(delset)))*Floc*(h2/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(h2/abs(Floc))*Floc*norm(delset)/3.;
vs=h2*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+h2));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
mMat(NBelem(i,j),NBelem(i,k))=mMat(NBelem(i,j),NBelem(i,k))+mMatL(j,k);
mMatGLS(NBelem(i,j),NBelem(i,k))=mMatGLS(NBelem(i,j),NBelem(i,k))+mMatGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
dt=0.01;
lSetLocal=lSetLocal-((((mMat+mMatGLS)^-1)*dt)*(f1+f2+f3))';
newlSet=lSetLocal;
% Reinitialize LS
nstat=zeros(NBNodes,1);
for i=1:NBElems
L1=sign(lSetLocal(NBelem(i,1)));
L2=sign(lSetLocal(NBelem(i,2)));
L3=sign(lSetLocal(NBelem(i,3)));
if L1 ~= L2 || L1 ~= L3
for j=1:3
nstat(NBelem(i,j))=1;
end
end
end
maincheck=0;
while(maincheck==0)
lmin=1000.;
avlmin=1000.;
eindex=0;
nindex=0;
maincheck=1;
for i=1:NBElems
if nstat(NBelem(i,1))+nstat(NBelem(i,2))+nstat(NBelem(i,3))==2
maincheck=0;
check=0;
ltot=0.;
for j=1:3
if nstat(NBelem(i,j))==0
if abs(lSetLocal(NBelem(i,j)))<=lmin
check=1;
tempindex=j;
end
end
ltot=ltot+abs(lSetLocal(NBelem(i,j)));
end
if check==1 & ltot/3.<=avlmin
eindex=i;
nindex=tempindex;
lmin=lSetLocal(NBelem(eindex,nindex));
avlmin=ltot/3.;
end
end
end
if maincheck==0
% Find New LS for point
xp=Node(NLocal(NBelem(eindex,nindex)),1);
yp=Node(NLocal(NBelem(eindex,nindex)),2);
count=0;
for i=1:3
if i~=nindex
count=count+1;
x(count)=Node(NLocal(NBelem(eindex,i)),1);
y(count)=Node(NLocal(NBelem(eindex,i)),2);
lloc(count)=newlSet(NBelem(eindex,i));
end
end
delxa=x(1)-xp;
delya=y(1)-yp;
delxb=x(2)-xp;
delyb=y(2)-yp;
N=[delxa delya; delxb delyb];
M=N^-1;
A=(M(1)*M(1)+M(2)*M(2));
B=(M(3)*M(3)+M(4)*M(4));
C=2.*(M(1)*M(3)+M(2)*M(4));
a=A+B+C;
b=-2.*lloc(1)*A-2.*lloc(2)*B-C*(lloc(1)+lloc(2));
c=lloc(1)*lloc(1)*A+lloc(2)*lloc(2)*B+lloc(1)*lloc(2)*C-1.;
templ1=(-b+sqrt(b*b-4.*a*c))/(2.*a);
templ2=(-b-sqrt(b*b-4.*a*c))/(2.*a);
if abs(templ1)>abs(templ2)
newlSet(NBelem(eindex,nindex))=templ1;
else
newlSet(NBelem(eindex,nindex))=templ2;
end
nstat(NBelem(eindex,nindex))=1;
end
end
% lSetLocal=newlSet;
% Update Global Level Set
for i=1:NBNodes
lSet(NLocal(i))=lSetLocal(i);
end
end
lSet'
[X Y]=meshgrid(0:0.25:8);
Z=zeros(33);
for i=1:1089
Z(i)=lSet(i);
end
surf(X,Y,Z)

165
Unpublished/XFEM2/Full2D/FESolve2DS.asv Normal file
View file

@ -0,0 +1,165 @@
function [] = FESolve2DS()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=4;
NumY=1;
delX=0.25;
delY=0.25;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=1;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(2*Element(e,n)-1)=1.;
end
if crdn<0.01
Bound(2*Element(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% Loop through time steps
for ts=1:tsteps
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
end
% regular element - fix extra dofs
enr=4;
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
for iw=1:4
w(iw)=1.;
end
% Loop Through Int Points
for i=1:enr;
g=gx(i);
h=hx(i);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
cond=1.;
spec=1.;
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
phih(1)=0.25*-(1.-g);
phih(2)=0.25*-(1.+g);
phih(3)=0.25*(1.+g);
phih(4)=0.25*(1.-g);
rjac=zeros(2,2);
for iter=1:4
rjac(1,1)=rjac(1,1)+phig(iter)*crdnx(iter);
rjac(1,2)=rjac(1,2)+phig(iter)*crdny(iter);
rjac(2,1)=rjac(2,1)+phih(iter)*crdnx(iter);
rjac(2,2)=rjac(2,2)+phih(iter)*crdny(iter);
end
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 ;
for iter=1:4
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=w(i)*djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(j,i);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
A=K+M;
Sub=A*Bound;
RHS=M*Tnew-Sub+pforce;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSR(iindex)=RHS(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
AR(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(AR^-1)*RHSR';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end
stored';

151
Unpublished/XFEM2/Full2D/FESolve2DS.m Normal file
View file

@ -0,0 +1,151 @@
function [] = FESolve2DS()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=4;
NumY=1;
delX=0.25;
delY=0.25;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Section Properties
rho=1.;
% Initial temperatures
Tnew=zeros(numNodes,1);
Bound=zeros(numNodes,1);
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=0.6
Tnew(Element(e,n))=1.;
end
if crdn<0.01
Bound(Element(e,n))=1.;
end
end
end
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% Loop through time steps
for ts=1:tsteps
K=zeros(numNodes,numNodes);
M=zeros(numNodes,numNodes);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4);
Me=zeros(4);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
end
% regular element - fix extra dofs
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
for iw=1:4
w(iw)=1.;
end
% Loop Through Int Points
for i=1:4;
g=gx(i);
h=hx(i);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
cond=1.;
spec=1.;
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
phih(1)=0.25*-(1.-g);
phih(2)=0.25*-(1.+g);
phih(3)=0.25*(1.+g);
phih(4)=0.25*(1.-g);
rjac=zeros(2,2);
for iter=1:4
rjac(1,1)=rjac(1,1)+phig(iter)*crdnx(iter);
rjac(1,2)=rjac(1,2)+phig(iter)*crdny(iter);
rjac(2,1)=rjac(2,1)+phih(iter)*crdnx(iter);
rjac(2,2)=rjac(2,2)+phih(iter)*crdny(iter);
end
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 ;
for iter=1:4
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=w(i)*djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Assemble Global Matrices
gnum(1)=Element(e,1);
gnum(2)=Element(e,2);
gnum(3)=Element(e,3);
gnum(4)=Element(e,4);
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(j,i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(j,i);
end
end
end
%Remove inactive DOFs(Reduce Matrices)
A=K+M;
Sub=A*Bound;
RHS=M*Tnew-Sub;
iindex=0;
for i=1:numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSR(iindex)=RHS(i);
jindex=0;
for j=1:numNodes;
if Bound(j)==0.;
jindex=jindex+1;
AR(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(AR^-1)*RHSR';
iindex=0;
for i=1:numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end

411
Unpublished/XFEM2/Full2D/FESolveX2D.asv Normal file
View file

@ -0,0 +1,411 @@
function [] = FESolveX2D()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=4;
NumY=1;
delX=0.25;
delY=0.25;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(2*Element(e,n)-1)=1.;
end
if crdn<0.01
Bound(2*Element(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% penalty term
Penalty=00.;
% Loop through time steps
for ts=1:tsteps
eNodes=zeros(2*numNodes,1);
% Get interface velocity
d(1)=dpos+delX;
d(2)=dpos+3*delX/4;
d(3)=dpos+delX/4;
d(4)=dpos;
for e=1:numElem
crdn1=Node(Element(e,1),1);
crdn2=Node(Element(e,2),1);
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(Element(e,1)*2-1);
tmp1b=Tnew(Element(e,1)*2);
tmp2a=Tnew(Element(e,2)*2-1);
tmp2b=Tnew(Element(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
% vel=-0.1*(0.5/delX)*(2*t(1)+t(2)-t(3)-2*t(4))
vel=0.0;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=abs(crdnx(icrd)-dpos)*sign(crdnx(icrd)-dpos);
end
if sign(theta(1))~=sign(theta(2))
% possible enriched element
npart=10;
enr=npart*npart;
for sdx=1:npart
for sdy=1:npart
midx=-1.-1./npart+(2./npart)*sdx;
midy=-1.-1./npart+(2./npart)*sdy;
subindex=npart*(sdy-1)+sdx;
gpos=1./(sqrt(3.)*npart);
gx(subindex,1)=midx-gpos;
gx(subindex,2)=midx+gpos;
gx(subindex,3)=midx+gpos;
gx(subindex,4)=midx-gpos;
hx(subindex,1)=midy-gpos;
hx(subindex,2)=midy-gpos;
hx(subindex,3)=midy+gpos;
hx(subindex,4)=midy+gpos;
end
end
% check if int points are on different sides of front
check=0;
for i=1:enr
for 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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
if i==1 && j==1
sgn=sign(iLS);
else
if sign(iLS)~=sgn
check=1;
end
end
end
end
if check==0
% regular element - fix extra dofs
enr=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;
end
eNodes(2*Element(e,1))=1;
eNodes(2*Element(e,2))=1;
eNodes(2*Element(e,3))=1;
eNodes(2*Element(e,4))=1;
% enriched element
enr=8;
% get interface position on element
elen=abs(crdnx(2)-crdnx(1));
frac=abs(dpos-crdnx(1))/elen;
len1=2.*frac;
len2=2.*(1.-frac);
% devide element for sub integration
mid1=-1+len1/2.;
mid2=1-len2/2.;
gx(1)=mid1-(len1/2.)/sqrt(3.);
gx(2)=mid1+(len1/2.)/sqrt(3.);
gx(3)=mid1+(len1/2.)/sqrt(3.);
gx(4)=mid1-(len1/2.)/sqrt(3.);
gx(5)=mid2-(len2/2.)/sqrt(3.);
gx(6)=mid2+(len2/2.)/sqrt(3.);
gx(7)=mid2+(len2/2.)/sqrt(3.);
gx(8)=mid2-(len2/2.)/sqrt(3.);
gpos=1/sqrt(3.);
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=+gpos;
hx(4)=+gpos;
hx(5)=-gpos;
hx(6)=-gpos;
hx(7)=+gpos;
hx(8)=+gpos;
for iw=1:4
w(iw)=frac/2.;
w(iw+4)=(1.-frac)/2.;
end
else
% regular element - fix extra dofs
enr=4;
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
for iw=1:4
w(iw)=1.;
end
end
% Loop Through Int Points
for i=1:enr;
g=gx(i);
h=hx(i);
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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
cond=1.;
spec=1.;
for iter=1:4
if enr==8
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
else
phi(2*iter)=0.;
end
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
if enr==8
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
else
phig(2*iter)=0.;
phih(2*iter)=0.;
end
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=w(i)*djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==8;
count=0;
if sign(theta(1))~=sign(theta(2))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(2)));
xi(count)=f*(crdnx(2)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(2)-crdny(1))+crdny(1);
gi(count)=(2.*xi(count)-(crdnx(1)+crdnx(2)))/(-crdnx(1)+crdnx(2));
hi(count)=-1.;
end
if sign(theta(2))~=sign(theta(3))
count=count+1;
f=abs(theta(2))/(abs(theta(2))+abs(theta(3)));
xi(count)=f*(crdnx(3)-crdnx(2))+crdnx(2);
yi(count)=f*(crdny(3)-crdny(2))+crdny(2);
gi(count)=1.;
hi(count)=(2.*yi(count)-(crdny(2)+crdny(3)))/(-crdny(2)+crdny(3));
end
if sign(theta(3))~=sign(theta(4))
count=count+1;
f=abs(theta(3))/(abs(theta(3))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(3))+crdnx(3);
yi(count)=f*(crdny(4)-crdny(3))+crdny(3);
gi(count)=(2.*xi(count)-(crdnx(4)+crdnx(3)))/(-crdnx(4)+crdnx(3));
hi(count)=1.;
end
if sign(theta(1))~=sign(theta(4))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(4)-crdny(1))+crdny(1);
gi(count)=-1.;
hi(count)=(2.*yi(count)-(crdny(1)+crdny(4)))/(-crdny(4)+crdny(1));
end
c=zeros(2,1);
c=(c+1.);
for i=1:2;
G(i,1)=0.25*(1.-gi(i))*(1.-hi(i));
G(i,3)=0.25*(1.+gi(i))*(1.-hi(i));
G(i,5)=0.25*(1.+gi(i))*(1.+hi(i));
G(i,7)=0.25*(1.-gi(i))*(1.+hi(i));
G(i,2)=-G(i,1)*abs(theta(1));
G(i,4)=-G(i,3)*abs(theta(2));
G(i,6)=-G(i,5)*abs(theta(3));
G(i,8)=-G(i,7)*abs(theta(4));
end
pen=Penalty*(G'*G);
pfL=Penalty*G'*c;
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i))=K(gnum(j)+1,gnum(i))+Ke(2*j,2*i-1);
K(gnum(j),gnum(i)+1)=K(gnum(j),gnum(i)+1)+Ke(2*j-1,2*i);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i))=M(gnum(j)+1,gnum(i))+Me(2*j,2*i-1);
M(gnum(j),gnum(i)+1)=M(gnum(j),gnum(i)+1)+Me(2*j-1,2*i);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove NON-ENHANCED DOFs(Reduce Matrices)
iindex=0.;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
TR1(iindex)=Tnew(i);
BR1(iindex)=Bound(i);
pforceR1(iindex)=pforce(i);
jindex=0;
for j=1:ndof*numNodes;
check=0;
if mod(j,2)==0 && eNodes(j)~=1
check=1;
end
if check==0
jindex=jindex+1;
MR1(iindex,jindex)=M(i,j);
KR1(iindex,jindex)=K(i,j);
end
end
end
end
AR1=KR1+MR1;
SubR1=AR1*BR1';
RHSR1=MR1*TR1'-SubR1+pforceR1';
% Apply Boundary Conditions
Biindex=0.;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
RHSR2(Biindex)=RHSR1(i);
jindex=0;
for j=1:iindex;
check=0;
if BR1(j)==0.;
jindex=jindex+1;
AR2(Biindex,jindex)=AR1(i,j);
end
end
end
end
%Solve
Tnewr=(AR2^-1)*RHSR2';
% Restore Matrices
Biindex=0;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
TR1(i)=Tnewr(Biindex);
end
end
iindex=0;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
Tnew(i)=TR1(iindex);
end
end
Tnew
end
stored';

364
Unpublished/XFEM2/Full2D/FESolveX2D.m Normal file
View file

@ -0,0 +1,364 @@
function [] = FESolveX2D()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=4;
NumY=1;
delX=0.25;
delY=0.25;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(2*Element(e,n)-1)=1.;
end
if crdn<0.01
Bound(2*Element(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% penalty term
Penalty=50.;
% Loop through time steps
for ts=1:tsteps
eNodes=zeros(2*numNodes,1);
% Get interface velocity
d(1)=dpos+delX;
d(2)=dpos+3*delX/4;
d(3)=dpos+delX/4;
d(4)=dpos;
for e=1:numElem
crdn1=Node(Element(e,1),1);
crdn2=Node(Element(e,2),1);
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(Element(e,1)*2-1);
tmp1b=Tnew(Element(e,1)*2);
tmp2a=Tnew(Element(e,2)*2-1);
tmp2b=Tnew(Element(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
% vel=-0.1*(0.5/delX)*(2*t(1)+t(2)-t(3)-2*t(4))
vel=0.0;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=abs(crdnx(icrd)-dpos)*sign(crdnx(icrd)-dpos);
end
if sign(theta(1))~=sign(theta(2))
% possible enriched element
npart=10;
enr=npart*npart;
for sdx=1:npart
for sdy=1:npart
midx=-1.-1./npart+(2./npart)*sdx;
midy=-1.-1./npart+(2./npart)*sdy;
subindex=npart*(sdy-1)+sdx;
gpos=1./(sqrt(3.)*npart);
gx(subindex,1)=midx-gpos;
gx(subindex,2)=midx+gpos;
gx(subindex,3)=midx+gpos;
gx(subindex,4)=midx-gpos;
hx(subindex,1)=midy-gpos;
hx(subindex,2)=midy-gpos;
hx(subindex,3)=midy+gpos;
hx(subindex,4)=midy+gpos;
end
end
% check if int points are on different sides of front
check=0;
for i=1:enr
for 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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
if i==1 && j==1
sgn=sign(iLS);
else
if sign(iLS)~=sgn
check=1;
end
end
end
end
if check==0
% regular element - fix extra dofs
enr=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;
end
else
% regular element - fix extra dofs
enr=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;
end
% Loop Through Int Points
for i=1:enr
for 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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
cond=1.;
spec=1.;
for iter=1:4
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=djac;
Ke=Ke+(we*cond*(phix'*phix+phiy'*phiy))/double(enr);
Me=Me+((we*rho*spec*phi'*phi)/dtime)/double(enr);
end
end
% Add penalty term and get temp gradient on interface
if enr>1;
count=0;
if sign(theta(1))~=sign(theta(2))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(2)));
xi(count)=f*(crdnx(2)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(2)-crdny(1))+crdny(1);
gi(count)=(2.*xi(count)-(crdnx(1)+crdnx(2)))/(-crdnx(1)+crdnx(2));
hi(count)=-1.;
end
if sign(theta(2))~=sign(theta(3))
count=count+1;
f=abs(theta(2))/(abs(theta(2))+abs(theta(3)));
xi(count)=f*(crdnx(3)-crdnx(2))+crdnx(2);
yi(count)=f*(crdny(3)-crdny(2))+crdny(2);
gi(count)=1.;
hi(count)=(2.*yi(count)-(crdny(2)+crdny(3)))/(-crdny(2)+crdny(3));
end
if sign(theta(3))~=sign(theta(4))
count=count+1;
f=abs(theta(3))/(abs(theta(3))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(3))+crdnx(3);
yi(count)=f*(crdny(4)-crdny(3))+crdny(3);
gi(count)=(2.*xi(count)-(crdnx(4)+crdnx(3)))/(-crdnx(4)+crdnx(3));
hi(count)=1.;
end
if sign(theta(1))~=sign(theta(4))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(4)-crdny(1))+crdny(1);
gi(count)=-1.;
hi(count)=(2.*yi(count)-(crdny(1)+crdny(4)))/(-crdny(4)+crdny(1));
end
c=zeros(2,1);
c=(c+1.);
for i=1:2;
G(i,1)=0.25*(1.-gi(i))*(1.-hi(i));
G(i,3)=0.25*(1.+gi(i))*(1.-hi(i));
G(i,5)=0.25*(1.+gi(i))*(1.+hi(i));
G(i,7)=0.25*(1.-gi(i))*(1.+hi(i));
G(i,2)=-G(i,1)*abs(theta(1));
G(i,4)=-G(i,3)*abs(theta(2));
G(i,6)=-G(i,5)*abs(theta(3));
G(i,8)=-G(i,7)*abs(theta(4));
end
pen=Penalty*(G'*G);
pfL=Penalty*G'*c;
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i))=K(gnum(j)+1,gnum(i))+Ke(2*j,2*i-1);
K(gnum(j),gnum(i)+1)=K(gnum(j),gnum(i)+1)+Ke(2*j-1,2*i);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i))=M(gnum(j)+1,gnum(i))+Me(2*j,2*i-1);
M(gnum(j),gnum(i)+1)=M(gnum(j),gnum(i)+1)+Me(2*j-1,2*i);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove NON-ENHANCED DOFs(Reduce Matrices)
iindex=0.;
for i=1:ndof*numNodes;
check=0;
% if mod(i,2)==0 && eNodes(i)~=1
% check=1;
% end
if check==0
iindex=iindex+1;
TR1(iindex)=Tnew(i);
BR1(iindex)=Bound(i);
pforceR1(iindex)=pforce(i);
jindex=0;
for j=1:ndof*numNodes;
check=0;
% if mod(j,2)==0 && eNodes(j)~=1
% check=1;
% end
if check==0
jindex=jindex+1;
MR1(iindex,jindex)=M(i,j);
KR1(iindex,jindex)=K(i,j);
end
end
end
end
AR1=KR1+MR1;
SubR1=AR1*BR1';
RHSR1=MR1*TR1'-SubR1+pforceR1';
% Apply Boundary Conditions
Biindex=0.;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
RHSR2(Biindex)=RHSR1(i);
jindex=0;
for j=1:iindex;
check=0;
if BR1(j)==0.;
jindex=jindex+1;
AR2(Biindex,jindex)=AR1(i,j);
end
end
end
end
%Solve
Tnewr=(AR2^-1)*RHSR2';
% Restore Matrices
Biindex=0;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
TR1(i)=Tnewr(Biindex);
end
end
iindex=0;
for i=1:ndof*numNodes;
check=0;
% if mod(i,2)==0 && eNodes(i)~=1
% check=1;
% end
if check==0
iindex=iindex+1;
Tnew(i)=TR1(iindex);
end
end
Tnew
end
stored';

269
Unpublished/XFEM2/Full2D/FESolveX2DLS.m Normal file
View file

@ -0,0 +1,269 @@
function [] = FESolveX2DLS()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=3;
NumY=1;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.1;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(2*Element(e,n)-1)=1.;
Bound(2*Element(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.1;
tsteps=20;
time=0.;
% penalty term
beta=80.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+delX;
d(2)=dpos+3*delX/4;
d(3)=dpos+delX/4;
d(4)=dpos;
for e=1:numElem
crdn1=Node(Element(e,1),1);
crdn2=Node(Element(e,2),1);
for j=1:4
if d(j)>=crdn1 & d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(Element(e,1)*2-1);
tmp1b=Tnew(Element(e,1)*2);
tmp2a=Tnew(Element(e,2)*2-1);
tmp2b=Tnew(Element(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
% vel=-0.1*(0.5/delX)*(2*t(1)+t(2)-t(3)-2*t(4))
vel=0.0;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=abs(crdnx(icrd)-dpos)*sign(crdnx(icrd)-dpos);
end
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=8;
% get interface position on element
elen=abs(crdnx(2)-crdnx(1));
frac=abs(dpos-crdnx(1))/elen;
len1=2.*frac;
len2=2.*(1.-frac);
% devide element for sub integration
mid1=-1+len1/2.;
mid2=1-len2/2.;
gx(1)=mid1-(len1/2.)/sqrt(3.);
gx(2)=mid1+(len1/2.)/sqrt(3.);
gx(3)=mid1+(len1/2.)/sqrt(3.);
gx(4)=mid1-(len1/2.)/sqrt(3.);
gx(5)=mid2-(len2/2.)/sqrt(3.);
gx(6)=mid2+(len2/2.)/sqrt(3.);
gx(7)=mid2+(len2/2.)/sqrt(3.);
gx(8)=mid2-(len2/2.)/sqrt(3.);
gpos=1/sqrt(3.);
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=+gpos;
hx(4)=+gpos;
hx(5)=-gpos;
hx(6)=-gpos;
hx(7)=+gpos;
hx(8)=+gpos;
for iw=1:4
w(iw)=frac/2.;
w(iw+4)=(1.-frac)/2.;
end
else
% regular element - fix extra dofs
enr=4;
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
for iw=1:4
w(iw)=1.;
end
end
% Loop Through Int Points
for i=1:enr;
g=gx(i);
h=hx(i);
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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
if iLS<0.
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
for iter=1:4
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=w(i)*djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==8;
xi=2.*frac-1;
yi=0.;
gm(1)=0.25*(1.-xi)*(1.-yi);
gm(3)=0.25*(1.+xi)*(1.-yi);
gm(5)=0.25*(1.+xi)*(1.+yi);
gm(7)=0.25*(1.-xi)*(1.+yi);
gm(2)=gm(1)*(-abs(theta(1)));
gm(4)=gm(3)*(-abs(theta(2)));
gm(6)=gm(5)*(-abs(theta(3)));
gm(8)=gm(7)*(-abs(theta(4)));
pen=beta*(gm'*gm);
pfL=beta*1.*gm';
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=M*Tnew;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i)+pforce(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
StiffI=Ared^-1;
Tnewr=(Ared^-1)*RHSred';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end
stored'

305
Unpublished/XFEM2/Full2D/FESolveX2Db.asv Normal file
View file

@ -0,0 +1,305 @@
function [] = FESolveX2Db()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=2;
NumY=1;
delX=0.25;
delY=0.25;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.4;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
stored(1)=dpos;
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(2*Element(e,n)-1)=1.;
end
if crdn<0.01
Bound(2*Element(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.01;
tsteps=1;
time=0.;
% penalty term
Penalty=00.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+delX;
d(2)=dpos+3*delX/4;
d(3)=dpos+delX/4;
d(4)=dpos;
for e=1:numElem
crdn1=Node(Element(e,1),1);
crdn2=Node(Element(e,2),1);
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(Element(e,1)*2-1);
tmp1b=Tnew(Element(e,1)*2);
tmp2a=Tnew(Element(e,2)*2-1);
tmp2b=Tnew(Element(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
% vel=-0.1*(0.5/delX)*(2*t(1)+t(2)-t(3)-2*t(4))
vel=0.0;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=abs(crdnx(icrd)-dpos)*sign(crdnx(icrd)-dpos);
end
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=8;
% get interface position on element
elen=abs(crdnx(2)-crdnx(1));
frac=abs(dpos-crdnx(1))/elen;
len1=2.*frac;
len2=2.*(1.-frac);
% devide element for sub integration
mid1=-1+len1/2.;
mid2=1-len2/2.;
gx(1)=mid1-(len1/2.)/sqrt(3.);
gx(2)=mid1+(len1/2.)/sqrt(3.);
gx(3)=mid1+(len1/2.)/sqrt(3.);
gx(4)=mid1-(len1/2.)/sqrt(3.);
gx(5)=mid2-(len2/2.)/sqrt(3.);
gx(6)=mid2+(len2/2.)/sqrt(3.);
gx(7)=mid2+(len2/2.)/sqrt(3.);
gx(8)=mid2-(len2/2.)/sqrt(3.);
gpos=1/sqrt(3.);
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=+gpos;
hx(4)=+gpos;
hx(5)=-gpos;
hx(6)=-gpos;
hx(7)=+gpos;
hx(8)=+gpos;
for iw=1:4
w(iw)=frac/2.;
w(iw+4)=(1.-frac)/2.;
end
else
% regular element - fix extra dofs
enr=4;
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
for iw=1:4
w(iw)=1.;
end
end
% Loop Through Int Points
for i=1:enr;
g=gx(i);
h=hx(i);
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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
cond=1.;
spec=1.;
for iter=1:4
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=w(i)*djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
Me
% Add penalty term and get temp gradient on interface
if enr==8;
count=0;
if sign(theta(1))~=sign(theta(2))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(2)));
xi(count)=f*(crdnx(2)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(2)-crdny(1))+crdny(1);
gi(count)=(2.*xi(count)-(crdnx(1)+crdnx(2)))/(-crdnx(1)+crdnx(2));
hi(count)=-1.;
end
if sign(theta(2))~=sign(theta(3))
count=count+1;
f=abs(theta(2))/(abs(theta(2))+abs(theta(3)));
xi(count)=f*(crdnx(3)-crdnx(2))+crdnx(2);
yi(count)=f*(crdny(3)-crdny(2))+crdny(2);
gi(count)=1.;
hi(count)=(2.*yi(count)-(crdny(2)+crdny(3)))/(-crdny(2)+crdny(3));
end
if sign(theta(3))~=sign(theta(4))
count=count+1;
f=abs(theta(3))/(abs(theta(3))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(3))+crdnx(3);
yi(count)=f*(crdny(4)-crdny(3))+crdny(3);
gi(count)=(2.*xi(count)-(crdnx(4)+crdnx(3)))/(-crdnx(4)+crdnx(3));
hi(count)=1.;
end
if sign(theta(1))~=sign(theta(4))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(4)-crdny(1))+crdny(1);
gi(count)=-1.;
hi(count)=(2.*yi(count)-(crdny(1)+crdny(4)))/(-crdny(4)+crdny(1));
end
c=zeros(2,1);
c=(c+1.);
for i=1:2;
G(i,1)=0.25*(1.-gi(i))*(1.-hi(i));
G(i,3)=0.25*(1.+gi(i))*(1.-hi(i));
G(i,5)=0.25*(1.+gi(i))*(1.+hi(i));
G(i,7)=0.25*(1.-gi(i))*(1.+hi(i));
G(i,2)=-G(i,1)*abs(theta(1));
G(i,4)=-G(i,3)*abs(theta(2));
G(i,6)=-G(i,5)*abs(theta(3));
G(i,8)=-G(i,7)*abs(theta(4));
end
pen=Penalty*(G'*G);
pfL=Penalty*G'*c;
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i))=M(gnum(j)+1,gnum(i))+Me(2*j,2*i-1);
M(gnum(j),gnum(i)+1)=M(gnum(j),gnum(i)+1)+Me(2*j-1,2*i);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
M
A=K+M;
Sub=A*Bound;
M*Tnew;
RHS=M*Tnew-Sub+pforce;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSR(iindex)=RHS(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
AR(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(AR^-1)*RHSR';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end
stored';

271
Unpublished/XFEM2/Full2D/FESolveX2Db.m Normal file
View file

@ -0,0 +1,271 @@
function [] = FESolveX2Db()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=4;
NumY=1;
delX=0.25;
delY=0.25;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% dofs per node
ndof=2;
% Define Section Properties
rho=1.;
% initial interface position
dpos=0.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(2*Element(e,n)-1)=1.;
end
if crdn<0.01
Bound(2*Element(e,n)-1)=1.;
end
end
end
% Define Time Step
dtime=0.01;
tsteps=1;
time=0.;
% penalty term
Penalty=00.;
% Loop through time steps
for ts=1:tsteps
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4*ndof);
Me=zeros(4*ndof);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=abs(crdnx(icrd)-dpos)*sign(crdnx(icrd)-dpos);
end
% if sign(theta(1))~=sign(theta(2))
if 1==2
% enriched element
enr=8;
% get interface position on element
elen=abs(crdnx(2)-crdnx(1));
frac=abs(dpos-crdnx(1))/elen;
len1=2.*frac;
len2=2.*(1.-frac);
% devide element for sub integration
mid1=-1+len1/2.;
mid2=1-len2/2.;
gx(1)=mid1-(len1/2.)/sqrt(3.);
gx(2)=mid1+(len1/2.)/sqrt(3.);
gx(3)=mid1+(len1/2.)/sqrt(3.);
gx(4)=mid1-(len1/2.)/sqrt(3.);
gx(5)=mid2-(len2/2.)/sqrt(3.);
gx(6)=mid2+(len2/2.)/sqrt(3.);
gx(7)=mid2+(len2/2.)/sqrt(3.);
gx(8)=mid2-(len2/2.)/sqrt(3.);
gpos=1/sqrt(3.);
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=+gpos;
hx(4)=+gpos;
hx(5)=-gpos;
hx(6)=-gpos;
hx(7)=+gpos;
hx(8)=+gpos;
for iw=1:4
w(iw)=frac/2.;
w(iw+4)=(1.-frac)/2.;
end
else
% regular element - fix extra dofs
enr=4;
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
for iw=1:4
w(iw)=1.;
end
end
% Loop Through Int Points
for i=1:enr;
g=gx(i);
h=hx(i);
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);
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
cond=1.;
spec=1.;
for iter=1:4
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=w(i)*djac;
B=[phix;phiy];
% Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Ke=Ke+we*cond*(B'*B);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==8;
count=0;
if sign(theta(1))~=sign(theta(2))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(2)));
xi(count)=f*(crdnx(2)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(2)-crdny(1))+crdny(1);
gi(count)=(2.*xi(count)-(crdnx(1)+crdnx(2)))/(-crdnx(1)+crdnx(2));
hi(count)=-1.;
end
if sign(theta(2))~=sign(theta(3))
count=count+1;
f=abs(theta(2))/(abs(theta(2))+abs(theta(3)));
xi(count)=f*(crdnx(3)-crdnx(2))+crdnx(2);
yi(count)=f*(crdny(3)-crdny(2))+crdny(2);
gi(count)=1.;
hi(count)=(2.*yi(count)-(crdny(2)+crdny(3)))/(-crdny(2)+crdny(3));
end
if sign(theta(3))~=sign(theta(4))
count=count+1;
f=abs(theta(3))/(abs(theta(3))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(3))+crdnx(3);
yi(count)=f*(crdny(4)-crdny(3))+crdny(3);
gi(count)=(2.*xi(count)-(crdnx(4)+crdnx(3)))/(-crdnx(4)+crdnx(3));
hi(count)=1.;
end
if sign(theta(1))~=sign(theta(4))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(4)-crdny(1))+crdny(1);
gi(count)=-1.;
hi(count)=(2.*yi(count)-(crdny(1)+crdny(4)))/(-crdny(4)+crdny(1));
end
c=zeros(2,1);
c=(c+1.);
for i=1:2;
G(i,1)=0.25*(1.-gi(i))*(1.-hi(i));
G(i,3)=0.25*(1.+gi(i))*(1.-hi(i));
G(i,5)=0.25*(1.+gi(i))*(1.+hi(i));
G(i,7)=0.25*(1.-gi(i))*(1.+hi(i));
G(i,2)=-G(i,1)*abs(theta(1));
G(i,4)=-G(i,3)*abs(theta(2));
G(i,6)=-G(i,5)*abs(theta(3));
G(i,8)=-G(i,7)*abs(theta(4));
end
pen=Penalty*(G'*G);
pfL=Penalty*G'*c;
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i))=K(gnum(j)+1,gnum(i))+Ke(2*j,2*i-1);
K(gnum(j),gnum(i)+1)=K(gnum(j),gnum(i)+1)+Ke(2*j-1,2*i);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i))=M(gnum(j)+1,gnum(i))+Me(2*j,2*i-1);
M(gnum(j),gnum(i)+1)=M(gnum(j),gnum(i)+1)+Me(2*j-1,2*i);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
A=K+M;
Sub=A*Bound;
RHS=M*Tnew-Sub+pforce;
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSR(iindex)=RHS(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
AR(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(AR^-1)*RHSR';
iindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end

404
Unpublished/XFEM2/Full2D/LevelSet.f90 Normal file
View file

@ -0,0 +1,404 @@
! This Subroutine Implements the Level Set Method
! J. Grogan - 07/10/13
subroutine uexternaldb(lop,lrestart,time,dtime,kstep,kinc)
include 'aba_param.inc'
dimension time(2)
integer Element (100,4)
real Node(100,2),LSet(100)
!
if(lop==0)then
! Get Mesh Data
call getMesh(Element,Node,numElem,numNodes)
! Get Initial Level Set
call initialLSet(LSet,Node,numNodes)
elseif(lop==1)then
! Update Level Set
call updateLSet(Node,numNodes,Element,numElem,dtime,LSet)
endif
return
end
! This subroutine returns the finite element mesh connectivity data
subroutine getMesh(Element,Node,numElem,numNodes)
include 'aba_param.inc'
integer Element (100,4)
real Node(100,2)
character(256) outdir,jobname,input
call getoutdir(outdir,lenoutdir)
call getjobname(jobname,lenjobname)
filename=trim(outdir)//trim(jobname)//'.inp'
open(unit=107,file=filename,status='old')
read(107,*)input
do while (index(input,'*Node')==0)
read(107,*)input
enddo
ierr=0
numNodes=0
do while (ierr==0)
read(107,*)nodeNum,xcor,ycor,zcor
if(ierr==0)then
Node(nodeNum,1)=xcor
Node(nodeNum,2)=ycor
numNodes=numNodes+1
endif
enddo
do while (index(input,'*Element')==0)
read(107,*)input
enddo
numElem=0
do while (ierr==0)
read(107,*)elNum,n1,n2,n3,n4
if(ierr==0)then
Element(elNum,1)=n1
Element(elNum,2)=n2
Element(elNum,3)=n3
Element(elNum,4)=n4
numElem=numElem+1
endif
enddo
close(107)
end subroutine
! This subroutine calculates the initial Level Set
subroutine initialLSet(LSet,Node,numNodes)
include 'aba_param.inc'
real Node(100,2),LSet(100)
!centx=4.
!centy=4.
!rad=2.1
!do i=1,numNodes
! dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy))
! LSet(i)=dist-rad
!enddo
do i=1,numNodes
dist=Node(i,1)-0.1
LSet(i)=dist
enddo
end subroutine
! This subroutine updates the Level Set
subroutine updateLSet(Node,numNodes,Element,numElem,dtime,LSet)
include 'aba_param.inc'
integer Element(100,4),NBelem(100,4)
real Node(100,2),NGlobal(100,2),NLocal(100,2)
real LSet(100),LSetLocal(100),F(100),Fred(100)
real A(100,100),Ared(100,100),RHS(100),RHSred(100)
real M(100,100),MGL(100,100),f1(100),f2(100),f3(100)
! parameters
bandWidth=10.
av_Length=1.
h2=0.00001*av_Length
visc=0.0005
dt=0.01
! explicit update of Level Set
do istep=1:floor(dtime/dt)
! Identify Narrow Band Elements and Get Local Level Set
call getNarrowBand(NBelem,NBElems,NGlobal,NLocal,NBNodes,LSetLocal, &
& bandWidth,LSet,Element,numElem,numNodes)
! Identify Scalar Velocity on Nodes Crossed By Interface - F
call getF(F,LSetLocal,NBElems,NBNodes,NBelem)
! Get 'Stiffness' Matrix - A
call getA(A,Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal)
! Apply BCs
RHS=-matmul(A,F)
iindex=0
do i=1,NBNodes
if (F(i)==0.)then
iindex=iindex+1
RHSred(iindex)=RHS(i)
jindex=0
do j=1,NBNodes
if (F(j)==0.)then
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j)
endif
enddo
endif
enddo
! Solve for Fred
Fred=(Ared^-1)*RHSred'
! Get F
iindex=0
do i=1,NBNodes
if (F(i)==0.)then
iindex=iindex+1
F(i)=Fred(iindex)
endif
enddo
! Get Level Set Equation Terms
call getTerms(M,MGLS,f1,f2,f3,Node,NLocal,NBelem,NBNodes,NBElems,&
& LSetLocal,visc,h2,F)
LSetLocal=LSetLocal-((((M+MGLS)^-1)*dt)*(f1+f2+f3))'
! Reinitialize LS
!call fastMarch(LSetLocal,NBelem,Node,NLocal,NBNodes)
do i=1,NBNodes
LSet(NLocal(i))=LSetLocal(i)
end
enddo
end subroutine
! This subroutine identifies elements in the narrow band
subroutine getNarrowBand(NBelem,NBElems,NGlobal,NLocal,NBNodes,LSetLocal,&
& bandWidth,LSet,Element,numElem,numNodes)
include 'aba_param.inc'
integer Element(100,4),NBelem(100,4)
real Node(100,2),NGlobal(100,2),NLocal(100,2)
real LSet(100),LSetLocal(100)
! Identify Narrow Band Elements
NBElems=0
NBNodes=0
NGlobal=0.
do i=1,numElem
check=0
do iNd=1,4
if (abs(LSet(Element(i,iNd)))<=bandWidth*(delX+delY)/2.)then
check=1
endif
enddo
! If an element is in the narrow band split it into triangles
if (check==1)then
for j=1,4
if (NGlobal(Element(i,j))==0)then
NBNodes=NBNodes+1
NGlobal(Element(i,j))=NBNodes
NLocal(NBNodes)=Element(i,j)
endif
endddo
NBElems=NBElems+1
NBelem(NBElems,1)=NGlobal(Element(i,1))
NBelem(NBElems,2)=NGlobal(Element(i,2))
NBelem(NBElems,3)=NGlobal(Element(i,3))
NBElems=NBElems+1
NBelem(NBElems,1)=NGlobal(Element(i,1))
NBelem(NBElems,2)=NGlobal(Element(i,3))
NBelem(NBElems,3)=NGlobal(Element(i,4))
endif
enddo
! Get local Level Set
do i=1,NBNodes
LSetLocal(i)=LSet(NLocal(i))
enddo
end subroutine
! This subroutine extends the interface velocity throughout the computational domain
subroutine getF(F,LSetLocal,NBElems,NBNodes,NBelem)
include 'aba_param.inc'
real LSetLocal(100),F(100),L(3)
F=0.
do i=1,NBElems
do j=1,3
L(j)=sign(1.,LSetLocal(NBelem(i,j)))
enddo
if (L(1) /= L(2) .or. L(1) /= L(3))then
do j=1,3
F(NBelem(i,j))= 1.
enddo
endif
enddo
end subroutine
! This subroutine gets the 'stiffness' matrix - A
subroutine getA(A,Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal)
include 'aba_param.inc'
integer NBelem(100,4)
real Node(100,2),NLocal(100,2)
real LSetLocal(100),A(100,100),AfL(3,3),AfLGLS(3,3)
real gx(3),hx(3),phi(3),phig(3),phih(3),phix(3),phiy(3)
A=0.
do i=1,NBElems
gx(1)=2./3.
gx(2)=1./6.
gx(3)=1./6.
hx(1)=1./6.
hx(2)=1./6.
hx(3)=2./3.
AfL=0.
AfLGLS=0.
x1=Node(NLocal(NBelem(i,1)),1)
y1=Node(NLocal(NBelem(i,1)),2)
x2=Node(NLocal(NBelem(i,2)),1)
y2=Node(NLocal(NBelem(i,2)),2)
x3=Node(NLocal(NBelem(i,3)),1)
y3=Node(NLocal(NBelem(i,3)),2)
do j=1,3
g=gx(j)
h=hx(j)
phi(1)=1.-g-h
phi(2)=g
phi(3)=h
phig(1)=-1.
phig(2)=1.
phig(3)=0.
phih(1)=-1.
phih(2)=0.
phih(3)=1.
djac=2.*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2))
do k=1,3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k))
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k))
enddo
delphi=[phix;phiy]
nodalLset=[LSetLocal(NBelem(i,1));LSetLocal(NBelem(i,2));LSetLocal(NBelem(i,3))]
set=phi*nodalLset
delset=delphi*nodalLset
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.
enddo
do k=1,3
do j=1,3
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+AfL(j,k)+AfLGLS(j,k)
enddo
enddo
enddo
end subroutine
! This subroutine gets the neccessary terms for the level set equation
subroutine getTerms(M,MGLS,f1,f2,f3,Node,NLocal,NBelem,NBNodes,NBElems,&
& LSetLocal,visc,h2,F)
include 'aba_param.inc'
integer NBelem(100,4)
real Node(100,2),NLocal(100,2),LSetLocal(100)
real M(100,100),MGLS(100,100),f1(100),f2(100),f3(100)
real ML(3,3),MGLSL(3,3),f1L(3),f2L(3),f3L(3)
real gx(3),hx(3),phi(3),phig(3),phih(3),phix(3),phiy(3)
M=0.
MGLS=0.
f1=0.
f2=0.
f3=0.
do i=1,NBElems
ML=0.
MGLSL=0.
f1L=0.
f2L=0.
f3L=0.
gx(1)=2./3.
gx(2)=1./6.
gx(3)=1./6.
hx(1)=1./6.
hx(2)=1./6.
hx(3)=2./3.
x1=Node(NLocal(NBelem(i,1)),1)
y1=Node(NLocal(NBelem(i,1)),2)
x2=Node(NLocal(NBelem(i,2)),1)
y2=Node(NLocal(NBelem(i,2)),2)
x3=Node(NLocal(NBelem(i,3)),1)
y3=Node(NLocal(NBelem(i,3)),2)
do j=1,3
g=gx(j)
h=hx(j)
phi(1)=1.-g-h
phi(2)=g
phi(3)=h
phig(1)=-1.
phig(2)=1.
phig(3)=0.
phih(1)=-1.
phih(2)=0.
phih(3)=1.
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2))
do k=1,3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k))
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k))
end
delphi=[phix;phiy]
nodalLset=[LSetLocal(NBelem(i,1));LSetLocal(NBelem(i,2));LSetLocal(NBelem(i,3))]
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))]
delset=delphi*nodalLset;
Floc=phi*nodalF
ML=ML+(phi'*phi)/3.
MGLSL=MGLSL+((delphi'*(delset/norm(delset)))*Floc*(h2/abs(Floc)))*phi/3.
f1L=f1L+phi'*Floc*norm(delset)/3.
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(h2/abs(Floc))*Floc*norm(delset)/3.
vs=h2*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+h2))
f3L=f3L+vs*delphi'*delset/3.
enddo
do k=1,3
do j=1,3
M(NBelem(i,j),NBelem(i,k))=M(NBelem(i,j),NBelem(i,k))+ML(j,k)
MGLS(NBelem(i,j),NBelem(i,k))=MGLS(NBelem(i,j),NBelem(i,k))+MGLSL(j,k)
enddo
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k)
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k)
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k)
enddo
enddo
end subroutine
! This subroutine uses the fast marching method to re-initialize the level set
call fastMarch(LSetLocal,NBelem,Node,NLocal,NBNodes)
include 'aba_param.inc'
integer NBelem(100,4),nstat(100)
real Node(100,2),NLocal(100,2),LSetLocal(100),newlSet(100),L(3)
newlSet=LSetLocal
! Reinitialize LS
nstat=0
do i=1,NBElems
do j=1,3
L(j)=sign(1.,lSetLocal(NBelem(i,j)))
enddo
if (L(1) /= L(2) .or. L(1) /= L(3))then
do j=1,3
nstat(NBelem(i,j))=1
enddo
endif
enddo
maincheck=0
do while(maincheck==0)
lmin=1000.
avlmin=1000.
eindex=0
nindex=0
maincheck=1
do i=1,NBElems
if (nstat(NBelem(i,1))+nstat(NBelem(i,2))+nstat(NBelem(i,3))==2)then
maincheck=0
check=0
ltot=0.
do j=1,3
if (nstat(NBelem(i,j))==0)then
if (abs(lSetLocal(NBelem(i,j)))<=lmin)then
check=1
tempindex=j
endif
endif
ltot=ltot+abs(lSetLocal(NBelem(i,j)))
enddo
if (check==1 .and. ltot/3.<=avlmin)then
eindex=i
nindex=tempindex
lmin=lSetLocal(NBelem(eindex,nindex))
avlmin=ltot/3.
endif
endif
enddo
if (maincheck==0)then
! Find New LS for point
xp=Node(NLocal(NBelem(eindex,nindex)),1)
yp=Node(NLocal(NBelem(eindex,nindex)),2)
count=0
do i=1,3
if (i/=nindex)then
icount=icount+1
x(icount)=Node(NLocal(NBelem(eindex,i)),1)
y(icount)=Node(NLocal(NBelem(eindex,i)),2)
lloc(icount)=newlSet(NBelem(eindex,i))
endif
enddo
delxa=x(1)-xp
delya=y(1)-yp
delxb=x(2)-xp
delyb=y(2)-yp
N=[delxa delya; delxb delyb]
M=N^-1
A=(M(1)*M(1)+M(2)*M(2))
B=(M(3)*M(3)+M(4)*M(4))
C=2.*(M(1)*M(3)+M(2)*M(4))
a=A+B+C
b=-2.*lloc(1)*A-2.*lloc(2)*B-C*(lloc(1)+lloc(2))
c=lloc(1)*lloc(1)*A+lloc(2)*lloc(2)*B+lloc(1)*lloc(2)*C-1.
templ1=(-b+sqrt(b*b-4.*a*c))/(2.*a)
templ2=(-b-sqrt(b*b-4.*a*c))/(2.*a)
if (abs(templ1)>abs(templ2))then
newlSet(NBelem(eindex,nindex))=templ1
else
newlSet(NBelem(eindex,nindex))=templ2
endif
nstat(NBelem(eindex,nindex))=1
endif
enddo
LSetLocal=newlSet
end subroutine

268
Unpublished/XFEM2/Full2D/XCOR1D.m Normal file
View file

@ -0,0 +1,268 @@
function [] = XCOR1D()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=4;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=0.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
for n=1:2
crdn1=ndCoords(elemNodes(e,n));
if crdn1<=dpos
Tnew(2*elemNodes(e,n)-1)=1.;
end
end
end
Bound(1)=1.;
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% penalty term
beta=100.;
% Loop through time steps
for ts=1:tsteps
eNodes=zeros(2*numNodes,1);
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=0.5*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
vel=0.
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
eNodes(2*elemNodes(e,1))=1;
eNodes(2*elemNodes(e,2))=1;
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
% if term<0
% cond=0.00;
% spec=0.001;
% else
cond=1.;
spec=1.;
% end
if enr==4
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
else
phi(2)=0.0;
phi(4)=0.0;
end
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
if enr==4
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
else
phic(2)=0.0;
phic(4)=0.0;
end
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
if enr==5;
Ke(1,2)=0.;
Me(1,2)=0.;
Ke(2,1)=0.;
Me(2,1)=0.;
Ke(1,4)=0.;
Me(1,4)=0.;
Ke(4,1)=0.;
Me(4,1)=0.;
Ke(3,2)=0.;
Me(3,2)=0.;
Ke(2,3)=0.;
Me(2,3)=0.;
Ke(4,3)=0.;
Me(4,3)=0.;
Ke(3,4)=0.;
Me(3,4)=0.;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove NON-ENHANCED DOFs(Reduce Matrices)
iindex=0.;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
TR1(iindex)=Tnew(i);
BR1(iindex)=Bound(i);
pforceR1(iindex)=pforce(i);
jindex=0;
for j=1:ndof*numNodes;
check=0;
if mod(j,2)==0 && eNodes(j)~=1
check=1;
end
if check==0
jindex=jindex+1;
MR1(iindex,jindex)=M(i,j);
KR1(iindex,jindex)=K(i,j);
end
end
end
end
AR1=KR1+MR1;
SubR1=AR1*BR1';
RHSR1=MR1*TR1'-SubR1+pforceR1';
% Apply Boundary Conditions
Biindex=0.;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
RHSR2(Biindex)=RHSR1(i);
jindex=0;
for j=1:iindex;
check=0;
if BR1(j)==0.;
jindex=jindex+1;
AR2(Biindex,jindex)=AR1(i,j);
end
end
end
end
%Solve
Tnewr=(AR2^-1)*RHSR2';
% Restore Matrices
Biindex=0;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
TR1(i)=Tnewr(Biindex);
end
end
iindex=0;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
Tnew(i)=TR1(iindex);
end
end
Tnew
end
stored';

196
Unpublished/XFEM2/Full2D/XCOR1Db.m Normal file
View file

@ -0,0 +1,196 @@
function [] = XCOR1Db()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=4;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=0.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
for n=1:2
crdn1=ndCoords(elemNodes(e,n));
if crdn1<=dpos
Tnew(2*elemNodes(e,n)-1)=1.;
end
end
end
Bound(1)=1.;
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% penalty term
beta=100.;
% Loop through time steps
for ts=1:tsteps
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=0.5*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
vel=0.;
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
cond=1.;
spec=1.;
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
Me
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
A=K+M;
Sub=A*Bound;
M*Tnew;
RHS=M*Tnew-Sub+pforce;
% Apply Boundary Conditions
Biindex=0.;
for i=1:ndof*numNodes;
if Bound(i)==0.;
Biindex=Biindex+1;
RHSR(Biindex)=RHS(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
AR(Biindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(AR^-1)*RHSR';
% Restore Matrices
Biindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
Biindex=Biindex+1;
Tnew(i)=Tnewr(Biindex);
end
end
Tnew
end
stored';

783
Unpublished/XFEM2/Full2D/XCOR_2D.asv Normal file
View file

@ -0,0 +1,783 @@
function []=XCOR_2D()
clear all
% Define Mesh
NumX=2;
NumY=1;
delX=1.;
delY=1.;
numElem=NumX*NumY;
numNodes=(NumX+1)*(NumY+1);
Elength=(delX+delY)/2.;
[Node,Element]=buildMesh(NumX,NumY,delX,delY);
% Simulation Parameters
rho=1.;
Penalty=80.;
dtImp=0.1;
dtExp=0.01;
tsteps=4;
bandWidth=10.;
epsilon=0.00001;
visc=0.0005;
% Get Initial Level Set
LSetOld=initialLSet(Node,numNodes);
% plotLSet(NumX,NumY,delX,delY,LSet);
% Initial Conditions
Temp=zeros(numNodes*2,1);
for i=1:numNodes
if LSetOld(i)<=0
Temp(2*i-1)=1.;
end
end
% Boundary Conditions
Bound=zeros(numNodes*2,1);
for i=1:numNodes
if Node(i,1)<delX/10.
Bound(2*i-1)=1.;
end
end
% Loop through time steps
for ts=1:tsteps
% Update Level Set
LSetNew=updateLSet(Temp,Node,numNodes,Element,numElem,dtImp,dtExp,LSetOld,...
Elength,bandWidth,epsilon,visc);
% Solve for Temperature
Temp=getTemp(Node,Element,numNodes,numElem,LSetNew,Bound,Temp,Penalty,rho,dtImp,LSetOld);
LSetOld=LSetNew;
LSetOld'
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Create a linear quadrilateral FE mesh
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [Node,Element]=buildMesh(NumX,NumY,delX,delY)
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% This function updates the level set
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [LSet]=updateLSet(Temp,Node,numNodes,Element,numElem,dtImp,dtExp,LSet,...
Elength,bandWidth,epsilon,visc)
% parameters
charLen=epsilon*Elength;
for tstep=1:floor(dtImp/dtExp)
% Identify Narrow Band Elements and Get Local Level Set
[NBelem,NBElems,NGlobal,NLocal,NBNodes,LSetLocal]=getNarrowBand(bandWidth,...
Elength,LSet,Element,numElem,numNodes);
% Identify Scalar Velocity on Nodes Crossed By Interface - F
F=getF(Temp,LSetLocal,NBElems,NBNodes,NLocal,NBelem,Node,Elength);
% Get 'Stiffness' Matrix - A
A=getA(Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal);
% Apply BCs
RHS=-A*F;
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i);
jindex=0;
for j=1:NBNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
if iindex>0
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
end
% Get Level Set Equation Terms
[M,MGLS,f1,f2,f3]=getTerms(Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal,visc,charLen,F);
LSetLocal=LSetLocal-((((M+MGLS)^-1)*dtExp)*(f1+f2+f3))';
% Reinitialize LS
%LSetLocal=fastMarch(LSetLocal,NBelem,Node,NLocal,NBNodes,NBElems);
for i=1:NBNodes
LSet(NLocal(i))=LSetLocal(i);
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Find elements in narrow band and create map between
% global node labels and those in narrow band
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [NBelem,NBElems,NGlobal,NLocal,NBNodes,LSetLocal]=getNarrowBand(bandWidth,...
ELength,LSet,Element,numElem,numNodes)
% Identify Narrow Band Elements
NBElems=0;
NBNodes=0;
NGlobal=zeros(numNodes);
for i=1:numElem
check=0;
for iNd=1:4
if abs(LSet(Element(i,iNd)))<=bandWidth*ELength
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
for j=1:4
if NGlobal(Element(i,j))==0
NBNodes=NBNodes+1;
NGlobal(Element(i,j))=NBNodes;
NLocal(NBNodes)=Element(i,j);
end
end
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,2));
NBelem(NBElems,3)=NGlobal(Element(i,3));
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,3));
NBelem(NBElems,3)=NGlobal(Element(i,4));
end
end
% Get local Level Set
for i=1:NBNodes
LSetLocal(i)=LSet(NLocal(i));
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Get Interface Normal Veloctiy 'F'
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function F=getF(Temp,LSetLocal,NBElems,NBNodes,NLocal,NBelem,Node,ELength)
F=zeros(NBNodes,1);
eStat=zeros(NBElems,1);
nData=zeros(NBNodes,2);
for i=1:NBElems
for j=1:3
L(j)=LSetLocal(NBelem(i,j));
end
x11=Node(NLocal(NBelem(i,1)),1);
x12=Node(NLocal(NBelem(i,2)),1);
x13=Node(NLocal(NBelem(i,3)),1);
y11=Node(NLocal(NBelem(i,1)),2);
y12=Node(NLocal(NBelem(i,2)),2);
y13=Node(NLocal(NBelem(i,3)),2);
count=0.;
if sign(L(1)) ~= sign(L(2))
eStat(i)=1;
count=count+1;
f=abs(L(1))/(abs(L(1))+abs(L(2)));
xi(count)=f*(x12-x11)+x11;
yi(count)=f*(y12-y11)+y11;
end
if sign(L(1)) ~= sign(L(3))
eStat(i)=1;
count=count+1;
f=abs(L(1))/(abs(L(1))+abs(L(3)));
xi(count)=f*(x13-x11)+x11;
yi(count)=f*(y13-y11)+y11 ;
end
if sign(L(2)) ~= sign(L(3))
eStat(i)=1;
count=count+1;
f=abs(L(2))/(abs(L(2))+abs(L(3)));
xi(count)=f*(x13-x12)+x12;
yi(count)=f*(y13-y12)+y12 ;
end
if eStat(i)==1
n=[yi(2)-yi(1); xi(1)-xi(2)];
n=n/norm(n);
xd(1,1)=(xi(1)+xi(2))/2.;
xd(1,2)=(yi(1)+yi(2))/2.;
xd(2,1)=0.1*ELength*n(1)+xd(1,1);
xd(2,2)=0.1*ELength*n(2)+xd(1,2);
% Check if xd2 is in element
v0(1)=x11;
v0(2)=y11;
v1(1)=x12-x11;
v1(2)=y12-y11;
v2(1)=x13-x11;
v2(2)=y13-y11;
v(1)=xd(2,1);
v(2)=xd(2,2);
ra=((v(1)*v2(2)-v2(1)*v(2))-(v0(1)*v2(2)-v2(1)*v0(2)))/(v1(1)*v2(2)-v2(1)*v1(2));
rb=-((v(1)*v1(2)-v1(1)*v(2))-(v0(1)*v1(2)-v1(1)*v0(2)))/(v1(1)*v2(2)-v2(1)*v1(2));
check=0;
if ra>0. && rb>0. && ra+rb<1.
index=i;
x21=x11;
x22=x12;
x23=x13;
y21=y11;
y22=y12;
y23=y13;
else
for j=1:NBElems
tx1=Node(NLocal(NBelem(j,1)),1);
tx2=Node(NLocal(NBelem(j,2)),1);
tx3=Node(NLocal(NBelem(j,3)),1);
ty1=Node(NLocal(NBelem(j,1)),2);
ty2=Node(NLocal(NBelem(j,2)),2);
ty3=Node(NLocal(NBelem(j,3)),2);
v0(1)=tx1;
v0(2)=ty1;
v1(1)=tx2-tx1;
v1(2)=ty2-ty1;
v2(1)=tx3-tx1;
v2(2)=ty3-ty1;
v(1)=xd(2,1);
v(2)=xd(2,2);
ra=((v(1)*v2(2)-v2(1)*v(2))-(v0(1)*v2(2)-v2(1)*v0(2)))/(v1(1)*v2(2)-v2(1)*v1(2));
rb=-((v(1)*v1(2)-v1(1)*v(2))-(v0(1)*v1(2)-v1(1)*v0(2)))/(v1(1)*v2(2)-v2(1)*v1(2));
if ra>0. && rb>0. && ra+rb<1.
index=j;
x21=tx1;
x22=tx2;
x23=tx3;
y21=ty1;
y22=ty2;
y23=ty3;
end
end
end
Ae1=0.5*((x12*y13-x13*y12)+(y12-y13)*x11+(x13-x12)*y11);
Ae2=0.5*((x22*y23-x23*y22)+(y22-y23)*x21+(x23-x22)*y21);
N1=(1./(2.*Ae))*((y2-y3)*(xd(j,1)-x2)+(x3-x2)*(xd(j,2)-y2));
N2=(1./(2.*Ae))*((y3-y1)*(xd(j,1)-x3)+(x1-x3)*(xd(j,2)-y3));
N3=(1./(2.*Ae))*((y1-y2)*(xd(j,1)-x1)+(x2-x1)*(xd(j,2)-y1));
T1=Temp(2*NLocal(NBelem(i,1))-1);
T2=Temp(2*NLocal(NBelem(i,2))-1);
T3=Temp(2*NLocal(NBelem(i,3))-1);
a1=Temp(2*NLocal(NBelem(i,1)));
a2=Temp(2*NLocal(NBelem(i,2)));
a3=Temp(2*NLocal(NBelem(i,3)));
L1=LSetLocal(NBelem(i,1));
L2=LSetLocal(NBelem(i,2));
L3=LSetLocal(NBelem(i,3));
LS=abs(N1*L1+L2*N2+L3*N3);
p1=N1*(LS-abs(L1));
p2=N2*(LS-abs(L2));
p3=N3*(LS-abs(L3));
T(j)=N1*T1+N2*T2+N3*T3+p1*a1+p2*a2+p3*a3;
end
gradT=(T(2)-T(1))/(0.1*ELength);
for j=1:3
nData(NBelem(i,j),1)=nData(NBelem(i,j),1)+1.;
nData(NBelem(i,j),2)=nData(NBelem(i,j),2)+0.1*gradT;
end
end
end
for i=1:NBNodes
if nData(i,1)>0
F(i)=nData(i,2)/nData(i,1);
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Get 'Stiffness' Matrix 'A'
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [A]=getA(Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal)
A=zeros(NBNodes);
for i=1:NBElems
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[LSetLocal(NBelem(i,1));LSetLocal(NBelem(i,2));LSetLocal(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Get terms for LS equation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [M,MGLS,f1,f2,f3]=getTerms(Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal,visc,charLen,F)
M=zeros(NBNodes);
MGLS=zeros(NBNodes);
f1=zeros(NBNodes,1);
f2=zeros(NBNodes,1);
f3=zeros(NBNodes,1);
for i=1:NBElems
ML=zeros(3);
MGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[LSetLocal(NBelem(i,1));LSetLocal(NBelem(i,2));LSetLocal(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
ML=ML+(phi'*phi)/3.;
MGLSL=MGLSL+((delphi'*(delset/norm(delset)))*Floc*(charLen/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(charLen/abs(Floc))*Floc*norm(delset)/3.;
vs=charLen*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+charLen));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
M(NBelem(i,j),NBelem(i,k))=M(NBelem(i,j),NBelem(i,k))+ML(j,k);
MGLS(NBelem(i,j),NBelem(i,k))=MGLS(NBelem(i,j),NBelem(i,k))+MGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Use Fast March Method to Reinitialize LS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function LSetLocal=fastMarch(LSetLocal,NBelem,Node,NLocal,NBNodes,NBElems)
newlSet=LSetLocal;
% Reinitialize LS
nstat=zeros(NBNodes,1);
for i=1:NBElems
for j=1:3
L(j)=sign(LSetLocal(NBelem(i,j)));
end
if L(1) ~= L(2) || L(1) ~= L(3)
for j=1:3
nstat(NBelem(i,j))=1;
end
end
end
maincheck=0;
while(maincheck==0)
lmin=1000.;
avlmin=1000.;
eindex=0;
nindex=0;
maincheck=1;
for i=1:NBElems
if nstat(NBelem(i,1))+nstat(NBelem(i,2))+nstat(NBelem(i,3))==2
maincheck=0;
check=0;
ltot=0.;
for j=1:3
if nstat(NBelem(i,j))==0
if abs(LSetLocal(NBelem(i,j)))<=lmin
check=1;
tempindex=j;
end
end
ltot=ltot+abs(LSetLocal(NBelem(i,j)));
end
if check==1 && ltot/3.<=avlmin
eindex=i;
nindex=tempindex;
lmin=LSetLocal(NBelem(eindex,nindex));
avlmin=ltot/3.;
end
end
end
if maincheck==0
% Find New LS for point
xp=Node(NLocal(NBelem(eindex,nindex)),1);
yp=Node(NLocal(NBelem(eindex,nindex)),2);
count=0;
for i=1:3
if i~=nindex
count=count+1;
x(count)=Node(NLocal(NBelem(eindex,i)),1);
y(count)=Node(NLocal(NBelem(eindex,i)),2);
lloc(count)=newlSet(NBelem(eindex,i));
end
end
delxa=x(1)-xp;
delya=y(1)-yp;
delxb=x(2)-xp;
delyb=y(2)-yp;
N=[delxa delya; delxb delyb];
M=N^-1;
A=(M(1)*M(1)+M(2)*M(2));
B=(M(3)*M(3)+M(4)*M(4));
C=2.*(M(1)*M(3)+M(2)*M(4));
a=A+B+C;
b=-2.*lloc(1)*A-2.*lloc(2)*B-C*(lloc(1)+lloc(2));
c=lloc(1)*lloc(1)*A+lloc(2)*lloc(2)*B+lloc(1)*lloc(2)*C-1.;
templ1=(-b+sqrt(b*b-4.*a*c))/(2.*a);
templ2=(-b-sqrt(b*b-4.*a*c))/(2.*a);
if abs(templ1)>abs(templ2)
newlSet(NBelem(eindex,nindex))=templ1;
else
newlSet(NBelem(eindex,nindex))=templ2;
end
nstat(NBelem(eindex,nindex))=1;
end
end
LSetLocal=newlSet;
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Solve Implicit Porblem to Get Temperature
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Temp=getTemp(Node,Element,numNodes,numElem,LSet,Bound,Temp,Penalty,rho,dtImp,LSetOld)
K=zeros(numNodes*2,numNodes*2);
M=zeros(numNodes*2,numNodes*2);
MStar=zeros(numNodes*2,numNodes*2);
pforce=zeros(numNodes*2,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(8);
Me=zeros(8);
MeStar=zeros(8);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=LSet(Element(e,icrd));
thetaO(icrd)=LSetOld(Element(e,icrd));
end
check=0;
for i=1:3
for j=i+1:4
if sign(theta(1))~=sign(theta(j))
check=1;
end
end
end
if check==1
% possible enriched element
npart=10;
enr=npart*npart;
for sdx=1:npart
for sdy=1:npart
midx=-1.-1./npart+(2./npart)*sdx;
midy=-1.-1./npart+(2./npart)*sdy;
subindex=npart*(sdy-1)+sdx;
gpos=1./(sqrt(3.)*npart);
gx(subindex,1)=midx-gpos;
gx(subindex,2)=midx+gpos;
gx(subindex,3)=midx+gpos;
gx(subindex,4)=midx-gpos;
hx(subindex,1)=midy-gpos;
hx(subindex,2)=midy-gpos;
hx(subindex,3)=midy+gpos;
hx(subindex,4)=midy+gpos;
end
end
% check if int points are on different sides of front
check=0;
for i=1:enr
for 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);
phiO=phi;
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
if i==1 && j==1
sgn=sign(iLS);
else
if sign(iLS)~=sgn
check=1;
end
end
end
end
if check==0
% regular element - fix extra dofs
enr=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;
end
else
% regular element - fix extra dofs
enr=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;
end
for i=1:enr
for 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);
phiO=phi;
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
iLSO=thetaO(1)*phi(1)+thetaO(2)*phi(3)+thetaO(3)*phi(5)+thetaO(4)*phi(7);
if iLS<0.
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
if iLSO<0.
specO=0.01;
else
specO=1.;
end
for iter=1:4
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
phiO(2*iter)=phiO(2*iter-1)*(abs(iLSO)-abs(thetaO(iter)));
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=djac;
Ke=Ke+(we*cond*(phix'*phix+phiy'*phiy))/double(enr);
Me=Me+((we*rho*spec*phi'*phi)/dtImp)/double(enr);
MeStar=MeStar+((we*rho*specO*phi'*phiO)/dtImp)/double(enr);
end
end
% Add penalty term and get temp gradient on interface
if enr>1;
count=0;
if sign(theta(1))~=sign(theta(2))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(2)));
xi(count)=f*(crdnx(2)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(2)-crdny(1))+crdny(1);
gi(count)=(2.*xi(count)-(crdnx(1)+crdnx(2)))/(-crdnx(1)+crdnx(2));
hi(count)=-1.;
end
if sign(theta(2))~=sign(theta(3))
count=count+1;
f=abs(theta(2))/(abs(theta(2))+abs(theta(3)));
xi(count)=f*(crdnx(3)-crdnx(2))+crdnx(2);
yi(count)=f*(crdny(3)-crdny(2))+crdny(2);
gi(count)=1.;
hi(count)=(2.*yi(count)-(crdny(2)+crdny(3)))/(-crdny(2)+crdny(3));
end
if sign(theta(3))~=sign(theta(4))
count=count+1;
f=abs(theta(3))/(abs(theta(3))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(3))+crdnx(3);
yi(count)=f*(crdny(4)-crdny(3))+crdny(3);
gi(count)=(2.*xi(count)-(crdnx(4)+crdnx(3)))/(-crdnx(4)+crdnx(3));
hi(count)=1.;
end
if sign(theta(1))~=sign(theta(4))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(4)-crdny(1))+crdny(1);
gi(count)=-1.;
hi(count)=(2.*yi(count)-(crdny(1)+crdny(4)))/(-crdny(4)+crdny(1));
end
c=zeros(2,1);
c=(c+1.);
for i=1:2;
G(i,1)=0.25*(1.-gi(i))*(1.-hi(i));
G(i,3)=0.25*(1.+gi(i))*(1.-hi(i));
G(i,5)=0.25*(1.+gi(i))*(1.+hi(i));
G(i,7)=0.25*(1.-gi(i))*(1.+hi(i));
G(i,2)=-G(i,1)*abs(theta(1));
G(i,4)=-G(i,3)*abs(theta(2));
G(i,6)=-G(i,5)*abs(theta(3));
G(i,8)=-G(i,7)*abs(theta(4));
end
pen=Penalty*(G'*G);
pfL=Penalty*G'*c;
% pen=zeros(8);
% pfL=zeros(8,1);
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
MStar(gnum(j),gnum(i))=MStar(gnum(j),gnum(i))+MeStar(2*j-1,2*i-1);
MStar(gnum(j)+1,gnum(i)+1)=MStar(gnum(j)+1,gnum(i)+1)+MeStar(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=MStar*Temp;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:2*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i)+pforce(i);
jindex=0;
for j=1:2*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tempr=(Ared^-1)*RHSred';
iindex=0;
for i=1:2*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Temp(i)=Tempr(iindex);
end
end
Temp
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Generates the initial level set
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [LSet]=initialLSet(Node,numNodes)
%centx=4.;
%centy=4.;
%rad=2.1;
%for i=1:numNodes;
% dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
% LSet(i)=dist-rad;
%end
for i=1:numNodes;
dist=Node(i,1)-1.1;
LSet(i)=dist;
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Plot the level set
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function []=plotLSet(NumX,NumY,delX,delY,LSet)
[X Y]=meshgrid(0:delX:delX*NumX,0:delY:delY*NumY);
Z=zeros(NumX+1,NumY+1);
for i=1:(NumX+1)*(NumY+1)
Z(i)=LSet(i);
end
surf(X,Y,Z)
end

801
Unpublished/XFEM2/Full2D/XCOR_2D.m Normal file
View file

@ -0,0 +1,801 @@
function []=XCOR_2D()
clear all
% Define Mesh
NumX=10;
NumY=1;
delX=1.;
delY=1.;
numElem=NumX*NumY;
numNodes=(NumX+1)*(NumY+1);
Elength=(delX+delY)/2.;
[Node,Element]=buildMesh(NumX,NumY,delX,delY);
% Simulation Parameters
rho=1.;
Penalty=200.;
dtImp=0.01;
dtExp=0.001;
tsteps=10;
bandWidth=10.;
epsilon=0.00001;
visc=0.0005;
% Get Initial Level Set
LSetOld=initialLSet(Node,numNodes);
% plotLSet(NumX,NumY,delX,delY,LSet);
% Initial Conditions
Temp=zeros(numNodes*2,1);
for i=1:numNodes
if LSetOld(i)<=0
Temp(2*i-1)=1.;
end
end
% Boundary Conditions
Bound=zeros(numNodes*2,1);
for i=1:numNodes
if Node(i,1)<delX/10.
Bound(2*i-1)=1.;
end
end
% Loop through time steps
for ts=1:tsteps
% Update Level Set
LSetNew=updateLSet(Temp,Node,numNodes,Element,numElem,dtImp,dtExp,LSetOld,...
Elength,bandWidth,epsilon,visc);
% Solve for Temperature
Temp=getTemp(Node,Element,numNodes,numElem,LSetNew,Bound,Temp,Penalty,rho,dtImp,LSetOld);
LSetOld=LSetNew;
LSetOld'
POUT(ts)=LSetOld(1);
end
POUT';
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Create a linear quadrilateral FE mesh
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [Node,Element]=buildMesh(NumX,NumY,delX,delY)
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% This function updates the level set
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [LSet]=updateLSet(Temp,Node,numNodes,Element,numElem,dtImp,dtExp,LSet,...
Elength,bandWidth,epsilon,visc)
% parameters
charLen=epsilon*Elength;
for tstep=1:floor(dtImp/dtExp)
% Identify Narrow Band Elements and Get Local Level Set
[NBelem,NBElems,NGlobal,NLocal,NBNodes,LSetLocal]=getNarrowBand(bandWidth,...
Elength,LSet,Element,numElem,numNodes);
% Identify Scalar Velocity on Nodes Crossed By Interface - F
F=getF(Temp,LSetLocal,NBElems,NBNodes,NLocal,NBelem,Node,Elength);
% Get 'Stiffness' Matrix - A
A=getA(Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal);
% Apply BCs
RHS=-A*F;
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i);
jindex=0;
for j=1:NBNodes
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
if iindex>0
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:NBNodes
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
end
% Get Level Set Equation Terms
[M,MGLS,f1,f2,f3]=getTerms(Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal,visc,charLen,F);
LSetLocal=LSetLocal-((((M+MGLS)^-1)*dtExp)*(f1+f2+f3))';
% Reinitialize LS
%LSetLocal=fastMarch(LSetLocal,NBelem,Node,NLocal,NBNodes,NBElems);
for i=1:NBNodes
LSet(NLocal(i))=LSetLocal(i);
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Find elements in narrow band and create map between
% global node labels and those in narrow band
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [NBelem,NBElems,NGlobal,NLocal,NBNodes,LSetLocal]=getNarrowBand(bandWidth,...
ELength,LSet,Element,numElem,numNodes)
% Identify Narrow Band Elements
NBElems=0;
NBNodes=0;
NGlobal=zeros(numNodes);
for i=1:numElem
check=0;
for iNd=1:4
if abs(LSet(Element(i,iNd)))<=bandWidth*ELength
check=1;
end
end
% If an element is in the narrow band split it into triangles
if check==1
for j=1:4
if NGlobal(Element(i,j))==0
NBNodes=NBNodes+1;
NGlobal(Element(i,j))=NBNodes;
NLocal(NBNodes)=Element(i,j);
end
end
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,2));
NBelem(NBElems,3)=NGlobal(Element(i,3));
NBElems=NBElems+1;
NBelem(NBElems,1)=NGlobal(Element(i,1));
NBelem(NBElems,2)=NGlobal(Element(i,3));
NBelem(NBElems,3)=NGlobal(Element(i,4));
end
end
% Get local Level Set
for i=1:NBNodes
LSetLocal(i)=LSet(NLocal(i));
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Get Interface Normal Veloctiy 'F'
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function F=getF(Temp,LSetLocal,NBElems,NBNodes,NLocal,NBelem,Node,ELength)
F=zeros(NBNodes,1);
eStat=zeros(NBElems,1);
nData=zeros(NBNodes,2);
for i=1:NBElems
for j=1:3
L(j)=LSetLocal(NBelem(i,j));
end
x11=Node(NLocal(NBelem(i,1)),1);
x12=Node(NLocal(NBelem(i,2)),1);
x13=Node(NLocal(NBelem(i,3)),1);
y11=Node(NLocal(NBelem(i,1)),2);
y12=Node(NLocal(NBelem(i,2)),2);
y13=Node(NLocal(NBelem(i,3)),2);
count=0.;
if sign(L(1)) ~= sign(L(2))
eStat(i)=1;
count=count+1;
f=abs(L(1))/(abs(L(1))+abs(L(2)));
xi(count)=f*(x12-x11)+x11;
yi(count)=f*(y12-y11)+y11;
end
if sign(L(1)) ~= sign(L(3))
eStat(i)=1;
count=count+1;
f=abs(L(1))/(abs(L(1))+abs(L(3)));
xi(count)=f*(x13-x11)+x11;
yi(count)=f*(y13-y11)+y11 ;
end
if sign(L(2)) ~= sign(L(3))
eStat(i)=1;
count=count+1;
f=abs(L(2))/(abs(L(2))+abs(L(3)));
xi(count)=f*(x13-x12)+x12;
yi(count)=f*(y13-y12)+y12 ;
end
if eStat(i)==1
n=[yi(2)-yi(1); xi(1)-xi(2)];
n=n/norm(n);
xd(1,1)=(xi(1)+xi(2))/2.;
xd(1,2)=(yi(1)+yi(2))/2.;
xd(2,1)=0.15*ELength*n(1)+xd(1,1);
xd(2,2)=0.15*ELength*n(2)+xd(1,2);
% Check if xd2 is in element
v0(1)=x11;
v0(2)=y11;
v1(1)=x12-x11;
v1(2)=y12-y11;
v2(1)=x13-x11;
v2(2)=y13-y11;
v(1)=xd(2,1);
v(2)=xd(2,2);
ra=((v(1)*v2(2)-v2(1)*v(2))-(v0(1)*v2(2)-v2(1)*v0(2)))/(v1(1)*v2(2)-v2(1)*v1(2));
rb=-((v(1)*v1(2)-v1(1)*v(2))-(v0(1)*v1(2)-v1(1)*v0(2)))/(v1(1)*v2(2)-v2(1)*v1(2));
check=0;
if ra>0. && rb>0. && ra+rb<1.
index=i;
x21=x11;
x22=x12;
x23=x13;
y21=y11;
y22=y12;
y23=y13;
else
for j=1:NBElems
tx1=Node(NLocal(NBelem(j,1)),1);
tx2=Node(NLocal(NBelem(j,2)),1);
tx3=Node(NLocal(NBelem(j,3)),1);
ty1=Node(NLocal(NBelem(j,1)),2);
ty2=Node(NLocal(NBelem(j,2)),2);
ty3=Node(NLocal(NBelem(j,3)),2);
v0(1)=tx1;
v0(2)=ty1;
v1(1)=tx2-tx1;
v1(2)=ty2-ty1;
v2(1)=tx3-tx1;
v2(2)=ty3-ty1;
v(1)=xd(2,1);
v(2)=xd(2,2);
ra=((v(1)*v2(2)-v2(1)*v(2))-(v0(1)*v2(2)-v2(1)*v0(2)))/(v1(1)*v2(2)-v2(1)*v1(2));
rb=-((v(1)*v1(2)-v1(1)*v(2))-(v0(1)*v1(2)-v1(1)*v0(2)))/(v1(1)*v2(2)-v2(1)*v1(2));
if ra>0. && rb>0. && ra+rb<1.
index=j;
x21=tx1;
x22=tx2;
x23=tx3;
y21=ty1;
y22=ty2;
y23=ty3;
end
end
end
Ae=0.5*((x12*y13-x13*y12)+(y12-y13)*x11+(x13-x12)*y11);
N1=(1./(2.*Ae))*((y12-y13)*(xd(1,1)-x12)+(x13-x12)*(xd(1,2)-y12));
N2=(1./(2.*Ae))*((y13-y11)*(xd(1,1)-x13)+(x11-x13)*(xd(1,2)-y13));
N3=(1./(2.*Ae))*((y11-y12)*(xd(1,1)-x11)+(x12-x11)*(xd(1,2)-y11));
T1=Temp(2*NLocal(NBelem(i,1))-1);
T2=Temp(2*NLocal(NBelem(i,2))-1);
T3=Temp(2*NLocal(NBelem(i,3))-1);
a1=Temp(2*NLocal(NBelem(i,1)));
a2=Temp(2*NLocal(NBelem(i,2)));
a3=Temp(2*NLocal(NBelem(i,3)));
L1=LSetLocal(NBelem(i,1));
L2=LSetLocal(NBelem(i,2));
L3=LSetLocal(NBelem(i,3));
LS=abs(N1*L1+L2*N2+L3*N3);
p1=N1*(LS-abs(L1));
p2=N2*(LS-abs(L2));
p3=N3*(LS-abs(L3));
T(1)=N1*T1+N2*T2+N3*T3+p1*a1+p2*a2+p3*a3;
Ae=0.5*((x22*y23-x23*y22)+(y22-y23)*x21+(x23-x22)*y21);
N1=(1./(2.*Ae))*((y22-y23)*(xd(2,1)-x22)+(x23-x22)*(xd(2,2)-y22));
N2=(1./(2.*Ae))*((y23-y21)*(xd(2,1)-x23)+(x21-x23)*(xd(2,2)-y23));
N3=(1./(2.*Ae))*((y21-y22)*(xd(2,1)-x21)+(x22-x21)*(xd(2,2)-y21));
T1=Temp(2*NLocal(NBelem(index,1))-1);
T2=Temp(2*NLocal(NBelem(index,2))-1);
T3=Temp(2*NLocal(NBelem(index,3))-1);
a1=Temp(2*NLocal(NBelem(index,1)));
a2=Temp(2*NLocal(NBelem(index,2)));
a3=Temp(2*NLocal(NBelem(index,3)));
L1=LSetLocal(NBelem(index,1));
L2=LSetLocal(NBelem(index,2));
L3=LSetLocal(NBelem(index,3));
LS=abs(N1*L1+L2*N2+L3*N3);
p1=N1*(LS-abs(L1));
p2=N2*(LS-abs(L2));
p3=N3*(LS-abs(L3));
T(2)=N1*T1+N2*T2+N3*T3+p1*a1+p2*a2+p3*a3
gradT=(T(2)-T(1))/(0.15*ELength);
for j=1:3
nData(NBelem(i,j),1)=nData(NBelem(i,j),1)+1.;
nData(NBelem(i,j),2)=nData(NBelem(i,j),2)+0.1*gradT;
end
end
end
for i=1:NBNodes
if nData(i,1)>0
F(i)=nData(i,2)/nData(i,1);
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Get 'Stiffness' Matrix 'A'
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [A]=getA(Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal)
A=zeros(NBNodes);
for i=1:NBElems
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
AfL=zeros(3);
AfLGLS=zeros(3);
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=2*abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[LSetLocal(NBelem(i,1));LSetLocal(NBelem(i,2));LSetLocal(NBelem(i,3))];
set=phi*nodalLset;
delset=delphi*nodalLset;
AfL=AfL+(phi'*sign(set))*(delset'*delphi)/3.;
AfLGLS=AfLGLS+(delphi'*delset)*(1./norm(delset))*(delset'*delphi)/3.;
end
sum=AfL+AfLGLS;
for k=1:3;
for j=1:3;
A(NBelem(i,j),NBelem(i,k))=A(NBelem(i,j),NBelem(i,k))+sum(j,k);
end
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Get terms for LS equation
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [M,MGLS,f1,f2,f3]=getTerms(Node,NLocal,NBelem,NBNodes,NBElems,LSetLocal,visc,charLen,F)
M=zeros(NBNodes);
MGLS=zeros(NBNodes);
f1=zeros(NBNodes,1);
f2=zeros(NBNodes,1);
f3=zeros(NBNodes,1);
for i=1:NBElems
ML=zeros(3);
MGLSL=zeros(3);
f1L=zeros(3,1);
f2L=zeros(3,1);
f3L=zeros(3,1);
gx(1)=2./3.;
gx(2)=1./6.;
gx(3)=1./6.;
hx(1)=1./6.;
hx(2)=1./6.;
hx(3)=2./3.;
x1=Node(NLocal(NBelem(i,1)),1);
y1=Node(NLocal(NBelem(i,1)),2);
x2=Node(NLocal(NBelem(i,2)),1);
y2=Node(NLocal(NBelem(i,2)),2);
x3=Node(NLocal(NBelem(i,3)),1);
y3=Node(NLocal(NBelem(i,3)),2);
for j=1:3
g=gx(j);
h=hx(j);
phi(1)=1.-g-h;
phi(2)=g;
phi(3)=h;
phig(1)=-1.;
phig(2)=1.;
phig(3)=0.;
phih(1)=-1.;
phih(2)=0.;
phih(3)=1.;
djac=abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2));
for k=1:3
phix(k)=(1./djac)*((-y1+y3)*phig(k)+(y1-y2)*phih(k));
phiy(k)=(1./djac)*((x1-x3)*phig(k)+(-x1+x2)*phih(k));
end
delphi=[phix;phiy];
nodalLset=[LSetLocal(NBelem(i,1));LSetLocal(NBelem(i,2));LSetLocal(NBelem(i,3))];
nodalF=[F(NBelem(i,1));F(NBelem(i,2));F(NBelem(i,3))];
delset=delphi*nodalLset;
Floc=phi*nodalF;
ML=ML+(phi'*phi)/3.;
MGLSL=MGLSL+((delphi'*(delset/norm(delset)))*Floc*(charLen/abs(Floc)))*phi/3.;
f1L=f1L+phi'*Floc*norm(delset)/3.;
f2L=f2L+(delphi'*(delset/norm(delset))*Floc)*(charLen/abs(Floc))*Floc*norm(delset)/3.;
vs=charLen*((abs(visc+Floc*norm(delset)))/(norm(Floc*delset)+charLen));
f3L=f3L+vs*delphi'*delset/3.;
end
for k=1:3;
for j=1:3;
M(NBelem(i,j),NBelem(i,k))=M(NBelem(i,j),NBelem(i,k))+ML(j,k);
MGLS(NBelem(i,j),NBelem(i,k))=MGLS(NBelem(i,j),NBelem(i,k))+MGLSL(j,k);
end
f1(NBelem(i,k))=f1(NBelem(i,k))+f1L(k);
f2(NBelem(i,k))=f2(NBelem(i,k))+f2L(k);
f3(NBelem(i,k))=f3(NBelem(i,k))+f3L(k);
end
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Use Fast March Method to Reinitialize LS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function LSetLocal=fastMarch(LSetLocal,NBelem,Node,NLocal,NBNodes,NBElems)
newlSet=LSetLocal;
% Reinitialize LS
nstat=zeros(NBNodes,1);
for i=1:NBElems
for j=1:3
L(j)=sign(LSetLocal(NBelem(i,j)));
end
if L(1) ~= L(2) || L(1) ~= L(3)
for j=1:3
nstat(NBelem(i,j))=1;
end
end
end
maincheck=0;
while(maincheck==0)
lmin=1000.;
avlmin=1000.;
eindex=0;
nindex=0;
maincheck=1;
for i=1:NBElems
if nstat(NBelem(i,1))+nstat(NBelem(i,2))+nstat(NBelem(i,3))==2
maincheck=0;
check=0;
ltot=0.;
for j=1:3
if nstat(NBelem(i,j))==0
if abs(LSetLocal(NBelem(i,j)))<=lmin
check=1;
tempindex=j;
end
end
ltot=ltot+abs(LSetLocal(NBelem(i,j)));
end
if check==1 && ltot/3.<=avlmin
eindex=i;
nindex=tempindex;
lmin=LSetLocal(NBelem(eindex,nindex));
avlmin=ltot/3.;
end
end
end
if maincheck==0
% Find New LS for point
xp=Node(NLocal(NBelem(eindex,nindex)),1);
yp=Node(NLocal(NBelem(eindex,nindex)),2);
count=0;
for i=1:3
if i~=nindex
count=count+1;
x(count)=Node(NLocal(NBelem(eindex,i)),1);
y(count)=Node(NLocal(NBelem(eindex,i)),2);
lloc(count)=newlSet(NBelem(eindex,i));
end
end
delxa=x(1)-xp;
delya=y(1)-yp;
delxb=x(2)-xp;
delyb=y(2)-yp;
N=[delxa delya; delxb delyb];
M=N^-1;
A=(M(1)*M(1)+M(2)*M(2));
B=(M(3)*M(3)+M(4)*M(4));
C=2.*(M(1)*M(3)+M(2)*M(4));
a=A+B+C;
b=-2.*lloc(1)*A-2.*lloc(2)*B-C*(lloc(1)+lloc(2));
c=lloc(1)*lloc(1)*A+lloc(2)*lloc(2)*B+lloc(1)*lloc(2)*C-1.;
templ1=(-b+sqrt(b*b-4.*a*c))/(2.*a);
templ2=(-b-sqrt(b*b-4.*a*c))/(2.*a);
if abs(templ1)>abs(templ2)
newlSet(NBelem(eindex,nindex))=templ1;
else
newlSet(NBelem(eindex,nindex))=templ2;
end
nstat(NBelem(eindex,nindex))=1;
end
end
LSetLocal=newlSet;
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Solve Implicit Porblem to Get Temperature
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function Temp=getTemp(Node,Element,numNodes,numElem,LSet,Bound,Temp,Penalty,rho,dtImp,LSetOld)
K=zeros(numNodes*2,numNodes*2);
M=zeros(numNodes*2,numNodes*2);
MStar=zeros(numNodes*2,numNodes*2);
pforce=zeros(numNodes*2,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(8);
Me=zeros(8);
MeStar=zeros(8);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
theta(icrd)=LSet(Element(e,icrd));
thetaO(icrd)=LSetOld(Element(e,icrd));
end
check=0;
for i=1:3
for j=i+1:4
if sign(theta(1))~=sign(theta(j))
check=1;
end
end
end
if check==1
% possible enriched element
npart=10;
enr=npart*npart;
for sdx=1:npart
for sdy=1:npart
midx=-1.-1./npart+(2./npart)*sdx;
midy=-1.-1./npart+(2./npart)*sdy;
subindex=npart*(sdy-1)+sdx;
gpos=1./(sqrt(3.)*npart);
gx(subindex,1)=midx-gpos;
gx(subindex,2)=midx+gpos;
gx(subindex,3)=midx+gpos;
gx(subindex,4)=midx-gpos;
hx(subindex,1)=midy-gpos;
hx(subindex,2)=midy-gpos;
hx(subindex,3)=midy+gpos;
hx(subindex,4)=midy+gpos;
end
end
% check if int points are on different sides of front
check=0;
for i=1:enr
for 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);
phiO=phi;
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
if i==1 && j==1
sgn=sign(iLS);
else
if sign(iLS)~=sgn
check=1;
end
end
end
end
if check==0
% regular element - fix extra dofs
enr=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;
end
else
% regular element - fix extra dofs
enr=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;
end
for i=1:enr
for 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);
phiO=phi;
iLS=theta(1)*phi(1)+theta(2)*phi(3)+theta(3)*phi(5)+theta(4)*phi(7);
iLSO=thetaO(1)*phi(1)+thetaO(2)*phi(3)+thetaO(3)*phi(5)+thetaO(4)*phi(7);
if iLS<0.
cond=0.;
spec=0.01;
else
cond=1.;
spec=1.;
end
if iLSO<0.
specO=0.01;
else
specO=1.;
end
for iter=1:4
phi(2*iter)=phi(2*iter-1)*(abs(iLS)-abs(theta(iter)));
phiO(2*iter)=phiO(2*iter-1)*(abs(iLSO)-abs(thetaO(iter)));
end
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(iLS)*(phig(1)*theta(1)+phig(3)*theta(2)+phig(5)*theta(3)+phig(7)*theta(4));
diLSh=sign(iLS)*(phih(1)*theta(1)+phih(3)*theta(2)+phih(5)*theta(3)+phih(7)*theta(4));
for iter=1:4
phig(2*iter)=phig(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSg;
phih(2*iter)=phih(2*iter-1)*(abs(iLS)-abs(theta(iter)))+phi(2*iter-1)*diLSh;
end
rjac=zeros(2,2);
for 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);
end
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 ;
for iter=1:8
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=djac;
Ke=Ke+(we*cond*(phix'*phix+phiy'*phiy))/double(enr);
Me=Me+((we*rho*spec*phi'*phi)/dtImp)/double(enr);
MeStar=MeStar+((we*rho*specO*phi'*phiO)/dtImp)/double(enr);
end
end
% Add penalty term and get temp gradient on interface
if enr>1;
count=0;
if sign(theta(1))~=sign(theta(2))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(2)));
xi(count)=f*(crdnx(2)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(2)-crdny(1))+crdny(1);
gi(count)=(2.*xi(count)-(crdnx(1)+crdnx(2)))/(-crdnx(1)+crdnx(2));
hi(count)=-1.;
end
if sign(theta(2))~=sign(theta(3))
count=count+1;
f=abs(theta(2))/(abs(theta(2))+abs(theta(3)));
xi(count)=f*(crdnx(3)-crdnx(2))+crdnx(2);
yi(count)=f*(crdny(3)-crdny(2))+crdny(2);
gi(count)=1.;
hi(count)=(2.*yi(count)-(crdny(2)+crdny(3)))/(-crdny(2)+crdny(3));
end
if sign(theta(3))~=sign(theta(4))
count=count+1;
f=abs(theta(3))/(abs(theta(3))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(3))+crdnx(3);
yi(count)=f*(crdny(4)-crdny(3))+crdny(3);
gi(count)=(2.*xi(count)-(crdnx(4)+crdnx(3)))/(-crdnx(4)+crdnx(3));
hi(count)=1.;
end
if sign(theta(1))~=sign(theta(4))
count=count+1;
f=abs(theta(1))/(abs(theta(1))+abs(theta(4)));
xi(count)=f*(crdnx(4)-crdnx(1))+crdnx(1);
yi(count)=f*(crdny(4)-crdny(1))+crdny(1);
gi(count)=-1.;
hi(count)=(2.*yi(count)-(crdny(1)+crdny(4)))/(-crdny(4)+crdny(1));
end
c=zeros(2,1);
c=(c+1.);
for i=1:2;
G(i,1)=0.25*(1.-gi(i))*(1.-hi(i));
G(i,3)=0.25*(1.+gi(i))*(1.-hi(i));
G(i,5)=0.25*(1.+gi(i))*(1.+hi(i));
G(i,7)=0.25*(1.-gi(i))*(1.+hi(i));
G(i,2)=-G(i,1)*abs(theta(1));
G(i,4)=-G(i,3)*abs(theta(2));
G(i,6)=-G(i,5)*abs(theta(3));
G(i,8)=-G(i,7)*abs(theta(4));
end
pen=Penalty*(G'*G);
pfL=Penalty*G'*c;
% pen=zeros(8);
% pfL=zeros(8,1);
Ke=Ke+pen;
else
pen=zeros(8);
pfL=zeros(8,1);
end
% Assemble Global Matrices
gnum(1)=2*Element(e,1)-1;
gnum(2)=2*Element(e,2)-1;
gnum(3)=2*Element(e,3)-1;
gnum(4)=2*Element(e,4)-1;
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(2*j-1,2*i-1);
K(gnum(j)+1,gnum(i)+1)=K(gnum(j)+1,gnum(i)+1)+Ke(2*j,2*i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(2*j-1,2*i-1);
M(gnum(j)+1,gnum(i)+1)=M(gnum(j)+1,gnum(i)+1)+Me(2*j,2*i);
MStar(gnum(j),gnum(i))=MStar(gnum(j),gnum(i))+MeStar(2*j-1,2*i-1);
MStar(gnum(j)+1,gnum(i)+1)=MStar(gnum(j)+1,gnum(i)+1)+MeStar(2*j,2*i);
end
end
for i=1:4;
pforce(gnum(i))=pforce(gnum(i))+pfL(2*i-1);
pforce(gnum(i)+1)=pforce(gnum(i)+1)+pfL(2*i);
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=MStar*Temp;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:2*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i)+pforce(i);
jindex=0;
for j=1:2*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tempr=(Ared^-1)*RHSred';
iindex=0;
for i=1:2*numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Temp(i)=Tempr(iindex);
end
end
Temp
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Generates the initial level set
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function [LSet]=initialLSet(Node,numNodes)
%centx=4.;
%centy=4.;
%rad=2.1;
%for i=1:numNodes;
% dist=sqrt((Node(i,1)-centx)*(Node(i,1)-centx)+(Node(i,2)-centy)*(Node(i,2)-centy));
% LSet(i)=dist-rad;
%end
for i=1:numNodes;
dist=Node(i,1)-4.6;
LSet(i)=dist;
end
end
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Plot the level set
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
function []=plotLSet(NumX,NumY,delX,delY,LSet)
[X Y]=meshgrid(0:delX:delX*NumX,0:delY:delY*NumY);
Z=zeros(NumX+1,NumY+1);
for i=1:(NumX+1)*(NumY+1)
Z(i)=LSet(i);
end
surf(X,Y,Z)
end

62
Unpublished/XFEM2/Full2D/uelmatinp.inp Normal file
View file

@ -0,0 +1,62 @@
*HEADING
Test for passing abaqus material to UELMAT: transient heat transfer
*RESTART,WRITE,NUMBER INTERVAL=10
*PREPRINT,MODEL=YES
*PART,NAME=part1
*NODE,NSET=NALL
1,0,0,0
2,1,0,0
3,0,1,0
4,1,1,0
5,0,2,0
6,1,2,0
*NSET,NSET=Left
1,3,5
*NSET,NSET=Right
2,4,6
*USER ELEMENT, TYPE=U1, NODES=4, COORDINATES=2,
INTEGRATION=4,TENSOR=TWOD
11,
*ELEMENT,TYPE=U1,ELSET=SOLID
1, 1,2,4,3
2, 3,4,6,5
*END PART
*ASSEMBLY,NAME=A1
*INSTANCE,NAME=I1,PART=PART1
*END INSTANCE
*Nset, nset=Set-6, instance=I1
1,3,5
*Nset, nset=Set-7, instance=I1
2,4,6
*END ASSEMBLY
*UEL PROPERTY, ELSET=I1.SOLID, MATERIAL=MAT_THERM
**************************************
***************************************
*MATERIAL,NAME=MAT_THERM
*CONDUCTIVITY
1.0,
*SPECIFIC HEAT
1.,
*DENSITY
1.,
*Initial Conditions, type=TEMPERATURE
Set-6, 1.,0.
*Initial Conditions, type=TEMPERATURE
Set-7, 0.,0.
*STEP
*HEAT TRANSFER, DELTMX=1.
0.1,1.0,,0.1
**
*BOUNDARY
Set-6,11,11,1.
*OUTPUT,FIELD,freq=1
*ELEMENT OUTPUT,ELSET=I1.SOLID
HFL,
*NODE OUTPUT,NSET=I1.NALL
NT,
*OUTPUT,HISTORY
*ELEMENT OUTPUT,ELSET=I1.SOLID
HFL,
*NODE OUTPUT,NSET=I1.NALL
NT11,
*END STEP

128
Unpublished/XFEM2/GetF.m Normal file
View file

@ -0,0 +1,128 @@
function [] = GetF()
% set up grid
gd=0.;
numElem=4;
eLen=0.25;
for i=1:numElem+1
ndCrd(i)=gd;
gd=gd+eLen;
end
for i=1:numElem
elemNod(i,1)=i;
elemNod(i,2)=i+1;
end
% Initial level set
dpos=0.1;
for i=1:numElem+1
lSet(i)=sign(ndCrd(i)-dpos)*abs(dpos-ndCrd(i));
end
lSet'
for tstep=1:120
% Velocity BC
F=zeros(numElem+1,1);
for i=1:numElem
if sign(lSet(elemNod(i,1)))~=sign(lSet(elemNod(i,2)))
F(elemNod(i,1))= 0.0005;
F(elemNod(i,2))= 0.0005;
end
end
% Assemble 'Stiffness' Matrices
A=zeros(numElem+1);
for i=1:numElem
pos(1)=-1/sqrt(3);
pos(2)=1/sqrt(3);
AfL=zeros(2);
AfLGLS=zeros(2);
for j=1:2
shp(1)=(1-pos(j))/2.;
shp(2)=(1+pos(j))/2.;
dshp(1)=-0.5;
dshp(2)=0.5;
rset=shp(1)*lSet(elemNod(i,1))+shp(2)*lSet(elemNod(i,2));
dls=dshp(1)*lSet(elemNod(i,1))+dshp(2)*lSet(elemNod(i,2));
AfL=AfL+shp'*sign(rset)*(dls*dshp);
AfLGLS=AfLGLS+(dshp'*dls)*(0.25/abs(dls))*(dls*dshp);
end
for k=1:2;
for j=1:2;
A(elemNod(i,j),elemNod(i,k))=A(elemNod(i,j),elemNod(i,k))+AfL(j,k)+AfLGLS(j,k);
end
end
end
% Apply BCs
RHS=zeros(numElem+1,1);
Sub=A*F;
iindex=0;
for i=1:numElem+1
if F(i)==0.
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
Fred=0.;
jindex=0;
for j=1:numElem+1
if F(j)==0.
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
% Solve for Fred
Fred=(Ared^-1)*RHSred';
% Get F
iindex=0;
for i=1:numElem+1
if F(i)==0.
iindex=iindex+1;
F(i)=Fred(iindex);
end
end
% Update level set
mMat=zeros(numElem+1);
mMatGLS=zeros(numElem+1);
f1=zeros(numElem+1,1);
f2=zeros(numElem+1,1);
f3=zeros(numElem+1,1);
h=0.25;
visc=0.000;
for i=1:numElem
pos(1)=-1/sqrt(3);
pos(2)=1/sqrt(3);
mMatL=zeros(2);
mMatGLSL=zeros(2);
f1L=zeros(2,1);
f2L=zeros(2,1);
f3L=zeros(2,1);
for j=1:2
shp(1)=(1-pos(j))/2.;
shp(2)=(1+pos(j))/2.;
dshp(1)=-0.5;
dshp(2)=0.5;
Floc=shp(1)*F(elemNod(i,1))+shp(2)*F(elemNod(i,2));
rset=shp(1)*lSet(elemNod(i,1))+shp(2)*lSet(elemNod(i,2));
dls=dshp(1)*lSet(elemNod(i,1))+dshp(2)*lSet(elemNod(i,2));
mMatL=mMatL+shp'*shp;
mMatGLSL=mMatGLSL+((dshp'*(dls/abs(dls)))*Floc*(h/abs(Floc)))*shp;
f1L=f1L+shp'*Floc*abs(dls);
f2L=f2L+(dshp'*(dls/abs(dls))*Floc)*(h/abs(Floc))*Floc*abs(dls);
vs=h*((abs(visc+Floc*abs(dls)))/(abs(Floc*dls)+h));
f3L=f3L+vs*dshp'*dls;
end
for k=1:2;
for j=1:2;
mMat(elemNod(i,j),elemNod(i,k))=mMat(elemNod(i,j),elemNod(i,k))+mMatL(j,k);
mMatGLS(elemNod(i,j),elemNod(i,k))=mMatGLS(elemNod(i,j),elemNod(i,k))+mMatGLSL(j,k);
end
f1(elemNod(i,k))=f1(elemNod(i,k))+f1L(k);
f2(elemNod(i,k))=f2(elemNod(i,k))+f2L(k);
f3(elemNod(i,k))=f3(elemNod(i,k))+f3L(k);
end
end
dt=0.01;
lSet=lSet-((((mMat+mMatGLS)^-1)/dt)*(f1+f2+f3))';
lSet'
end

237
Unpublished/XFEM2/JQuad.for Normal file
View file

@ -0,0 +1,237 @@
c***********************************************************
subroutine uelmat(rhs,amatrx,svars,energy,ndofel,nrhs,
1 nsvars,props,nprops,coords,mcrd,nnode,u,du,
2 v,a,jtype,time,dtime,kstep,kinc,jelem,params,
3 ndload,jdltyp,adlmag,predef,npredf,lflags,mlvarx,
4 ddlmag,mdload,pnewdt,jprops,njpro,period,
5 materiallib)
c
include 'aba_param.inc'
C
dimension rhs(mlvarx,*), amatrx(ndofel, ndofel), props(*),
1 svars(*), energy(*), coords(mcrd, nnode), u(ndofel),
2 du(mlvarx,*), v(ndofel), a(ndofel), time(2), params(*),
3 jdltyp(mdload,*), adlmag(mdload,*), ddlmag(mdload,*),
4 predef(2, npredf, nnode), lflags(*), jprops(*)
parameter (zero=0.d0, dmone=-1.0d0, one=1.d0, four=4.0d0,
1 fourth=0.25d0,gaussCoord=0.577350269d0)
parameter (ndim=2, ndof=2, nshr=1,nnodemax=4,
1 ntens=4, ninpt=4, nsvint=4)
c
dimension stiff(ndof*nnodemax,ndof*nnodemax),
1 force(ndof*nnodemax), shape(nnodemax), dshape(ndim,nnodemax),
2 xjac(ndim,ndim),xjaci(ndim,ndim), bmat(nnodemax*ndim),
3 statevLocal(nsvint),stress(ntens), ddsdde(ntens, ntens),
4 stran(ntens), dstran(ntens), wght(ninpt)
c
dimension predef_loc(npredf),dpredef_loc(npredf),
1 defGrad(3,3),utmp(3),xdu(3),stiff_p(3,3),force_p(3)
dimension coord24(2,4),coords_ip(3)
data coord24 /dmone, dmone,
2 one, dmone,
3 one, one,
4 dmone, one/
c
data wght /one, one, one, one/
c*************************************************************
c U1 = first-order, plane strain, full integration
c*************************************************************
c define mass matrix as identity at start of analysis
if (lflags(3).eq.4) then
amatrx = zero
do i=1, ndofel
amatrx(i,i) = one
end do
goto 999
end if
c properties
thickness = 0.1d0
c initialize rhs and k
rhs = zero
amatrx = zero
c loop over integration points
do kintk = 1, ninpt
c determine gauss point in local sys (g,h)
c takes form: [4 3]
c [1 2]
g = coord24(1,kintk)*gaussCoord
h = coord24(2,kintk)*gaussCoord
c shape functions
shape(1) = (one - g)*(one - h)/four
shape(2) = (one + g)*(one - h)/four
shape(3) = (one + g)*(one + h)/four
shape(4) = (one - g)*(one + h)/four
c derivative d(Ni)/d(g)
dshape(1,1) = -(one - h)/four
dshape(1,2) = (one - h)/four
dshape(1,3) = (one + h)/four
dshape(1,4) = -(one + h)/four
c derivative d(Ni)/d(h)
dshape(2,1) = -(one - g)/four
dshape(2,2) = -(one + g)/four
dshape(2,3) = (one + g)/four
dshape(2,4) = (one - g)/four
c compute global coordinates of the ip
coords_ip = zero
do k1=1,nnode
do k2=1,mcrd
coords_ip(k2)=coords_ip(k2)+shape(k1)*coords(k2,k1)
end do
end do
c form b-matrix
djac = one
xjac = zero
xjaci = zero
c Get Jacobian
do inod= 1, nnode
do idim = 1, ndim
do jdim = 1, ndim
xjac(jdim,idim) = xjac(jdim,idim) +
1 dshape(jdim,inod)*coords(idim,inod)
end do
end do
end do
c Get Det of Jacobian
djac = xjac(1,1)*xjac(2,2) - xjac(1,2)*xjac(2,1)
if (djac .gt. zero) then
! jacobian is positive - invert it
xjaci(1,1) = xjac(2,2)/djac
xjaci(2,2) = xjac(1,1)/djac
xjaci(1,2) = -xjac(1,2)/djac
xjaci(2,1) = -xjac(2,1)/djac
else
! negative or zero jacobian - reduce time inc.
write(7,*)'WARNING: element',jelem,'has neg. Jacobian'
pnewdt = fourth
endif
if (pnewdt .lt. pnewdtLocal) pnewdtLocal = pnewdt
c Build B matrix
bmat = zero
do inod = 1, nnode
do ider = 1, ndim
do idim = 1, ndim
irow = idim + (inod - 1)*ndim
bmat(irow) = bmat(irow) +
1 xjaci(idim,ider)*dshape(ider,inod)
end do
end do
end do
c get strain inc
dstran(i) = zero
c set deformation gradient to Identity matrix
defGrad = zero
do k1=1,3
defGrad(k1,k1) = one
end do
c compute incremental strains
do nodi = 1, nnode
incr_row = (nodi - 1)*ndof
do i = 1, ndof
xdu(i)= du(i + incr_row,1)
utmp(i) = u(i + incr_row)
end do
dNidx = bmat(1+(nodi-1)*ndim)
dNidy = bmat(2+(nodi-1)*ndim)
dstran(1) = dstran(1)+dNidx*xdu(1)
dstran(2) = dstran(2)+dNidy*xdu(2)
dstran(4) = dstran(4)+dNidy*xdu(1)+dNidx*xdu(2)
c deformation gradient (prob not required for umat)
defGrad(1,1) = defGrad(1,1) + dNidx*utmp(1)
defGrad(1,2) = defGrad(1,2) + dNidy*utmp(1)
defGrad(2,1) = defGrad(2,1) + dNidx*utmp(2)
defGrad(2,2) = defGrad(2,2) + dNidy*utmp(2)
end do
c call constitutive routine
isvinc= (kintk-1)*nsvint
c prepare arrays for entry into material routines
do i = 1, nsvint
statevLocal(i)=svars(i+isvinc)
end do
c state variables
do k1=1,ntens
stran(k1) = statevLocal(k1)
stress(k1) = zero
end do
do i=1, ntens
do j=1, ntens
ddsdde(i,j) = zero
end do
ddsdde(i,j) = one
enddo
c compute characteristic element length
celent = sqrt(djac*dble(ninpt))
dvmat = djac*thickness
c
dvdv0 = one
call material_lib_mech(materiallib,stress,ddsdde,
1 stran,dstran,kintk,dvdv0,dvmat,defGrad,
2 predef_loc,dpredef_loc,npredf,celent,coords_ip)
c
do k1=1,ntens
statevLocal(k1) = stran(k1) + dstran(k1)
end do
isvinc= (kintk-1)*nsvint
c update element state variables
do i = 1, nsvint
svars(i+isvinc)=statevLocal(i)
end do
c form stiffness matrix and internal force vector
dNjdx = zero
dNjdy = zero
force = zero
stiff = zero
dvol= wght(kintk)*djac
do nodj = 1, nnode
incr_col = (nodj - 1)*ndof
dNjdx = bmat(1+(nodj-1)*ndim)
dNjdy = bmat(2+(nodj-1)*ndim)
force_p(1) = dNjdx*stress(1) + dNjdy*stress(4)
force_p(2) = dNjdy*stress(2) + dNjdx*stress(4)
do jdof = 1, ndof
jcol = jdof + incr_col
force(jcol) = force(jcol)+force_p(jdof)*dvol
end do
do nodi = 1, nnode
incr_row = (nodi -1)*ndof
dNidx = bmat(1+(nodi-1)*ndim)
dNidy = bmat(2+(nodi-1)*ndim)
stiff_p(1,1) = dNidx*ddsdde(1,1)*dNjdx
& + dNidy*ddsdde(4,4)*dNjdy
& + dNidx*ddsdde(1,4)*dNjdy
& + dNidy*ddsdde(4,1)*dNjdx
stiff_p(1,2) = dNidx*ddsdde(1,2)*dNjdy
& + dNidy*ddsdde(4,4)*dNjdx
& + dNidx*ddsdde(1,4)*dNjdx
& + dNidy*ddsdde(4,2)*dNjdy
stiff_p(2,1) = dNidy*ddsdde(2,1)*dNjdx
& + dNidx*ddsdde(4,4)*dNjdy
& + dNidy*ddsdde(2,4)*dNjdy
& + dNidx*ddsdde(4,1)*dNjdx
stiff_p(2,2) = dNidy*ddsdde(2,2)*dNjdy
& + dNidx*ddsdde(4,4)*dNjdx
& + dNidy*ddsdde(2,4)*dNjdx
& + dNidx*ddsdde(4,2)*dNjdy
do jdof = 1, ndof
icol = jdof + incr_col
do idof = 1, ndof
irow = idof + incr_row
stiff(irow,icol) = stiff(irow,icol) +
& stiff_p(idof,jdof)*dvol
end do
end do
end do
end do
c assemble rhs and lhs
do k1=1, ndof*nnode
rhs(k1, 1) = rhs(k1, 1) - force(k1)
do k2=1, ndof*nnode
amatrx(k1, k2) = amatrx(k1, k2) + stiff(k1,k2)
end do
end do
end do ! end loop on material integration points
pnewdt = pnewdtLocal
c
999 continue
c
return
end

293
Unpublished/XFEM2/JQuadX.for Normal file
View file

@ -0,0 +1,293 @@
c User subroutine UEL XFEM
subroutine uel(rhs,amatrx,svars,energy,ndofel,nrhs,nsvars,
1 props,nprops,coords,mcrd,nnode,u,du,v,a,jtype,time,dtime,
1 kstep,kinc,jelem,params,ndload,jdltyp,adlmag,predef,npredf,
1 lflags,mlvarx,ddlmag,mdload,pnewdt,jprops,njprop,period)
c
include 'aba_param.inc'
c ABAQUS defined variables:
dimension rhs(mlvarx,*), amatrx(ndofel,ndofel), props(*),
1 svars(nsvars), energy(8), coords(mcrd,nnode), u(ndofel),
1 du(mlvarx,*), v(ndofel), a(ndofel), time(2), params(*),
1 jdltyp(mdload,*), adlmag(mdload,*), ddlmag(mdload,*),
1 predef(2,npredf,nnode), lflags(*), jprops(*)
c
character*256 outdir
integer lenoutdir
integer i,j,k,pss,orderq(3),gint,flag,dimens
integer ncracks,maxncp,nelmx,nnodx,typexe(nnode),ix(nnode)
integer,parameter :: mpg=1650
integer,allocatable:: typex(:,:),ncp(:)
real*8 e, nu
real*8 f(ndofel)
real*8 sg(3,mpg),xypg(2,mpg),xe(8),ye(8),xyc0(2),xycprev(2)
real*8, allocatable:: xyc(:,:,:),dist(:,:),elemgg(:,:)
real*8, allocatable:: batg(:,:),dbatg(:,:),jatg(:)
c
c Read real and integer properties set at the ABAQUS input file
e = props(1)
nu = props(2)
pss = jprops(1)
orderq(1) = jprops(2)
orderq(2) = jprops(3)
orderq(3) = jprops(4)
dimens = jprops(5)
c Read the working directory
call getoutdir(outdir,lenoutdir)
c read number of cracks, max number of crack path points,
c number of enriched elements and enriched nodes.
open(68,file=outdir(1:lenoutdir)//’\files\gginfox’)
read(68,*) ncracks,maxncp,nelmx,nnodx
close(68)
c Allocate dimensions
allocate (typex(nnodx,2), ncp(ncracks))
allocate (xyc(ncracks,maxncp,2), dist(nnodx,3), elemgg(nelmx,10))
c read coordinates of path points for each crack
open(68,file=outdir(1:lenoutdir)//’\files\ggxyc’)
do i=1,ncracks
read(68,*) ncp(i)
do j=1,ncp(i)
read(68,*) (xyc(i,j,k),k=1,2)
end do
end do
close(68)
c Read list of enriched nodes, type of enrichment and distances
open(68,file=outdir(1:lenoutdir)//’\files\ggnodex’)
do i=1,nnodx
read(68,*) (typex(i,j),j=1,2),(dist(i,j),j=2,3)
dist(i,1)=typex(i,1)
end do
close(68)
c read list of enriched elements, type of enrichment and intersection points
open(68,file=outdir(1:lenoutdir)//’\files\ggelemx’)
do i=1,nelmx
read(68,*) (elemgg(i,j),j=1,10)
end do
close(68)
c call initializing routines for matrix and vectors
call initializem(rhs,ndofel,nrhs)
call initializem(amatrx,ndofel,ndofel)
call initializev(energy,8)
call initializev(svars,nsvars)
c verification of element type (type=12 for enriched element)
if (jtype.eq.12) then
c **************************************
c * 4 node enriched element with *
c * up to 12 dof/node for x-fem *
c **************************************
if (lflags(1).eq.71) then
c coupled thermal-stress, steady state analysis
if (lflags(3).eq.1) then
c Routine that defines the location of integration points according to
c the appropriate subdivision. This enables to know the total number of
c integration points for the current element, stored in gint, and whether
c the element is subdivided for integration (flag=1) or not.
CALL int2d_X(JELEM,NelmX,ElemGG,MCRD,NNODE,COORDS,orderQ,
1 NCracks,maxNCP,NCP,XYC,gint,sg,Xe,Ye,flag,mpg,xypg,
1 XYC0,XYCPrev)
c Allocate dimensions once the total number of integration points gint is known
allocate(batg(3*gint,ndofel),dbatg(3*gint,ndofel),jatg(gint))
call initializem(batg,3*gint,ndofel)
call initializem(dbatg,3*gint,ndofel)
call initializev(jatg,gint)
c Search of the enrichment type for the nodes of the current element.
c The keys to the enrichment types are stored in the element vector TypeXe
call typexelement(outdir,lenoutdir,jelem,nnode,nelmx,ix,typexe)
c element stiffness matrix computation, stored in amatrx
call k_u12(e,nu,amatrx,ndofel,nnode,dimens,mcrd,
coords,pss,nnodx,ix,typexe,dist,xyc0,xycprev,
gint,sg,xe,ye,flag,batg,dbatg,jatg)
c Routine that multiplies AMATRX times U to obtain the force vector F
c at the end of the current increment
call mult_v(amatrx,ndofel,ndofel,u,f,ndofel)
c compute the residual force vector
do i=1,ndofel
rhs(i,1) = rhs(i,1) - f(i)
end do
c Compute stresses at Gauss points for post-processing purposes
c Store them as SVARS for output to the results file (.fil)
call svars_u12(jtype,jelem,svars,nsvars,u,ndofel,batg,
1 dbatg,jatg,gint,mpg,xypg)
end if
end if
end if
return
end
C Element stiffness matrix. Subroutine: K U12
subroutine k_u12(e,nu,amatrx,ndofel,nnode,dimens,mcrd,
1 COORDS,PSS,NnodX,ix,TypeXe,Dist,XYC0,XYCPrev,
1 gint,sg,Xe,Ye,flag,BatG,DBatG,JatG)
implicit none
integer ndofel,nnode,dimens,mcrd,pss,nnodx,gint,flag,pos
integer l,i,j,kk,typexe(nnode),ix(nnode)
real*8 e,nu,dist(nnodx,3),sg(3,*)
real*8 amatrx(ndofel,ndofel),xyc0(2),xycprev(2)
real*8 xe(2*nnode),ye(2*nnode),coords(mcrd,nnode),xl(dimens,nnode)
real*8 xsj(gint),shp(3,4)
real*8 dnf(nnode,2,4),fnode(nnode,4),h,hnode(nnode)
real*8 b(3,ndofel), db(3,ndofel), bt(ndofel,3), d(3,3)
real*8 batg(3*gint,ndofel),dbatg(3*gint,ndofel),jatg(gint)
logical nodetype1,nodetype2
c NOTES:
c Routine shapef2D is called to compute standard shape functions,
c derivatives and jacobian at integration points. This routine outputs:
c shp(3,*) - Shape functions and derivatives at point
c shp(1,i) = dN_i/dx = dN_i/dx1
c shp(2,i) = dN_i/dy = dN_i/dx2
c shp(3,i) = N_i
c xsj - Jacobian determinant at point
c Local coordinates of integration points are passed in sg(1,*), sg(2,*)
c Integration weights are passed in sg(3,*)
c Initialize AMATRX and logical variables
call initializem(amatrx,ndofel,ndofel)
NodeType1=.false.
NodeType2=.false.
c Reduce info passed thru COORDS (3D) to xl (2D)
do i=1,dimens
do j=1,nnode
xl(i,j)=coords(i,j)
end do
end do
c Define constitutive stress-strain elastic matrix
call calc_d(pss,d,e,nu)
c Specify the type of nodal enrichment
do i=1,nnode
if (typexe(i).eq.1) then
nodetype1=.true.
elseif (typexe(i).eq.2) then
nodetype2=.true.
end if
end do
c Numerical integration loop over gint integration points
DO l = 1,gint
c Compute shape functions, derivatives and jacobian at integration point
call shapef2d(sg(1,l),xl,shp,xsj(l),dimens,nnode,ix,.false.)
if (flag.eq.1) then !element is subdivided for integration
xsj(l) = sg(3,l) !the integration weight includes the jacobian
else !element is not subdivided. standard integration
xsj(l) = xsj(l)*sg(3,l)
endif
c Value of the Heaviside function at integration point
c (This call is also used to store the values of H
c at nodes of the element for modified enrichment)
if (nodetype1) then
call heaviside(nnodx,dist,nnode,ix,shp,h,hnode)
endif
c Derivatives of shape functions Ni times enrichment functions Fj at integration point
c (This call is also used to compute the derivatives of shape functions Ni times
c enrichment functions Fj at nodes of the element for modified enrichment)
if (nodetype2) then
call fcracktip(xyc0,xycprev,shp,xe,ye,dnf,fnode)
endif
c STIFFNESS MATRIX COMPUTATION:
c Assembly of element matrix B (denoted as B) at integration point
call initializem(b,3,ndofel)
pos=1
c loop over nodes
do i= 1,nnode
c Contribution to B of derivatives of standard shape functions
B(1,Pos) = shp(1,i)
B(2,Pos+1)= shp(2,i)
B(3,Pos) = shp(2,i)
B(3,Pos+1)= shp(1,i)
c Contribution to B of derivatives of shape functions times Heaviside function
if (typexe(i).eq.1) then
b(1,2+pos) = shp(1,i)*(h-hnode(i))
b(2,3+pos) = shp(2,i)*(h-hnode(i))
b(3,2+pos) = shp(2,i)*(h-hnode(i))
b(3,3+pos) = shp(1,i)*(h-hnode(i))
c Contribution to B of derivatives of shape functions times crack tip functions
elseif(typexe(i).eq.2) then
do kk= 1,4
b(1,2*kk+2+pos)= dnf(i,1,kk)-shp(1,i)*fnode(i,kk)
b(2,2*kk+3+pos)= dnf(i,2,kk)-shp(2,i)*fnode(i,kk)
b(3,2*kk+2+pos)= dnf(i,2,kk)-shp(2,i)*fnode(i,kk)
b(3,2*kk+3+pos)= dnf(i,1,kk)-shp(1,i)*fnode(i,kk)
end do
end if
Pos=Pos+12 !Each node has 12 dof
end do ! i = end loop over element nodes
db=matmul(d,b) ! matrix d*b
bt=transpose(b) ! b transpose
c Integration of BT*D*B
amatrx= amatrx + matmul(bt,db)*xsj(l)
c store information at each integration point for further post-processing
do i=1,3
do j=1,ndofel
batg(3*(l-1)+i,j)=b(i,j)
dbatg(3*(l-1)+i,j)=db(i,j)
end do
end do
jatg(l)=xsj(l)
end do ! l = end loop for each integration point
return
end
c
SUBROUTINE SVARS_U12(JTYPE,JELEM,SVARS,NSVARS,U,Dof,BatG,DBatG,
* JatG,gint,mpg,xypg)
c Calculates and/or stores the following magnitudes at the element integration points,
c storing them in SVARS: strains, stresses, strain energy density, dv/dx, du/dy, jacobian,
c dNi/dx, dNi/dy, global coordinates of integration points.
IMPLICIT NONE
INTEGER i,j,k,NSVARS, Dof, gint, JTYPE,JELEM,mpg
REAL*8 SVARS(NSVARS), U(Dof),BatG(3*gint,Dof),DBatG(3*gint,Dof)
REAL*8 JatG(gint),B(3,Dof),DB(3,Dof),Bdvdx(3,Dof),Bdudy(3,Dof)
REAL*8 EPS(3),SIG(3),W,dvdx(3),dudy(3),JAC,xypg(2,mpg)
c &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
39
c &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
c First value stored in SVARS is the total number of integration points
c of the enriched element
SVARS(1)=gint
DO i=1,gint
JAC=JatG(i)
DO k=1,3
DO j=1,Dof
B(k,j)=BatG(3*(i-1)+k,j)
Bdvdx(k,j)=B(k,j) ! For computation of dv/dx
Bdudy(k,j)=B(k,j) ! For computation of du/dy
DB(k,j)=DBatG(3*(i-1)+k,j)
END DO
END DO
CALL MULT_V(B,3,Dof,U,EPS,3) ! Compute strains EPS
CALL MULT_V(DB,3,Dof,U,SIG,3) ! Compute stresses SIG
W=0.5d0*(EPS(1)*SIG(1)+EPS(2)*SIG(2)+EPS(3)*SIG(3))
c Computation of dv/dx & du/dy
c Set to zero positions in the 3rd row of B associated with dN/dy
DO j=1,Dof,2
Bdvdx(3,j)=0.0d0
END DO
CALL MULT_V(Bdvdx,3,Dof,U,dvdx,3) !compute dv/dx, stored in dvdx(3)
c Set to zero positions in the 3rd row of B associated with dN/dx
DO j=2,Dof,2
Bdudy(3,j)=0.0d0
END DO
CALL MULT_V(Bdudy,3,Dof,U,dudy,3) !compute du/dy, stored in dudy(3)
c Store in SVARS the following information at integration points
SVARS(1+20*(i-1)+1)=EPS(1)
SVARS(1+20*(i-1)+2)=EPS(2)
SVARS(1+20*(i-1)+3)=EPS(3)
SVARS(1+20*(i-1)+4)=SIG(1)
SVARS(1+20*(i-1)+5)=SIG(2)
SVARS(1+20*(i-1)+6)=SIG(3)
SVARS(1+20*(i-1)+7)=W
SVARS(1+20*(i-1)+8)=dvdx(3)
SVARS(1+20*(i-1)+9)=dudy(3)
SVARS(1+20*(i-1)+10)=JAC ! Jacobian includes integration weight
c Store in SVARS the shape functions derivatives dNi/dx, dNi/dy for external computation
c of dq/dx, dq/dy (used in domain interaction integrals).
c (we take them from the positions associated with the standard dofs)
SVARS(1+20*(i-1)+11)=B(1,1)
SVARS(1+20*(i-1)+12)=B(1,13)
SVARS(1+20*(i-1)+13)=B(1,25)
SVARS(1+20*(i-1)+14)=B(1,37)
SVARS(1+20*(i-1)+15)=B(2,2)
SVARS(1+20*(i-1)+16)=B(2,14)
SVARS(1+20*(i-1)+17)=B(2,26)
SVARS(1+20*(i-1)+18)=B(2,38)
Store in SVARS the global coordinates of integration points
SVARS(1+20*(i-1)+19)=xypg(1,i)
SVARS(1+20*(i-1)+20)=xypg(2,i)
END DO !i loop over all integration points of the element
RETURN
END

70
Unpublished/XFEM2/JTruss.for Normal file
View file

@ -0,0 +1,70 @@
subroutine uel(rhs,amatrx,svars,energy,ndofel,nrhs,nsvars,
1 props,nprops,coords,mcrd,nnode,u,du,v,a,jtype,time,
2 dtime,kstep,kinc,jelem,params,ndload,jdltyp,adlmag,
3 predef,npredf,lflags,mlvarx,ddlmag,mdload,pnewdt,
4 jprops,njprop,period)
c
include 'aba_param.inc'
parameter ( zero = 0.d0, half = 0.5d0, one = 1.d0 )
c
c This is a linear truss element for Abaqus/Standard
c general static analysis in 1D space (aligned to x-axis) only.
dimension rhs(mlvarx,*),amatrx(ndofel,ndofel),
1 svars(nsvars),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(*),
5 jprops(*)
c
c assign section properties
area = props(1)
e = props(2)
anu = props(3)
rho = props(4)
c calculate stiffness and mass
alen = abs(coords(1,2)-coords(1,1))
ak = area*e/alen
am = half*area*rho*alen
c Initialize Arrays
rhs = zero
amatrx = zero
if (lflags(3).eq.1) then
C Stiffness and Force
C Get Stiffness Matrix
amatrx(1,1) = ak
amatrx(4,4) = ak
amatrx(1,4) = -ak
amatrx(4,1) = -ak
c Get Internal Contrib to Residual Force
rhs(1,1) = -ak*(u(1)-u(4))
rhs(4,1) = -ak*(u(4)-u(1))
c Get External Contrib to Residual Force
do kdload = 1, ndload
if (jdltyp(kdload,1).eq.1001) then
rhs(4,1) = rhs(4,1)+adlmag(kdload,1)
end if
end do
else if (lflags(3).eq.2) then
c Stiffness
amatrx(1,1) = ak
amatrx(4,4) = ak
amatrx(1,4) = -ak
amatrx(4,1) = -ak
else if (lflags(3).eq.4) then
c Mass
do k1 = 1, ndofel
amatrx(k1,k1) = am
end do
else if (lflags(3).eq.5) then
print *,'oops'
else if (lflags(3).eq.6) then
C Mass and Force
do k1 = 1, ndofel
amatrx(k1,k1) = am
end do
rhs(1,1) = -ak*(u(1)-u(4))
rhs(4,1) = -ak*(u(4)-u(1))
END IF
c
return
end

147
Unpublished/XFEM2/S2D.asv Normal file
View file

@ -0,0 +1,147 @@
function [] = S2D()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=3;
NumY=3;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j);
Element(index,4)=i+(NumX+1)*(j)+1;
end
end
numElem=(NumX)*(NumY);
% Define Section Properties
rho=1.;
cond=1.;
spec=1.;
% initial interface position
dpos=0.25;
% Initial temperatures
Tnew=zeros(numNodes,1);
Bound=zeros(numNodes,1);
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(Element(e,n))=1.;
Bound(Element(e,n))=1.;
end
end
end
% Define Time Step
dtime=0.05;
tsteps=1;
% Loop through time steps
for ts=1:tsteps
K=zeros(numNodes,numNodes);
M=zeros(numNodes,numNodes);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4);
Me=zeros(4);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
end
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
% Loop Through Int Points
for i=1:4;
g=gx(i);
h=hx(i);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
phih(1)=0.25*-(1.-g);
phih(2)=0.25*-(1.+g);
phih(3)=0.25*(1.+g);
phih(4)=0.25*(1.-g);
rjac=zeros(2,2);
for iter=1:4
rjac(1,1)=rjac(1,1)+phig(iter)*crdnx(iter);
rjac(1,2)=rjac(1,2)+phig(iter)*crdny(iter);
rjac(2,1)=rjac(2,1)+phih(iter)*crdnx(iter);
rjac(2,2)=rjac(2,2)+phih(iter)*crdny(iter);
end
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 ;
for iter=1:4
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Assemble Global Matrices
gnum(1)=Element(e,1);
gnum(2)=Element(e,2);
gnum(3)=Element(e,3);
gnum(4)=Element(e,4);
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(j,i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(j,i);
end
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=M*Tnew;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
jindex=0;
for j=1:numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(Ared^-1)*RHSred';
iindex=0;
for i=1:numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end

146
Unpublished/XFEM2/S2D.m Normal file
View file

@ -0,0 +1,146 @@
function [] = S2D()
% MATLAB based 2-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Mesh
NumX=10;
NumY=1;
delX=1.;
delY=1.;
for j=1:NumY+1
for i=1:NumX+1
index=i+(NumX+1)*(j-1);
Node(index,1)=single((i-1.))*delX;
Node(index,2)=single((j-1.))*delY;
end
end
numNodes=(NumX+1)*(NumY+1);
for j=1:NumY
for i=1:NumX
index=i+NumX*(j-1);
Element(index,1)=i+(NumX+1)*(j-1);
Element(index,2)=i+(NumX+1)*(j-1)+1;
Element(index,3)=i+(NumX+1)*(j)+1;
Element(index,4)=i+(NumX+1)*(j);
end
end
numElem=(NumX)*(NumY);
% Define Section Properties
rho=1.;
cond=1.;
spec=1.;
% initial interface position
dpos=0.25;
% Initial temperatures
Tnew=zeros(numNodes,1);
Bound=zeros(numNodes,1);
for e=1:numElem
for n=1:4
crdn=Node(Element(e,n),1);
if crdn<=dpos
Tnew(Element(e,n))=1.;
Bound(Element(e,n))=1.;
end
end
end
% Define Time Step
dtime=0.1;
tsteps=10;
% Loop through time steps
for ts=1:tsteps
K=zeros(numNodes,numNodes);
M=zeros(numNodes,numNodes);
% Loop Through Elements
for e=1:numElem
Ke=zeros(4);
Me=zeros(4);
for icrd=1:4;
crdnx(icrd)=Node(Element(e,icrd),1);
crdny(icrd)=Node(Element(e,icrd),2);
end
gpos=1/sqrt(3.);
gx(1)=-gpos;
gx(2)=gpos;
gx(3)=gpos;
gx(4)=-gpos;
hx(1)=-gpos;
hx(2)=-gpos;
hx(3)=gpos;
hx(4)=gpos;
% Loop Through Int Points
for i=1:4;
g=gx(i);
h=hx(i);
phi(1)=0.25*(1.-g)*(1.-h);
phi(2)=0.25*(1.+g)*(1.-h);
phi(3)=0.25*(1.+g)*(1.+h);
phi(4)=0.25*(1.-g)*(1.+h);
phig(1)=0.25*-(1.-h);
phig(2)=0.25*(1.-h);
phig(3)=0.25*(1.+h);
phig(4)=0.25*-(1.+h);
phih(1)=0.25*-(1.-g);
phih(2)=0.25*-(1.+g);
phih(3)=0.25*(1.+g);
phih(4)=0.25*(1.-g);
rjac=zeros(2,2);
for iter=1:4
rjac(1,1)=rjac(1,1)+phig(iter)*crdnx(iter);
rjac(1,2)=rjac(1,2)+phig(iter)*crdny(iter);
rjac(2,1)=rjac(2,1)+phih(iter)*crdnx(iter);
rjac(2,2)=rjac(2,2)+phih(iter)*crdny(iter);
end
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 ;
for iter=1:4
phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter);
phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter);
end
we=djac;
Ke=Ke+we*cond*(phix'*phix+phiy'*phiy);
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Assemble Global Matrices
gnum(1)=Element(e,1);
gnum(2)=Element(e,2);
gnum(3)=Element(e,3);
gnum(4)=Element(e,4);
for i=1:4;
for j=1:4;
K(gnum(j),gnum(i))=K(gnum(j),gnum(i))+Ke(j,i);
M(gnum(j),gnum(i))=M(gnum(j),gnum(i))+Me(j,i);
end
end
end
%Remove inactive DOFs(Reduce Matrices)
RHS=M*Tnew;
A=K+M;
Sub=A*Bound;
iindex=0;
for i=1:numNodes;
if Bound(i)==0.;
iindex=iindex+1;
RHSred(iindex)=RHS(i)-Sub(i);
jindex=0;
for j=1:numNodes;
if Bound(j)==0.;
jindex=jindex+1;
Ared(iindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(Ared^-1)*RHSred';
iindex=0;
for i=1:numNodes;
if Bound(i)==0.;
iindex=iindex+1;
Tnew(i)=Tnewr(iindex);
end
end
Tnew
end

80
Unpublished/XFEM2/UEL_TRANHT.for Normal file
View file

@ -0,0 +1,80 @@
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(9),gwei(9),phi(8),phix(8),phic(8),stiffk(2,2)
dimension stiffm(2,2)
c
c print *,u(1),u(2),du(1,nhrs),du(2,nhrs),time(1),lflags(3)
c material property definition
rho = 1.
spec = 1.
conduc = 1.
c initialization (nrhs=1)
do k1=1,ndofel
rhs(k1,nrhs)=0.
do k2=1,ndofel
amatrx(k2,k1)=0.
stiffk(k2,k1)=0.
stiffm(k2,k1)=0.
enddo
enddo
if (lflags(3).eq.4) return
c transient analysis
if (lflags(1).eq.33) then
c determine gauss point locations
gpx(1)=-1./sqrt(3.)
gpx(2)=1./sqrt(3.)
gwei(1)=1.
gwei(2)=1.
c assemble amatrx and rhs
do k=1,2
c loop through gauss pts
c=gpx(k)
c get shape functions and derivatives
phi(1)=(1.-c)/2.
phi(2)=(1.+c)/2.
phic(1)=-0.5
phic(2)=0.5
dxdc=abs(coords(1,2)-coords(1,1))/2.
ajacob=dxdc
phix(1)=phic(1)*(1./ajacob)
phix(2)=phic(2)*(1./ajacob)
c interpolate temperatures to int points
dtdx=u(1)*phix(1)+u(2)*phix(2)
t=u(1)*phi(1)+u(2)*phi(2)
told=(u(1)-du(1,nrhs))*phi(1)+(u(2)-du(2,nrhs))*phi(2)
c other housekeeping
cond=conduc
dtdt=(t-told)/dtime
we=gwei(k)*ajacob
c Assemble Element Stiffness Matrix and Add to Global
do ki=1,2
c loop over nodes
rhs(ki,nrhs)=rhs(ki,nrhs)-we*(phi(ki)*rho*spec*dtdt
1 + cond*(phix(ki)*dtdx))
do kj=1,2
stiffk(ki,kj)=stiffk(ki,kj)+
1 we*cond*(phix(ki)*phix(kj))
stiffm(ki,kj)=stiffm(ki,kj)+
1 we*(phi(ki)*phi(kj)*rho*spec)/dtime
end do
end do
do i=1,2
do j=1,2
amatrx(i,j)=stiffk(i,j)+stiffm(i,j)
enddo
enddo
enddo
end if
return
end

202
Unpublished/XFEM2/UEL_TRANHTX.for Normal file
View file

@ -0,0 +1,202 @@
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

114
Unpublished/XFEM2/UEL_TRANHT_2d.for Normal file
View file

@ -0,0 +1,114 @@
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 gx(4),hx(4),phi(4),phix(4),phiy(4),phig(4),phih(4)
dimension rjac(2,2),rjaci(2,2)
c
c material property definition
rho = 1.
spec = 1.
cond = 1.
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 gauss point locations
gpos=1./sqrt(3.)
gx(1)=-gpos
gx(2)=gpos
gx(3)=gpos
gx(4)=-gpos
hx(1)=-gpos
hx(2)=-gpos
hx(3)=gpos
hx(4)=gpos
c assemble amatrx and rhs
do k=1,4
c loop through gauss pts
g=gx(k)
h=hx(k)
c get shape functions and derivatives
phi(1)=0.25*(1.-g)*(1.-h)
phi(2)=0.25*(1.+g)*(1.-h)
phi(3)=0.25*(1.+g)*(1.+h)
phi(4)=0.25*(1.-g)*(1.+h)
phig(1)=0.25*-(1.-h)
phig(2)=0.25*(1.-h)
phig(3)=0.25*(1.+h)
phig(4)=0.25*-(1.+h)
phih(1)=0.25*-(1.-g)
phih(2)=0.25*-(1.+g)
phih(3)=0.25*(1.+g)
phih(4)=0.25*(1.-g)
c get ip coords
crdx=0.
crdy=0.
do k1=1,nnode
crdx=crdx+phi(k1)*coords(1,k1)
crdy=crdy+phi(k1)*coords(2,k1)
end do
c get jacobian
rjac=0.
do i=1,4
rjac(1,1)=rjac(1,1)+phig(i)*coords(1,i)
rjac(1,2)=rjac(1,2)+phig(i)*coords(2,i)
rjac(2,1)=rjac(2,1)+phih(i)*coords(1,i)
rjac(2,2)=rjac(2,2)+phih(i)*coords(2,i)
enddo
djac=rjac(1,1)*rjac(2,2)-rjac(1,2)*rjac(2,1)
print *,djac
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
c get b matrix
phix(1)=rjaci(1,1)*phig(1)+rjaci(1,2)*phih(1)
phiy(1)=rjaci(2,1)*phig(1)+rjaci(2,2)*phih(1)
phix(2)=rjaci(1,1)*phig(2)+rjaci(1,2)*phih(2)
phiy(2)=rjaci(2,1)*phig(2)+rjaci(2,2)*phih(2)
phix(3)=rjaci(1,1)*phig(3)+rjaci(1,2)*phih(3)
phiy(3)=rjaci(2,1)*phig(3)+rjaci(2,2)*phih(3)
phix(4)=rjaci(1,1)*phig(4)+rjaci(1,2)*phih(4)
phiy(4)=rjaci(2,1)*phig(4)+rjaci(2,2)*phih(4)
c interpolate temperatures to int points
dtdx=u(1)*phix(1)+u(2)*phix(2)
1 +u(3)*phix(3)+u(4)*phix(4)
dtdy=u(1)*phiy(1)+u(2)*phiy(2)
1 +u(3)*phiy(3)+u(4)*phiy(4)
t=u(1)*phi(1)+u(2)*phi(2)+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=djac
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+phiy(ki)*dtdy))
do kj=1,4
amatrx(ki,kj)=amatrx(ki,kj)+we*(phi(ki)*phi(kj)
1 *rho*spec/dtime+cond*(phix(ki)*phix(kj)+
1 phiy(ki)*phiy(kj)))
end do
end do
enddo
end if
return
end

270
Unpublished/XFEM2/XCOR1D.m Normal file
View file

@ -0,0 +1,270 @@
function [] = XCOR1D()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=4;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=0.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
for n=1:2
crdn1=ndCoords(elemNodes(e,n));
if crdn1<=dpos
Tnew(2*elemNodes(e,n)-1)=1.;
end
end
end
Bound(1)=1.;
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% penalty term
beta=100.;
% Loop through time steps
for ts=1:tsteps
eNodes=zeros(2*numNodes,1);
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=0.5*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
vel=0.
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
eNodes(2*elemNodes(e,1))=1;
eNodes(2*elemNodes(e,2))=1;
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
% if term<0
% cond=0.00;
% spec=0.001;
% else
cond=1.;
spec=1.;
% end
if enr==4
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
else
phi(2)=0.0;
phi(4)=0.0;
end
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
if enr==4
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
else
phic(2)=0.0;
phic(4)=0.0;
end
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
if enr==5;
Ke(1,2)=0.;
Me(1,2)=0.;
Ke(2,1)=0.;
Me(2,1)=0.;
Ke(1,4)=0.;
Me(1,4)=0.;
Ke(4,1)=0.;
Me(4,1)=0.;
Ke(3,2)=0.;
Me(3,2)=0.;
Ke(2,3)=0.;
Me(2,3)=0.;
Ke(4,3)=0.;
Me(4,3)=0.;
Ke(3,4)=0.;
Me(3,4)=0.;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
Ke;
Me;
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
%Remove NON-ENHANCED DOFs(Reduce Matrices)
iindex=0.;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
TR1(iindex)=Tnew(i);
BR1(iindex)=Bound(i);
pforceR1(iindex)=pforce(i);
jindex=0;
for j=1:ndof*numNodes;
check=0;
if mod(j,2)==0 && eNodes(j)~=1
check=1;
end
if check==0
jindex=jindex+1;
MR1(iindex,jindex)=M(i,j);
KR1(iindex,jindex)=K(i,j);
end
end
end
end
AR1=KR1+MR1;
SubR1=AR1*BR1';
RHSR1=MR1*TR1'-SubR1+pforceR1';
% Apply Boundary Conditions
Biindex=0.;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
RHSR2(Biindex)=RHSR1(i);
jindex=0;
for j=1:iindex;
check=0;
if BR1(j)==0.;
jindex=jindex+1;
AR2(Biindex,jindex)=AR1(i,j);
end
end
end
end
%Solve
Tnewr=(AR2^-1)*RHSR2';
% Restore Matrices
Biindex=0;
for i=1:iindex;
if BR1(i)==0.;
Biindex=Biindex+1;
TR1(i)=Tnewr(Biindex);
end
end
iindex=0;
for i=1:ndof*numNodes;
check=0;
if mod(i,2)==0 && eNodes(i)~=1
check=1;
end
if check==0
iindex=iindex+1;
Tnew(i)=TR1(iindex);
end
end
Tnew
end
stored';

197
Unpublished/XFEM2/XCOR1Db.asv Normal file
View file

@ -0,0 +1,197 @@
function [] = XCOR1Db()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=4;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=0.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
for n=1:2
crdn1=ndCoords(elemNodes(e,n));
if crdn1<=dpos
Tnew(2*elemNodes(e,n)-1)=1.;
end
end
end
Bound(1)=1.;
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% penalty term
beta=100.;
% Loop through time steps
for ts=1:tsteps
eNodes=zeros(2*numNodes,1);
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=0.5*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
vel=0.
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
eNodes(2*elemNodes(e,1))=1;
eNodes(2*elemNodes(e,2))=1;
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
cond=1.;
spec=1.;
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
A=K+M;
Sub=A*Bound;
RHS=M*Tnew-Sub+pforce;
% Apply Boundary Conditions
Biindex=0.;
for i=1:ndof*numNodes;
if Bound(i)==0.;
Biindex=Biindex+1;
RHSR(Biindex)=RHS(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
AR(Biindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(AR^-1)*RHSR';
% Restore Matrices
Biindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
Biindex=Biindex+1;
Tnew(i)=Tnewr(Biindex);
end
end
Tnew
end
stored';

197
Unpublished/XFEM2/XCOR1Db.m Normal file
View file

@ -0,0 +1,197 @@
function [] = XCOR1Db()
% MATLAB based 1-D XFEM Solver
% J. Grogan (2012)
clear all
% Define Geometry
len=1.;
% Define Section Properties
rho=1.;
% Generate Mesh
numElem=4;
charlen=len/numElem;
ndCoords=linspace(0,len,numElem+1);
numNodes=size(ndCoords,2);
indx=1:numElem;
elemNodes(:,1)=indx;
elemNodes(:,2)=indx+1;
% dofs per node
ndof=2;
% initial interface position
dpos=0.6;
% Initial temperatures
Tnew=zeros(numNodes*2,1);
Bound=zeros(numNodes*2,1);
%storage
stored(1)=dpos;
for e=1:numElem
for n=1:2
crdn1=ndCoords(elemNodes(e,n));
if crdn1<=dpos
Tnew(2*elemNodes(e,n)-1)=1.;
end
end
end
Bound(1)=1.;
% Define Time Step
dtime=0.01;
tsteps=10;
time=0.;
% penalty term
beta=100.;
% Loop through time steps
for ts=1:tsteps
eNodes=zeros(2*numNodes,1);
% Get interface velocity
d(1)=dpos+charlen;
d(2)=dpos+3*charlen/4;
d(3)=dpos+charlen/4;
d(4)=dpos;
for e=1:numElem
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
for j=1:4
if d(j)>=crdn1 && d(j)<crdn2
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
point=(d(j)-crdn1)/ajacob-1.;
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
tmp1a=Tnew(elemNodes(e,1)*2-1);
tmp1b=Tnew(elemNodes(e,1)*2);
tmp2a=Tnew(elemNodes(e,2)*2-1);
tmp2b=Tnew(elemNodes(e,2)*2);
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)));
t(j)=gm(1)*tmp1a+gm(2)*tmp1b+gm(3)*tmp2a+gm(4)*tmp2b;
end
end
end
vel=0.5*(0.5/charlen)*(2*t(1)+t(2)-t(3)-2*t(4));
vel=0.
% Update interface position
dpos=dpos+vel*dtime;
stored(ts+1)=dpos;
K=zeros(numNodes*ndof,numNodes*ndof);
M=zeros(numNodes*ndof,numNodes*ndof);
pforce=zeros(numNodes*ndof,1);
% Loop Through Elements
for e=1:numElem
Ke=zeros(2*ndof);
Me=zeros(2*ndof);
crdn1=ndCoords(elemNodes(e,1));
crdn2=ndCoords(elemNodes(e,2));
theta(1)=abs(crdn1-dpos)*sign(crdn1-dpos);
theta(2)=abs(crdn2-dpos)*sign(crdn2-dpos);
enr=2;
elen=abs(crdn2-crdn1);
ajacob=elen/2.;
if sign(theta(1))~=sign(theta(2))
% enriched element
eNodes(2*elemNodes(e,1))=1;
eNodes(2*elemNodes(e,2))=1;
enr=4;
% get interface position on element
point=(dpos-crdn1)/ajacob-1.;
% devide element for sub integration
len1=abs(-point-1.);
len2=abs(1.-point);
mid1=-1+len1/2.;
mid2=1-len2/2.;
gpx(1)=-(len1/2.)/sqrt(3.)+mid1;
gpx(2)=(len1/2.)/sqrt(3.)+mid1;
gpx(3)=-(len2/2.)/sqrt(3.)+mid2;
gpx(4)=(len2/2.)/sqrt(3.)+mid2;
w(1)=(len1/2.);
w(2)=(len1/2.);
w(3)=(len2/2.);
w(4)=(len2/2.);
else
% regular element - fix extra dofs
gpx(1)=-1/sqrt(3.);
gpx(2)=1/sqrt(3.);
w(1)=1.;
w(2)=1.;
end
% Loop Through Int Points
for i=1:enr;
c=gpx(i);
phi(1)=(1.-c)/2.;
phi(3)=(1.+c)/2.;
term=theta(1)*phi(1)+theta(2)*phi(3);
cond=1.;
spec=1.;
phi(2)=phi(1)*(abs(term)-abs(theta(1)));
phi(4)=phi(3)*(abs(term)-abs(theta(2)));
phic(1)=-0.5;
phic(3)=0.5;
dterm=sign(term)*(phic(1)*theta(1)+phic(3)*theta(2));
phic(2)=phic(1)*(abs(term)-abs(theta(1)))+phi(1)*dterm;
phic(4)=phic(3)*(abs(term)-abs(theta(2)))+phi(3)*dterm;
phix(1)=phic(1)/ajacob;
phix(2)=phic(2)/ajacob;
phix(3)=phic(3)/ajacob;
phix(4)=phic(4)/ajacob;
we=ajacob*w(i);
Ke=Ke+we*cond*phix'*phix;
Me=Me+(we*rho*spec*phi'*phi)/dtime;
end
% Add penalty term and get temp gradient on interface
if enr==4;
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)));
pen=beta*(gm'*gm);
pfL=beta*1*gm';
Ke=Ke+pen;
else
pen=zeros(4);
pfL=zeros(4,1);
end
% Assemble Global Matrices
gnum=2.*elemNodes(e,1)-1.;
for i=1:4;
for j=1:4;
K(gnum+j-1,gnum+i-1)=K(gnum+j-1,gnum+i-1)+Ke(j,i);
M(gnum+j-1,gnum+i-1)=M(gnum+j-1,gnum+i-1)+Me(j,i);
end
pforce(gnum+i-1)=pforce(gnum+i-1)+pfL(i);
end
end
A=K+M;
Sub=A*Bound;
RHS=M*Tnew-Sub+pforce;
% Apply Boundary Conditions
Biindex=0.;
for i=1:ndof*numNodes;
if Bound(i)==0.;
Biindex=Biindex+1;
RHSR(Biindex)=RHS(i);
jindex=0;
for j=1:ndof*numNodes;
if Bound(j)==0.;
jindex=jindex+1;
AR(Biindex,jindex)=A(i,j);
end
end
end
end
%Solve
Tnewr=(AR^-1)*RHSR';
% Restore Matrices
Biindex=0;
for i=1:ndof*numNodes;
if Bound(i)==0.;
Biindex=Biindex+1;
Tnew(i)=Tnewr(Biindex);
end
end
Tnew
end
stored';

546
Unpublished/XFEM2/XFEM/2D_Test1.for Normal file
View file

@ -0,0 +1,546 @@
C
C User element accessing Abaqus materials
C Heat Transfer -- conduction
C
c*****************************************************************
subroutine uelmat(rhs, amatrx, svars, energy, ndofel, nrhs,
1 nsvars, props, nprops, coords, mcrd, nnode, u, du, v, a, jtype,
2 time, dtime, kstep, kinc, jelem, params, ndload, jdltyp, adlmag,
3 predef, npredf, lflags, mlvarx, ddlmag, mdload, pnewdt, jprops,
4 njpro, period, materiallib)
c
include 'aba_param.inc'
C
dimension rhs(mlvarx,*), amatrx(ndofel, ndofel), props(*),
1 svars(*), energy(*), coords(mcrd, nnode), u(ndofel),
2 du(mlvarx,*), v(ndofel), a(ndofel), time(2), params(*),
3 jdltyp(mdload,*), adlmag(mdload,*), ddlmag(mdload,*),
4 predef(2, npredf, nnode), lflags(*), jprops(*)
c
c local arrays
c
parameter (zero=0.d0, one=1.d0)
parameter (ndim=2, ndof=1, ninpt=4, nnodemax=4)
c
c ndim ... number of spatial dimensions
c ndof ... number of degrees of freedom per node
c ninpt ... number of integration points
c
dimension stiff(ndof*nnodemax,ndof*nnodemax),
1 force(ndof*nnodemax), shape(nnodemax), dshape(ndim,nnodemax),
2 xjaci(ndim,ndim), bmat(nnodemax*ndim), wght(ninpt)
dimension coords_ip(3),dfgrd0(3,3),dfgrd1(3,3),
1 drot(3,3)
dimension coords_new(mcrd,nnodemax)
c
dimension predef_loc(npredf),dpredef_loc(npredf),xx1(3,3),
1 xx1Old(3,3)
dimension xjaci_new(ndim,ndim),bmat_new(nnodemax*ndim)
dimension dtemdx(ndim),rhoUdotdg(3),flux(ndim),dfdt(ndim),
1 dfdg(ndim,ndim)
c
data wght /one, one, one, one/
c
c********************************************************************
c
c U1 = first-order, plane strain, full integration
c
c********************************************************************
if (lflags(3).eq.4) goto 999
c
c Preliminaries
c
pnewdtLocal = pnewdt
if(jtype .ne. 1) then
write(7,*)'Incorrect element type'
call xit
endif
c
c initialize rhs and lhs
c
do k1=1, ndof*nnode
rhs(k1, 1)= zero
do k2=1, ndof*nnode
amatrx(k1, k2)= zero
end do
end do
c
do k1=1,nnode
do k2=1,mcrd
kk = (k1-1)*mcrd + k2
coords_new(k2,k1) = coords(k2,k1) + u(kk)
end do
end do
c
c loop over integration points
c
do kintk = 1, ninpt
c
c initialization
c
rho = zero
rhoUdot = zero
rhoUdotdt = zero
rhoUdotdg = zero
do i=1, 3
rhoUdotdg(i) = zero
end do
do i=1, ndim
flux(i) = zero
dfdt(i) = zero
end do
do i=1, ndim
do j=1, ndim
dfdg(i,j) = zero
end do
end do
c
c evaluate shape functions and derivatives
c
call shapefcn(kintk,ninpt,nnode,ndim,shape,dshape)
c
c compute coordinates at the integration point
c
do k1=1, 3
coords_ip(k1) = zero
end do
do k1=1,nnode
do k2=1,mcrd
coords_ip(k2)=coords_ip(k2)+shape(k1)*coords(k2,k1)
end do
end do
c
if(npredf.gt.0) then
call tempfv(kintk,ninpt,nnode,ndim,shape,predef,
* npredf,predef_loc,dpredef_loc)
end if
c
c form B-matrix
c
djac = one
djac_new = one
call jacobian(jelem,mcrd,ndim,nnode,coords,dshape,
1 djac,xjaci,pnewdt,coords_new,xjaci_new,djac_new)
c
if (pnewdt .lt. pnewdtLocal) pnewdtLocal = pnewdt
c
call bmatrix(xjaci,dshape,nnode,ndim,bmat,xjaci_new,
1 bmat_new)
c
c compute temp. and temp. gradient
c
temp = zero
dtemp = zero
call settemp(ndofel,ndof,ndim,nnode,mlvarx,bmat,du,
* dstran,u,xx1,xx1Old,temp,dtemp,dtemdx,shape)
c
c get Abaqus material
c
rpl = zero
drpldt = zero
celent = one
call material_lib_ht(materiallib,rhoUdot,rhoUdotdt,rhoUdotdg,
* flux,dfdt,dfdg,rpl,drpldt,kintk,djac,predef_loc,
* dpredef_loc,npredf,temp,dtemp,dtemdx,celent,coords_ip)
c
c
c form stiffness matrix and internal force vector
c
call rhsjacobian(nnode,ndim,ndof,
1 wght(kintk),djac,rhoUdot,rhoUdotdt,rhoUdotdg,flux,
2 dfdt,dfdg,shape,bmat,stiff,force,dtime,lflags)
c
c assemble rhs and lhs
c
do k1=1, ndof*nnode
rhs(k1, 1) = rhs(k1, 1) - force(k1)
do k2=1, ndof*nnode
amatrx(k1, k2) = amatrx(k1, k2) + stiff(k1,k2)
end do
end do
end do ! end loop on material integration points
pnewdt = pnewdtLocal
c
999 continue
c
return
end
c*****************************************************************
c
c Compute shape fuctions
c
subroutine shapefcn(kintk,ninpt,nnode,ndim,dN,dNdz)
c
include 'aba_param.inc'
c
parameter (dmone=-1.0d0,one=1.0d0,four=4.0d0,eight=8.0d0,
1 gaussCoord=0.577350269d0)
parameter (maxElemNode=8,maxDof=3,i2d4node=24,i3d8node=38)
dimension dN(*),dNdz(ndim,*),coord24(2,4),coord38(3,8)
c
data coord24 /dmone, dmone,
2 one, dmone,
3 one, one,
4 dmone, one/
c
data coord38 /dmone, dmone, dmone,
2 one, dmone, dmone,
3 one, one, dmone,
4 dmone, one, dmone,
5 dmone, dmone, one,
6 one, dmone, one,
7 one, one, one,
8 dmone, one, one/
C
iCode = 0
if (ninpt.eq.4.and.nnode.eq.4.and.ndim.eq.2) then
iCode = 24
else if (ninpt.eq.8.and.nnode.eq.8.and.ndim.eq.3) then
iCode = 38
else
write (6,*) '***ERROR: The shape fuctions cannot be found'
end if
C
C 3D 8-nodes
C
if (iCode.eq.i3d8node) then
c
c determine (g,h,r)
c
g = coord38(1,kintk)*gaussCoord
h = coord38(2,kintk)*gaussCoord
r = coord38(3,kintk)*gaussCoord
c
c shape functions
dN(1) = (one - g)*(one - h)*(one - r)/eight
dN(2) = (one + g)*(one - h)*(one - r)/eight
dN(3) = (one + g)*(one + h)*(one - r)/eight
dN(4) = (one - g)*(one + h)*(one - r)/eight
dN(5) = (one - g)*(one - h)*(one + r)/eight
dN(6) = (one + g)*(one - h)*(one + r)/eight
dN(7) = (one + g)*(one + h)*(one + r)/eight
dN(8) = (one - g)*(one + h)*(one + r)/eight
c
c derivative d(Ni)/d(g)
dNdz(1,1) = -(one - h)*(one - r)/eight
dNdz(1,2) = (one - h)*(one - r)/eight
dNdz(1,3) = (one + h)*(one - r)/eight
dNdz(1,4) = -(one + h)*(one - r)/eight
dNdz(1,5) = -(one - h)*(one + r)/eight
dNdz(1,6) = (one - h)*(one + r)/eight
dNdz(1,7) = (one + h)*(one + r)/eight
dNdz(1,8) = -(one + h)*(one + r)/eight
c
c derivative d(Ni)/d(h)
dNdz(2,1) = -(one - g)*(one - r)/eight
dNdz(2,2) = -(one + g)*(one - r)/eight
dNdz(2,3) = (one + g)*(one - r)/eight
dNdz(2,4) = (one - g)*(one - r)/eight
dNdz(2,5) = -(one - g)*(one + r)/eight
dNdz(2,6) = -(one + g)*(one + r)/eight
dNdz(2,7) = (one + g)*(one + r)/eight
dNdz(2,8) = (one - g)*(one + r)/eight
c
c derivative d(Ni)/d(r)
dNdz(3,1) = -(one - g)*(one - h)/eight
dNdz(3,2) = -(one + g)*(one - h)/eight
dNdz(3,3) = -(one + g)*(one + h)/eight
dNdz(3,4) = -(one - g)*(one + h)/eight
dNdz(3,5) = (one - g)*(one - h)/eight
dNdz(3,6) = (one + g)*(one - h)/eight
dNdz(3,7) = (one + g)*(one + h)/eight
dNdz(3,8) = (one - g)*(one + h)/eight
C
C 2D 4-nodes
C
else if (iCode.eq.i2d4node) then
c
c determine (g,h)
c
g = coord24(1,kintk)*gaussCoord
h = coord24(2,kintk)*gaussCoord
c
c shape functions
dN(1) = (one - g)*(one - h)/four;
dN(2) = (one + g)*(one - h)/four;
dN(3) = (one + g)*(one + h)/four;
dN(4) = (one - g)*(one + h)/four;
c
c derivative d(Ni)/d(g)
dNdz(1,1) = -(one - h)/four;
dNdz(1,2) = (one - h)/four;
dNdz(1,3) = (one + h)/four;
dNdz(1,4) = -(one + h)/four;
c
c derivative d(Ni)/d(h)
dNdz(2,1) = -(one - g)/four;
dNdz(2,2) = -(one + g)/four;
dNdz(2,3) = (one + g)/four;
dNdz(2,4) = (one - g)/four;
end if
c
return
end
c*****************************************************************
c Get local predefined fileds
c
subroutine tempfv(kintk,ninpt,nnode,ndim,shape,predef,
* npredf,predef_loc,dpredef_loc)
c
include 'aba_param.inc'
c
dimension shape(nnode),predef(2,npredf,nnode)
dimension predef_loc(npredf),dpredef_loc(npredf)
parameter (zero=0.d0)
c
do k1=1,npredf
predef_loc(k1) = zero
dpredef_loc(k1) = zero
do k2=1,nnode
predef_loc(k1) = predef_loc(k1)+
& (predef(1,k1,k2)-predef(2,k1,k2))*shape(k2)
dpredef_loc(k1) = dpredef_loc(k1)+predef(2,k1,k2)*shape(k2)
end do
end do
c
return
end
c*****************************************************************
c Compute jacobian matrix
c
subroutine jacobian(jelem,mcrd,ndim,nnode,
1 coords,dshape,djac,xjaci,pnewdt,coords_new,xjaci_new,
2 djac_new)
c
c Notation: ndim ....... element dimension
c nnode ..... number of nodes
c coords ..... coordinates of nodes
c dshape ..... derivs of shape fcn
c djac ....... determinant of Jacobian
c xjaci ...... inverse of Jacobian matrix
c
c
include 'aba_param.inc'
parameter(zero=0.d0, fourth=0.25d0, maxDof=3)
dimension xjac(maxDof,maxDof), xjaci(ndim,*), coords(mcrd,*)
dimension dshape(ndim,*),coords_new(mcrd,*)
dimension xjac_new(maxDof,maxDof), xjaci_new(ndim,*)
c
do i = 1, ndim
do j = 1, ndim
xjac(i,j) = zero
xjaci(i,j) = zero
xjac_new(i,j) = zero
xjaci_new(i,j) = zero
end do
end do
c
do inod= 1, nnode
do idim = 1, ndim
do jdim = 1, ndim
xjac(idim,jdim) = xjac(idim,jdim) +
1 dshape(jdim,inod)*coords(idim,inod)
end do
end do
end do
C
C ndim == 3
C
if (ndim.eq.3) then
djac = xjac(1,1)*xjac(2,2)*xjac(3,3) +
& xjac(2,1)*xjac(3,2)*xjac(1,3) +
& xjac(3,1)*xjac(2,3)*xjac(1,2) -
& xjac(3,1)*xjac(2,2)*xjac(1,3) -
& xjac(2,1)*xjac(1,2)*xjac(3,3) -
& xjac(1,1)*xjac(2,3)*xjac(3,2)
if (djac .gt. zero) then
! jacobian is positive - o.k.
xjaci(1,1) = (xjac(2,2)*xjac(3,3)-xjac(2,3)*xjac(3,2))/djac
xjaci(1,2) = (xjac(1,3)*xjac(3,2)-xjac(1,2)*xjac(3,3))/djac
xjaci(1,3) = (xjac(1,2)*xjac(2,3)-xjac(1,3)*xjac(2,2))/djac
!
xjaci(2,1) = (xjac(2,3)*xjac(3,1)-xjac(2,1)*xjac(3,3))/djac
xjaci(2,2) = (xjac(1,1)*xjac(3,3)-xjac(1,3)*xjac(3,1))/djac
xjaci(2,3) = (xjac(1,3)*xjac(2,1)-xjac(1,1)*xjac(2,3))/djac
!
xjaci(3,1) = (xjac(2,1)*xjac(3,2)-xjac(2,2)*xjac(3,1))/djac
xjaci(3,2) = (xjac(1,2)*xjac(3,1)-xjac(1,1)*xjac(3,2))/djac
xjaci(3,3) = (xjac(1,1)*xjac(2,2)-xjac(1,2)*xjac(2,1))/djac
else
! negative or zero jacobian
write(7,*)'WARNING: element',jelem,'has neg.
1 Jacobian'
pnewdt = fourth
endif
C
C ndim == 2
C
else if (ndim.eq.2) then
djac = xjac(1,1)*xjac(2,2) - xjac(1,2)*xjac(2,1)
djac_new = xjac_new(1,1)*xjac_new(2,2)
* - xjac_new(1,2)*xjac_new(2,1)
if (djac .gt. zero) then
! jacobian is positive - o.k.
xjaci(1,1) = xjac(2,2)/djac
xjaci(2,2) = xjac(1,1)/djac
xjaci(1,2) = -xjac(1,2)/djac
xjaci(2,1) = -xjac(2,1)/djac
else
! negative or zero jacobian
write(7,*)'WARNING: element',jelem,'has neg.
1 Jacobian'
pnewdt = fourth
endif
end if
return
end
c*****************************************************************
c
c Compute the B matrix
c
subroutine bmatrix(xjaci,dshape,nnode,ndim,bmat,
* xjaci_new,bmat_new)
c
c Notation:
c bmat(i) .....dN1/dx, dN1/dy, dN2/dx, dN2/dy..
c xjaci ...... inverse Jabobian matrix
c dshape ......derivative of shape functions
c
include 'aba_param.inc'
c
parameter (zero=0.d0)
dimension bmat(*), dshape(ndim,*)
dimension xjaci(ndim,*)
dimension xjaci_new(ndim,*),bmat_new(*)
do i = 1, nnode*ndim
bmat(i) = zero
bmat_new(i) = zero
end do
do inod = 1, nnode
do ider = 1, ndim
do idim = 1, ndim
irow = idim + (inod - 1)*ndim
bmat(irow) = bmat(irow) +
1 xjaci(idim,ider)*dshape(ider,inod)
end do
end do
end do
return
end
c*****************************************************************
c
c Set temperatures
c
subroutine settemp(ndofel,ndof,ndim,nnode,
1 mlvarx,bmat,du,dstran,u,xx1,xx1Old,temp,dtemp,dtemdx,dN)
c
c
c
include 'aba_param.inc'
parameter(zero=0.d0, one=1.d0)
dimension dstran(*), bmat(ndim,*),
1 du(mlvarx, *), xdu(3), xx1(3,*),
2 u(ndofel), utmp(3),
3 utmpOld(3),xx1Old(3,*),eps(3,3),dInvFold(3,3)
dimension dtemdx(*),dN(*)
C
c
c****************************************************************
c Compute temp, dtemp, and temp gradient at the material point
c****************************************************************
c
temp = zero
dtemp = zero
do iNode=1, nnode
temp = temp + dN(iNode)*u(iNode)
dtemp = dtemp + dN(iNode)*du(iNode,1)
end do
do iDof = 1, ndim
dtemdx(iDof) = zero
do iNode=1, nnode
dtemdx(iDof) = dtemdx(iDof) + bmat(idof,iNode)*u(iNode)
end do
end do
c
return
end
c*****************************************************************
c
c Compute element jacobian and nodal forces
c
subroutine rhsjacobian(nnode,ndim,ndof,
1 weight,djac,rhoUdot,rhoUdotdt,rhoUdotdg,flux,dfdt,
2 dfdg,dN,bmat,stiff,force,dtime,lflags)
c
c Stiffness matrix and internal force contributions at
c material integration point
c
include 'aba_param.inc'
parameter(zero=0.d0,maxDof=3)
dimension stiff(ndof*nnode,*)
dimension force(*)
dimension flux(*),dfdt(*),dfdg(ndim,*),rhoUdotdg(*)
dimension dN(*),bmat(ndim,*),lflags(*)
do i = 1, ndof*nnode
force(i) = zero
do j = 1, ndof*nnode
stiff(j,i) = zero
end do
end do
dvol=weight*djac
do nodj=1, nnode
if (lflags(1).eq.32.or.lflags(1).eq.33)
& force(nodj) = dN(nodj)*rhoUdot*dvol
ccc force(nodj) = dN(nodj)*(rhoUdot-rpl)*dvol
do jDof=1, ndim
force(nodj) = force(nodj)+bmat(jDof,nodj)*flux(jDof)*dvol
do nodi=1, nnode
ccc stiff(nodj,nodi) = stiff(nodj,nodi) +
ccc * bmat(jDof,nodj)*dN(nodi)*dfdt(jDof)*dvol
do iDof=1, ndim
stiff(nodj,nodi) = stiff(nodj,nodi) +
* bmat(jDof,nodj)*bmat(iDof,nodi)*dfdg(jDof,iDof)*dvol
end do
end do
end do
end do
do nodj=1, nnode
do nodi=1, nnode
do iDof=1, ndim
ccc stiff(nodj,nodi) = stiff(nodj,nodi) +
ccc * dN(nodj)*bmat(iDof,nodi)*rhoUdotdg(iDof)*dvol
end do
end do
end do
c
if (lflags(1).eq.32.or.lflags(1).eq.33) then
do nodj=1, nnode
do nodi=1, nnode
stiff(nodj,nodi) = stiff(nodj,nodi) +
* rhoUdotdt*dN(nodj)*dN(nodi)*dvol/dtime
end do
end do
end if
c
return
end

108
Unpublished/XFEM2/XFEM/2D_Test2.for Normal file
View file

@ -0,0 +1,108 @@
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),dndg(4),dndh(4),
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 gx(4),hx(4),gwei(4),dN(4),phix(8),phiy(8)
c
parameter(zero=0.d0,one=1.d0)
C MATERIAL PROPERTY DEFINITION
thick = 1.
rho = 1.
spec = 1.
conduc = 1.
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
gpos=1./sqrt(3.)
gx(1)=-gpos
gx(2)=gpos
gx(3)=gpos
gx(4)=-gpos
hx(1)=-gpos
hx(2)=-gpos
hx(3)=gpos
hx(4)=gpos
do i=1,4
gwei(i)=1.
enddo
c assemble amatrx and rhs
do k=1,4
c loop through gauss pts
g=gx(k)
h=hx(k)
c shape functions
dN(1) = (one - g)*(one - h)/4.
dN(2) = (one + g)*(one - h)/4.
dN(3) = (one + g)*(one + h)/4.
dN(4) = (one - g)*(one + h)/4.
c derivative d(Ni)/d(g)
dNdg(1) = -(one - h)/4.
dNdg(2) = (one - h)/4.
dNdg(3) = (one + h)/4.
dNdg(4) = -(one + h)/4.
c derivative d(Ni)/d(h)
dNdh(1) = -(one - g)/4.
dNdh(2) = -(one + g)/4.
dNdh(3) = (one + g)/4.
dNdh(4) = (one - g)/4.
c derivative dx/dg,dx/dh,dy/dg,dy/dh
dxdg=zero
dxdh=zero
dydg=zero
dydh=zero
do i=1,4
dxdg=dxdg+coords(1,i)*dNdg(i)
dxdh=dxdh+coords(1,i)*dNdh(i)
dydg=dydg+coords(2,i)*dNdg(i)
dydh=dydh+coords(2,i)*dNdh(i)
enddo
c calculation of jacobian
ajacob=(dxdg*dydh-dxdh*dydg)
c derivative dn/dx,dn/dy
do i=1,4
phix(i)=(dNdg(i)*dydh-dNdh(i)*dydg)/ajacob
phiy(i)=(dNdh(i)*dxdg-dNdg(i)*dxdh)/ajacob
enddo
dtdx=zero
dtdy=zero
t =zero
told=zero
do i=1,4
dtdx=u(i)*phix(i)+dtdx
dtdy=u(i)*phiy(i)+dtdy
t=u(i)*dn(i)+t
told=(u(i)-du(i,nrhs))*dn(i)+told
end do
cond=1.
dcdt=zero
dtdt=(t-told)/dtime
we=gwei(k)*ajacob
do ki=1,4
c loop over nodes
rhs(ki,nrhs) = rhs(ki,nrhs) -
1 we*(dN(ki)*rho*spec*dtdt +
2 cond*(phix(ki)*dtdx + phiy(ki)*dtdy))
do kj=1,4
amatrx(ki,kj)= amatrx(ki,kj) +
1 we*(dn(ki)*dn(kj)*rho*spec/dtime +
1 cond*(phix(ki)*phix(kj) + phiy(ki)*phiy(kj)))
end do
end do
enddo
end if
return
end

260
Unpublished/XFEM2/XFEM/2D_XCor.for Normal file
View file

@ -0,0 +1,260 @@
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 (icheck==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

260
Unpublished/XFEM2/XFEM/2D_XCorS.f Normal file
View file

@ -0,0 +1,260 @@
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

113
Unpublished/XFEM2/XFEM/2D_XCorS.for Normal file
View file

@ -0,0 +1,113 @@
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.
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)
enddo
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
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(2)=0.25*(1.+g)*(1.-h)
phi(3)=0.25*(1.+g)*(1.+h)
phi(4)=0.25*(1.-g)*(1.+h)
cond=1.
spec=1.
phig(1)=0.25*-(1.-h)
phig(2)=0.25*(1.-h)
phig(3)=0.25*(1.+h)
phig(4)=0.25*-(1.+h)
phih(1)=0.25*-(1.-g)
phih(2)=0.25*-(1.+g)
phih(3)=0.25*(1.+g)
phih(4)=0.25*(1.-g)
rjac=zero
do iter=1,4
rjac(1,1)=rjac(1,1)+phig(iter)*crdnx(iter)
rjac(1,2)=rjac(1,2)+phig(iter)*crdny(iter)
rjac(2,1)=rjac(2,1)+phih(iter)*crdnx(iter)
rjac(2,2)=rjac(2,2)+phih(iter)*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,4
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,4
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,4
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,4
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
end if
return
end

84
Unpublished/XFEM2/XFEM/AbInp.inp Normal file
View file

@ -0,0 +1,84 @@
*Heading
** Job name: Job-1 Model name: Model-1
** Generated by: Abaqus/CAE 6.12-1
*Preprint, echo=NO, model=NO, history=NO, contact=NO
**
** PARTS
**
*Part, name=Part-1
*Node
1, 0., 0., 0.
2, 0.25, 0., 0.
3, 0.5, 0., 0.
4, 0.75, 0., 0.
5, 1., 0., 0.
6, 0., 0.25, 0.
7, 0.25, 0.25, 0.
8, 0.5, 0.25, 0.
9, 0.75, 0.25, 0.
10, 1., 0.25, 0.
*USER ELEMENT,NODES=4,TYPE=U1,PROP=1,COORDINATES=2,VAR=2,unsymm
11,
*Element, type=U1,ELSET=UEL
1, 1, 2,7,6
2, 2, 3,8,7
3, 3, 4,9,8
4, 4, 5,10,9
*UEL Property, Elset=UEL
1.
*End Part
**
**
** ASSEMBLY
**
*Assembly, name=Assembly
**
*Instance, name=Part-1-1, part=Part-1
*End Instance
**
*Nset, nset=_PickedSet16, internal, instance=Part-1-1
1,2,3,6,7,8
*Nset, nset=_PickedSet17, internal, instance=Part-1-1
4,5,9,10
*Nset, nset=Set-6, instance=Part-1-1
1,6
*End Assembly
**
** MATERIALS
**
*Material, name=Material-1
*Conductivity
1.,
*Density
1.,
*Specific Heat
1.,
** ----------------------------------------------------------------
**
** Name: Predefined Field-1 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet16, 1.,0.
** Name: Predefined Field-2 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet17, 0.,0.
** STEP: Step-1
**
*Step, name=Step-1
*Heat Transfer, end=PERIOD, deltmx=100.
0.01, 0.1, 1e-09, 0.01,
**
** BOUNDARY CONDITIONS
**
** Name: BC-1 Type: Temperature
*Boundary
Set-6, 11, 11, 1.
**
** OUTPUT REQUESTS
**
*Restart, write, frequency=0
**
** FIELD OUTPUT: F-Output-1
**
*Output, field, variable=PRESELECT
*Output, history, frequency=0
*End Step

87
Unpublished/XFEM2/XFEM/AbInp1d.com Executable file
View file

@ -0,0 +1,87 @@
from driverConstants import *
from driverStandard import StandardAnalysis
import driverUtils, sys
options = {
'ams':OFF,
'analysisType':STANDARD,
'applicationName':'analysis',
'aqua':OFF,
'ask_delete':OFF,
'background':None,
'beamSectGen':OFF,
'biorid':OFF,
'complexFrequency':OFF,
'contact':OFF,
'cosimulation':OFF,
'coupledProcedure':OFF,
'cpus':1,
'cse':OFF,
'cyclicSymmetryModel':OFF,
'directCyclic':OFF,
'direct_port':'57621',
'direct_solver':DMP,
'dsa':OFF,
'dynamic':OFF,
'filPrt':[],
'fils':[],
'finitesliding':OFF,
'foundation':OFF,
'geostatic':OFF,
'heatTransfer':ON,
'importer':OFF,
'importerParts':OFF,
'includes':[],
'initialConditionsFile':OFF,
'input':'C:\\Users\\05365350\\Desktop\\Matlab_Run\\XFEM\\AbInp1d',
'job':'AbInp1d',
'lanczos':OFF,
'libs':[],
'listener_name':'ENGFL93H4J.uds.nuigalway.ie',
'listener_resource':'1168',
'massDiffusion':OFF,
'memory':'90%',
'message':None,
'messaging_mechanism':'DIRECT',
'moldflowFiles':[],
'moldflowMaterial':OFF,
'mp_mode':THREADS,
'mp_mode_requested':MPI,
'multiphysics':OFF,
'noDmpDirect':[],
'noMultiHost':[],
'no_domain_check':1,
'outputKeywords':ON,
'parameterized':OFF,
'partsAndAssemblies':ON,
'parval':OFF,
'postOutput':OFF,
'publicSim':OFF,
'restart':OFF,
'restartEndStep':OFF,
'restartIncrement':0,
'restartStep':0,
'restartWrite':OFF,
'rezone':OFF,
'runCalculator':OFF,
'soils':OFF,
'soliter':OFF,
'solverTypes':['DIRECT'],
'standard_parallel':ALL,
'staticNonlinear':OFF,
'steadyStateTransport':OFF,
'step':ON,
'subGen':OFF,
'subGenLibs':[],
'subGenTypes':[],
'submodel':OFF,
'substrLibDefs':OFF,
'substructure':OFF,
'symmetricModelGeneration':OFF,
'tmpdir':'C:\\Users\\05365350\\AppData\\Local\\Temp',
'tracer':OFF,
'user':'C:\\Users\\05365350\\Desktop\\Matlab_Run\\XFEM\\UEL2_TRANHTX.for',
'visco':OFF,
}
analysis = StandardAnalysis(options)
status = analysis.run()
sys.exit(status)

229
Unpublished/XFEM2/XFEM/AbInp1d.dat Normal file
View file

@ -0,0 +1,229 @@
1
Abaqus 6.10-1 Date 14-Jan-2013 Time 09:49:19
For use at NATIONAL UNIVERSITY OF IRELAND under license from Dassault Systemes or its subsidiary.
The Abaqus Software is a product of:
Dassault Systemes Simulia Corp.
Rising Sun Mills
166 Valley Street
Providence, RI 02909-2499, USA
Available for internal use at NATIONAL UNIVERSITY OF IRELAND.
The Abaqus Online Support System is accessible
through the "My Support" section of the SIMULIA
Home Page at http://www.simulia.com.
Support policies for academic licenses are described
on the SIMULIA web site at
http://www.simulia.com/academics/academic_support.html.
On machine ENGFL93H4J
you are authorized to run
Abaqus/Standard until 30-Jun-2013
Your site id is: 200000000008244
For assistance or any other information you may
obtain contact information for your local office
from the world wide web at:
http://www.simulia.com/about/locations.html
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* *
* ***************** *
* * N O T I C E * *
* ***************** *
* *
* *
* Abaqus 6.10-1 *
* *
* BUILD ID: 2010_04_29-14.17.36 102575 *
* *
* *
* Please make sure you are using release 6.10manuals *
* plus the notes accompanying this release. *
* *
* *
* *
* *
* *
* This program may not be used for commercial purposes *
* without payment of a commercial fee. *
* *
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
PROCESSING PART, INSTANCE, AND ASSEMBLY INFORMATION
*******************************************************
END PROCESSING PART, INSTANCE, AND ASSEMBLY INFORMATION
***********************************************************
OPTIONS BEING PROCESSED
***************************
*Heading
*Node
*userelement, nodes=2, type=U1, properties=1, variables=2, coordinates=1, unsymm
*Element, type=U1
*Elset, elset=ASSEMBLY_PART-1-1_UEL
*Nset, nset=ASSEMBLY_SET-6
*Nset, nset=ASSEMBLY__PICKEDSET16
*Nset, nset=ASSEMBLY__PICKEDSET17
*material, name=MATERIAL-1
*conductivity
*density
*specificheat
*initialconditions, type=TEMPERATURE
*initialconditions, type=TEMPERATURE
*initialconditions, type=TEMPERATURE
*initialconditions, type=TEMPERATURE
*userelement, nodes=2, type=U1, properties=1, variables=2, coordinates=1, unsymm
*boundary
*uelproperty, elset=ASSEMBLY_PART-1-1_UEL
*output, field, variable=PRESELECT
*output, history, frequency=0
*initialconditions, type=TEMPERATURE
*initialconditions, type=TEMPERATURE
*output, field, variable=PRESELECT
*output, history, frequency=0
*initialconditions, type=TEMPERATURE
*initialconditions, type=TEMPERATURE
*output, field, variable=PRESELECT
*output, history, frequency=0
*Step, name=Step-1
*output, field, variable=PRESELECT
*output, history, frequency=0
*Step, name=Step-1
*Step, name=Step-1
*heattransfer, end=PERIOD, deltmx=100
*boundary
*output, field, variable=PRESELECT
*output, history, frequency=0
*endstep
*Step, name=Step-1
*heattransfer, end=PERIOD, deltmx=100
*boundary
*output, field, variable=PRESELECT
*output, history, frequency=0
*endstep
P R O B L E M S I Z E
NUMBER OF ELEMENTS IS 4
NUMBER OF NODES IS 5
NUMBER OF NODES DEFINED BY THE USER 5
TOTAL NUMBER OF VARIABLES IN THE MODEL 10
(DEGREES OF FREEDOM PLUS MAX NO. OF ANY LAGRANGE MULTIPLIER
VARIABLES. INCLUDE *PRINT,SOLVE=YES TO GET THE ACTUAL NUMBER.)
END OF USER INPUT PROCESSING
JOB TIME SUMMARY
USER TIME (SEC) = 0.10000
SYSTEM TIME (SEC) = 0.10000
TOTAL CPU TIME (SEC) = 0.20000
WALLCLOCK TIME (SEC) = 0
1
Abaqus 6.10-1 Date 14-Jan-2013 Time 09:49:21
For use at NATIONAL UNIVERSITY OF IRELAND under license from Dassault Systemes or its subsidiary.
STEP 1 INCREMENT 1
TIME COMPLETED IN THIS STEP 0.00
S T E P 1 T R A N S I E N T H E A T T R A N S F E R
AUTOMATIC TIME CONTROL WITH -
A SUGGESTED INITIAL TIME INCREMENT OF 1.000E-02
AND A TOTAL TIME PERIOD OF 0.100
THE MINIMUM TIME INCREMENT ALLOWED IS 1.000E-09
THE MAXIMUM TIME INCREMENT ALLOWED IS 1.000E-02
THE SIZE OF THE TIME INCREMENT IS CONTROLLED BY -
THE TEMPERATURE CHANGE PER INCREMENT NOT EXCEEDING 100.
UNSYMMETRIC MATRIX STORAGE AND SOLUTION WILL BE USED
M E M O R Y E S T I M A T E
PROCESS FLOATING PT MINIMUM MEMORY MEMORY TO
OPERATIONS REQUIRED MINIMIZE I/O
PER ITERATION (MBYTES) (MBYTES)
1 2.96E+002 17 24
NOTE:
(1) SINCE ABAQUS DOES NOT PRE-ALLOCATE MEMORY AND ONLY ALLOCATES MEMORY AS NEEDED DURING THE ANALYSIS,
THE MEMORY REQUIREMENT PRINTED HERE CAN ONLY BE VIEWED AS A GENERAL GUIDELINE BASED ON THE BEST
KNOWLEDGE AVAILABLE AT THE BEGINNING OF A STEP BEFORE THE SOLUTION PROCESS HAS BEGUN.
(2) THE ESTIMATE IS NORMALLY UPDATED AT THE BEGINNING OF EVERY STEP. IT IS THE MAXIMUM VALUE OF THE
ESTIMATE FROM THE CURRENT STEP TO THE LAST STEP OF THE ANALYSIS, WITH UNSYMMETRIC SOLUTION TAKEN
INTO ACCOUNT IF APPLICABLE.
(3) SINCE THE ESTIMATE IS BASED ON THE ACTIVE DEGREES OF FREEDOM IN THE FIRST ITERATION OF THE
CURRENT STEP, THE MEMORY ESTIMATE MIGHT BE SIGNIFICANTLY DIFFERENT THAN ACTUAL USAGE FOR
PROBLEMS WITH SUBSTANTIAL CHANGES IN ACTIVE DEGREES OF FREEDOM BETWEEN STEPS (OR EVEN WITHIN
THE SAME STEP). EXAMPLES ARE: PROBLEMS WITH SIGNIFICANT CONTACT CHANGES, PROBLEMS WITH MODEL
CHANGE, PROBLEMS WITH BOTH STATIC STEP AND STEADY STATE DYNAMIC PROCEDURES WHERE ACOUSTIC
ELEMENTS WILL ONLY BE ACTIVATED IN THE STEADY STATE DYNAMIC STEPS.
(4) FOR MULTI-PROCESS EXECUTION, THE ESTIMATED VALUE OF FLOATING POINT OPERATIONS FOR EACH PROCESS
IS BASED ON AN INITIAL SCHEDULING OF OPERATIONS AND MIGHT NOT REFLECT THE ACTUAL FLOATING
POINT OPERATIONS COMPLETED ON EACH PROCESS. OPERATIONS ARE DYNAMICALY BALANCED DURING EXECUTION,
SO THE ACTUAL BALANCE OF OPERATIONS BETWEEN PROCESSES IS EXPECTED TO BE BETTER THAN THE ESTIMATE
PRINTED HERE.
(5) THE UPPER LIMIT OF MEMORY THAT CAN BE ALLOCATED BY ABAQUS WILL IN GENERAL DEPEND ON THE VALUE OF
THE "MEMORY" PARAMETER AND THE AMOUNT OF PHYSICAL MEMORY AVAILABLE ON THE MACHINE. PLEASE SEE
THE "ABAQUS ANALYSIS USER'S MANUAL" FOR MORE DETAILS. THE ACTUAL USAGE OF MEMORY AND OF DISK
SPACE FOR SCRATCH DATA WILL DEPEND ON THIS UPPER LIMIT AS WELL AS THE MEMORY REQUIRED TO MINIMIZE
I/O. IF THE MEMORY UPPER LIMIT IS GREATER THAN THE MEMORY REQUIRED TO MINIMIZE I/O, THEN THE ACTUAL
MEMORY USAGE WILL BE CLOSE TO THE ESTIMATED "MEMORY TO MINIMIZE I/O" VALUE, AND THE SCRATCH DISK
USAGE WILL BE CLOSE-TO-ZERO; OTHERWISE, THE ACTUAL MEMORY USED WILL BE CLOSE TO THE PREVIOUSLY
MENTIONED MEMORY LIMIT, AND THE SCRATCH DISK USAGE WILL BE ROUGHLY PROPORTIONAL TO THE DIFFERENCE
BETWEEN THE ESTIMATED "MEMORY TO MINIMIZE I/O" AND THE MEMORY UPPER LIMIT. HOWEVER ACCURATE
ESTIMATE OF THE SCRATCH DISK SPACE IS NOT POSSIBLE.
(6) USING "*RESTART, WRITE" CAN GENERATE A LARGE AMOUNT OF DATA WRITTEN IN THE WORK DIRECTORY.
THE ANALYSIS HAS BEEN COMPLETED
ANALYSIS COMPLETE
JOB TIME SUMMARY
USER TIME (SEC) = 0.20000
SYSTEM TIME (SEC) = 0.10000
TOTAL CPU TIME (SEC) = 0.30000
WALLCLOCK TIME (SEC) = 1

79
Unpublished/XFEM2/XFEM/AbInp1d.inp Normal file
View file

@ -0,0 +1,79 @@
*Heading
** Job name: Job-1 Model name: Model-1
** Generated by: Abaqus/CAE 6.12-1
*Preprint, echo=NO, model=NO, history=NO, contact=NO
**
** PARTS
**
*Part, name=Part-1
*Node
1, 0., 0., 0.
2, 0.25, 0., 0.
3, 0.5, 0., 0.
4, 0.75, 0., 0.
5, 1., 0., 0.
*USER ELEMENT,NODES=2,TYPE=U1,PROP=1,COORDINATES=1,VAR=2,unsymm
11,12
*Element, type=U1,ELSET=UEL
1, 1, 2,
2, 2, 3,
3, 3,4
4, 4,5
*UEL Property, Elset=UEL
1.
*End Part
**
**
** ASSEMBLY
**
*Assembly, name=Assembly
**
*Instance, name=Part-1-1, part=Part-1
*End Instance
**
*Nset, nset=_PickedSet16, internal, instance=Part-1-1
1,2,3
*Nset, nset=_PickedSet17, internal, instance=Part-1-1
4,5,6
*Nset, nset=Set-6, instance=Part-1-1
1,
*End Assembly
**
** MATERIALS
**
*Material, name=Material-1
*Conductivity
1.,
*Density
1.,
*Specific Heat
1.,
** ----------------------------------------------------------------
**
** Name: Predefined Field-1 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet16, 1.,0.
** Name: Predefined Field-2 Type: Temperature
*Initial Conditions, type=TEMPERATURE
_PickedSet17, 0.,0.
** STEP: Step-1
**
*Step, name=Step-1
*Heat Transfer, end=PERIOD, deltmx=100.
0.01, 0.1, 1e-09, 0.01,
**
** BOUNDARY CONDITIONS
**
** Name: BC-1 Type: Temperature
*Boundary
Set-6, 11, 11, 1.
**
** OUTPUT REQUESTS
**
*Restart, write, frequency=0
**
** FIELD OUTPUT: F-Output-1
**
*Output, field, variable=PRESELECT
*Output, history, frequency=0
*End Step

36
Unpublished/XFEM2/XFEM/AbInp1d.ipm Normal file
View file

@ -0,0 +1,36 @@
<?xml version="1.0"?><msgwrapper><Started><phase type="symconst">BATCHPRE_PHASE</phase><jobName type="string">AbInp1d</jobName><clientHost type="string">ENGFL93H4J</clientHost><handle type="integer">0</handle></Started>
<Odb_File><file type="string">C:\Users\05365350\Desktop\Matlab_Run\XFEM\AbInp1d.odb</file><phase type="symconst">BATCHPRE_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_File>
<Completed><message type="string">Analysis phase complete</message><phase type="symconst">BATCHPRE_PHASE</phase><jobName type="string">AbInp1d</jobName></Completed>
<Started><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName><clientHost type="string">ENGFL93H4J</clientHost><handle type="integer">7004</handle></Started>
<Step><stepId type="integer">1</stepId><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Step>
<Odb_Frame><step type="integer">0</step><frame type="integer">0</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">0</increment><attempts type="integer">0</attempts><severe type="integer">0</severe><equilibrium type="integer">0</equilibrium><iterations type="integer">0</iterations><totalTime type="float">0</totalTime><stepTime type="float">0</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<MEMORY_ESTIMATE><memory type="float">23.9047403335571</memory><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></MEMORY_ESTIMATE>
<Odb_Frame><step type="integer">0</step><frame type="integer">1</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">1</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.01</totalTime><stepTime type="float">0.01</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Status><step type="integer">1</step><increment type="integer">2</increment><attempts type="string"> 1U</attempts><severe type="integer">0</severe><equilibrium type="integer">4</equilibrium><iterations type="integer">4</iterations><totalTime type="float">0.01</totalTime><stepTime type="float">0.01</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">2</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">2</increment><attempts type="integer">2</attempts><severe type="integer">0</severe><equilibrium type="integer">2</equilibrium><iterations type="integer">2</iterations><totalTime type="float">0.0125</totalTime><stepTime type="float">0.0125</stepTime><timeIncrement type="float">0.0025</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">3</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">3</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.015</totalTime><stepTime type="float">0.015</stepTime><timeIncrement type="float">0.0025</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">4</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">4</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.02</totalTime><stepTime type="float">0.02</stepTime><timeIncrement type="float">0.005</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">5</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">5</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.03</totalTime><stepTime type="float">0.03</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">6</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">6</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.04</totalTime><stepTime type="float">0.04</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">7</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">7</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.05</totalTime><stepTime type="float">0.05</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">8</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">8</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.06</totalTime><stepTime type="float">0.06</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">9</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">9</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.07</totalTime><stepTime type="float">0.07</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">10</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">10</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.08</totalTime><stepTime type="float">0.08</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">11</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">11</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.09</totalTime><stepTime type="float">0.09</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<Odb_Frame><step type="integer">0</step><frame type="integer">12</frame><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Odb_Frame>
<Status><step type="integer">1</step><increment type="integer">12</increment><attempts type="integer">1</attempts><severe type="integer">0</severe><equilibrium type="integer">1</equilibrium><iterations type="integer">1</iterations><totalTime type="float">0.1</totalTime><stepTime type="float">0.1</stepTime><timeIncrement type="float">0.01</timeIncrement><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Status>
<End_Step><stepId type="integer">1</stepId><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></End_Step>
<Completed><message type="string">Analysis phase complete</message><phase type="symconst">STANDARD_PHASE</phase><jobName type="string">AbInp1d</jobName></Completed>
<JOB_COMPLETED><jobName type="string">AbInp1d</jobName><time type="string">Mon Jan 14 09:49:24 2013</time></JOB_COMPLETED></msgwrapper>

32
Unpublished/XFEM2/XFEM/AbInp1d.log Normal file
View file

@ -0,0 +1,32 @@
Abaqus JOB AbInp1d
Abaqus 6.10-1
C:\SIMULIA\Abaqus\6.10-1\Python\Lib\jabber.py:68: DeprecationWarning: the sha module is deprecated; use the hashlib module instead
Begin Compiling Abaqus/Standard User Subroutines
01/14/13 09:49:18
End Compiling Abaqus/Standard User Subroutines
01/14/13 09:49:18
Begin Linking Abaqus/Standard User Subroutines
01/14/13 09:49:18
Creating library standardU.lib and object standardU.exp
Microsoft (R) Manifest Tool version 5.2.3790.2075
Copyright (c) Microsoft Corporation 2005.
All rights reserved.
End Linking Abaqus/Standard User Subroutines
01/14/13 09:49:19
Begin Analysis Input File Processor
01/14/13 09:49:19
Run pre.exe
Abaqus License Manager checked out the following licenses:
Abaqus/Standard checked out 5 tokens.
<75 out of 85 licenses remain available>.
01/14/13 09:49:20
End Analysis Input File Processor
Begin Abaqus/Standard Analysis
01/14/13 09:49:20
Run standard.exe
Abaqus License Manager checked out the following licenses:
Abaqus/Standard checked out 5 tokens.
<75 out of 85 licenses remain available>.
01/14/13 09:49:24
End Abaqus/Standard Analysis
Abaqus JOB AbInp1d COMPLETED

659
Unpublished/XFEM2/XFEM/AbInp1d.msg Normal file
View file

@ -0,0 +1,659 @@
1
Abaqus 6.10-1 Date 14-Jan-2013 Time 09:49:21
For use at NATIONAL UNIVERSITY OF IRELAND under license from Dassault Systemes or its subsidiary.
STEP 1 INCREMENT 1 STEP TIME 0.00
S T E P 1 T R A N S I E N T H E A T T R A N S F E R
AUTOMATIC TIME CONTROL WITH -
A SUGGESTED INITIAL TIME INCREMENT OF 1.000E-02
AND A TOTAL TIME PERIOD OF 0.100
THE MINIMUM TIME INCREMENT ALLOWED IS 1.000E-09
THE MAXIMUM TIME INCREMENT ALLOWED IS 1.000E-02
THE SIZE OF THE TIME INCREMENT IS CONTROLLED BY -
THE TEMPERATURE CHANGE PER INCREMENT NOT EXCEEDING 100.
CONVERGENCE TOLERANCE PARAMETERS FOR HEAT FLUX
CRITERION FOR RESIDUAL HEAT FLUX FOR A NONLINEAR PROBLEM 5.000E-03
CRITERION FOR TEMP. CORRECTION IN A NONLINEAR PROBLEM 1.000E-02
INITIAL VALUE OF TIME AVERAGE HEAT FLUX 1.000E-02
AVERAGE HEAT FLUX IS TIME AVERAGE HEAT FLUX
ALTERNATE CRIT. FOR RESIDUAL HEAT FLUX FOR A NONLINEAR PROBLEM 2.000E-02
CRITERION FOR ZERO HEAT FLUX RELATIVE TO TIME AVRG. HEAT FLUX 1.000E-05
CRITERION FOR RESIDUAL HEAT FLUX WHEN THERE IS ZERO FLUX 1.000E-05
CRITERION FOR TEMP. CORRECTION WHEN THERE IS ZERO FLUX 1.000E-03
CRITERION FOR RESIDUAL HEAT FLUX FOR A LINEAR INCREMENT 1.000E-08
FIELD CONVERSION RATIO 1.00
CRITERION FOR ZERO HEAT FLUX REL. TO TIME AVRG. MAX. HEAT FLUX 1.000E-05
VOLUMETRIC STRAIN COMPATIBILITY TOLERANCE FOR HYBRID SOLIDS 1.000E-05
AXIAL STRAIN COMPATIBILITY TOLERANCE FOR HYBRID BEAMS 1.000E-05
TRANS. SHEAR STRAIN COMPATIBILITY TOLERANCE FOR HYBRID BEAMS 1.000E-05
SOFT CONTACT CONSTRAINT COMPATIBILITY TOLERANCE FOR P>P0 5.000E-03
SOFT CONTACT CONSTRAINT COMPATIBILITY TOLERANCE FOR P=0.0 0.100
CONTACT FORCE ERROR TOLERANCE FOR CONVERT SDI=YES 1.00
DISPLACEMENT COMPATIBILITY TOLERANCE FOR DCOUP ELEMENTS 1.000E-05
ROTATION COMPATIBILITY TOLERANCE FOR DCOUP ELEMENTS 1.000E-05
TIME INCREMENTATION CONTROL PARAMETERS:
FIRST EQUILIBRIUM ITERATION FOR CONSECUTIVE DIVERGENCE CHECK 4
EQUILIBRIUM ITERATION AT WHICH LOG. CONVERGENCE RATE CHECK BEGINS 8
EQUILIBRIUM ITERATION AFTER WHICH ALTERNATE RESIDUAL IS USED 9
MAXIMUM EQUILIBRIUM ITERATIONS ALLOWED 16
EQUILIBRIUM ITERATION COUNT FOR CUT-BACK IN NEXT INCREMENT 10
MAXIMUM EQUILIB. ITERS IN TWO INCREMENTS FOR TIME INCREMENT INCREASE 4
MAXIMUM ITERATIONS FOR SEVERE DISCONTINUITIES 12
MAXIMUM CUT-BACKS ALLOWED IN AN INCREMENT 5
MAXIMUM DISCON. ITERS IN TWO INCREMENTS FOR TIME INCREMENT INCREASE 6
MAXIMUM CONTACT AUGMENTATIONS FOR *SURFACE BEHAVIOR,AUGMENTED LAGRANGE 6
CONSECUTIVE INCS MEETING TIME INTEG. TOL. FOR TIME INC. INCREASE 3
CUT-BACK FACTOR AFTER DIVERGENCE 0.2500
CUT-BACK FACTOR FOR TOO SLOW CONVERGENCE 0.5000
CUT-BACK FACTOR AFTER TOO MANY EQUILIBRIUM ITERATIONS 0.7500
CUT-BACK FACTOR AFTER TOO MANY SEVERE DISCONTINUITY ITERATIONS 0.2500
CUT-BACK FACTOR AFTER PROBLEMS IN ELEMENT ASSEMBLY 0.2500
INCREASE FACTOR AFTER TWO INCREMENTS THAT CONVERGE QUICKLY 1.500
MAX. TIME INCREMENT INCREASE FACTOR ALLOWED 1.500
MAX. TIME INCREMENT INCREASE FACTOR ALLOWED (DYNAMICS) 1.250
MAX. TIME INCREMENT INCREASE FACTOR ALLOWED (DIFFUSION) 2.000
MINIMUM TIME INCREMENT RATIO FOR EXTRAPOLATION TO OCCUR 0.1000
CUT-BACK FACTOR WHEN TIME INTEGRATION ACCURACY TOL. EXCEEDED 0.8500
MAX. RATIO OF TIME INTEG. MEASURE TO TOL. FOR TIME INC. INCREASE 0.7500
INCREASE FACTOR FOR TIME INCREMENT WHEN POSSIBLE 0.8000
MIN. TIME INC. INCREASE FACTOR IN LINEAR TRANSIENT PROBLEMS 0.9500
MAX. RATIO OF TIME INCREMENT TO STABILITY LIMIT 1.000
FRACTION OF STABILITY LIMIT FOR NEW TIME INCREMENT 0.9500
TIME INCREMENT INCREASE FACTOR BEFORE A TIME POINT 1.000
AUTOMATIC TOLERANCES FOR OVERCLOSURE AND SEPARATION
PRESSURE ARE SUPPRESSED
GLOBAL STABILIZATION CONTROL IS NOT USED
FRICTION IS INCLUDED IN INCREMENT THAT THE CONTACT POINT CLOSES
PRINT OF INCREMENT NUMBER, TIME, ETC., EVERY 1 INCREMENTS
THE MAXIMUM NUMBER OF INCREMENTS IN THIS STEP IS 100
UNSYMMETRIC MATRIX STORAGE AND SOLUTION WILL BE USED
LINEAR EXTRAPOLATION WILL BE USED
DETAILS REGARDING ACTUAL SOLUTION WAVEFRONT REQUESTED
DETAILED OUTPUT OF DIAGNOSTICS TO DATABASE REQUESTED
PRINT OF INCREMENT NUMBER, TIME, ETC., TO THE MESSAGE FILE EVERY 1 INCREMENTS
EQUATIONS ARE BEING REORDERED TO MINIMIZE WAVEFRONT
COLLECTING MODEL CONSTRAINT INFORMATION FOR OVERCONSTRAINT CHECKS
COLLECTING STEP CONSTRAINT INFORMATION FOR OVERCONSTRAINT CHECKS
INCREMENT 1 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.400 TIME AVG. HEAT FLUX 0.400
LARGEST RESIDUAL HEAT FLUX 1.568E-15 AT NODE 2 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. -3.47 AT NODE 1 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -3.47 AT NODE 1 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS -3.47
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 1.000E-02, FRACTION OF STEP COMPLETED 0.100
STEP TIME COMPLETED 1.000E-02, TOTAL TIME COMPLETED 1.000E-02
INCREMENT 2 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 4.14 TIME AVG. HEAT FLUX 2.27
LARGEST RESIDUAL HEAT FLUX 14.6 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. -2.25 AT NODE 3 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. 2.18 AT NODE 1 DOF 12
INSTANCE: PART-1-1
HEAT FLUX EQUILIBRIUM NOT ACHIEVED WITHIN TOLERANCE.
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 2
AVERAGE HEAT FLUX 6.38 TIME AVG. HEAT FLUX 3.39
LARGEST RESIDUAL HEAT FLUX 24.1 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. -3.77 AT NODE 3 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -1.52 AT NODE 3 DOF 12
INSTANCE: PART-1-1
HEAT FLUX EQUILIBRIUM NOT ACHIEVED WITHIN TOLERANCE.
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 3
AVERAGE HEAT FLUX 10.1 TIME AVG. HEAT FLUX 5.25
LARGEST RESIDUAL HEAT FLUX 39.9 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. -6.28 AT NODE 3 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -2.51 AT NODE 3 DOF 12
INSTANCE: PART-1-1
HEAT FLUX EQUILIBRIUM NOT ACHIEVED WITHIN TOLERANCE.
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 4
AVERAGE HEAT FLUX 16.2 TIME AVG. HEAT FLUX 8.32
LARGEST RESIDUAL HEAT FLUX 66.0 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. -10.4 AT NODE 3 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -4.15 AT NODE 3 DOF 12
INSTANCE: PART-1-1
HEAT FLUX EQUILIBRIUM NOT ACHIEVED WITHIN TOLERANCE.
***NOTE: THE SOLUTION APPEARS TO BE DIVERGING. CONVERGENCE IS JUDGED UNLIKELY.
INCREMENT 2 STARTS. ATTEMPT NUMBER 2, TIME INCREMENT 2.500E-03
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.713 TIME AVG. HEAT FLUX 0.557
LARGEST RESIDUAL HEAT FLUX -0.923 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.383 AT NODE 1 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. 1.25 AT NODE 1 DOF 12
INSTANCE: PART-1-1
HEAT FLUX EQUILIBRIUM NOT ACHIEVED WITHIN TOLERANCE.
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 2
AVERAGE HEAT FLUX 0.850 TIME AVG. HEAT FLUX 0.625
LARGEST RESIDUAL HEAT FLUX -8.521E-15 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.504 AT NODE 1 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. 0.126 AT NODE 3 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM EQUATIONS HAVE CONVERGED
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.504
ITERATION SUMMARY FOR THE INCREMENT: 2 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 2 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 2.500E-03, FRACTION OF STEP COMPLETED 0.125
STEP TIME COMPLETED 1.250E-02, TOTAL TIME COMPLETED 1.250E-02
INCREMENT 3 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 2.500E-03
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.855 TIME AVG. HEAT FLUX 0.701
LARGEST RESIDUAL HEAT FLUX 8.410E-15 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.376 AT NODE 2 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -0.138 AT NODE 1 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.376
TIME INCREMENT MAY NOW INCREASE TO 5.000E-03
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 2.500E-03, FRACTION OF STEP COMPLETED 0.150
STEP TIME COMPLETED 1.500E-02, TOTAL TIME COMPLETED 1.500E-02
INCREMENT 4 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 5.000E-03
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.831 TIME AVG. HEAT FLUX 0.734
LARGEST RESIDUAL HEAT FLUX 8.868E-15 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.423 AT NODE 2 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -0.330 AT NODE 2 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.423
TIME INCREMENT MAY NOW INCREASE TO 1.000E-02
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 5.000E-03, FRACTION OF STEP COMPLETED 0.200
STEP TIME COMPLETED 2.000E-02, TOTAL TIME COMPLETED 2.000E-02
INCREMENT 5 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.745 TIME AVG. HEAT FLUX 0.736
LARGEST RESIDUAL HEAT FLUX -5.773E-15 AT NODE 4 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.446 AT NODE 1 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -0.406 AT NODE 2 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.446
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 1.000E-02, FRACTION OF STEP COMPLETED 0.300
STEP TIME COMPLETED 3.000E-02, TOTAL TIME COMPLETED 3.000E-02
INCREMENT 6 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.657 TIME AVG. HEAT FLUX 0.723
LARGEST RESIDUAL HEAT FLUX -7.147E-15 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.292 AT NODE 1 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -0.156 AT NODE 2 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.292
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 1.000E-02, FRACTION OF STEP COMPLETED 0.400
STEP TIME COMPLETED 4.000E-02, TOTAL TIME COMPLETED 4.000E-02
INCREMENT 7 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.576 TIME AVG. HEAT FLUX 0.702
LARGEST RESIDUAL HEAT FLUX 1.817E-14 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.216 AT NODE 1 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -7.617E-02 AT NODE 1 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.216
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 1.000E-02, FRACTION OF STEP COMPLETED 0.500
STEP TIME COMPLETED 5.000E-02, TOTAL TIME COMPLETED 5.000E-02
INCREMENT 8 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.503 TIME AVG. HEAT FLUX 0.677
LARGEST RESIDUAL HEAT FLUX -4.458E-15 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.172 AT NODE 1 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -4.391E-02 AT NODE 1 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.172
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 1.000E-02, FRACTION OF STEP COMPLETED 0.600
STEP TIME COMPLETED 6.000E-02, TOTAL TIME COMPLETED 6.000E-02
INCREMENT 9 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.439 TIME AVG. HEAT FLUX 0.651
LARGEST RESIDUAL HEAT FLUX -4.479E-15 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.143 AT NODE 1 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -2.906E-02 AT NODE 1 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.143
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 1.000E-02, FRACTION OF STEP COMPLETED 0.700
STEP TIME COMPLETED 7.000E-02, TOTAL TIME COMPLETED 7.000E-02
INCREMENT 10 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.383 TIME AVG. HEAT FLUX 0.624
LARGEST RESIDUAL HEAT FLUX -1.998E-15 AT NODE 4 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.122 AT NODE 1 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -2.148E-02 AT NODE 1 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.122
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 1.000E-02, FRACTION OF STEP COMPLETED 0.800
STEP TIME COMPLETED 8.000E-02, TOTAL TIME COMPLETED 8.000E-02
INCREMENT 11 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.334 TIME AVG. HEAT FLUX 0.597
LARGEST RESIDUAL HEAT FLUX 3.331E-15 AT NODE 4 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 0.105 AT NODE 3 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -1.708E-02 AT NODE 1 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 0.105
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 1.000E-02, FRACTION OF STEP COMPLETED 0.900
STEP TIME COMPLETED 9.000E-02, TOTAL TIME COMPLETED 9.000E-02
INCREMENT 12 STARTS. ATTEMPT NUMBER 1, TIME INCREMENT 1.000E-02
NUMBER OF EQUATIONS = 10 NUMBER OF FLOATING PT. OPERATIONS = 2.96E+02
CHECK POINT START OF SOLVER
CHECK POINT END OF SOLVER
ELAPSED USER TIME (SEC) = 0.0000
ELAPSED SYSTEM TIME (SEC) = 0.0000
ELAPSED TOTAL CPU TIME (SEC) = 0.0000
ELAPSED WALLCLOCK TIME (SEC) = 0
CONVERGENCE CHECKS FOR EQUILIBRIUM ITERATION 1
AVERAGE HEAT FLUX 0.292 TIME AVG. HEAT FLUX 0.572
LARGEST RESIDUAL HEAT FLUX 5.497E-15 AT NODE 3 DOF 11
INSTANCE: PART-1-1
LARGEST INCREMENT OF TEMP. 9.121E-02 AT NODE 3 DOF 12
INSTANCE: PART-1-1
LARGEST CORRECTION TO TEMP. -1.417E-02 AT NODE 1 DOF 12
INSTANCE: PART-1-1
THE HEAT FLUX EQUILIBRIUM RESPONSE WAS LINEAR IN THIS INCREMENT
MAXIMUM NON-PRESCRIBED INCREMENT IN TEMPERATURE IS 9.121E-02
ITERATION SUMMARY FOR THE INCREMENT: 1 TOTAL ITERATIONS, OF WHICH
0 ARE SEVERE DISCONTINUITY ITERATIONS AND 1 ARE EQUILIBRIUM ITERATIONS.
TIME INCREMENT COMPLETED 1.000E-02, FRACTION OF STEP COMPLETED 1.00
STEP TIME COMPLETED 0.100 , TOTAL TIME COMPLETED 0.100
THE ANALYSIS HAS BEEN COMPLETED
ANALYSIS SUMMARY:
TOTAL OF 12 INCREMENTS
1 CUTBACKS IN AUTOMATIC INCREMENTATION
17 ITERATIONS INCLUDING CONTACT ITERATIONS IF PRESENT
17 PASSES THROUGH THE EQUATION SOLVER OF WHICH
9 INVOLVE MATRIX DECOMPOSITION, INCLUDING
0 DECOMPOSITION(S) OF THE MASS MATRIX
1 REORDERING OF EQUATIONS TO MINIMIZE WAVEFRONT
0 ADDITIONAL RESIDUAL EVALUATIONS FOR LINE SEARCHES
0 ADDITIONAL OPERATOR EVALUATIONS FOR LINE SEARCHES
0 WARNING MESSAGES DURING USER INPUT PROCESSING
0 WARNING MESSAGES DURING ANALYSIS
0 ANALYSIS WARNINGS ARE NUMERICAL PROBLEM MESSAGES
0 ANALYSIS WARNINGS ARE NEGATIVE EIGENVALUE MESSAGES
0 ERROR MESSAGES
JOB TIME SUMMARY
USER TIME (SEC) = 0.20000
SYSTEM TIME (SEC) = 0.10000
TOTAL CPU TIME (SEC) = 0.30000
WALLCLOCK TIME (SEC) = 1

BIN
Unpublished/XFEM2/XFEM/AbInp1d.odb Normal file
View file

Binary file not shown.

76
Unpublished/XFEM2/XFEM/AbInp1d.prt Normal file
View file

@ -0,0 +1,76 @@
1
0
1
ASSEMBLY
1
PART-1-1
PART-1
1
PART-1-1
5
1 1
2 2
3 3
4 4
5 5
1 1
2 2
3 3
4 4
5 5
0
1
PART-1-1
4
1 1
2 2
3 3
4 4
1 1
2 2
3 3
4 4
0
0
1
PART-1-1
1
UEL
0
0
4
1 2 3 4
0
0
0
3
SET-6
0
0
0
1
PART-1-1
1
1
0
_PICKEDSET16
0
1
0
1
PART-1-1
3
1 2 3
0
_PICKEDSET17
0
1
0
1
PART-1-1
2
4 5
0
0
0
0

BIN
Unpublished/XFEM2/XFEM/AbInp1d.sim Normal file
View file

Binary file not shown.

20
Unpublished/XFEM2/XFEM/AbInp1d.sta Normal file
View file

@ -0,0 +1,20 @@
Abaqus/Standard 6.10-1 DATE 14-Jan-2013 TIME 09:49:21
SUMMARY OF JOB INFORMATION:
STEP INC ATT SEVERE EQUIL TOTAL TOTAL STEP INC OF DOF IF
DISCON ITERS ITERS TIME/ TIME/LPF TIME/LPF MONITOR RIKS
ITERS FREQ
1 1 1 0 1 1 0.0100 0.0100 0.01000
1 2 1U 0 4 4 0.0100 0.0100 0.01000
1 2 2 0 2 2 0.0125 0.0125 0.002500
1 3 1 0 1 1 0.0150 0.0150 0.002500
1 4 1 0 1 1 0.0200 0.0200 0.005000
1 5 1 0 1 1 0.0300 0.0300 0.01000
1 6 1 0 1 1 0.0400 0.0400 0.01000
1 7 1 0 1 1 0.0500 0.0500 0.01000
1 8 1 0 1 1 0.0600 0.0600 0.01000
1 9 1 0 1 1 0.0700 0.0700 0.01000
1 10 1 0 1 1 0.0800 0.0800 0.01000
1 11 1 0 1 1 0.0900 0.0900 0.01000
1 12 1 0 1 1 0.100 0.100 0.01000
THE ANALYSIS HAS COMPLETED SUCCESSFULLY

237
Unpublished/XFEM2/XFEM/JQuad.for Normal file
View file

@ -0,0 +1,237 @@
c***********************************************************
subroutine uelmat(rhs,amatrx,svars,energy,ndofel,nrhs,
1 nsvars,props,nprops,coords,mcrd,nnode,u,du,
2 v,a,jtype,time,dtime,kstep,kinc,jelem,params,
3 ndload,jdltyp,adlmag,predef,npredf,lflags,mlvarx,
4 ddlmag,mdload,pnewdt,jprops,njpro,period,
5 materiallib)
c
include 'aba_param.inc'
C
dimension rhs(mlvarx,*), amatrx(ndofel, ndofel), props(*),
1 svars(*), energy(*), coords(mcrd, nnode), u(ndofel),
2 du(mlvarx,*), v(ndofel), a(ndofel), time(2), params(*),
3 jdltyp(mdload,*), adlmag(mdload,*), ddlmag(mdload,*),
4 predef(2, npredf, nnode), lflags(*), jprops(*)
parameter (zero=0.d0, dmone=-1.0d0, one=1.d0, four=4.0d0,
1 fourth=0.25d0,gaussCoord=0.577350269d0)
parameter (ndim=2, ndof=2, nshr=1,nnodemax=4,
1 ntens=4, ninpt=4, nsvint=4)
c
dimension stiff(ndof*nnodemax,ndof*nnodemax),
1 force(ndof*nnodemax), shape(nnodemax), dshape(ndim,nnodemax),
2 xjac(ndim,ndim),xjaci(ndim,ndim), bmat(nnodemax*ndim),
3 statevLocal(nsvint),stress(ntens), ddsdde(ntens, ntens),
4 stran(ntens), dstran(ntens), wght(ninpt)
c
dimension predef_loc(npredf),dpredef_loc(npredf),
1 defGrad(3,3),utmp(3),xdu(3),stiff_p(3,3),force_p(3)
dimension coord24(2,4),coords_ip(3)
data coord24 /dmone, dmone,
2 one, dmone,
3 one, one,
4 dmone, one/
c
data wght /one, one, one, one/
c*************************************************************
c U1 = first-order, plane strain, full integration
c*************************************************************
c define mass matrix as identity at start of analysis
if (lflags(3).eq.4) then
amatrx = zero
do i=1, ndofel
amatrx(i,i) = one
end do
goto 999
end if
c properties
thickness = 0.1d0
c initialize rhs and k
rhs = zero
amatrx = zero
c loop over integration points
do kintk = 1, ninpt
c determine gauss point in local sys (g,h)
c takes form: [4 3]
c [1 2]
g = coord24(1,kintk)*gaussCoord
h = coord24(2,kintk)*gaussCoord
c shape functions
shape(1) = (one - g)*(one - h)/four
shape(2) = (one + g)*(one - h)/four
shape(3) = (one + g)*(one + h)/four
shape(4) = (one - g)*(one + h)/four
c derivative d(Ni)/d(g)
dshape(1,1) = -(one - h)/four
dshape(1,2) = (one - h)/four
dshape(1,3) = (one + h)/four
dshape(1,4) = -(one + h)/four
c derivative d(Ni)/d(h)
dshape(2,1) = -(one - g)/four
dshape(2,2) = -(one + g)/four
dshape(2,3) = (one + g)/four
dshape(2,4) = (one - g)/four
c compute global coordinates of the ip
coords_ip = zero
do k1=1,nnode
do k2=1,mcrd
coords_ip(k2)=coords_ip(k2)+shape(k1)*coords(k2,k1)
end do
end do
c form b-matrix
djac = one
xjac = zero
xjaci = zero
c Get Jacobian
do inod= 1, nnode
do idim = 1, ndim
do jdim = 1, ndim
xjac(jdim,idim) = xjac(jdim,idim) +
1 dshape(jdim,inod)*coords(idim,inod)
end do
end do
end do
c Get Det of Jacobian
djac = xjac(1,1)*xjac(2,2) - xjac(1,2)*xjac(2,1)
if (djac .gt. zero) then
! jacobian is positive - invert it
xjaci(1,1) = xjac(2,2)/djac
xjaci(2,2) = xjac(1,1)/djac
xjaci(1,2) = -xjac(1,2)/djac
xjaci(2,1) = -xjac(2,1)/djac
else
! negative or zero jacobian - reduce time inc.
write(7,*)'WARNING: element',jelem,'has neg. Jacobian'
pnewdt = fourth
endif
if (pnewdt .lt. pnewdtLocal) pnewdtLocal = pnewdt
c Build B matrix
bmat = zero
do inod = 1, nnode
do ider = 1, ndim
do idim = 1, ndim
irow = idim + (inod - 1)*ndim
bmat(irow) = bmat(irow) +
1 xjaci(idim,ider)*dshape(ider,inod)
end do
end do
end do
c get strain inc
dstran(i) = zero
c set deformation gradient to Identity matrix
defGrad = zero
do k1=1,3
defGrad(k1,k1) = one
end do
c compute incremental strains
do nodi = 1, nnode
incr_row = (nodi - 1)*ndof
do i = 1, ndof
xdu(i)= du(i + incr_row,1)
utmp(i) = u(i + incr_row)
end do
dNidx = bmat(1+(nodi-1)*ndim)
dNidy = bmat(2+(nodi-1)*ndim)
dstran(1) = dstran(1)+dNidx*xdu(1)
dstran(2) = dstran(2)+dNidy*xdu(2)
dstran(4) = dstran(4)+dNidy*xdu(1)+dNidx*xdu(2)
c deformation gradient (prob not required for umat)
defGrad(1,1) = defGrad(1,1) + dNidx*utmp(1)
defGrad(1,2) = defGrad(1,2) + dNidy*utmp(1)
defGrad(2,1) = defGrad(2,1) + dNidx*utmp(2)
defGrad(2,2) = defGrad(2,2) + dNidy*utmp(2)
end do
c call constitutive routine
isvinc= (kintk-1)*nsvint
c prepare arrays for entry into material routines
do i = 1, nsvint
statevLocal(i)=svars(i+isvinc)
end do
c state variables
do k1=1,ntens
stran(k1) = statevLocal(k1)
stress(k1) = zero
end do
do i=1, ntens
do j=1, ntens
ddsdde(i,j) = zero
end do
ddsdde(i,j) = one
enddo
c compute characteristic element length
celent = sqrt(djac*dble(ninpt))
dvmat = djac*thickness
c
dvdv0 = one
call material_lib_mech(materiallib,stress,ddsdde,
1 stran,dstran,kintk,dvdv0,dvmat,defGrad,
2 predef_loc,dpredef_loc,npredf,celent,coords_ip)
c
do k1=1,ntens
statevLocal(k1) = stran(k1) + dstran(k1)
end do
isvinc= (kintk-1)*nsvint
c update element state variables
do i = 1, nsvint
svars(i+isvinc)=statevLocal(i)
end do
c form stiffness matrix and internal force vector
dNjdx = zero
dNjdy = zero
force = zero
stiff = zero
dvol= wght(kintk)*djac
do nodj = 1, nnode
incr_col = (nodj - 1)*ndof
dNjdx = bmat(1+(nodj-1)*ndim)
dNjdy = bmat(2+(nodj-1)*ndim)
force_p(1) = dNjdx*stress(1) + dNjdy*stress(4)
force_p(2) = dNjdy*stress(2) + dNjdx*stress(4)
do jdof = 1, ndof
jcol = jdof + incr_col
force(jcol) = force(jcol)+force_p(jdof)*dvol
end do
do nodi = 1, nnode
incr_row = (nodi -1)*ndof
dNidx = bmat(1+(nodi-1)*ndim)
dNidy = bmat(2+(nodi-1)*ndim)
stiff_p(1,1) = dNidx*ddsdde(1,1)*dNjdx
& + dNidy*ddsdde(4,4)*dNjdy
& + dNidx*ddsdde(1,4)*dNjdy
& + dNidy*ddsdde(4,1)*dNjdx
stiff_p(1,2) = dNidx*ddsdde(1,2)*dNjdy
& + dNidy*ddsdde(4,4)*dNjdx
& + dNidx*ddsdde(1,4)*dNjdx
& + dNidy*ddsdde(4,2)*dNjdy
stiff_p(2,1) = dNidy*ddsdde(2,1)*dNjdx
& + dNidx*ddsdde(4,4)*dNjdy
& + dNidy*ddsdde(2,4)*dNjdy
& + dNidx*ddsdde(4,1)*dNjdx
stiff_p(2,2) = dNidy*ddsdde(2,2)*dNjdy
& + dNidx*ddsdde(4,4)*dNjdx
& + dNidy*ddsdde(2,4)*dNjdx
& + dNidx*ddsdde(4,2)*dNjdy
do jdof = 1, ndof
icol = jdof + incr_col
do idof = 1, ndof
irow = idof + incr_row
stiff(irow,icol) = stiff(irow,icol) +
& stiff_p(idof,jdof)*dvol
end do
end do
end do
end do
c assemble rhs and lhs
do k1=1, ndof*nnode
rhs(k1, 1) = rhs(k1, 1) - force(k1)
do k2=1, ndof*nnode
amatrx(k1, k2) = amatrx(k1, k2) + stiff(k1,k2)
end do
end do
end do ! end loop on material integration points
pnewdt = pnewdtLocal
c
999 continue
c
return
end

293
Unpublished/XFEM2/XFEM/JQuadX.for Normal file
View file

@ -0,0 +1,293 @@
c User subroutine UEL XFEM
subroutine uel(rhs,amatrx,svars,energy,ndofel,nrhs,nsvars,
1 props,nprops,coords,mcrd,nnode,u,du,v,a,jtype,time,dtime,
1 kstep,kinc,jelem,params,ndload,jdltyp,adlmag,predef,npredf,
1 lflags,mlvarx,ddlmag,mdload,pnewdt,jprops,njprop,period)
c
include 'aba_param.inc'
c ABAQUS defined variables:
dimension rhs(mlvarx,*), amatrx(ndofel,ndofel), props(*),
1 svars(nsvars), energy(8), coords(mcrd,nnode), u(ndofel),
1 du(mlvarx,*), v(ndofel), a(ndofel), time(2), params(*),
1 jdltyp(mdload,*), adlmag(mdload,*), ddlmag(mdload,*),
1 predef(2,npredf,nnode), lflags(*), jprops(*)
c
character*256 outdir
integer lenoutdir
integer i,j,k,pss,orderq(3),gint,flag,dimens
integer ncracks,maxncp,nelmx,nnodx,typexe(nnode),ix(nnode)
integer,parameter :: mpg=1650
integer,allocatable:: typex(:,:),ncp(:)
real*8 e, nu
real*8 f(ndofel)
real*8 sg(3,mpg),xypg(2,mpg),xe(8),ye(8),xyc0(2),xycprev(2)
real*8, allocatable:: xyc(:,:,:),dist(:,:),elemgg(:,:)
real*8, allocatable:: batg(:,:),dbatg(:,:),jatg(:)
c
c Read real and integer properties set at the ABAQUS input file
e = props(1)
nu = props(2)
pss = jprops(1)
orderq(1) = jprops(2)
orderq(2) = jprops(3)
orderq(3) = jprops(4)
dimens = jprops(5)
c Read the working directory
call getoutdir(outdir,lenoutdir)
c read number of cracks, max number of crack path points,
c number of enriched elements and enriched nodes.
open(68,file=outdir(1:lenoutdir)//’\files\gginfox’)
read(68,*) ncracks,maxncp,nelmx,nnodx
close(68)
c Allocate dimensions
allocate (typex(nnodx,2), ncp(ncracks))
allocate (xyc(ncracks,maxncp,2), dist(nnodx,3), elemgg(nelmx,10))
c read coordinates of path points for each crack
open(68,file=outdir(1:lenoutdir)//’\files\ggxyc’)
do i=1,ncracks
read(68,*) ncp(i)
do j=1,ncp(i)
read(68,*) (xyc(i,j,k),k=1,2)
end do
end do
close(68)
c Read list of enriched nodes, type of enrichment and distances
open(68,file=outdir(1:lenoutdir)//’\files\ggnodex’)
do i=1,nnodx
read(68,*) (typex(i,j),j=1,2),(dist(i,j),j=2,3)
dist(i,1)=typex(i,1)
end do
close(68)
c read list of enriched elements, type of enrichment and intersection points
open(68,file=outdir(1:lenoutdir)//’\files\ggelemx’)
do i=1,nelmx
read(68,*) (elemgg(i,j),j=1,10)
end do
close(68)
c call initializing routines for matrix and vectors
call initializem(rhs,ndofel,nrhs)
call initializem(amatrx,ndofel,ndofel)
call initializev(energy,8)
call initializev(svars,nsvars)
c verification of element type (type=12 for enriched element)
if (jtype.eq.12) then
c **************************************
c * 4 node enriched element with *
c * up to 12 dof/node for x-fem *
c **************************************
if (lflags(1).eq.71) then
c coupled thermal-stress, steady state analysis
if (lflags(3).eq.1) then
c Routine that defines the location of integration points according to
c the appropriate subdivision. This enables to know the total number of
c integration points for the current element, stored in gint, and whether
c the element is subdivided for integration (flag=1) or not.
CALL int2d_X(JELEM,NelmX,ElemGG,MCRD,NNODE,COORDS,orderQ,
1 NCracks,maxNCP,NCP,XYC,gint,sg,Xe,Ye,flag,mpg,xypg,
1 XYC0,XYCPrev)
c Allocate dimensions once the total number of integration points gint is known
allocate(batg(3*gint,ndofel),dbatg(3*gint,ndofel),jatg(gint))
call initializem(batg,3*gint,ndofel)
call initializem(dbatg,3*gint,ndofel)
call initializev(jatg,gint)
c Search of the enrichment type for the nodes of the current element.
c The keys to the enrichment types are stored in the element vector TypeXe
call typexelement(outdir,lenoutdir,jelem,nnode,nelmx,ix,typexe)
c element stiffness matrix computation, stored in amatrx
call k_u12(e,nu,amatrx,ndofel,nnode,dimens,mcrd,
coords,pss,nnodx,ix,typexe,dist,xyc0,xycprev,
gint,sg,xe,ye,flag,batg,dbatg,jatg)
c Routine that multiplies AMATRX times U to obtain the force vector F
c at the end of the current increment
call mult_v(amatrx,ndofel,ndofel,u,f,ndofel)
c compute the residual force vector
do i=1,ndofel
rhs(i,1) = rhs(i,1) - f(i)
end do
c Compute stresses at Gauss points for post-processing purposes
c Store them as SVARS for output to the results file (.fil)
call svars_u12(jtype,jelem,svars,nsvars,u,ndofel,batg,
1 dbatg,jatg,gint,mpg,xypg)
end if
end if
end if
return
end
C Element stiffness matrix. Subroutine: K U12
subroutine k_u12(e,nu,amatrx,ndofel,nnode,dimens,mcrd,
1 COORDS,PSS,NnodX,ix,TypeXe,Dist,XYC0,XYCPrev,
1 gint,sg,Xe,Ye,flag,BatG,DBatG,JatG)
implicit none
integer ndofel,nnode,dimens,mcrd,pss,nnodx,gint,flag,pos
integer l,i,j,kk,typexe(nnode),ix(nnode)
real*8 e,nu,dist(nnodx,3),sg(3,*)
real*8 amatrx(ndofel,ndofel),xyc0(2),xycprev(2)
real*8 xe(2*nnode),ye(2*nnode),coords(mcrd,nnode),xl(dimens,nnode)
real*8 xsj(gint),shp(3,4)
real*8 dnf(nnode,2,4),fnode(nnode,4),h,hnode(nnode)
real*8 b(3,ndofel), db(3,ndofel), bt(ndofel,3), d(3,3)
real*8 batg(3*gint,ndofel),dbatg(3*gint,ndofel),jatg(gint)
logical nodetype1,nodetype2
c NOTES:
c Routine shapef2D is called to compute standard shape functions,
c derivatives and jacobian at integration points. This routine outputs:
c shp(3,*) - Shape functions and derivatives at point
c shp(1,i) = dN_i/dx = dN_i/dx1
c shp(2,i) = dN_i/dy = dN_i/dx2
c shp(3,i) = N_i
c xsj - Jacobian determinant at point
c Local coordinates of integration points are passed in sg(1,*), sg(2,*)
c Integration weights are passed in sg(3,*)
c Initialize AMATRX and logical variables
call initializem(amatrx,ndofel,ndofel)
NodeType1=.false.
NodeType2=.false.
c Reduce info passed thru COORDS (3D) to xl (2D)
do i=1,dimens
do j=1,nnode
xl(i,j)=coords(i,j)
end do
end do
c Define constitutive stress-strain elastic matrix
call calc_d(pss,d,e,nu)
c Specify the type of nodal enrichment
do i=1,nnode
if (typexe(i).eq.1) then
nodetype1=.true.
elseif (typexe(i).eq.2) then
nodetype2=.true.
end if
end do
c Numerical integration loop over gint integration points
DO l = 1,gint
c Compute shape functions, derivatives and jacobian at integration point
call shapef2d(sg(1,l),xl,shp,xsj(l),dimens,nnode,ix,.false.)
if (flag.eq.1) then !element is subdivided for integration
xsj(l) = sg(3,l) !the integration weight includes the jacobian
else !element is not subdivided. standard integration
xsj(l) = xsj(l)*sg(3,l)
endif
c Value of the Heaviside function at integration point
c (This call is also used to store the values of H
c at nodes of the element for modified enrichment)
if (nodetype1) then
call heaviside(nnodx,dist,nnode,ix,shp,h,hnode)
endif
c Derivatives of shape functions Ni times enrichment functions Fj at integration point
c (This call is also used to compute the derivatives of shape functions Ni times
c enrichment functions Fj at nodes of the element for modified enrichment)
if (nodetype2) then
call fcracktip(xyc0,xycprev,shp,xe,ye,dnf,fnode)
endif
c STIFFNESS MATRIX COMPUTATION:
c Assembly of element matrix B (denoted as B) at integration point
call initializem(b,3,ndofel)
pos=1
c loop over nodes
do i= 1,nnode
c Contribution to B of derivatives of standard shape functions
B(1,Pos) = shp(1,i)
B(2,Pos+1)= shp(2,i)
B(3,Pos) = shp(2,i)
B(3,Pos+1)= shp(1,i)
c Contribution to B of derivatives of shape functions times Heaviside function
if (typexe(i).eq.1) then
b(1,2+pos) = shp(1,i)*(h-hnode(i))
b(2,3+pos) = shp(2,i)*(h-hnode(i))
b(3,2+pos) = shp(2,i)*(h-hnode(i))
b(3,3+pos) = shp(1,i)*(h-hnode(i))
c Contribution to B of derivatives of shape functions times crack tip functions
elseif(typexe(i).eq.2) then
do kk= 1,4
b(1,2*kk+2+pos)= dnf(i,1,kk)-shp(1,i)*fnode(i,kk)
b(2,2*kk+3+pos)= dnf(i,2,kk)-shp(2,i)*fnode(i,kk)
b(3,2*kk+2+pos)= dnf(i,2,kk)-shp(2,i)*fnode(i,kk)
b(3,2*kk+3+pos)= dnf(i,1,kk)-shp(1,i)*fnode(i,kk)
end do
end if
Pos=Pos+12 !Each node has 12 dof
end do ! i = end loop over element nodes
db=matmul(d,b) ! matrix d*b
bt=transpose(b) ! b transpose
c Integration of BT*D*B
amatrx= amatrx + matmul(bt,db)*xsj(l)
c store information at each integration point for further post-processing
do i=1,3
do j=1,ndofel
batg(3*(l-1)+i,j)=b(i,j)
dbatg(3*(l-1)+i,j)=db(i,j)
end do
end do
jatg(l)=xsj(l)
end do ! l = end loop for each integration point
return
end
c
SUBROUTINE SVARS_U12(JTYPE,JELEM,SVARS,NSVARS,U,Dof,BatG,DBatG,
* JatG,gint,mpg,xypg)
c Calculates and/or stores the following magnitudes at the element integration points,
c storing them in SVARS: strains, stresses, strain energy density, dv/dx, du/dy, jacobian,
c dNi/dx, dNi/dy, global coordinates of integration points.
IMPLICIT NONE
INTEGER i,j,k,NSVARS, Dof, gint, JTYPE,JELEM,mpg
REAL*8 SVARS(NSVARS), U(Dof),BatG(3*gint,Dof),DBatG(3*gint,Dof)
REAL*8 JatG(gint),B(3,Dof),DB(3,Dof),Bdvdx(3,Dof),Bdudy(3,Dof)
REAL*8 EPS(3),SIG(3),W,dvdx(3),dudy(3),JAC,xypg(2,mpg)
c &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
39
c &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
c First value stored in SVARS is the total number of integration points
c of the enriched element
SVARS(1)=gint
DO i=1,gint
JAC=JatG(i)
DO k=1,3
DO j=1,Dof
B(k,j)=BatG(3*(i-1)+k,j)
Bdvdx(k,j)=B(k,j) ! For computation of dv/dx
Bdudy(k,j)=B(k,j) ! For computation of du/dy
DB(k,j)=DBatG(3*(i-1)+k,j)
END DO
END DO
CALL MULT_V(B,3,Dof,U,EPS,3) ! Compute strains EPS
CALL MULT_V(DB,3,Dof,U,SIG,3) ! Compute stresses SIG
W=0.5d0*(EPS(1)*SIG(1)+EPS(2)*SIG(2)+EPS(3)*SIG(3))
c Computation of dv/dx & du/dy
c Set to zero positions in the 3rd row of B associated with dN/dy
DO j=1,Dof,2
Bdvdx(3,j)=0.0d0
END DO
CALL MULT_V(Bdvdx,3,Dof,U,dvdx,3) !compute dv/dx, stored in dvdx(3)
c Set to zero positions in the 3rd row of B associated with dN/dx
DO j=2,Dof,2
Bdudy(3,j)=0.0d0
END DO
CALL MULT_V(Bdudy,3,Dof,U,dudy,3) !compute du/dy, stored in dudy(3)
c Store in SVARS the following information at integration points
SVARS(1+20*(i-1)+1)=EPS(1)
SVARS(1+20*(i-1)+2)=EPS(2)
SVARS(1+20*(i-1)+3)=EPS(3)
SVARS(1+20*(i-1)+4)=SIG(1)
SVARS(1+20*(i-1)+5)=SIG(2)
SVARS(1+20*(i-1)+6)=SIG(3)
SVARS(1+20*(i-1)+7)=W
SVARS(1+20*(i-1)+8)=dvdx(3)
SVARS(1+20*(i-1)+9)=dudy(3)
SVARS(1+20*(i-1)+10)=JAC ! Jacobian includes integration weight
c Store in SVARS the shape functions derivatives dNi/dx, dNi/dy for external computation
c of dq/dx, dq/dy (used in domain interaction integrals).
c (we take them from the positions associated with the standard dofs)
SVARS(1+20*(i-1)+11)=B(1,1)
SVARS(1+20*(i-1)+12)=B(1,13)
SVARS(1+20*(i-1)+13)=B(1,25)
SVARS(1+20*(i-1)+14)=B(1,37)
SVARS(1+20*(i-1)+15)=B(2,2)
SVARS(1+20*(i-1)+16)=B(2,14)
SVARS(1+20*(i-1)+17)=B(2,26)
SVARS(1+20*(i-1)+18)=B(2,38)
Store in SVARS the global coordinates of integration points
SVARS(1+20*(i-1)+19)=xypg(1,i)
SVARS(1+20*(i-1)+20)=xypg(2,i)
END DO !i loop over all integration points of the element
RETURN
END

70
Unpublished/XFEM2/XFEM/JTruss.for Normal file
View file

@ -0,0 +1,70 @@
subroutine uel(rhs,amatrx,svars,energy,ndofel,nrhs,nsvars,
1 props,nprops,coords,mcrd,nnode,u,du,v,a,jtype,time,
2 dtime,kstep,kinc,jelem,params,ndload,jdltyp,adlmag,
3 predef,npredf,lflags,mlvarx,ddlmag,mdload,pnewdt,
4 jprops,njprop,period)
c
include 'aba_param.inc'
parameter ( zero = 0.d0, half = 0.5d0, one = 1.d0 )
c
c This is a linear truss element for Abaqus/Standard
c general static analysis in 1D space (aligned to x-axis) only.
dimension rhs(mlvarx,*),amatrx(ndofel,ndofel),
1 svars(nsvars),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(*),
5 jprops(*)
c
c assign section properties
area = props(1)
e = props(2)
anu = props(3)
rho = props(4)
c calculate stiffness and mass
alen = abs(coords(1,2)-coords(1,1))
ak = area*e/alen
am = half*area*rho*alen
c Initialize Arrays
rhs = zero
amatrx = zero
if (lflags(3).eq.1) then
C Stiffness and Force
C Get Stiffness Matrix
amatrx(1,1) = ak
amatrx(4,4) = ak
amatrx(1,4) = -ak
amatrx(4,1) = -ak
c Get Internal Contrib to Residual Force
rhs(1,1) = -ak*(u(1)-u(4))
rhs(4,1) = -ak*(u(4)-u(1))
c Get External Contrib to Residual Force
do kdload = 1, ndload
if (jdltyp(kdload,1).eq.1001) then
rhs(4,1) = rhs(4,1)+adlmag(kdload,1)
end if
end do
else if (lflags(3).eq.2) then
c Stiffness
amatrx(1,1) = ak
amatrx(4,4) = ak
amatrx(1,4) = -ak
amatrx(4,1) = -ak
else if (lflags(3).eq.4) then
c Mass
do k1 = 1, ndofel
amatrx(k1,k1) = am
end do
else if (lflags(3).eq.5) then
print *,'oops'
else if (lflags(3).eq.6) then
C Mass and Force
do k1 = 1, ndofel
amatrx(k1,k1) = am
end do
rhs(1,1) = -ak*(u(1)-u(4))
rhs(4,1) = -ak*(u(4)-u(1))
END IF
c
return
end

202
Unpublished/XFEM2/XFEM/UEL2_TRANHTX.f Normal file
View file

@ -0,0 +1,202 @@
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

165
Unpublished/XFEM2/XFEM/UEL2_TRANHTX.for Normal file
View file

@ -0,0 +1,165 @@
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
dpos1=0.6
c material property definition
rho = 1.
spec = 1.
c penalty term
beta=100.
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)
c if (term<0.)then
c cond=0.
c spec=0.1
c else
cond=1.
spec=1.
c endif
c if(enr==4)then
phi(2)=phi(1)*(abs(term)-abs(theta(1)))
phi(4)=phi(3)*(abs(term)-abs(theta(2)))
c else
c phi(2)=0.
c phi(4)=0.
c endif
c dNdci
phic(1)=-0.5
phic(3)=0.5
dterm=sign(1.,term)*(phic(1)*theta(1)+phic(3)*theta(2))
c 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
c else
c phic(2)=0.
c phic(4)=0.
c 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 a 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
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

80
Unpublished/XFEM2/XFEM/UEL_TRANHT.for Normal file
View file

@ -0,0 +1,80 @@
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(9),gwei(9),phi(8),phix(8),phic(8),stiffk(2,2)
dimension stiffm(2,2)
c
c print *,u(1),u(2),du(1,nhrs),du(2,nhrs),time(1),lflags(3)
c material property definition
rho = 1.
spec = 1.
conduc = 1.
c initialization (nrhs=1)
do k1=1,ndofel
rhs(k1,nrhs)=0.
do k2=1,ndofel
amatrx(k2,k1)=0.
stiffk(k2,k1)=0.
stiffm(k2,k1)=0.
enddo
enddo
if (lflags(3).eq.4) return
c transient analysis
if (lflags(1).eq.33) then
c determine gauss point locations
gpx(1)=-1./sqrt(3.)
gpx(2)=1./sqrt(3.)
gwei(1)=1.
gwei(2)=1.
c assemble amatrx and rhs
do k=1,2
c loop through gauss pts
c=gpx(k)
c get shape functions and derivatives
phi(1)=(1.-c)/2.
phi(2)=(1.+c)/2.
phic(1)=-0.5
phic(2)=0.5
dxdc=abs(coords(1,2)-coords(1,1))/2.
ajacob=dxdc
phix(1)=phic(1)*(1./ajacob)
phix(2)=phic(2)*(1./ajacob)
c interpolate temperatures to int points
dtdx=u(1)*phix(1)+u(2)*phix(2)
t=u(1)*phi(1)+u(2)*phi(2)
told=(u(1)-du(1,nrhs))*phi(1)+(u(2)-du(2,nrhs))*phi(2)
c other housekeeping
cond=conduc
dtdt=(t-told)/dtime
we=gwei(k)*ajacob
c Assemble Element Stiffness Matrix and Add to Global
do ki=1,2
c loop over nodes
rhs(ki,nrhs)=rhs(ki,nrhs)-we*(phi(ki)*rho*spec*dtdt
1 + cond*(phix(ki)*dtdx))
do kj=1,2
stiffk(ki,kj)=stiffk(ki,kj)+
1 we*cond*(phix(ki)*phix(kj))
stiffm(ki,kj)=stiffm(ki,kj)+
1 we*(phi(ki)*phi(kj)*rho*spec)/dtime
end do
end do
do i=1,2
do j=1,2
amatrx(i,j)=stiffk(i,j)+stiffm(i,j)
enddo
enddo
enddo
end if
return
end

81
Unpublished/XFEM2/XFEM/UEL_TRANHTX.f Normal file
View file

@ -0,0 +1,81 @@
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(9),gwei(9),phi(8),phix(8),phic(8)
c
c print *,u(1),u(2),du(1,nhrs),du(2,nhrs),time(1),lflags(3)
c level set calculation
dpos=0.01*time
c
c material property definition
rho = 1.
spec = 1.
conduc = 1.
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 gauss point locations
gpx(1)=-1./sqrt(3.)
gpx(2)=1./sqrt(3.)
gwei(1)=1.
gwei(2)=1.
c determine node level sets
rnl1=abs(coords(1,1)-dpos)
rnl2=abs(coords(1,2)-dpos)
c get jacobian
dxdc=abs(coords(1,2)-coords(1,1))/2.
ajacob=dxdc
c assemble amatrx and rhs
do k=1,4
c loop through gauss pts
c=gpx(k)
c get shape functions and derivatives
phi(1)=(1.-c)/2.
phi(2)=(1.+c)/2.
c get ip position
pos=coord(1,1)+ajacob(1.+c)
phi(3)=abs(c)
phic(1)=-0.5
phic(2)=0.5
phix(1)=phic(1)*(1./ajacob)
phix(2)=phic(2)*(1./ajacob)
c interpolate temperatures to int points
dtdx=u(1)*phix(1)+u(2)*phix(2)
t=u(1)*phi(1)+u(2)*phi(2)
told=(u(1)-du(1,nrhs))*phi(1)+(u(2)-du(2,nrhs))*phi(2)
c other housekeeping
cond=conduc
dtdt=(t-told)/dtime
we=gwei(k)*ajacob
c Assemble Element Stiffness Matrix and Add to Global
do ki=1,2
c loop over nodes
rhs(ki,nrhs)=rhs(ki,nrhs)-we*(phi(ki)*rho*spec*dtdt
1 + cond*(phix(ki)*dtdx))
do kj=1,2
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
return
end

202
Unpublished/XFEM2/XFEM/UEL_TRANHTX.for Normal file
View file

@ -0,0 +1,202 @@
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

114
Unpublished/XFEM2/XFEM/UEL_TRANHT_2d.for Normal file
View file

@ -0,0 +1,114 @@
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 gx(4),hx(4),phi(4),phix(4),phiy(4),phig(4),phih(4)
dimension rjac(2,2),rjaci(2,2)
c
c material property definition
rho = 1.
spec = 1.
cond = 1.
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 gauss point locations
gpos=1./sqrt(3.)
gx(1)=-gpos
gx(2)=gpos
gx(3)=gpos
gx(4)=-gpos
hx(1)=-gpos
hx(2)=-gpos
hx(3)=gpos
hx(4)=gpos
c assemble amatrx and rhs
do k=1,4
c loop through gauss pts
g=gx(k)
h=hx(k)
c get shape functions and derivatives
phi(1)=0.25*(1.-g)*(1.-h)
phi(2)=0.25*(1.+g)*(1.-h)
phi(3)=0.25*(1.+g)*(1.+h)
phi(4)=0.25*(1.-g)*(1.+h)
phig(1)=0.25*-(1.-h)
phig(2)=0.25*(1.-h)
phig(3)=0.25*(1.+h)
phig(4)=0.25*-(1.+h)
phih(1)=0.25*-(1.-g)
phih(2)=0.25*-(1.+g)
phih(3)=0.25*(1.+g)
phih(4)=0.25*(1.-g)
c get ip coords
crdx=0.
crdy=0.
do k1=1,4
crdx=crdx+phi(k1)*coords(1,k1)
crdy=crdy+phi(k1)*coords(2,k1)
end do
c get jacobian
rjac=0.
do i=1,4
rjac(1,1)=rjac(1,1)+phig(i)*coords(1,i)
rjac(1,2)=rjac(1,2)+phig(i)*coords(2,i)
rjac(2,1)=rjac(2,1)+phih(i)*coords(1,i)
rjac(2,2)=rjac(2,2)+phih(i)*coords(2,i)
enddo
djac=rjac(1,1)*rjac(2,2)-rjac(1,2)*rjac(2,1)
print *,djac
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
c get b matrix
phix(1)=rjaci(1,1)*phig(1)+rjaci(1,2)*phih(1)
phiy(1)=rjaci(2,1)*phig(1)+rjaci(2,2)*phih(1)
phix(2)=rjaci(1,1)*phig(2)+rjaci(1,2)*phih(2)
phiy(2)=rjaci(2,1)*phig(2)+rjaci(2,2)*phih(2)
phix(3)=rjaci(1,1)*phig(3)+rjaci(1,2)*phih(3)
phiy(3)=rjaci(2,1)*phig(3)+rjaci(2,2)*phih(3)
phix(4)=rjaci(1,1)*phig(4)+rjaci(1,2)*phih(4)
phiy(4)=rjaci(2,1)*phig(4)+rjaci(2,2)*phih(4)
c interpolate temperatures to int points
dtdx=u(1)*phix(1)+u(2)*phix(2)
1 +u(3)*phix(3)+u(4)*phix(4)
dtdy=u(1)*phiy(1)+u(2)*phiy(2)
1 +u(3)*phiy(3)+u(4)*phiy(4)
t=u(1)*phi(1)+u(2)*phi(2)+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=djac
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+phiy(ki)*dtdy))
do kj=1,4
amatrx(ki,kj)=amatrx(ki,kj)+we*(phi(ki)*phi(kj)
1 *rho*spec/dtime+cond*(phix(ki)*phix(kj)+
1 phiy(ki)*phiy(kj)))
end do
end do
enddo
end if
return
end

198
Unpublished/XFEM2/XFEM/htelem.for Normal file
View file

@ -0,0 +1,198 @@
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 GPX(9),GPY(9),GWEI(9),PHI(8),PHIX(8),PHIY(8),PHIC(8),
1 PHIE(8),IFACE(9),GWE(3),AR(3)
C
PARAMETER(ZERO=0.D0,TWOHUN=200.D0,FIVHUN=500.D0,CONDUC=204.D0)
DATA IFACE/1,5,2,6,3,7,4,8,1/
C
C
C MATERIAL PROPERTY DEFINITION
C
THICK = PROPS(1)
RHO = PROPS(2)
SPEC = PROPS(3)
C
C INITIALIZATION (NRHS=1)
C
DO 6 K1=1,NDOFEL
RHS(K1,NRHS)=ZERO
DO 4 K2=1,NDOFEL
AMATRX(K2,K1)=ZERO
4 CONTINUE
6 CONTINUE
C
IF (LFLAGS(3).EQ.4) RETURN
C
C TRANSIENT ANALYSIS
C
IF (LFLAGS(1).EQ.33) THEN
C
C DETERMINE GAUSS POINT LOCATIONS
C
SUBROUTINE GSPT(GPX,GPY)
INCLUDE 'aba_param.inc'
DIMENSION AR(3),GPX(9),GPY(9)
C
PARAMETER(ZERO=0.D0,ONENEG=-1.D0,ONE=1.D0,SIX=6.D0,TEN=10.D0)
C
C GPX: X COORDINATE OF GAUSS PT
C GPY: Y COORDINATE OF GAUSS PT
C
R=SQRT(SIX/TEN)
AR(1)=-1.
AR(2)=0.
AR(3)=1.
DO 10 I=1,3
DO 10 J=1,3
NUMGP=(I-1)*3+J
GPX(NUMGP)=AR(I)*R
GPY(NUMGP)=AR(J)*R
10 CONTINUE
RETURN
END
CALL GSPT(GPX,GPY)
C
C DETERMINE GAUSS WEIGHTS
C
CALL GSWT(GWEI,GWE)
C
C ASSEMBLE AMATRX AND RHS
C
DO 300 K=1,9
C LOOP THROUGH GAUSS PTS
C=GPX(K)
E=GPY(K)
CALL DER(C,E,GPX,GPY,GWEI,PHI,PHIX,PHIY,PHIC,PHIE
1 ,DXDC,DXDE,DYDC,DYDE,AJACOB,COORDS,MCRD,NNODE)
DTDX=ZERO
DTDY=ZERO
T =ZERO
TOLD=ZERO
DO I=1,8
DTDX=U(I)*PHIX(I)+DTDX
DTDY=U(I)*PHIY(I)+DTDY
T =U(I)*PHI(I)+T
TOLD=(U(I)-DU(I,NRHS))*PHI(I)+TOLD
END DO
C CHECK ON TEMPERATURE DEPENDENCE OF THERMAL CONDUCTIVITY
COND=CONDUC
DCDT=ZERO
DTDT=(T-TOLD)/DTIME
WE=GWEI(K)*AJACOB
DO KI=1,8
C LOOP OVER NODES
RHS(KI,NRHS) = RHS(KI,NRHS) -
1 WE*(PHI(KI)*RHO*SPEC*DTDT +
2 COND*(PHIX(KI)*DTDX + PHIY(KI)*DTDY))
DO KJ=1,8
AMATRX(KI,KJ)= AMATRX(KI,KJ) + WE*(PHI(KI)*PHI(KJ)*RHO*
1 SPEC/DTIME + COND*(PHIX(KI)*PHIX(KJ) + PHIY(KI)*
2 PHIY(KJ)) + DCDT*PHI(KJ)*(PHIX(KI)*DTDX +
3 PHIY(KI)*DTDY))
END DO
END DO
300 CONTINUE
C
RETURN
END
C
C
SUBROUTINE GSWT(GWEI,GWE)
INCLUDE 'aba_param.inc'
DIMENSION GWEI(9),GWE(3)
C
PARAMETER(FIVE=5.D0,EIGHT=8.D0,NINE=9.D0)
C
C GWEI : GAUSS WEIGHT
C
GWE(1)=FIVE/NINE
GWE(2)=EIGHT/NINE
GWE(3)=FIVE/NINE
DO 10 I=1,3
DO 10 J=1,3
NUMGP=(I-1)*3+J
GWEI(NUMGP)=GWE(I)*GWE(J)
10 CONTINUE
RETURN
END
C
SUBROUTINE DER(C,E,GPX,GPY,GWEI,PHI,PHIX,PHIY,PHIC,PHIE,
1 DXDC,DXDE,DYDC,DYDE,AJACOB,COORDS,MCRD,NNODE)
INCLUDE 'aba_param.inc'
DIMENSION PHI(8),PHIX(8),PHIY(8),PHIC(8),PHIE(8),
1 COORDS(MCRD,NNODE)
C
PARAMETER(ZERO=0.D0,FOURTH=0.25D0,HALF=0.5D0,ONE=1.D0,TWO=2.D0)
C
C INTERPOLATION FUNCTIONS
C
PHI(1) = FOURTH*(ONE-C)*(ONE-E)*(-C-E-ONE)
PHI(2) = FOURTH*(ONE+C)*(ONE-E)*(C-E-ONE)
PHI(3) = FOURTH*(ONE+C)*(ONE+E)*(C+E-ONE)
PHI(4) = FOURTH*(ONE-C)*(ONE+E)*(-C+E-ONE)
PHI(5) = HALF*(ONE-C*C)*(ONE-E)
PHI(6) = HALF*(ONE+C)*(ONE-E*E)
PHI(7) = HALF*(ONE-C*C)*(ONE+E)
PHI(8) = HALF*(ONE-C)*(ONE-E*E)
C
C DERIVATIVES WRT TO C
C
PHIC(1) = FOURTH*(ONE-E)*(TWO*C+E)
PHIC(2) = FOURTH*(ONE-E)*(TWO*C-E)
PHIC(3) = FOURTH*(ONE+E)*(TWO*C+E)
PHIC(4) = FOURTH*(ONE+E)*(TWO*C-E)
PHIC(5) = -C*(ONE-E)
PHIC(6) = HALF*(ONE-E*E)
PHIC(7) = -C*(ONE+E)
PHIC(8) = -HALF*(ONE-E*E)
C
C DERIVATIVES WRT TO E
C
PHIE(1) = FOURTH*(ONE-C)*(TWO*E+C)
PHIE(2) = FOURTH*(ONE+C)*(TWO*E-C)
PHIE(3) = FOURTH*(ONE+C)*(TWO*E+C)
PHIE(4) = FOURTH*(ONE-C)*(TWO*E-C)
PHIE(5) = -HALF*(ONE-C*C)
PHIE(6) = -E*(ONE+C)
PHIE(7) = HALF*(ONE-C*C)
PHIE(8) = -E*(ONE-C)
DXDC=ZERO
DXDE=ZERO
DYDC=ZERO
DYDE=ZERO
DO 3 I=1,8
DXDC=DXDC+COORDS(1,I)*PHIC(I)
DXDE=DXDE+COORDS(1,I)*PHIE(I)
DYDC=DYDC+COORDS(2,I)*PHIC(I)
DYDE=DYDE+COORDS(2,I)*PHIE(I)
3 CONTINUE
C
C CALCULATION OF JACOBIAN
C
AJACOB=(DXDC*DYDE-DXDE*DYDC)
C
C DERIVATIVES WRT TO X AND Y
C
DO 5 I=1,8
PHIX(I)=(PHIC(I)*DYDE-PHIE(I)*DYDC)/AJACOB
PHIY(I)=(PHIE(I)*DXDC-PHIC(I)*DXDE)/AJACOB
5 CONTINUE
RETURN
END

192
Unpublished/XFEM2/XFEM/uel.for Normal file
View file

@ -0,0 +1,192 @@
SUBROUTINE UEL(RHS,AMATRX,SVARS,ENERGY,NDOFEL,NRHS,NSVARS,
1 PROPS,NPROPS,COORDS,MCRD,NNODE,U,DU,V,A,JTYPE,TIME,
2 DTIME,KSTEP,KINC,JELEM,PARAMS,NDLOAD,JDLTYP,ADLMAG,
3 PREDEF,NPREDF,LFLAGS,MLVARX,DDLMAG,MDLOAD,PNEWDT,
4 JPROPS,NJPROP,PERIOD)
C
INCLUDE 'ABA_PARAM.INC'
PARAMETER ( ZERO = 0.D0, HALF = 0.5D0, ONE = 1.D0 )
C
DIMENSION RHS(MLVARX,*),AMATRX(NDOFEL,NDOFEL),
1 SVARS(NSVARS),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(*),
5 JPROPS(*)
DIMENSION SRESID(6)
C
C UEL SUBROUTINE FOR A HORIZONTAL TRUSS ELEMENT
C
C SRESID - stores the static residual at time t+dt
C SVARS - In 1-6, contains the static residual at time t
C upon entering the routine. SRESID is copied to
C SVARS(1-6) after the dynamic residual has been
C calculated.
C - For half-increment residual calculations: In 7-12,
C contains the static residual at the beginning
C of the previous increment. SVARS(1-6) are copied
C into SVARS(7-12) after the dynamic residual has
C been calculated.
C
AREA = PROPS(1)
E = PROPS(2)
ANU = PROPS(3)
RHO = PROPS(4)
C
ALEN = ABS(COORDS(1,2)-COORDS(1,1))
AK = AREA*E/ALEN
AM = HALF*AREA*RHO*ALEN
C
DO K1 = 1, NDOFEL
SRESID(K1) = ZERO
DO KRHS = 1, NRHS
RHS(K1,KRHS) = ZERO
END DO
DO K2 = 1, NDOFEL
AMATRX(K2,K1) = ZERO
END DO
END DO
C
IF (LFLAGS(3).EQ.1) THEN
C Normal incrementation
IF (LFLAGS(1).EQ.1 .OR. LFLAGS(1).EQ.2) THEN
C *STATIC
AMATRX(1,1) = AK
AMATRX(4,4) = AK
AMATRX(1,4) = -AK
AMATRX(4,1) = -AK
IF (LFLAGS(4).NE.0) THEN
FORCE = AK*(U(4)-U(1))
DFORCE = AK*(DU(4,1)-DU(1,1))
SRESID(1) = -DFORCE
SRESID(4) = DFORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
ENERGY(2) = HALF*FORCE*(DU(4,1)-DU(1,1))
* + HALF*DFORCE*(U(4)-U(1))
* + HALF*DFORCE*(DU(4,1)-DU(1,1))
ELSE
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
DO KDLOAD = 1, NDLOAD
IF (JDLTYP(KDLOAD,1).EQ.1001) THEN
RHS(4,1) = RHS(4,1)+ADLMAG(KDLOAD,1)
ENERGY(8) = ENERGY(8)+(ADLMAG(KDLOAD,1)
* - HALF*DDLMAG(KDLOAD,1))*DU(4,1)
IF (NRHS.EQ.2) THEN
C Riks
RHS(4,2) = RHS(4,2)+DDLMAG(KDLOAD,1)
END IF
END IF
END DO
ENERGY(2) = HALF*FORCE*(U(4)-U(1))
END IF
ELSE IF (LFLAGS(1).EQ.11 .OR. LFLAGS(1).EQ.12) THEN
C *DYNAMIC
ALPHA = PARAMS(1)
BETA = PARAMS(2)
GAMMA = PARAMS(3)
C
DADU = ONE/(BETA*DTIME**2)
DVDU = GAMMA/(BETA*DTIME)
C
DO K1 = 1, NDOFEL
AMATRX(K1,K1) = AM*DADU
RHS(K1,1) = RHS(K1,1)-AM*A(K1)
END DO
AMATRX(1,1) = AMATRX(1,1)+(ONE+ALPHA)*AK
AMATRX(4,4) = AMATRX(4,4)+(ONE+ALPHA)*AK
AMATRX(1,4) = AMATRX(1,4)-(ONE+ALPHA)*AK
AMATRX(4,1) = AMATRX(4,1)-(ONE+ALPHA)*AK
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1) -
* ((ONE+ALPHA)*SRESID(1)-ALPHA*SVARS(1))
RHS(4,1) = RHS(4,1) -
* ((ONE+ALPHA)*SRESID(4)-ALPHA*SVARS(4))
ENERGY(1) = ZERO
DO K1 = 1, NDOFEL
SVARS(K1+6) = SVARS(k1)
SVARS(K1) = SRESID(K1)
ENERGY(1) = ENERGY(1)+HALF*V(K1)*AM*V(K1)
END DO
ENERGY(2) = HALF*FORCE*(U(4)-U(1))
END IF
ELSE IF (LFLAGS(3).EQ.2) THEN
C Stiffness matrix
AMATRX(1,1) = AK
AMATRX(4,4) = AK
AMATRX(1,4) = -AK
AMATRX(4,1) = -AK
ELSE IF (LFLAGS(3).EQ.4) THEN
C Mass matrix
DO K1 = 1, NDOFEL
AMATRX(K1,K1) = AM
END DO
ELSE IF (LFLAGS(3).EQ.5) THEN
C Half-increment residual calculation
ALPHA = PARAMS(1)
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1)-AM*A(1)-(ONE+ALPHA)*SRESID(1)
* + HALF*ALPHA*( SVARS(1)+SVARS(7) )
RHS(4,1) = RHS(4,1)-AM*A(4)-(ONE+ALPHA)*SRESID(4)
* + HALF*ALPHA*( SVARS(4)+SVARS(10) )
ELSE IF (LFLAGS(3).EQ.6) THEN
C Initial acceleration calculation
DO K1 = 1, NDOFEL
AMATRX(K1,K1) = AM
END DO
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
ENERGY(1) = ZERO
DO K1 = 1, NDOFEL
SVARS(K1) = SRESID(K1)
ENERGY(1) = ENERGY(1)+HALF*V(K1)*AM*V(K1)
END DO
ENERGY(2) = HALF*FORCE*(U(4)-U(1))
ELSE IF (LFLAGS(3).EQ.100) THEN
C Output for perturbations
IF (LFLAGS(1).EQ.1 .OR. LFLAGS(1).EQ.2) THEN
C *STATIC
FORCE = AK*(U(4)-U(1))
DFORCE = AK*(DU(4,1)-DU(1,1))
SRESID(1) = -DFORCE
SRESID(4) = DFORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
ENERGY(2) = HALF*FORCE*(DU(4,1)-DU(1,1))
* + HALF*DFORCE*(U(4)-U(1))
* + HALF*DFORCE*(DU(4,1)-DU(1,1))
DO KVAR = 1, NSVARS
SVARS(KVAR) = ZERO
END DO
SVARS(1) = RHS(1,1)
SVARS(4) = RHS(4,1)
ELSE IF (LFLAGS(1).EQ.41) THEN
C *FREQUENCY
DO KRHS = 1, NRHS
DFORCE = AK*(DU(4,KRHS)-DU(1,KRHS))
SRESID(1) = -DFORCE
SRESID(4) = DFORCE
RHS(1,KRHS) = RHS(1,KRHS)-SRESID(1)
RHS(4,KRHS) = RHS(4,KRHS)-SRESID(4)
END DO
DO KVAR = 1, NSVARS
SVARS(KVAR) = ZERO
END DO
SVARS(1) = RHS(1,1)
SVARS(4) = RHS(4,1)
END IF
END IF
C
RETURN
END

367
Unpublished/XFEM2/XFEM/uelmat.for Normal file
View file

@ -0,0 +1,367 @@
c***********************************************************
subroutine uelmat(rhs,amatrx,svars,energy,ndofel,nrhs,
1 nsvars,props,nprops,coords,mcrd,nnode,u,du,
2 v,a,jtype,time,dtime,kstep,kinc,jelem,params,
3 ndload,jdltyp,adlmag,predef,npredf,lflags,mlvarx,
4 ddlmag,mdload,pnewdt,jprops,njpro,period,
5 materiallib)
c
include 'aba_param.inc'
C
dimension rhs(mlvarx,*), amatrx(ndofel, ndofel), props(*),
1 svars(*), energy(*), coords(mcrd, nnode), u(ndofel),
2 du(mlvarx,*), v(ndofel), a(ndofel), time(2), params(*),
3 jdltyp(mdload,*), adlmag(mdload,*), ddlmag(mdload,*),
4 predef(2, npredf, nnode), lflags(*), jprops(*)
parameter (zero=0.d0, dmone=-1.0d0, one=1.d0, four=4.0d0,
1 fourth=0.25d0,gaussCoord=0.577350269d0)
parameter (ndim=2, ndof=2, nshr=1,nnodemax=4,
1 ntens=4, ninpt=4, nsvint=4)
c
c ndim ... number of spatial dimensions
c ndof ... number of degrees of freedom per node
c nshr ... number of shear stress component
c ntens ... total number of stress tensor components
c (=ndi+nshr)
c ninpt ... number of integration points
c nsvint... number of state variables per integration pt
c (strain)
c
dimension stiff(ndof*nnodemax,ndof*nnodemax),
1 force(ndof*nnodemax), shape(nnodemax), dshape(ndim,nnodemax),
2 xjac(ndim,ndim),xjaci(ndim,ndim), bmat(nnodemax*ndim),
3 statevLocal(nsvint),stress(ntens), ddsdde(ntens, ntens),
4 stran(ntens), dstran(ntens), wght(ninpt)
c
dimension predef_loc(npredf),dpredef_loc(npredf),
1 defGrad(3,3),utmp(3),xdu(3),stiff_p(3,3),force_p(3)
dimension coord24(2,4),coords_ip(3)
data coord24 /dmone, dmone,
2 one, dmone,
3 one, one,
4 dmone, one/
c
data wght /one, one, one, one/
c
c*************************************************************
c
c U1 = first-order, plane strain, full integration
c
c State variables: each integration point has nsvint SDVs
c
c isvinc=(npt-1)*nsvint ... integration point counter
c statev(1+isvinc ) ... strain
c
c*************************************************************
if (lflags(3).eq.4) then
do i=1, ndofel
do j=1, ndofel
amatrx(i,j) = zero
end do
amatrx(i,i) = one
end do
goto 999
end if
c
c PRELIMINARIES
c
pnewdtLocal = pnewdt
if(jtype .ne. 1) then
write(7,*)'Incorrect element type'
call xit
endif
if(nsvars .lt. ninpt*nsvint) then
write(7,*)'Increase the number of SDVs to', ninpt*nsvint
call xit
endif
thickness = 0.1d0
c
c INITIALIZE RHS AND LHS
c
do k1=1, ndof*nnode
rhs(k1, 1)= zero
do k2=1, ndof*nnode
amatrx(k1, k2)= zero
end do
end do
c
c LOOP OVER INTEGRATION POINTS
c
do kintk = 1, ninpt
c
c EVALUATE SHAPE FUNCTIONS AND THEIR DERIVATIVES
c
c determine (g,h)
c
g = coord24(1,kintk)*gaussCoord
h = coord24(2,kintk)*gaussCoord
c
c shape functions
shape(1) = (one - g)*(one - h)/four;
shape(2) = (one + g)*(one - h)/four;
shape(3) = (one + g)*(one + h)/four;
shape(4) = (one - g)*(one + h)/four;
c
c derivative d(Ni)/d(g)
dshape(1,1) = -(one - h)/four;
dshape(1,2) = (one - h)/four;
dshape(1,3) = (one + h)/four;
dshape(1,4) = -(one + h)/four;
c
c derivative d(Ni)/d(h)
dshape(2,1) = -(one - g)/four;
dshape(2,2) = -(one + g)/four;
dshape(2,3) = (one + g)/four;
dshape(2,4) = (one - g)/four;
c
c compute coordinates at the integration point
c
do k1=1, 3
coords_ip(k1) = zero
end do
do k1=1,nnode
do k2=1,mcrd
coords_ip(k2)=coords_ip(k2)+shape(k1)*coords(k2,k1)
end do
end do
c
c INTERPOLATE FIELD VARIABLES
c
if(npredf.gt.0) then
do k1=1,npredf
predef_loc(k1) = zero
dpredef_loc(k1) = zero
do k2=1,nnode
predef_loc(k1) =
& predef_loc(k1)+
& (predef(1,k1,k2)-predef(2,k1,k2))*shape(k2)
dpredef_loc(k1) =
& dpredef_loc(k1)+predef(2,k1,k2)*shape(k2)
end do
end do
end if
c
c FORM B-MATRIX
c
djac = one
c
do i = 1, ndim
do j = 1, ndim
xjac(i,j) = zero
xjaci(i,j) = zero
end do
end do
c
do inod= 1, nnode
do idim = 1, ndim
do jdim = 1, ndim
xjac(jdim,idim) = xjac(jdim,idim) +
1 dshape(jdim,inod)*coords(idim,inod)
end do
end do
end do
djac = xjac(1,1)*xjac(2,2) - xjac(1,2)*xjac(2,1)
if (djac .gt. zero) then
! jacobian is positive - o.k.
xjaci(1,1) = xjac(2,2)/djac
xjaci(2,2) = xjac(1,1)/djac
xjaci(1,2) = -xjac(1,2)/djac
xjaci(2,1) = -xjac(2,1)/djac
else
! negative or zero jacobian
write(7,*)'WARNING: element',jelem,'has neg.
1 Jacobian'
pnewdt = fourth
endif
if (pnewdt .lt. pnewdtLocal) pnewdtLocal = pnewdt
c
do i = 1, nnode*ndim
bmat(i) = zero
end do
do inod = 1, nnode
do ider = 1, ndim
do idim = 1, ndim
irow = idim + (inod - 1)*ndim
bmat(irow) = bmat(irow) +
1 xjaci(idim,ider)*dshape(ider,inod)
end do
end do
end do
c
c CALCULATE INCREMENTAL STRAINS
c
do i = 1, ntens
dstran(i) = zero
end do
!
! set deformation gradient to Identity matrix
do k1=1,3
do k2=1,3
defGrad(k1,k2) = zero
end do
defGrad(k1,k1) = one
end do
c
c COMPUTE INCREMENTAL STRAINS
c
do nodi = 1, nnode
incr_row = (nodi - 1)*ndof
do i = 1, ndof
xdu(i)= du(i + incr_row,1)
utmp(i) = u(i + incr_row)
end do
dNidx = bmat(1 + (nodi-1)*ndim)
dNidy = bmat(2 + (nodi-1)*ndim)
dstran(1) = dstran(1) + dNidx*xdu(1)
dstran(2) = dstran(2) + dNidy*xdu(2)
dstran(4) = dstran(4) +
1 dNidy*xdu(1) +
2 dNidx*xdu(2)
c deformation gradient
defGrad(1,1) = defGrad(1,1) + dNidx*utmp(1)
defGrad(1,2) = defGrad(1,2) + dNidy*utmp(1)
defGrad(2,1) = defGrad(2,1) + dNidx*utmp(2)
defGrad(2,2) = defGrad(2,2) + dNidy*utmp(2)
end do
c
c CALL CONSTITUTIVE ROUTINE
c
isvinc= (kintk-1)*nsvint ! integration point increment
c
c prepare arrays for entry into material routines
c
do i = 1, nsvint
statevLocal(i)=svars(i+isvinc)
end do
c
c state variables
c
do k1=1,ntens
stran(k1) = statevLocal(k1)
stress(k1) = zero
end do
c
do i=1, ntens
do j=1, ntens
ddsdde(i,j) = zero
end do
ddsdde(i,j) = one
enddo
c
c compute characteristic element length
c
celent = sqrt(djac*dble(ninpt))
dvmat = djac*thickness
c
dvdv0 = one
call material_lib_mech(materiallib,stress,ddsdde,
1 stran,dstran,kintk,dvdv0,dvmat,defGrad,
2 predef_loc,dpredef_loc,npredf,celent,coords_ip)
c
do k1=1,ntens
statevLocal(k1) = stran(k1) + dstran(k1)
end do
c
isvinc= (kintk-1)*nsvint ! integration point increment
c
c update element state variables
c
do i = 1, nsvint
svars(i+isvinc)=statevLocal(i)
end do
c
c form stiffness matrix and internal force vector
c
dNjdx = zero
dNjdy = zero
do i = 1, ndof*nnode
force(i) = zero
do j = 1, ndof*nnode
stiff(j,i) = zero
end do
end do
dvol= wght(kintk)*djac
do nodj = 1, nnode
incr_col = (nodj - 1)*ndof
dNjdx = bmat(1+(nodj-1)*ndim)
dNjdy = bmat(2+(nodj-1)*ndim)
force_p(1) = dNjdx*stress(1) + dNjdy*stress(4)
force_p(2) = dNjdy*stress(2) + dNjdx*stress(4)
do jdof = 1, ndof
jcol = jdof + incr_col
force(jcol) = force(jcol) +
& force_p(jdof)*dvol
end do
do nodi = 1, nnode
incr_row = (nodi -1)*ndof
dNidx = bmat(1+(nodi-1)*ndim)
dNidy = bmat(2+(nodi-1)*ndim)
stiff_p(1,1) = dNidx*ddsdde(1,1)*dNjdx
& + dNidy*ddsdde(4,4)*dNjdy
& + dNidx*ddsdde(1,4)*dNjdy
& + dNidy*ddsdde(4,1)*dNjdx
stiff_p(1,2) = dNidx*ddsdde(1,2)*dNjdy
& + dNidy*ddsdde(4,4)*dNjdx
& + dNidx*ddsdde(1,4)*dNjdx
& + dNidy*ddsdde(4,2)*dNjdy
stiff_p(2,1) = dNidy*ddsdde(2,1)*dNjdx
& + dNidx*ddsdde(4,4)*dNjdy
& + dNidy*ddsdde(2,4)*dNjdy
& + dNidx*ddsdde(4,1)*dNjdx
stiff_p(2,2) = dNidy*ddsdde(2,2)*dNjdy
& + dNidx*ddsdde(4,4)*dNjdx
& + dNidy*ddsdde(2,4)*dNjdx
& + dNidx*ddsdde(4,2)*dNjdy
do jdof = 1, ndof
icol = jdof + incr_col
do idof = 1, ndof
irow = idof + incr_row
stiff(irow,icol) = stiff(irow,icol) +
& stiff_p(idof,jdof)*dvol
end do
end do
end do
end do
c
c assemble rhs and lhs
c
do k1=1, ndof*nnode
rhs(k1, 1) = rhs(k1, 1) - force(k1)
do k2=1, ndof*nnode
amatrx(k1, k2) = amatrx(k1, k2) + stiff(k1,k2)
end do
end do
end do ! end loop on material integration points
pnewdt = pnewdtLocal
c
999 continue
c
return
end

367
Unpublished/XFEM2/XFEM/uelmat2.for Normal file
View file

@ -0,0 +1,367 @@
c***********************************************************
subroutine uelmat(rhs,amatrx,svars,energy,ndofel,nrhs,
1 nsvars,props,nprops,coords,mcrd,nnode,u,du,
2 v,a,jtype,time,dtime,kstep,kinc,jelem,params,
3 ndload,jdltyp,adlmag,predef,npredf,lflags,mlvarx,
4 ddlmag,mdload,pnewdt,jprops,njpro,period,
5 materiallib)
c
include 'aba_param.inc'
C
dimension rhs(mlvarx,*), amatrx(ndofel, ndofel), props(*),
1 svars(*), energy(*), coords(mcrd, nnode), u(ndofel),
2 du(mlvarx,*), v(ndofel), a(ndofel), time(2), params(*),
3 jdltyp(mdload,*), adlmag(mdload,*), ddlmag(mdload,*),
4 predef(2, npredf, nnode), lflags(*), jprops(*)
parameter (zero=0.d0, dmone=-1.0d0, one=1.d0, four=4.0d0,
1 fourth=0.25d0,gaussCoord=0.577350269d0)
parameter (ndim=2, ndof=2, nshr=1,nnodemax=4,
1 ntens=4, ninpt=4, nsvint=4)
c
c ndim ... number of spatial dimensions
c ndof ... number of degrees of freedom per node
c nshr ... number of shear stress component
c ntens ... total number of stress tensor components
c (=ndi+nshr)
c ninpt ... number of integration points
c nsvint... number of state variables per integration pt
c (strain)
c
dimension stiff(ndof*nnodemax,ndof*nnodemax),
1 force(ndof*nnodemax), shape(nnodemax), dshape(ndim,nnodemax),
2 xjac(ndim,ndim),xjaci(ndim,ndim), bmat(nnodemax*ndim),
3 statevLocal(nsvint),stress(ntens), ddsdde(ntens, ntens),
4 stran(ntens), dstran(ntens), wght(ninpt)
c
dimension predef_loc(npredf),dpredef_loc(npredf),
1 defGrad(3,3),utmp(3),xdu(3),stiff_p(3,3),force_p(3)
dimension coord24(2,4),coords_ip(3)
data coord24 /dmone, dmone,
2 one, dmone,
3 one, one,
4 dmone, one/
c
data wght /one, one, one, one/
c
c*************************************************************
c
c U1 = first-order, plane strain, full integration
c
c State variables: each integration point has nsvint SDVs
c
c isvinc=(npt-1)*nsvint ... integration point counter
c statev(1+isvinc ) ... strain
c
c*************************************************************
if (lflags(3).eq.4) then
do i=1, ndofel
do j=1, ndofel
amatrx(i,j) = zero
end do
amatrx(i,i) = one
end do
goto 999
end if
c
c PRELIMINARIES
c
pnewdtLocal = pnewdt
if(jtype .ne. 1) then
write(7,*)'Incorrect element type'
call xit
endif
if(nsvars .lt. ninpt*nsvint) then
write(7,*)'Increase the number of SDVs to', ninpt*nsvint
call xit
endif
thickness = 0.1d0
c
c INITIALIZE RHS AND LHS
c
do k1=1, ndof*nnode
rhs(k1, 1)= zero
do k2=1, ndof*nnode
amatrx(k1, k2)= zero
end do
end do
c
c LOOP OVER INTEGRATION POINTS
c
do kintk = 1, ninpt
c
c EVALUATE SHAPE FUNCTIONS AND THEIR DERIVATIVES
c
c determine (g,h)
c
g = coord24(1,kintk)*gaussCoord
h = coord24(2,kintk)*gaussCoord
c
c shape functions
shape(1) = (one - g)*(one - h)/four;
shape(2) = (one + g)*(one - h)/four;
shape(3) = (one + g)*(one + h)/four;
shape(4) = (one - g)*(one + h)/four;
c
c derivative d(Ni)/d(g)
dshape(1,1) = -(one - h)/four;
dshape(1,2) = (one - h)/four;
dshape(1,3) = (one + h)/four;
dshape(1,4) = -(one + h)/four;
c
c derivative d(Ni)/d(h)
dshape(2,1) = -(one - g)/four;
dshape(2,2) = -(one + g)/four;
dshape(2,3) = (one + g)/four;
dshape(2,4) = (one - g)/four;
c
c compute coordinates at the integration point
c
do k1=1, 3
coords_ip(k1) = zero
end do
do k1=1,nnode
do k2=1,mcrd
coords_ip(k2)=coords_ip(k2)+shape(k1)*coords(k2,k1)
end do
end do
c
c INTERPOLATE FIELD VARIABLES
c
if(npredf.gt.0) then
do k1=1,npredf
predef_loc(k1) = zero
dpredef_loc(k1) = zero
do k2=1,nnode
predef_loc(k1) =
& predef_loc(k1)+
& (predef(1,k1,k2)-predef(2,k1,k2))*shape(k2)
dpredef_loc(k1) =
& dpredef_loc(k1)+predef(2,k1,k2)*shape(k2)
end do
end do
end if
c
c FORM B-MATRIX
c
djac = one
c
do i = 1, ndim
do j = 1, ndim
xjac(i,j) = zero
xjaci(i,j) = zero
end do
end do
c
do inod= 1, nnode
do idim = 1, ndim
do jdim = 1, ndim
xjac(jdim,idim) = xjac(jdim,idim) +
1 dshape(jdim,inod)*coords(idim,inod)
end do
end do
end do
djac = xjac(1,1)*xjac(2,2) - xjac(1,2)*xjac(2,1)
if (djac .gt. zero) then
! jacobian is positive - o.k.
xjaci(1,1) = xjac(2,2)/djac
xjaci(2,2) = xjac(1,1)/djac
xjaci(1,2) = -xjac(1,2)/djac
xjaci(2,1) = -xjac(2,1)/djac
else
! negative or zero jacobian
write(7,*)'WARNING: element',jelem,'has neg.
1 Jacobian'
pnewdt = fourth
endif
if (pnewdt .lt. pnewdtLocal) pnewdtLocal = pnewdt
c
do i = 1, nnode*ndim
bmat(i) = zero
end do
do inod = 1, nnode
do ider = 1, ndim
do idim = 1, ndim
irow = idim + (inod - 1)*ndim
bmat(irow) = bmat(irow) +
1 xjaci(idim,ider)*dshape(ider,inod)
end do
end do
end do
c
c CALCULATE INCREMENTAL STRAINS
c
do i = 1, ntens
dstran(i) = zero
end do
!
! set deformation gradient to Identity matrix
do k1=1,3
do k2=1,3
defGrad(k1,k2) = zero
end do
defGrad(k1,k1) = one
end do
c
c COMPUTE INCREMENTAL STRAINS
c
do nodi = 1, nnode
incr_row = (nodi - 1)*ndof
do i = 1, ndof
xdu(i)= du(i + incr_row,1)
utmp(i) = u(i + incr_row)
end do
dNidx = bmat(1 + (nodi-1)*ndim)
dNidy = bmat(2 + (nodi-1)*ndim)
dstran(1) = dstran(1) + dNidx*xdu(1)
dstran(2) = dstran(2) + dNidy*xdu(2)
dstran(4) = dstran(4) +
1 dNidy*xdu(1) +
2 dNidx*xdu(2)
c deformation gradient
defGrad(1,1) = defGrad(1,1) + dNidx*utmp(1)
defGrad(1,2) = defGrad(1,2) + dNidy*utmp(1)
defGrad(2,1) = defGrad(2,1) + dNidx*utmp(2)
defGrad(2,2) = defGrad(2,2) + dNidy*utmp(2)
end do
c
c CALL CONSTITUTIVE ROUTINE
c
isvinc= (kintk-1)*nsvint ! integration point increment
c
c prepare arrays for entry into material routines
c
do i = 1, nsvint
statevLocal(i)=svars(i+isvinc)
end do
c
c state variables
c
do k1=1,ntens
stran(k1) = statevLocal(k1)
stress(k1) = zero
end do
c
do i=1, ntens
do j=1, ntens
ddsdde(i,j) = zero
end do
ddsdde(i,j) = one
enddo
c
c compute characteristic element length
c
celent = sqrt(djac*dble(ninpt))
dvmat = djac*thickness
c
dvdv0 = one
call material_lib_mech(materiallib,stress,ddsdde,
1 stran,dstran,kintk,dvdv0,dvmat,defGrad,
2 predef_loc,dpredef_loc,npredf,celent,coords_ip)
c
do k1=1,ntens
statevLocal(k1) = stran(k1) + dstran(k1)
end do
c
isvinc= (kintk-1)*nsvint ! integration point increment
c
c update element state variables
c
do i = 1, nsvint
svars(i+isvinc)=statevLocal(i)
end do
c
c form stiffness matrix and internal force vector
c
dNjdx = zero
dNjdy = zero
do i = 1, ndof*nnode
force(i) = zero
do j = 1, ndof*nnode
stiff(j,i) = zero
end do
end do
dvol= wght(kintk)*djac
do nodj = 1, nnode
incr_col = (nodj - 1)*ndof
dNjdx = bmat(1+(nodj-1)*ndim)
dNjdy = bmat(2+(nodj-1)*ndim)
force_p(1) = dNjdx*stress(1) + dNjdy*stress(4)
force_p(2) = dNjdy*stress(2) + dNjdx*stress(4)
do jdof = 1, ndof
jcol = jdof + incr_col
force(jcol) = force(jcol) +
& force_p(jdof)*dvol
end do
do nodi = 1, nnode
incr_row = (nodi -1)*ndof
dNidx = bmat(1+(nodi-1)*ndim)
dNidy = bmat(2+(nodi-1)*ndim)
stiff_p(1,1) = dNidx*ddsdde(1,1)*dNjdx
& + dNidy*ddsdde(4,4)*dNjdy
& + dNidx*ddsdde(1,4)*dNjdy
& + dNidy*ddsdde(4,1)*dNjdx
stiff_p(1,2) = dNidx*ddsdde(1,2)*dNjdy
& + dNidy*ddsdde(4,4)*dNjdx
& + dNidx*ddsdde(1,4)*dNjdx
& + dNidy*ddsdde(4,2)*dNjdy
stiff_p(2,1) = dNidy*ddsdde(2,1)*dNjdx
& + dNidx*ddsdde(4,4)*dNjdy
& + dNidy*ddsdde(2,4)*dNjdy
& + dNidx*ddsdde(4,1)*dNjdx
stiff_p(2,2) = dNidy*ddsdde(2,2)*dNjdy
& + dNidx*ddsdde(4,4)*dNjdx
& + dNidy*ddsdde(2,4)*dNjdx
& + dNidx*ddsdde(4,2)*dNjdy
do jdof = 1, ndof
icol = jdof + incr_col
do idof = 1, ndof
irow = idof + incr_row
stiff(irow,icol) = stiff(irow,icol) +
& stiff_p(idof,jdof)*dvol
end do
end do
end do
end do
c
c assemble rhs and lhs
c
do k1=1, ndof*nnode
rhs(k1, 1) = rhs(k1, 1) - force(k1)
do k2=1, ndof*nnode
amatrx(k1, k2) = amatrx(k1, k2) + stiff(k1,k2)
end do
end do
end do ! end loop on material integration points
pnewdt = pnewdtLocal
c
999 continue
c
return
end

367
Unpublished/XFEM2/XFEM/uelmatinp.for Normal file
View file

@ -0,0 +1,367 @@
c***********************************************************
subroutine uelmat(rhs,amatrx,svars,energy,ndofel,nrhs,
1 nsvars,props,nprops,coords,mcrd,nnode,u,du,
2 v,a,jtype,time,dtime,kstep,kinc,jelem,params,
3 ndload,jdltyp,adlmag,predef,npredf,lflags,mlvarx,
4 ddlmag,mdload,pnewdt,jprops,njpro,period,
5 materiallib)
c
include 'aba_param.inc'
C
dimension rhs(mlvarx,*), amatrx(ndofel, ndofel), props(*),
1 svars(*), energy(*), coords(mcrd, nnode), u(ndofel),
2 du(mlvarx,*), v(ndofel), a(ndofel), time(2), params(*),
3 jdltyp(mdload,*), adlmag(mdload,*), ddlmag(mdload,*),
4 predef(2, npredf, nnode), lflags(*), jprops(*)
parameter (zero=0.d0, dmone=-1.0d0, one=1.d0, four=4.0d0,
1 fourth=0.25d0,gaussCoord=0.577350269d0)
parameter (ndim=2, ndof=2, nshr=1,nnodemax=4,
1 ntens=4, ninpt=4, nsvint=4)
c
c ndim ... number of spatial dimensions
c ndof ... number of degrees of freedom per node
c nshr ... number of shear stress component
c ntens ... total number of stress tensor components
c (=ndi+nshr)
c ninpt ... number of integration points
c nsvint... number of state variables per integration pt
c (strain)
c
dimension stiff(ndof*nnodemax,ndof*nnodemax),
1 force(ndof*nnodemax), shape(nnodemax), dshape(ndim,nnodemax),
2 xjac(ndim,ndim),xjaci(ndim,ndim), bmat(nnodemax*ndim),
3 statevLocal(nsvint),stress(ntens), ddsdde(ntens, ntens),
4 stran(ntens), dstran(ntens), wght(ninpt)
c
dimension predef_loc(npredf),dpredef_loc(npredf),
1 defGrad(3,3),utmp(3),xdu(3),stiff_p(3,3),force_p(3)
dimension coord24(2,4),coords_ip(3)
data coord24 /dmone, dmone,
2 one, dmone,
3 one, one,
4 dmone, one/
c
data wght /one, one, one, one/
c
c*************************************************************
c
c U1 = first-order, plane strain, full integration
c
c State variables: each integration point has nsvint SDVs
c
c isvinc=(npt-1)*nsvint ... integration point counter
c statev(1+isvinc ) ... strain
c
c*************************************************************
if (lflags(3).eq.4) then
do i=1, ndofel
do j=1, ndofel
amatrx(i,j) = zero
end do
amatrx(i,i) = one
end do
goto 999
end if
c
c PRELIMINARIES
c
pnewdtLocal = pnewdt
if(jtype .ne. 1) then
write(7,*)'Incorrect element type'
call xit
endif
if(nsvars .lt. ninpt*nsvint) then
write(7,*)'Increase the number of SDVs to', ninpt*nsvint
call xit
endif
thickness = 0.1d0
c
c INITIALIZE RHS AND LHS
c
do k1=1, ndof*nnode
rhs(k1, 1)= zero
do k2=1, ndof*nnode
amatrx(k1, k2)= zero
end do
end do
c
c LOOP OVER INTEGRATION POINTS
c
do kintk = 1, ninpt
c
c EVALUATE SHAPE FUNCTIONS AND THEIR DERIVATIVES
c
c determine (g,h)
c
g = coord24(1,kintk)*gaussCoord
h = coord24(2,kintk)*gaussCoord
c
c shape functions
shape(1) = (one - g)*(one - h)/four;
shape(2) = (one + g)*(one - h)/four;
shape(3) = (one + g)*(one + h)/four;
shape(4) = (one - g)*(one + h)/four;
c
c derivative d(Ni)/d(g)
dshape(1,1) = -(one - h)/four;
dshape(1,2) = (one - h)/four;
dshape(1,3) = (one + h)/four;
dshape(1,4) = -(one + h)/four;
c
c derivative d(Ni)/d(h)
dshape(2,1) = -(one - g)/four;
dshape(2,2) = -(one + g)/four;
dshape(2,3) = (one + g)/four;
dshape(2,4) = (one - g)/four;
c
c compute coordinates at the integration point
c
do k1=1, 3
coords_ip(k1) = zero
end do
do k1=1,nnode
do k2=1,mcrd
coords_ip(k2)=coords_ip(k2)+shape(k1)*coords(k2,k1)
end do
end do
c
c INTERPOLATE FIELD VARIABLES
c
if(npredf.gt.0) then
do k1=1,npredf
predef_loc(k1) = zero
dpredef_loc(k1) = zero
do k2=1,nnode
predef_loc(k1) =
& predef_loc(k1)+
& (predef(1,k1,k2)-predef(2,k1,k2))*shape(k2)
dpredef_loc(k1) =
& dpredef_loc(k1)+predef(2,k1,k2)*shape(k2)
end do
end do
end if
c
c FORM B-MATRIX
c
djac = one
c
do i = 1, ndim
do j = 1, ndim
xjac(i,j) = zero
xjaci(i,j) = zero
end do
end do
c
do inod= 1, nnode
do idim = 1, ndim
do jdim = 1, ndim
xjac(jdim,idim) = xjac(jdim,idim) +
1 dshape(jdim,inod)*coords(idim,inod)
end do
end do
end do
djac = xjac(1,1)*xjac(2,2) - xjac(1,2)*xjac(2,1)
if (djac .gt. zero) then
! jacobian is positive - o.k.
xjaci(1,1) = xjac(2,2)/djac
xjaci(2,2) = xjac(1,1)/djac
xjaci(1,2) = -xjac(1,2)/djac
xjaci(2,1) = -xjac(2,1)/djac
else
! negative or zero jacobian
write(7,*)'WARNING: element',jelem,'has neg.
1 Jacobian'
pnewdt = fourth
endif
if (pnewdt .lt. pnewdtLocal) pnewdtLocal = pnewdt
c
do i = 1, nnode*ndim
bmat(i) = zero
end do
do inod = 1, nnode
do ider = 1, ndim
do idim = 1, ndim
irow = idim + (inod - 1)*ndim
bmat(irow) = bmat(irow) +
1 xjaci(idim,ider)*dshape(ider,inod)
end do
end do
end do
c
c CALCULATE INCREMENTAL STRAINS
c
do i = 1, ntens
dstran(i) = zero
end do
!
! set deformation gradient to Identity matrix
do k1=1,3
do k2=1,3
defGrad(k1,k2) = zero
end do
defGrad(k1,k1) = one
end do
c
c COMPUTE INCREMENTAL STRAINS
c
do nodi = 1, nnode
incr_row = (nodi - 1)*ndof
do i = 1, ndof
xdu(i)= du(i + incr_row,1)
utmp(i) = u(i + incr_row)
end do
dNidx = bmat(1 + (nodi-1)*ndim)
dNidy = bmat(2 + (nodi-1)*ndim)
dstran(1) = dstran(1) + dNidx*xdu(1)
dstran(2) = dstran(2) + dNidy*xdu(2)
dstran(4) = dstran(4) +
1 dNidy*xdu(1) +
2 dNidx*xdu(2)
c deformation gradient
defGrad(1,1) = defGrad(1,1) + dNidx*utmp(1)
defGrad(1,2) = defGrad(1,2) + dNidy*utmp(1)
defGrad(2,1) = defGrad(2,1) + dNidx*utmp(2)
defGrad(2,2) = defGrad(2,2) + dNidy*utmp(2)
end do
c
c CALL CONSTITUTIVE ROUTINE
c
isvinc= (kintk-1)*nsvint ! integration point increment
c
c prepare arrays for entry into material routines
c
do i = 1, nsvint
statevLocal(i)=svars(i+isvinc)
end do
c
c state variables
c
do k1=1,ntens
stran(k1) = statevLocal(k1)
stress(k1) = zero
end do
c
do i=1, ntens
do j=1, ntens
ddsdde(i,j) = zero
end do
ddsdde(i,j) = one
enddo
c
c compute characteristic element length
c
celent = sqrt(djac*dble(ninpt))
dvmat = djac*thickness
c
dvdv0 = one
call material_lib_mech(materiallib,stress,ddsdde,
1 stran,dstran,kintk,dvdv0,dvmat,defGrad,
2 predef_loc,dpredef_loc,npredf,celent,coords_ip)
c
do k1=1,ntens
statevLocal(k1) = stran(k1) + dstran(k1)
end do
c
isvinc= (kintk-1)*nsvint ! integration point increment
c
c update element state variables
c
do i = 1, nsvint
svars(i+isvinc)=statevLocal(i)
end do
c
c form stiffness matrix and internal force vector
c
dNjdx = zero
dNjdy = zero
do i = 1, ndof*nnode
force(i) = zero
do j = 1, ndof*nnode
stiff(j,i) = zero
end do
end do
dvol= wght(kintk)*djac
do nodj = 1, nnode
incr_col = (nodj - 1)*ndof
dNjdx = bmat(1+(nodj-1)*ndim)
dNjdy = bmat(2+(nodj-1)*ndim)
force_p(1) = dNjdx*stress(1) + dNjdy*stress(4)
force_p(2) = dNjdy*stress(2) + dNjdx*stress(4)
do jdof = 1, ndof
jcol = jdof + incr_col
force(jcol) = force(jcol) +
& force_p(jdof)*dvol
end do
do nodi = 1, nnode
incr_row = (nodi -1)*ndof
dNidx = bmat(1+(nodi-1)*ndim)
dNidy = bmat(2+(nodi-1)*ndim)
stiff_p(1,1) = dNidx*ddsdde(1,1)*dNjdx
& + dNidy*ddsdde(4,4)*dNjdy
& + dNidx*ddsdde(1,4)*dNjdy
& + dNidy*ddsdde(4,1)*dNjdx
stiff_p(1,2) = dNidx*ddsdde(1,2)*dNjdy
& + dNidy*ddsdde(4,4)*dNjdx
& + dNidx*ddsdde(1,4)*dNjdx
& + dNidy*ddsdde(4,2)*dNjdy
stiff_p(2,1) = dNidy*ddsdde(2,1)*dNjdx
& + dNidx*ddsdde(4,4)*dNjdy
& + dNidy*ddsdde(2,4)*dNjdy
& + dNidx*ddsdde(4,1)*dNjdx
stiff_p(2,2) = dNidy*ddsdde(2,2)*dNjdy
& + dNidx*ddsdde(4,4)*dNjdx
& + dNidy*ddsdde(2,4)*dNjdx
& + dNidx*ddsdde(4,2)*dNjdy
do jdof = 1, ndof
icol = jdof + incr_col
do idof = 1, ndof
irow = idof + incr_row
stiff(irow,icol) = stiff(irow,icol) +
& stiff_p(idof,jdof)*dvol
end do
end do
end do
end do
c
c assemble rhs and lhs
c
do k1=1, ndof*nnode
rhs(k1, 1) = rhs(k1, 1) - force(k1)
do k2=1, ndof*nnode
amatrx(k1, k2) = amatrx(k1, k2) + stiff(k1,k2)
end do
end do
end do ! end loop on material integration points
pnewdt = pnewdtLocal
c
999 continue
c
return
end

62
Unpublished/XFEM2/XFEM/uelmatinp.inp Normal file
View file

@ -0,0 +1,62 @@
*HEADING
Test for passing abaqus material to UELMAT: transient heat transfer
*RESTART,WRITE,NUMBER INTERVAL=10
*PREPRINT,MODEL=YES
*PART,NAME=part1
*NODE,NSET=NALL
1,0,0,0
2,1,0,0
3,0,1,0
4,1,1,0
5,0,2,0
6,1,2,0
*NSET,NSET=Left
1,3,5
*NSET,NSET=Right
2,4,6
*USER ELEMENT, TYPE=U1, NODES=4, COORDINATES=2,
INTEGRATION=4,TENSOR=TWOD
11,
*ELEMENT,TYPE=U1,ELSET=SOLID
1, 1,2,4,3
2, 3,4,6,5
*END PART
*ASSEMBLY,NAME=A1
*INSTANCE,NAME=I1,PART=PART1
*END INSTANCE
*Nset, nset=Set-6, instance=I1
1,3,5
*Nset, nset=Set-7, instance=I1
2,4,6
*END ASSEMBLY
*UEL PROPERTY, ELSET=I1.SOLID, MATERIAL=MAT_THERM
**************************************
***************************************
*MATERIAL,NAME=MAT_THERM
*CONDUCTIVITY
1.0,
*SPECIFIC HEAT
1.,
*DENSITY
1.,
*Initial Conditions, type=TEMPERATURE
Set-6, 1.,0.
*Initial Conditions, type=TEMPERATURE
Set-7, 0.,0.
*STEP
*HEAT TRANSFER, DELTMX=1.
0.1,1.0,,0.1
**
*BOUNDARY
Set-6,11,11,1.
*OUTPUT,FIELD,freq=1
*ELEMENT OUTPUT,ELSET=I1.SOLID
HFL,
*NODE OUTPUT,NSET=I1.NALL
NT,
*OUTPUT,HISTORY
*ELEMENT OUTPUT,ELSET=I1.SOLID
HFL,
*NODE OUTPUT,NSET=I1.NALL
NT11,
*END STEP

53
Unpublished/XFEM2/XFEM/umeshbak.for Normal file
View file

@ -0,0 +1,53 @@
C USER INPUT FOR ADAPTIVE MESH CONSTRAINT
C
SUBROUTINE UMESHMOTION(UREF,ULOCAL,NODE,NNDOF,
$ LNODETYPE,ALOCAL,NDIM,TIME,DTIME,PNEWDT,
$ KSTEP,KINC,KMESHSWEEP,JMATYP,JGVBLOCK,LSMOOTH)
C
include 'ABA_PARAM.INC'
C
C USER DEFINED DIMENSION STATEMENTS
C
CHARACTER*80 PARTNAME
DIMENSION ARRAY(1000),JPOS(15),HFARRAY(1000)
DIMENSION ULOCAL(*),UGLOBAL(NDIM),TLOCAL(NDIM)
DIMENSION JGVBLOCK(*),JMATYP(*)
DIMENSION NODELIST(100),JELEMLIST(10),JELEMTYPE(10)
DIMENSION ALOCAL(NDIM,*)
DIMENSION UTEMP(2)
C
C The dimensions of the variables ARRAY and JARRAY
C must be set equal to or greater than 15
C
CALL GETPARTINFO(NODE,0,PARTNAME,LOCNUM,JRCD)
CALL GETVRN(LOCNUM,'COORD',ARRAY,JRCD,JGVBLOCK,LTRN)
NELEMS=10
CALL GETNODETOELEMCONN(NODE, NELEMS, JELEMLIST, JELEMTYPE,
$ JRCD, JGVBLOCK)
CALL GETVRMAVGATNODE(NODE,1,'HFL',HFARRAY,JRCD,JELEMLIST,
$ NELEMS,JMATYP,JGVBLOCK)
C PRINT *,'****'
C PRINT *, HFARRAY(1),HFARRAY(2),HFARRAY(3),HFARRAY(4)
C PRINT *,NODE,TIME
FluxX=HFARRAY(2)
FluxY=HFARRAY(3)
FluxZ=HFARRAY(4)
if(abs(FluxX)<0.001)FluxX=0.
if(abs(FluxY)<0.001)FluxY=0.
if(abs(FluxZ)<0.001)FluxZ=0.
UGLOBAL(1) = -2.*FluxX
UGLOBAL(2) = -2.*FluxY
UGLOBAL(3) = 0.
DO I=1,NDIM
TLOCAL(I)=0.
DO J=1,NDIM
TLOCAL(I)=TLOCAL(I)+UGLOBAL(J)*ALOCAL(J,I)
ENDDO
ENDDO
DO I=1,NDIM
ULOCAL(I)=TLOCAL(I)
ENDDO
lsmooth=1
C
RETURN
END

27
Unpublished/XFEM2/XFEM/usfdld.f Normal file
View file

@ -0,0 +1,27 @@
c J. Grogan, 2012
c -------------------------------------------------------------------
SUBROUTINE USDFLD(FIELD,STATEV,PNEWDT,DIRECT,T,CELENT,
1 TIME,DTIME,CMNAME,ORNAME,NFIELD,NSTATV,NOEL,NPT,LAYER,
2 KSPT,KSTEP,KINC,NDI,NSHR,COORD,JMAC,JMATYP,MATLAYO,
3 LACCFLA)
C
INCLUDE 'ABA_PARAM.INC'
C
CHARACTER*80 CMNAME,ORNAME
CHARACTER*3 FLGRAY(15)
DIMENSION FIELD(NFIELD),STATEV(NSTATV),DIRECT(3,3),
1 T(3,3),TIME(2)
DIMENSION ARRAY(15),JARRAY(15),JMAC(*),JMATYP(*),
1 COORD(*)
c -------------------------------------------------------------------
field(1)=0.
return
end subroutine

220
Unpublished/XFEM2/XFEM/usfdld.for Normal file
View file

@ -0,0 +1,220 @@
c J. Grogan, 2012
c -------------------------------------------------------------------
SUBROUTINE USDFLD(FIELD,STATEV,PNEWDT,DIRECT,T,CELENT,
1 TIME,DTIME,CMNAME,ORNAME,NFIELD,NSTATV,NOEL,NPT,LAYER,
2 KSPT,KSTEP,KINC,NDI,NSHR,COORD,JMAC,JMATYP,MATLAYO,
3 LACCFLA)
C
INCLUDE 'ABA_PARAM.INC'
C
CHARACTER*80 CMNAME,ORNAME
CHARACTER*3 FLGRAY(15)
DIMENSION FIELD(NFIELD),STATEV(NSTATV),DIRECT(3,3),
1 T(3,3),TIME(2)
DIMENSION ARRAY(15),JARRAY(15),JMAC(*),JMATYP(*),
1 COORD(*)
c -------------------------------------------------------------------
field(1)=0.
print *, coord(1),time(1),dtime,T,'****'
return
end subroutine
SUBROUTINE UEL(RHS,AMATRX,SVARS,ENERGY,NDOFEL,NRHS,NSVARS,
1 PROPS,NPROPS,COORDS,MCRD,NNODE,U,DU,V,A,JTYPE,TIME,
2 DTIME,KSTEP,KINC,JELEM,PARAMS,NDLOAD,JDLTYP,ADLMAG,
3 PREDEF,NPREDF,LFLAGS,MLVARX,DDLMAG,MDLOAD,PNEWDT,
4 JPROPS,NJPROP,PERIOD)
C
INCLUDE 'ABA_PARAM.INC'
PARAMETER ( ZERO = 0.D0, HALF = 0.5D0, ONE = 1.D0 )
C
DIMENSION RHS(MLVARX,*),AMATRX(NDOFEL,NDOFEL),
1 SVARS(NSVARS),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(*),
5 JPROPS(*)
DIMENSION SRESID(6)
C
C UEL SUBROUTINE FOR A HORIZONTAL TRUSS ELEMENT
C
C SRESID - stores the static residual at time t+dt
C SVARS - In 1-6, contains the static residual at time t
C upon entering the routine. SRESID is copied to
C SVARS(1-6) after the dynamic residual has been
C calculated.
C - For half-increment residual calculations: In 7-12,
C contains the static residual at the beginning
C of the previous increment. SVARS(1-6) are copied
C into SVARS(7-12) after the dynamic residual has
C been calculated.
C
AREA = PROPS(1)
E = PROPS(2)
ANU = PROPS(3)
RHO = PROPS(4)
C
ALEN = ABS(COORDS(1,2)-COORDS(1,1))
AK = AREA*E/ALEN
AM = HALF*AREA*RHO*ALEN
C
DO K1 = 1, NDOFEL
SRESID(K1) = ZERO
DO KRHS = 1, NRHS
RHS(K1,KRHS) = ZERO
END DO
DO K2 = 1, NDOFEL
AMATRX(K2,K1) = ZERO
END DO
END DO
C
IF (LFLAGS(3).EQ.1) THEN
C Normal incrementation
IF (LFLAGS(1).EQ.1 .OR. LFLAGS(1).EQ.2) THEN
C *STATIC
AMATRX(1,1) = AK
AMATRX(4,4) = AK
AMATRX(1,4) = -AK
AMATRX(4,1) = -AK
IF (LFLAGS(4).NE.0) THEN
FORCE = AK*(U(4)-U(1))
DFORCE = AK*(DU(4,1)-DU(1,1))
SRESID(1) = -DFORCE
SRESID(4) = DFORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
ENERGY(2) = HALF*FORCE*(DU(4,1)-DU(1,1))
* + HALF*DFORCE*(U(4)-U(1))
* + HALF*DFORCE*(DU(4,1)-DU(1,1))
ELSE
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
DO KDLOAD = 1, NDLOAD
IF (JDLTYP(KDLOAD,1).EQ.1001) THEN
RHS(4,1) = RHS(4,1)+ADLMAG(KDLOAD,1)
ENERGY(8) = ENERGY(8)+(ADLMAG(KDLOAD,1)
* - HALF*DDLMAG(KDLOAD,1))*DU(4,1)
IF (NRHS.EQ.2) THEN
C Riks
RHS(4,2) = RHS(4,2)+DDLMAG(KDLOAD,1)
END IF
END IF
END DO
ENERGY(2) = HALF*FORCE*(U(4)-U(1))
END IF
ELSE IF (LFLAGS(1).EQ.11 .OR. LFLAGS(1).EQ.12) THEN
C *DYNAMIC
ALPHA = PARAMS(1)
BETA = PARAMS(2)
GAMMA = PARAMS(3)
C
DADU = ONE/(BETA*DTIME**2)
DVDU = GAMMA/(BETA*DTIME)
C
DO K1 = 1, NDOFEL
AMATRX(K1,K1) = AM*DADU
RHS(K1,1) = RHS(K1,1)-AM*A(K1)
END DO
AMATRX(1,1) = AMATRX(1,1)+(ONE+ALPHA)*AK
AMATRX(4,4) = AMATRX(4,4)+(ONE+ALPHA)*AK
AMATRX(1,4) = AMATRX(1,4)-(ONE+ALPHA)*AK
AMATRX(4,1) = AMATRX(4,1)-(ONE+ALPHA)*AK
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1) -
* ((ONE+ALPHA)*SRESID(1)-ALPHA*SVARS(1))
RHS(4,1) = RHS(4,1) -
* ((ONE+ALPHA)*SRESID(4)-ALPHA*SVARS(4))
ENERGY(1) = ZERO
DO K1 = 1, NDOFEL
SVARS(K1+6) = SVARS(k1)
SVARS(K1) = SRESID(K1)
ENERGY(1) = ENERGY(1)+HALF*V(K1)*AM*V(K1)
END DO
ENERGY(2) = HALF*FORCE*(U(4)-U(1))
END IF
ELSE IF (LFLAGS(3).EQ.2) THEN
C Stiffness matrix
AMATRX(1,1) = AK
AMATRX(4,4) = AK
AMATRX(1,4) = -AK
AMATRX(4,1) = -AK
ELSE IF (LFLAGS(3).EQ.4) THEN
C Mass matrix
DO K1 = 1, NDOFEL
AMATRX(K1,K1) = AM
END DO
ELSE IF (LFLAGS(3).EQ.5) THEN
C Half-increment residual calculation
ALPHA = PARAMS(1)
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1)-AM*A(1)-(ONE+ALPHA)*SRESID(1)
* + HALF*ALPHA*( SVARS(1)+SVARS(7) )
RHS(4,1) = RHS(4,1)-AM*A(4)-(ONE+ALPHA)*SRESID(4)
* + HALF*ALPHA*( SVARS(4)+SVARS(10) )
ELSE IF (LFLAGS(3).EQ.6) THEN
C Initial acceleration calculation
DO K1 = 1, NDOFEL
AMATRX(K1,K1) = AM
END DO
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
ENERGY(1) = ZERO
DO K1 = 1, NDOFEL
SVARS(K1) = SRESID(K1)
ENERGY(1) = ENERGY(1)+HALF*V(K1)*AM*V(K1)
END DO
ENERGY(2) = HALF*FORCE*(U(4)-U(1))
ELSE IF (LFLAGS(3).EQ.100) THEN
C Output for perturbations
IF (LFLAGS(1).EQ.1 .OR. LFLAGS(1).EQ.2) THEN
C *STATIC
FORCE = AK*(U(4)-U(1))
DFORCE = AK*(DU(4,1)-DU(1,1))
SRESID(1) = -DFORCE
SRESID(4) = DFORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
ENERGY(2) = HALF*FORCE*(DU(4,1)-DU(1,1))
* + HALF*DFORCE*(U(4)-U(1))
* + HALF*DFORCE*(DU(4,1)-DU(1,1))
DO KVAR = 1, NSVARS
SVARS(KVAR) = ZERO
END DO
SVARS(1) = RHS(1,1)
SVARS(4) = RHS(4,1)
ELSE IF (LFLAGS(1).EQ.41) THEN
C *FREQUENCY
DO KRHS = 1, NRHS
DFORCE = AK*(DU(4,KRHS)-DU(1,KRHS))
SRESID(1) = -DFORCE
SRESID(4) = DFORCE
RHS(1,KRHS) = RHS(1,KRHS)-SRESID(1)
RHS(4,KRHS) = RHS(4,KRHS)-SRESID(4)
END DO
DO KVAR = 1, NSVARS
SVARS(KVAR) = ZERO
END DO
SVARS(1) = RHS(1,1)
SVARS(4) = RHS(4,1)
END IF
END IF
C
RETURN
END

192
Unpublished/XFEM2/uel.for Normal file
View file

@ -0,0 +1,192 @@
SUBROUTINE UEL(RHS,AMATRX,SVARS,ENERGY,NDOFEL,NRHS,NSVARS,
1 PROPS,NPROPS,COORDS,MCRD,NNODE,U,DU,V,A,JTYPE,TIME,
2 DTIME,KSTEP,KINC,JELEM,PARAMS,NDLOAD,JDLTYP,ADLMAG,
3 PREDEF,NPREDF,LFLAGS,MLVARX,DDLMAG,MDLOAD,PNEWDT,
4 JPROPS,NJPROP,PERIOD)
C
INCLUDE 'ABA_PARAM.INC'
PARAMETER ( ZERO = 0.D0, HALF = 0.5D0, ONE = 1.D0 )
C
DIMENSION RHS(MLVARX,*),AMATRX(NDOFEL,NDOFEL),
1 SVARS(NSVARS),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(*),
5 JPROPS(*)
DIMENSION SRESID(6)
C
C UEL SUBROUTINE FOR A HORIZONTAL TRUSS ELEMENT
C
C SRESID - stores the static residual at time t+dt
C SVARS - In 1-6, contains the static residual at time t
C upon entering the routine. SRESID is copied to
C SVARS(1-6) after the dynamic residual has been
C calculated.
C - For half-increment residual calculations: In 7-12,
C contains the static residual at the beginning
C of the previous increment. SVARS(1-6) are copied
C into SVARS(7-12) after the dynamic residual has
C been calculated.
C
AREA = PROPS(1)
E = PROPS(2)
ANU = PROPS(3)
RHO = PROPS(4)
C
ALEN = ABS(COORDS(1,2)-COORDS(1,1))
AK = AREA*E/ALEN
AM = HALF*AREA*RHO*ALEN
C
DO K1 = 1, NDOFEL
SRESID(K1) = ZERO
DO KRHS = 1, NRHS
RHS(K1,KRHS) = ZERO
END DO
DO K2 = 1, NDOFEL
AMATRX(K2,K1) = ZERO
END DO
END DO
C
IF (LFLAGS(3).EQ.1) THEN
C Normal incrementation
IF (LFLAGS(1).EQ.1 .OR. LFLAGS(1).EQ.2) THEN
C *STATIC
AMATRX(1,1) = AK
AMATRX(4,4) = AK
AMATRX(1,4) = -AK
AMATRX(4,1) = -AK
IF (LFLAGS(4).NE.0) THEN
FORCE = AK*(U(4)-U(1))
DFORCE = AK*(DU(4,1)-DU(1,1))
SRESID(1) = -DFORCE
SRESID(4) = DFORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
ENERGY(2) = HALF*FORCE*(DU(4,1)-DU(1,1))
* + HALF*DFORCE*(U(4)-U(1))
* + HALF*DFORCE*(DU(4,1)-DU(1,1))
ELSE
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
DO KDLOAD = 1, NDLOAD
IF (JDLTYP(KDLOAD,1).EQ.1001) THEN
RHS(4,1) = RHS(4,1)+ADLMAG(KDLOAD,1)
ENERGY(8) = ENERGY(8)+(ADLMAG(KDLOAD,1)
* - HALF*DDLMAG(KDLOAD,1))*DU(4,1)
IF (NRHS.EQ.2) THEN
C Riks
RHS(4,2) = RHS(4,2)+DDLMAG(KDLOAD,1)
END IF
END IF
END DO
ENERGY(2) = HALF*FORCE*(U(4)-U(1))
END IF
ELSE IF (LFLAGS(1).EQ.11 .OR. LFLAGS(1).EQ.12) THEN
C *DYNAMIC
ALPHA = PARAMS(1)
BETA = PARAMS(2)
GAMMA = PARAMS(3)
C
DADU = ONE/(BETA*DTIME**2)
DVDU = GAMMA/(BETA*DTIME)
C
DO K1 = 1, NDOFEL
AMATRX(K1,K1) = AM*DADU
RHS(K1,1) = RHS(K1,1)-AM*A(K1)
END DO
AMATRX(1,1) = AMATRX(1,1)+(ONE+ALPHA)*AK
AMATRX(4,4) = AMATRX(4,4)+(ONE+ALPHA)*AK
AMATRX(1,4) = AMATRX(1,4)-(ONE+ALPHA)*AK
AMATRX(4,1) = AMATRX(4,1)-(ONE+ALPHA)*AK
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1) -
* ((ONE+ALPHA)*SRESID(1)-ALPHA*SVARS(1))
RHS(4,1) = RHS(4,1) -
* ((ONE+ALPHA)*SRESID(4)-ALPHA*SVARS(4))
ENERGY(1) = ZERO
DO K1 = 1, NDOFEL
SVARS(K1+6) = SVARS(k1)
SVARS(K1) = SRESID(K1)
ENERGY(1) = ENERGY(1)+HALF*V(K1)*AM*V(K1)
END DO
ENERGY(2) = HALF*FORCE*(U(4)-U(1))
END IF
ELSE IF (LFLAGS(3).EQ.2) THEN
C Stiffness matrix
AMATRX(1,1) = AK
AMATRX(4,4) = AK
AMATRX(1,4) = -AK
AMATRX(4,1) = -AK
ELSE IF (LFLAGS(3).EQ.4) THEN
C Mass matrix
DO K1 = 1, NDOFEL
AMATRX(K1,K1) = AM
END DO
ELSE IF (LFLAGS(3).EQ.5) THEN
C Half-increment residual calculation
ALPHA = PARAMS(1)
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1)-AM*A(1)-(ONE+ALPHA)*SRESID(1)
* + HALF*ALPHA*( SVARS(1)+SVARS(7) )
RHS(4,1) = RHS(4,1)-AM*A(4)-(ONE+ALPHA)*SRESID(4)
* + HALF*ALPHA*( SVARS(4)+SVARS(10) )
ELSE IF (LFLAGS(3).EQ.6) THEN
C Initial acceleration calculation
DO K1 = 1, NDOFEL
AMATRX(K1,K1) = AM
END DO
FORCE = AK*(U(4)-U(1))
SRESID(1) = -FORCE
SRESID(4) = FORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
ENERGY(1) = ZERO
DO K1 = 1, NDOFEL
SVARS(K1) = SRESID(K1)
ENERGY(1) = ENERGY(1)+HALF*V(K1)*AM*V(K1)
END DO
ENERGY(2) = HALF*FORCE*(U(4)-U(1))
ELSE IF (LFLAGS(3).EQ.100) THEN
C Output for perturbations
IF (LFLAGS(1).EQ.1 .OR. LFLAGS(1).EQ.2) THEN
C *STATIC
FORCE = AK*(U(4)-U(1))
DFORCE = AK*(DU(4,1)-DU(1,1))
SRESID(1) = -DFORCE
SRESID(4) = DFORCE
RHS(1,1) = RHS(1,1)-SRESID(1)
RHS(4,1) = RHS(4,1)-SRESID(4)
ENERGY(2) = HALF*FORCE*(DU(4,1)-DU(1,1))
* + HALF*DFORCE*(U(4)-U(1))
* + HALF*DFORCE*(DU(4,1)-DU(1,1))
DO KVAR = 1, NSVARS
SVARS(KVAR) = ZERO
END DO
SVARS(1) = RHS(1,1)
SVARS(4) = RHS(4,1)
ELSE IF (LFLAGS(1).EQ.41) THEN
C *FREQUENCY
DO KRHS = 1, NRHS
DFORCE = AK*(DU(4,KRHS)-DU(1,KRHS))
SRESID(1) = -DFORCE
SRESID(4) = DFORCE
RHS(1,KRHS) = RHS(1,KRHS)-SRESID(1)
RHS(4,KRHS) = RHS(4,KRHS)-SRESID(4)
END DO
DO KVAR = 1, NSVARS
SVARS(KVAR) = ZERO
END DO
SVARS(1) = RHS(1,1)
SVARS(4) = RHS(4,1)
END IF
END IF
C
RETURN
END

367
Unpublished/XFEM2/uelmat.for Normal file
View file

@ -0,0 +1,367 @@
c***********************************************************
subroutine uelmat(rhs,amatrx,svars,energy,ndofel,nrhs,
1 nsvars,props,nprops,coords,mcrd,nnode,u,du,
2 v,a,jtype,time,dtime,kstep,kinc,jelem,params,
3 ndload,jdltyp,adlmag,predef,npredf,lflags,mlvarx,
4 ddlmag,mdload,pnewdt,jprops,njpro,period,
5 materiallib)
c
include 'aba_param.inc'
C
dimension rhs(mlvarx,*), amatrx(ndofel, ndofel), props(*),
1 svars(*), energy(*), coords(mcrd, nnode), u(ndofel),
2 du(mlvarx,*), v(ndofel), a(ndofel), time(2), params(*),
3 jdltyp(mdload,*), adlmag(mdload,*), ddlmag(mdload,*),
4 predef(2, npredf, nnode), lflags(*), jprops(*)
parameter (zero=0.d0, dmone=-1.0d0, one=1.d0, four=4.0d0,
1 fourth=0.25d0,gaussCoord=0.577350269d0)
parameter (ndim=2, ndof=2, nshr=1,nnodemax=4,
1 ntens=4, ninpt=4, nsvint=4)
c
c ndim ... number of spatial dimensions
c ndof ... number of degrees of freedom per node
c nshr ... number of shear stress component
c ntens ... total number of stress tensor components
c (=ndi+nshr)
c ninpt ... number of integration points
c nsvint... number of state variables per integration pt
c (strain)
c
dimension stiff(ndof*nnodemax,ndof*nnodemax),
1 force(ndof*nnodemax), shape(nnodemax), dshape(ndim,nnodemax),
2 xjac(ndim,ndim),xjaci(ndim,ndim), bmat(nnodemax*ndim),
3 statevLocal(nsvint),stress(ntens), ddsdde(ntens, ntens),
4 stran(ntens), dstran(ntens), wght(ninpt)
c
dimension predef_loc(npredf),dpredef_loc(npredf),
1 defGrad(3,3),utmp(3),xdu(3),stiff_p(3,3),force_p(3)
dimension coord24(2,4),coords_ip(3)
data coord24 /dmone, dmone,
2 one, dmone,
3 one, one,
4 dmone, one/
c
data wght /one, one, one, one/
c
c*************************************************************
c
c U1 = first-order, plane strain, full integration
c
c State variables: each integration point has nsvint SDVs
c
c isvinc=(npt-1)*nsvint ... integration point counter
c statev(1+isvinc ) ... strain
c
c*************************************************************
if (lflags(3).eq.4) then
do i=1, ndofel
do j=1, ndofel
amatrx(i,j) = zero
end do
amatrx(i,i) = one
end do
goto 999
end if
c
c PRELIMINARIES
c
pnewdtLocal = pnewdt
if(jtype .ne. 1) then
write(7,*)'Incorrect element type'
call xit
endif
if(nsvars .lt. ninpt*nsvint) then
write(7,*)'Increase the number of SDVs to', ninpt*nsvint
call xit
endif
thickness = 0.1d0
c
c INITIALIZE RHS AND LHS
c
do k1=1, ndof*nnode
rhs(k1, 1)= zero
do k2=1, ndof*nnode
amatrx(k1, k2)= zero
end do
end do
c
c LOOP OVER INTEGRATION POINTS
c
do kintk = 1, ninpt
c
c EVALUATE SHAPE FUNCTIONS AND THEIR DERIVATIVES
c
c determine (g,h)
c
g = coord24(1,kintk)*gaussCoord
h = coord24(2,kintk)*gaussCoord
c
c shape functions
shape(1) = (one - g)*(one - h)/four;
shape(2) = (one + g)*(one - h)/four;
shape(3) = (one + g)*(one + h)/four;
shape(4) = (one - g)*(one + h)/four;
c
c derivative d(Ni)/d(g)
dshape(1,1) = -(one - h)/four;
dshape(1,2) = (one - h)/four;
dshape(1,3) = (one + h)/four;
dshape(1,4) = -(one + h)/four;
c
c derivative d(Ni)/d(h)
dshape(2,1) = -(one - g)/four;
dshape(2,2) = -(one + g)/four;
dshape(2,3) = (one + g)/four;
dshape(2,4) = (one - g)/four;
c
c compute coordinates at the integration point
c
do k1=1, 3
coords_ip(k1) = zero
end do
do k1=1,nnode
do k2=1,mcrd
coords_ip(k2)=coords_ip(k2)+shape(k1)*coords(k2,k1)
end do
end do
c
c INTERPOLATE FIELD VARIABLES
c
if(npredf.gt.0) then
do k1=1,npredf
predef_loc(k1) = zero
dpredef_loc(k1) = zero
do k2=1,nnode
predef_loc(k1) =
& predef_loc(k1)+
& (predef(1,k1,k2)-predef(2,k1,k2))*shape(k2)
dpredef_loc(k1) =
& dpredef_loc(k1)+predef(2,k1,k2)*shape(k2)
end do
end do
end if
c
c FORM B-MATRIX
c
djac = one
c
do i = 1, ndim
do j = 1, ndim
xjac(i,j) = zero
xjaci(i,j) = zero
end do
end do
c
do inod= 1, nnode
do idim = 1, ndim
do jdim = 1, ndim
xjac(jdim,idim) = xjac(jdim,idim) +
1 dshape(jdim,inod)*coords(idim,inod)
end do
end do
end do
djac = xjac(1,1)*xjac(2,2) - xjac(1,2)*xjac(2,1)
if (djac .gt. zero) then
! jacobian is positive - o.k.
xjaci(1,1) = xjac(2,2)/djac
xjaci(2,2) = xjac(1,1)/djac
xjaci(1,2) = -xjac(1,2)/djac
xjaci(2,1) = -xjac(2,1)/djac
else
! negative or zero jacobian
write(7,*)'WARNING: element',jelem,'has neg.
1 Jacobian'
pnewdt = fourth
endif
if (pnewdt .lt. pnewdtLocal) pnewdtLocal = pnewdt
c
do i = 1, nnode*ndim
bmat(i) = zero
end do
do inod = 1, nnode
do ider = 1, ndim
do idim = 1, ndim
irow = idim + (inod - 1)*ndim
bmat(irow) = bmat(irow) +
1 xjaci(idim,ider)*dshape(ider,inod)
end do
end do
end do
c
c CALCULATE INCREMENTAL STRAINS
c
do i = 1, ntens
dstran(i) = zero
end do
!
! set deformation gradient to Identity matrix
do k1=1,3
do k2=1,3
defGrad(k1,k2) = zero
end do
defGrad(k1,k1) = one
end do
c
c COMPUTE INCREMENTAL STRAINS
c
do nodi = 1, nnode
incr_row = (nodi - 1)*ndof
do i = 1, ndof
xdu(i)= du(i + incr_row,1)
utmp(i) = u(i + incr_row)
end do
dNidx = bmat(1 + (nodi-1)*ndim)
dNidy = bmat(2 + (nodi-1)*ndim)
dstran(1) = dstran(1) + dNidx*xdu(1)
dstran(2) = dstran(2) + dNidy*xdu(2)
dstran(4) = dstran(4) +
1 dNidy*xdu(1) +
2 dNidx*xdu(2)
c deformation gradient
defGrad(1,1) = defGrad(1,1) + dNidx*utmp(1)
defGrad(1,2) = defGrad(1,2) + dNidy*utmp(1)
defGrad(2,1) = defGrad(2,1) + dNidx*utmp(2)
defGrad(2,2) = defGrad(2,2) + dNidy*utmp(2)
end do
c
c CALL CONSTITUTIVE ROUTINE
c
isvinc= (kintk-1)*nsvint ! integration point increment
c
c prepare arrays for entry into material routines
c
do i = 1, nsvint
statevLocal(i)=svars(i+isvinc)
end do
c
c state variables
c
do k1=1,ntens
stran(k1) = statevLocal(k1)
stress(k1) = zero
end do
c
do i=1, ntens
do j=1, ntens
ddsdde(i,j) = zero
end do
ddsdde(i,j) = one
enddo
c
c compute characteristic element length
c
celent = sqrt(djac*dble(ninpt))
dvmat = djac*thickness
c
dvdv0 = one
call material_lib_mech(materiallib,stress,ddsdde,
1 stran,dstran,kintk,dvdv0,dvmat,defGrad,
2 predef_loc,dpredef_loc,npredf,celent,coords_ip)
c
do k1=1,ntens
statevLocal(k1) = stran(k1) + dstran(k1)
end do
c
isvinc= (kintk-1)*nsvint ! integration point increment
c
c update element state variables
c
do i = 1, nsvint
svars(i+isvinc)=statevLocal(i)
end do
c
c form stiffness matrix and internal force vector
c
dNjdx = zero
dNjdy = zero
do i = 1, ndof*nnode
force(i) = zero
do j = 1, ndof*nnode
stiff(j,i) = zero
end do
end do
dvol= wght(kintk)*djac
do nodj = 1, nnode
incr_col = (nodj - 1)*ndof
dNjdx = bmat(1+(nodj-1)*ndim)
dNjdy = bmat(2+(nodj-1)*ndim)
force_p(1) = dNjdx*stress(1) + dNjdy*stress(4)
force_p(2) = dNjdy*stress(2) + dNjdx*stress(4)
do jdof = 1, ndof
jcol = jdof + incr_col
force(jcol) = force(jcol) +
& force_p(jdof)*dvol
end do
do nodi = 1, nnode
incr_row = (nodi -1)*ndof
dNidx = bmat(1+(nodi-1)*ndim)
dNidy = bmat(2+(nodi-1)*ndim)
stiff_p(1,1) = dNidx*ddsdde(1,1)*dNjdx
& + dNidy*ddsdde(4,4)*dNjdy
& + dNidx*ddsdde(1,4)*dNjdy
& + dNidy*ddsdde(4,1)*dNjdx
stiff_p(1,2) = dNidx*ddsdde(1,2)*dNjdy
& + dNidy*ddsdde(4,4)*dNjdx
& + dNidx*ddsdde(1,4)*dNjdx
& + dNidy*ddsdde(4,2)*dNjdy
stiff_p(2,1) = dNidy*ddsdde(2,1)*dNjdx
& + dNidx*ddsdde(4,4)*dNjdy
& + dNidy*ddsdde(2,4)*dNjdy
& + dNidx*ddsdde(4,1)*dNjdx
stiff_p(2,2) = dNidy*ddsdde(2,2)*dNjdy
& + dNidx*ddsdde(4,4)*dNjdx
& + dNidy*ddsdde(2,4)*dNjdx
& + dNidx*ddsdde(4,2)*dNjdy
do jdof = 1, ndof
icol = jdof + incr_col
do idof = 1, ndof
irow = idof + incr_row
stiff(irow,icol) = stiff(irow,icol) +
& stiff_p(idof,jdof)*dvol
end do
end do
end do
end do
c
c assemble rhs and lhs
c
do k1=1, ndof*nnode
rhs(k1, 1) = rhs(k1, 1) - force(k1)
do k2=1, ndof*nnode
amatrx(k1, k2) = amatrx(k1, k2) + stiff(k1,k2)
end do
end do
end do ! end loop on material integration points
pnewdt = pnewdtLocal
c
999 continue
c
return
end

53
Unpublished/XFEM2/umeshbak.for Normal file
View file

@ -0,0 +1,53 @@
C USER INPUT FOR ADAPTIVE MESH CONSTRAINT
C
SUBROUTINE UMESHMOTION(UREF,ULOCAL,NODE,NNDOF,
$ LNODETYPE,ALOCAL,NDIM,TIME,DTIME,PNEWDT,
$ KSTEP,KINC,KMESHSWEEP,JMATYP,JGVBLOCK,LSMOOTH)
C
include 'ABA_PARAM.INC'
C
C USER DEFINED DIMENSION STATEMENTS
C
CHARACTER*80 PARTNAME
DIMENSION ARRAY(1000),JPOS(15),HFARRAY(1000)
DIMENSION ULOCAL(*),UGLOBAL(NDIM),TLOCAL(NDIM)
DIMENSION JGVBLOCK(*),JMATYP(*)
DIMENSION NODELIST(100),JELEMLIST(10),JELEMTYPE(10)
DIMENSION ALOCAL(NDIM,*)
DIMENSION UTEMP(2)
C
C The dimensions of the variables ARRAY and JARRAY
C must be set equal to or greater than 15
C
CALL GETPARTINFO(NODE,0,PARTNAME,LOCNUM,JRCD)
CALL GETVRN(LOCNUM,'COORD',ARRAY,JRCD,JGVBLOCK,LTRN)
NELEMS=10
CALL GETNODETOELEMCONN(NODE, NELEMS, JELEMLIST, JELEMTYPE,
$ JRCD, JGVBLOCK)
CALL GETVRMAVGATNODE(NODE,1,'HFL',HFARRAY,JRCD,JELEMLIST,
$ NELEMS,JMATYP,JGVBLOCK)
C PRINT *,'****'
C PRINT *, HFARRAY(1),HFARRAY(2),HFARRAY(3),HFARRAY(4)
C PRINT *,NODE,TIME
FluxX=HFARRAY(2)
FluxY=HFARRAY(3)
FluxZ=HFARRAY(4)
if(abs(FluxX)<0.001)FluxX=0.
if(abs(FluxY)<0.001)FluxY=0.
if(abs(FluxZ)<0.001)FluxZ=0.
UGLOBAL(1) = -2.*FluxX
UGLOBAL(2) = -2.*FluxY
UGLOBAL(3) = 0.
DO I=1,NDIM
TLOCAL(I)=0.
DO J=1,NDIM
TLOCAL(I)=TLOCAL(I)+UGLOBAL(J)*ALOCAL(J,I)
ENDDO
ENDDO
DO I=1,NDIM
ULOCAL(I)=TLOCAL(I)
ENDDO
lsmooth=1
C
RETURN
END