OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_shel_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_shel_mp ../engine/source/output/sta/stat_shel_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!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
32!||====================================================================
33 SUBROUTINE stat_shel_mp(ITAB,ITABG,LENG,IPART,IGEO,
34 . IXC,IXTG,IPARTC,IPARTTG,IPART_STATE,
35 . NODTAG,STAT_INDXC,STAT_INDXTG,SH4TREE,SH3TREE,
36 . IPARG ,SH4TRIM ,SH3TRIM ,ELBUF_TAB,THKE ,
37 . IDEL)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42 USE my_alloc_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "param_c.inc"
53#include "remesh_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(*), ITABG(*), LENG, IPART(LIPART1,*),
61 . IGEO(NPROPGI,*), IXC(NIXC,*), IXTG(NIXTG,*),
62 . IPARTC(*), IPARTTG(*), IPART_STATE(*),
63 . NODTAG(*), STAT_INDXC(*), STAT_INDXTG(*),
64 . sh4tree(ksh4tree,*), sh3tree(ksh3tree,*),
65 . iparg(nparg,*), sh4trim(*), sh3trim(*),
66 . idel
67 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
68 my_real
69 . THKE(*)
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I, N, JJ, IPRT0, IPRT, K, II
74 INTEGER NG, NEL, NFT, LFT, LLT, ITY, MLW, ITHK,IOFF
75 INTEGER WORK(70000)
76 INTEGER, DIMENSION(:),ALLOCATABLE :: NP
77 INTEGER, DIMENSION(:,:),ALLOCATABLE :: CLEF
78 double precision,DIMENSION(:),ALLOCATABLE :: THK
79 TYPE(g_bufel_) ,POINTER :: GBUF
80C-----------------------------------------------
81 CALL my_alloc(thk,max(numelc,numeltg))
82 CALL my_alloc(clef,2,max(numelc,numeltg))
83 CALL my_alloc(np,8*max(numelc,numeltg))
84C-----------------------------------------------
85C 4-NODE SHELLS
86C-----------------------------------------------
87 jj = 0
88 ii = 0
89 IF(numelc/=0)THEN
90
91 DO ng=1,ngroup
92 ity =iparg(5,ng)
93 IF(ity==3) THEN
94 nel =iparg(2,ng)
95 nft =iparg(3,ng)
96 gbuf => elbuf_tab(ng)%GBUF
97 mlw =iparg(1,ng)
98 ithk =iparg(28,ng)
99 lft=1
100 llt=nel
101 DO i=lft,llt
102 n = i + nft
103
104 iprt=ipartc(n)
105 IF(ipart_state(iprt)==0)cycle
106
107 np(jj+1) = ixc(nixc,n)
108 np(jj+2) = itab(ixc(2,n))
109 np(jj+3) = itab(ixc(3,n))
110 np(jj+4) = itab(ixc(4,n))
111 np(jj+5) = itab(ixc(5,n))
112 np(jj+6) = iprt
113 np(jj+7) = iabs(nint(gbuf%OFF(i)))
114 ii = ii + 1
115 IF (mlw /= 0 .AND. mlw /= 13) THEN
116 IF (ithk >0 ) THEN
117 thk(ii) = gbuf%THK(i)
118 ELSE
119 thk(ii) = thke(n)
120 END IF
121 ELSE
122 thk(ii) = zero
123 ENDIF
124 jj = jj + 7
125
126 stat_numelc =stat_numelc+1
127 clef(1,stat_numelc)=iprt
128 clef(2,stat_numelc)=ixc(nixc,n)
129
130 nodtag(ixc(2,n))=1
131 nodtag(ixc(3,n))=1
132 nodtag(ixc(4,n))=1
133 nodtag(ixc(5,n))=1
134
135 END DO
136 END IF
137 END DO
138 END IF
139C----
140 DO n=1,stat_numelc
141 stat_indxc(n)=n
142 END DO
143 CALL my_orders(0,work,clef,stat_indxc,stat_numelc,2)
144C----
145 iprt0=0
146 DO n=1,stat_numelc
147 k=stat_indxc(n)
148 jj=7*(k-1)
149 iprt=np(jj+6)
150 ioff=np(jj+7)
151 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
152 IF(iprt /= iprt0)THEN
153 WRITE(iugeo,'(A,I10)')'/SHELL/',ipart(4,iprt)
154 WRITE(iugeo,'(A)')
155 . '# SHELLID NOD1 NOD2 NOD3 NOD4 THK'
156 iprt0=iprt
157 END IF
158 WRITE(iugeo,'(5I10,30X,1PE20.13)')
159 . np(jj+1),np(jj+2),np(jj+3),np(jj+4),np(jj+5),thk(k)
160 ENDIF
161 END DO
162C----
163C Specific adaptive meshing :
164 IF(nadmesh /=0)THEN
165 jj = 0
166 IF(numelc/=0)THEN
167 DO ng=1,ngroup
168 ity =iparg(5,ng)
169 IF(ity==3) THEN
170 nel =iparg(2,ng)
171 nft =iparg(3,ng)
172 lft=1
173 llt=nel
174 DO i=lft,llt
175 n = i + nft
176
177 iprt=ipartc(n)
178 IF(ipart_state(iprt)==0)cycle
179
180 np(jj+1) = ixc(nixc,n)
181 IF(sh4tree(2,n) /= 0)THEN
182 np(jj+2) = ixc(nixc,sh4tree(2,n) )
183 np(jj+3) = ixc(nixc,sh4tree(2,n)+1)
184 np(jj+4) = ixc(nixc,sh4tree(2,n)+2)
185 np(jj+5) = ixc(nixc,sh4tree(2,n)+3)
186 ELSE
187 np(jj+2) =0
188 np(jj+3) =0
189 np(jj+4) =0
190 np(jj+5) =0
191 END IF
192 np(jj+6) = sh4tree(3,n)
193 np(jj+7) = iprt
194 IF(lsh4trim /= 0)THEN
195 IF(sh4trim(n)==-1)THEN
196 np(jj+8) = -1
197 ELSE
198 np(jj+8) = 0
199 END IF
200 ELSE
201 np(jj+8) = 0
202 END IF
203 jj = jj + 8
204 END DO
205 END IF
206 END DO
207 END IF
208
209 iprt0=0
210 DO n=1,stat_numelc
211 k=stat_indxc(n)
212 jj=8*(k-1)
213 iprt=np(jj+7)
214 IF(iprt /= iprt0)THEN
215 WRITE(iugeo,'(A)')'/ADMESH/STATE/SHELL'
216 WRITE(iugeo,'(2A)')
217 . '# SHELLID ID1 ID2 ID3 ID4 LEVEL',
218 . ' IMAPPING'
219 iprt0=iprt
220 END IF
221 WRITE(iugeo,'(7I10)')
222 . np(jj+1),np(jj+2),np(jj+3),np(jj+4),np(jj+5),np(jj+6),np(jj+8)
223 END DO
224
225 END IF
226C-----------------------------------------------
227C 3-NODE SHELLS
228C-----------------------------------------------
229 jj = 0
230 ii = 0
231 IF(numeltg/=0)THEN
232 DO ng=1,ngroup
233 ity =iparg(5,ng)
234 IF(ity==7) THEN
235 nel =iparg(2,ng)
236 nft =iparg(3,ng)
237 gbuf => elbuf_tab(ng)%GBUF
238 mlw =iparg(1,ng)
239 ithk =iparg(28,ng)
240 lft=1
241 llt=nel
242C
243 DO i=lft,llt
244 n = i + nft
245
246 iprt=iparttg(n)
247 IF(ipart_state(iprt)==0)cycle
248
249 np(jj+1) = ixtg(nixtg,n)
250 np(jj+2) = itab(ixtg(2,n))
251 np(jj+3) = itab(ixtg(3,n))
252 np(jj+4) = itab(ixtg(4,n))
253 np(jj+5) = iprt
254 np(jj+6) = iabs(nint(gbuf%OFF(i)))
255 ii = ii + 1
256 IF (mlw /= 0 .AND. mlw /= 13) THEN
257 IF (ithk >0 ) THEN
258 thk(ii) = gbuf%THK(i)
259 ELSE
260 thk(ii) = thke(n)
261 END IF
262 ELSE
263 thk(ii) = zero
264 ENDIF
265 jj = jj + 6
266
267 stat_numeltg =stat_numeltg+1
268 clef(1,stat_numeltg)=iprt
269 clef(2,stat_numeltg)=ixtg(nixtg,n)
270
271 nodtag(ixtg(2,n))=1
272 nodtag(ixtg(3,n))=1
273 nodtag(ixtg(4,n))=1
274
275 END DO
276 END IF
277 END DO
278 END IF
279
280C-----
281 DO n=1,stat_numeltg
282 stat_indxtg(n)=n
283 END DO
284 CALL my_orders(0,work,clef,stat_indxtg,stat_numeltg,2)
285C-----
286 iprt0=0
287 DO n=1,stat_numeltg
288 k=stat_indxtg(n)
289 jj=6*(k-1)
290 iprt=np(jj+5)
291 ioff=np(jj+6)
292 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
293 IF(iprt /= iprt0)THEN
294 WRITE(iugeo,'(A,I10)')'/SH3N/',ipart(4,iprt)
295 WRITE(iugeo,'(A)')
296 . '# SH3NID NOD1 NOD2 NOD3 THK'
297 iprt0=iprt
298 END IF
299 WRITE(iugeo,'(4I10,40X,1PE20.13)')
300 . np(jj+1),np(jj+2),np(jj+3),np(jj+4),thk(k)
301 ENDIF
302 END DO
303C-----
304C Specific adaptive meshing :
305 IF(nadmesh /=0)THEN
306 jj = 0
307 IF(numeltg/=0)THEN
308
309 DO ng=1,ngroup
310 ity =iparg(5,ng)
311 IF(ity==7) THEN
312 nel =iparg(2,ng)
313 nft =iparg(3,ng)
314 lft=1
315 llt=nel
316C
317 DO i=lft,llt
318 n = i + nft
319
320 iprt=iparttg(n)
321 IF(ipart_state(iprt)==0)cycle
322
323 np(jj+1) = ixtg(nixtg,n)
324 IF(sh3tree(2,n) /= 0)THEN
325 np(jj+2) = ixtg(nixtg,sh3tree(2,n) )
326 np(jj+3) = ixtg(nixtg,sh3tree(2,n)+1)
327 np(jj+4) = ixtg(nixtg,sh3tree(2,n)+2)
328 np(jj+5) = ixtg(nixtg,sh3tree(2,n)+3)
329 ELSE
330 np(jj+2) =0
331 np(jj+3) =0
332 np(jj+4) =0
333 np(jj+5) =0
334 END IF
335 np(jj+6) = sh3tree(3,n)
336 np(jj+7) = iprt
337 IF(lsh3trim /= 0)THEN
338 IF(sh3trim(n)==-1)THEN
339 np(jj+8) = -1
340 ELSE
341 np(jj+8) = 0
342 END IF
343 ELSE
344 np(jj+8) = 0
345 END IF
346 jj = jj + 8
347 END DO
348 END IF
349 END DO
350 END IF
351
352 iprt0=0
353 DO n=1,stat_numeltg
354 k=stat_indxtg(n)
355 jj=8*(k-1)
356 iprt=np(jj+7)
357 IF(iprt /= iprt0)THEN
358 WRITE(iugeo,'(A)')'/ADMESH/STATE/SH3N'
359 WRITE(iugeo,'(2A)')
360 . '# SH3NID ID1 ID2 ID3 ID4 LEVEL',
361 . ' IMAPPING'
362 iprt0=iprt
363 END IF
364 WRITE(iugeo,'(7I10)')
365 . np(jj+1),np(jj+2),np(jj+3),np(jj+4),np(jj+5),np(jj+6),np(jj+8)
366 END DO
367
368 END IF
369C-----------------------------------------------
370 DEALLOCATE(thk)
371 DEALLOCATE(clef)
372 DEALLOCATE(np)
373 RETURN
374 END
max
#define max(a, b)
Definition macros.h:21
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
stat_shel_mp
subroutine stat_shel_mp(itab, itabg, leng, ipart, igeo, ixc, ixtg, ipartc, iparttg, ipart_state, nodtag, stat_indxc, stat_indxtg, sh4tree, sh3tree, iparg, sh4trim, sh3trim, elbuf_tab, thke, idel)
Definition stat_shel_mp.F:38