i25pwr3e.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/.
!||====================================================================
!||    i25pwr3e               ../starter/source/interfaces/inter3d1/i25pwr3e.F
!||--- called by ------------------------------------------------------
!||    inint3                 ../starter/source/interfaces/inter3d1/inint3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE i25pwr3e(ITAB ,INACTI ,CAND_M  ,CAND_S ,ISTOK,
     1                   LLT   ,PENE   ,IWPENE  ,CAND_P ,
     2                   N1    ,N2     ,M1      ,M2     ,
     3                   NOINT ,NTY    ,IRECT   ,ID     ,TITR   ,
     4                   CAND_M_G ,CAND_S_G,CAND_P_G ,IEDGE,NLEDGE,
     5                   NEDGE ,LEDGE)
 
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
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      "scr03_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ITAB(*),CAND_M(*),CAND_S(*), IRECT(4,*), 
     .        N1(*), N2(*), M1(*), M2(*),
     .        CAND_M_G(*),CAND_S_G(*)
      INTEGER LLT,IWPENE,INACTI,NOINT,NTY,NSN,ISTOK
      INTEGER  , INTENT(IN) :: IEDGE, NEDGE, NLEDGE
      INTEGER  , INTENT(IN) :: LEDGE(NLEDGE,*)
C     REAL
      my_real
     .   pene(*), cand_p(*), cand_p_g(*)
      INTEGER ID
      CHARACTER(LEN=NCHARTITLE) :: TITR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, L
      INTEGER IX1, IX2, IX3, IX4, NSVG
      INTEGER SOL_EDGE, SH_EDGE
C     REAL
C-----------------------------------------------
 
      sol_edge=iedge/10 ! solids
      sh_edge =iedge-10*sol_edge ! shells
 
       DO i=1,llt
 
         IF(pene(i)/=zero)THEN
C          True initial penetration
           IF(sh_edge==1.AND.ledge(3,cand_m(i))/=0) THEN
 
           ELSEIF(sh_edge==1.AND.ledge(3,cand_s(i))/=0) THEN
 
             ELSEIF(sh_edge==3 .AND.
     .        ledge(3,cand_m(i))/=0 .AND.
     .        ledge(3,cand_s(i))/=0) THEN ! One of the 2 edges is not a free edge 
             
           ELSE
             iwpene=iwpene+1
             IF(ipri>=5) 
     .         CALL ancmsg(msgid=1631,
     .                         msgtype=msgwarning,
     .                         anmode=aninfo_blind_1,
     .                         i1=itab(n1(i)),
     .                         i2=itab(n2(i)),
     .                         i3=itab(m1(i)),
     .                         i4=itab(m2(i)),
     .                         r1=pene(i),
     .                         prmod=msg_cumu)
           ENDIF
           IF(inacti==0)THEN
C            Ignore initial penetrations
C          ELSEIF(INACTI==1) THEN
C            DESACTIVATION DES NOEUDS
C            WRITE(IOUT,'(A)')'NODE STIFFNESS IS SET TO ZERO'
C            STFN(J) = ZERO
           ELSE IF(inacti==5) THEN
C
C            Reduction of PENE
             istok=istok+1
             cand_m_g(istok)= cand_m(i)
             cand_s_g(istok)= cand_s(i)
             cand_p_g(istok)= -pene(i)
           ELSE IF(inacti==-1) THEN
             istok=istok+1
C            CAND_P < 0 <=> Initial penetration into the Starter & Initial forces
             cand_m_g(istok)= cand_m(i)
             cand_s_g(istok)= cand_s(i)
             cand_p_g(istok)= -pene(i)
           ENDIF
         ELSE
         END IF
 
      END DO
C
      RETURN
      END