OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rlink0.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!|| rlink0 ../engine/source/constraints/general/rlink/rlink0.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../engine/source/input/lectur.F
27!||--- calls -----------------------------------------------------
28!|| spmd_exch_fr6 ../engine/source/mpi/kinematic_conditions/spmd_exch_fr6.F
29!|| sum_6_float ../engine/source/system/parit.F
30!||====================================================================
31 SUBROUTINE rlink0(V ,VR ,MS ,IN ,NLIK ,
32 2 IDIR ,IDROT ,NOD ,NSN ,IC ,
33 3 ICR ,ISKW ,ISK ,SKEW,ISKWN,
34 4 FR_RL,WEIGHT)
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "com01_c.inc"
43#include "com04_c.inc"
44#include "task_c.inc"
45#include "param_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER NLIK, IDIR, IDROT, NSN, IC, ICR, ISKW, ISK
50 INTEGER NOD(*), ISKWN(LISKN,*), FR_RL(*), WEIGHT(*)
51C REAL
52 my_real
53 . v(3,*), vr(3,*), ms(*), in(*), skew(*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I, IC1, ICC, IC2, IC3, N, K
58C REAL
59 my_real
60 . mass, iner, vx, vy, vz, dvx, dvy, dvz, vvx, vvy, vvz,
61 . f1(nsn), f2(nsn), f3(nsn), f4(nsn)
62 DOUBLE PRECISION FRL6(4,6)
63C-----------------------------------------------
64C
65 idir=ic
66 idrot=icr
67 nlik =nsn
68 DO 10 i=0,numskw
69 IF(isk/=iskwn(4,i+1))GOTO 10
70 iskw=i+1
71 GOTO 20
72 10 CONTINUE
73C
74 20 CONTINUE
75C
76 IF(ic==0)GOTO 150
77 ic1=ic/4
78 icc=ic-4*ic1
79 ic2=icc/2
80 ic3=icc-2*ic2
81C
82 vx =zero
83 vy =zero
84 vz =zero
85 mass=zero
86C
87 DO i=1,nsn
88 n = nod(i)
89 IF(weight(n)==1) THEN
90 f1(i)=ms(n)
91 f2(i)=ms(n)*v(1,n)
92 f3(i)=ms(n)*v(2,n)
93 f4(i)=ms(n)*v(3,n)
94 ELSE
95 f1(i)=zero
96 f2(i)=zero
97 f3(i)=zero
98 f4(i)=zero
99 ENDIF
100 ENDDO
101C
102C Traitement Parith/ON avant echange
103C
104 DO k = 1, 6
105 frl6(1,k) = zero
106 frl6(2,k) = zero
107 frl6(3,k) = zero
108 frl6(4,k) = zero
109 END DO
110 CALL sum_6_float(1 ,nsn ,f1, frl6(1,1), 4)
111 CALL sum_6_float(1 ,nsn ,f2, frl6(2,1), 4)
112 CALL sum_6_float(1 ,nsn ,f3, frl6(3,1), 4)
113 CALL sum_6_float(1 ,nsn ,f4, frl6(4,1), 4)
114 IF(nspmd>1) THEN
115 IF(fr_rl(ispmd+1)/=0) THEN
116 CALL spmd_exch_fr6(fr_rl,frl6,4*6)
117 END IF
118 END IF
119 mass = frl6(1,1)+frl6(1,2)+frl6(1,3)+
120 + frl6(1,4)+frl6(1,5)+frl6(1,6)
121 vx = frl6(2,1)+frl6(2,2)+frl6(2,3)+
122 + frl6(2,4)+frl6(2,5)+frl6(2,6)
123 vy = frl6(3,1)+frl6(3,2)+frl6(3,3)+
124 + frl6(3,4)+frl6(3,5)+frl6(3,6)
125 vz = frl6(4,1)+frl6(4,2)+frl6(4,3)+
126 + frl6(4,4)+frl6(4,5)+frl6(4,6)
127
128 IF(mass /= zero) THEN
129 vx=vx/mass
130 vy=vy/mass
131 vz=vz/mass
132 ENDIF
133C
134 DO i=1,nsn
135 n = nod(i)
136 dvx =v(1,n)-vx
137 dvy =v(2,n)-vy
138 dvz =v(3,n)-vz
139 vvx =ic1*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
140 vvy =ic2*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
141 vvz =ic3*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
142 v(1,n) =v(1,n)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
143 v(2,n) =v(2,n)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
144 v(3,n) =v(3,n)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
145 ENDDO
146C
147 150 IF(icr==0)RETURN
148 ic1=icr/4
149 icc=icr-4*ic1
150 ic2=icc/2
151 ic3=icc-2*ic2
152C
153 vx =zero
154 vy =zero
155 vz =zero
156 iner=zero
157C
158 DO i=1,nsn
159 n = nod(i)
160 IF(weight(n)==1) THEN
161 f1(i)=in(n)
162 f2(i)=in(n)*vr(1,n)
163 f3(i)=in(n)*vr(2,n)
164 f4(i)=in(n)*vr(3,n)
165 ELSE
166 f1(i)=zero
167 f2(i)=zero
168 f3(i)=zero
169 f4(i)=zero
170 ENDIF
171 ENDDO
172C
173C Traitement Parith/ON avant echange
174C
175 DO k = 1, 6
176 frl6(1,k) = zero
177 frl6(2,k) = zero
178 frl6(3,k) = zero
179 frl6(4,k) = zero
180 END DO
181 CALL sum_6_float(1 ,nsn ,f1, frl6(1,1), 4)
182 CALL sum_6_float(1 ,nsn ,f2, frl6(2,1), 4)
183 CALL sum_6_float(1 ,nsn ,f3, frl6(3,1), 4)
184 CALL sum_6_float(1 ,nsn ,f4, frl6(4,1), 4)
185 IF(nspmd>1) THEN
186 IF(fr_rl(ispmd+1)/=0) THEN
187 CALL spmd_exch_fr6(fr_rl,frl6,4*6)
188 END IF
189 END IF
190 iner = frl6(1,1)+frl6(1,2)+frl6(1,3)+
191 + frl6(1,4)+frl6(1,5)+frl6(1,6)
192 vx = frl6(2,1)+frl6(2,2)+frl6(2,3)+
193 + frl6(2,4)+frl6(2,5)+frl6(2,6)
194 vy = frl6(3,1)+frl6(3,2)+frl6(3,3)+
195 + frl6(3,4)+frl6(3,5)+frl6(3,6)
196 vz = frl6(4,1)+frl6(4,2)+frl6(4,3)+
197 + frl6(4,4)+frl6(4,5)+frl6(4,6)
198C
199 IF(iner==zero)RETURN
200C
201 vx=vx/iner
202 vy=vy/iner
203 vz=vz/iner
204C
205 DO i=1,nsn
206 n = nod(i)
207 dvx =vr(1,n)-vx
208 dvy =vr(2,n)-vy
209 dvz =vr(3,n)-vz
210 vvx =ic1*(skew(1)*dvx+skew(2)*dvy+skew(3)*dvz)
211 vvy =ic2*(skew(4)*dvx+skew(5)*dvy+skew(6)*dvz)
212 vvz =ic3*(skew(7)*dvx+skew(8)*dvy+skew(9)*dvz)
213 vr(1,n) =vr(1,n)-vvx*skew(1)-vvy*skew(4)-vvz*skew(7)
214 vr(2,n) =vr(2,n)-vvx*skew(2)-vvy*skew(5)-vvz*skew(8)
215 vr(3,n) =vr(3,n)-vvx*skew(3)-vvy*skew(6)-vvz*skew(9)
216 ENDDO
217C
218 RETURN
219 END
my_real
#define my_real
Definition cppsort.cpp:32
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:64
rlink0
subroutine rlink0(v, vr, ms, in, nlik, idir, idrot, nod, nsn, ic, icr, iskw, isk, skew, iskwn, fr_rl, weight)
Definition rlink0.F:35
spmd_exch_fr6
subroutine spmd_exch_fr6(fr, fs6, len)
Definition spmd_exch_fr6.F:51