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