OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dynain_shel_mp.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dynain_shel_mp (itab, itabg, leng, igeo, ixc, ixtg, ipartc, iparttg, dynain_data, nodtag, dynain_indxc, dynain_indxtg, iparg, elbuf_tab, thke, ipart)

Function/Subroutine Documentation

◆ dynain_shel_mp()

subroutine dynain_shel_mp ( integer, dimension(*) itab,
integer, dimension(*) itabg,
integer leng,
integer, dimension(npropgi,*) igeo,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
type (dynain_database), intent(inout) dynain_data,
integer, dimension(*) nodtag,
integer, dimension(*) dynain_indxc,
integer, dimension(*) dynain_indxtg,
integer, dimension(nparg,*) iparg,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
thke,
integer, dimension(lipart1,*) ipart )

Definition at line 34 of file dynain_shel_mp.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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