OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dynain_shel_spmd.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 "spmd_c.inc"
#include "task_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ dynain_shel_spmd()

subroutine dynain_shel_spmd ( 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 lengc,
integer lengtg,
integer, dimension(lipart1,*) ipart )

Definition at line 37 of file dynain_shel_spmd.F.

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
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
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
strs_txt50
subroutine strs_txt50(text, length)
Definition sta_txt.F:87