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

Go to the source code of this file.

Functions/Subroutines

subroutine rini33_rb (nel, nuvar, iprop, ixr, npby, lpby, rby, stifr, uvar, itab, igeo, ixr_kj, gmass)
integer function find_rby (idnod, npby, lpby)

Function/Subroutine Documentation

◆ find_rby()

integer function find_rby ( integer idnod,
integer, dimension(nnpby,*) npby,
integer, dimension(*) lpby )

Definition at line 280 of file rini33_rb.F.

281C-----------------------------------------------
282C I m p l i c i t T y p e s
283C-----------------------------------------------
284#include "implicit_f.inc"
285C-----------------------------------------------
286C A n a l y s e M o d u l e
287C-----------------------------------------------
288#include "param_c.inc"
289#include "com04_c.inc"
290C-----------------------------------------------
291C D u m m y A r g u m e n t s
292C-----------------------------------------------
293 INTEGER IDNOD,NPBY(NNPBY,*),LPBY(*)
294C-----------------------------------------------
295C L o c a l V a r i a b l e s
296C-----------------------------------------------
297 INTEGER I,N,K,NSL
298C=======================================================================
299
300 find_rby = 0
301
302 k = 0
303 DO n=1,nrbykin
304 nsl=npby(2,n)
305 DO i=1,nsl
306 IF (npby(7,n)/=0) THEN
307 IF (idnod==lpby(k+i)) THEN
308 find_rby = n
309 EXIT
310 ENDIF
311 ENDIF
312 END DO
313 k=k+nsl
314 ENDDO
315
316C-----------------------
317 RETURN
find_rby
integer function find_rby(idnod, npby, lpby)
Definition rini33_rb.F:281

◆ rini33_rb()

subroutine rini33_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 )

Definition at line 38 of file rini33_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"
60C----------------------------------------------------------
61C 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
62C----------------------------------------------------------
63 INTEGER NEL,NUVAR,IPROP,IXR(NIXR,*),NPBY(NNPBY,NRBODY),LPBY(*),
64 . ITAB(*),IXR_KJ(5,*),IGEO(NPROPGI)
65 my_real
66 . rby(nrby,nrbody),stifr(*),uvar(nuvar,*),gmass(*)
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I,II,IEL,J,K,N,L,S,NN,NSL,IERROR,NODES,USR,
71 . IDSK(2),ISK,NSK,ISK2,JTYP,M(2),NOD(2),NODF(3),
72 . RESET_U_GEO,GET_U_SKEW,SRB(6),NO(3),IDSKRB(2),
73 . IDRB(2),ERR_FLG,N1,N2,N3,N4,ID_KJ,NUMEL_KJ,IELUSR,
74 . RB1,RB2,IPID,IDSK2
75C
76 my_real
77 . mass,iner,rm,ri,knn,kr,l2,u(lskew),q(lskew),get_u_geo,v(lskew),
78 . xsk1,xsk2,len
79C
80 INTEGER ID
81 CHARACTER(LEN=NCHARTITLE)::TITR
82C-----------------------------------------------
83 INTEGER FIND_RBY
84 EXTERNAL get_u_geo,reset_u_geo,get_u_skew
85 DATA nodes/2/
86C=======================================================================
87
88 id=igeo(1)
89 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
90C
91 jtyp = nint(get_u_geo(1,iprop))
92 isk2 = nint(get_u_geo(3,iprop))
93 knn = get_u_geo(10,iprop)
94 nsk = 2
95 IF (isk2==0) nsk = 1
96 err_flg = 0
97 ipid=ixr(1,1+nft)
98C------------------check on the skews-----------------
99 DO i=1,nsk
100 idsk(i) = nint(get_u_geo(1+i,iprop))
101 isk = get_u_skew(idsk(i),no(1),no(2),no(3),u)
102 IF (isk==0) THEN
103 CALL ancmsg(msgid=926,
104 . msgtype=msgerror,
105 . anmode=aninfo,
106 . i1=id,
107 . c1=titr,
108 . i2=idsk(i))
109 err_flg = 1
110 GOTO 500
111 ENDIF
112 DO j=1,3
113 srb(j+3*(i-1)) = find_rby(no(j),npby,lpby)
114 END DO
115 IF((srb(1+3*(i-1))==(srb(2+3*(i-1)))).AND.
116 . (srb(1+3*(i-1))==(srb(3+3*(i-1))))) THEN
117 idskrb(i) = srb(1+3*(i-1))
118 ELSE
119 idskrb(i) = 0
120 IF (srb(1+3*(i-1))+srb(2+3*(i-1))+srb(3+3*(i-1))==0) THEN
121 CALL ancmsg(msgid=392,
122 . msgtype=msgwarning,
123 . anmode=aninfo_blind_2,
124 . i1=id,
125 . c1=titr,
126 . i2=idsk(i))
127 ELSE
128 CALL ancmsg(msgid=919,
129 . msgtype=msgwarning,
130 . anmode=aninfo_blind_2,
131 . i1=id,
132 . c1=titr,
133 . i2=idsk(i))
134 ENDIF
135 ENDIF
136500 CONTINUE
137 ENDDO
138 IF (err_flg==1) THEN
139 GOTO 1000
140 ENDIF
141 IF (isk2==0) THEN
142 idskrb(2) = idskrb(1)
143 ENDIF
144
145C------------------Loop on the nodes-----------------
146
147 IF(nrbody==0) THEN
148 CALL ancmsg(msgid=390,
149 . msgtype=msgwarning,
150 . anmode=aninfo_blind_2,
151 . i1=id,
152 . c1=titr)
153 ELSE
154 DO iel=1,nel
155 l2 = 0.
156 rm = 1.e30
157 ri = 1.e30
158 idrb(1)=0
159 idrb(2)=0
160C-->
161 DO i=1,nodes
162 m(i) = 0
163 k = 0
164 nod(i)=ixr(1+i,nft+iel)
165 DO n=1,nrbody
166 nsl=npby(2,n)
167 IF (npby(1,n)==nod(i)) THEN
168C-- Tag for error message - Can't be attached to main node-
169 idrb(i)=-n
170 uvar(37+i,iel)= n
171 EXIT
172 ENDIF
173C
174 DO j=1,nsl
175 nn = lpby(j+k)
176 IF(nn==nod(i)) THEN
177 idrb(i)=n
178 m(i) = npby(1,n)
179 mass = rby(14,n)
180 iner = (rby(10,n)+rby(11,n)+rby(12,n))/3.0
181C L2 = INER/MASS
182 uvar(33+i,iel)= mass
183 uvar(35+i,iel)= iner
184 uvar(37+i,iel)= n
185 IF((i==2).AND.(isk2==0)) THEN
186c--- rigid body principal frame
187 DO ii=1,9
188 u(ii)= uvar(3+ii,iel)
189 END DO
190 CALL prod_atb(rby(1,n),u,q)
191 uvar(4,iel) = q(1)
192 uvar(5,iel) = q(2)
193 uvar(6,iel) = q(3)
194 uvar(7,iel) = q(4)
195 uvar(8,iel) = q(5)
196 uvar(9,iel) = q(6)
197 uvar(10,iel)= q(7)
198 uvar(11,iel)= q(8)
199 uvar(12,iel)= q(9)
200 ENDIF
201C-->
202 GOTO 100
203 ENDIF
204 ENDDO
205100 k = k+nsl
206C
207 ENDDO
208C
209C-> Storage of a elementary mass (hormone mass) for special energy calculation
210 gmass(iel) = (uvar(34,iel)*uvar(35,iel))/max(em20,uvar(34,iel)+uvar(35,iel))
211C-->
212 IF (idrb(i)==0) THEN
213 usr = itab(nod(i))
214 CALL ancmsg(msgid=391,
215 . msgtype=msgwarning,
216 . anmode=aninfo_blind_2,
217 . i1=id,
218 . c1=titr,
219 . i2=usr)
220 ELSEIF (idrb(i) < 0) THEN
221 usr = itab(nod(i))
222 CALL ancmsg(msgid=1768,
223 . msgtype=msgerror,
224 . anmode=aninfo_blind_2,
225 . i1=id,
226 . c1=titr,
227 . i2=ixr(nixr,nft+iel),
228 . i3=usr)
229 ELSEIF ((idrb(i)/=idskrb(1)).AND.
230 . (idrb(i)/=idskrb(2))) THEN
231 usr = itab(nod(i))
232 CALL ancmsg(msgid=920,
233 . msgtype=msgwarning,
234 . anmode=aninfo_blind_2,
235 . i1=id,
236 . c1=titr,
237 . i2=usr,
238 . c2="OR",
239 . i3=idsk(1),
240 . i4=idsk(2))
241 ENDIF
242 ENDDO
243
244C---> Control consistence Noeud / Skew --------------------
245 IF((idrb(1)==idskrb(1)).AND.(idrb(2)==idskrb(2)))GOTO 350
246 IF((idrb(1)==idskrb(2)).AND.(idrb(2)==idskrb(1)))THEN
247C--> permutation skews
248 CALL ancmsg(msgid=921,
249 . msgtype=msgwarning,
250 . anmode=aninfo_blind_2,
251 . i1=id,
252 . c1=titr,
253 . i2=idsk(2),
254 . i3=idsk(1))
255 xsk1 = idsk(2)
256 xsk2 = idsk(1)
257 ierror = reset_u_geo(2,iprop,xsk1)
258 ierror = reset_u_geo(3,iprop,xsk2)
259 GOTO 350
260 ENDIF
261350 CONTINUE
262C-->
263 ENDDO
264 ENDIF
265
266C-------------------------------------------------------
267 1000 CONTINUE
268
269 RETURN
270
271 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
prod_atb
subroutine prod_atb(a, b, x)
Definition rini33.F:553
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