OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_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!|| stat_shel_spmd ../engine/source/output/sta/stat_shel_spmd.F
25!||--- called by ------------------------------------------------------
26!|| genstat ../engine/source/output/sta/genstat.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!||--- uses -----------------------------------------------------
32!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!|| message_mod ../engine/share/message_module/message_mod.F
35!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
36!||====================================================================
37 SUBROUTINE stat_shel_spmd(ITAB,ITABG,LENG,IPART,IGEO,
38 . IXC,IXTG,IPARTC,IPARTTG,IPART_STATE,
39 . NODTAG,STAT_INDXC,STAT_INDXTG,LENGC,LENGTG,
40 . IPARG ,ELBUF_TAB,THKE,IDEL)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE elbufdef_mod
45 USE message_mod
46 USE my_alloc_mod
47 use element_mod , only : nixc,nixtg
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "param_c.inc"
58#include "scr16_c.inc"
59#include "scr17_c.inc"
60#include "spmd_c.inc"
61#include "task_c.inc"
62#include "units_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER ITAB(*), ITABG(*), LENG, IPART(LIPART1,*),
67 . IGEO(NPROPGI,*), IXC(NIXC,*), IXTG(NIXTG,*),
68 . IPARTC(*), IPARTTG(*), IPART_STATE(*),
69 . nodtag(*), stat_indxc(*), stat_indxtg(*),
70 . lengc, lengtg, iparg(nparg,*),idel
71 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
72 my_real
73 . THKE(*)
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I, N, JJ, IPRT, IPRT0, K, II
78 INTEGER NG, NEL, NFT, LFT, LLT, ITY, LEN, ITHK, MLW,IOFF
79 INTEGER WORK(70000)
80 INTEGER THK_LEN,THK0_LEN
81 INTEGER,DIMENSION(:),ALLOCATABLE :: IADD
82 INTEGER,DIMENSION(:,:),ALLOCATABLE :: IADG
83 INTEGER,DIMENSION(:),ALLOCATABLE :: NP
84 INTEGER,DIMENSION(:),ALLOCATABLE :: NPGLOB
85 INTEGER,DIMENSION(:,:),ALLOCATABLE :: CLEF
86 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: THK ! Gather Thickness from Shell & Triangle elements
87 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: THK0 ! ISPMD=0 : Shell & Triangle Thicknesses after gather.
88 TYPE(G_BUFEL_) ,POINTER :: GBUF
89C-----------------------------------------------
90 CALL my_alloc(np,max(7*numelc,6*numeltg))
91 CALL my_alloc(npglob,max(7*lengc,6*lengtg))
92 CALL my_alloc(clef,2,max(numelcg,numeltgg))
93 CALL my_alloc(iadg,nspmd,npart)
94 CALL my_alloc(iadd,npart+1)
95C-----------------------------------------------
96C INITIALIZATION
97C-----------------------------------------------
98 thk_len = max(1,max(numelc,numeltg))
99 ALLOCATE(thk(thk_len))
100 IF (ispmd == 0) THEN
101 thk0_len = max(1,max(numelcg,numeltgg))
102 ELSE
103 thk0_len=1
104 ENDIF
105 ALLOCATE(thk0(thk0_len))
106C-----------------------------------------------
107C 4-NODE SHELLS
108C-----------------------------------------------
109 iadd = 0
110 npglob(1:max(7*lengc,6*lengtg)) = 0
111C
112 jj = 0
113 ii = 0
114 DO ng=1,ngroup
115 ity =iparg(5,ng)
116 IF(ity==3) THEN
117 nel =iparg(2,ng)
118 nft =iparg(3,ng)
119 gbuf => elbuf_tab(ng)%GBUF
120 mlw =iparg(1,ng)
121 ithk =iparg(28,ng)
122 lft=1
123 llt=nel
124 DO i=lft,llt
125 n = i + nft
126
127 iprt=ipartc(n)
128 IF(ipart_state(iprt)==0)cycle
129
130 np(jj+1) = ixc(nixc,n)
131 np(jj+2) = itab(ixc(2,n))
132 np(jj+3) = itab(ixc(3,n))
133 np(jj+4) = itab(ixc(4,n))
134 np(jj+5) = itab(ixc(5,n))
135 np(jj+6) = iprt
136 np(jj+7) = iabs(nint(gbuf%OFF(i)))
137 ii = ii + 1
138 IF (mlw /= 0 .AND. mlw /= 13) THEN
139 IF (ithk >0 ) THEN
140 thk(ii) = gbuf%THK(i)
141 ELSE
142 thk(ii) = thke(n)
143 END IF
144 ELSE
145 thk(ii) = zero
146 ENDIF
147 jj = jj + 7
148
149 stat_numelc =stat_numelc+1
150
151 nodtag(ixc(2,n))=1
152 nodtag(ixc(3,n))=1
153 nodtag(ixc(4,n))=1
154 nodtag(ixc(5,n))=1
155 END DO
156 END IF
157 END DO
158C-----
159 stat_numelc_g=0
160 CALL spmd_iget_partn_sta(7,stat_numelc,stat_numelc_g,lengc,np,
161 . iadg,npglob,stat_indxc)
162 len = 0
163 CALL spmd_rgather9_dp(thk,ii,thk0,thk0_len,len)
164
165C-----
166 IF (ispmd==0) THEN
167 DO n=1,stat_numelc_g
168 stat_indxc(n)=n
169 clef(1,n)=npglob(7*(n-1)+7)
170 clef(2,n)=npglob(7*(n-1)+1)
171 END DO
172 CALL my_orders(0,work,clef,stat_indxc,stat_numelc_g,2)
173
174 iprt0=0
175 DO n=1,stat_numelc_g
176 k=stat_indxc(n)
177 jj=7*(k-1)
178 iprt=npglob(jj+6)
179 ioff=npglob(jj+7)
180 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
181 IF(iprt /= iprt0)THEN
182 WRITE(iugeo,'(A,I10)')'/SHELL/',ipart(4,iprt)
183 WRITE(iugeo,'(A)')
184 . '# SHELLID NOD1 NOD2 NOD3 NOD4 THK'
185 iprt0=iprt
186 END IF
187 WRITE(iugeo,'(5I10,30X,1PE20.13)')
188 . npglob(jj+1),
189 . npglob(jj+2),npglob(jj+3),npglob(jj+4),npglob(jj+5),thk0(k)
190 ENDIF
191 END DO
192 ENDIF
193C-----------------------------------------------
194C 3-NODE SHELLS
195C-----------------------------------------------
196 iadd = 0
197C
198 jj = 0
199 ii = 0
200 DO ng=1,ngroup
201 ity =iparg(5,ng)
202 IF(ity==7) THEN
203 nel =iparg(2,ng)
204 nft =iparg(3,ng)
205 gbuf => elbuf_tab(ng)%GBUF
206 mlw =iparg(1,ng)
207 ithk =iparg(28,ng)
208 lft=1
209 llt=nel
210C
211 DO i=lft,llt
212 n = i + nft
213
214 iprt=iparttg(n)
215 IF(ipart_state(iprt)==0)cycle
216
217 np(jj+1) = ixtg(nixtg,n)
218 np(jj+2) = itab(ixtg(2,n))
219 np(jj+3) = itab(ixtg(3,n))
220 np(jj+4) = itab(ixtg(4,n))
221 np(jj+5) = iprt
222 np(jj+6) = iabs(nint(gbuf%OFF(i)))
223 ii = ii + 1
224 IF (mlw /= 0 .AND. mlw /= 13) THEN
225 IF (ithk >0 ) THEN
226 thk(ii) = gbuf%THK(i)
227 ELSE
228 thk(ii) = thke(n)
229 END IF
230 ELSE
231 thk(ii) = zero
232 ENDIF
233
234 jj = jj + 6
235
236 stat_numeltg =stat_numeltg+1
237
238 nodtag(ixtg(2,n))=1
239 nodtag(ixtg(3,n))=1
240 nodtag(ixtg(4,n))=1
241 END DO
242 END IF
243 END DO
244C-----
245 stat_numeltg_g=0
246 CALL spmd_iget_partn_sta(6,stat_numeltg,stat_numeltg_g,lengtg,np,
247 . iadg,npglob,stat_indxtg)
248 len = 0
249 CALL spmd_rgather9_dp(thk,ii,thk0,thk0_len,len)
250C-----
251 IF (ispmd==0) THEN
252 DO n=1,stat_numeltg_g
253 stat_indxtg(n)=n
254 clef(1,n)=npglob(6*(n-1)+6)
255 clef(2,n)=npglob(6*(n-1)+1)
256 END DO
257 CALL my_orders(0,work,clef,stat_indxtg,stat_numeltg_g,2)
258
259 iprt0=0
260 DO n=1,stat_numeltg_g
261 k=stat_indxtg(n)
262 jj=6*(k-1)
263 iprt=npglob(jj+5)
264 ioff=npglob(jj+6)
265 IF(idel==0.OR.(idel==1.AND.ioff >= 1)) THEN
266 IF(iprt /= iprt0)THEN
267 WRITE(iugeo,'(A,I10)')'/SH3N/',ipart(4,iprt)
268 WRITE(iugeo,'(A)')
269 . '# SH3NID NOD1 NOD2 NOD3 THK'
270 iprt0=iprt
271 END IF
272 WRITE(iugeo,'(4I10,40X,1PE20.13)')
273 . npglob(jj+1),
274 . npglob(jj+2),npglob(jj+3),npglob(jj+4),thk0(k)
275 ENDIF
276 END DO
277 ENDIF
278
279 DEALLOCATE(thk)
280 DEALLOCATE(thk0)
281 DEALLOCATE(np)
282 DEALLOCATE(npglob)
283 DEALLOCATE(clef)
284 DEALLOCATE(iadg)
285 DEALLOCATE(iadd)
286C-----------------------------------------------
287 RETURN
288 END
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
message_mod
Definition message_mod.F:1257
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
stat_shel_spmd
subroutine stat_shel_spmd(itab, itabg, leng, ipart, igeo, ixc, ixtg, ipartc, iparttg, ipart_state, nodtag, stat_indxc, stat_indxtg, lengc, lengtg, iparg, elbuf_tab, thke, idel)
Definition stat_shel_spmd.F:41