i23pwr3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	i23pwr3 (itab, inacti, cand_e, cand_n, stfn, x, i_stok, nsv, iwpene, pene, noint, nty, gap_s, msr, irect, gapmin, gapmax, fpenmax, nsn, itag, cand_en, cand_nn, cand_p, stf, ifpen, ifpenn, gapv)

Function/Subroutine Documentation

i23pwr3()

subroutine i23pwr3	(	integer, dimension(*)	itab,
		integer	inacti,
		integer, dimension(*)	cand_e,
		integer, dimension(*)	cand_n,
			stfn,
			x,
		integer	i_stok,
		integer, dimension(*)	nsv,
		integer	iwpene,
			pene,
		integer	noint,
		integer	nty,
			gap_s,
		integer, dimension(*)	msr,
		integer, dimension(4,*)	irect,
			gapmin,
			gapmax,
			fpenmax,
		integer	nsn,
		integer, dimension(*)	itag,
		integer, dimension(*)	cand_en,
		integer, dimension(*)	cand_nn,
			cand_p,
			stf,
		integer, dimension(*)	ifpen,
		integer, dimension(*)	ifpenn,
			gapv )

Definition at line 31 of file i23pwr3.F.

      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