c
c User subroutine VFRICTION to define friction forces
c
      subroutine vfriction (
c Write only - 
     *   fTangential, 
c Read/Write - 
     *   state,
c Read only - 
     *   nBlock, nBlockAnal, nBlockEdge, 
     *   nNodState, nNodSlv, nNodMst, 
     *   nFricDir, nDir, 
     *   nStates, nProps, nTemp, nFields, 
     *   jFlags, rData, 
     *   surfInt, surfSlv, surfMst, 
     *   jConSlvUid, jConMstUid, props, 
     *   dSlipFric, fStickForce, fTangPrev, fNormal, 
     *   areaCont, dircosN, dircosSl, 
     *   shapeSlv, shapeMst, 
     *   coordSlv, coordMst, 
     *   velSlv, velMst, 
     *   tempSlv, tempMst, 
     *   fieldSlv, fieldMst )
c
c Array dimensioning variables:
c
c      nBlockAnal = nBlock    (non-analytical-rigid master surface)
c      nBlockAnal = 1         (analytical rigid master surface)
c      nBlockEdge = 1         (non-edge-type slave surface)
c      nBlockEdge = nBlock    (edge-type slave surface)
c      nNodState  = 1         (node-type slave surface)
c      nNodState  = 4         (edge-type slave surface)
c      nNodSlv    = 1         (node-type slave surface)
c      nNodSlv    = 2         (edge-type slave surface)
c      nNodMst    = 4         (facet-type master surface)
c      nNodMst    = 2         (edge-type master surface)
c      nNodMst    = 1         (analytical rigid master surface)
c
c Surface names surfSlv and surfMst are not available for
c general contact (set to blank).
c
      include 'vaba_param.inc'
      dimension fTangential(nFricDir,nBlock),
     *   state(nStates,nNodState,nBlock),
     *   jConSlvUid(nNodSlv,nBlock), 
     *   jConMstUid(nNodMst,nBlockAnal), 
     *   props(nProps),
     *   dSlipFric(nDir,nBlock),
     *   fStickForce(nBlock), 
     *   fTangPrev(nDir,nBlock),
     *   fNormal(nBlock), 
     *   areaCont(nBlock),
     *   dircosN(nDir,nBlock),
     *   dircosSl(nDir,nBlock), 
     *   shapeSlv(nNodSlv,nBlockEdge), 
     *   shapeMst(nNodMst,nBlockAnal), 
     *   coordSlv(nDir,nNodSlv,nBlock), 
     *   coordMst(nDir,nNodMst,nBlockAnal), 
     *   velSlv(nDir,nNodSlv,nBlock), 
     *   velMst(nDir,nNodMst,nBlockAnal), 
     *   tempSlv(nBlock), 
     *   tempMst(nBlockAnal),
     *   fieldSlv(nFields,nBlock),
     *   fieldMst(nFields,nBlockAnal)
c
      parameter( iKStep    = 1,
     *           iKInc     = 2,
     *           iLConType = 3,
     *           nFlags    = 3 )
      parameter( iTimStep      = 1,
     *           iTimGlb       = 2,
     *           iDTimCur      = 3,
     *           iFrictionWork = 4, 
     *           nData         = 4 )
c
      dimension jFlags(nFlags), rData(nData)
      character*80 surfInt, surfSlv, surfMst 
      parameter( zero=0.d0, one=1.d0 )
c
      us = props(1)
      uk = props(2)
      dc = props(3)
      du = us - uk
      dTimCurInv = one / rData(iDTimCur)
c
      do k = 1, nBlock
         fn = fNormal(k)
         fs = fStickForce(k)
         slipRateNorm = sqrt( dSlipFric(1,k)*dSlipFric(1,k) +
     *                        dSlipFric(2,k)*dSlipFric(2,k) +
     *                        dSlipFric(3,k)*dSlipFric(3,k) )*dTimCurInv
         u = uk + du*exp( -dc*slipRateNorm )
         ft = min ( u*fn, fs )
         fTangential(1,k) = -ft
         fTangential(2,k) = zero
       end do
c
      return
      end