OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_brick_mp.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!|| stat_brick_mp ../engine/source/output/sta/stat_brick_mp.F
25!||--- called by ------------------------------------------------------
26!|| genstat ../engine/source/output/sta/genstat.F
27!||--- calls -----------------------------------------------------
28!|| my_orders ../common_source/tools/sort/my_orders.c
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| element_mod ../common_source/modules/elements/element_mod.F90
32!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
33!||====================================================================
34 SUBROUTINE stat_brick_mp(ITAB,IPART,IGEO,IXS,IPARTS,
35 . IPART_STATE,NODTAG,STAT_INDXS,
36 . IPARG ,IXS10,IXS16,IXS20,ELBUF_TAB,
37 . IDEL)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42 USE my_alloc_mod
43 use element_mod , only : nixs
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com01_c.inc"
52#include "com04_c.inc"
53#include "param_c.inc"
54#include "scr16_c.inc"
55#include "scr17_c.inc"
56#include "units_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER ITAB(*), IPART(LIPART1,*),IPARTS(*),
61 . IGEO(NPROPGI,*), IXS(NIXS,*), IPART_STATE(*),
62 . NODTAG(*), STAT_INDXS(*),
63 . iparg(nparg,*),ixs10(6,*),ixs16(8,*),ixs20(12,*),
64 . idel
65 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I, N, JJ, IPRT0, IPRT, K,N10,N20,N16
70 INTEGER NG, NEL, NFT, LFT, LLT, ITY, ISOLNOD, IOFF
71 INTEGER WORK(70000)
72 INTEGER,DIMENSION(:),ALLOCATABLE :: NP
73 INTEGER,DIMENSION(:,:),ALLOCATABLE :: CLEF
74 TYPE(g_bufel_) ,POINTER :: GBUF
75C-----------------------------------------------
76C 8 NODES BRICK
77C-----------------------------------------------
78 CALL my_alloc(np,24*numels)
79 CALL my_alloc(clef,2,numels)
80C-----------------------------------------------
81 jj = 0
82 IF(numels/=0)THEN
83
84 DO ng=1,ngroup
85 ity =iparg(5,ng)
86 isolnod = iparg(28,ng)
87 nel =iparg(2,ng)
88 nft =iparg(3,ng)
89 gbuf => elbuf_tab(ng)%GBUF
90 lft=1
91 llt=nel
92 IF(ity == 1) THEN
93 DO i=lft,llt
94 n = i + nft
95 iprt=iparts(n)
96 IF(ipart_state(iprt)==0)cycle
97
98 np(jj+1) = ixs(nixs,n)
99 IF (isolnod == 10)THEN
100 n10 = n - numels8
101 np(jj+2) = itab(ixs(2,n))
102 np(jj+3) = itab(ixs(4,n))
103 np(jj+4) = itab(ixs(7,n))
104 np(jj+5) = itab(ixs(6,n))
105 IF(ixs10(1,n10) /= 0)THEN
106 np(jj+6) = itab(ixs10(1,n10))
107 ELSE
108 np(jj+6) = 0
109 ENDIF
110 IF(ixs10(2,n10) /= 0)THEN
111 np(jj+7) = itab(ixs10(2,n10))
112 ELSE
113 np(jj+7) = 0
114 ENDIF
115 IF(ixs10(3,n10) /= 0)THEN
116 np(jj+8) = itab(ixs10(3,n10))
117 ELSE
118 np(jj+8) = 0
119 ENDIF
120 IF(ixs10(4,n10) /= 0)THEN
121 np(jj+9) = itab(ixs10(4,n10))
122 ELSE
123 np(jj+9) = 0
124 ENDIF
125 IF(ixs10(5,n10) /= 0)THEN
126 np(jj+10) = itab(ixs10(5,n10))
127 ELSE
128 np(jj+10) = 0
129 ENDIF
130 IF(ixs10(6,n10) /= 0)THEN
131 np(jj+11) = itab(ixs10(6,n10))
132 ELSE
133 np(jj+11) = 0
134 ENDIF
135 np(jj+12) = 0
136 np(jj+13) = 0
137 np(jj+14) = 0
138 np(jj+15) = 0
139 np(jj+16) = 0
140 np(jj+17) = 0
141 np(jj+18) = 0
142 np(jj+19) = 0
143 np(jj+20) = 0
144 np(jj+21) = 0
145 ELSEIF (isolnod == 16)THEN
146 n16 = n - (numels8+numels10+numels20)
147 np(jj+2) = itab(ixs(2,n))
148 np(jj+3) = itab(ixs(3,n))
149 np(jj+4) = itab(ixs(4,n))
150 np(jj+5) = itab(ixs(5,n))
151 np(jj+6) = itab(ixs(6,n))
152 np(jj+7) = itab(ixs(7,n))
153 np(jj+8) = itab(ixs(8,n))
154 np(jj+9) = itab(ixs(9,n))
155 IF(ixs16(1,n16) /= 0)THEN
156 np(jj+10) = itab(ixs16(1,n16))
157 ELSE
158 np(jj+10) = 0
159 ENDIF
160 IF(ixs16(2,n16) /= 0)THEN
161 np(jj+11) = itab(ixs16(2,n16))
162 ELSE
163 np(jj+11) = 0
164 ENDIF
165 IF(ixs16(3,n16) /= 0)THEN
166 np(jj+12) = itab(ixs16(3,n16))
167 ELSE
168 np(jj+12) = 0
169 ENDIF
170 IF(ixs16(4,n16) /= 0)THEN
171 np(jj+13) = itab(ixs16(4,n16))
172 ELSE
173 np(jj+13) = 0
174 ENDIF
175 IF(ixs16(5,n16) /= 0)THEN
176 np(jj+14) = itab(ixs16(5,n16))
177 ELSE
178 np(jj+14) = 0
179 ENDIF
180 IF(ixs16(6,n16) /= 0)THEN
181 np(jj+15) = itab(ixs16(6,n16))
182 ELSE
183 np(jj+15) = 0
184 ENDIF
185 IF(ixs16(7,n16) /= 0)THEN
186 np(jj+16) = itab(ixs16(7,n16))
187 ELSE
188 np(jj+16) = 0
189 ENDIF
190 IF(ixs16(8,n16) /= 0)THEN
191 np(jj+17) = itab(ixs16(8,n16))
192 ELSE
193 np(jj+17) = 0
194 ENDIF
195 np(jj+18) = 0
196 np(jj+19) = 0
197 np(jj+20) = 0
198 np(jj+21) = 0
199 ELSEIF (isolnod == 20)THEN
200 n20 = n - (numels8+numels10)
201 np(jj+2) = itab(ixs(2,n))
202 np(jj+3) = itab(ixs(3,n))
203 np(jj+4) = itab(ixs(4,n))
204 np(jj+5) = itab(ixs(5,n))
205 np(jj+6) = itab(ixs(6,n))
206 np(jj+7) = itab(ixs(7,n))
207 np(jj+8) = itab(ixs(8,n))
208 np(jj+9) = itab(ixs(9,n))
209 IF(ixs20(1,n20) /= 0)THEN
210 np(jj+10) = itab(ixs20(1,n20))
211 ELSE
212 np(jj+10) = 0
213 ENDIF
214 IF(ixs20(2,n20) /= 0)THEN
215 np(jj+11) = itab(ixs20(2,n20))
216 ELSE
217 np(jj+11) = 0
218 ENDIF
219 IF(ixs20(3,n20) /= 0)THEN
220 np(jj+12) = itab(ixs20(3,n20))
221 ELSE
222 np(jj+12) = 0
223 ENDIF
224 IF(ixs20(4,n20) /= 0)THEN
225 np(jj+13) = itab(ixs20(4,n20))
226 ELSE
227 np(jj+13) = 0
228 ENDIF
229 IF(ixs20(5,n20) /= 0)THEN
230 np(jj+14) = itab(ixs20(5,n20))
231 ELSE
232 np(jj+14) = 0
233 ENDIF
234 IF(ixs20(6,n20) /= 0)THEN
235 np(jj+15) = itab(ixs20(6,n20))
236 ELSE
237 np(jj+15) = 0
238 ENDIF
239 IF(ixs20(7,n20) /= 0)THEN
240 np(jj+16) = itab(ixs20(7,n20))
241 ELSE
242 np(jj+16) = 0
243 ENDIF
244 IF(ixs20(8,n20) /= 0)THEN
245 np(jj+17) = itab(ixs20(8,n20))
246 ELSE
247 np(jj+17) = 0
248 ENDIF
249 IF(ixs20(9,n20) /= 0)THEN
250 np(jj+18) = itab(ixs20(9,n20))
251 ELSE
252 np(jj+18) = 0
253 ENDIF
254 IF(ixs20(10,n20) /= 0)THEN
255 np(jj+19) = itab(ixs20(10,n20))
256 ELSE
257 np(jj+19) = 0
258 ENDIF
259 IF(ixs20(11,n20) /= 0)THEN
260 np(jj+20) = itab(ixs20(11,n20))
261 ELSE
262 np(jj+20) = 0
263 ENDIF
264 IF(ixs20(12,n20) /= 0)THEN
265 np(jj+21) = itab(ixs20(12,n20))
266 ELSE
267 np(jj+21) = 0
268 ENDIF
269 ELSE
270 np(jj+2) = itab(ixs(2,n))
271 np(jj+3) = itab(ixs(3,n))
272 np(jj+4) = itab(ixs(4,n))
273 np(jj+5) = itab(ixs(5,n))
274 np(jj+6) = itab(ixs(6,n))
275 np(jj+7) = itab(ixs(7,n))
276 np(jj+8) = itab(ixs(8,n))
277 np(jj+9) = itab(ixs(9,n))
278 np(jj+10) = 0
279 np(jj+11) = 0
280 np(jj+12) = 0
281 np(jj+13) = 0
282 np(jj+14) = 0
283 np(jj+15) = 0
284 np(jj+16) = 0
285 np(jj+17) = 0
286 np(jj+18) = 0
287 np(jj+19) = 0
288 np(jj+20) = 0
289 np(jj+21) = 0
290 ENDIF
291 np(jj+22) = iprt
292 np(jj+23) = isolnod
293 np(jj+24) = iabs(nint(gbuf%OFF(i)))
294 jj = jj + 24
295
296 stat_numels =stat_numels+1
297 clef(1,stat_numels)=iprt
298 clef(2,stat_numels)=ixs(nixs,n)
299
300 IF (isolnod == 10)THEN
301 nodtag(ixs(2,n))=1
302 nodtag(ixs(4,n))=1
303 nodtag(ixs(7,n))=1
304 nodtag(ixs(6,n))=1
305 IF (ixs10(1,n10) /= 0) nodtag(ixs10(1,n10))=1
306 IF (ixs10(2,n10) /= 0) nodtag(ixs10(2,n10))=1
307 IF (ixs10(3,n10) /= 0) nodtag(ixs10(3,n10))=1
308 IF (ixs10(4,n10) /= 0) nodtag(ixs10(4,n10))=1
309 IF (ixs10(5,n10) /= 0) nodtag(ixs10(5,n10))=1
310 IF (ixs10(6,n10) /= 0) nodtag(ixs10(6,n10))=1
311 ELSEIF (isolnod == 16)THEN
312 nodtag(ixs(2,n))=1
313 nodtag(ixs(3,n))=1
314 nodtag(ixs(4,n))=1
315 nodtag(ixs(5,n))=1
316 nodtag(ixs(6,n))=1
317 nodtag(ixs(7,n))=1
318 nodtag(ixs(8,n))=1
319 nodtag(ixs(9,n))=1
320 IF (ixs16(1,n16) /= 0) nodtag(ixs16(1,n16))=1
321 IF (ixs16(2,n16) /= 0) nodtag(ixs16(2,n16))=1
322 IF (ixs16(3,n16) /= 0) nodtag(ixs16(3,n16))=1
323 IF (ixs16(4,n16) /= 0) nodtag(ixs16(4,n16))=1
324 IF (ixs16(5,n16) /= 0) nodtag(ixs16(5,n16))=1
325 IF (ixs16(6,n16) /= 0) nodtag(ixs16(6,n16))=1
326 IF (ixs16(7,n16) /= 0) nodtag(ixs16(7,n16))=1
327 IF (ixs16(8,n16) /= 0) nodtag(ixs16(8,n16))=1
328 ELSEIF (isolnod == 20)THEN
329 nodtag(ixs(2,n))=1
330 nodtag(ixs(3,n))=1
331 nodtag(ixs(4,n))=1
332 nodtag(ixs(5,n))=1
333 nodtag(ixs(6,n))=1
334 nodtag(ixs(7,n))=1
335 nodtag(ixs(8,n))=1
336 nodtag(ixs(9,n))=1
337 IF (ixs20(1,n20) /= 0) nodtag(ixs20(1,n20))=1
338 IF (ixs20(2,n20) /= 0) nodtag(ixs20(2,n20))=1
339 IF (ixs20(3,n20) /= 0) nodtag(ixs20(3,n20))=1
340 IF (ixs20(4,n20) /= 0) nodtag(ixs20(4,n20))=1
341 IF (ixs20(5,n20) /= 0) nodtag(ixs20(5,n20))=1
342 IF (ixs20(6,n20) /= 0) nodtag(ixs20(6,n20))=1
343 IF (ixs20(7,n20) /= 0) nodtag(ixs20(7,n20))=1
344 IF (ixs20(8,n20) /= 0) nodtag(ixs20(8,n20))=1
345 IF (ixs20(9,n20) /= 0) nodtag(ixs20(9,n20))=1
346 IF (ixs20(10,n20) /= 0) nodtag(ixs20(10,n20))=1
347 IF (ixs20(11,n20) /= 0) nodtag(ixs20(11,n20))=1
348 IF (ixs20(12,n20) /= 0) nodtag(ixs20(12,n20))=1
349 ELSE
350 nodtag(ixs(2,n))=1
351 nodtag(ixs(3,n))=1
352 nodtag(ixs(4,n))=1
353 nodtag(ixs(5,n))=1
354 nodtag(ixs(6,n))=1
355 nodtag(ixs(7,n))=1
356 nodtag(ixs(8,n))=1
357 nodtag(ixs(9,n))=1
358 ENDIF
359 END DO
360 END IF
361 END DO
362C----
363 DO n=1,stat_numels
364 stat_indxs(n)=n
365 END DO
366 CALL my_orders(0,work,clef,stat_indxs,stat_numels,2)
367C----
368 iprt0=0
369 DO n=1,stat_numels
370 k=stat_indxs(n)
371 jj=24*(k-1)
372 iprt=np(jj+22)
373 ioff=np(jj+24)
374 IF (np(jj+23) == 4) THEN
375 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
376 IF(iprt /= iprt0)THEN
377 WRITE(iugeo,'(A,I10)')'/TETRA4/',ipart(4,iprt)
378 WRITE(iugeo,'(A)')
379 . '# TETRA4ID NOD1 NOD2 NOD3 NOD4'
380 iprt0=iprt
381 END IF
382 WRITE(iugeo,'(5I10)') np(jj+1),np(jj+2),np(jj+4),
383 . np(jj+8),np(jj+6)
384 ENDIF
385 ELSEIF (np(jj+23) == 6) THEN
386 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
387 IF(iprt /= iprt0)THEN
388 WRITE(iugeo,'(A,I10)')'/PENTA6/',ipart(4,iprt)
389 WRITE(iugeo,'(A)')
390 . '# PENTA6ID NOD1 NOD2 NOD3 NOD4 NOD5 NOD6'
391 iprt0=iprt
392 END IF
393 WRITE(iugeo,'(7I10)') np(jj+1),np(jj+2),np(jj+3),
394 . np(jj+4),np(jj+6),np(jj+7),
395 . np(jj+8)
396 ENDIF
397 ELSEIF (np(jj+23) == 8) THEN
398 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
399 IF(iprt /= iprt0)THEN
400 WRITE(iugeo,'(A,I10)')'/BRICK/',ipart(4,iprt)
401 WRITE(iugeo,'(A)')
402 . '# BRICKID NOD1 NOD2 NOD3 NOD4 NOD5 NOD6 NOD7 NOD8'
403 iprt0=iprt
404 END IF
405 WRITE(iugeo,'(9I10)') np(jj+1),np(jj+2),np(jj+3),
406 . np(jj+4),np(jj+5),np(jj+6),
407 . np(jj+7),np(jj+8),np(jj+9)
408 ENDIF
409 ELSEIF (np(jj+23) == 10) THEN
410 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
411 IF(iprt /= iprt0)THEN
412 WRITE(iugeo,'(A,I10)')'/TETRA10/',ipart(4,iprt)
413 WRITE(iugeo,'(A)')
414 . '#TETRA10ID'
415 WRITE(iugeo,'(A)')
416 . '# NOD1 NOD2 NOD3 NOD4 NOD5 NOD6 NOD7 NOD8 NOD9 NOD10'
417 iprt0=iprt
418 END IF
419 WRITE(iugeo,'(I10)') np(jj+1)
420 WRITE(iugeo,'(10I10)') np(jj+2),np(jj+3),np(jj+4),
421 . np(jj+5),np(jj+6),np(jj+7),
422 . np(jj+8),np(jj+9),np(jj+10),
423 . np(jj+11)
424 ENDIF
425 ELSEIF (np(jj+23) == 16) THEN
426 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
427 IF(iprt /= iprt0)THEN
428 WRITE(iugeo,'(A,I10)')'/SHEL16/',ipart(4,iprt)
429 WRITE(iugeo,'(A)')
430 . '#TSHEL16ID NOD1 NOD2 NOD3 NOD4 NOD5 NOD6 NOD7 NOD8'
431 WRITE(iugeo,'(A)')
432 . '# NOD9 NOD10 NOD11 NOD12'
433 WRITE(iugeo,'(A)')
434 . '# NOD13 NOD14 NOD15 NOD16'
435 iprt0=iprt
436 END IF
437 WRITE(iugeo,'(9I10)') np(jj+1),np(jj+2),np(jj+3),np(jj+4),
438 . np(jj+5),np(jj+6),np(jj+7),
439 . np(jj+8),np(jj+9)
440 WRITE(iugeo,'(4I10)') np(jj+10),np(jj+11),np(jj+12),
441 . np(jj+13)
442 WRITE(iugeo,'(4I10)') np(jj+14),np(jj+15),np(jj+16),
443 . np(jj+17)
444 ENDIF
445 ELSEIF (np(jj+23) == 20) THEN
446 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
447 IF(iprt /= iprt0)THEN
448 WRITE(iugeo,'(A,I10)')'/BRIC20/',ipart(4,iprt)
449 WRITE(iugeo,'(A)')
450 . '#BRICK20ID NOD1 NOD2 NOD3 NOD4 NOD5 NOD6 NOD7 NOD8'
451 WRITE(iugeo,'(A)')
452 . '# NOD9 NOD10 NOD11 NOD12 NOD13 NOD14 NOD15 NOD16'
453 WRITE(iugeo,'(A)')
454 . '# NOD17 NOD18 NOD19 NOD20'
455 iprt0=iprt
456 END IF
457 WRITE(iugeo,'(9I10)') np(jj+1),np(jj+2),np(jj+3),np(jj+4),
458 . np(jj+5),np(jj+6),np(jj+7),
459 . np(jj+8),np(jj+9)
460 WRITE(iugeo,'(8I10)') np(jj+10),np(jj+11),np(jj+12),
461 . np(jj+13),np(jj+14),np(jj+15),
462 . np(jj+16),np(jj+17)
463 WRITE(iugeo,'(4I10)') np(jj+18),np(jj+19),np(jj+20),
464 . np(jj+21)
465 ENDIF
466 ENDIF
467 END DO
468 ENDIF
469C-----------------------------------------------
470 DEALLOCATE(np)
471 DEALLOCATE(clef)
472C-----------------------------------------------
473 RETURN
474 END
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
subroutine stat_brick_mp(itab, ipart, igeo, ixs, iparts, ipart_state, nodtag, stat_indxs, iparg, ixs10, ixs16, ixs20, elbuf_tab, idel)