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