update_weight_inter_type7.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/.
!||====================================================================
!||    update_weight_inter_type7   ../starter/source/spmd/domain_decomposition/update_weight_inter_type7.F
!||--- called by ------------------------------------------------------
!||    i20ini3                     ../starter/source/interfaces/inter3d1/i20ini3.F
!||    inint3                      ../starter/source/interfaces/inter3d1/inint3.F
!||--- uses       -----------------------------------------------------
!||    inter_cand_mod              ../starter/share/modules1/inter_cand_mod.F
!||====================================================================
        SUBROUTINE update_weight_inter_type7(NELEMINT,INTERFACE_ID,NSN,NRTM,IFIEND,
     .                                       IRECT,NSV,I_STOK,CAND_E,CAND_N,
     .                                       IGAP,GAP,GAPMAX,GAPMIN,DGAPLOAD,
     .                                       DRAD,GAP_S,GAP_S_L,GAP_M,GAP_M_L,
     .                                       NUMNOD,X,INTER_CAND)
!$COMMENT
!       UPDATE_WEIGHT_INTER_TYPE7 description :
!       save the contact data for interface type 7 
!
!       UPDATE_WEIGHT_INTER_TYPE7 organization :
!           for each contact, save :
!            * 4 main node IDs
!            * 1 secondary node ID
!            * 1 segment ID
!            * type of interface
!$ENDCOMMENT
        USE inter_cand_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
        INTEGER, INTENT(inout) :: NELEMINT
        INTEGER, INTENT(in) :: INTERFACE_ID !< interface id 
        INTEGER, INTENT(in) :: NSN !< number of S node
        INTEGER, INTENT(in) :: NRTM !< number of segment
        INTEGER, INTENT(inout) :: IFIEND !< ???
        INTEGER, DIMENSION(4,NRTM) :: IRECT !< list of M nodes for the NRTM segments
        INTEGER, DIMENSION(NSN) :: NSV !< list of S nodes
        INTEGER, INTENT(in) :: I_STOK !< total number of pair of candidate
        INTEGER, INTENT(in) :: NUMNOD !< number of node
        INTEGER, DIMENSION(I_STOK), INTENT(in) :: CAND_E !< segment id of the candidate I
        INTEGER, DIMENSION(I_STOK), INTENT(in) :: CAND_N !< pointer to the S node id of the candidate I
        INTEGER, INTENT(in) :: IGAP !< gap option for the current interface
        my_real, INTENT(in) :: gap,gapmax,gapmin !< gap value
        my_real, INTENT(IN) :: dgapload ,drad !< other kind of gap
        my_real, DIMENSION(NSN) :: gap_s,gap_s_l !< gap of S node
        my_real, DIMENSION(NRTM) :: gap_m,gap_m_l!< gap of segment
        my_real, DIMENSION(3,NUMNOD), INTENT(in) :: x
        TYPE(inter_cand_), INTENT(inout) :: INTER_CAND
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
        INTEGER :: S_NODE_ID
        INTEGER :: SEGMENT_ID
 
        INTEGER :: N,I
        INTEGER :: IX1,IX2,IX3,IX4
        my_real
     .   xmin,xmax,ymin,ymax,zmin,zmax,threshold,
     .   xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4
C-----------------------------------------------
        ifiend = ifiend + i_stok
        inter_cand%IXINT(1:inter_cand%S_IXINT_1,nelemint+1:nelemint+i_stok) = 0
        inter_cand%ADDRESS(interface_id) = nelemint ! save the adress of the first pair
        threshold = max(gap+dgapload,drad)
        ! ---------------------------
        ! loop over the S candidates
        DO i = 1, i_stok
          s_node_id = nsv(cand_n(i)) ! S node id
          segment_id  = cand_e(i) ! segment id
          ! find the 4 M node id
          ix1=irect(1,segment_id)
          ix2=irect(2,segment_id)
          ix3=irect(3,segment_id)
          ix4=irect(4,segment_id)
 
          inter_cand%IXINT(1,nelemint+i) = ix1
          inter_cand%IXINT(2,nelemint+i) = ix2
          inter_cand%IXINT(3,nelemint+i) = ix3
          inter_cand%IXINT(4,nelemint+i) = ix4
          inter_cand%IXINT(5,nelemint+i) = s_node_id
          inter_cand%IXINT(6,nelemint+i) = 7
          inter_cand%IXINT(7,nelemint+i) = segment_id
          inter_cand%IXINT(8,nelemint+i) = interface_id
 
          zi = x(3,s_node_id)
          z1=x(3,ix1)
          z2=x(3,ix2)
          z3=x(3,ix3)
          z4=x(3,ix4)
          IF(igap==0)THEN
            threshold = gap
          ELSE
            threshold=gap_s(cand_n(i))+gap_m(cand_e(i))
            IF(igap==3)
     .        threshold=min(threshold,
     .             gap_s_l(cand_n(i))+gap_m_l(cand_e(i)))
            threshold=min(threshold,gapmax)
            threshold=max(threshold,gapmin)
          ENDIF
          threshold = max(threshold+dgapload,drad)
 
          ! -------------
          ! check if the S node will be retain for the interface force computation for the 
          ! first cycle of the engine
          zmin = min(z1,z2,z3,z4)-threshold
          zmax = max(z1,z2,z3,z4)+threshold
          IF (zmin<=zi.AND.zmax>=zi) THEN
            yi = x(2,s_node_id)
            y1 = x(2,ix1)
            y2 = x(2,ix2)
            y3 = x(2,ix3)
            y4 = x(2,ix4)
            ymin = min(y1,y2,y3,y4)-threshold
            ymax = max(y1,y2,y3,y4)+threshold
            IF (ymin<=yi.AND.ymax>=yi) THEN
              xi = x(1,s_node_id)
              x1 = x(1,ix1)
              x2 = x(1,ix2)
              x3 = x(1,ix3)
              x4 = x(1,ix4)
              xmin = min(x1,x2,x3,x4)-threshold
              xmax = max(x1,x2,x3,x4)+threshold
              IF (xmin<=xi.AND.xmax>=xi) THEN
                inter_cand%IXINT(6,nelemint+i)=-7
              ENDIF
            ENDIF
          ENDIF
          ! -------------          
        ENDDO
        ! ---------------------------
        nelemint=nelemint+i_stok
        inter_cand%ADDRESS(interface_id+1) = nelemint ! save the adress of the last pair
        ! ---------------------------
 
        RETURN
        END SUBROUTINE update_weight_inter_type7