OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admmap3.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!|| admmap3 ../engine/source/model/remesh/admmap3.F
25!||--- called by ------------------------------------------------------
26!|| admdiv ../engine/source/model/remesh/admdiv.F
27!|| admini ../engine/source/model/remesh/admini.F
28!|| admregul ../engine/source/model/remesh/admregul.f
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| element_mod ../common_source/modules/elements/element_mod.F90
32!|| remesh_mod ../engine/share/modules/remesh_mod.F
33!||====================================================================
34 SUBROUTINE admmap3(N ,IXTG ,X ,IPARG ,ELBUF_TAB,
35 . IGEO ,IPM ,SH3TREE)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE remesh_mod
40 USE elbufdef_mod
41 use element_mod , only : nixtg
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "vect01_c.inc"
50#include "com01_c.inc"
51#include "param_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER N, IXTG(NIXTG,*), IPARG(NPARG,*),
56 . igeo(npropgi,*), ipm(npropmi,*), sh3tree(ksh3tree,*)
57 my_real
58 . x(3,*)
59 TYPE(elbuf_struct_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER IB,M,N1,N2,N3,N4,IR,IS,IT,IL,NPTR,NPTS,NPTT,NLAY,
64 . i,j,k,ii,jj,i1,ng,ng1,nel1,nft1,mlw,nel,
65 . matly,nuvar,ivar,istra,iexpan,nptm,kk(8),kk1(8)
66 my_real
67 . nx,ny,nz,
68 . stot,x12,y12,z12,x13,y13,z13,s2wake(4)
69 TYPE(g_bufel_) ,POINTER :: GBUFS,GBUFT
70 TYPE(l_bufel_) ,POINTER :: LBUFS,LBUFT
71 TYPE(buf_lay_) ,POINTER :: BUFLY
72C-----------------------------------------------
73 stot=zero
74c
75 DO ib=1,4
76 m = sh3tree(2,n)+ib-1
77 n1 = ixtg(2,m)
78 n2 = ixtg(3,m)
79 n3 = ixtg(4,m)
80
81 x12 = x(1,n2) - x(1,n1)
82 y12 = x(2,n2) - x(2,n1)
83 z12 = x(3,n2) - x(3,n1)
84
85 x13 = x(1,n3) - x(1,n1)
86 y13 = x(2,n3) - x(2,n1)
87 z13 = x(3,n3) - x(3,n1)
88
89 nx = y12*z13 - z12*y13
90 ny = z12*x13 - x12*z13
91 nz = x12*y13 - y12*x13
92
93 s2wake(ib)=sqrt(nx*nx+ny*ny+nz*nz)
94 stot = stot+s2wake(ib)
95 END DO
96C-----------------------------------------------
97 ng = sh3tree(4,n)
98 mlw = iparg(1,ng)
99c
100C IF (MLW==0) GOTO 250
101C---
102 nel = iparg(2,ng)
103 nft = iparg(3,ng)
104 npt = iparg(6,ng)
105 istra= iparg(44,ng)
106 igtyp= iparg(38,ng)
107 iexpan=iparg(49,ng)
108 nptm = max(1,npt)
109 i = n-nft
110C
111 gbufs => elbuf_tab(ng)%GBUF
112 nlay = elbuf_tab(ng)%NLAY
113 nptr = elbuf_tab(ng)%NPTR
114 npts = elbuf_tab(ng)%NPTS
115 nptt = elbuf_tab(ng)%NPTT
116C
117C---- T3
118C
119 DO ib=1,3
120
121 m = sh3tree(2,n)+ib-1
122 ng1 = sh3tree(4,m)
123 nel1 = iparg(2,ng1)
124 nft1 = iparg(3,ng1)
125 i1 = m-nft1
126 gbuft => elbuf_tab(ng1)%GBUF
127!
128 DO k=1,8 ! length max of GBUF%G_STRA = 8
129 kk(k) = nel *(k-1)
130 kk1(k) = nel1*(k-1)
131 ENDDO
132!
133 gbuft%FOR(kk1(1)+i1) = gbufs%FOR(kk(1)+i)
134 gbuft%FOR(kk1(2)+i1) = gbufs%FOR(kk(2)+i)
135 gbuft%FOR(kk1(3)+i1) = gbufs%FOR(kk(3)+i)
136 gbuft%FOR(kk1(4)+i1) = gbufs%FOR(kk(4)+i)
137 gbuft%FOR(kk1(5)+i1) = gbufs%FOR(kk(5)+i)
138c
139 gbuft%MOM(kk1(1)+i1) = gbufs%MOM(kk(1)+i)
140 gbuft%MOM(kk1(2)+i1) = gbufs%MOM(kk(2)+i)
141 gbuft%MOM(kk1(3)+i1) = gbufs%MOM(kk(3)+i)
142c
143 gbuft%EINT(i1) = gbufs%EINT(i)*s2wake(ib)/stot
144 gbuft%EINT(i1+nel1) = gbufs%EINT(i+nel)*s2wake(ib)/stot
145c
146 gbuft%THK(i1) = gbufs%THK(i) !thk
147 gbuft%OFF(i1) = gbufs%OFF(i)
148c
149 IF (gbuft%G_EPSD > 0) THEN
150 gbuft%EPSD(i1) = gbufs%EPSD(i) ! eps_dot
151 ENDIF
152c
153 IF (istra > 0) THEN
154 DO k=1,8 ! deformations
155 gbuft%STRA(kk1(k)+i1) = gbufs%STRA(kk(k)+i)
156 END DO
157 END IF
158c
159 IF (iexpan /= 0) THEN
160 gbuft%TEMP(i1) = gbufs%TEMP(i)
161 END IF
162c
163C Local Stress
164c
165 DO ir=1,nptr
166 DO is=1,npts
167 DO il=1,nlay
168 DO it=1,nptt
169 lbuft => elbuf_tab(ng1)%BUFLY(il)%LBUF(ir,is,it)
170 lbufs => elbuf_tab(ng )%BUFLY(il)%LBUF(ir,is,it)
171 lbuft%SIG(kk1(1)+i1) = lbufs%SIG(kk(1)+i)
172 lbuft%SIG(kk1(2)+i1) = lbufs%SIG(kk(2)+i)
173 lbuft%SIG(kk1(3)+i1) = lbufs%SIG(kk(3)+i)
174 lbuft%SIG(kk1(4)+i1) = lbufs%SIG(kk(4)+i)
175 lbuft%SIG(kk1(5)+i1) = lbufs%SIG(kk(5)+i)
176 END DO
177 END DO
178 END DO
179 END DO
180c
181C pla
182c
183 IF (gbuft%G_PLA > 0) THEN
184 DO il=1,nlay
185 DO ir=1,nptr
186 DO is=1,npts
187 DO it=1,nptt
188 elbuf_tab(ng1)%BUFLY(il)%LBUF(ir,is,it)%PLA(i1) =
189 . elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)%PLA(i)
190 END DO
191 END DO
192 END DO
193 END DO
194 ENDIF
195c
196C Uvar
197c
198 IF (mlw>=28 .AND. mlw/=32) THEN
199 DO il=1,nlay
200 DO ir=1,nptr
201 DO is=1,npts
202 DO it=1,nptt
203 DO k=1,elbuf_tab(ng)%BUFLY(il)%NVAR_MAT
204 elbuf_tab(ng1)%BUFLY(il)%MAT(ir,is,it)%VAR(nel1*(k-1)+i1)=
205 . elbuf_tab(ng )%BUFLY(il)%MAT(ir,is,it)%VAR(nel*(k-1)+i)
206 END DO
207 END DO
208 END DO
209 END DO
210 END DO
211 END IF
212c
213C sig moyen
214! IF (NLAY > 1) THEN
215! DO K=1,NLAY
216! DO J=1,5
217! ELBUF_TAB(NG1)%BUFLY(K)%SIGPT(I1) =
218! . ELBUF_TAB(NG)%BUFLY(K)%SIGPT(I)
219! END DO
220! END DO
221! ELSE
222! II = 5*(I1-1)
223! JJ = 5*(I-1)
224! DO K=1,NPT
225! DO J=1,5
226! ELBUF_TAB(NG1)%BUFLY(1)%SIGPT(II+I1) =
227! . ELBUF_TAB(NG)%BUFLY(1)%SIGPT(JJ+I)
228! END DO
229! END DO
230! ENDIF
231
232c-----
233 END DO ! IB=1,3
234c---------------------------------------------------
235C IB=4
236c---------------------------------------------------
237 m = sh3tree(2,n)+3
238 ng1 = sh3tree(4,m)
239
240 nel1 = iparg(2,ng1)
241 nft1 = iparg(3,ng1)
242 gbuft => elbuf_tab(ng1)%GBUF
243 i1 = m-nft1
244!
245 DO k=1,8 ! length max of GBUF%G_STRA = 8
246 kk(k) = nel *(k-1)
247 kk1(k) = nel1*(k-1)
248 ENDDO
249!
250 gbuft%FOR(kk1(1)+i1) = gbufs%FOR(kk(1)+i)
251 gbuft%FOR(kk1(2)+i1) = gbufs%FOR(kk(2)+i)
252 gbuft%FOR(kk1(3)+i1) = gbufs%FOR(kk(3)+i)
253 gbuft%FOR(kk1(4)+i1) = gbufs%FOR(kk(4)+i)
254 gbuft%FOR(kk1(5)+i1) = gbufs%FOR(kk(5)+i)
255c
256 gbuft%MOM(kk1(1)+i1) = gbufs%MOM(kk(1)+i)
257 gbuft%MOM(kk1(2)+i1) = gbufs%MOM(kk(2)+i)
258 gbuft%MOM(kk1(3)+i1) = gbufs%MOM(kk(3)+i)
259c
260 gbuft%THK(i1) = gbufs%THK(i) !thk
261 gbuft%OFF(i1) = gbufs%OFF(i)
262c
263
264C ener totale approximation
265 gbuft%EINT(i1) = gbufs%EINT(i)*s2wake(ib)/stot
266 gbuft%EINT(i1+nel1) = gbufs%EINT(i+nel)*s2wake(ib)/stot
267c
268c
269 IF (gbuft%G_EPSD > 0) THEN
270 gbuft%EPSD(i1) = gbufs%EPSD(i) ! eps_dot
271 ENDIF
272c
273 IF (istra > 0) THEN
274 DO k=1,8 ! deformations
275 gbuft%STRA(kk1(k)+i1) = gbufs%STRA(kk(k)+i)
276 END DO
277 END IF
278c
279 IF (iexpan/=0) THEN
280 gbuft%TEMP(i1)=gbufs%TEMP(i)
281 END IF
282c
283C Local Stress
284c
285 IF (igtyp == 1) THEN
286 DO ir=1,nptr
287 DO is=1,npts
288 DO il=1,nlay
289 DO it=1,nptt
290 lbuft => elbuf_tab(ng1)%BUFLY(il)%LBUF(ir,is,it)
291 lbufs => elbuf_tab(ng )%BUFLY(il)%LBUF(ir,is,it)
292 lbuft%SIG(kk1(1)+i1) = lbufs%SIG(kk(1)+i)
293 lbuft%SIG(kk1(2)+i1) = lbufs%SIG(kk(2)+i)
294 lbuft%SIG(kk1(3)+i1) = lbufs%SIG(kk(3)+i)
295 lbuft%SIG(kk1(4)+i1) =-lbufs%SIG(kk(4)+i)
296 lbuft%SIG(kk1(5)+i1) =-lbufs%SIG(kk(5)+i)
297 END DO
298 END DO
299 END DO
300 END DO
301 ELSE
302 DO ir=1,nptr
303 DO is=1,npts
304 DO il=1,nlay
305 DO it=1,nptt
306 lbuft => elbuf_tab(ng1)%BUFLY(il)%LBUF(ir,is,it)
307 lbufs => elbuf_tab(ng )%BUFLY(il)%LBUF(ir,is,it)
308 lbuft%SIG(kk1(1)+i1) = lbufs%SIG(kk(1)+i)
309 lbuft%SIG(kk1(2)+i1) = lbufs%SIG(kk(2)+i)
310 lbuft%SIG(kk1(3)+i1) = lbufs%SIG(kk(3)+i)
311 lbuft%SIG(kk1(4)+i1) = lbufs%SIG(kk(4)+i)
312 lbuft%SIG(kk1(5)+i1) = lbufs%SIG(kk(5)+i)
313 END DO
314 END DO
315 END DO
316 END DO
317 END IF
318c
319C pla
320c
321 IF (gbuft%G_PLA > 0) THEN
322 DO il=1,nlay
323 DO ir=1,nptr
324 DO is=1,npts
325 DO it=1,nptt
326 elbuf_tab(ng1)%BUFLY(il)%LBUF(ir,is,it)%PLA(i1) =
327 . elbuf_tab(ng )%BUFLY(il)%LBUF(ir,is,it)%PLA(i)
328 END DO
329 END DO
330 END DO
331 END DO
332 ENDIF
333c
334C Uvar
335c
336 IF (mlw>=28 .AND. mlw/=32) THEN
337 DO il=1,nlay
338 DO ir=1,nptr
339 DO is=1,npts
340 DO it=1,nptt
341 DO k=1,elbuf_tab(ng)%BUFLY(il)%NVAR_MAT
342 elbuf_tab(ng1)%BUFLY(il)%MAT(ir,is,it)%VAR(nel1*(k-1)+i1)=
343 . elbuf_tab(ng )%BUFLY(il)%MAT(ir,is,it)%VAR(nel*(k-1)+i)
344 END DO
345 END DO
346 END DO
347 END DO
348 END DO
349 END IF
350
351c
352C sig moyen
353! IF (NLAY > 1) THEN
354! DO il=1,nlay
355! BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
356! DO K=1,5
357! BUFLY%SIGPT(I1+K) = BUFLY%SIGPT(I+K)
358! END DO
359! END DO
360! ELSE
361! BUFLY => ELBUF_TAB(NG)%BUFLY(1)
362! II = 5*(I1-1)
363! JJ = 5*(I-1)
364! DO IT=1,NPT
365! II = (IT-1)*NEL*5
366! JJ = (IT-1)*NEL1*5
367! DO K=1,5
368! BUFLY%SIGPT(II+K) = BUFLY%SIGPT(JJ+K)
369! END DO
370! END DO
371! ENDIF
372c---------------------------------------------
373C Reset Source Variable elements
374c---------------------------------------------
375 gbufs%OFF(i) =-abs(gbufs%OFF(i))
376!
377 gbufs%FOR(kk(1)+i) = zero
378 gbufs%FOR(kk(2)+i) = zero
379 gbufs%FOR(kk(3)+i) = zero
380 gbufs%FOR(kk(4)+i) = zero
381 gbufs%FOR(kk(5)+i) = zero
382!
383 gbufs%MOM(kk(1)+i) = zero
384 gbufs%MOM(kk(2)+i) = zero
385 gbufs%MOM(kk(3)+i) = zero
386 gbufs%EINT(i) = zero
387 gbufs%EINT(i+nel) = zero
388 IF (gbufs%G_EPSD > 0) gbufs%EPSD(i) = zero
389 IF (istra > 0) THEN ! deformations
390 DO k=1,8
391 gbufs%STRA(kk(k)+i) = zero
392 END DO
393 END IF
394c
395 DO ir=1,nptr
396 DO is=1,npts
397 DO il=1,nlay
398 DO it=1,nptt
399 DO k=1,5
400 elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)%SIG(kk(k)+i)=zero
401 ENDDO
402 elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)%PLA(i)=zero
403 END DO
404 END DO
405 END DO
406 END DO
407c
408C sig moyen
409C IF (NLAY > 1) THEN
410C DO K=1,NLAY
411C BUFLY => ELBUF_TAB(NG)%BUFLY(K)
412C DO J=1,5
413C BUFLY%SIGPT(J)=ZERO
414C END DO
415C END DO
416C ELSE
417C BUFLY => ELBUF_TAB(NG)%BUFLY(1)
418C DO K=1,NPT
419C II = (K-1)*NEL*5
420C DO J=1,5
421C BUFLY%SIGPT(II+J)=ZERO
422C END DO
423C END DO
424C ENDIF
425C-----------
426 RETURN
427 END
428
admmap3
subroutine admmap3(n, ixtg, x, iparg, elbuf_tab, igeo, ipm, sh3tree)
Definition admmap3.F:36
admregul
subroutine admregul(ixc, ipartc, ixtg, iparttg, ipart, itask, iparg, x, ms, in, elbuf_tab, nodft, nodlt, igeo, ipm, sh4tree, msc, inc, sh3tree, mstg, intg, ptg, mscnd, incnd, pm, mcp, mcpc, mcptg, itherm_fe)
Definition admregul.F:45
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
remesh_mod
Definition remesh_mod.F:50