OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rlink2.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| rlink2 ../engine/source/constraints/general/rlink/rlink2.f
25!||--- called by ------------------------------------------------------
26!|| rlink10 ../engine/source/constraints/general/rlink/rlink10.F
27!|| rlink11 ../engine/source/constraints/general/rlink/rlink10.F
28!||--- calls -----------------------------------------------------
29!|| sum_6_float ../engine/source/system/parit.F
30!||====================================================================
31 SUBROUTINE rlink2(MS,IN,A,AR,V,
32 2 VR,NSN,IC,ICR,NOD,
33 3 SKEW,WEIGHT,FRL6,IFLAG)
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
269 END
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
rlink2
subroutine rlink2(ms, in, a, ar, v, vr, nsn, ic, icr, nod, skew, weight, frl6, iflag)
Definition rlink2.F:34