i21pwr3.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	i21pwr3 (itab, inacti, cand_e, cand_n, stfn, x, i_stok, nsv, iwpene, peni, noint, nty, gap_s, msr, irtlm, irect, xm0, gapmin, gapmax, depth, nsn, itag, drad, id, titr)

Function/Subroutine Documentation

i21pwr3()

subroutine i21pwr3	(	integer, dimension(*)	itab,
		integer	inacti,
		integer, dimension(*)	cand_e,
		integer, dimension(*)	cand_n,
			stfn,
			x,
		integer	i_stok,
		integer, dimension(*)	nsv,
		integer	iwpene,
			peni,
		integer	noint,
		integer	nty,
			gap_s,
		integer, dimension(*)	msr,
		integer, dimension(2,*)	irtlm,
		integer, dimension(4,*)	irect,
			xm0,
			gapmin,
			gapmax,
			depth,
		integer	nsn,
		integer, dimension(*)	itag,
			drad,
		integer	id,
		character(len=nchartitle)	titr )

Definition at line 33 of file i21pwr3.F.

      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