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