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
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"
59#include "units_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(*),ms(*),in(*)
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 DO iel=1,nel
92 l2 = 0.
93 rm = 1.e30
94 ri = 1.e30
95 idrb(1)=0
96 idrb(2)=0
97C-->
98 DO i=1,nodes
99 m(i) = 0
100 k = 0
101 nod(i)=ixr(1+i,nft+iel)
102C--> Search of connected rbody ---
103 DO n=1,nrbody
104 nsl=npby(2,n)
105 IF (npby(1,n)==nod(i)) THEN
106C-- Tag for error message - Can't be attached to main node of rbody-
107 idrb(i)=-n
108 uvar(37+i,iel)= n
109 EXIT
110 ENDIF
111C
112 DO j=1,nsl
113 nn = lpby(j+k)
114 IF(nn==nod(i)) THEN
115 idrb(i)=n
116 m(i) = npby(1,n)
117 mass = rby(14,n)
118 iner = (rby(10,n)+rby(11,n)+rby(12,n))/3.0
119C L2 = INER/MASS
120 uvar(33+i,iel)= mass
121 uvar(35+i,iel)= iner
122 uvar(37+i,iel)= n
123C-->
124 GOTO 100
125 ENDIF
126 ENDDO
127100 k = k+nsl
128 ENDDO
129C
130C--> Stockage d'une masse elementaire (masse hormonique) pour calcul d'energie specifique
131 gmass(iel) = (uvar(34,iel)*uvar(35,iel))/max(em20,uvar(34,iel)+uvar(35,iel))
132C-->
133 IF (idrb(i)==0) THEN
134C--> no rbodies found - kjoint connected to structural node ---
135 uvar(33+i,iel)= ms(nod(i))
136 uvar(35+i,iel)= in(nod(i))
137 uvar(37+i,iel)= 0
138 IF (ms(nod(i)) <= em20) THEN
139 CALL ancmsg(msgid=1773,
140 . msgtype=msgerror,
141 . anmode=aninfo_blind_2,
142 . i1=id,
143 . c1=titr,
144 . i2=ixr(nixr,nft+iel),
145 . i3=itab(nod(i)))
146 ELSEIF (in(nod(i)) <= em20) THEN
147 CALL ancmsg(msgid=1774,
148 . msgtype=msgwarning,
149 . anmode=aninfo_blind_2,
150 . i1=id,
151 . c1=titr,
152 . i2=ixr(nixr,nft+iel),
153 . i3=itab(nod(i)))
154 ENDIF
155 ELSEIF (idrb(i) < 0) THEN
156C--> kjoint connected to main node of rbody - error --
157 CALL ancmsg(msgid=1768,
158 . msgtype=msgerror,
159 . anmode=aninfo_blind_2,
160 . i1=id,
161 . c1=titr,
162 . i2=ixr(nixr,nft+iel),
163 . i3=itab(nod(i)))
164 ENDIF
165C
166 ENDDO
167C-->
168 ENDDO
169
170C---> Print de l'output pour kjoint2--------------------
171 DO iel=1,nel
172 ielusr = ixr(nixr,nft+iel)
173 rb1 = 0
174 rb2 = 0
175 IF (uvar(38,iel) > 0) rb1 = npby(6,nint(uvar(38,iel)))
176 IF (uvar(39,iel) > 0) rb2 = npby(6,nint(uvar(39,iel)))
177 n1 = itab(ixr(2,nft+iel))
178 n2 = itab(ixr(3,nft+iel))
179 n3 = 0
180 n4 = 0
181 IF (ixr(4,nft+iel)/=0) n3 = itab(ixr(4,nft+iel))
182 len=sqrt(uvar(1,iel)**2+uvar(2,iel)**2+uvar(3,iel)**2)
183 numel_kj = ixr_kj(1,numelr+1)
184 DO j=1,numel_kj
185 IF (ixr_kj(4,j)==ielusr) id_kj = j
186 END DO
187 IF (id_kj>0) THEN
188 IF (ixr_kj(1,id_kj)/=0) n4 = itab(ixr_kj(1,id_kj))
189 ENDIF
190 idsk2 = nint(get_u_geo(54,iprop))
191 IF (idsk2==0) THEN
192 WRITE(iout,2000)
193 WRITE(iout,'(1X,5I10,4X,2I10,2X,F16.7,2X,3F16.7)') ielusr,n1,
194 . n2,n3,n4,rb1,rb2,len,(uvar(21+k,iel),k=1,3)
195 WRITE(iout,'(2(95X,3F16.7/))') (uvar(21+k,iel),k=4,9)
196 ELSE
197 WRITE(iout,2100)
198 WRITE(iout,'(1X,5I10,4X,2I10,2X,F16.7,2X,F16.7,2X,3F16.7)') ielusr,n1,
199 . n2,n3,n4,rb1,rb2,len,uvar(7,iel),(uvar(21+k,iel),k=1,3)
200 WRITE(iout,'(2(95X,F16.7,2X,3F16.7))' ) uvar(8,iel) ,(uvar(21+k,iel),k=4,6)
201 WRITE(iout,'(2(95X,F16.7,2X,3F16.7/))') uvar(9,iel) ,(uvar(21+k,iel),k=7,9)
202 ENDIF
203 ENDDO
204
205C-------------------------------------------------------
206
207 RETURN
208 2000 FORMAT(5x,'NUMBER',8x,'N1',8x,'N2',8x,'N3',8x,'N4',
209 . 8x,'RBODY1',4x,'RBODY2',12x,'LENGTH',13x,
210 . 'LOCAL SKEW (VECTORS)')
211
212 2100 FORMAT(5x,'NUMBER',8x,'N1',8x,'N2',8x,'N3',8x,'N4',
213 . 8x,'RBODY1',4x,'RBODY2',12x,'LENGTH',4x,'INITIAL ANGLES (RAD)',13x,
214 . 'LOCAL SKEW (VECTORS)')
215
216 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
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