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