i25sti_edg.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/.
!||====================================================================
!||    i25sti_edg        ../starter/source/interfaces/inter3d1/i25sti_edg.F
!||--- called by ------------------------------------------------------
!||    inint3            ../starter/source/interfaces/inter3d1/inint3.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE i25sti_edg(
     1 NEDGE    ,LEDGE     ,STFE       ,STFM      ,IGAP      ,
     2 GAPE     ,GAP_E_L   ,GAP_M      ,GAP_M_L   ,GAP_S_L   ,
     3 BGAPEMX  ,INTFRIC   ,IPARTFRIC_E,IPARTFRICM,IPARTSM   ,
     4 BGAPEMX_L,NSN       ,NSV        )
C-----------------------------------------------
      USE intbuf_fric_mod  
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      "param_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEDGE,IGAP,INTFRIC,
     .   LEDGE(NLEDGE,*),IPARTFRIC_E(*) ,IPARTFRICM(*), IPARTSM(*)
      INTEGER , INTENT(IN) ::  NSN
      INTEGER , INTENT(IN) ::  NSV(NSN)
      my_real
     .   stfe(*), gape(*), gap_e_l(*), stfm(*), gap_m(*), gap_m_l(*), gap_s_l(*), bgapemx,
     .   bgapemx_l
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, A, B, N1, N2, IPRTA, IPRTB, IPRTGA, IPRTGB
      my_real
     .   STFA,STFB,GAPA,GAPB
      INTEGER, DIMENSION(:),ALLOCATABLE :: TAGSLAV
C-----------------------------------------------
      DO i=1,nedge
 
        stfa=zero
        stfb=zero
 
        a=ledge(1,i)
        IF(a/=0) stfa=stfm(a)
        b=ledge(3,i)
        IF(b/=0) stfb=stfm(b)
        IF(stfa/=zero.AND.stfb/=zero)THEN
          stfe(i)=two*stfa*stfb/max(zero,stfa+stfb)
        ELSE
          stfe(i)=max(stfa,stfb)
        END IF
      END DO
C
      bgapemx=zero        
      DO i=1,nedge
 
        gapa=zero
        gapb=zero
 
        a=ledge(1,i)
        IF(a/=0) gapa=gap_m(a)
        b=ledge(3,i)
        IF(b/=0) gapb=gap_m(b)
        gape(i)=max(gapa,gapb)
 
        bgapemx   = max(bgapemx,gape(i)) ! BGAPEMX overall the model 
 
      END DO
 
      bgapemx_l=zero        
      IF(igap==3)THEN
        ALLOCATE(tagslav(numnod))
        tagslav(1:numnod)   = 0
        DO i=1,nsn
           tagslav(nsv(i)) = i
        ENDDO
        DO i=1,nedge
          n1=ledge(5,i)
          n2=ledge(6,i)                             !      4-node segment
          gap_e_l(i)=min(gap_s_l(tagslav(n1)),gap_s_l(tagslav(n2)))   !    O-----------------O
                                                    !   Edge1             Edge2
 
          bgapemx_l   = max(bgapemx_l,gap_e_l(i)) ! BGAPEMX_L overall the model 
        END DO
        DEALLOCATE(tagslav)
      END IF
 
      IF(intfric > 0) THEN
        DO i=1,nedge
           iprta=0 
           iprtb=0
 
           iprtga=0
           iprtgb=0
 
           a=ledge(1,i)
           IF(a/=0) iprtga=ipartsm(a)
           IF(a/=0) iprta=ipartfricm(a)
 
           b=ledge(3,i)
           IF(b/=0) iprtgb=ipartsm(b)
           IF(b/=0) iprtb=ipartfricm(b)
 
           IF(iprta == iprtb) THEN
              ipartfric_e(i) = iprta
           ELSE
              IF(iprtga > iprtgb ) THEN ! bigger part id is taken
                 ipartfric_e(i) = iprta
              ELSE
                 ipartfric_e(i) = iprtb
              ENDIF
           ENDIF
        END DO
      ENDIF
C        
      RETURN
      END