Add scripts and inp files.
This commit is contained in:
parent
ad937f2602
commit
e19f869a1e
390 changed files with 6580687 additions and 10 deletions
546
Unpublished/XFEM/AbaqusUEL/2D_Test1.for
Normal file
546
Unpublished/XFEM/AbaqusUEL/2D_Test1.for
Normal 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/XFEM/AbaqusUEL/2D_Test2.for
Normal file
108
Unpublished/XFEM/AbaqusUEL/2D_Test2.for
Normal 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/XFEM/AbaqusUEL/2D_XCor.for
Normal file
260
Unpublished/XFEM/AbaqusUEL/2D_XCor.for
Normal 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/XFEM/AbaqusUEL/2D_XCorS.f
Normal file
260
Unpublished/XFEM/AbaqusUEL/2D_XCorS.f
Normal 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/XFEM/AbaqusUEL/2D_XCorS.for
Normal file
113
Unpublished/XFEM/AbaqusUEL/2D_XCorS.for
Normal 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/XFEM/AbaqusUEL/AbInp.inp
Normal file
84
Unpublished/XFEM/AbaqusUEL/AbInp.inp
Normal 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
|
||||
79
Unpublished/XFEM/AbaqusUEL/AbInp1d.inp
Normal file
79
Unpublished/XFEM/AbaqusUEL/AbInp1d.inp
Normal 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
|
||||
237
Unpublished/XFEM/AbaqusUEL/JQuad.for
Normal file
237
Unpublished/XFEM/AbaqusUEL/JQuad.for
Normal 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/XFEM/AbaqusUEL/JQuadX.for
Normal file
293
Unpublished/XFEM/AbaqusUEL/JQuadX.for
Normal 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/XFEM/AbaqusUEL/JTruss.for
Normal file
70
Unpublished/XFEM/AbaqusUEL/JTruss.for
Normal 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/XFEM/AbaqusUEL/UEL2_TRANHTX.f
Normal file
202
Unpublished/XFEM/AbaqusUEL/UEL2_TRANHTX.f
Normal 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/XFEM/AbaqusUEL/UEL2_TRANHTX.for
Normal file
165
Unpublished/XFEM/AbaqusUEL/UEL2_TRANHTX.for
Normal 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/XFEM/AbaqusUEL/UEL_TRANHT.for
Normal file
80
Unpublished/XFEM/AbaqusUEL/UEL_TRANHT.for
Normal 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/XFEM/AbaqusUEL/UEL_TRANHTX.f
Normal file
81
Unpublished/XFEM/AbaqusUEL/UEL_TRANHTX.f
Normal 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/XFEM/AbaqusUEL/UEL_TRANHTX.for
Normal file
202
Unpublished/XFEM/AbaqusUEL/UEL_TRANHTX.for
Normal 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/XFEM/AbaqusUEL/UEL_TRANHT_2d.for
Normal file
114
Unpublished/XFEM/AbaqusUEL/UEL_TRANHT_2d.for
Normal 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/XFEM/AbaqusUEL/htelem.for
Normal file
198
Unpublished/XFEM/AbaqusUEL/htelem.for
Normal 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/XFEM/AbaqusUEL/uel.for
Normal file
192
Unpublished/XFEM/AbaqusUEL/uel.for
Normal 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/XFEM/AbaqusUEL/uelmat.for
Normal file
367
Unpublished/XFEM/AbaqusUEL/uelmat.for
Normal 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/XFEM/AbaqusUEL/uelmat2.for
Normal file
367
Unpublished/XFEM/AbaqusUEL/uelmat2.for
Normal 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/XFEM/AbaqusUEL/uelmatinp.for
Normal file
367
Unpublished/XFEM/AbaqusUEL/uelmatinp.for
Normal 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/XFEM/AbaqusUEL/uelmatinp.inp
Normal file
62
Unpublished/XFEM/AbaqusUEL/uelmatinp.inp
Normal 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/XFEM/AbaqusUEL/umeshbak.for
Normal file
53
Unpublished/XFEM/AbaqusUEL/umeshbak.for
Normal 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/XFEM/AbaqusUEL/usfdld.f
Normal file
27
Unpublished/XFEM/AbaqusUEL/usfdld.f
Normal 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/XFEM/AbaqusUEL/usfdld.for
Normal file
220
Unpublished/XFEM/AbaqusUEL/usfdld.for
Normal 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
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue