OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rini45_rb.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "vect01_c.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ rini45_rb()

subroutine rini45_rb ( integer nel,
integer nuvar,
integer iprop,
integer, dimension(nixr,*) ixr,
integer, dimension(nnpby,nrbody) npby,
integer, dimension(*) lpby,
rby,
stifr,
uvar,
integer, dimension(*) itab,
integer, dimension(npropgi) igeo,
integer, dimension(5,*) ixr_kj,
gmass,
ms,
in )

Definition at line 37 of file rini45_rb.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE names_and_titles_mod , ONLY : nchartitle
45 use element_mod , only : nixr
46C-------------------------------------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "param_c.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "vect01_c.inc"
58#include "com04_c.inc"
59#include "scr17_c.inc"
60#include "units_c.inc"
61C----------------------------------------------------------
62C 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
63C----------------------------------------------------------
64 INTEGER NEL,NUVAR,IPROP,IXR(NIXR,*),NPBY(NNPBY,NRBODY),LPBY(*),
65 . ITAB(*),IXR_KJ(5,*),IGEO(NPROPGI)
66 my_real
67 . rby(nrby,nrbody),stifr(*),uvar(nuvar,*),gmass(*),ms(*),in(*)
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I,II,IEL,J,K,N,L,S,NN,NSL,IERROR,NODES,USR,
72 . IDSK(2),ISK,NSK,ISK2,JTYP,M(2),NOD(2),NODF(3),
73 . RESET_U_GEO,GET_U_SKEW,SRB(6),NO(3),IDSKRB(2),
74 . IDRB(2),ERR_FLG,N1,N2,N3,N4,ID_KJ,NUMEL_KJ,IELUSR,
75 . RB1,RB2,IPID,IDSK2
76C
77 my_real
78 . mass,iner,rm,ri,knn,kr,l2,u(lskew),q(lskew),get_u_geo,v(lskew),
79 . xsk1,xsk2,len
80C
81 INTEGER ID
82 CHARACTER(LEN=NCHARTITLE) :: TITR
83C-----------------------------------------------
84 INTEGER FIND_RBY
85 EXTERNAL get_u_geo,reset_u_geo,get_u_skew
86 DATA nodes/2/
87C=======================================================================
88
89 id=igeo(1)
90 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
91C
92 DO iel=1,nel
93 l2 = 0.
94 rm = 1.e30
95 ri = 1.e30
96 idrb(1)=0
97 idrb(2)=0
98C-->
99 DO i=1,nodes
100 m(i) = 0
101 k = 0
102 nod(i)=ixr(1+i,nft+iel)
103C--> Search of connected rbody ---
104 DO n=1,nrbody
105 nsl=npby(2,n)
106 IF (npby(1,n)==nod(i)) THEN
107C-- Tag for error message - Can't be attached to main node of rbody-
108 idrb(i)=-n
109 uvar(37+i,iel)= n
110 EXIT
111 ENDIF
112C
113 DO j=1,nsl
114 nn = lpby(j+k)
115 IF(nn==nod(i)) THEN
116 idrb(i)=n
117 m(i) = npby(1,n)
118 mass = rby(14,n)
119 iner = (rby(10,n)+rby(11,n)+rby(12,n))/3.0
120C L2 = INER/MASS
121 uvar(33+i,iel)= mass
122 uvar(35+i,iel)= iner
123 uvar(37+i,iel)= n
124C-->
125 GOTO 100
126 ENDIF
127 ENDDO
128100 k = k+nsl
129 ENDDO
130C
131C-> Storage of a elementary mass (hormone mass) for special energy calculation
132 gmass(iel) = (uvar(34,iel)*uvar(35,iel))/max(em20,uvar(34,iel)+uvar(35,iel))
133C-->
134 IF (idrb(i)==0) THEN
135C--> no rbodies found - kjoint connected to structural node ---
136 uvar(33+i,iel)= ms(nod(i))
137 uvar(35+i,iel)= in(nod(i))
138 uvar(37+i,iel)= 0
139 IF (ms(nod(i)) <= em20) THEN
140 CALL ancmsg(msgid=1773,
141 . msgtype=msgerror,
142 . anmode=aninfo_blind_2,
143 . i1=id,
144 . c1=titr,
145 . i2=ixr(nixr,nft+iel),
146 . i3=itab(nod(i)))
147 ELSEIF (in(nod(i)) <= em20) THEN
148 CALL ancmsg(msgid=1774,
149 . msgtype=msgwarning,
150 . anmode=aninfo_blind_2,
151 . i1=id,
152 . c1=titr,
153 . i2=ixr(nixr,nft+iel),
154 . i3=itab(nod(i)))
155 ENDIF
156 ELSEIF (idrb(i) < 0) THEN
157C--> kjoint connected to main node of rbody - error --
158 CALL ancmsg(msgid=1768,
159 . msgtype=msgerror,
160 . anmode=aninfo_blind_2,
161 . i1=id,
162 . c1=titr,
163 . i2=ixr(nixr,nft+iel),
164 . i3=itab(nod(i)))
165 ENDIF
166C
167 ENDDO
168C-->
169 ENDDO
170
171C---> Print of the output for kjoint2--------------------
172 DO iel=1,nel
173 ielusr = ixr(nixr,nft+iel)
174 rb1 = 0
175 rb2 = 0
176 IF (uvar(38,iel) > 0) rb1 = npby(6,nint(uvar(38,iel)))
177 IF (uvar(39,iel) > 0) rb2 = npby(6,nint(uvar(39,iel)))
178 n1 = itab(ixr(2,nft+iel))
179 n2 = itab(ixr(3,nft+iel))
180 n3 = 0
181 n4 = 0
182 IF (ixr(4,nft+iel)/=0) n3 = itab(ixr(4,nft+iel))
183 len=sqrt(uvar(1,iel)**2+uvar(2,iel)**2+uvar(3,iel)**2)
184 numel_kj = ixr_kj(1,numelr+1)
185 DO j=1,numel_kj
186 IF (ixr_kj(4,j)==ielusr) id_kj = j
187 END DO
188 IF (id_kj>0) THEN
189 IF (ixr_kj(1,id_kj)/=0) n4 = itab(ixr_kj(1,id_kj))
190 ENDIF
191 idsk2 = nint(get_u_geo(54,iprop))
192 IF (idsk2==0) THEN
193 WRITE(iout,2000)
194 WRITE(iout,'(1X,5I10,4X,2I10,2X,F16.7,2X,3F16.7)') ielusr,n1,
195 . n2,n3,n4,rb1,rb2,len,(uvar(21+k,iel),k=1,3)
196 WRITE(iout,'(2(95X,3F16.7/))') (uvar(21+k,iel),k=4,9)
197 ELSE
198 WRITE(iout,2100)
199 WRITE(iout,'(1X,5I10,4X,2I10,2X,F16.7,2X,F16.7,2X,3F16.7)') ielusr,n1,
200 . n2,n3,n4,rb1,rb2,len,uvar(7,iel),(uvar(21+k,iel),k=1,3)
201 WRITE(iout,'(2(95X,F16.7,2X,3F16.7))' ) uvar(8,iel) ,(uvar(21+k,iel),k=4,6)
202 WRITE(iout,'(2(95X,F16.7,2X,3F16.7/))') uvar(9,iel) ,(uvar(21+k,iel),k=7,9)
203 ENDIF
204 ENDDO
205
206C-------------------------------------------------------
207
208 RETURN
209 2000 FORMAT(5x,'NUMBER',8x,'N1',8x,'N2',8x,'N3',8x,'N4',
210 . 8x,'RBODY1',4x,'RBODY2',12x,'LENGTH',13x,
211 . 'LOCAL SKEW (VECTORS)')
212
213 2100 FORMAT(5x,'NUMBER',8x,'N1',8x,'N2',8x,'N3',8x,'N4',
214 . 8x,'RBODY1',4x,'RBODY2',12x,'LENGTH',4x,'INITIAL ANGLES (RAD)',13x,
215 . 'LOCAL SKEW (VECTORS)')
216
217 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
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
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