120 integer ithermal,icmd,kode,ielas,iel,iint,nstate_,mi(*),nfiber,
122 & j,k,l,m,n,ioffset,nt,kk(84),iorien
124 real*8 elconloc(21),stiff(21),emec0(6),beta(6),stre(6),
125 & vj,t1l,dtime,xkl(3,3),xokl(3,3),voj,c(3,3),a(3),pgauss(3),
126 & orab(7,*),skl(3,3),aa(3),emec(6),time,ttime
128 real*8 xstate(nstate_,mi(1),*),xstateini(nstate_,mi(1),*),
129 & constant(21),dd,dm(3,3,4),djdc(3,3,4),d2jdc2(3,3,3,3,4),
130 &
v1,v1b,v3,v3bi,v4(4),v4br(4),djbdc(3,3,4),d2jbdc2(3,3,3,3,4),
131 & didc(3,3,3),d2idc2(3,3,3,3,3),dibdc(3,3,3),d2ibdc2(3,3,3,3,3),
132 & dudc(3,3),d2udc2(3,3,3,3),v33,cinv(3,3),xk1,xk2,d(3,3),term
134 kk=(/1,1,1,1,1,1,2,2,2,2,2,2,1,1,3,3,2,2,3,3,3,3,3,3,
135 & 1,1,1,2,2,2,1,2,3,3,1,2,1,2,1,2,1,1,1,3,2,2,1,3,3,3,1,3,
136 & 1,2,1,3,1,3,1,3,1,1,2,3,2,2,2,3,3,3,2,3,1,2,2,3,1,3,2,3,
149 constant(i)=elconloc(i)
151 if(dabs(constant(2)).lt.1.d-10)
then 152 constant(2)=1.d0/(20.d0*constant(1))
159 c(i,i)=emec(i)*2.d0+1.d0
178 a(1)=constant(ioffset)
179 a(2)=constant(ioffset+1)
180 dd=a(1)*a(1)+a(2)*a(2)
182 write(*,*)
'*ERROR in umat_el_fiber: components of' 183 write(*,*)
' direction vector ',k,
' are too big' 195 a(j)=skl(j,1)*aa(1)+skl(j,2)*aa(2)+skl(j,3)*aa(3)
208 v1=c(1,1)+c(2,2)+c(3,3)
209 v3=c(1,1)*(c(2,2)*c(3,3)-c(2,3)*c(2,3))
210 & -c(1,2)*(c(1,2)*c(3,3)-c(1,3)*c(2,3))
211 & +c(1,3)*(c(1,2)*c(2,3)-c(1,3)*c(2,2))
213 v4(j)=dm(1,1,j)*c(1,1)+dm(2,2,j)*c(2,2)+dm(3,3,j)*c(3,3)+
214 & 2.d0*(dm(1,2,j)*c(1,2)+dm(1,3,j)*c(1,3)+dm(2,3,j)*c(2,3))
221 cinv(1,1)=(c(2,2)*c(3,3)-c(2,3)*c(2,3))/v3
222 cinv(2,2)=(c(1,1)*c(3,3)-c(1,3)*c(1,3))/v3
223 cinv(3,3)=(c(1,1)*c(2,2)-c(1,2)*c(1,2))/v3
224 cinv(1,2)=(c(1,3)*c(2,3)-c(1,2)*c(3,3))/v3
225 cinv(1,3)=(c(1,2)*c(2,3)-c(2,2)*c(1,3))/v3
226 cinv(2,3)=(c(1,2)*c(1,3)-c(1,1)*c(2,3))/v3
236 didc(k,l,3)=v3*cinv(k,l)
238 djdc(k,l,j)=dm(k,l,j)
254 d2idc2(k,l,m,n,1)=0.d0
255 d2idc2(k,l,m,n,3)=v3*(cinv(m,n)*cinv(k,l)-
256 & (cinv(k,m)*cinv(n,l)+cinv(k,n)*cinv(m,l))/2.d0)
258 d2jdc2(k,l,m,n,j)=0.d0
268 v4br(j)=v4(j)*v33-1.d0
275 dibdc(k,l,1)=-v33**4*
v1*didc(k,l,3)/3.d0
278 djbdc(k,l,j)=-v33**4*v4(j)*didc(k,l,3)/3.d0
295 d2ibdc2(k,l,m,n,1)=4.d0/9.d0*v33**7*
v1*didc(k,l,3)
296 & *didc(m,n,3)-v33**4/3.d0*(didc(m,n,1)*didc(k,l,3)
297 & +didc(k,l,1)*didc(m,n,3))-v33**4/3.d0*
v1*
298 & d2idc2(k,l,m,n,3)+v33*d2idc2(k,l,m,n,1)
300 d2jbdc2(k,l,m,n,j)=4.d0/9.d0*v33**7*v4(j)*didc(k,l,3)
301 & *didc(m,n,3)-v33**4/3.d0*(djdc(m,n,j)*didc(k,l,3)
302 & +djdc(k,l,j)*didc(m,n,3))-v33**4/3.d0*v4(j)*
303 & d2idc2(k,l,m,n,3)+v33*d2jdc2(k,l,m,n,j)
313 dudc(k,l)=constant(1)*dibdc(k,l,1)+
314 & (1.d0-v3bi)*didc(k,l,3)/constant(2)
316 if(v4br(j).lt.0.d0) cycle
317 if(xk2*v4br(j)**2.gt.227.d0)
then 318 write(*,*)
'*ERROR in umat_elastic_fiber' 319 write(*,*)
' fiber extension is too large' 320 write(*,*)
' for exponential function' 324 xk1=constant(ioffset+1)
325 xk2=constant(ioffset+2)
326 dudc(k,l)=dudc(k,l)+xk1*v4br(j)*
327 & dexp(xk2*v4br(j)**2)*djbdc(k,l,j)
343 term=constant(1)*d2ibdc2(k,l,m,n,1)+
344 & v3bi**3*didc(k,l,3)*didc(m,n,3)/(2.d0*constant(2))
345 & +(1.d0-v3bi)*d2idc2(k,l,m,n,3)/constant(2)
347 if(v4br(j).lt.0.d0) cycle
349 xk1=constant(ioffset+1)
350 xk2=constant(ioffset+2)
351 term=term+xk1*dexp(xk2*v4br(j)**2)*
352 & (djbdc(k,l,j)*djbdc(m,n,j)*(1.d0+2.d0*xk2*v4br(j)**2)+
353 & v4br(j)*d2jbdc2(k,l,m,n,j))
372 stiff(i)=4.d0*d2udc2(k,l,m,n)
378 stre(1)=2.d0*dudc(1,1)
379 stre(2)=2.d0*dudc(2,2)
380 stre(3)=2.d0*dudc(3,3)
381 stre(4)=2.d0*dudc(1,2)
382 stre(5)=2.d0*dudc(1,3)
383 stre(6)=2.d0*dudc(2,3)
static double * v1
Definition: mafillsmmain_se.c:40