OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dynain_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!|| dynain_shel_mp ../engine/source/output/dynain/dynain_shel_mp.F
25!||--- called by ------------------------------------------------------
26!|| gendynain ../engine/source/output/dynain/gendynain.F
27!||--- calls -----------------------------------------------------
28!|| my_orders ../common_source/tools/sort/my_orders.c
29!|| strs_txt50 ../engine/source/output/sta/sta_txt.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!|| state_mod ../common_source/modules/state_mod.F
34!||====================================================================
35 SUBROUTINE dynain_shel_mp(ITAB ,ITABG ,LENG ,IGEO ,IXC ,
36 . IXTG ,IPARTC ,IPARTTG ,DYNAIN_DATA ,
37 . NODTAG ,DYNAIN_INDXC,DYNAIN_INDXTG,IPARG ,
38 . ELBUF_TAB,THKE ,IPART )
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE elbufdef_mod
43 USE state_mod
44 use element_mod , only : nixc,nixtg
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C C o m m o n B l o c k s
51C-----------------------------------------------
52#include "com01_c.inc"
53#include "com04_c.inc"
54#include "param_c.inc"
55#include "scr16_c.inc"
56#include "scr17_c.inc"
57#include "units_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER ITAB(*), ITABG(*), LENG, IGEO(NPROPGI,*),
62 . IXC(NIXC,*), IXTG(NIXTG,*),IPARTC(*), IPARTTG(*),
63 . NODTAG(*) , DYNAIN_INDXC(*) ,DYNAIN_INDXTG(*),
64 . iparg(nparg,*),ipart(lipart1,*)
65
66 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
67 my_real
68 . THKE(*)
69 TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I, N, JJ, IPRT, K, II
74 INTEGER NG, NEL, NFT, LFT, LLT, ITY, MLW, ITHK,IOFF,
75 . IPROP,ID_PROP,IERR , N4SHELL, N3SHELL, IGTYP, IGTYP0
76 INTEGER WORK(70000)
77 INTEGER , DIMENSION(:),ALLOCATABLE :: NPC , NPTG
78 INTEGER , DIMENSION(:,:),ALLOCATABLE :: CLEF
79 double precision THKN ,BETA
80 double precision , DIMENSION(:),ALLOCATABLE :: THKC , THKTG ,BETAC , BETATG
81 TYPE(g_bufel_) ,POINTER :: GBUF
82 CHARACTER*100 LINE
83C--------------------------------------------------------
84
85C-----------------------
86C Allocation Tabs
87C-----------------------
88 ALLOCATE(npc(8*numelc),stat=ierr)
89 ALLOCATE(nptg(7*numeltg),stat=ierr)
90 ALLOCATE(clef(2,max(numelc,numeltg)),stat=ierr)
91 ALLOCATE(thkc(numelc),stat=ierr)
92 ALLOCATE(thktg(numeltg),stat=ierr)
93 ALLOCATE(betac(numelc),stat=ierr)
94 ALLOCATE(betatg(numeltg),stat=ierr)
95C-----------------------------------------------
96C 4-NODE SHELLS
97C-----------------------------------------------
98 jj = 0
99 ii = 0
100
101 IF(numelc/=0)THEN
102
103 DO ng=1,ngroup
104 ity =iparg(5,ng)
105 IF(ity==3) THEN
106 nel =iparg(2,ng)
107 nft =iparg(3,ng)
108 gbuf => elbuf_tab(ng)%GBUF
109 mlw =iparg(1,ng)
110 iprop =iparg(62,ng)
111 ithk =iparg(28,ng)
112 id_prop=igeo(1,iprop)
113 igtyp= iparg(38,ng)
114 IF(igtyp/= 1) igtyp = 2
115 lft=1
116 llt=nel
117
118 DO i=lft,llt
119 n = i + nft
120
121 iprt=ipartc(n)
122 IF(dynain_data%IPART_DYNAIN(iprt)==0)cycle
123
124 npc(jj+1) = ixc(nixc,n)
125 npc(jj+2) = itab(ixc(2,n))
126 npc(jj+3) = itab(ixc(3,n))
127 npc(jj+4) = itab(ixc(4,n))
128 npc(jj+5) = itab(ixc(5,n))
129 npc(jj+6) = ipart(4,iprt)
130 npc(jj+7) = nint(gbuf%OFF(i))
131 npc(jj+8) = igtyp
132 ii = ii + 1
133 IF (mlw /= 0 .AND. mlw /= 13) THEN
134 IF (ithk >0 ) THEN
135 thkc(ii) = gbuf%THK(i)
136 ELSE
137 thkc(ii) = thke(n)
138 END IF
139 ELSE
140 thkc(ii) = zero
141 ENDIF
142 jj = jj + 8
143
144 dynain_data%DYNAIN_NUMELC = dynain_data%DYNAIN_NUMELC+1
145
146 clef(1,dynain_data%DYNAIN_NUMELC)=igtyp
147 clef(2,dynain_data%DYNAIN_NUMELC)=ixc(nixc,n)
148
149 nodtag(ixc(2,n))=1
150 nodtag(ixc(3,n))=1
151 nodtag(ixc(4,n))=1
152 nodtag(ixc(5,n))=1
153
154 IF(igtyp /= 1) THEN
155 betac(ii) = (hundred80*acos(gbuf%BETAORTH(i)))/pi
156 ENDIF
157
158
159 END DO
160 END IF
161 END DO
162 END IF
163C----
164 DO n=1,dynain_data%DYNAIN_NUMELC
165 dynain_indxc(n)=n
166 END DO
167 CALL my_orders(0,work,clef,dynain_indxc,dynain_data%DYNAIN_NUMELC,2)
168
169
170C-----------------------------------------------
171C 3-NODE SHELLS
172C-----------------------------------------------
173 jj = 0
174 ii = 0
175 IF(numeltg/=0)THEN
176 DO ng=1,ngroup
177 ity =iparg(5,ng)
178 IF(ity==7) THEN
179 nel =iparg(2,ng)
180 nft =iparg(3,ng)
181 gbuf => elbuf_tab(ng)%GBUF
182 mlw =iparg(1,ng)
183 ithk =iparg(28,ng)
184 iprop =iparg(62,ng)
185 id_prop=igeo(1,iprop)
186 igtyp= iparg(38,ng)
187 IF(igtyp/= 1) igtyp = 2
188 lft=1
189 llt=nel
190C
191 DO i=lft,llt
192 n = i + nft
193
194 iprt=iparttg(n)
195 IF(dynain_data%IPART_DYNAIN(iprt)==0)cycle
196
197 nptg(jj+1) = ixtg(nixtg,n)
198 nptg(jj+2) = itab(ixtg(2,n))
199 nptg(jj+3) = itab(ixtg(3,n))
200 nptg(jj+4) = itab(ixtg(4,n))
201 nptg(jj+5) = ipart(4,iprt)
202 nptg(jj+6) = nint(gbuf%OFF(i))
203 nptg(jj+7) = igtyp
204 ii = ii + 1
205 IF (mlw /= 0 .AND. mlw /= 13) THEN
206 IF (ithk >0 ) THEN
207 thktg(ii) = gbuf%THK(i)
208 ELSE
209 thktg(ii) = thke(n)
210 END IF
211 ELSE
212 thktg(ii) = zero
213 ENDIF
214 jj = jj + 7
215
216 dynain_data%DYNAIN_NUMELTG =dynain_data%DYNAIN_NUMELTG+1
217
218 clef(1,dynain_data%DYNAIN_NUMELTG)=igtyp
219 clef(2,dynain_data%DYNAIN_NUMELTG)=ixtg(nixtg,n)
220
221 nodtag(ixtg(2,n))=1
222 nodtag(ixtg(3,n))=1
223 nodtag(ixtg(4,n))=1
224
225 IF(igtyp /= 1) THEN
226 betatg(ii) = (hundred80*acos(gbuf%BETAORTH(i)))/pi
227 ENDIF
228
229 END DO
230 END IF
231 END DO
232 END IF
233
234C-----
235 DO n=1,dynain_data%DYNAIN_NUMELTG
236 dynain_indxtg(n)=n
237 END DO
238 CALL my_orders(0,work,clef,dynain_indxtg,dynain_data%DYNAIN_NUMELTG,2)
239C-----------------------------------------------------------
240C Output
241C------------------------------------------------------------
242
243C---------Non Orthotropic elements ------------
244
245 igtyp0 = 0
246 DO n=1,dynain_data%DYNAIN_NUMELC
247 k=dynain_indxc(n)
248 jj=8*(k-1)
249 ioff=npc(jj+7)
250 igtyp = npc(jj+8)
251 thkn = thkc(k)
252 IF(ioff >= 1) THEN
253 IF(igtyp==1) THEN
254 IF(igtyp/=igtyp0) THEN
255 IF(dynain_data%ZIPDYNAIN==0) THEN
256 WRITE(iudynain,'(A)')'*ELEMENT_SHELL_THICKNESS'
257 WRITE(iudynain,'(A)')
258 . '$SHELLID PART_ID NOD1 NOD2 NOD3 NOD4'
259 WRITE(iudynain,'(A)')
260 . '$ THIC1 THIC2 THIC3 THIC4'
261 ELSE
262 WRITE(line,'(A)') '*ELEMENT_SHELL_THICKNESS'
263 CALL strs_txt50(line,100)
264 WRITE(line,'(A)')
265 . '$SHELLID PART_ID NOD1 NOD2 NOD3 NOD4'
266 CALL strs_txt50(line,100)
267 WRITE(line,'(A)')
268 . '$ THIC1 THIC2 THIC3 THIC4'
269 CALL strs_txt50(line,100)
270 ENDIF
271 igtyp0 = igtyp
272 ENDIF
273
274 IF(dynain_data%ZIPDYNAIN==0) THEN
275 WRITE(iudynain,'(6I8)')
276 . npc(jj+1),npc(jj+6),npc(jj+2),npc(jj+3),npc(jj+4),npc(jj+5)
277 WRITE(iudynain,'(1P4G16.9)')
278 . thkn,thkn,thkn,thkn
279 ELSE
280 WRITE(line,'(6I8)')
281 . npc(jj+1),npc(jj+6),npc(jj+2),npc(jj+3),npc(jj+4),npc(jj+5)
282 CALL strs_txt50(line,100)
283 WRITE(line,'(1P4G16.9)')
284 . thkn,thkn,thkn,thkn
285 CALL strs_txt50(line,100)
286 ENDIF
287
288 ELSE
289 EXIT
290 ENDIF
291 ENDIF
292
293 END DO
294
295 n4shell = n
296
297 DO n=1,dynain_data%DYNAIN_NUMELTG
298 k=dynain_indxtg(n)
299 jj=7*(k-1)
300 ioff=nptg(jj+6)
301 igtyp = nptg(jj+7)
302 thkn = thktg(k)
303 IF(ioff >= 1) THEN
304 IF(igtyp==1) THEN
305 IF(dynain_data%ZIPDYNAIN==0) THEN
306 WRITE(iudynain,'(5I8)')
307 . nptg(jj+1),nptg(jj+5),nptg(jj+2),nptg(jj+3),nptg(jj+4)
308 WRITE(iudynain,'(1P3G16.9)')
309 . thkn,thkn,thkn
310 ELSE
311 WRITE(line,'(5I8)')
312 . nptg(jj+1),nptg(jj+5),nptg(jj+2),nptg(jj+3),nptg(jj+4)
313 CALL strs_txt50(line,100)
314 WRITE(line,'(1P3G16.9)')
315 . thkn,thkn,thkn
316 CALL strs_txt50(line,100)
317 ENDIF
318 ELSE
319 EXIT
320 ENDIF
321 ENDIF
322 END DO
323 n3shell = n
324
325C--------- Orthotropic elements ------------
326
327 igtyp0 = 1
328 DO n=n4shell,dynain_data%DYNAIN_NUMELC
329 k=dynain_indxc(n)
330 jj=8*(k-1)
331 ioff=npc(jj+7)
332 igtyp = npc(jj+8)
333 thkn = thkc(k)
334 beta = betac(k)
335 IF(ioff >= 1) THEN
336 IF(igtyp/=igtyp0) THEN
337 igtyp0 = igtyp
338 IF(dynain_data%ZIPDYNAIN==0) THEN
339 WRITE(iudynain,'(A)')'*ELEMENT_SHELL_THICKNESS_BETA'
340 WRITE(iudynain,'(A)')
341 . '$SHELLID PART_ID NOD1 NOD2 NOD3 NOD4'
342 WRITE(iudynain,'(A)')
343 . '$ THIC1 THIC2 THIC3 THIC4 BETA'
344 ELSE
345 WRITE(line,'(A)') '*ELEMENT_SHELL_THICKNESS_BETA'
346 CALL strs_txt50(line,100)
347 WRITE(line,'(A)')
348 . '$SHELLID PART_ID NOD1 NOD2 NOD3 NOD4'
349 CALL strs_txt50(line,100)
350 WRITE(line,'(a)')
351 . '$ thic1 thic2 thic3 thic4 beta'
352 CALL STRS_TXT50(LINE,100)
353 ENDIF
354 ENDIF
355 IF(DYNAIN_DATA%ZIPDYNAIN==0) THEN
356 WRITE(IUDYNAIN,'(6i8)')
357 . NPC(JJ+1),NPC(JJ+6),NPC(JJ+2),NPC(JJ+3),NPC(JJ+4),NPC(JJ+5)
358 WRITE(IUDYNAIN,'(1p5g16.9)')
359 . THKN,THKN,THKN,THKN,BETA
360 ELSE
361 WRITE(LINE,'(6i8)')
362 . NPC(JJ+1),NPC(JJ+6),NPC(JJ+2),NPC(JJ+3),NPC(JJ+4),NPC(JJ+5)
363 CALL STRS_TXT50(LINE,100)
364 WRITE(LINE,'(1p5g16.9)')
365 . THKN,THKN,THKN,THKN,BETA
366 CALL STRS_TXT50(LINE,100)
367 ENDIF
368 ENDIF
369
370 END DO
371
372
373 DO N=N3SHELL,DYNAIN_DATA%DYNAIN_NUMELTG
374 K=DYNAIN_INDXTG(N)
375 JJ=7*(K-1)
376 IOFF=NPTG(JJ+6)
377 THKN = THKTG(K)
378 BETA = BETATG(K)
379 IF(IOFF >= 1) THEN
380 IF(DYNAIN_DATA%ZIPDYNAIN==0) THEN
381 WRITE(IUDYNAIN,'(5i8)')
382 . NPTG(JJ+1),NPTG(JJ+5),NPTG(JJ+2),NPTG(JJ+3),NPTG(JJ+4)
383 WRITE(IUDYNAIN,'(1p3g16.9,16x,1pg16.9)')
384 . THKN,THKN,THKN,BETA
385 ELSE
386 WRITE(LINE,'(5i8)')
387 . NPC(JJ+1),NPC(JJ+6),NPC(JJ+2),NPC(JJ+3),NPC(JJ+4)
388 CALL STRS_TXT50(LINE,100)
389 WRITE(LINE,'(1p3g16.9,16x,1pg16.9)')
390 . THKN,THKN,THKN,BETA
391 CALL STRS_TXT50(LINE,100)
392 ENDIF
393 ENDIF
394 END DO
395
396
397C-----------------------
398C DEAllocation Tabs
399C-----------------------
400 DEALLOCATE(NPC,NPTG,CLEF,THKC,THKTG,BETAC,BETATG)
401C-----------------------------------------------
402
403 RETURN
404 END
dynain_shel_mp
subroutine dynain_shel_mp(itab, itabg, leng, igeo, ixc, ixtg, ipartc, iparttg, dynain_data, nodtag, dynain_indxc, dynain_indxtg, iparg, elbuf_tab, thke, ipart)
Definition dynain_shel_mp.F:39
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
state_mod
Definition state_mod.F:54
strs_txt50
subroutine strs_txt50(text, length)
Definition sta_txt.F:87