i21pwr3.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/.
!||====================================================================
!||    i21pwr3                ../starter/source/interfaces/inter3d1/i21pwr3.F
!||--- called by ------------------------------------------------------
!||    inint3_thkvar          ../starter/source/interfaces/inter3d1/inint3_thkvar.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||--- uses       -----------------------------------------------------
!||    format_mod             ../starter/share/modules1/format_mod.F90
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE i21pwr3(ITAB,INACTI,CAND_E,CAND_N,STFN,
     1                  X     ,I_STOK,NSV   ,IWPENE,PENI,
     2                  NOINT,NTY   ,GAP_S ,MSR ,IRTLM  ,
     3                  IRECT,XM0   ,GAPMIN,GAPMAX,DEPTH,
     4                  NSN  ,ITAG  ,DRAD  ,ID,TITR)
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
      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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "scr03_c.inc"
#include      "units_c.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,*), IRTLM(2,*),ITAG(*)
      INTEGER I_STOK,NSV(*),MSR(*),IWPENE,INACTI,NOINT,NTY,NSN
      my_real STFN(*),X(3,*),PENI(*),GAP_S(*),XM0(3,*),GAPMIN,GAPMAX,DEPTH,DRAD
      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,JWARN
      INTEGER IX1, IX2, IX3, IX4, NSVG
C-----------------------------------------------
       JWARN = 0
        DO 100 i=1,i_stok
          j=cand_n(i)
          l=cand_e(i)
          IF(irtlm(1,j)==cand_e(i))THEN
 
            ix1=msr(irect(1,l))
            ix2=msr(irect(2,l))
            ix3=msr(irect(3,l))
            ix4=msr(irect(4,l))
            nsvg=nsv(j)
            IF(peni(j)>zero)THEN
              IF(ipri>=1)THEN
                WRITE(iout,fmt=fmw_5i) itab(nsvg), itab(ix1),itab(ix2), itab(ix3),itab(ix4)
              END IF
c              IF(PENI(J)>ZERO)THEN
                WRITE(iout,1000)peni(j)
c              ENDIF
              IF(inacti/=6)THEN
                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)')
     .              'INACTI=2 IS NOT AVAILABLE FOR INTERFACE TYPE21'
                ELSE IF(inacti==3) THEN
C                 CHANGE LES COORDONNEES DES NOEUDS SECND
                  WRITE(iout,'(A)')
     .              'INACTI=3 IS NOT AVAILABLE FOR INTERFACE TYPE21'
                ELSE IF(inacti==4) THEN
C                 CHANGE LES COORDONNEES DES NOEUDS MAIN
                  WRITE(iout,'(A)')
     .              'INACTI=4 IS NOT AVAILABLE FOOR INTERFACE TYPE21'
                ELSE IF(inacti==5) THEN
C                 REDUCTION DU GAP 
                  jwarn = 1
                ENDIF
              ELSE
C               INACTI==6
C               REDUCTION DU GAP 
                jwarn = 1
C
                peni(j)=peni(j)
     .           +zep05*(min(max(gap_s(j),gapmin),gapmax)+depth-peni(j))
              END IF
              iwpene=iwpene+1
            ENDIF
          ENDIF
 100    CONTINUE
      IF (jwarn /= 0) WRITE(iout,'(A)')'REDUCE INITIAL GAP'
C
      IF(iwpene/=0) THEN
        CALL ancmsg(msgid=499,
     .              msgtype=msgwarning,
     .              anmode=aninfo_blind_1,
     .                   i1=id,
     .                   c1=titr,i2=iwpene)
      ENDIF
C
 1000 FORMAT(2x,'** INITIAL PENETRATION =',1pg20.13)
      RETURN
      END