i2forces_2D.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/.
!||====================================================================
!||    i2forces_2d   ../engine/source/interfaces/interf/i2forces_2D.F
!||--- called by ------------------------------------------------------
!||    i2for3n       ../engine/source/interfaces/interf/i2for3.F
!||    i2for3pn      ../engine/source/interfaces/interf/i2for3p.F
!||--- uses       -----------------------------------------------------
!||    h3d_mod       ../engine/share/modules/h3d_mod.F
!||====================================================================
      SUBROUTINE i2forces_2d(X      ,FS      ,FX      ,FY      ,FZ      ,
     .                       IRECT  ,NIR     ,FSAV    ,FNCONT  ,FNCONTP ,
     .                       FTCONTP,WEIGHT  ,H3D_DATA,NSL     ,H)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE h3d_mod 
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER , INTENT(IN) :: NSL,IRECT(4),NIR,WEIGHT(NUMNOD)
      my_real , INTENT(IN) :: X(3,NUMNOD),H(4)
      my_real , INTENT(INOUT) :: fsav(6),fncont(3,numnod),fncontp(3,numnod),
     .                           ftcontp(3,numnod)
      my_real , INTENT(IN)    :: fs(3),fx(4),fy(4),fz(4)
      TYPE(h3d_database),INTENT(IN) :: H3D_DATA
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "scr14_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N1,N2,N3,N4,J,JJ
C     REAL
      my_real
     .   xc0,yc0,zc0,xc,yc,zc,x0,x1,x2,y0,y1,y2,
     .   z0,z1,z2,xcdg,ycdg,zcdg,mcdg,
     .   sum,fnorm,vx,vy,vz,dt12m,fn(3),ft(3)
C=======================================================================
      IF (tt == zero) THEN   
        dt12m = one/dt2
      ELSE
        dt12m = one/dt12
      ENDIF
C
      IF (weight(nsl)==1) THEN
C
        n1  = irect(1)
        n2  = irect(2)
C
        x0  = x(1,nsl)
        y0  = x(2,nsl)
        z0  = x(3,nsl)
        x1  = x(1,n1)
        y1  = x(2,n1)
        z1  = x(3,n1)
        x2  = x(1,n2)
        y2  = x(2,n2)
        z2  = x(3,n2)
C------------------------------------------------                  
C       direction of segment
        vx = x1 - x2
        vy = y1 - y2
        vz = z1 - z2
C------------------------------------------------
        sum = one / sqrt(vx*vx + vy*vy + vz*vz)
        vx = vx * sum
        vy = vy * sum
        vz = vz * sum
C   
C       composantes N/T de la forces nodale
C
        fnorm = vx*fs(1) + vy*fs(2) + vz*fs(3)
        ft(1) = vx*fnorm
        ft(2) = vy*fnorm
        ft(3) = vz*fnorm
C
        fn(1) = fs(1) - ft(1)
        fn(2) = fs(2) - ft(2)
        fn(3) = fs(3) - ft(3)
C
C-------- print of forces in TH
C
        fsav(1) = fsav(1) + fn(1)*dt1
        fsav(2) = fsav(2) + fn(2)*dt1
        fsav(3) = fsav(3) + fn(3)*dt1
        fsav(4) = fsav(4) + ft(1)*dt1
        fsav(5) = fsav(5) + ft(2)*dt1
        fsav(6) = fsav(6) + ft(3)*dt1
C
C-------- print of forces in ANIM / H3D
C 
        IF(anim_v(13)+h3d_data%N_VECT_CONT2>0) THEN
          fncont(1,nsl) = fncont(1,nsl) - fs(1)
          fncont(2,nsl) = fncont(2,nsl) - fs(2)
          fncont(3,nsl) = fncont(3,nsl) - fs(3)
          DO jj=1,nir
            j=irect(jj)
            fncont(1,j) = fncont(1,j) + fx(jj)
            fncont(2,j) = fncont(2,j) + fy(jj)
            fncont(3,j) = fncont(3,j) + fz(jj)
          ENDDO
        ENDIF  
C
        IF(anim_v(27)+h3d_data%N_VECT_PCONT2>0) THEN ! Normal/Tangential forces output
          fncontp(1,nsl) = fncontp(1,nsl) - fs(1)
          fncontp(2,nsl) = fncontp(2,nsl) - fs(2)
          fncontp(3,nsl) = fncontp(3,nsl) - fs(3)
          DO jj=1,nir
            j=irect(jj)
            fncontp(1,j) = fncontp(1,j) + fx(jj)
            fncontp(2,j) = fncontp(2,j) + fy(jj)
            fncontp(3,j) = fncontp(3,j) + fz(jj)
          ENDDO
 
          ftcontp(1,nsl) = vx
          ftcontp(2,nsl) = vy
          ftcontp(3,nsl) = vz
          DO jj=1,nir
            j=irect(jj)
            ftcontp(1,j) = ftcontp(1,j) - ftcontp(1,nsl)*h(jj)
            ftcontp(2,j) = ftcontp(2,j) - ftcontp(2,nsl)*h(jj)
            ftcontp(3,j) = ftcontp(3,j) - ftcontp(3,nsl)*h(jj)
          ENDDO
        ENDIF
C
      ENDIF
C---
      RETURN
      END