OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
alew4.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!|| alew4 ../engine/source/ale/grid/alew4.F
25!||--- called by ------------------------------------------------------
26!|| alewdx ../engine/source/ale/grid/alewdx.F
27!||--- calls -----------------------------------------------------
28!|| spmd_exalew ../engine/source/mpi/fluid/spmd_cfd.F
29!|| spmd_exalew_pon ../engine/source/mpi/fluid/spmd_cfd.F
30!||--- uses -----------------------------------------------------
31!|| ale_mod ../common_source/modules/ale/ale_mod.F
32!||====================================================================
33 SUBROUTINE alew4(
34 1 X ,D ,V ,W ,WA ,
35 2 NALE ,IPARG ,NC ,WB ,
36 3 IAD_ELEM,FR_ELEM,FR_NBCC ,SIZEN ,ADDCNE,
37 4 PROCNE ,FSKY ,FSKYV ,IADX ,WMA ,
38 5 NIX, NIADX )
39C-----------------------------------------------
40C D e s c r i p t i o n
41C-----------------------------------------------
42C Compute Grid for /ALE/GRID/STANDARD
43C
44C X,D,V are allocated to SX,SD,DV=3*(NUMNOD_L+NUMVVOIS_L)
45C in grid subroutine it may needed to access nodes which
46C are connected to a remote elem. They are sored in X(1:3,NUMNOD+1:)
47C Consequently X is defined here X(3,SX/3) instead of X(3,NUMNOD) as usually
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE ale_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "com01_c.inc"
64#include "com04_c.inc"
65#include "com08_c.inc"
66#include "param_c.inc"
67#include "parit_c.inc"
68#include "tabsiz_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72! SPMD CASE : SX >= 3*NUMNOD (SX = 3*(NUMNOD_L+NRCVVOIS_L))
73! X(1:3,1:NUMNOD) : local nodes
74! (1:3, NUMNOD+1:) additional nodes (also on adjacent domains but connected to the boundary of the current domain)
75! idem with D(SD), and V(SV)
76C-----------------------------------------------
77 INTEGER NALE(NUMNOD), IPARG(NPARG,NGROUP), NC(NIX,*), ADDCNE(*), PROCNE(*),
78 . IAD_ELEM(2,*), FR_ELEM(*), FR_NBCC(2,*), IADX(NIADX,*) ,
79 . SIZEN, NIX, NIADX
80 my_real X(3,SX/3), D(3,SD/3), V(3,SV/3), W(3,SW/3), WA(3,*), WB(3,*),
81 . FSKY(8,LSKY), FSKYV(LSKY,8), WMA(*)
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER
86 . ICT(2,12), J1(MVSIZ), J2(MVSIZ), I , NG, NEL, NFT, ITY , MQE , ITR ,
87 . NTR , N , NNC , NCT , K , II , ICT4(2,6), ICT8(2,12) ,ICT2(2,4),
88 . ISOLNOD , KK , SIZE , LENS, LENR
89 my_real
90 . dx(mvsiz) , dy(mvsiz) , dz(mvsiz) , xx(mvsiz) , xy(mvsiz) , xz(mvsiz) ,
91 . ddx(mvsiz), ddy(mvsiz), ddz(mvsiz) , dl(mvsiz) , ddl(mvsiz),
92 . gam1 , dlf , ddlf , xm(12) ,
93 . ym(12) , zm(12) , vx(mvsiz,3),vy(mvsiz,3),vz(mvsiz,3),vv ,
94 . x13 , y13 , z13 ,x24 ,y24 ,z24 ,dt0x ,
95 . dlf0 ,wbtmp(3,sizen)
96C-----------------------------------------------
97 DATA ict8/1,2,4,3,8,7,5,6,
98 a 1,4,5,8,6,7,2,3,
99 b 1,5,2,6,3,7,4,8/
100 DATA ict4/1,3,3,6,6,1,1,5,3,5,6,5/
101 DATA ict2/1,2,4,3,1,4,2,3/
102C-----------------------------------------------
103C S o u r c e L i n e s
104C-----------------------------------------------
105 IF(ale%GRID%ALPHA < zero)THEN
106 DO i=1,numnod
107 IF(iabs(nale(i)) == 1) THEN
108 wb(1,i)=zero
109 wb(2,i)=zero
110 wb(3,i)=zero
111 ENDIF
112 ENDDO
113C
114 ale%GRID%ALPHA=-ale%GRID%ALPHA
115 ENDIF
116C
117 dt0x=dt2/(-ale%GRID%VGX+sqrt(ale%GRID%VGX**2+one))/ale%GRID%ALPHA
118 IF(tt == zero)ale%GRID%VGZ=dt0x
119 ale%GRID%VGZ=max(dt0x,(ale%GRID%VGZ+half*dt0x)/three_half)
120 IF(ale%GRID%VGY0 == zero)THEN
121 ale%GRID%VGY0=ale%GRID%VGY
122 ale%GRID%VGZ0=ale%GRID%VGZ
123 ENDIF
124 ale%GRID%VGY=ale%GRID%VGY0*ale%GRID%VGZ/ale%GRID%VGZ0
125 gam1=ale%GRID%GAMMA-one
126C
127C-----------------------------------------------
128C SPMD
129C-----------------------------------------------
130 IF (iparit /= 0) THEN
131#include "vectorize.inc"
132 DO i=1,numnod
133 IF(iabs(nale(i)) == 1) THEN
134 wa(1,i)=zero
135 wa(2,i)=zero
136 wa(3,i)=zero
137 ENDIF
138 ENDDO
139 ELSE
140
141#include "vectorize.inc"
142 DO i=1,numnod
143 IF(iabs(nale(i)) == 1) THEN
144 wa(1,i)=zero
145 wa(2,i)=zero
146 wa(3,i)=zero
147 wbtmp(1,i)=zero
148 wbtmp(2,i)=zero
149 wbtmp(3,i)=zero
150 ENDIF
151
152 ENDDO
153 ENDIF
154C
155C zeroing FSKY for Parith/ON
156C
157 IF(iparit /= 0) THEN
158 IF(ivector == 0) THEN
159 DO n=1,numnod
160 IF(iabs(nale(n)) == 1) THEN
161 nct = addcne(n)-1
162 nnc = addcne(n+1)-addcne(n)
163 DO k = nct+1, nct+nnc
164 fsky(1,k) = zero
165 fsky(2,k) = zero
166 fsky(3,k) = zero
167 fsky(4,k) = zero
168 fsky(5,k) = zero
169 fsky(6,k) = zero
170 ENDDO
171 ENDIF
172 ENDDO
173 ELSE
174 DO n=1,numnod
175 IF(iabs(nale(n)) == 1) THEN
176 nct = addcne(n)-1
177 nnc = addcne(n+1)-addcne(n)
178 DO k = nct+1, nct+nnc
179 fskyv(k,1) = zero
180 fskyv(k,2) = zero
181 fskyv(k,3) = zero
182 fskyv(k,4) = zero
183 fskyv(k,5) = zero
184 fskyv(k,6) = zero
185 ENDDO
186 ENDIF
187 ENDDO
188 ENDIF
189 ENDIF
190C
191 DO ng=1,ngroup
192 nel=iparg(2,ng)
193 nft=iparg(3,ng)
194 ity=iparg(5,ng)
195 mqe=iparg(7,ng)
196C
197 IF ((ity == 1 .OR. ity == 2) .AND. mqe == 1) THEN
198 isolnod=iparg(28,ng)
199
200c number of springs/node=3
201 IF(ity == 2)THEN
202 ntr=4
203 DO itr=1,ntr
204 ict(1,itr)=ict2(1,itr)
205 ict(2,itr)=ict2(2,itr)
206 ENDDO
207 DO i=1,nel
208 DO itr=1,ntr
209 j1(i)=nc(ict(1,itr)+1,nft+i)
210 j2(i)=nc(ict(2,itr)+1,nft+i)
211 xm(itr)=x(1,j1(i))+x(1,j2(i))
212 ym(itr)=x(2,j1(i))+x(2,j2(i))
213 zm(itr)=x(3,j1(i))+x(3,j2(i))
214 ENDDO
215 vy(i,1)= zm(2)-zm(1)
216 vz(i,1)=-(ym(2)-ym(1))
217 vv=sqrt(vy(i,1)**2+vz(i,1)**2)
218 vx(i,1)=0.
219 vy(i,1)=vy(i,1)/vv
220 vz(i,1)=vz(i,1)/vv
221 vy(i,2)= zm(4)-zm(3)
222 vz(i,2)=-(ym(4)-ym(3))
223 vv=sqrt(vy(i,2)**2+vz(i,2)**2)
224 vx(i,2)=0.
225 vy(i,2)=vy(i,2)/vv
226 vz(i,2)=vz(i,2)/vv
227 ENDDO
228 ELSEIF(isolnod == 4)THEN
229 ntr=6
230 DO itr=1,ntr
231 ict(1,itr)=ict4(1,itr)
232 ict(2,itr)=ict4(2,itr)
233 ENDDO
234 ELSE
235 ntr=12
236 DO itr=1,ntr
237 ict(1,itr)=ict8(1,itr)
238 ict(2,itr)=ict8(2,itr)
239 ENDDO
240C middle
241 DO i=1,nel
242 DO itr=1,12
243 j1(i)=nc(ict(1,itr)+1,nft+i)
244 j2(i)=nc(ict(2,itr)+1,nft+i)
245 xm(itr)=x(1,j1(i))+x(1,j2(i))
246 ym(itr)=x(2,j1(i))+x(2,j2(i))
247 zm(itr)=x(3,j1(i))+x(3,j2(i))
248 ENDDO
249 DO k=1,3
250 kk=4*(k-1)
251 x13=xm(kk+3)-xm(kk+1)
252 y13=ym(kk+3)-ym(kk+1)
253 z13=zm(kk+3)-zm(kk+1)
254 x24=xm(kk+4)-xm(kk+2)
255 y24=ym(kk+4)-ym(kk+2)
256 z24=zm(kk+4)-zm(kk+2)
257 vx(i,k)=y13*z24-z13*y24
258 vy(i,k)=z13*x24-x13*z24
259 vz(i,k)=x13*y24-y13*x24
260 vv=sqrt(vx(i,k)**2+vy(i,k)**2+vz(i,k)**2)
261 vx(i,k)=vx(i,k)/vv
262 vy(i,k)=vy(i,k)/vv
263 vz(i,k)=vz(i,k)/vv
264 ENDDO
265 ENDDO
266 ENDIF
267 DO itr=1,ntr
268 IF(ity == 1)kk=(itr+3)/4
269 IF(ity == 2)kk=(itr+1)/2
270 DO i=1,nel
271C
272 j1(i)=nc(ict(1,itr)+1,nft+i)
273 j2(i)=nc(ict(2,itr)+1,nft+i)
274C
275 ddx(i)=(w(1,j2(i))-w(1,j1(i)))*dt2
276 ddy(i)=(w(2,j2(i))-w(2,j1(i)))*dt2
277 ddz(i)=(w(3,j2(i))-w(3,j1(i)))*dt2
278 dx(i)=d(1,j2(i))-d(1,j1(i))
279 dy(i)=d(2,j2(i))-d(2,j1(i))
280 dz(i)=d(3,j2(i))-d(3,j1(i))
281 xx(i)=x(1,j2(i))-x(1,j1(i))
282 xy(i)=x(2,j2(i))-x(2,j1(i))
283 xz(i)=x(3,j2(i))-x(3,j1(i))
284C
285 ddlf=vx(i,kk)*ddx(i)+vy(i,kk)*ddy(i)+vz(i,kk)*ddz(i)
286 dlf0=abs(vx(i,kk)*xx(i)+vy(i,kk)*xy(i)+vz(i,kk)*xz(i))
287 dlf=(dlf0-ale%GRID%VGY)/ale%GRID%VGY
288 dlf=min(dlf,zero)
289 dlf0=dlf0-0.2*ale%GRID%VGY
290 dlf0=min(dlf0,zero)
291 dlf=ale%GRID%GAMMA+gam1*dlf*dlf*dlf
292 dlf=min(dlf,one)
293 dx(i)=dt2*dlf0*dlf/ale%GRID%VGZ/ale%GRID%VGZ
294 ddl(i)= ale%GRID%VGX/ale%GRID%VGZ
295 IF(ddlf > 0.)dlf=ale%GRID%GAMMA
296 dl(i) = 1. /ale%GRID%VGZ/ale%GRID%VGZ *dlf
297c DL(I)=0.
298C
299 ENDDO
300C
301C-----------------------------------------------
302C SPMD PARITH/OFF
303C-----------------------------------------------
304 IF(iparit == 0) THEN
305 DO i=1,nel
306 IF(nale(j1(i)) /= 0) THEN
307 wbtmp(1,j1(i))=wbtmp(1,j1(i))+ddx(i)*dl(i)
308 wbtmp(2,j1(i))=wbtmp(2,j1(i))+ddy(i)*dl(i)
309 wbtmp(3,j1(i))=wbtmp(3,j1(i))+ddz(i)*dl(i)
310 wa(1,j1(i))=wa(1,j1(i))+ddx(i)*ddl(i)
311 wa(2,j1(i))=wa(2,j1(i))+ddy(i)*ddl(i)
312 wa(3,j1(i))=wa(3,j1(i))+ddz(i)*ddl(i)
313 ENDIF
314C
315 IF(nale(j2(i)) /= 0) THEN
316 wbtmp(1,j2(i))=wbtmp(1,j2(i))-ddx(i)*dl(i)
317 wbtmp(2,j2(i))=wbtmp(2,j2(i))-ddy(i)*dl(i)
318 wbtmp(3,j2(i))=wbtmp(3,j2(i))-ddz(i)*dl(i)
319 wa(1,j2(i))=wa(1,j2(i))-ddx(i)*ddl(i)
320 wa(2,j2(i))=wa(2,j2(i))-ddy(i)*ddl(i)
321 wa(3,j2(i))=wa(3,j2(i))-ddz(i)*ddl(i)
322 ENDIF
323 ENDDO
324 ELSE
325C-----------------------------------------------
326C SPMD PARITH/ON
327C-----------------------------------------------
328 IF(ivector == 0) THEN
329 DO i=1,nel
330 ii = i+nft
331 IF(nale(j1(i)) /= 0) THEN
332 k = iadx(ict(1,itr),ii)
333C WB J1
334 fsky(1,k)=fsky(1,k)+dl(i)*ddx(i)
335 fsky(2,k)=fsky(2,k)+dl(i)*ddy(i)
336 fsky(3,k)=fsky(3,k)+dl(i)*ddz(i)
337C WA J1
338 fsky(4,k)=fsky(4,k)+ddl(i)*ddx(i)
339 fsky(5,k)=fsky(5,k)+ddl(i)*ddy(i)
340 fsky(6,k)=fsky(6,k)+ddl(i)*ddz(i)
341 ENDIF
342C
343 IF(nale(j2(i)) /= 0) THEN
344 k = iadx(ict(2,itr),ii)
345C WB J2
346 fsky(1,k)=fsky(1,k)-dl(i)*ddx(i)
347 fsky(2,k)=fsky(2,k)-dl(i)*ddy(i)
348 fsky(3,k)=fsky(3,k)-dl(i)*ddz(i)
349C WA J2
350 fsky(4,k)=fsky(4,k)-ddl(i)*ddx(i)
351 fsky(5,k)=fsky(5,k)-ddl(i)*ddy(i)
352 fsky(6,k)=fsky(6,k)-ddl(i)*ddz(i)
353 ENDIF
354 ENDDO
355 ELSE
356#include "vectorize.inc"
357 DO i=1,nel
358 ii = i+nft
359 IF(nale(j1(i)) /= 0) THEN
360 k = iadx(ict(1,itr),ii)
361C WB J1
362 fskyv(k,1)=fskyv(k,1)+dl(i)*ddx(i)
363 fskyv(k,2)=fskyv(k,2)+dl(i)*ddy(i)
364 fskyv(k,3)=fskyv(k,3)+dl(i)*ddz(i)
365C WA J1
366 fskyv(k,4)=fskyv(k,4)+ddl(i)*ddx(i)
367 fskyv(k,5)=fskyv(k,5)+ddl(i)*ddy(i)
368 fskyv(k,6)=fskyv(k,6)+ddl(i)*ddz(i)
369 ENDIF
370C
371 IF(nale(j2(i)) /= 0) THEN
372 k = iadx(ict(2,itr),ii)
373C WB J2
374 fskyv(k,1)=fskyv(k,1)-dl(i)*ddx(i)
375 fskyv(k,2)=fskyv(k,2)-dl(i)*ddy(i)
376 fskyv(k,3)=fskyv(k,3)-dl(i)*ddz(i)
377C WA J2
378 fskyv(k,4)=fskyv(k,4)-ddl(i)*ddx(i)
379 fskyv(k,5)=fskyv(k,5)-ddl(i)*ddy(i)
380 fskyv(k,6)=fskyv(k,6)-ddl(i)*ddz(i)
381 ENDIF
382 ENDDO
383 ENDIF
384C-----------------------------------------------
385 ENDIF
386 enddo!next ITR
387 ENDIF
388 enddo!next NG
389C
390C-----------------------------------------------
391C SPMD : CUMULATION OF WA WB
392C-----------------------------------------------
393 IF(iparit == 0)THEN
394 IF(nspmd > 1)THEN
395 SIZE = 6
396 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
397 CALL spmd_exalew(wa,wbtmp,iad_elem,fr_elem,nale,SIZE,lenr)
398 END IF
399 DO i=1,numnod
400 IF(nale(i) /= 0) THEN
401 wb(1,i)=wb(1,i)+wbtmp(1,i)
402 wb(2,i)=wb(2,i)+wbtmp(2,i)
403 wb(3,i)=wb(3,i)+wbtmp(3,i)
404 ENDIF
405 ENDDO
406 ELSE
407 IF(nspmd > 1)THEN
408 SIZE = 6
409 lens = fr_nbcc(1,nspmd+1)
410 lenr = fr_nbcc(2,nspmd+1)
411 CALL spmd_exalew_pon(
412 1 fsky ,fskyv ,iad_elem,fr_elem,nale,
413 2 addcne,procne,fr_nbcc ,SIZE ,lenr,
414 3 lens )
415 END IF
416C SPMD treatment parith/on
417 IF(ivector == 1) THEN
418 DO n=1,numnod
419 IF(nale(n) /= 0) THEN
420 nct = addcne(n)-1
421 nnc = addcne(n+1)-addcne(n)
422 DO k = nct+1, nct+nnc
423 wb(1,n) = wb(1,n) + fskyv(k,1)
424 wb(2,n) = wb(2,n) + fskyv(k,2)
425 wb(3,n) = wb(3,n) + fskyv(k,3)
426 wa(1,n) = wa(1,n) + fskyv(k,4)
427 wa(2,n) = wa(2,n) + fskyv(k,5)
428 wa(3,n) = wa(3,n) + fskyv(k,6)
429C
430 fskyv(k,1) = zero
431 fskyv(k,2) = zero
432 fskyv(k,3) = zero
433 fskyv(k,4) = zero
434 fskyv(k,5) = zero
435 fskyv(k,6) = zero
436 ENDDO
437 ENDIF
438 ENDDO
439 ELSE
440 DO n=1,numnod
441 IF(nale(n) /= 0) THEN
442 nct = addcne(n)-1
443 nnc = addcne(n+1)-addcne(n)
444 DO k = nct+1, nct+nnc
445 wb(1,n) = wb(1,n) + fsky(1,k)
446 wb(2,n) = wb(2,n) + fsky(2,k)
447 wb(3,n) = wb(3,n) + fsky(3,k)
448 wa(1,n) = wa(1,n) + fsky(4,k)
449 wa(2,n) = wa(2,n) + fsky(5,k)
450 wa(3,n) = wa(3,n) + fsky(6,k)
451C
452 fsky(1,k) = zero
453 fsky(2,k) = zero
454 fsky(3,k) = zero
455 fsky(4,k) = zero
456 fsky(5,k) = zero
457 fsky(6,k) = zero
458 ENDDO
459 ENDIF
460 ENDDO
461 ENDIF
462 ENDIF
463C-----------------------------------------------
464 DO i=1,numnod
465 IF(iabs(nale(i)) == 1)THEN
466 w(1,i)= w(1,i)+(wb(1,i)*dt2+wa(1,i))/wma(i)
467 w(2,i)= w(2,i)+(wb(2,i)*dt2+wa(2,i))/wma(i)
468 w(3,i)= w(3,i)+(wb(3,i)*dt2+wa(3,i))/wma(i)
469 ELSEIF(nale(i) == 0)THEN
470 w(1,i)=v(1,i)
471 w(2,i)=v(2,i)
472 w(3,i)=v(3,i)
473 ELSEIF(iabs(nale(i)) == 2)THEN
474 w(1,i)=zero
475 w(2,i)=zero
476 w(3,i)=zero
477 ENDIF
478 enddo!next I
479C
480 RETURN
481 END
alew4
subroutine alew4(x, d, v, w, wa, nale, iparg, nc, wb, iad_elem, fr_elem, fr_nbcc, sizen, addcne, procne, fsky, fskyv, iadx, wma, nix, niadx)
Definition alew4.F:39
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
spmd_exalew_pon
subroutine spmd_exalew_pon(fsky, fskyv, iad_elem, fr_elem, nale, addcne, procne, fr_nbcc, size, lenr, lens)
Definition spmd_cfd.F:1343
spmd_exalew
subroutine spmd_exalew(wa, wb, iad_elem, fr_elem, nale, size, lenr)
Definition spmd_cfd.F:1210