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, nNodSec, nNodMain, * nFricDir, nDir, * nStates, nProps, nTemp, nFields, * jFlags, rData, * surfInt, surfSec, surfMain, * jConSecUid, jConMainUid, props, * dSlipFric, fStickForce, fTangPrev, fNormal, * areaCont, dircosN, dircosSec, * shapeSec, shapeMain, * coordSec, coordMain, * velSec, velMain, * tempSec, tempMain, * fieldSec, fieldMain ) c c Array dimensioning variables: c c nBlockAnal = nBlock (non-analytical-rigid main surface) c nBlockAnal = 1 (analytical rigid main surface) c nBlockEdge = 1 (non-edge-type secondary surface) c nBlockEdge = nBlock (edge-type secondary surface) c nNodState = 1 (node-type secondary surface) c nNodState = 4 (edge-type secondary surface) c nNodSec = 1 (node-type secondary surface) c nNodSec = 2 (edge-type secondary surface) c nNodMain = 4 (facet-type main surface) c nNodMain = 2 (edge-type main surface) c nNodMain = 1 (analytical rigid main surface) c c Surface names surfSec and surfMain are not available for c general contact (set to blank). c include 'vaba_param.inc' dimension fTangential(nFricDir,nBlock), * state(nStates,nNodState,nBlock), * jConSecUid(nNodSec,nBlock), * jConMainUid(nNodMain,nBlockAnal), * props(nProps), * dSlipFric(nDir,nBlock), * fStickForce(nBlock), * fTangPrev(nDir,nBlock), * fNormal(nBlock), * areaCont(nBlock), * dircosN(nDir,nBlock), * dircosSec(nDir,nBlock), * shapeSec(nNodSec,nBlockEdge), * shapeMain(nNodMain,nBlockAnal), * coordSec(nDir,nNodSec,nBlock), * coordMain(nDir,nNodMain,nBlockAnal), * velSec(nDir,nNodSec,nBlock), * velMain(nDir,nNodMain,nBlockAnal), * tempSec(nBlock), * tempMain(nBlockAnal), * fieldSec(nFields,nBlock), * fieldMain(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, surfSec, surfMain 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