i25pwr3e.F File Reference

#include "implicit_f.inc"
#include "scr03_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i25pwr3e (itab, inacti, cand_m, cand_s, istok, llt, pene, iwpene, cand_p, n1, n2, m1, m2, noint, nty, irect, id, titr, cand_m_g, cand_s_g, cand_p_g, iedge, nledge, nedge, ledge)

Function/Subroutine Documentation

i25pwr3e()

subroutine i25pwr3e	(	integer, dimension(*)	itab,
		integer	inacti,
		integer, dimension(*)	cand_m,
		integer, dimension(*)	cand_s,
		integer	istok,
		integer	llt,
			pene,
		integer	iwpene,
			cand_p,
		integer, dimension(*)	n1,
		integer, dimension(*)	n2,
		integer, dimension(*)	m1,
		integer, dimension(*)	m2,
		integer	noint,
		integer	nty,
		integer, dimension(4,*)	irect,
		integer	id,
		character(len=nchartitle)	titr,
		integer, dimension(*)	cand_m_g,
		integer, dimension(*)	cand_s_g,
			cand_p_g,
		integer, intent(in)	iedge,
		integer, intent(in)	nledge,
		integer, intent(in)	nedge,
		integer, dimension(nledge,*), intent(in)	ledge )

Definition at line 32 of file i25pwr3e.F.

 
      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