OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rlink2.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine rlink2 (ms, in, a, ar, v, vr, nsn, ic, icr, nod, skew, weight, frl6, iflag)

Function/Subroutine Documentation

◆ rlink2()

subroutine rlink2 ( ms,
in,
a,
ar,
v,
vr,
integer nsn,
integer ic,
integer icr,
integer, dimension(*) nod,
skew,
integer, dimension(*) weight,
double precision, dimension(15,6) frl6,
integer iflag )

Definition at line 31 of file rlink2.F.

34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C D u m m y A r g u m e n t s
40C-----------------------------------------------
41 INTEGER NSN, IC, ICR, IFLAG
42 INTEGER NOD(*),WEIGHT(*)
43 my_real
44 . ms(*), in(*), a(3,*), ar(3,*), v(3,*), vr(3,*), skew(*)
45 DOUBLE PRECISION FRL6(15,6)
46C-----------------------------------------------
47C L o c a l V a r i a b l e s
48C-----------------------------------------------
49 INTEGER IC1, ICC, IC2, IC3, I, N, K
50 my_real
51 . mass, iner, ax, ay, az, vx, vy, vz, dax, day, daz, aax, aay,
52 . aaz, dvx, dvy, dvz, vvx, vvy, vvz,
53 . f1(nsn), f2(nsn), f3(nsn), f4(nsn), f5(nsn), f6(nsn), f7(nsn)
54C-----------------------------------------------
55
56 iner = zero
57
58 IF(iflag == 1)THEN
59
60C Init Parith/ON
61 DO k = 1, 6
62 frl6(1,k) = zero
63 frl6(2,k) = zero
64 frl6(3,k) = zero
65 frl6(4,k) = zero
66 frl6(5,k) = zero
67 frl6(6,k) = zero
68 frl6(7,k) = zero
69 frl6(8,k) = zero
70 frl6(9,k) = zero
71 frl6(10,k) = zero
72 frl6(11,k) = zero
73 frl6(12,k) = zero
74 frl6(13,k) = zero
75 frl6(14,k) = zero
76 frl6(15,k) = zero
77 END DO
78
79 IF(ic==0)GOTO 150
80C
81c AX =ZERO
82c AY =ZERO
83c AZ =ZERO
84c VX =ZERO
85c VY =ZERO
86c VZ =ZERO
87c MASS=ZERO
88C
89 DO i=1,nsn
90 n = nod(i)
91 IF(weight(n)==1) THEN
92 f1(i)=ms(n)
93 f2(i)=ms(n)*a(1,n)
94 f3(i)=ms(n)*a(2,n)
95 f4(i)=ms(n)*a(3,n)
96 f5(i)=ms(n)*v(1,n)
97 f6(i)=ms(n)*v(2,n)
98 f7(i)=ms(n)*v(3,n)
99 ELSE
100 f1(i)=zero
101 f2(i)=zero
102 f3(i)=zero
103 f4(i)=zero
104 f5(i)=zero
105 f6(i)=zero
106 f7(i)=zero
107 ENDIF
108 ENDDO
109C
110C Traitement Parith/ON avant echange
111C
112 CALL sum_6_float(1 ,nsn ,f1, frl6(1,1), 15)
113 CALL sum_6_float(1 ,nsn ,f2, frl6(2,1), 15)
114 CALL sum_6_float(1 ,nsn ,f3, frl6(3,1), 15)
115 CALL sum_6_float(1 ,nsn ,f4, frl6(4,1), 15)
116 CALL sum_6_float(1 ,nsn ,f5, frl6(5,1), 15)
117 CALL sum_6_float(1 ,nsn ,f6, frl6(6,1), 15)
118 CALL sum_6_float(1 ,nsn ,f7, frl6(7,1), 15)
119C
120C
121 150 IF(icr==0)RETURN
122C
123c AX =ZERO
124c AY =ZERO
125c AZ =ZERO
126c VX =ZERO
127c VY =ZERO
128c VZ =ZERO
129c INER=ZERO
130C
131 DO i=1,nsn
132 n = nod(i)
133 IF(weight(n)==1) THEN
134 f1(i)=in(n)
135 f2(i)=in(n)*ar(1,n)
136 f3(i)=in(n)*ar(2,n)
137 f4(i)=in(n)*ar(3,n)
138 f5(i)=in(n)*vr(1,n)
139 f6(i)=in(n)*vr(2,n)
140 f7(i)=in(n)*vr(3,n)
141 ELSE
142 f1(i)=zero
143 f2(i)=zero
144 f3(i)=zero
145 f4(i)=zero
146 f5(i)=zero
147 f6(i)=zero
148 f7(i)=zero
149 ENDIF
150 ENDDO
151C
152C Traitement Parith/ON avant echange
153C
154 CALL sum_6_float(1 ,nsn ,f1, frl6(8,1), 15)
155 CALL sum_6_float(1 ,nsn ,f2, frl6(9,1), 15)
156 CALL sum_6_float(1 ,nsn ,f3, frl6(10,1), 15)
157 CALL sum_6_float(1 ,nsn ,f4, frl6(11,1), 15)
158 CALL sum_6_float(1 ,nsn ,f5, frl6(12,1), 15)
159 CALL sum_6_float(1 ,nsn ,f6, frl6(13,1), 15)
160 CALL sum_6_float(1 ,nsn ,f7, frl6(14,1), 15)
161C
162 ELSEIF(iflag == 2)THEN
163C
164 IF(ic==0)GOTO 250
165 ic1=ic/4
166 icc=ic-4*ic1
167 ic2=icc/2
168 ic3=icc-2*ic2
169 mass = frl6(1,1)+frl6(1,2)+frl6(1,3)+
170 + frl6(1,4)+frl6(1,5)+frl6(1,6)
171 ax = frl6(2,1)+frl6(2,2)+frl6(2,3)+
172 + frl6(2,4)+frl6(2,5)+frl6(2,6)
173 ay = frl6(3,1)+frl6(3,2)+frl6(3,3)+
174 + frl6(3,4)+frl6(3,5)+frl6(3,6)
175 az = frl6(4,1)+frl6(4,2)+frl6(4,3)+
176 + frl6(4,4)+frl6(4,5)+frl6(4,6)
177 vx = frl6(5,1)+frl6(5,2)+frl6(5,3)+
178 + frl6(5,4)+frl6(5,5)+frl6(5,6)
179 vy = frl6(6,1)+frl6(6,2)+frl6(6,3)+
180 + frl6(6,4)+frl6(6,5)+frl6(6,6)
181 vz = frl6(7,1)+frl6(7,2)+frl6(7,3)+
182 + frl6(7,4)+frl6(7,5)+frl6(7,6)
183C
184 mass=max(em20,mass)
185 ax= ax/mass
186 ay= ay/mass
187 az= az/mass
188 vx= vx/mass
189 vy= vy/mass
190 vz= vz/mass
191C
192 DO i=1,nsn
193 n = nod(i)
194 dax =a(1,n)-ax
195 day =a(2,n)-ay
196 daz =a(3,n)-az
197 aax =ic1*(skew(1)*dax+skew(2)*day+skew(3)*daz)
198 aay =ic2*(skew(4)*dax+skew(5)*day+skew(6)*daz)
199 aaz =ic3*(skew(7)*dax+skew(8)*day+skew(9)*daz)
200 a(1,n) =a(1,n)-aax*skew(1)-aay*skew(4)-aaz*skew(7)
201 a(2,n) =a(2,n)-aax*skew(2)-aay*skew(5)-aaz*skew(8)
202 a(3,n) =a(3,n)-aax*skew(3)-aay*skew(6)-aaz*skew(9)
203C
204 dvx =v(1,n)-vx
205 dvy =v(2,n)-vy
206 dvz =v(3,n)-vz
207 vvx =ic1*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
208 vvy =ic2*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
209 vvz =ic3*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
210 v(1,n) =v(1,n)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
211 v(2,n) =v(2,n)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
212 v(3,n) =v(3,n)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
213C
214 END DO
215
216 250 IF(icr==0)RETURN
217 ic1=icr/4
218 icc=icr-4*ic1
219 ic2=icc/2
220 ic3=icc-2*ic2
221
222 IF(iner==zero)RETURN
223C
224 iner = frl6(8,1)+frl6(8,2)+frl6(8,3)+
225 + frl6(8,4)+frl6(8,5)+frl6(8,6)
226 ax = frl6(9,1)+frl6(9,2)+frl6(9,3)+
227 + frl6(9,4)+frl6(9,5)+frl6(9,6)
228 ay = frl6(10,1)+frl6(10,2)+frl6(10,3)+
229 + frl6(10,4)+frl6(10,5)+frl6(10,6)
230 az = frl6(11,1)+frl6(11,2)+frl6(11,3)+
231 + frl6(11,4)+frl6(11,5)+frl6(11,6)
232 vx = frl6(12,1)+frl6(12,2)+frl6(12,3)+
233 + frl6(12,4)+frl6(12,5)+frl6(12,6)
234 vy = frl6(13,1)+frl6(13,2)+frl6(13,3)+
235 + frl6(13,4)+frl6(13,5)+frl6(13,6)
236 vz = frl6(14,1)+frl6(14,2)+frl6(14,3)+
237 + frl6(14,4)+frl6(14,5)+frl6(14,6)
238 ax=ax/iner
239 ay=ay/iner
240 az=az/iner
241 vx=vx/iner
242 vy=vy/iner
243 vz=vz/iner
244C
245 DO i=1,nsn
246 n = nod(i)
247 dax =ar(1,n)-ax
248 day =ar(2,n)-ay
249 daz =ar(3,n)-az
250 aax =ic1*(skew(1)*dax+skew(2)*day+skew(3)*daz)
251 aay =ic2*(skew(4)*dax+skew(5)*day+skew(6)*daz)
252 aaz =ic3*(skew(7)*dax+skew(8)*day+skew(9)*daz)
253 ar(1,n) =ar(1,n)-aax*skew(1)-aay*skew(4)-aaz*skew(7)
254 ar(2,n) =ar(2,n)-aax*skew(2)-aay*skew(5)-aaz*skew(8)
255 ar(3,n) =ar(3,n)-aax*skew(3)-aay*skew(6)-aaz*skew(9)
256 dvx =vr(1,n)-vx
257 dvy =vr(2,n)-vy
258 dvz =vr(3,n)-vz
259 vvx =ic1*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
260 vvy =ic2*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
261 vvz =ic3*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
262 vr(1,n) =vr(1,n)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
263 vr(2,n) =vr(2,n)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
264 vr(3,n) =vr(3,n)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
265 ENDDO
266 END IF
267C
268 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:64