rini45__rb_8F_source.html

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/.

!||====================================================================

!||    rini45_rb              ../starter/source/elements/joint/rjoint/rini45_rb.F

!||--- called by ------------------------------------------------------

!||    initia                 ../starter/source/elements/initia/initia.F

!||--- calls      -----------------------------------------------------

!||    ancmsg                 ../starter/source/output/message/message.F

!||    find_rby               ../starter/source/elements/joint/rjoint/rini33_rb.F

!||    fretitl2               ../starter/source/starter/freform.F

!||    get_u_geo              ../starter/source/user_interface/uaccess.F

!||    get_u_skew             ../starter/source/user_interface/uaccess.F

!||    reset_u_geo            ../starter/source/user_interface/uaccess.F

!||--- uses       -----------------------------------------------------

!||    message_mod            ../starter/share/message_module/message_mod.F

!||====================================================================


      SUBROUTINE rini45_rb(NEL,NUVAR,IPROP,IXR,NPBY,

     1                     LPBY,RBY,STIFR,UVAR,ITAB,

     1                     IGEO,IXR_KJ,GMASS,MS,IN)

C-----------------------------------------------

C   M o d u l e s

C-----------------------------------------------

      USE message_mod

      USE names_and_titles_mod , ONLY : nchartitle

      use element_mod , only : nixr

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      "param_c.inc"

C-----------------------------------------------

C   C o m m o n   B l o c k s

C-----------------------------------------------

#include      "vect01_c.inc"

#include      "com04_c.inc"

#include      "scr17_c.inc"

#include      "units_c.inc"

C----------------------------------------------------------

C   D u m m y   A r g u m e n t s   a n d   F u n c t i o n

C----------------------------------------------------------

      INTEGER NEL,NUVAR,IPROP,IXR(NIXR,*),NPBY(NNPBY,NRBODY),LPBY(*),

     .        ITAB(*),IXR_KJ(5,*),IGEO(NPROPGI)

      my_real

     . rby(nrby,nrbody),stifr(*),uvar(nuvar,*),gmass(*),ms(*),in(*)

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER I,II,IEL,J,K,N,L,S,NN,NSL,IERROR,NODES,USR,

     .        IDSK(2),ISK,NSK,ISK2,JTYP,M(2),NOD(2),NODF(3),

     .        reset_u_geo,get_u_skew,srb(6),no(3),idskrb(2),

     .        idrb(2),err_flg,n1,n2,n3,n4,id_kj,numel_kj,ielusr,

     .        rb1,rb2,ipid,idsk2

C

      my_real

     .   mass,iner,rm,ri,knn,kr,l2,u(lskew),q(lskew),get_u_geo,v(lskew),

     .   xsk1,xsk2,len

C

      INTEGER ID

      CHARACTER(LEN=NCHARTITLE) :: TITR

C-----------------------------------------------

      INTEGER FIND_RBY

      EXTERNAL GET_U_GEO,RESET_U_GEO,GET_U_SKEW

      DATA nodes/2/

C=======================================================================


      id=igeo(1)

      CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)

C

      DO iel=1,nel

        l2 = 0.

        rm = 1.e30

        ri = 1.e30

          idrb(1)=0

          idrb(2)=0

C-->

        DO i=1,nodes

            m(i) = 0

            k = 0

            nod(i)=ixr(1+i,nft+iel)

C-->        Search of connected rbody ---

            DO n=1,nrbody

              nsl=npby(2,n)

              IF (npby(1,n)==nod(i)) THEN

C--             Tag for error message - Can't be attached to main node of rbody-

          idrb(i)=-n

                uvar(37+i,iel)= n

                EXIT

              ENDIF

C

              DO j=1,nsl

                nn = lpby(j+k)

                IF(nn==nod(i)) THEN

            idrb(i)=n

                  m(i) = npby(1,n)

                  mass = rby(14,n)

                  iner = (rby(10,n)+rby(11,n)+rby(12,n))/3.0

C                 L2 = INER/MASS

                  uvar(33+i,iel)= mass

                  uvar(35+i,iel)= iner

                  uvar(37+i,iel)= n

C-->

                  GOTO 100

                ENDIF

              ENDDO

100           k = k+nsl

            ENDDO

C

C-> Storage of a elementary mass (hormone mass) for special energy calculation

            gmass(iel) = (uvar(34,iel)*uvar(35,iel))/max(em20,uvar(34,iel)+uvar(35,iel))

C-->

            IF (idrb(i)==0) THEN

C-->          no rbodies found - kjoint connected to structural node  ---

              uvar(33+i,iel)= ms(nod(i))

              uvar(35+i,iel)= in(nod(i))

              uvar(37+i,iel)= 0

              IF (ms(nod(i)) <= em20) THEN

                CALL ancmsg(msgid=1773,

     .                      msgtype=msgerror,

     .                      anmode=aninfo_blind_2,

     .                      i1=id,

     .                      c1=titr,

     .                      i2=ixr(nixr,nft+iel),

     .                      i3=itab(nod(i)))

              ELSEIF (in(nod(i)) <= em20) THEN

                CALL ancmsg(msgid=1774,

     .                      msgtype=msgwarning,

     .                      anmode=aninfo_blind_2,

     .                      i1=id,

     .                      c1=titr,

     .                      i2=ixr(nixr,nft+iel),

     .                      i3=itab(nod(i)))

              ENDIF

            ELSEIF (idrb(i) < 0) THEN

C-->          kjoint connected to main node of rbody - error --

              CALL ancmsg(msgid=1768,

     .                    msgtype=msgerror,

     .                    anmode=aninfo_blind_2,

     .                    i1=id,

     .                    c1=titr,

     .                    i2=ixr(nixr,nft+iel),

     .                    i3=itab(nod(i)))

              ENDIF

C

        ENDDO

C-->

      ENDDO


C---> Print of the output for kjoint2--------------------

      DO iel=1,nel

        ielusr = ixr(nixr,nft+iel)

        rb1 = 0

        rb2 = 0

          IF (uvar(38,iel) > 0) rb1 = npby(6,nint(uvar(38,iel)))

          IF (uvar(39,iel) > 0) rb2 = npby(6,nint(uvar(39,iel)))

        n1 = itab(ixr(2,nft+iel))

        n2 = itab(ixr(3,nft+iel))

          n3 = 0

          n4 = 0

        IF (ixr(4,nft+iel)/=0) n3 = itab(ixr(4,nft+iel))

          len=sqrt(uvar(1,iel)**2+uvar(2,iel)**2+uvar(3,iel)**2)

          numel_kj = ixr_kj(1,numelr+1)

        DO j=1,numel_kj

          IF (ixr_kj(4,j)==ielusr) id_kj = j

        END DO

        IF (id_kj>0) THEN

          IF (ixr_kj(1,id_kj)/=0) n4 = itab(ixr_kj(1,id_kj))

        ENDIF

        idsk2 = nint(get_u_geo(54,iprop))

        IF (idsk2==0) THEN

          WRITE(iout,2000)

          WRITE(iout,'(1X,5I10,4X,2I10,2X,F16.7,2X,3F16.7)') ielusr,n1,

     .    n2,n3,n4,rb1,rb2,len,(uvar(21+k,iel),k=1,3)

          WRITE(iout,'(2(95X,3F16.7/))') (uvar(21+k,iel),k=4,9)

        ELSE

          WRITE(iout,2100)

          WRITE(iout,'(1X,5I10,4X,2I10,2X,F16.7,2X,F16.7,2X,3F16.7)') ielusr,n1,

     .    n2,n3,n4,rb1,rb2,len,uvar(7,iel),(uvar(21+k,iel),k=1,3)

          WRITE(iout,'(2(95X,F16.7,2X,3F16.7))' ) uvar(8,iel) ,(uvar(21+k,iel),k=4,6)

          WRITE(iout,'(2(95X,F16.7,2X,3F16.7/))') uvar(9,iel) ,(uvar(21+k,iel),k=7,9)

        ENDIF

      ENDDO


C-------------------------------------------------------


      RETURN

 2000 FORMAT(5x,'NUMBER',8x,'N1',8x,'N2',8x,'N3',8x,'N4',

     .       8x,'RBODY1',4x,'RBODY2',12x,'LENGTH',13x,

     .       'LOCAL SKEW (VECTORS)')


 2100 FORMAT(5x,'NUMBER',8x,'N1',8x,'N2',8x,'N3',8x,'N4',

     .       8x,'RBODY1',4x,'RBODY2',12x,'LENGTH',4x,'INITIAL ANGLES (RAD)',13x,

     .       'LOCAL SKEW (VECTORS)')


      RETURN


      END

C

my_real
#define my_real
Definition cppsort.cpp:32

max
#define max(a, b)
Definition macros.h:21

message_mod
Definition message_mod.F:1257

names_and_titles_mod
Definition names_and_titles_mod.F:1002

names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008

rini45_rb
subroutine rini45_rb(nel, nuvar, iprop, ixr, npby, lpby, rby, stifr, uvar, itab, igeo, ixr_kj, gmass, ms, in)
Definition rini45_rb.F:40

ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895

fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799

get_u_skew
integer function get_u_skew(idskw, n1, n2, n3, v)
Definition uaccess.F:1127

reset_u_geo
integer function reset_u_geo(ivar, ip, a)
Definition uaccess.F:395