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 ) c u = props(1) c do k = 1, nBlock fn = fNormal(k) fs = fStickForce(k) ft = min ( u*fn, fs ) fTangential(1,k) = -ft fTangential(2,k) = zero end do c return end