OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admmap4.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!|| admmap4 ../engine/source/model/remesh/admmap4.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!|| remesh_mod ../engine/share/modules/remesh_mod.F
32!||====================================================================
33 SUBROUTINE admmap4(N ,IXC ,X ,IPARG ,ELBUF_TAB,
34 . IGEO ,IPM ,SH4TREE)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE remesh_mod
39 USE elbufdef_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "vect01_c.inc"
48#include "com01_c.inc"
49#include "param_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER N, IXC(NIXC,*), IPARG(NPARG,*),
54 . igeo(npropgi,*), ipm(npropmi,*), sh4tree(ksh4tree,*)
55 my_real
56 . x(3,*)
57 TYPE(elbuf_struct_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER IB,M,N1,N2,N3,N4,IR,IS,IT,IL,IPT,NPTR,NPTS,NPTT,NLAY,
62 . i,j,k,ii,jj,i1,ig,ng,ng1,nel1,nft1,mlw,nel,istra,
63 . iexpan,ih,lens,lenm,lenf,nptm,
64 . ptf,ptm,pte,ptp,pts,qtf,qtm,qte,qtp,qts,kk(12),kk1(12)
65 my_real
66 . nx,ny,nz,stot,x13,y13,z13,x24,y24,z24,zz
67 my_real
68 . qpg(2,4),s2wake(4),sk(2),st(2),mk(2),mt(2),
69 . shk(2),sht(2),z01(11,11)
70 TYPE(g_bufel_) ,POINTER :: GBUFS,GBUFT
71 TYPE(l_bufel_) ,POINTER :: LBUFS,LBUFT
72 TYPE(buf_lay_) ,POINTER :: BUFLY
73C---------------------------
74 DATA qpg/-0.5,-0.5,
75 . 0.5,-0.5,
76 . 0.5, 0.5,
77 . -0.5, 0.5/
78 DATA z01/
79 1 0. ,0. ,0. ,0. ,0. ,
80 1 0. ,0. ,0. ,0. ,0. ,0. ,
81 2 -.5 ,0.5 ,0. ,0. ,0. ,
82 2 0. ,0. ,0. ,0. ,0. ,0. ,
83 3 -.5 ,0. ,0.5 ,0. ,0. ,
84 3 0. ,0. ,0. ,0. ,0. ,0. ,
85 4 -.5 ,-.1666667,0.1666667,0.5 ,0. ,
86 4 0. ,0. ,0. ,0. ,0. ,0. ,
87 5 -.5 ,-.25 ,0. ,0.25 ,0.5 ,
88 5 0. ,0. ,0. ,0. ,0. ,0. ,
89 6 -.5 ,-.3 ,-.1 ,0.1 ,0.3 ,
90 6 0.5 ,0. ,0. ,0. ,0. ,0. ,
91 7 -.5 ,-.3333333,-.1666667,0.0 ,0.1666667,
92 7 0.3333333,0.5 ,0. ,0. ,0. ,0. ,
93 8 -.5 ,-.3571429,-.2142857,-.0714286,0.0714286,
94 8 0.2142857,0.3571429,0.5 ,0. ,0. ,0. ,
95 9 -.5 ,-.375 ,-.25 ,-.125 ,0.0 ,
96 9 0.125 ,0.25 ,0.375 ,0.5 ,0. ,0. ,
97 a -.5 ,-.3888889,-.2777778,-.1666667,0.0555555,
98 a 0.0555555,0.1666667,0.2777778,0.3888889,0.5 ,0. ,
99 b -.5 ,-.4 ,-.3 ,-.2 ,-.1 ,
100 b 0. ,0.1 ,0.2 ,0.3 ,0.4 ,0.5 /
101C-----------------------------------------------
102 stot=zero
103 DO ib=1,4
104
105 m = sh4tree(2,n)+ib-1
106 n1 = ixc(2,m)
107 n2 = ixc(3,m)
108 n3 = ixc(4,m)
109 n4 = ixc(5,m)
110
111 x13 = x(1,n3) - x(1,n1)
112 y13 = x(2,n3) - x(2,n1)
113 z13 = x(3,n3) - x(3,n1)
114
115 x24 = x(1,n4) - x(1,n2)
116 y24 = x(2,n4) - x(2,n2)
117 z24 = x(3,n4) - x(3,n2)
118
119 nx = y13*z24 - z13*y24
120 ny = z13*x24 - x13*z24
121 nz = x13*y24 - y13*x24
122
123 s2wake(ib)=sqrt(nx*nx+ny*ny+nz*nz)
124 stot=stot+s2wake(ib)
125
126 END DO
127C-----------------------------------------------
128 ng =sh4tree(4,n)
129 mlw = iparg(1,ng)
130C IF (MLW == 0) GOTO 250
131C---
132 nel = iparg(2,ng)
133 nft = iparg(3,ng)
134 npt = iparg(6,ng)
135 istra= iparg(44,ng)
136 jhbe = iparg(23,ng)
137 igtyp= iparg(38,ng)
138 iexpan=iparg(49,ng)
139 i = n-nft
140
141 nptm = max(1,npt)
142 gbufs => elbuf_tab(ng)%GBUF
143 nlay = elbuf_tab(ng)%NLAY
144 nptr = elbuf_tab(ng)%NPTR
145 npts = elbuf_tab(ng)%NPTS
146 nptt = elbuf_tab(ng)%NPTT
147!
148 DO k=1,12 ! length max of GBUF%G_HOURG = 12
149 kk(k) = nel *(k-1)
150 ENDDO
151!
152c----------------------------------------------
153 DO ib=1,4
154
155 m = sh4tree(2,n)+ib-1
156 ng1= sh4tree(4,m)
157
158 nel1 = iparg(2,ng1)
159 nft1 = iparg(3,ng1)
160 i1 = m-nft1
161 gbuft => elbuf_tab(ng1)%GBUF
162!
163 DO k=1,12 ! length max of GBUF%G_HOURG = 12
164 kk1(k) = nel1*(k-1)
165 ENDDO
166!
167c----
168 IF (jhbe == 11) THEN ! Batoz
169c----
170 gbuft%THK(i1) = gbufs%THK(i) !thk
171c ener totale approximation
172 gbuft%EINT(i1) = gbufs%EINT(i)*s2wake(ib)/stot
173 gbuft%EINT(i1+nel1) = gbufs%EINT(i+nel)*s2wake(ib)/stot
174c
175 gbuft%OFF(i1) = gbufs%OFF(i)
176c
177 IF (gbuft%G_EPSD > 0) THEN
178 gbuft%EPSD(i1) = gbufs%EPSD(i) ! eps_dot
179 ENDIF
180c
181 IF (istra > 0) THEN
182 DO k=1,8 ! deformations
183 gbuft%STRA(kk1(k)+i1)=gbufs%STRA(kk(k)+i)
184 END DO
185 END IF
186c
187 IF (iexpan /= 0) THEN
188 gbuft%TEMP(i1)=gbufs%TEMP(i)
189 END IF
190c
191c pla
192c
193 IF (gbuft%G_PLA > 0) THEN
194 DO il=1,nlay
195 DO ir=1,nptr
196 DO is=1,npts
197 DO it=1,nptt
198 elbuf_tab(ng1)%BUFLY(il)%LBUF(ir,is,it)%PLA(i1) =
199 . elbuf_tab(ng) %BUFLY(il)%LBUF(ir,is,it)%PLA(i)
200 END DO
201 END DO
202 END DO
203 END DO
204 ENDIF
205c
206c Stress
207c
208 DO il=1,nlay
209 DO ir=1,nptr
210 DO is=1,npts
211 DO it=1,nptt
212 lbuft => elbuf_tab(ng1)%BUFLY(il)%LBUF(ir,is,it)
213 lbufs => elbuf_tab(ng )%BUFLY(il)%LBUF(ir,is,it)
214 lbuft%SIG(kk1(1)+i1) = lbufs%SIG(kk(1)+i)
215 lbuft%SIG(kk1(2)+i1) = lbufs%SIG(kk(2)+i)
216 lbuft%SIG(kk1(3)+i1) = lbufs%SIG(kk(3)+i)
217 lbuft%SIG(kk1(4)+i1) = lbufs%SIG(kk(4)+i)
218 lbuft%SIG(kk1(5)+i1) = lbufs%SIG(kk(5)+i)
219 END DO
220 END DO
221 END DO
222 END DO
223c
224c Uvar
225c
226 IF (mlw>=28 .AND. mlw/=32) THEN
227 DO il=1,nlay
228 DO ir=1,nptr
229 DO is=1,npts
230 DO it=1,nptt
231 DO k=1,elbuf_tab(ng)%BUFLY(il)%NVAR_MAT
232 elbuf_tab(ng1)%BUFLY(il)%MAT(ir,is,it)%VAR(nel1*(k-1)+i1)=
233 . elbuf_tab(ng)%BUFLY(il)%MAT(ir,is,it)%VAR(nel*(k-1)+i)
234 END DO
235 END DO
236 END DO
237 END DO
238 END DO
239 END IF
240c
241 lenf = nel*5
242 lenm = nel*3
243 lens = nel*8
244 ptf = 5*nel*(ib-1)
245 ptm = 3*nel*(ib-1)
246 DO ir=1,nptr
247 DO is=1,npts
248 ig = nptr*(is-1) + ir
249 qtf = 5*nel1*(ig-1)
250 qtm = 3*nel1*(ig-1)
251 gbuft%FORPG(qtf+kk1(1)+i1)=gbufs%FORPG(ptf+kk(1)+i)
252 gbuft%FORPG(qtf+kk1(2)+i1)=gbufs%FORPG(ptf+kk(2)+i)
253 gbuft%FORPG(qtf+kk1(3)+i1)=gbufs%FORPG(ptf+kk(3)+i)
254 gbuft%FORPG(qtf+kk1(4)+i1)=gbufs%FORPG(ptf+kk(4)+i)
255 gbuft%FORPG(qtf+kk1(5)+i1)=gbufs%FORPG(ptf+kk(5)+i)
256!
257 gbuft%MOMPG(qtm+kk1(1)+i1)=gbufs%MOMPG(ptm+kk(1)+i)
258 gbuft%MOMPG(qtm+kk1(2)+i1)=gbufs%MOMPG(ptm+kk(2)+i)
259 gbuft%MOMPG(qtm+kk1(3)+i1)=gbufs%MOMPG(ptm+kk(3)+i)
260 ENDDO
261 ENDDO
262c end Batoz
263c----
264 ELSE !Q4 & QEPH
265c----
266 gbuft%FOR(kk1(1)+i1) = gbufs%FOR(kk(1)+i)
267 gbuft%FOR(kk1(2)+i1) = gbufs%FOR(kk(2)+i)
268 gbuft%FOR(kk1(3)+i1) = gbufs%FOR(kk(3)+i)
269 gbuft%FOR(kk1(4)+i1) = gbufs%FOR(kk(4)+i)
270 gbuft%FOR(kk1(5)+i1) = gbufs%FOR(kk(5)+i)
271!
272 gbuft%MOM(kk1(1)+i1) = gbufs%MOM(kk(1)+i)
273 gbuft%MOM(kk1(2)+i1) = gbufs%MOM(kk(2)+i)
274 gbuft%MOM(kk1(3)+i1) = gbufs%MOM(kk(3)+i)
275c
276 gbuft%THK(i1) = gbufs%THK(i) !thk
277c
278 IF (jhbe == 22 .OR. jhbe == 23) THEN
279 ih = (i-1)*12
280 st(1) = gbufs%HOURG(kk(1)+i)
281 st(2) = -gbufs%HOURG(kk(2)+i)
282 mt(1) = gbufs%HOURG(kk(3)+i)
283 mt(2) = -gbufs%HOURG(kk(4)+i)
284 sk(1) = -gbufs%HOURG(kk(7)+i)
285 sk(2) = gbufs%HOURG(kk(8)+i)
286 mk(1) = -gbufs%HOURG(kk(9)+i)
287 mk(2) = gbufs%HOURG(kk(10)+i)
288 sht(1)= gbufs%HOURG(kk(5)+i)
289 sht(2)= -gbufs%HOURG(kk(6)+i)
290 shk(1)= -gbufs%HOURG(kk(11)+i)
291 shk(2)= gbufs%HOURG(kk(12)+i)
292
293 IF (npt==0) THEN
294 gbuft%FOR(kk1(1)+i1) = gbuft%FOR(kk1(1)+i1)
295 . + st(1)*qpg(2,ib)+sk(1)*qpg(1,ib)
296 gbuft%FOR(kk1(2)+i1) = gbuft%FOR(kk1(2)+i1)
297 . + st(2)*qpg(2,ib)+sk(2)*qpg(1,ib)
298c GBUFT%FOR(KK1(3)+I1) = GBUFT%FOR(KK1(3)+I1)
299 gbuft%FOR(kk1(4)+i1) = gbuft%FOR(kk1(4)+i1)
300 . + sht(2)*qpg(2,ib)+shk(2)*qpg(1,ib)
301 gbuft%FOR(kk1(5)+i1) = gbuft%FOR(kk1(5)+i1)
302 . + sht(1)*qpg(2,ib)+shk(1)*qpg(1,ib)
303!
304 gbuft%MOM(kk1(1)+i1) = gbuft%MOM(kk1(1)+i1)
305 . + mt(1)*qpg(2,ib)+mk(1)*qpg(1,ib)
306 gbuft%MOM(kk1(2)+i1) = gbuft%MOM(kk1(2)+i1)
307 . + mt(2)*qpg(2,ib)+mk(2)*qpg(1,ib)
308c GBUFT%MOM(KK1(3)+I1) = GBUFT%MOM(KK1(3)+I1)
309 ELSE
310 CONTINUE
311 END IF
312c---
313 DO k=1,12 ! hour
314 gbuft%HOURG(kk1(k)+i1) = zero
315 END DO
316c
317 ELSE ! JHBE
318 DO k=1,5 ! hour
319 gbuft%HOURG(kk1(k)+i1) = gbufs%HOURG(kk(k)+i)
320 END DO
321 END IF
322c ener totale approximation
323 gbuft%EINT(i1) = gbufs%EINT(i)*s2wake(ib)/stot
324 gbuft%EINT(i1+nel1) = gbufs%EINT(i+nel)*s2wake(ib)/stot
325c
326 gbuft%OFF(i1) = gbufs%OFF(i)
327 IF (gbuft%G_EPSD > 0) THEN
328 gbuft%EPSD(i1) = gbufs%EPSD(i) ! eps_dot
329 ENDIF
330 IF (iexpan/=0) THEN
331 gbuft%TEMP(i1) = gbufs%TEMP(i)
332 END IF
333c
334 IF (istra > 0) THEN
335 DO k=1,8 ! deformations
336 gbuft%STRA(kk1(k)+i1)=gbufs%STRA(kk(k)+i)
337 END DO
338 END IF
339c
340c Stress
341c
342 DO il=1,nlay
343 DO it=1,nptt
344 lbuft => elbuf_tab(ng1)%BUFLY(il)%LBUF(1,1,it)
345 lbufs => elbuf_tab(ng )%BUFLY(il)%LBUF(1,1,it)
346 lbuft%SIG(kk1(1)+i1) = lbufs%SIG(kk(1)+i)
347 lbuft%SIG(kk1(2)+i1) = lbufs%SIG(kk(2)+i)
348 lbuft%SIG(kk1(3)+i1) = lbufs%SIG(kk(3)+i)
349 lbuft%SIG(kk1(4)+i1) = lbufs%SIG(kk(4)+i)
350 lbuft%SIG(kk1(5)+i1) = lbufs%SIG(kk(5)+i)
351 END DO
352 END DO
353c
354 IF (jhbe == 22 .OR. jhbe == 23) THEN
355 DO il=1,nlay
356 DO it=1,nptt
357 lbuft => elbuf_tab(ng1)%BUFLY(il)%LBUF(1,1,it)
358 ipt = il*it
359 zz = gbuft%THK(i1)*z01(ipt,npt)
360 lbuft%SIG(kk1(1)+i1) = lbuft%SIG(kk1(1)+i1)
361 . + (st(1)+zz*mt(1))*qpg(2,ib)
362 . + (sk(1)+zz*mk(1))*qpg(1,ib)
363 lbuft%SIG(kk1(2)+i1) = lbuft%SIG(kk1(2)+i1)
364 . + (st(2)+zz*mt(2))*qpg(2,ib)
365 . + (sk(2)+zz*mk(2))*qpg(1,ib)
366C LBUFT%SIG(KK1(3)+I1) = LBUFT%SIG(KK1(3)+I1)
367 lbuft%SIG(kk1(4)+i1) = lbuft%SIG(kk1(4)+i1)
368 . + sht(2)*qpg(2,ib) + shk(2)*qpg(1,ib)
369 lbuft%SIG(kk1(5)+i1) = lbuft%SIG(kk1(5)+i1)
370 . + sht(1)*qpg(2,ib) + shk(1)*qpg(1,ib)
371 END DO
372 END DO
373 END IF
374c
375c pla
376c
377 IF (gbuft%G_PLA > 0) THEN
378 DO il=1,nlay
379 DO it=1,nptt
380 elbuf_tab(ng1)%BUFLY(il)%LBUF(1,1,it)%PLA(i1) =
381 . elbuf_tab(ng )%BUFLY(il)%LBUF(1,1,it)%PLA(i)
382 END DO
383 END DO
384 ENDIF
385c
386C uvar
387c
388 IF (mlw>=28 .AND. mlw/=32) THEN
389 DO il=1,nlay
390 DO it=1,nptt
391 DO k=1,elbuf_tab(ng)%BUFLY(il)%NVAR_MAT
392 elbuf_tab(ng1)%BUFLY(il)%MAT(1,1,it)%VAR(nel1*(k-1)+i1)=
393 . elbuf_tab(ng )%BUFLY(il)%MAT(1,1,it)%VAR(nel*(k-1)+i)
394 END DO
395 END DO
396 END DO
397 END IF
398c
399C---- end Q4 & QEPH
400C
401 END IF
402 END DO ! IB=1,4
403c---------------------------------------------
404c reset source element variables
405c---------------------------------------------
406 gbufs%OFF(i) =-abs(gbufs%OFF(i))
407!
408 gbufs%FOR(kk(1)+i) = zero
409 gbufs%FOR(kk(2)+i) = zero
410 gbufs%FOR(kk(3)+i) = zero
411 gbufs%FOR(kk(4)+i) = zero
412 gbufs%FOR(kk(5)+i) = zero
413!
414 gbufs%MOM(kk(1)+i) = zero
415 gbufs%MOM(kk(2)+i) = zero
416 gbufs%MOM(kk(3)+i) = zero
417 gbufs%EINT(i) = zero
418 gbufs%EINT(i+nel) = zero
419 IF (gbufs%G_EPSD > 0) gbufs%EPSD(i) = zero
420 IF (istra > 0) THEN ! deformations
421 DO k=1,8
422 gbufs%STRA(kk(k)+i) = zero
423 END DO
424 END IF
425c
426 DO ir=1,nptr
427 DO is=1,npts
428 DO il=1,nlay
429 DO it=1,nptt
430 DO k=1,5
431 elbuf_tab(ng)%BUFLY(il)%LBUF(ir,is,it)%SIG(kk(k)+i)=zero
432 ENDDO
433 END DO
434 END DO
435 END DO
436 END DO
437c
438c sig moyen
439! IF (NLAY > 1) THEN
440! DO IL=1,NLAY
441! BUFLY => ELBUF_TAB(NG)%BUFLY(IL)
442! DO K=1,5
443! BUFLY%SIGPT(K)=ZERO
444! END DO
445! END DO
446! ELSE
447! BUFLY => ELBUF_TAB(NG)%BUFLY(1)
448! DO IPT=1,NPT
449! II = (IPT-1)*NEL*5
450! DO K=1,5
451! BUFLY%SIGPT(II+K)=ZERO
452! END DO
453! END DO
454! ENDIF
455!c
456! IF (JHBE==11) THEN
457! DO IR=1,NPTR
458! DO IS=1,NPTS
459! IG = NPTR*(IS-1) + IR
460! PTF = (IG-1)*NEL*5
461! JJ = 5*(I-1)
462! DO K=1,5 ! for
463! GBUFS%FORPG(PTF+KK(K)+I) = ZERO
464! END DO
465! PTM = (IG-1)*NEL*3
466! JJ = 3*(I-1)
467! DO K=1,3 ! mom
468! GBUFS%MOMPG(PTM+KK(K)+I) = ZERO
469! END DO
470!
471! IF (ISTRA /= 0) THEN
472! PTE = 8*NEL*(IG-1)
473! JJ = 8*(I-1)
474! DO K=1,8 ! deformations
475! GBUFS%STRPG(PTE+KK(K)+I) = ZERO
476! END DO
477! END IF
478! END DO
479! END DO
480! END IF
481c
482C-----------
483 RETURN
484 END
485
486
487
admmap4
subroutine admmap4(n, ixc, x, iparg, elbuf_tab, igeo, ipm, sh4tree)
Definition admmap4.F:35
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