OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgwals.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!|| rgwals ../engine/source/constraints/general/rwall/rgwals.F
25!||--- called by ------------------------------------------------------
26!|| rgwal0 ../engine/source/constraints/general/rwall/rgwal0.F
27!|| rgwal0_imp ../engine/source/constraints/general/rwall/rgwal0.F
28!||--- calls -----------------------------------------------------
29!|| my_barrier ../engine/source/system/machine.F
30!|| sum_6_float ../engine/source/system/parit.F
31!||====================================================================
32 SUBROUTINE rgwals(X ,A ,V ,RWL ,NSW ,
33 1 NSN ,ITIED,MSR ,MS ,WEIGHT,
34 2 ICONT,FRWL6,IMP_S,NT_RW,IDDL ,
35 3 IKC ,NDOF ,NODNX_SMS,WEIGHT_MD,WFEXT,WFEXT_MD)
36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40#include "comlock.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com06_c.inc"
45#include "com08_c.inc"
46#include "scr11_c.inc"
47#include "impl1_c.inc"
48#include "sms_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER NSN, ITIED, MSR,ICONT,IMP_S,NT_RW
53 INTEGER NSW(*), WEIGHT(*), IDDL(*),IKC(*),NDOF(*), NODNX_SMS(*),WEIGHT_MD(*)
54 my_real X(*), A(*), V(*), RWL(*), MS(*)
55 DOUBLE PRECISION FRWL6(7,6)
56 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
57 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT_MD
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER M3, M2, M1, I, N, N3, N2, N1, J, K, JJ,NINDEX, INDEX(NSN)
62 my_real
63 . RA2, XWL, YWL, ZWL, VXW, VYW, VZW, TFXTN, FACT,
64 . tfxt, vx, vy, vz, ux, uy, uz, xc, yc, zc, dp, xx, xn,
65 . yn, zn, dv, da, dvt, fnxn, fnyn, fnzn, fnxt, fnyt, fnzt, fndfn,
66 . ftdft, fric, fric2, fcoe, xwlo, ywlo, zwlo,
67 . f1(nsn), f2(nsn), f3(nsn), f4(nsn), f5(nsn), f6(nsn), f7(nsn),
68 . tfxt2, tfxtn2, wewe2
69 DOUBLE PRECISION FRWL6_L(7,6)
70C-----------------------------------------------
71 ICONT=0
72 CALL my_barrier
73! We need an OMP barrier here because each thread initializes
74! the variables : without barrier ICONT can be set to 1 by a
75! thread in the !$OMP DO loop whereas another (late) thread initializes
76! ICONT to 0
77! ICONT is a shared variable
78 ra2=(half*rwl(7))**2
79 IF(msr==0)THEN
80 xwlo=rwl(4)
81 ywlo=rwl(5)
82 zwlo=rwl(6)
83 xwl=rwl(4)
84 ywl=rwl(5)
85 zwl=rwl(6)
86 vxw=zero
87 vyw=zero
88 vzw=zero
89 ELSE
90 m3=3*msr
91 m2=m3-1
92 m1=m2-1
93C changement formulation : plus d'impasse sur contribution force
94 vxw=v(m1)+a(m1)*dt12
95 vyw=v(m2)+a(m2)*dt12
96 vzw=v(m3)+a(m3)*dt12
97 xwlo=x(m1)
98 ywlo=x(m2)
99 zwlo=x(m3)
100 xwl=x(m1)+vxw*dt2
101 ywl=x(m2)+vyw*dt2
102 zwl=x(m3)+vzw*dt2
103 ENDIF
104 tfxt =zero
105 tfxtn=zero
106 tfxt2 =zero
107 tfxtn2=zero
108 nindex=0
109C----
110 IF(idtmins==0.AND.idtmins_int==0)THEN
111!$OMP DO
112 DO i=1,nsn
113 n=nsw(i)
114 n3=3*n
115 n2=n3-1
116 n1=n2-1
117 vx=v(n1)+a(n1)*dt12
118 vy=v(n2)+a(n2)*dt12
119 vz=v(n3)+a(n3)*dt12
120 ux=x(n1)+vx*dt2
121 uy=x(n2)+vy*dt2
122 uz=x(n3)+vz*dt2
123 xc=ux-xwl
124 yc=uy-ywl
125 zc=uz-zwl
126 dp=xc**2+yc**2+zc**2
127 IF(dp <= ra2)THEN
128 icont=1
129 nindex = nindex+1
130 index(nindex) = i
131 END IF
132 END DO
133!$OMP END DO
134 ELSE
135!$OMP DO
136 DO i=1,nsn
137 n=nsw(i)
138 IF(nodnx_sms(n)/=0)cycle
139 n3=3*n
140 n2=n3-1
141 n1=n2-1
142 vx=v(n1)+a(n1)*dt12
143 vy=v(n2)+a(n2)*dt12
144 vz=v(n3)+a(n3)*dt12
145 ux=x(n1)+vx*dt2
146 uy=x(n2)+vy*dt2
147 uz=x(n3)+vz*dt2
148 xc=ux-xwl
149 yc=uy-ywl
150 zc=uz-zwl
151 dp=xc**2+yc**2+zc**2
152 IF(dp <= ra2)THEN
153 icont=1
154 nindex = nindex+1
155 index(nindex) = i
156 END IF
157 END DO
158!$OMP END DO
159 END IF
160C----
161 fact=one/dt12
162 DO j = 1,nindex
163 i = index(j)
164 n=nsw(i)
165 n3=3*n
166 n2=n3-1
167 n1=n2-1
168 xc=x(n1)-xwlo
169 yc=x(n2)-ywlo
170 zc=x(n3)-zwlo
171 xx=sqrt(xc**2+yc**2+zc**2)
172 xn=xc/xx
173 yn=yc/xx
174 zn=zc/xx
175 dv=(v(n1)-vxw)*xn+(v(n2)-vyw)*yn+(v(n3)-vzw)*zn
176 da=a(n1)*xn+a(n2)*yn+a(n3)*zn
177 dvt=dv+da*dt12
178 fnxn=dvt*xn*ms(n)
179 fnyn=dvt*yn*ms(n)
180 fnzn=dvt*zn*ms(n)
181 tfxtn = tfxtn - weight_md(n)*fact*
182 . ((v(n1)-vxw)*fnxn+(v(n2)-vyw)*fnyn+(v(n3)-vzw)*fnzn)
183 wewe2 = (1-weight_md(n))*weight(n)
184 tfxtn2 = tfxtn2 - wewe2*fact*
185 . ((v(n1)-vxw)*fnxn+(v(n2)-vyw)*fnyn+(v(n3)-vzw)*fnzn)
186 f1(j) = fnxn*weight_md(n)
187 f2(j) = fnyn*weight_md(n)
188 f3(j) = fnzn*weight_md(n)
189 f4(j) = ms(n)*weight_md(n)
190 IF(itied/=0)THEN
191 fnxt=((v(n1)-vxw)+a(n1)*dt12)*ms(n)-fnxn
192 fnyt=((v(n2)-vyw)+a(n2)*dt12)*ms(n)-fnyn
193 fnzt=((v(n3)-vzw)+a(n3)*dt12)*ms(n)-fnzn
194 fndfn=fnxn**2+fnyn**2+fnzn**2
195 ftdft=fnxt**2+fnyt**2+fnzt**2
196 fric=rwl(13)
197 fric2=fric**2
198 IF(ftdft<=fric2*fndfn.OR.itied==1) THEN
199C POINT SECND TIED
200 a(n1)=zero
201 a(n2)=zero
202 a(n3)=zero
203 v(n1)=vxw
204 v(n2)=vyw
205 v(n3)=vzw
206 IF (imp_s==1) THEN
207 IF(ndof(n)>0) THEN
208 jj=iddl(n)+1
209 IF (ikc(jj)==0)ikc(jj)=3
210 IF (ikc(jj+1)==0)ikc(jj+1)=3
211 IF (ikc(jj+2)==0)ikc(jj+2)=3
212 ENDIF
213 ENDIF
214 ELSE
215C POINT SECND SLIDING
216 fcoe=fric*sqrt(fndfn/ftdft)
217 fnxt=fcoe*fnxt
218 fnyt=fcoe*fnyt
219 fnzt=fcoe*fnzt
220 a(n1)=a(n1)-(da*xn+fnxt/(dt12*ms(n)))
221 a(n2)=a(n2)-(da*yn+fnyt/(dt12*ms(n)))
222 a(n3)=a(n3)-(da*zn+fnzt/(dt12*ms(n)))
223 v(n1)=v(n1)-dv*xn
224 v(n2)=v(n2)-dv*yn
225 v(n3)=v(n3)-dv*zn
226 IF (imp_s==1) THEN
227 IF(ndof(n)>0) THEN
228 v(n1)=-dv
229 a(n1)=xn
230 a(n2)=yn
231 a(n3)=zn
232 jj=iddl(n)+1
233 IF (ikc(jj)==0)ikc(jj)=10
234 ENDIF
235 ENDIF
236 tfxt=tfxt-
237 . ((v(n1)-vxw)*fnxt+(v(n2)-vyw)*fnyt+(v(n3)-vzw)*fnzt)
238 . *weight_md(n)
239 wewe2 = (1-weight_md(n))*weight(n)
240 tfxt2=tfxt2-
241 . ((v(n1)-vxw)*fnxt+(v(n2)-vyw)*fnyt+(v(n3)-vzw)*fnzt)
242 . *wewe2
243 ENDIF
244 f5(j) = fnxt*weight_md(n)
245 f6(j) = fnyt*weight_md(n)
246 f7(j) = fnzt*weight_md(n)
247 ELSE
248 f5(j) = zero
249 f6(j) = zero
250 f7(j) = zero
251 a(n1)=a(n1)-da*xn
252 a(n2)=a(n2)-da*yn
253 a(n3)=a(n3)-da*zn
254 v(n1)=v(n1)-dv*xn
255 v(n2)=v(n2)-dv*yn
256 v(n3)=v(n3)-dv*zn
257 IF(imp_s==1) THEN
258 IF(ndof(n)>0) THEN
259 v(n1) = -dv
260 a(n1)=xn
261 a(n2)=yn
262 a(n3)=zn
263 jj=iddl(n)+1
264 IF (ikc(jj)==0)ikc(jj)=10
265 ENDIF
266 ENDIF
267 ENDIF
268 ENDDO
269C
270 IF(imconv==1)THEN
271 tfxt=tfxt+half*dt1*tfxtn
272 tfxt2=tfxt2+half*dt1*tfxtn2
273!$OMP ATOMIC
274 wfext=wfext+tfxt
275 wfext_md=wfext_md+tfxt2
276
277 DO k = 1, 6
278 frwl6_l(1,k) = zero
279 frwl6_l(2,k) = zero
280 frwl6_l(3,k) = zero
281 frwl6_l(4,k) = zero
282 frwl6_l(5,k) = zero
283 frwl6_l(6,k) = zero
284 frwl6_l(7,k) = zero
285 END DO
286 CALL sum_6_float(1, nindex, f1, frwl6_l(1,1), 7)
287 CALL sum_6_float(1, nindex, f2, frwl6_l(2,1), 7)
288 CALL sum_6_float(1, nindex, f3, frwl6_l(3,1), 7)
289 CALL sum_6_float(1, nindex, f4, frwl6_l(4,1), 7)
290 CALL sum_6_float(1, nindex, f5, frwl6_l(5,1), 7)
291 CALL sum_6_float(1, nindex, f6, frwl6_l(6,1), 7)
292 CALL sum_6_float(1, nindex, f7, frwl6_l(7,1), 7)
293
294#include "lockon.inc"
295 DO k = 1, 6
296 frwl6(1,k) = frwl6(1,k)+frwl6_l(1,k)
297 frwl6(2,k) = frwl6(2,k)+frwl6_l(2,k)
298 frwl6(3,k) = frwl6(3,k)+frwl6_l(3,k)
299 frwl6(4,k) = frwl6(4,k)+frwl6_l(4,k)
300 frwl6(5,k) = frwl6(5,k)+frwl6_l(5,k)
301 frwl6(6,k) = frwl6(6,k)+frwl6_l(6,k)
302 frwl6(7,k) = frwl6(7,k)+frwl6_l(7,k)
303 END DO
304#include "lockoff.inc"
305 ENDIF
306
307 IF (imp_s==1) THEN
308 DO j=1,nindex
309 i = index(j)
310 n=nsw(i)
311 IF (ndof(n)>0) THEN
312C to be uncommented the day it is parallel in implicit
313!$OMP ATOMIC
314 nt_rw = nt_rw + 1
315 END IF
316 ENDDO
317 ENDIF
318C
319 RETURN
320 END
sum_6_float
subroutine sum_6_float(jft, jlt, f, f6, n)
Definition parit.F:64
rgwals
subroutine rgwals(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, icont, frwl6, imp_s, nt_rw, iddl, ikc, ndof, nodnx_sms, weight_md, wfext, wfext_md)
Definition rgwals.F:36
my_barrier
subroutine my_barrier
Definition machine.F:31