i9frms.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    i9frms    ../engine/source/interfaces/int09/i9frms.F
!||--- called by ------------------------------------------------------
!||    i9main2   ../engine/source/interfaces/int09/i9main2.F
!||    i9main3   ../engine/source/interfaces/int09/i9main3.F
!||--- calls      -----------------------------------------------------
!||    shapeh    ../engine/source/ale/inter/shapeh.F
!||====================================================================
      SUBROUTINE i9frms(X    ,SKEW,A   ,FN ,FT   ,
     2                  IRECT,LMSR,CRST,MSR,NSV  ,
     3                  ILOC ,IRTL,MS  ,NOR,LCODE,
     4                  ISKEW,FRIC,MSMN,MSMT,NMN,NSN)
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
      END