subroutine uedinc(inc1,incsub1)
      implicit real*8 (a-h,o-z)
c     dummy user subroutine that would get called at the end of each
c     increment

c
c     for each node 
c        icntyp = 0  no contact
c               = 1  node is contacting rigid surface only
c               = 2  node is a tied node
c               = 3  node is a retained node
c               >10  node is a retained node in multiple ties
c
c	contf	contact force components
c
      include '../common/array4'
      include '../common/array5'
      include '../common/arrays'
      include '../common/develp'
      include '../common/space'
      include '../common/peturb'
      include '../common/dimen'
      include '../common/form'
      include '../common/form1'

C ndiflx	No. of flexible bodies
C nbct		No. of nodes on the boundary of contact body
C nbcn		Upper bound to the no. of nodes on the boundary of contact body
C setwr2	Internal routine, copies contact information to iwrkn2
C vecftc	Internal routine, used to copy nodal information from global vector
C inod		internal node number (that is in contact)
C contf		Array containing contact forces for a given node
C i2or3		2d or 3D problem
C lext		external (user) node number


	dimension contf(10)
	save incold

	character*20 ext,status
	ext='cont'
	status='unknown'
	
	if(incold.ne.inc1) then
	 jjj = flopen(56,ext,status)
	  write(56,*)"Contact forces in Increment ",inc1
	  write(56,110)
 110	  format("Body No.",3X,"Node",3X,"icntyp",8X,"Force X",6X,"Force Y",6X,"Force Z")
	  incold=inc1
	endif
	
c
C	write(57,*)inc,vars(ixtrap),vars(ixtrap+1),vars(ixtrap+2)
	do 100 md=1,ndiflx
	 nbct=ints(inbct+md-1)
	 do 200 i=1,nbct
	  inod=ints(inf+(md-1)*nbcn+i-1)
	  call vecftc(contf,vars(ipload),ndegmx,ndeg,inod,jrdpre,0,15)

C convert the internal node number to user node number
	  lext=ndinex(inod,1)
          call setwr2(ints(iwrkn2))
	  icntyp = ints(iwrkn2+inod-1)
	  if(icntyp.gt.0) then
	   if(i2or3.eq.2) then
	    write(56,111)md,lext,icntyp,contf(1),contf(2)
111	    format(3i7,5X,2e14.5)
	   else if(i2or3.eq.3) then
	    write(56,111)md,lext,icntyp,contf(1),contf(2),contf(3)
112	    format(3i7,5X,3e14.5)
	   endif
	  endif

C convert the external node to internal node number
	lint=ndinex(lext,2)
	write(55,*)lint,lext,icntyp

200	continue
100	continue
c
      return
      end


	function ndinex(node,it)
	
      implicit real*8 (a-h,o-z)
      include '../common/arrays'
      include '../common/develp'
      include '../common/space'
      include '../common/dimen'
      include '../common/prepro'

	lint1=lint
	lext1=lext
	if(it.eq.1) then
C convert the internal node number to user node number
	  ndinex=node
	  la2=inpnum+node-1
	  if(joptit.ne.0) ndinex=igetsh(ints(la2),1)
	  if(nnoids.ne.0) ndinex=ints(inoids+ndinex-1)
	else if(it.eq.2) then
C convert the external node to internal node number
	  ndinex=ibsrch(node,ints(inoids),numnp,1)
	  la2=inpnum+ndinex-1
	  if(joptit.ne.0)ndinex=igetsh(ints(la2),0)
	endif
	
	return
	end

C *************
C Subroutine to create a file name of a given extension
	function flopen(nunit,ext,status)
	implicit real*8 (a-h,o-z)
        parameter (idlen=80)
      character jidnam*(idlen),ridnam*(idlen),pidnam*(idlen),
     1  sidnam*(idlen),thfname*(idlen)
	character ext*(20),status*(20),flname*(idlen+21)
	dimension ilen(7)
      common /jname/ jidnam,ridnam,pidnam,sidnam,ilen

C	lnext = index(ext,' ') - 1
C	lnsta = index(status,' ') - 1
	jl = ilen(1)
	flname = jidnam(:jl)//'.'//ext
	open(unit=nunit,name=flname,status=status)

	return
	end