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