i9frms.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "scr08_a_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i9frms (x, skew, a, fn, ft, irect, lmsr, crst, msr, nsv, iloc, irtl, ms, nor, lcode, iskew, fric, msmn, msmt, nmn, nsn)

Function/Subroutine Documentation

i9frms()

subroutine i9frms	(		x,
			skew,
			a,
			fn,
			ft,
		integer, dimension(4,*)	irect,
		integer, dimension(4,*)	lmsr,
			crst,
		integer, dimension(*)	msr,
		integer, dimension(*)	nsv,
		integer, dimension(*)	iloc,
		integer, dimension(*)	irtl,
			ms,
			nor,
		integer, dimension(*)	lcode,
		integer, dimension(*)	iskew,
			fric,
			msmn,
			msmt,
		integer, intent(in)	nmn,
		integer, intent(in)	nsn )

Definition at line 31 of file i9frms.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "scr08_a_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRECT(4,*), LMSR(4,*), MSR(*), NSV(*), ILOC(*), IRTL(*),
     .   LCODE(*), ISKEW(*)
C     REAL
      my_real
     .   x(3,*), skew(lskew,*), a(*), fn(*), ft(*), msmn(*), msmt(*),
     .   crst(2,*), ms(*), nor(3,*), fric
      INTEGER, INTENT(in) :: NMN,NSN
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NIR, I, J, I3, J3, I2, J2, I1, J1, II, L, JJ, NN, JJ3,
     .   JJ2, JJ1
C     REAL
      my_real
     .   h(4), n1, n2, n3, aa(3), ss, tt, xmss, fxi, fyi, fzi, fsn,
     .   fxn, fyn, fzn, fxt, fyt, fzt, fst, fac, fxmi, fymi, fzmi,
     .   fsm, fxmn, fymn, fzmn, fxmt, fymt, fzmt
C-----------------------------------------------
C
      IF(n2d==0)THEN
        nir=4
      ELSE
        nir=2
      ENDIF
C
      DO 10 i=1,nmn
      j=msr(i)
      i3=3*i
      i2=i3-1
      i1=i2-1
      msmn(i1)=ms(j)
      msmt(i1)=ms(j)
      fn(i1)=zero
      fn(i2)=zero
      fn(i3)=zero
      ft(i1)=zero
      ft(i2)=zero
      ft(i3)=zero
 10   CONTINUE
C
      DO 60 ii=1,nsn
      i=nsv(ii)
      j=iloc(ii)
      IF(j<1) GO TO 60
      l=irtl(ii)
      DO 20 jj=1,nir
      nn=irect(jj,l)
  20  iy(jj)=nn
C
      ss=crst(1,ii)
      tt=crst(2,ii)
      n1=nor(1,ii)
      n2=nor(2,ii)
      n3=nor(3,ii)
C
      i3=3*i
      i2=i3-1
      i1=i2-1
C
      aa(1)=a(i1)
      aa(2)=a(i2)
      aa(3)=a(i3)
C
      IF(n2d==0)THEN
        CALL shapeh(h,ss,tt)
      ELSE
        h(1) = half*(one - ss)
        h(2) = half*(one + ss)
      ENDIF
      DO 50 jj=1,nir
      j3=3*iy(jj)
      j2=j3-1
      j1=j2-1
      jj3=3*msr(iy(jj))
      jj2=jj3-1
      jj1=jj2-1
C
      xmss=ms(i)*h(jj)
C-------------------------------------
C     FORCES TOTALE
C-------------------------------------
      fxi=aa(1)*xmss
      fyi=aa(2)*xmss
      fzi=aa(3)*xmss
      fxmi=a(jj1)*xmss
      fymi=a(jj1)*xmss
      fzmi=a(jj1)*xmss
C-------------------------------------
C     FORCE NORMALE SECOND C-------------------------------------
      fsn=(fxi*n1+fyi*n2+fzi*n3)
      fxn=fsn*n1
      fyn=fsn*n2
      fzn=fsn*n3
C-------------------------------------
C     FORCE NORMALE main (CORRECTIF)
C-------------------------------------
      fsm = (fxmi*n1+fymi*n2+fzmi*n3)
      fxmn = fsm*n1
      fymn = fsm*n2
      fzmn = fsm*n3
C-------------------------------------
C     sum of normal forces
C-------------------------------------
      fn(j1) = fn(j1) + fxn - fxmn
      fn(j2) = fn(j2) + fyn - fymn
      fn(j3) = fn(j3) + fzn - fzmn
      msmn(j1) = msmn(j1) + xmss
C-------------------------------------
C     FORCE FRICTION
C-------------------------------------
      fxt = fxi - fxn
      fyt = fyi - fyn
      fzt = fzi - fzn
      fst = sqrt(fxt*fxt+fyt*fyt+fzt*fzt)
      fac = min(one,fric*fsn/max(em30,fst))
C-------------------------------------
C     FORCE FRICTION main (CORRECTIF)
C-------------------------------------
      fxmt = fxmi - fxmn
      fymt = fymi - fymn
      fzmt = fzmi - fzmn
C-------------------------------------
C     sum of friction forces
C-------------------------------------
      ft(j1)=ft(j1) + (fxt - fxmt)*fac
      ft(j2)=ft(j2) + (fyt - fymt)*fac
      ft(j3)=ft(j3) + (fzt - fzmt)*fac
      msmt(j1)=msmt(j1) + xmss*fac
C
 50   CONTINUE
 60   CONTINUE
C
      RETURN