i23pwr3.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/.
!||====================================================================
!||    i23pwr3       ../starter/source/interfaces/inter3d1/i23pwr3.F
!||--- called by ------------------------------------------------------
!||    inint3        ../starter/source/interfaces/inter3d1/inint3.F
!||--- uses       -----------------------------------------------------
!||    format_mod    ../starter/share/modules1/format_mod.F90
!||    message_mod   ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE i23pwr3(ITAB,INACTI,CAND_E,CAND_N,STFN,
     1                  X     ,I_STOK,NSV   ,IWPENE,PENE,
     2                  NOINT,NTY   ,GAP_S ,MSR ,
     3                  IRECT,GAPMIN,GAPMAX ,FPENMAX,
     4                  NSN  ,ITAG  ,CAND_EN,CAND_NN,
     5                  CAND_P,STF  ,IFPEN ,IFPENN,GAPV)
      USE message_mod
      USE format_mod , ONLY : fmw_5i
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 ITAB(*),CAND_E(*),CAND_N(*), IRECT(4,*), 
     .        ITAG(*),CAND_NN(*),CAND_EN(*), IFPEN(*),
     .        IFPENN(*)
      INTEGER I_STOK,NSV(*),MSR(*),IWPENE,INACTI,NOINT,NTY,NSN,JWARN
      my_real
     .   stfn(*),x(3,*),pene(*),cand_p(*),gap_s(*),
     .   gapmin,gapmax,stf(*),gapv(*),fpenmax
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "scr03_c.inc"
#include      "units_c.inc"
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
      my_real PENMAX
C-----------------------------------------------
       JWARN = 0
        DO 100 i=1,i_stok
          j=cand_n(i)
          l=cand_e(i)
 
          ix1=irect(1,l)
          ix2=irect(2,l)
          ix3=irect(3,l)
          ix4=irect(4,l)
          nsvg=nsv(j)
          IF(pene(i)>zero)THEN
            IF(ipri>=1)THEN
              WRITE(iout,fmt=fmw_5i) itab(nsvg), itab(ix1),itab(ix2), itab(ix3),itab(ix4)
            END IF
            WRITE(iout,1000)pene(i)
C
            penmax=fpenmax*gapv(i)
            IF(inacti==1) THEN
C             DESACTIVATION DES NOEUDS
              WRITE(iout,'(A)')'NODE STIFFNESS IS SET TO ZERO'
              stfn(j) = zero
            ELSE IF(inacti==2) THEN
C             DESACTIVATION DES ELEMENTS
              WRITE(iout,'(A)')'ELEMENT STIFFNESS IS SET TO ZERO'
              stf(cand_e(i)) = zero
            ELSE IF(inacti==3) THEN
C             CHANGE LES COORDONNEES DES NOEUDS SECND
              WRITE(iout,'(A)')
     .          'INACTI=3 IS NOT AVAILABLE FOR INTERFACE TYPE23'
            ELSE IF(inacti==4) THEN
C             CHANGE LES COORDONNEES DES NOEUDS MAIN
              WRITE(iout,'(A)')
     .          'INACTI=4 IS NOT AVAILABLE FOR INTERFACE TYPE23'
            ELSEIF(fpenmax /= zero .AND. pene(i) > penmax) THEN
C               DESACTIVATION DES NOEUDS
                WRITE(iout,'(A,1PG20.13,A)')
     .                ' MAX INITIAL PENETRATION ',penmax,' IS REACHED'
                WRITE(iout,'(A)')'NODE STIFFNESS IS SET TO ZERO'
                stfn(j) = zero
            ELSE IF(inacti==5) THEN
C             REDUCTION DU GAP 
              jwarn = 1
              pene(i)=pene(i)+em08*pene(i)
            ELSE
C             INACTI==6
C             REDUCTION DU GAP 
              jwarn = 1
              pene(i)=pene(i)+zep05*(gapv(i)-pene(i))
            END IF
            cand_p(iwpene+1)  = pene(i)
            cand_nn(iwpene+1) = cand_n(i)
            cand_en(iwpene+1) = cand_e(i)
            ifpenn(iwpene+1)  = ifpen(i)
            iwpene=iwpene+1
          ENDIF
 100    CONTINUE
        IF (jwarn /= 0) WRITE(iout,'(A)')'REDUCE INITIAL GAP'
C
 1000 FORMAT(2x,'** INITIAL PENETRATION =',1pg20.13)
      RETURN
      END