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 279 of file rini33_rb.F.

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

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