OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
rgwall.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!|| rgwall ../engine/source/constraints/general/rwall/rgwall.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 rgwall(X ,A ,V ,RWL ,NSW ,
33 2 NSN ,ITIED ,MSR ,MS ,WEIGHT,
34 3 ICONT ,RWSAV ,FRWL6 ,IMP_S ,NT_RW ,
35 4 IDDL ,IKC ,NDOF ,NODNX_SMS, WEIGHT_MD,
36 5 WFEXT ,WFEXT_MD)
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41#include "comlock.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45!#include "com06_c.inc"
46#include "com08_c.inc"
47#include "scr11_c.inc"
48#include "impl1_c.inc"
49#include "sms_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NSN, ITIED, MSR,ICONT,IMP_S,NT_RW
54 INTEGER NSW(*), WEIGHT(*),IDDL(*),IKC(*),NDOF(*), NODNX_SMS(*)
55 INTEGER WEIGHT_MD(*)
56 my_real X(*), A(*), V(*), RWL(*), MS(*), RWSAV(*)
57 DOUBLE PRECISION FRWL6(7,6)
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,NINDEX, IFQ, J, K, JJ,
62 . INDEX(NSN)
63 my_real XWL, YWL, ZWL, VXW, VYW, VZW, TFXTN, FACT,
64 . TFXT, VX, VY, VZ, UX, UY, UZ, XC, YC, ZC, DP, DV, DA, DVT,
65 . fnxn, fnyn, fnzn, fnxt, fnyt, fnzt, fndfn, ftdft, fric, fric2,
66 . fcoe,msw,fac,alpha,alphi,
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)
70 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT, WFEXT_MD
71C-----------------------------------------------
72 IF(IDTMINS==0.AND.idtmins_int==0)THEN
73C-------------
74C STANDARD CASE
75C------------
76
77 icont=0
78 CALL my_barrier
79! We need an OMP barrier here because each thread initializes
80! the variables : without barrier icont can be set to 1 by a
81! thread in the !$OMP DO loop whereas another (late) thread initializes
82! ICONT to 0
83! ICONT is a shared variable
84C
85 IF(msr == 0)THEN
86 xwl=rwl(4)
87 ywl=rwl(5)
88 zwl=rwl(6)
89 vxw=zero
90 vyw=zero
91 vzw=zero
92 ELSE
93 m3=3*msr
94 m2=m3-1
95 m1=m2-1
96C changement formulation : plus d'impasse sur contribution force
97 vxw=v(m1)+a(m1)*dt12
98 vyw=v(m2)+a(m2)*dt12
99 vzw=v(m3)+a(m3)*dt12
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 ifq = nint(rwl(15))
111 IF (ifq > 0) THEN
112!$OMP DO
113 DO i=1,nsn
114 n=nsw(i)
115 n3=3*n
116 n2=n3-1
117 n1=n2-1
118 vx=v(n1)+a(n1)*dt12
119 vy=v(n2)+a(n2)*dt12
120 vz=v(n3)+a(n3)*dt12
121 ux=x(n1)+vx*dt2
122 uy=x(n2)+vy*dt2
123 uz=x(n3)+vz*dt2
124 xc=ux-xwl
125 yc=uy-ywl
126 zc=uz-zwl
127 dp=xc*rwl(1)+yc*rwl(2)+zc*rwl(3)
128 IF(dp > zero)THEN
129 k = 3*(i-1)
130 rwsav(k+1) = zero
131 rwsav(k+2) = zero
132 rwsav(k+3) = zero
133 cycle
134 END IF
135 icont=1
136C--- test for penetrated nodes
137 IF((vx-vxw)*rwl(1)+(vy-vyw)*rwl(2)+(vz-vzw)*rwl(3) > zero)THEN
138 cycle
139 ENDIF
140 nindex = nindex+1
141 index(nindex) = i
142 END DO
143!$OMP END DO
144 ELSE
145!$OMP DO
146 DO i=1,nsn
147 n=nsw(i)
148 n3=3*n
149 n2=n3-1
150 n1=n2-1
151 vx=v(n1)+a(n1)*dt12
152 vy=v(n2)+a(n2)*dt12
153 vz=v(n3)+a(n3)*dt12
154 ux=x(n1)+vx*dt2
155 uy=x(n2)+vy*dt2
156 uz=x(n3)+vz*dt2
157 xc=ux-xwl
158 yc=uy-ywl
159 zc=uz-zwl
160 dp=xc*rwl(1)+yc*rwl(2)+zc*rwl(3)
161 IF(dp > zero) cycle
162 icont=1
163C--- test pour noeuds penetres
164 IF((vx-vxw)*rwl(1)+(vy-vyw)*rwl(2)+(vz-vzw)*rwl(3) > zero)THEN
165 cycle
166 ENDIF
167 nindex = nindex+1
168 index(nindex) = i
169 END DO
170!$OMP END DO
171 ENDIF
172 ELSE
173C-----------------
174C AMS
175C-----------------
176 icont=0
177 CALL my_barrier
178! We need an OMP barrier here because each thread initializes
179! the variables : without barrier icont can be set to 1 by a
180! thread in the !$OMP DO loop whereas a (late) thread initialize
181! ICONT to 0
182! ICONT is a shared variable
183C
184 IF(msr == 0)THEN
185 xwl=rwl(4)
186 ywl=rwl(5)
187 zwl=rwl(6)
188 vxw=zero
189 vyw=zero
190 vzw=zero
191 ELSE
192 m3=3*msr
193 m2=m3-1
194 m1=m2-1
195C changement formulation : plus d'impasse sur contribution force
196 vxw=v(m1)+a(m1)*dt12
197 vyw=v(m2)+a(m2)*dt12
198 vzw=v(m3)+a(m3)*dt12
199 xwl=x(m1)+vxw*dt2
200 ywl=x(m2)+vyw*dt2
201 zwl=x(m3)+vzw*dt2
202 ENDIF
203 tfxt =zero
204 tfxtn=zero
205 tfxt2 =zero
206 tfxtn2=zero
207 nindex=0
208C
209 ifq = nint(rwl(15))
210 IF (ifq > 0) THEN
211!$OMP DO
212 DO i=1,nsn
213 n=nsw(i)
214 IF(nodnx_sms(n)/=0)cycle
215C
216 n3=3*n
217 n2=n3-1
218 n1=n2-1
219 vx=v(n1)+a(n1)*dt12
220 vy=v(n2)+a(n2)*dt12
221 vz=v(n3)+a(n3)*dt12
222 ux=x(n1)+vx*dt2
223 uy=x(n2)+vy*dt2
224 uz=x(n3)+vz*dt2
225 xc=ux-xwl
226 yc=uy-ywl
227 zc=uz-zwl
228 dp=xc*rwl(1)+yc*rwl(2)+zc*rwl(3)
229 IF(dp > zero)THEN
230 k = 3*(i-1)
231 rwsav(k+1) = zero
232 rwsav(k+2) = zero
233 rwsav(k+3) = zero
234 cycle
235 ENDIF
236 icont=1
237C--- test pour noeuds penetres
238 IF((vx-vxw)*rwl(1)+(vy-vyw)*rwl(2)+(vz-vzw)*rwl(3) > zero)THEN
239 cycle
240 ENDIF
241 nindex = nindex+1
242 index(nindex) = i
243 END DO
244!$OMP END DO
245 ELSE
246!$OMP DO
247 DO i=1,nsn
248 n=nsw(i)
249 IF(nodnx_sms(n)/=0)cycle
250C
251 n3=3*n
252 n2=n3-1
253 n1=n2-1
254 vx=v(n1)+a(n1)*dt12
255 vy=v(n2)+a(n2)*dt12
256 vz=v(n3)+a(n3)*dt12
257 ux=x(n1)+vx*dt2
258 uy=x(n2)+vy*dt2
259 uz=x(n3)+vz*dt2
260 xc=ux-xwl
261 yc=uy-ywl
262 zc=uz-zwl
263 dp=xc*rwl(1)+yc*rwl(2)+zc*rwl(3)
264 IF(dp > zero) cycle
265 icont=1
266C--- test pour noeuds penetres
267 IF((vx-vxw)*rwl(1)+(vy-vyw)*rwl(2)+(vz-vzw)*rwl(3) > zero)THEN
268 cycle
269 ENDIF
270 nindex = nindex+1
271 index(nindex) = i
272 END DO
273!$OMP END DO
274 ENDIF
275 ENDIF
276C-----------------
277 IF(dt12 /= zero)THEN
278 fact=one/dt12
279 ELSE
280 fact = zero
281 ENDIF
282
283 IF(itied == 0)THEN
284C
285 DO j = 1,nindex
286 i = index(j)
287 n=nsw(i)
288 n3=3*n
289 n2=n3-1
290 n1=n2-1
291 dv=(v(n1)-vxw)*rwl(1)+(v(n2)-vyw)*rwl(2)+(v(n3)-vzw)*rwl(3)
292 da=a(n1)*rwl(1)+a(n2)*rwl(2)+a(n3)*rwl(3)
293 dvt=dv+da*dt12
294C
295 msw=ms(n)
296 dvt=dvt*msw
297 fnxn=dvt*rwl(1)
298 fnyn=dvt*rwl(2)
299 fnzn=dvt*rwl(3)
300 tfxtn = tfxtn - weight_md(n)*fact*((v(n1)-vxw)*fnxn+(v(n2)-vyw)*fnyn+(v(n3)-vzw)*fnzn)
301 wewe2 = (1-weight_md(n))*weight(n)
302 tfxtn2 = tfxtn2 - wewe2*fact*((v(n1)-vxw)*fnxn+(v(n2)-vyw)*fnyn+(v(n3)-vzw)*fnzn)
303 f1(j) = fnxn*weight_md(n)
304 f2(j) = fnyn*weight_md(n)
305 f3(j) = fnzn*weight_md(n)
306 f4(j) = msw*weight_md(n)
307 f5(j) = zero
308 f6(j) = zero
309 f7(j) = zero
310 a(n1)=a(n1)-da*rwl(1)
311 a(n2)=a(n2)-da*rwl(2)
312 a(n3)=a(n3)-da*rwl(3)
313 v(n1)=v(n1)-dv*rwl(1)
314 v(n2)=v(n2)-dv*rwl(2)
315 v(n3)=v(n3)-dv*rwl(3)
316 IF(imp_s == 1) v(n1) = -dv
317 ENDDO
318C
319 ELSEIF(itied == 1)THEN
320C
321 DO j = 1,nindex
322 i = index(j)
323 n=nsw(i)
324 n3=3*n
325 n2=n3-1
326 n1=n2-1
327 dv=(v(n1)-vxw)*rwl(1)+(v(n2)-vyw)*rwl(2)+(v(n3)-vzw)*rwl(3)
328 da=a(n1)*rwl(1)+a(n2)*rwl(2)+a(n3)*rwl(3)
329 dvt=dv+da*dt12
330C
331 msw=ms(n)
332 dvt=dvt*msw
333 fnxn=dvt*rwl(1)
334 fnyn=dvt*rwl(2)
335 fnzn=dvt*rwl(3)
336 tfxtn = tfxtn - weight_md(n)*fact*((v(n1)-vxw)*fnxn+(v(n2)-vyw)*fnyn+(v(n3)-vzw)*fnzn)
337 wewe2 = (1-weight_md(n))*weight(n)
338 tfxtn2 = tfxtn2 - wewe2*fact*((v(n1)-vxw)*fnxn+(v(n2)-vyw)*fnyn+(v(n3)-vzw)*fnzn)
339 f1(j) = fnxn*weight_md(n)
340 f2(j) = fnyn*weight_md(n)
341 f3(j) = fnzn*weight_md(n)
342 f4(j) = msw*weight_md(n)
343C
344 fnxt=((v(n1)-vxw)+a(n1)*dt12)*msw-fnxn
345 fnyt=((v(n2)-vyw)+a(n2)*dt12)*msw-fnyn
346 fnzt=((v(n3)-vzw)+a(n3)*dt12)*msw-fnzn
347 a(n1)=zero
348 a(n2)=zero
349 a(n3)=zero
350 v(n1)=vxw
351 v(n2)=vyw
352 v(n3)=vzw
353 f5(j) = fnxt*weight_md(n)
354 f6(j) = fnyt*weight_md(n)
355 f7(j) = fnzt*weight_md(n)
356 ENDDO
357C
358 ELSE
359C
360 IF (ifq > 0.) THEN
361C--- friction filtering
362 fric = rwl(13)
363 alpha= rwl(14)
364 IF (ifq == 3) alpha = alpha * dt12
365 alphi = one - alpha
366 fric2 = fric**2
367 DO j = 1,nindex
368 i = index(j)
369 n=nsw(i)
370 n3=3*n
371 n2=n3-1
372 n1=n2-1
373 dv=(v(n1)-vxw)*rwl(1)+(v(n2)-vyw)*rwl(2)+(v(n3)-vzw)*rwl(3)
374 da=a(n1)*rwl(1)+a(n2)*rwl(2)+a(n3)*rwl(3)
375 dvt=dv+da*dt12
376 dvt=dvt*ms(n)
377 fnxn=dvt*rwl(1)
378 fnyn=dvt*rwl(2)
379 fnzn=dvt*rwl(3)
380 tfxtn = tfxtn - weight_md(n)*fact*((v(n1)-vxw)*fnxn+(v(n2)-vyw)*fnyn+(v(n3)-vzw)*fnzn)
381 wewe2 = (1-weight_md(n))*weight(n)
382 tfxtn2 = tfxtn2 - wewe2*fact*((v(n1)-vxw)*fnxn+(v(n2)-vyw)*fnyn+(v(n3)-vzw)*fnzn)
383 f1(j) = fnxn*weight_md(n)
384 f2(j) = fnyn*weight_md(n)
385 f3(j) = fnzn*weight_md(n)
386 f4(j) = ms(n)*weight_md(n)
387 fnxt=((v(n1)-vxw)+a(n1)*dt12)*ms(n)-fnxn
388 fnyt=((v(n2)-vyw)+a(n2)*dt12)*ms(n)-fnyn
389 fnzt=((v(n3)-vzw)+a(n3)*dt12)*ms(n)-fnzn
390C--- filter
391 k = 3*(i-1)+1
392 fnxt = fnxt * alpha + rwsav(k) * alphi
393 fnyt = fnyt * alpha + rwsav(k+1) * alphi
394 fnzt = fnzt * alpha + rwsav(k+2) * alphi
395C---
396 fndfn=fnxn**2+fnyn**2+fnzn**2
397 ftdft=fnxt**2+fnyt**2+fnzt**2
398 IF (fndfn == 0) THEN
399 rwsav(k) = zero
400 rwsav(k+1) = zero
401 rwsav(k+2) = zero
402 ELSE
403 rwsav(k) = fnxt
404 rwsav(k+1) = fnyt
405 rwsav(k+2) = fnzt
406 ENDIF
407 fcoe=min(one,fric*sqrt(fndfn/max(em20,ftdft)))
408 fnxt=fcoe*fnxt
409 fnyt=fcoe*fnyt
410 fnzt=fcoe*fnzt
411 fac = dt12*ms(n)
412 IF(fac /= zero)THEN
413 fac=one/fac
414 ENDIF
415 a(n1)=a(n1)-(da*rwl(1)+fnxt*fac)
416 a(n2)=a(n2)-(da*rwl(2)+fnyt*fac)
417 a(n3)=a(n3)-(da*rwl(3)+fnzt*fac)
418 v(n1)=v(n1)-dv*rwl(1)
419 v(n2)=v(n2)-dv*rwl(2)
420 v(n3)=v(n3)-dv*rwl(3)
421 tfxt = tfxt - weight_md(n)*((v(n1)-vxw)*fnxt+(v(n2)-vyw)*fnyt+(v(n3)-vzw)*fnzt)
422 wewe2 = (1-weight_md(n))*weight(n)
423 tfxt2 = tfxt2 - wewe2*((v(n1)-vxw)*fnxt+(v(n2)-vyw)*fnyt+(v(n3)-vzw)*fnzt)
424 f5(j) = fnxt*weight_md(n)
425 f6(j) = fnyt*weight_md(n)
426 f7(j) = fnzt*weight_md(n)
427 IF(imp_s == 1) v(n1) = -dv
428 ENDDO
429 ELSE
430C--- no friction filtering
431 fric=rwl(13)
432 fric2=fric**2
433 DO j = 1,nindex
434 i = index(j)
435 n=nsw(i)
436 n3=3*n
437 n2=n3-1
438 n1=n2-1
439 dv=(v(n1)-vxw)*rwl(1)+(v(n2)-vyw)*rwl(2)+(v(n3)-vzw)*rwl(3)
440 da=a(n1)*rwl(1)+a(n2)*rwl(2)+a(n3)*rwl(3)
441 dvt=dv+da*dt12
442 dvt=dvt*ms(n)
443 fnxn=dvt*rwl(1)
444 fnyn=dvt*rwl(2)
445 fnzn=dvt*rwl(3)
446 tfxtn = tfxtn - weight_md(n)*fact*((v(n1)-vxw)*fnxn+(v(n2)-vyw)*fnyn+(v(n3)-vzw)*fnzn)
447 wewe2 = (1-weight_md(n))*weight(n)
448 fnxt=((v(n1)-vxw)+a(n1)*dt12)*ms(n)-fnxn
449 fnyt=((v(n2)-vyw)+a(n2)*dt12)*ms(n)-fnyn
450 fnzt=((v(n3)-vzw)+a(n3)*dt12)*ms(n)-fnzn
451 tfxtn2 = tfxtn2 - wewe2*((v(n1)-vxw)*fnxt+(v(n2)-vyw)*fnyt+(v(n3)-vzw)*fnzt)
452 f1(j) = fnxn*weight_md(n)
453 f2(j) = fnyn*weight_md(n)
454 f3(j) = fnzn*weight_md(n)
455 f4(j) = ms(n)*weight_md(n)
456 fndfn=fnxn**2+fnyn**2+fnzn**2
457 ftdft=fnxt**2+fnyt**2+fnzt**2
458C
459 IF(ftdft <= fric2*fndfn) THEN
460C--- tied secnd point
461 a(n1)=zero
462 a(n2)=zero
463 a(n3)=zero
464 v(n1)=vxw
465 v(n2)=vyw
466 v(n3)=vzw
467 IF (imp_s == 1) THEN
468 IF (ndof(n) > 0) THEN
469 jj=iddl(n)+1
470 IF (ikc(jj) == 0)ikc(jj)=3
471 IF (ikc(jj+1) == 0)ikc(jj+1)=3
472 IF (ikc(jj+2) == 0)ikc(jj+2)=3
473 ENDIF
474 ENDIF
475 ELSE
476C--- sliding secnd point
477 fcoe=fric*sqrt(fndfn/ftdft)
478 fnxt=fcoe*fnxt
479 fnyt=fcoe*fnyt
480 fnzt=fcoe*fnzt
481 fac=one/(dt12*ms(n))
482
483 a(n1)=a(n1)-(da*rwl(1)+fnxt*fac)
484 a(n2)=a(n2)-(da*rwl(2)+fnyt*fac)
485 a(n3)=a(n3)-(da*rwl(3)+fnzt*fac)
486 v(n1)=v(n1)-dv*rwl(1)
487 v(n2)=v(n2)-dv*rwl(2)
488 v(n3)=v(n3)-dv*rwl(3)
489 IF (imp_s == 1) THEN
490 IF (ndof(n) > 0) THEN
491 v(n1)=-dv
492 a(n1)=rwl(1)
493 a(n2)=rwl(2)
494 a(n3)=rwl(3)
495 jj=iddl(n)+1
496 IF (ikc(jj) == 0)ikc(jj)=10
497 ENDIF
498 ENDIF
499 tfxt = tfxt - weight_md(n)*((v(n1)-vxw)*fnxt+(v(n2)-vyw)*fnyt+(v(n3)-vzw)*fnzt)
500 wewe2 = (1-weight_md(n))*weight(n)
501 tfxt2 = tfxt2 - wewe2*((v(n1)-vxw)*fnxt+(v(n2)-vyw)*fnyt+(v(n3)-vzw)*fnzt)
502 ENDIF
503 f5(j) = fnxt*weight_md(n)
504 f6(j) = fnyt*weight_md(n)
505 f7(j) = fnzt*weight_md(n)
506 ENDDO
507 ENDIF
508 ENDIF
509C
510 IF(imconv == 1)THEN
511 tfxt=tfxt+half*dt1*tfxtn
512 tfxt2=tfxt2+half*dt1*tfxtn2
513!$OMP ATOMIC
514 wfext=wfext+tfxt
515 wfext_md=wfext_md+tfxt2
516C
517 DO k = 1, 6
518 frwl6_l(1,k) = zero
519 frwl6_l(2,k) = zero
520 frwl6_l(3,k) = zero
521 frwl6_l(4,k) = zero
522 frwl6_l(5,k) = zero
523 frwl6_l(6,k) = zero
524 frwl6_l(7,k) = zero
525 END DO
526 CALL sum_6_float(1, nindex, f1, frwl6_l(1,1), 7)
527 CALL sum_6_float(1, nindex, f2, frwl6_l(2,1), 7)
528 CALL sum_6_float(1, nindex, f3, frwl6_l(3,1), 7)
529 CALL sum_6_float(1, nindex, f4, frwl6_l(4,1), 7)
530 CALL sum_6_float(1, nindex, f5, frwl6_l(5,1), 7)
531 CALL sum_6_float(1, nindex, f6, frwl6_l(6,1), 7)
532 CALL sum_6_float(1, nindex, f7, frwl6_l(7,1), 7)
533
534#include "lockon.inc"
535 DO k = 1, 6
536 frwl6(1,k) = frwl6(1,k)+frwl6_l(1,k)
537 frwl6(2,k) = frwl6(2,k)+frwl6_l(2,k)
538 frwl6(3,k) = frwl6(3,k)+frwl6_l(3,k)
539 frwl6(4,k) = frwl6(4,k)+frwl6_l(4,k)
540 frwl6(5,k) = frwl6(5,k)+frwl6_l(5,k)
541 frwl6(6,k) = frwl6(6,k)+frwl6_l(6,k)
542 frwl6(7,k) = frwl6(7,k)+frwl6_l(7,k)
543 END DO
544#include "lockoff.inc"
545 ENDIF
546C
547 IF (imp_s == 1) THEN
548 IF(itied == 1)THEN
549 DO j=1,nindex
550 i = index(j)
551 n=nsw(i)
552 IF (ndof(n) > 0) THEN
553 jj=iddl(n)+1
554 IF (ikc(jj) == 0)ikc(jj)=3
555 IF (ikc(jj+1) == 0)ikc(jj+1)=3
556 IF (ikc(jj+2) == 0)ikc(jj+2)=3
557 ENDIF
558 ENDDO
559 ELSEIF(itied == 0.OR.ifq > 0)THEN
560 DO j=1,nindex
561 i = index(j)
562 n=nsw(i)
563 IF (ndof(n) > 0) THEN
564 n3=3*n
565 n2=n3-1
566 n1=n2-1
567 a(n1)=rwl(1)
568 a(n2)=rwl(2)
569 a(n3)=rwl(3)
570 jj=iddl(n)+1
571 IF (ikc(jj) == 0)ikc(jj)=10
572 ENDIF
573 ENDDO
574 ELSE
575C--------c'est fait avant-------
576 ENDIF
577 DO j=1,nindex
578 i = index(j)
579 n=nsw(i)
580 IF (ndof(n) > 0) THEN
581C to be uncommented the day it is parallel in implicit
582!$OMP ATOMIC
583 nt_rw = nt_rw + 1
584 END IF
585 ENDDO
586 ENDIF
587C
588 RETURN
589 END
the
end diagonal values have been computed in the(sparse) matrix id.SOL
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
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
rgwal0
subroutine rgwal0(x, a, v, rwbuf, lprw, nprw, ms, fsav, fr_wall, fopt, rwsav, weight, frwl6, nodnx_sms, weight_md, dimfb, fbsav6, stabsen, tabsensor, wfext, wfext_md)
Definition rgwal0.F:40
rgwall
subroutine rgwall(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, icont, rwsav, frwl6, imp_s, nt_rw, iddl, ikc, ndof, nodnx_sms, weight_md, wfext, wfext_md)
Definition rgwall.F:37
my_barrier
subroutine my_barrier
Definition machine.F:31