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