rivet0.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	rivet0 (v, vr, ms, in, ixri, rivet, geo, itab, ikine)

Function/Subroutine Documentation

rivet0()

subroutine rivet0	(		v,
			vr,
			ms,
			in,
		integer, dimension(4,*)	ixri,
			rivet,
			geo,
		integer, dimension(*)	itab,
		integer, dimension(*)	ikine )

Definition at line 33 of file rivet0.F.

      USE message_mod
C
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      "param_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXRI(4,*), ITAB(*), IKINE(*)
C     REAL
      my_real
     .   v(3,*), vr(3,*), ms(*), in(*), rivet(nrivf,*),
     .   geo(npropg,*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, IGL, IG, IROT, K1, K2, IGTYP, IKINE1(3*NUMNOD)
C     REAL
      my_real
     .   xm, xin
C
      DO i=1,3*numnod
        ikine1(i) = 0
      ENDDO
C
      DO 100 i=1,nrivet
       rivet(1,i) = one
      ig=ixri(1,i)
C
      irot=geo(4,ig)
      k1=ixri(2,i)
      k2=ixri(3,i)
      xm=(ms(k1)+ms(k2))
         igtyp=geo(12,ig)
         IF (igtyp/=5) THEN
C           WRITE(ISTDO,*)' ** ERROR/RIVET PROPERTY SET'
C           WRITE(IOUT,1000)IGTYP
C 1000      FORMAT(//,' ** ERROR WRONG RIVET PROPERTY SET IDENTIFIER :',
C     .            I5,//)
C           IERR=IERR+1
            CALL ancmsg(msgid=46,
     .                  msgtype=msgerror,
     .                  anmode=aninfo_blind_1,
     .                  i1=ixri(4,i),
     .                  i2=igtyp)
         ENDIF
      IF(ms(k1)<1.e-15.OR.ms(k2)<1.e-15) THEN
C         WRITE(ISTDO,*)' ** ERROR/RIVET OR SPOTWELD DEFINITION'
C         WRITE(IOUT,2000)IXRI(4,I)
C 2000    FORMAT(//,' ** ERROR:ONE OR BOTH OF THE TWO NODES OF RIVET :'
C     .          ,I5,/,'HAVE A NULL MASS',
C     .          ' (MAY BE SECND NODE(S) OF A RIGID BODY)',//)
C         IERR=IERR+1
C        IF(MS(K1)<1.E-15.AND.MS(K2)<1.E-15) CALL ARRET(2)
         IF(ms(k1)<em15.AND.ms(k2)<em15) THEN
           CALL ancmsg(msgid=47,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=ixri(4,i))
         END IF
         CALL ancmsg(msgid=47,
     .               msgtype=msgerror,
     .               anmode=aninfo_blind_1,
     .               i1=ixri(4,i))
      ENDIF
      v(1,k1)=(v(1,k1)*ms(k1)+v(1,k2)*ms(k2))/xm
      v(2,k1)=(v(2,k1)*ms(k1)+v(2,k2)*ms(k2))/xm
      v(3,k1)=(v(3,k1)*ms(k1)+v(3,k2)*ms(k2))/xm
      v(1,k2)=v(1,k1)
      v(2,k2)=v(2,k1)
      v(3,k2)=v(3,k1)
      CALL kinset(32,itab(k1),ikine(k1),1,0,ikine1(k1))
      CALL kinset(32,itab(k1),ikine(k1),2,0,ikine1(k1))
      CALL kinset(32,itab(k1),ikine(k1),3,0,ikine1(k1))
      CALL kinset(32,itab(k2),ikine(k2),1,0,ikine1(k2))
      CALL kinset(32,itab(k2),ikine(k2),2,0,ikine1(k2))
      CALL kinset(32,itab(k2),ikine(k2),3,0,ikine1(k2))
      IF(irot==1)THEN
       CALL kinset(32,itab(k1),ikine(k1),4,0,ikine1(k1))
       CALL kinset(32,itab(k1),ikine(k1),5,0,ikine1(k1))
       CALL kinset(32,itab(k1),ikine(k1),6,0,ikine1(k1))
       CALL kinset(32,itab(k2),ikine(k2),4,0,ikine1(k2))
       CALL kinset(32,itab(k2),ikine(k2),5,0,ikine1(k2))
       CALL kinset(32,itab(k2),ikine(k2),6,0,ikine1(k2))
       IF(in(k1)<em15.AND.in(k2)<em15) THEN
C         WRITE(ISTDO,*)' ** ERROR/RIVET OR SPOTWELD DEFINITION'
C         WRITE(IOUT,3000)IXRI(4,I)
C 3000    FORMAT(//,' ** ERROR:ONE BOTH OF THE TWO NODES OF RIVET :'
C     .          ,I5,/,'HAVE A NULL INERTIA',
C     .          ' (MAY BE NODES OF 8 NODES SOLIDS)',//)
C         IERR=IERR+1
C         CALL ARRET(2)
          CALL ancmsg(msgid=48,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=ixri(4,i))
       ENDIF
       xin=(in(k1)+in(k2))
       vr(1,k1)=(vr(1,k1)*in(k1)+vr(1,k2)*in(k2))/xin
       vr(2,k1)=(vr(2,k1)*in(k1)+vr(2,k2)*in(k2))/xin
       vr(3,k1)=(vr(3,k1)*in(k1)+vr(3,k2)*in(k2))/xin
       vr(1,k2)=vr(1,k1)
       vr(2,k2)=vr(2,k1)
       vr(3,k2)=vr(3,k1)
      ENDIF
 100  CONTINUE
C
      RETURN