OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_c_thk.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_c_thk ../engine/source/output/sta/stat_c_thk.F
25!||--- called by ------------------------------------------------------
26!|| genstat ../engine/source/output/sta/genstat.F
27!||--- calls -----------------------------------------------------
28!|| spmd_rgather9_dp ../engine/source/mpi/interfaces/spmd_outp.F
29!|| strs_txt50 ../engine/source/output/sta/sta_txt.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!||====================================================================
34 SUBROUTINE stat_c_thk(ELBUF_TAB,IPARG ,IPM ,IGEO ,IXC ,
35 2 IXTG ,WA,WAP0 ,IPARTC, IPARTTG,
36 3 IPART_STATE,STAT_INDXC,STAT_INDXTG ,
37 4 THKE ,SIZP0)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE elbufdef_mod
42 use element_mod , only : nixc,nixtg
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 "units_c.inc"
54#include "task_c.inc"
55#include "scr14_c.inc"
56#include "scr16_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER SIZP0
61 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),
62 . IPARG(NPARG,*),IPM(NPROPMI,*),IGEO(NPROPGI,*),
63 . ipartc(*), iparttg(*), ipart_state(*),
64 . stat_indxc(*), stat_indxtg(*)
65 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
66 my_real
67 . THKE(*)
68 double precision WA(*),WAP0(*)
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER I, N, J, JJ, LEN, K, IOFF
73 INTEGER NG, NEL, NFT, ITY, LFT,
74 . LLT, MLW, IPRT
75 INTEGER ID,ITHK
76 double precision
77 . THK
78 CHARACTER*100 LINE
79 TYPE(g_bufel_) ,POINTER :: GBUF
80C-----------------------------------------------
81C 4-NODE SHELLS
82C-----------------------------------------------
83 jj = 0
84 IF(stat_numelc==0) GOTO 200
85
86 DO ng=1,ngroup
87 ity =iparg(5,ng)
88 IF(ity==3) THEN
89 gbuf => elbuf_tab(ng)%GBUF
90 mlw =iparg(1,ng)
91 nel =iparg(2,ng)
92 nft =iparg(3,ng)
93 ithk =iparg(28,ng)
94 lft =1
95 llt =nel
96
97 DO i=lft,llt
98 n = i + nft
99
100 iprt=ipartc(n)
101 IF(ipart_state(iprt)==0)cycle
102
103 jj = jj + 1
104 IF (mlw /= 0 .AND. mlw /= 13) THEN
105 wa(jj) = gbuf%OFF(i)
106 ELSE
107 wa(jj) = zero
108 ENDIF
109 jj = jj + 1
110 wa(jj) = ixc(nixc,n)
111 jj = jj + 1
112 IF (mlw /= 0 .AND. mlw /= 13) THEN
113 IF (ithk >0 ) THEN
114 wa(jj) = gbuf%THK(i)
115 ELSE
116 wa(jj) = thke(n)
117 END IF
118 ELSE
119 wa(jj) = zero
120 ENDIF
121 ENDDO
122 ENDIF
123 ENDDO
124
125 200 CONTINUE
126
127 IF(nspmd == 1)THEN
128 len=jj
129 DO j=1,len
130 wap0(j)=wa(j)
131 END DO
132 ELSE
133 len = 0
134 CALL spmd_rgather9_dp(wa,jj,wap0,sizp0,len)
135 END IF
136
137 IF(ispmd==0.AND.len>0) THEN
138 IF (izipstrs == 0) THEN
139 WRITE(iugeo,'(A)')'/INISHE/THICK'
140 WRITE(iugeo,'(A)')
141 . '# SHELLID THK'
142 ELSE
143 WRITE(line,'(A)')'/INISHE/THICK'
144 CALL strs_txt50(line,100)
145 WRITE(line,'(A)')
146 . '# SHELLID THK'
147 CALL strs_txt50(line,100)
148 END IF
149
150 DO n=1,stat_numelc_g
151 k=stat_indxc(n)
152 j=3*(k-1)
153 ioff = nint(wap0(j + 1))
154 IF(ioff >= 1)THEN
155 id =nint(wap0(j+2))
156 thk =wap0(j+3)
157 IF (izipstrs == 0) THEN
158 WRITE(iugeo,'(I10,20X,1PE20.13)')id,thk
159 ELSE
160 WRITE(line,'(I10,20X,1PE20.13)')id,thk
161 CALL strs_txt50(line,100)
162 END IF
163 END IF
164 END DO
165
166 ENDIF
167
168C-----------------------------------------------
169C 3-NODE SHELLS
170C-----------------------------------------------
171 jj = 0
172 IF(stat_numeltg==0) GOTO 300
173
174 DO ng=1,ngroup
175 ity =iparg(5,ng)
176 IF(ity==7) THEN
177 gbuf => elbuf_tab(ng)%GBUF
178 mlw =iparg(1,ng)
179 nel =iparg(2,ng)
180 nft =iparg(3,ng)
181 ithk =iparg(28,ng)
182
183 lft =1
184 llt =nel
185 DO i=lft,llt
186 n = i + nft
187
188 iprt=iparttg(n)
189 IF(ipart_state(iprt)==0)cycle
190
191 jj = jj + 1
192 IF (mlw /= 0 .AND. mlw /= 13) THEN
193 wa(jj) = gbuf%OFF(i)
194 ELSE
195 wa(jj) = zero
196 ENDIF
197 jj = jj + 1
198 wa(jj) = ixtg(nixtg,n)
199 jj = jj + 1
200 IF (mlw /= 0 .AND. mlw /= 13) THEN
201 IF (ithk >0 ) THEN
202 wa(jj) = gbuf%THK(i)
203 ELSE
204 wa(jj) = thke(n+numelc)
205 END IF
206 ELSE
207 wa(jj) = zero
208 ENDIF
209 ENDDO
210 ENDIF
211 ENDDO
212
213 300 CONTINUE
214
215 IF(nspmd == 1)THEN
216 len=jj
217 DO j=1,len
218 wap0(j)=wa(j)
219 END DO
220 ELSE
221 len = 0
222 CALL spmd_rgather9_dp(wa,jj,wap0,sizp0,len)
223 END IF
224
225 IF(ispmd==0.AND.len>0) THEN
226 IF (izipstrs == 0) THEN
227 WRITE(iugeo,'(A)')'/INISH3/THICK'
228 WRITE(iugeo,'(A)')
229 . '# SH3NID THK'
230 ELSE
231 WRITE(line,'(A)')'/INISH3/THICK'
232 CALL strs_txt50(line,100)
233 WRITE(line,'(A)')
234 . '# SH3NID THK'
235 CALL strs_txt50(line,100)
236 END IF
237
238 DO n=1,stat_numeltg_g
239 k=stat_indxtg(n)
240 j=3*(k-1)
241 ioff = nint(wap0(j + 1))
242 IF(ioff >= 1)THEN
243 id =nint(wap0(j+2))
244 thk =wap0(j+3)
245 IF (izipstrs == 0) THEN
246 WRITE(iugeo,'(I10,20X,1PE20.13)')id,thk
247 ELSE
248 WRITE(line,'(I10,20X,1PE20.13)')id,thk
249 CALL strs_txt50(line,100)
250 END IF
251 END IF
252 END DO
253 ENDIF
254
255 RETURN
256 END
spmd_rgather9_dp
subroutine spmd_rgather9_dp(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:1019
strs_txt50
subroutine strs_txt50(text, length)
Definition sta_txt.F:87
stat_c_thk
subroutine stat_c_thk(elbuf_tab, iparg, ipm, igeo, ixc, ixtg, wa, wap0, ipartc, iparttg, ipart_state, stat_indxc, stat_indxtg, thke, sizp0)
Definition stat_c_thk.F:38