OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_admesh.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!|| sms_admesh_0 ../engine/source/ams/sms_admesh.F
25!||--- called by ------------------------------------------------------
26!|| sms_mass_scale_2 ../engine/source/ams/sms_mass_scale_2.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
30!|| remesh_mod ../engine/share/modules/remesh_mod.F
31!||====================================================================
32 SUBROUTINE sms_admesh_0(A ,DIAG_SMS, IXC, IXTG,SH4TREE ,
33 . SH3TREE )
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE remesh_mod
38 USE my_alloc_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C D u m m y A r g u m e n t s
45C-----------------------------------------------
46 INTEGER IXC(NIXC,*), IXTG(NIXTG,*),
47 . sh4tree(ksh4tree,*), sh3tree(ksh3tree,*)
48C REAL
49 my_real
50 . a(3,*), diag_sms(*)
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "param_c.inc"
56#include "remesh_c.inc"
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER N, NN, LEVEL, IP, NLEV
61 INTEGER SON,M1,M2,M3,M4,MC,N1,N2,N3,N4,J,K
62 INTEGER,DIMENSION(:),ALLOCATABLE :: LKINNOD
63 my_real
64 . a1,a2,a3,a4,ac
65C-----------------------------------------------
66 CALL my_alloc(lkinnod,numnod)
67 lkinnod=0
68 DO level=levelmax-1,0,-1
69
70 DO nn=psh4kin(level)+1,psh4kin(level+1)
71 n =lsh4kin(nn)
72
73 son=sh4tree(2,n)
74
75 n1=ixc(2,n)
76 n2=ixc(3,n)
77 n3=ixc(4,n)
78 n4=ixc(5,n)
79C
80 mc=ixc(4,son)
81 ac= fourth*diag_sms(mc)
82 diag_sms(n1)=diag_sms(n1)+ac
83 diag_sms(n2)=diag_sms(n2)+ac
84 diag_sms(n3)=diag_sms(n3)+ac
85 diag_sms(n4)=diag_sms(n4)+ac
86
87 diag_sms(mc)=zero
88 lkinnod(mc)=1
89C
90 m1=ixc(3,son )
91 IF(lkinnod(m1)==0)THEN
92 lkinnod(m1)=1
93 a1=half*diag_sms(m1)
94 diag_sms(n1)=diag_sms(n1)+a1
95 diag_sms(n2)=diag_sms(n2)+a1
96 diag_sms(m1)=zero
97 END IF
98C
99 m2=ixc(4,son+1)
100 IF(lkinnod(m2)==0)THEN
101 lkinnod(m2)=1
102 a2=half*diag_sms(m2)
103 diag_sms(n2)=diag_sms(n2)+a2
104 diag_sms(n3)=diag_sms(n3)+a2
105 diag_sms(m2)=zero
106 END IF
107C
108 m3=ixc(5,son+2)
109 IF(lkinnod(m3)==0)THEN
110 lkinnod(m3)=1
111 a3=half*diag_sms(m3)
112 diag_sms(n3)=diag_sms(n3)+a3
113 diag_sms(n4)=diag_sms(n4)+a3
114 diag_sms(m3)=zero
115 END IF
116C
117 m4=ixc(2,son+3)
118 IF(lkinnod(m4)==0)THEN
119 lkinnod(m4)=1
120 a4=half*diag_sms(m4)
121 diag_sms(n1)=diag_sms(n1)+a4
122 diag_sms(n4)=diag_sms(n4)+a4
123 diag_sms(m4)=zero
124 END IF
125
126 END DO
127
128
129 DO nn=psh3kin(level)+1,psh3kin(level+1)
130 n =lsh3kin(nn)
131
132 son=sh3tree(2,n)
133
134 n1=ixtg(2,n)
135 n2=ixtg(3,n)
136 n3=ixtg(4,n)
137C
138 m1=ixtg(4,son+3)
139 IF(lkinnod(m1)==0)THEN
140 lkinnod(m1)=1
141 a1=half*diag_sms(m1)
142 diag_sms(n1)=diag_sms(n1)+a1
143 diag_sms(n2)=diag_sms(n2)+a1
144 diag_sms(m1)=zero
145 END IF
146C
147 m2=ixtg(2,son+3)
148 IF(lkinnod(m2)==0)THEN
149 lkinnod(m2)=1
150 a2=half*diag_sms(m2)
151 diag_sms(n2)=diag_sms(n2)+a2
152 diag_sms(n3)=diag_sms(n3)+a2
153 diag_sms(m2)=zero
154 END IF
155
156 m3=ixtg(3,son+3)
157 IF(lkinnod(m3)==0)THEN
158 lkinnod(m3)=1
159 a3=half*diag_sms(m3)
160 diag_sms(n3)=diag_sms(n3)+a3
161 diag_sms(n1)=diag_sms(n1)+a3
162 diag_sms(m3)=zero
163 END IF
164
165 END DO
166
167 END DO
168 DEALLOCATE(lkinnod)
169 RETURN
170 END
171!||====================================================================
172!|| sms_admesh_1 ../engine/source/ams/sms_admesh.F
173!||--- called by ------------------------------------------------------
174!|| sms_pcg ../engine/source/ams/sms_pcg.F
175!||--- calls -----------------------------------------------------
176!||--- uses -----------------------------------------------------
177!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
178!|| remesh_mod ../engine/share/modules/remesh_mod.F
179!||====================================================================
180 SUBROUTINE sms_admesh_1(A ,DIAG_SMS, IXC, IXTG,SH4TREE ,
181 . SH3TREE ,NODNX_SMS)
182C-----------------------------------------------
183C M o d u l e s
184C-----------------------------------------------
185 USE remesh_mod
186 USE my_alloc_mod
187C-----------------------------------------------
188C I m p l i c i t T y p e s
189C-----------------------------------------------
190#include "implicit_f.inc"
191C-----------------------------------------------
192C D u m m y A r g u m e n t s
193C-----------------------------------------------
194 INTEGER IXC(NIXC,*), IXTG(NIXTG,*),
195 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*), NODNX_SMS(*)
196C REAL
197 my_real
198 . a(3,*), diag_sms(*)
199C-----------------------------------------------
200C C o m m o n B l o c k s
201C-----------------------------------------------
202#include "com04_c.inc"
203#include "param_c.inc"
204#include "remesh_c.inc"
205C-----------------------------------------------
206C L o c a l V a r i a b l e s
207C-----------------------------------------------
208 INTEGER N, NN, LEVEL, IP, NLEV
209 INTEGER SON,M1,M2,M3,M4,MC,N1,N2,N3,N4,J,K
210 INTEGER,DIMENSION(:),ALLOCATABLE :: LKINNOD
211
212 my_real
213 . a1,a2,a3,a4,ac
214C-----------------------------------------------
215 CALL my_alloc(lkinnod,numnod)
216 lkinnod=0
217 DO level=levelmax-1,0,-1
218
219 DO nn=psh4kin(level)+1,psh4kin(level+1)
220 n =lsh4kin(nn)
221
222 son=sh4tree(2,n)
223
224 n1=ixc(2,n)
225 n2=ixc(3,n)
226 n3=ixc(4,n)
227 n4=ixc(5,n)
228C
229 mc=ixc(4,son)
230 DO j=1,3
231 ac= fourth*a(j,mc)
232 a(j,n1)=a(j,n1)+ac
233 a(j,n2)=a(j,n2)+ac
234 a(j,n3)=a(j,n3)+ac
235 a(j,n4)=a(j,n4)+ac
236 a(j,mc)=zero
237 END DO
238 lkinnod(mc)=1
239C
240 m1=ixc(3,son )
241 IF(lkinnod(m1)==0)THEN
242 lkinnod(m1)=1
243 DO j=1,3
244 a1=half*a(j,m1)
245 a(j,n1)=a(j,n1)+a1
246 a(j,n2)=a(j,n2)+a1
247 a(j,m1)=zero
248 END DO
249 END IF
250C
251 m2=ixc(4,son+1)
252 IF(lkinnod(m2)==0)THEN
253 lkinnod(m2)=1
254 DO j=1,3
255 a2=half*a(j,m2)
256 a(j,n2)=a(j,n2)+a2
257 a(j,n3)=a(j,n3)+a2
258 a(j,m2)=zero
259 END DO
260 END IF
261
262 m3=ixc(5,son+2)
263 IF(lkinnod(m3)==0)THEN
264 lkinnod(m3)=1
265 DO j=1,3
266 a3=half*a(j,m3)
267 a(j,n3)=a(j,n3)+a3
268 a(j,n4)=a(j,n4)+a3
269 a(j,m3)=zero
270 END DO
271 END IF
272C
273 m4=ixc(2,son+3)
274 IF(lkinnod(m4)==0)THEN
275 lkinnod(m4)=1
276 DO j=1,3
277 a4=half*a(j,m4)
278 a(j,n1)=a(j,n1)+a4
279 a(j,n4)=a(j,n4)+a4
280 a(j,m4)=zero
281 END DO
282 END IF
283
284 END DO
285
286
287 DO nn=psh3kin(level)+1,psh3kin(level+1)
288 n =lsh3kin(nn)
289
290 son=sh3tree(2,n)
291
292 n1=ixtg(2,n)
293 n2=ixtg(3,n)
294 n3=ixtg(4,n)
295C
296 m1=ixtg(4,son+3)
297 IF(lkinnod(m1)==0)THEN
298 lkinnod(m1)=1
299 DO j=1,3
300 a1=half*a(j,m1)
301 a(j,n1)=a(j,n1)+a1
302 a(j,n2)=a(j,n2)+a1
303 a(j,m1)=zero
304 END DO
305 END IF
306C
307 m2=ixtg(2,son+3)
308 IF(lkinnod(m2)==0)THEN
309 lkinnod(m2)=1
310 DO j=1,3
311 a2=half*a(j,m2)
312 a(j,n2)=a(j,n2)+a2
313 a(j,n3)=a(j,n3)+a2
314 a(j,m2)=zero
315 END DO
316 END IF
317
318 m3=ixtg(3,son+3)
319 IF(lkinnod(m3)==0)THEN
320 lkinnod(m3)=1
321 DO j=1,3
322 a3=half*a(j,m3)
323 a(j,n3)=a(j,n3)+a3
324 a(j,n1)=a(j,n1)+a3
325 a(j,m3)=zero
326 END DO
327 END IF
328
329 END DO
330
331 END DO
332 DEALLOCATE(lkinnod)
333 RETURN
334 END
335!||====================================================================
336!|| sms_admesh_2 ../engine/source/ams/sms_admesh.F
337!||--- called by ------------------------------------------------------
338!|| sms_pcg ../engine/source/ams/sms_pcg.F
339!||--- calls -----------------------------------------------------
340!|| my_barrier ../engine/source/system/machine.F
341!||--- uses -----------------------------------------------------
342!|| remesh_mod ../engine/share/modules/remesh_mod.F
343!||====================================================================
344 SUBROUTINE sms_admesh_2(A ,DIAG_SMS, IXC, IXTG,SH4TREE ,
345 . SH3TREE ,ITASK)
346C-----------------------------------------------
347C M o d u l e s
348C-----------------------------------------------
349 USE remesh_mod
350C-----------------------------------------------
351C I m p l i c i t T y p e s
352C-----------------------------------------------
353#include "implicit_f.inc"
354C-----------------------------------------------
355C D u m m y A r g u m e n t s
356C-----------------------------------------------
357 INTEGER IXC(NIXC,*), IXTG(NIXTG,*),
358 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*), ITASK
359C REAL
360 my_real
361 . a(3,*), diag_sms(*)
362C-----------------------------------------------
363C C o m m o n B l o c k s
364C-----------------------------------------------
365#include "param_c.inc"
366#include "remesh_c.inc"
367#include "task_c.inc"
368C-----------------------------------------------
369C L o c a l V a r i a b l e s
370C-----------------------------------------------
371 INTEGER N, NN, LEVEL, IP, NLEV
372 INTEGER SON,M1,M2,M3,M4,MC,N1,N2,N3,N4,J,K,NA,NB
373 INTEGER LL, SH4FT, SH4LT, SH3FT, SH3LT
374C-----------------------------------------------
375C
376C allocation tag
377 IF(itask==0)THEN
378 tagnod=0
379 END IF
380C
381 CALL my_barrier
382C
383C-------
384 DO level=0,levelmax-1
385
386 ll=psh4kin(level+1)-psh4kin(level)
387 sh4ft = psh4kin(level)+ 1+itask*ll/ nthread
388 sh4lt = psh4kin(level)+ (itask+1)*ll/nthread
389
390 DO nn=sh4ft,sh4lt
391 n =lsh4kin(nn)
392
393 son=sh4tree(2,n)
394
395 n1=ixc(2,n)
396 n2=ixc(3,n)
397 n3=ixc(4,n)
398 n4=ixc(5,n)
399C
400 mc=ixc(4,son)
401 IF(tagnod(mc)==0)THEN
402 tagnod(mc)=1
403 DO j=1,3
404 a(j,mc)= fourth*(a(j,n1)+a(j,n2)+a(j,n3)+a(j,n4))
405 END DO
406 END IF
407C
408 m1=ixc(3,son )
409 IF(tagnod(m1)==0)THEN
410 tagnod(m1)=1
411 na=min(n1,n2)
412 nb=max(n1,n2)
413 DO j=1,3
414 a(j,m1)=half*(a(j,na)+a(j,nb))
415 END DO
416 END IF
417C
418 m2=ixc(4,son+1)
419 IF(tagnod(m2)==0)THEN
420 tagnod(m2)=1
421 na=min(n2,n3)
422 nb=max(n2,n3)
423 DO j=1,3
424 a(j,m2)=half*(a(j,na)+a(j,nb))
425 END DO
426 END IF
427
428 m3=ixc(5,son+2)
429 IF(tagnod(m3)==0)THEN
430 tagnod(m3)=1
431 na=min(n3,n4)
432 nb=max(n3,n4)
433 DO j=1,3
434 a(j,m3)=half*(a(j,na)+a(j,nb))
435 END DO
436 END IF
437C
438 m4=ixc(2,son+3)
439 IF(tagnod(m4)==0)THEN
440 tagnod(m4)=1
441 na=min(n4,n1)
442 nb=max(n4,n1)
443 DO j=1,3
444 a(j,m4)=half*(a(j,na)+a(j,nb))
445 END DO
446 END IF
447
448 END DO
449
450
451 ll=psh3kin(level+1)-psh3kin(level)
452 sh3ft = psh3kin(level)+ 1+itask*ll/ nthread
453 sh3lt = psh3kin(level)+ (itask+1)*ll/nthread
454
455 DO nn=sh3ft,sh3lt
456 n =lsh3kin(nn)
457
458 son=sh3tree(2,n)
459
460 n1=ixtg(2,n)
461 n2=ixtg(3,n)
462 n3=ixtg(4,n)
463C
464 m1=ixtg(4,son+3)
465 IF(tagnod(m1)==0)THEN
466 tagnod(m1)=1
467 na=min(n1,n2)
468 nb=max(n1,n2)
469 DO j=1,3
470 a(j,m1)=half*(a(j,na)+a(j,nb))
471 END DO
472 END IF
473C
474 m2=ixtg(2,son+3)
475 IF(tagnod(m2)==0)THEN
476 tagnod(m2)=1
477 na=min(n2,n3)
478 nb=max(n2,n3)
479 DO j=1,3
480 a(j,m2)=half*(a(j,na)+a(j,nb))
481 END DO
482 END IF
483
484 m3=ixtg(3,son+3)
485 IF(tagnod(m3)==0)THEN
486 tagnod(m3)=1
487 na=min(n3,n1)
488 nb=max(n3,n1)
489 DO j=1,3
490 a(j,m3)=half*(a(j,na)+a(j,nb))
491 END DO
492 END IF
493
494 END DO
495C
496 CALL my_barrier
497C
498 END DO
499
500 RETURN
501 END
502
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
remesh_mod
Definition remesh_mod.F:50
remesh_mod::lsh4kin
integer, dimension(:), allocatable lsh4kin
Definition remesh_mod.F:62
remesh_mod::lsh3kin
integer, dimension(:), allocatable lsh3kin
Definition remesh_mod.F:62
remesh_mod::psh4kin
integer, dimension(:), allocatable psh4kin
Definition remesh_mod.F:62
remesh_mod::psh3kin
integer, dimension(:), allocatable psh3kin
Definition remesh_mod.F:62
remesh_mod::tagnod
integer, dimension(:), allocatable tagnod
Definition remesh_mod.F:77
sms_admesh_1
subroutine sms_admesh_1(a, diag_sms, ixc, ixtg, sh4tree, sh3tree, nodnx_sms)
Definition sms_admesh.F:182
sms_admesh_2
subroutine sms_admesh_2(a, diag_sms, ixc, ixtg, sh4tree, sh3tree, itask)
Definition sms_admesh.F:346
sms_admesh_0
subroutine sms_admesh_0(a, diag_sms, ixc, ixtg, sh4tree, sh3tree)
Definition sms_admesh.F:34
my_barrier
subroutine my_barrier
Definition machine.F:31