OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
alew2.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!|| alew2 ../engine/source/ale/grid/alew2.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 alew2(
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 ,IADS )
38C-----------------------------------------------
39C D e s c r i p t i o n
40C-----------------------------------------------
41C Compute Grid for /ALE/GRID/SPRING
42C
43C X,D,V are allocated to SX,SD,DV=3*(NUMNOD_L+NUMVVOIS_L)
44C in grid subroutine it may needed to access nodes which
45C are connected to a remote elem. They are sored in X(1:3,NUMNOD+1:)
46C Consequently X is defined here X(3,SX/3) instead of X(3,NUMNOD) as usually
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE ale_mod
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C G l o b a l P a r a m e t e r s
57C-----------------------------------------------
58#include "mvsiz_p.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com01_c.inc"
63#include "com04_c.inc"
64#include "com08_c.inc"
65#include "param_c.inc"
66#include "parit_c.inc"
67#include "tabsiz_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71! SPMD CASE : SX >= 3*NUMNOD (SX = 3*(NUMNOD_L+NRCVVOIS_L))
72! X(1:3,1:NUMNOD) : local nodes
73! (1:3, NUMNOD+1:) additional nodes (also on adjacent domains but connected to the boundary of the current domain)
74! idem with D(SD), and V(SV)
75C-----------------------------------------------
76 INTEGER NALE(NUMNOD), IPARG(NPARG,NGROUP), NC(11,*), ADDCNE(*), PROCNE(*),
77 . IAD_ELEM(2,*), FR_ELEM(*), FR_NBCC(2,*), IADS(8,*),SIZEN
78 my_real X(3,SX/3), D(3,SD/3), V(3,SV/3), W(3,SW/3), WA(3,*), WB(3,*),
79 . FSKY(8,LSKY), FSKYV(LSKY,8)
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER ICT(2,28), J1(MVSIZ), J2(MVSIZ), I, NG, NEL, NFT, ITY, MQE, ITR,
84 . NTR, N, NNC, NCT, K, II, SIZE, LENR, LENS
85 my_real
86 . FAC(28),
87 . dx(mvsiz) ,dy(mvsiz) , dz(mvsiz),
88 . xx(mvsiz) ,xy(mvsiz) , xz(mvsiz),
89 . dl1(mvsiz) ,ddx(mvsiz), ddy(mvsiz), ddz(mvsiz),
90 . dl(mvsiz) ,xl(mvsiz) , ddl(mvsiz),
91 . beta, dlm, dlmin, gam1, wbtmp(3,sizen)
92C-----------------------------------------------
93 DATA fac/1.,1.,1.,1.,
94 a 1.,1.,1.,1.,
95 a 1.,1.,1.,1.,
96 d 1.,1.,1.,1.,
97 d 1.,1.,1.,1.,
98 d 1.,1.,1.,1.,
99 i 0.,0.,0.,0./
100 DATA ict/1,2,2,3,3,4,4,1,
101 a 5,6,6,7,7,8,8,5,
102 a 1,5,2,6,3,7,4,8,
103 d 1,3,2,4,5,7,6,8,
104 d 1,6,2,5,2,7,3,6,
105 d 3,8,4,7,1,8,4,5,
106 i 1,7,2,8,3,5,4,6/
107 DATA ntr/24/
108C-----------------------------------------------
109C S o u r c e L i n e s
110C-----------------------------------------------
111 dlmin = em01
112 gam1=half*(ale%GRID%GAMMA-one)
113 DO i=13,24
114 fac(i)=ale%GRID%VGY
115 ENDDO
116 beta=six*(one + two*ale%GRID%VGY)
117C-----------------------------------------------
118C SPMD code makes difference between Parith/ON & OFF
119C-----------------------------------------------
120 IF (iparit /= 0) THEN
121 DO i=1,numnod
122 IF(iabs(nale(i)) == 1) THEN
123 wa(1,i)=zero
124 wa(2,i)=zero
125 wa(3,i)=zero
126 ENDIF
127 ENDDO
128 ELSE
129C usage of WBTMP in P/OFF
130 DO i=1,numnod
131 IF(iabs(nale(i)) == 1) THEN
132 wa(1,i)=zero
133 wa(2,i)=zero
134 wa(3,i)=zero
135 wbtmp(1,i)=zero
136 wbtmp(2,i)=zero
137 wbtmp(3,i)=zero
138 ENDIF
139 ENDDO
140 ENDIF
141C
142C zeroing FSKY for Parith/ON
143C
144 IF(iparit /= 0) THEN
145 IF(ivector == 0) THEN
146 DO n=1,numnod
147 IF(iabs(nale(n)) == 1) THEN
148 nct = addcne(n)-1
149 nnc = addcne(n+1)-addcne(n)
150 DO k = nct+1, nct+nnc
151 fsky(1,k) = zero
152 fsky(2,k) = zero
153 fsky(3,k) = zero
154 fsky(4,k) = zero
155 fsky(5,k) = zero
156 fsky(6,k) = zero
157 ENDDO
158 ENDIF
159 ENDDO
160 ELSE
161 DO n=1,numnod
162 IF(iabs(nale(n)) == 1) THEN
163 nct = addcne(n)-1
164 nnc = addcne(n+1)-addcne(n)
165 DO k = nct+1, nct+nnc
166 fskyv(k,1) = zero
167 fskyv(k,2) = zero
168 fskyv(k,3) = zero
169 fskyv(k,4) = zero
170 fskyv(k,5) = zero
171 fskyv(k,6) = zero
172 ENDDO
173 ENDIF
174 ENDDO
175 ENDIF
176 ENDIF
177C
178 dlm=zero
179
180 DO ng=1,ngroup
181 nel=iparg(2,ng)
182 nft=iparg(3,ng)
183 ity=iparg(5,ng)
184 mqe=iparg(7,ng)
185
186 IF (ity == 1 .AND. mqe == 1) THEN
187 DO itr=1,ntr
188 DO i=1,nel
189 j1(i)=nc(ict(1,itr)+1,nft+i)
190 j2(i)=nc(ict(2,itr)+1,nft+i)
191 ddx(i)=(w(1,j2(i))-w(1,j1(i)))*dt2
192 ddy(i)=(w(2,j2(i))-w(2,j1(i)))*dt2
193 ddz(i)=(w(3,j2(i))-w(3,j1(i)))*dt2
194 dx(i)=d(1,j2(i))-d(1,j1(i))
195 dy(i)=d(2,j2(i))-d(2,j1(i))
196 dz(i)=d(3,j2(i))-d(3,j1(i))
197 xx(i)=x(1,j2(i))-x(1,j1(i))
198 xy(i)=x(2,j2(i))-x(2,j1(i))
199 xz(i)=x(3,j2(i))-x(3,j1(i))
200 enddo!next I
201C
202 DO i=1,nel
203 xx(i)=xx(i)-dx(i)
204 xy(i)=xy(i)-dy(i)
205 xz(i)=xz(i)-dz(i)
206 xl(i)=sqrt(xx(i)**2+xy(i)**2+xz(i)**2)
207 dl(i)=(xx(i)*dx(i)+xy(i)*dy(i)+xz(i)*dz(i))/xl(i)
208 ddl(i)=(xx(i)*ddx(i)+xy(i)*ddy(i)+xz(i)*ddz(i))/xl(i)
209 dlm=min(dlm,dl(i)/xl(i))
210 dl1(i)=ale%GRID%GAMMA+gam1*min(dl(i)/xl(i),zero)
211 dl(i) = fac(itr)/xl(i) /ale%GRID%ALPHA/ale%GRID%ALPHA *ddl(i)*dl1(i)
212 ddl(i)= fac(itr)/xl(i) * ale%GRID%VGX/ale%GRID%ALPHA*ddl(i)
213 enddo!next I
214
215 ! --- SPMD PARITH/OFF
216 IF(iparit == 0) THEN
217 DO i=1,nel
218 IF(iabs(nale(j1(i))) == 1) THEN
219 wbtmp(1,j1(i))=wbtmp(1,j1(i))+dl(i)*xx(i)
220 wbtmp(2,j1(i))=wbtmp(2,j1(i))+dl(i)*xy(i)
221 wbtmp(3,j1(i))=wbtmp(3,j1(i))+dl(i)*xz(i)
222 wa(1,j1(i))=wa(1,j1(i))+ddl(i)*xx(i)
223 wa(2,j1(i))=wa(2,j1(i))+ddl(i)*xy(i)
224 wa(3,j1(i))=wa(3,j1(i))+ddl(i)*xz(i)
225 ENDIF
226 IF(iabs(nale(j2(i))) == 1) THEN
227 wbtmp(1,j2(i))=wbtmp(1,j2(i))-dl(i)*xx(i)
228 wbtmp(2,j2(i))=wbtmp(2,j2(i))-dl(i)*xy(i)
229 wbtmp(3,j2(i))=wbtmp(3,j2(i))-dl(i)*xz(i)
230 wa(1,j2(i))=wa(1,j2(i))-ddl(i)*xx(i)
231 wa(2,j2(i))=wa(2,j2(i))-ddl(i)*xy(i)
232 wa(3,j2(i))=wa(3,j2(i))-ddl(i)*xz(i)
233 ENDIF
234 ENDDO
235 ELSE ! => IPARIT /= 0
236 ! --- SPMD PARITH/ON
237 IF(ivector == 0) THEN
238 DO i=1,nel
239 ii = i+nft
240 IF(iabs(nale(j1(i))) == 1) THEN
241 k = iads(ict(1,itr),ii)
242 ! WB J1
243 fsky(1,k)=fsky(1,k)+dl(i)*xx(i)
244 fsky(2,k)=fsky(2,k)+dl(i)*xy(i)
245 fsky(3,k)=fsky(3,k)+dl(i)*xz(i)
246 ! WA J1
247 fsky(4,k)=fsky(4,k)+ddl(i)*xx(i)
248 fsky(5,k)=fsky(5,k)+ddl(i)*xy(i)
249 fsky(6,k)=fsky(6,k)+ddl(i)*xz(i)
250 ENDIF
251 IF(iabs(nale(j2(i))) == 1) THEN
252 k = iads(ict(2,itr),ii)
253 ! WB J2
254 fsky(1,k)=fsky(1,k)-dl(i)*xx(i)
255 fsky(2,k)=fsky(2,k)-dl(i)*xy(i)
256 fsky(3,k)=fsky(3,k)-dl(i)*xz(i)
257 ! WA J2
258 fsky(4,k)=fsky(4,k)-ddl(i)*xx(i)
259 fsky(5,k)=fsky(5,k)-ddl(i)*xy(i)
260 fsky(6,k)=fsky(6,k)-ddl(i)*xz(i)
261 ENDIF
262 ENDDO
263 ELSE ! => (IVECTOR /= 0)
264#include "vectorize.inc"
265 DO i=1,nel
266 ii = i+nft
267 IF(iabs(nale(j1(i))) == 1) THEN
268 k = iads(ict(1,itr),ii)
269 ! WB J1
270 fskyv(k,1)=fskyv(k,1)+dl(i)*xx(i)
271 fskyv(k,2)=fskyv(k,2)+dl(i)*xy(i)
272 fskyv(k,3)=fskyv(k,3)+dl(i)*xz(i)
273 ! WA J1
274 fskyv(k,4)=fskyv(k,4)+ddl(i)*xx(i)
275 fskyv(k,5)=fskyv(k,5)+ddl(i)*xy(i)
276 fskyv(k,6)=fskyv(k,6)+ddl(i)*xz(i)
277 ENDIF
278 IF(iabs(nale(j2(i))) == 1) THEN
279 k = iads(ict(2,itr),ii)
280 ! WB J2
281 fskyv(k,1)=fskyv(k,1)-dl(i)*xx(i)
282 fskyv(k,2)=fskyv(k,2)-dl(i)*xy(i)
283 fskyv(k,3)=fskyv(k,3)-dl(i)*xz(i)
284 ! WA J2
285 fskyv(k,4)=fskyv(k,4)-ddl(i)*xx(i)
286 fskyv(k,5)=fskyv(k,5)-ddl(i)*xy(i)
287 fskyv(k,6)=fskyv(k,6)-ddl(i)*xz(i)
288 ENDIF
289 enddo!next I
290 ENDIF !IVECTOR
291 endif!IPARIT
292 enddo!next ITR
293 endif!IF (ITY == 1 .AND. MQE == 1)
294 enddo!next NG
295C
296 ale%GRID%VGZ=dlm
297C-----------------------------------------------
298C CODE SPMD : CUMUL WA WB
299C-----------------------------------------------
300 IF(iparit == 0)THEN
301 IF(nspmd > 1)THEN
302 SIZE = 6
303 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
304 CALL spmd_exalew(wa,wbtmp,iad_elem,fr_elem,nale,SIZE,lenr)
305 END IF
306 DO i=1,numnod
307 IF(iabs(nale(i)) == 1) THEN
308 wb(1,i)=wb(1,i)+wbtmp(1,i)
309 wb(2,i)=wb(2,i)+wbtmp(2,i)
310 wb(3,i)=wb(3,i)+wbtmp(3,i)
311 ENDIF
312 ENDDO
313 ELSE
314 IF(nspmd > 1)THEN
315 SIZE = 6
316 lens = fr_nbcc(1,nspmd+1)
317 lenr = fr_nbcc(2,nspmd+1)
318 CALL spmd_exalew_pon(
319 1 fsky ,fskyv ,iad_elem,fr_elem,nale,
320 2 addcne,procne,fr_nbcc ,SIZE ,lenr,
321 3 lens )
322 END IF
323 IF(ivector == 1) THEN
324 DO n=1,numnod
325 IF(iabs(nale(n)) == 1) THEN
326 nct = addcne(n)-1
327 nnc = addcne(n+1)-addcne(n)
328 DO k = nct+1, nct+nnc
329 wb(1,n) = wb(1,n) + fskyv(k,1)
330 wb(2,n) = wb(2,n) + fskyv(k,2)
331 wb(3,n) = wb(3,n) + fskyv(k,3)
332 wa(1,n) = wa(1,n) + fskyv(k,4)
333 wa(2,n) = wa(2,n) + fskyv(k,5)
334 wa(3,n) = wa(3,n) + fskyv(k,6)
335C
336 fskyv(k,1) = zero
337 fskyv(k,2) = zero
338 fskyv(k,3) = zero
339 fskyv(k,4) = zero
340 fskyv(k,5) = zero
341 fskyv(k,6) = zero
342 ENDDO
343 ENDIF
344 ENDDO
345 ELSE
346
347 DO n=1,numnod
348 IF(iabs(nale(n)) == 1) THEN
349 nct = addcne(n)-1
350 nnc = addcne(n+1)-addcne(n)
351 DO k = nct+1, nct+nnc
352 wb(1,n) = wb(1,n) + fsky(1,k)
353 wb(2,n) = wb(2,n) + fsky(2,k)
354 wb(3,n) = wb(3,n) + fsky(3,k)
355 wa(1,n) = wa(1,n) + fsky(4,k)
356 wa(2,n) = wa(2,n) + fsky(5,k)
357 wa(3,n) = wa(3,n) + fsky(6,k)
358C
359 fsky(1,k) = zero
360 fsky(2,k) = zero
361 fsky(3,k) = zero
362 fsky(4,k) = zero
363 fsky(5,k) = zero
364 fsky(6,k) = zero
365 ENDDO
366 ENDIF
367 ENDDO
368 ENDIF
369 ENDIF
370C-----------------------------------------------
371 DO i=1,numnod
372 IF(iabs(nale(i)) == 1)THEN
373 w(1,i)= w(1,i)+(wb(1,i)*dt2+wa(1,i))/beta
374 w(2,i)= w(2,i)+(wb(2,i)*dt2+wa(2,i))/beta
375 w(3,i)= w(3,i)+(wb(3,i)*dt2+wa(3,i))/beta
376 ELSEIF(nale(i) == 0)THEN
377 w(1,i)=v(1,i)
378 w(2,i)=v(2,i)
379 w(3,i)=v(3,i)
380 ELSEIF(iabs(nale(i)) == 2)THEN
381 w(1,i)=zero
382 w(2,i)=zero
383 w(3,i)=zero
384 ENDIF
385 enddo!next I
386C
387 RETURN
388 END
alew2
subroutine alew2(x, d, v, w, wa, nale, iparg, nc, wb, iad_elem, fr_elem, fr_nbcc, sizen, addcne, procne, fsky, fskyv, iads)
Definition alew2.F:38
min
#define min(a, b)
Definition macros.h:20
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