i11pwr3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	i11pwr3 (itab, inacti, cand_m, cand_s, stfs, stfm, x, nsv, iwpene, n1, n2, m1, m2, nx, ny, nz, gapv, gap_s, gap_m, penis, penim, igap, print_warning)

Function/Subroutine Documentation

i11pwr3()

subroutine i11pwr3	(	integer, dimension(*)	itab,
		integer	inacti,
		integer, dimension(*)	cand_m,
		integer, dimension(*)	cand_s,
			stfs,
			stfm,
			x,
		integer, dimension(*)	nsv,
		integer	iwpene,
		integer, dimension(*)	n1,
		integer, dimension(*)	n2,
		integer, dimension(*)	m1,
		integer, dimension(*)	m2,
			nx,
			ny,
			nz,
			gapv,
			gap_s,
			gap_m,
			penis,
			penim,
		integer	igap,
		logical	print_warning )

Definition at line 30 of file i11pwr3.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
        USE format_mod , ONLY : fmw_4i, fmw_i_3f
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ITAB(*),CAND_M(*),CAND_S(*),INACTI,IGAP, N1(*) ,N2(*) ,M1(*) ,M2(*)
      INTEGER NSV(*),IWPENE
      LOGICAL PRINT_WARNING
      my_real stfs(*),stfm(*),x(3,*),gap_s(*) ,gap_m(*),penis(2,*), penim(2,*),nx(mvsiz), ny(mvsiz), nz(mvsiz),gapv(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
#include      "vect07_c.inc"
#include      "scr03_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, IS, IM,JWARN
      my_real pene(mvsiz), peneold, s2, d, pplus
C-----------------------------------------------
C
      jwarn = 0
      DO i=1,llt
         s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
         gapv(i) = sqrt(gapv(i))
         pene(i) = gapv(i) - s2
         s2 = 1./max(em30,s2)
         nx(i) = nx(i)*s2
         ny(i) = ny(i)*s2
         nz(i) = nz(i)*s2
      ENDDO
C
        DO 100 i=lft,llt
          IF(ipri>=1)THEN
            WRITE(iout,fmt=fmw_4i)
     2       itab(n1(i)),itab(n2(i)),itab(m1(i)),itab(m2(i))
          ENDIF
          IF(pene(i)>zero)THEN
           IF(ipri>=5)THEN
            WRITE(iout,1000)pene(i)
            WRITE(iout,fmt=fmw_i_3f)itab(n1(i)),
     .                                  x(1,n1(i))+pene(i)*nx(i),
     .                                  x(2,n1(i))+pene(i)*ny(i),
     .                                  x(3,n1(i))+pene(i)*nz(i)
            WRITE(iout,fmt=fmw_i_3f)itab(n2(i)),
     .                                  x(1,n2(i))+pene(i)*nx(i),
     .                                  x(2,n2(i))+pene(i)*ny(i),
     .                                  x(3,n2(i))+pene(i)*nz(i)
           ENDIF
C
            IF(inacti/=6)THEN
              pene(i) = pene(i) + em8*pene(i)
              IF(inacti==1) THEN
C               DESACTIVATION DES NOEUDS
                WRITE(iout,'(A)')'SECONDARY STIFFNESS IS SET TO ZERO'
                stfs(cand_s(i)) = zero
              ELSE IF(inacti==2) THEN
C               DESACTIVATION DES ELEMENTS
                WRITE(iout,'(A)')'MAIN STIFFNESS IS SET TO ZERO'
                stfm(cand_m(i)) = zero
              ELSE IF(inacti==5) THEN
C               REDUCTION DU GAP 
                IF(pene(i)>=gapv(i)*zep995)THEN
                  WRITE(iout,'(a)')' *** penetration > gap - 0.5% !! '
                  WRITE(iout,'(A)')'SECONDARY STIFFNESS IS SET TO ZERO'
                  pene(i)=gapv(i)
                  stfs(cand_s(i)) =zero
                ELSE
                  jwarn = 1
                  is=cand_s(i)
                  im=cand_m(i)
                   penis(2,is)=max(penis(2,is),half*pene(i))
                   penim(2,im)=max(penim(2,im),half*pene(i))
                  penis(1,is)=penis(2,is)
                  penim(1,im)=penim(2,im)
                ENDIF
              ENDIF
C
            ELSE
C             INACTI==6
              IF(pene(i)>=gapv(i)*zep995)THEN
                WRITE(iout,'(A)')' *** PENETRATION > GAP - 0.5% !! '
                WRITE(iout,'(A)')'SECONDARY STIFFNESS IS SET TO ZERO'
                pene(i)=gapv(i)
                stfs(cand_s(i)) = zero
              ELSE
                jwarn = 1
                is=cand_s(i)
                im=cand_m(i)
                pplus=half*(pene(i)+zep05*(gapv(i)-pene(i)))
                penis(2,is)=max(penis(2,is),pplus)
                penim(2,im)=max(penim(2,im),pplus)
                penis(1,is)=penis(2,is)
                penim(1,im)=penim(2,im)
              ENDIF
            END IF
C
            iwpene=iwpene+1
          ENDIF
 100    CONTINUE
        IF (jwarn==1 .AND. print_warning ) THEN
           WRITE(iout,'(A)')'REDUCE INITIAL GAP'
           print_warning = .false.
        ENDIF
C
 1000 FORMAT(2x,'** INITIAL PENETRATION =',1pg20.13,
     . ' POSSIBLE NEW COORDINATES OF SECONDARY NODES')
      RETURN