c	 2D XFEM Corrosion Element     





	 subroutine uel(rhs,amatrx,svars,energy,ndofel,nrhs,nsvars,props,         
     1 nprops,coords,mcrd,nnode,u,du,v,a,jtype,time,dtime,kstep,kinc,
     2 jelem,params,ndload,jdltyp,adlmag,predef,npredf,lflags,
     3 mlvarx,ddlmag,mdload,pnewdt,jprops,njprop,period)
c
      include 'aba_param.inc'
c
      dimension rhs(mlvarx,*),amatrx(ndofel,ndofel),svars(nsvars),
     1 energy(8),props(*),coords(mcrd,nnode),
     2 u(ndofel),du(mlvarx,*),v(ndofel),a(ndofel),time(2),
     3 params(3),jdltyp(mdload,*),adlmag(mdload,*),
     4 ddlmag(mdload,*),predef(2,npredf,nnode),lflags(*),jprops(*)
c
      dimension phig(8),phih(8),phi(8),phix(8),phiy(8)
	  dimension crdnx(4),crdny(4),w(8),dndg(4),dndh(4)
	  dimension theta(4),rjac(2,2),rjaci(2,2)
c
      parameter(zero=0.d0,one=1.d0)
c       material property definition
		thick = 1.
		rho   = 1.
		beta=40.
		vel=0.0
		dpos=0.25+vel*time(2)
c       initialization  (nrhs=1)                                                        
		do k1=1,ndofel                      
			rhs(k1,nrhs)=zero
			do k2=1,ndofel
				amatrx(k2,k1)=zero
			enddo                                      
		enddo                                      
		if (lflags(1).eq.33) then
			do icrd=1,4
				crdnx(icrd)=coords(1,icrd)
				crdny(icrd)=coords(2,icrd)
				theta(icrd)=abs(crdnx(icrd)-dpos)*
     1				sign(1.,crdnx(icrd)-dpos)	
			enddo
			if sign(1.,theta(1))/=sign(1.,theta(2))then
c				Enriched
				ienr=8
				elen=abs(crdnx(2)-crdnx(1))
				frac=abs(dpos-crdnx(1))/elen
				rlen1=2.*frac
				rlen2=2.*(1.-frac)  					
				rmid1=-1+rlen1/2.
				rmid2=1-rlen2/2.
				gx(1)=rmid1-(rlen1/2.)/sqrt(3.)
				gx(2)=rmid1+(rlen1/2.)/sqrt(3.)
				gx(3)=rmid1+(rlen1/2.)/sqrt(3.)
				gx(4)=rmid1-(rlen1/2.)/sqrt(3.)
				gx(5)=rmid2-(rlen2/2.)/sqrt(3.)
				gx(6)=rmid2+(rlen2/2.)/sqrt(3.)
				gx(7)=rmid2+(rlen2/2.)/sqrt(3.)
				gx(8)=rmid2-(rlen2/2.)/sqrt(3.) 
				gpos=1/sqrt(3.)
				hx(1)=-gpos
				hx(2)=-gpos
				hx(3)=+gpos
				hx(4)=+gpos
				hx(5)=-gpos
				hx(6)=-gpos
				hx(7)=+gpos
				hx(8)=+gpos 					
				do iw=1,4
					w(iw)=frac/2.;
					w(iw+4)=(1.-frac)/2.;
				enddo
			else
c				Normal Shp Funs	
				ienr=4
				gpos=1./sqrt(3.)
				gx(1)=-gpos
				gx(2)=gpos
				gx(3)=gpos
				gx(4)=-gpos
				hx(1)=-gpos
				hx(2)=-gpos
				hx(3)=gpos
				hx(4)=gpos
				do iw=1,4
					w(iw)=1.
				enddo
			endif
c     		assemble amatrx and rhs
			do k=1,ienr
c     			loop through gauss pts
				g=gx(k)
				h=hx(k)
				phi(1)=0.25*(1.-g)*(1.-h)
				phi(3)=0.25*(1.+g)*(1.-h)
				phi(5)=0.25*(1.+g)*(1.+h)
				phi(7)=0.25*(1.-g)*(1.+h)  				
				riLS=theta(1)*phi(1)+theta(2)*phi(3)+
     1				theta(3)*phi(5)+theta(4)*phi(7)
				if (riLS<0.)then
					cond=0.
					spec=0.01
				else
					cond=1.
					spec=1.
				endif				
				do iter=1,4
					phi(2*iter)=phi(2*iter-1)*
     1					(abs(riLS)-abs(theta(iter)))	
				enddo
				phig(1)=0.25*-(1.-h)
				phig(3)=0.25*(1.-h)
				phig(5)=0.25*(1.+h)
				phig(7)=0.25*-(1.+h)
				phih(1)=0.25*-(1.-g)
				phih(3)=0.25*-(1.+g)
				phih(5)=0.25*(1.+g)
				phih(7)=0.25*(1.-g)
				diLSg=sign(1.,iLS)*(phig(1)*theta(1)+phig(3)*
     1				theta(2)+phig(5)*theta(3)+phig(7)*theta(4))
				diLSh=sign(1.,iLS)*(phih(1)*theta(1)+phih(3)*
     1				theta(2)+phih(5)*theta(3)+phih(7)*theta(4))
				do iter=1,4                      
					phig(2*iter)=phig(2*iter-1)*(abs(iLS)-
     1					abs(theta(iter)))+phi(2*iter-1)*diLSg
					phih(2*iter)=phih(2*iter-1)*(abs(iLS)-
     1					abs(theta(iter)))+phi(2*iter-1)*diLSh
				enddo  
				rjac=0.
				do iter=1,4
					rjac(1,1)=rjac(1,1)+phig(2*iter-1)*crdnx(iter)
					rjac(1,2)=rjac(1,2)+phig(2*iter-1)*crdny(iter)
					rjac(2,1)=rjac(2,1)+phih(2*iter-1)*crdnx(iter)
					rjac(2,2)=rjac(2,2)+phih(2*iter-1)*crdny(iter)
				enddo
				djac=rjac(1,1)*rjac(2,2)-rjac(1,2)*rjac(2,1)
				rjaci(1,1)= rjac(2,2)/djac
				rjaci(2,2)= rjac(1,1)/djac
				rjaci(1,2)=-rjac(1,2)/djac
				rjaci(2,1)=-rjac(2,1)/djac  
				do iter=1,8              
					phix(iter)=rjaci(1,1)*phig(iter)+rjaci(1,2)*phih(iter)
					phiy(iter)=rjaci(2,1)*phig(iter)+rjaci(2,2)*phih(iter)
				enddo
				dtdx=zero
				dtdy=zero
				t =zero
				told=zero
				do i=1,8
					dtdx=u(i)*phix(i)+dtdx
					dtdy=u(i)*phiy(i)+dtdy
					t=u(i)*phi(i)+t
					told=(u(i)-du(i,nrhs))*phi(i)+told
				end do
				dtdt=(t-told)/dtime
				we=w(k)*djac
				do ki=1,8
c       		loop over nodes
					rhs(ki,nrhs) = rhs(ki,nrhs) - 
     1                 	we*(phi(ki)*rho*spec*dtdt + 
     2                 	cond*(phix(ki)*dtdx + phiy(ki)*dtdy))
					do kj=1,8
						amatrx(ki,kj)= amatrx(ki,kj) + 
     1					we*(phi(ki)*phi(kj)*rho*spec/dtime +
     1                 	cond*(phix(ki)*phix(kj)+phiy(ki)*phiy(kj)))            		
					end do
				end do
			enddo
c			if interface is in the element a penalty term is needed
			if(enr==4)then
				xi=point
				gm(1)=(1.-xi)/2.
				gm(3)=(1.+xi)/2.
				term=theta(1)*gm(1)+theta(2)*gm(3)
				gm(2)=gm(1)*(abs(term)-abs(theta(1)))
				gm(4)=gm(3)*(abs(term)-abs(theta(2)))
				term2=gm(1)*u(1)+gm(2)*u(2)+gm(3)*u(3)+gm(4)*u(4)
				diff=abs(term2-1.)
c				add penalty flux/force: BGtc
				targetT=1.
				do i=1,4
					rhs(i,nrhs)=rhs(i,nrhs)+beta*gm(i)*diff
				enddo
c				find GtG
				gm2=0.
				do i=1,4
					do j=1,4
						gm2(i,j)=gm(i)*gm(j)
					enddo
				enddo
c				add penalty stiffness
				do i=1,4
					do j=1,4
						amatrx(i,j)=amatrx(i,j)+beta*gm2(i,j)
					enddo
				enddo
			endif
		end if
		return
		end