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 34 of file admthke.F.

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