iqela1.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/.
!||====================================================================
!||    iqela1       ../engine/source/ale/inter/iqela1.F
!||--- called by ------------------------------------------------------
!||    intal2       ../engine/source/ale/inter/intal2.F
!||--- calls      -----------------------------------------------------
!||    shapeh       ../engine/source/ale/inter/shapeh.F
!||--- uses       -----------------------------------------------------
!||    h3d_mod      ../engine/share/modules/h3d_mod.F
!||    output_mod   ../common_source/modules/output/output_mod.F90
!||====================================================================
      SUBROUTINE iqela1(OUTPUT,A,E,MSM,IRECT,CRST,MSR,
     1                 NSV,ILOC,IRTL,MS,NOR,LCODE,ISKEW,FSAV,
     2                 FCONT,FNCONT,H3D_DATA,NSN,NMN)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE h3d_mod
      USE output_mod
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is related to option /INTER/TYPE1
C and computes forces. See E(1:3)=FSN.N(1:3)
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      "com04_c.inc"
#include      "com06_c.inc"
#include      "com08_c.inc"
#include      "scr07_c.inc"
#include      "scr08_a_c.inc"
#include      "scr14_c.inc"
#include      "scr16_c.inc"
#include      "param_c.inc"
#include      "comlock.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(output_), INTENT(INOUT) :: OUTPUT
      INTEGER,INTENT(INOUT) :: IRECT(4,*), MSR(*), NSV(*), ILOC(*), IRTL(*),LCODE(*), ISKEW(*)
      my_real,INTENT(INOUT) :: a(sa), e(*), msm(*), crst(2,*), ms(*),nor(3,*),fsav(*)
      my_real,INTENT(INOUT) :: fcont(3,*),fncont(3,*)
      INTEGER, INTENT(IN) :: NSN,NMN
      TYPE(h3d_database) :: H3D_DATA
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, ISK, LCOD
      my_real H(4), N1, N2, N3, AA(3), SSS, TTT, XMSS, FXI, FYI, FZI, FSN
      my_real :: fsn_sav, fxi_sav, fyi_sav, fzi_sav,impx,impy,impz
      LOGICAL ICONT, IPCONT, IANIM
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      icont  = .false.
      ipcont = .false.
      ianim  = .false.
      icont  = (anim_v(4)+outp_v(4) > 0+h3d_data%N_VECT_CONT)
      IF(anim_v(12)+outp_v(12)+h3d_data%N_VECT_PCONT > 0)THEN      
       IF( (tt>=output%TANIM .AND. tt<=output%TANIM_STOP) .OR.tt >= toutp.OR.tt >= h3d_data%TH3D.OR.
     .      (manim >= 4.AND.manim <= 15).OR. h3d_data%MH3D /= 0)THEN
         ipcont = .true.
       ENDIF
      ENDIF
      IF(icont .OR. ipcont)ianim=.true.
 
      fsn_sav = zero
      fxi_sav = zero
      fyi_sav = zero
      fzi_sav = zero
      
      nir=2
      IF(n2d == 0)nir=4
      !main nodes
      DO i=1,nmn
       j=msr(i)
       i3=3*i
       i2=i3-1
       i1=i2-1
       msm(i)=ms(j)
       e(i1)=zero
       e(i2)=zero
       e(i3)=zero
      ENDDO
 
      !second nodes
      DO ii=1,nsn
       i=nsv(ii)
       j=iloc(ii)
       IF(j >= 1) THEN
         l=irtl(ii)
         DO jj=1,nir
          nn=irect(jj,l)
          iy(jj)=nn
         ENDDO
         !parametric coordinates on main face
         sss=crst(1,ii)
         ttt=crst(2,ii)
         !normal
         n1=nor(1,ii)
         n2=nor(2,ii)
         n3=nor(3,ii)
         !A(1:3,I) <-> A(3*I - 1:3)
         i3=3*i
         i2=i3-1
         i1=i2-1
         CALL shapeh(h,sss,ttt)
         DO jj=1,nir
           j3=3*iy(jj)
           j2=j3-1
           j1=j2-1
           jj3=3*msr(iy(jj))
           jj2=jj3-1
           jj1=jj2-1
           aa(1)=a(i1)   !Accel for itab(I), where I=NSV(II)
           aa(2)=a(i2)
           aa(3)=a(i3)
           isk=iskew(iy(jj))
           lcod=lcode(iy(jj))
           xmss=ms(i)*h(jj)
           fxi=aa(1)-a(jj1)
           fyi=aa(2)-a(jj2)
           fzi=aa(3)-a(jj3)
           fsn=(fxi*n1+fyi*n2+fzi*n3)*xmss
           fsn_sav = fsn_sav + fsn
           fxi_sav = fxi_sav + fxi*xmss
           fyi_sav = fyi_sav + fyi*xmss
           fzi_sav = fzi_sav + fzi*xmss
           e(j1)=e(j1)+fsn*n1
           e(j2)=e(j2)+fsn*n2
           e(j3)=e(j3)+fsn*n3
           msm(iy(jj))=msm(iy(jj))+xmss
         enddo!next JJ
       ENDIF
      enddo!next II
 
      !SUM(E(1:3,*)) is NF(1:3) on main segment 
 
      !---------------------------------
      ! /TH/INTER
      !     NORMAL IMPULSE BACKUP
      !---------------------------------
      impx    = fxi_sav*dt12
      impy    = fyi_sav*dt12
      impz    = fzi_sav*dt12
      fsn_sav = fsn_sav*dt12
#include "lockon.inc"
      fsav(1)=fsav(1)  + impx
      fsav(2)=fsav(2)  + impy
      fsav(3)=fsav(3)  + impz
      fsav(8)=fsav(8)  + abs(impx)
      fsav(9)=fsav(9)  + abs(impy)
      fsav(10)=fsav(10)+ abs(impz)
      fsav(11)=fsav(11)+ fsn_sav
#include "lockoff.inc"
      !---------------------------------
 
 
      IF(ianim)THEN
        !---------------------------------
        ! /ANIM/VECT/CONT
        !---------------------------------
        IF(icont)THEN
#include "lockon.inc"
          DO i=1,nmn
            j          = msr(i)
            i3         = 3*i
            i2         = i3-1
            i1         = i2-1
            fcont(1,j) = fcont(1,j)+e(i1) 
            fcont(2,j) = fcont(2,j)+e(i2)
            fcont(3,j) = fcont(3,j)+e(i3)
          ENDDO
#include "lockoff.inc"
        ENDIF
        !---------------------------------
        ! /ANIM/VECT/PCONT
        !---------------------------------
        IF(ipcont)THEN
#include "lockon.inc"
          DO i=1,nmn
            j           = msr(i)
            i3          = 3*i
            i2          = i3-1
            i1          = i2-1
            fncont(1,j) = fncont(1,j)+e(i1) 
            fncont(2,j) = fncont(2,j)+e(i2)
            fncont(3,j) = fncont(3,j)+e(i3)
          ENDDO
#include "lockoff.inc"
        ENDIF
      ENDIF
 
      
 
C-----------------------------------------------------
 
      RETURN
      END