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