rivet0.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    rivet0          ../starter/source/elements/reader/rivet0.F
!||--- called by ------------------------------------------------------
!||    hm_read_rivet   ../starter/source/elements/reader/hm_read_rivet.F
!||--- calls      -----------------------------------------------------
!||    ancmsg          ../starter/source/output/message/message.F
!||    kinset          ../starter/source/constraints/general/kinset.F
!||--- uses       -----------------------------------------------------
!||    message_mod     ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE rivet0(V,VR,MS,IN,IXRI,RIVET,GEO,ITAB,IKINE)
      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
      END