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             deactivation of nodes
              WRITE(iout,'(A)')'NODE STIFFNESS IS SET TO ZERO'
              stfn(j) = zero
            ELSE IF(inacti==2) THEN
C             deactivation of elements
              WRITE(iout,'(A)')'ELEMENT STIFFNESS IS SET TO ZERO'
              stf(cand_e(i)) = zero
            ELSE IF(inacti==3) THEN
C             changes the coordinates of the secondary nodes
              WRITE(iout,'(A)')
     .          'INACTI=3 IS NOT AVAILABLE FOR INTERFACE TYPE23'
            ELSE IF(inacti==4) THEN
C             changes the coordinates of the main nodes
              WRITE(iout,'(A)')
     .          'INACTI=4 IS NOT AVAILABLE FOR INTERFACE TYPE23'
            ELSEIF(fpenmax /= zero .AND. pene(i) > penmax) THEN
C               deactivation of nodes
                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             gap reduction
              jwarn = 1
              pene(i)=pene(i)+em08*pene(i)
            ELSE
C             INACTI==6
C             gap reduction
              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