OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
admthke.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "vect01_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine admthke (ixc, ixtg, x, iparg, elbuf_tab, ipart, ipartc, iparttg, iad_elem, fr_elem, weight, area_sh4, area_sh3, area_nod, thick_sh4, thick_sh3, thick_nod, err_thk_sh4, err_thk_sh3, sh4tree, sh3tree)

Function/Subroutine Documentation

◆ admthke()

subroutine admthke ( integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
x,
integer, dimension(nparg,*) iparg,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(lipart1,*) ipart,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
area_sh4,
area_sh3,
area_nod,
thick_sh4,
thick_sh3,
thick_nod,
err_thk_sh4,
err_thk_sh3,
integer, dimension(ksh4tree,*) sh4tree,
integer, dimension(ksh3tree,*) sh3tree )

Definition at line 35 of file admthke.F.

41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE remesh_mod
45 USE elbufdef_mod
46 use element_mod , only : nixc,nixtg
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51#include "comlock.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "param_c.inc"
57#include "remesh_c.inc"
58#include "vect01_c.inc"
59#include "scr17_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63C REAL
64 INTEGER
65 . IXC(NIXC,*), IXTG(NIXTG,*), IPARG(NPARG,*),
66 . IPART(LIPART1,*), IPARTC(*), IPARTTG(*),
67 . IAD_ELEM(2,*), FR_ELEM(*), WEIGHT(*),
68 . SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*)
69 my_real
70 . x(3,*), area_sh4(*), area_sh3(*), area_nod(*),
71 . thick_sh4(*), thick_sh3(*), thick_nod(*),
72 . err_thk_sh4(*), err_thk_sh3(*)
73 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER N1,N2,N3,N4,
78 . I,N,NG,NEL,LENR,
79 . NN,LEVEL,MY_LEVEL,M,SON,LL,M1,M2,M3,M4,MC
80C REAL
81 my_real
82 . area, a, at, thk,
83 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,
84 . x31,y31,z31,x42,y42,z42,x32,y32,z32,e3x,e3y,e3z
85 my_real
86 . tn1,tn2,tn3,tn4,tpg1,tpg2,tpg3,tpg4,unt
87 TYPE(G_BUFEL_) ,POINTER :: GBUF
88C-----------------------------------------------
89C Retrieve Thickness on active and secnd levels
90C-----------------------------------------------
91 DO level=0,levelmax-1
92
93 DO nn=psh4kin(level)+ 1,psh4kin(level+1)
94
95 n =lsh4kin(nn)
96
97 IF(sh4tree(3,n)>=0)THEN
98
99 ng =sh4tree(4,n)
100 nel =iparg(2,ng)
101 nft =iparg(3,ng)
102 lft=1
103 llt=min(nvsiz,nel)
104 gbuf => elbuf_tab(ng)%GBUF
105
106 i=n-nft
107 IF (gbuf%OFF(i) == zero) THEN
108 thk=zero
109 ELSE
110 thk = gbuf%THK(i)
111 END IF
112 thick_sh4(n)=thk
113
114 END IF
115
116 thk = thick_sh4(n)
117 son = sh4tree(2,n)
118 thick_sh4(son) =thk
119 thick_sh4(son+1)=thk
120 thick_sh4(son+2)=thk
121 thick_sh4(son+3)=thk
122 END DO
123
124 END DO
125C
126 level=levelmax
127 DO nn=psh4kin(level)+ 1,psh4kin(level+1)
128
129 n =lsh4kin(nn)
130
131 IF(sh4tree(3,n)>=0)THEN
132
133 ng =sh4tree(4,n)
134 nel =iparg(2,ng)
135 nft =iparg(3,ng)
136 lft=1
137 llt=min(nvsiz,nel)
138 gbuf => elbuf_tab(ng)%GBUF
139 i=n-nft
140c
141 IF (gbuf%OFF(i) == zero) THEN
142 thk=zero
143 ELSE
144 thk=gbuf%THK(i)
145 END IF
146 thick_sh4(n)=thk
147
148 END IF
149
150 END DO
151C
152 DO level=0,levelmax-1
153
154 DO nn=psh3kin(level)+ 1,psh3kin(level+1)
155
156 n =lsh3kin(nn)
157
158 IF(sh3tree(3,n)>=0)THEN
159
160 ng =sh3tree(4,n)
161 nel =iparg(2,ng)
162 nft =iparg(3,ng)
163 lft=1
164 llt=min(nvsiz,nel)
165 gbuf => elbuf_tab(ng)%GBUF
166 i=n-nft
167c
168 IF (gbuf%OFF(i) == zero) THEN
169 thk=zero
170 ELSE
171 thk=gbuf%THK(i)
172 END IF
173 thick_sh3(n)=thk
174
175 END IF
176
177 thk = thick_sh3(n)
178 son = sh3tree(2,n)
179 thick_sh3(son) =thk
180 thick_sh3(son+1)=thk
181 thick_sh3(son+2)=thk
182 thick_sh3(son+3)=thk
183 END DO
184 END DO
185C
186 level=levelmax
187 DO nn=psh3kin(level)+ 1,psh3kin(level+1)
188
189 n =lsh3kin(nn)
190
191 IF(sh3tree(3,n)>=0)THEN
192
193 ng =sh3tree(4,n)
194 nel =iparg(2,ng)
195 nft =iparg(3,ng)
196 lft=1
197 llt=min(nvsiz,nel)
198 gbuf => elbuf_tab(ng)%GBUF
199c
200 i=n-nft
201 IF (gbuf%OFF(i) == zero) THEN
202 thk=zero
203 ELSE
204 thk=gbuf%THK(i)
205 END IF
206 thick_sh3(n)=thk
207
208 END IF
209
210 END DO
211C-----------------------------------------------
212C ... Through the maximum (finest) level ...
213C-----------------------------------------------
214 level=levelmax
215 DO nn=psh4kin(level)+1,psh4kin(level+1)
216
217 n =lsh4kin(nn)
218
219 ng =sh4tree(4,n)
220 nel =iparg(2,ng)
221 nft =iparg(3,ng)
222 lft=1
223 llt=min(nvsiz,nel)
224 gbuf => elbuf_tab(ng)%GBUF
225c
226 i=n-nft
227 IF (gbuf%OFF(i) == zero) cycle
228
229 n1=ixc(2,n)
230 n2=ixc(3,n)
231 n3=ixc(4,n)
232 n4=ixc(5,n)
233
234 x1=x(1,n1)
235 y1=x(2,n1)
236 z1=x(3,n1)
237 x2=x(1,n2)
238 y2=x(2,n2)
239 z2=x(3,n2)
240 x3=x(1,n3)
241 y3=x(2,n3)
242 z3=x(3,n3)
243 x4=x(1,n4)
244 y4=x(2,n4)
245 z4=x(3,n4)
246C
247 x31=x3-x1
248 y31=y3-y1
249 z31=z3-z1
250 x42=x4-x2
251 y42=y4-y2
252 z42=z4-z2
253
254 e3x=y31*z42-z31*y42
255 e3y=z31*x42-x31*z42
256 e3z=x31*y42-y31*x42
257
258 e3x=one_over_8*e3x
259 e3y=one_over_8*e3y
260 e3z=one_over_8*e3z
261
262 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
263 area_sh4(n)=area
264 at = area * thick_sh4(n)
265
266 area_nod(n1)=area_nod(n1)+area
267 area_nod(n2)=area_nod(n2)+area
268 area_nod(n3)=area_nod(n3)+area
269 area_nod(n4)=area_nod(n4)+area
270 thick_nod(n1)=thick_nod(n1)+at
271 thick_nod(n2)=thick_nod(n2)+at
272 thick_nod(n3)=thick_nod(n3)+at
273 thick_nod(n4)=thick_nod(n4)+at
274
275 END DO
276C
277 level=levelmax
278 DO nn=psh3kin(level)+1,psh3kin(level+1)
279
280 n =lsh3kin(nn)
281
282 ng =sh3tree(4,n)
283 nel =iparg(2,ng)
284 nft =iparg(3,ng)
285 lft=1
286 llt=min(nvsiz,nel)
287 gbuf => elbuf_tab(ng)%GBUF
288c
289 i=n-nft
290 IF (gbuf%OFF(i) == zero) cycle
291
292 n1=ixtg(2,n)
293 n2=ixtg(3,n)
294 n3=ixtg(4,n)
295 x1=x(1,n1)
296 y1=x(2,n1)
297 z1=x(3,n1)
298 x2=x(1,n2)
299 y2=x(2,n2)
300 z2=x(3,n2)
301 x3=x(1,n3)
302 y3=x(2,n3)
303 z3=x(3,n3)
304 x31=x3-x1
305 y31=y3-y1
306 z31=z3-z1
307 x32=x3-x2
308 y32=y3-y2
309 z32=z3-z2
310
311 e3x=y31*z32-z31*y32
312 e3y=z31*x32-x31*z32
313 e3z=x31*y32-y31*x32
314 e3x=one_over_6*e3x
315 e3y=one_over_6*e3y
316 e3z=one_over_6*e3z
317
318 area=sqrt(e3x*e3x+e3y*e3y+e3z*e3z)
319 area_sh3(n)=area
320 at= area * thick_sh3(n)
321
322 area_nod(n1)=area_nod(n1)+area
323 area_nod(n2)=area_nod(n2)+area
324 area_nod(n3)=area_nod(n3)+area
325 thick_nod(n1)=thick_nod(n1)+at
326 thick_nod(n2)=thick_nod(n2)+at
327 thick_nod(n3)=thick_nod(n3)+at
328
329 END DO
330C-----------------------------------------------
331C Error for active elements at max level
332C-----------------------------------------------
333 DO nn=psh4kin(level)+1,psh4kin(level+1)
334
335 n =lsh4kin(nn)
336
337 IF(sh4tree(3,n) >= 0)THEN
338
339 n1=ixc(2,n)
340 n2=ixc(3,n)
341 n3=ixc(4,n)
342 n4=ixc(5,n)
343
344 unt=one/thick_sh4(n)
345 tn1=abs(thick_nod(n1)/max(em30,area_nod(n1))*unt-one)
346 tn2=abs(thick_nod(n2)/max(em30,area_nod(n2))*unt-one)
347 tn3=abs(thick_nod(n3)/max(em30,area_nod(n3))*unt-one)
348 tn4=abs(thick_nod(n4)/max(em30,area_nod(n4))*unt-one)
349 err_thk_sh4(n)=fourth*(tn1+tn2+tn3+tn4)
350 END IF
351
352 END DO
353C
354 DO nn=psh3kin(level)+1,psh3kin(level+1)
355
356 n =lsh3kin(nn)
357
358 IF(sh3tree(3,n) >= 0)THEN
359
360 n1=ixtg(2,n)
361 n2=ixtg(3,n)
362 n3=ixtg(4,n)
363
364 unt=one/thick_sh3(n)
365 tn1=abs(thick_nod(n1)/max(em30,area_nod(n1))*unt-one)
366 tn2=abs(thick_nod(n2)/max(em30,area_nod(n2))*unt-one)
367 tn3=abs(thick_nod(n3)/max(em30,area_nod(n3))*unt-one)
368 err_thk_sh3(n)=third*(tn1+tn2+tn3)
369 END IF
370
371 END DO
372C-----------------------------------------------
373C Error for all active elements (from bottom to top)
374C-----------------------------------------------
375 tagnod=0
376 DO level=levelmax-1,0,-1
377
378 DO nn=psh4kin(level)+1,psh4kin(level+1)
379 n =lsh4kin(nn)
380
381 son=sh4tree(2,n)
382
383 n1=ixc(2,n)
384 n2=ixc(3,n)
385 n3=ixc(4,n)
386 n4=ixc(5,n)
387
388 mc=ixc(4,son)
389
390 area=fourth*area_nod(mc)
391 at =fourth*thick_nod(mc)
392
393 area_nod(n1) =area_nod(n1)+area
394 area_nod(n2) =area_nod(n2)+area
395 area_nod(n3) =area_nod(n3)+area
396 area_nod(n4) =area_nod(n4)+area
397 thick_nod(n1)=thick_nod(n1)+at
398 thick_nod(n2)=thick_nod(n2)+at
399 thick_nod(n3)=thick_nod(n3)+at
400 thick_nod(n4)=thick_nod(n4)+at
401
402 tagnod(mc)=1
403
404
405 m1=ixc(3,son )
406 IF(tagnod(m1)==0)THEN
407
408 tagnod(m1)=1
409
410 area=half*area_nod(m1)
411 at =half*thick_nod(m1)
412
413 area_nod(n1) =area_nod(n1)+area
414 area_nod(n2) =area_nod(n2)+area
415 thick_nod(n1)=thick_nod(n1)+at
416 thick_nod(n2)=thick_nod(n2)+at
417
418 END IF
419
420 m2=ixc(4,son+1)
421 IF(tagnod(m2)==0)THEN
422
423 tagnod(m2)=1
424
425 area=half*area_nod(m2)
426 at =half*thick_nod(m2)
427
428 area_nod(n2) =area_nod(n2)+area
429 area_nod(n3) =area_nod(n3)+area
430 thick_nod(n2)=thick_nod(n2)+at
431 thick_nod(n3)=thick_nod(n3)+at
432
433 END IF
434
435 m3=ixc(5,son+2)
436 IF(tagnod(m3)==0)THEN
437
438 tagnod(m3)=1
439
440 area=half*area_nod(m3)
441 at =half*thick_nod(m3)
442
443 area_nod(n3) =area_nod(n3)+area
444 area_nod(n4) =area_nod(n4)+area
445 thick_nod(n3)=thick_nod(n3)+at
446 thick_nod(n4)=thick_nod(n4)+at
447
448 END IF
449
450 m4=ixc(2,son+3)
451 IF(tagnod(m4)==0)THEN
452
453 tagnod(m4)=1
454
455 area=half*area_nod(m4)
456 at =half*thick_nod(m4)
457
458 area_nod(n4) =area_nod(n4)+area
459 area_nod(n1) =area_nod(n1)+area
460 thick_nod(n4)=thick_nod(n4)+at
461 thick_nod(n1)=thick_nod(n1)+at
462
463 END IF
464
465 END DO
466
467 DO nn=psh3kin(level)+1,psh3kin(level+1)
468 n =lsh3kin(nn)
469
470 son=sh3tree(2,n)
471
472 n1=ixtg(2,n)
473 n2=ixtg(3,n)
474 n3=ixtg(4,n)
475C
476 m1=ixtg(4,son+3)
477 IF(tagnod(m1)==0)THEN
478
479 tagnod(m1)=1
480
481 area=half*area_nod(m1)
482 at =half*thick_nod(m1)
483
484 area_nod(n1) =area_nod(n1)+area
485 area_nod(n2) =area_nod(n2)+area
486 thick_nod(n1)=thick_nod(n1)+at
487 thick_nod(n2)=thick_nod(n2)+at
488
489 END IF
490C
491 m2=ixtg(2,son+3)
492 IF(tagnod(m2)==0)THEN
493 tagnod(m2)=1
494
495 area=half*area_nod(m2)
496 at =half*thick_nod(m2)
497
498 area_nod(n2) =area_nod(n2)+area
499 area_nod(n3) =area_nod(n3)+area
500 thick_nod(n2)=thick_nod(n2)+at
501 thick_nod(n3)=thick_nod(n3)+at
502
503 END IF
504
505 m3=ixtg(3,son+3)
506 IF(tagnod(m3)==0)THEN
507 tagnod(m3)=1
508
509 area=half*area_nod(m3)
510 at =half*thick_nod(m3)
511
512 area_nod(n3) =area_nod(n3)+area
513 area_nod(n1) =area_nod(n1)+area
514 thick_nod(n3)=thick_nod(n3)+at
515 thick_nod(n1)=thick_nod(n1)+at
516
517 END IF
518
519 END DO
520
521 DO nn=psh4kin(level)+1,psh4kin(level+1)
522 n =lsh4kin(nn)
523
524 IF(sh4tree(3,n) >= 0)THEN
525
526 n1=ixc(2,n)
527 n2=ixc(3,n)
528 n3=ixc(4,n)
529 n4=ixc(5,n)
530
531 unt=one/thick_sh4(n)
532 tn1=abs(thick_nod(n1)/max(em30,area_nod(n1))*unt-one)
533 tn2=abs(thick_nod(n2)/max(em30,area_nod(n2))*unt-one)
534 tn3=abs(thick_nod(n3)/max(em30,area_nod(n3))*unt-one)
535 tn4=abs(thick_nod(n4)/max(em30,area_nod(n4))*unt-one)
536 err_thk_sh4(n)=fourth*(tn1+tn2+tn3+tn4)
537 END IF
538 END DO
539
540 DO nn=psh3kin(level)+1,psh3kin(level+1)
541 n =lsh3kin(nn)
542
543 IF(sh3tree(3,n) >= 0)THEN
544
545 n1=ixtg(2,n)
546 n2=ixtg(3,n)
547 n3=ixtg(4,n)
548
549 unt=one/thick_sh3(n)
550 tn1=abs(thick_nod(n1)/max(em30,area_nod(n1))*unt-one)
551 tn2=abs(thick_nod(n2)/max(em30,area_nod(n2))*unt-one)
552 tn3=abs(thick_nod(n3)/max(em30,area_nod(n3))*unt-one)
553 err_thk_sh3(n)=third*(tn1+tn2+tn3)
554 END IF
555 END DO
556
557 END DO
558
559 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
560 CALL spmd_exch_nodarea(area_nod,iad_elem,fr_elem,lenr,weight)
561 CALL spmd_exch_nodarea(thick_nod,iad_elem,fr_elem,lenr,weight)
562
563 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
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
spmd_exch_nodarea
subroutine spmd_exch_nodarea(nodarea, iad_elem, fr_elem, lenr, weight)
Definition spmd_exch_nodarea.F:41