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