OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_c_thk.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine stat_c_thk (elbuf_tab, iparg, ipm, igeo, ixc, ixtg, wa, wap0, ipartc, iparttg, ipart_state, stat_indxc, stat_indxtg, thke, sizp0)

Function/Subroutine Documentation

◆ stat_c_thk()

subroutine stat_c_thk ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
integer, dimension(npropmi,*) ipm,
integer, dimension(npropgi,*) igeo,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
double precision, dimension(*) wa,
double precision, dimension(*) wap0,
integer, dimension(*) ipartc,
integer, dimension(*) iparttg,
integer, dimension(*) ipart_state,
integer, dimension(*) stat_indxc,
integer, dimension(*) stat_indxtg,
thke,
integer sizp0 )

Definition at line 33 of file stat_c_thk.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
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