OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
thsph.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!|| thsph ../engine/source/output/th/thsph.F
25!||--- called by ------------------------------------------------------
26!|| hist2 ../engine/source/output/th/hist2.F
27!||--- calls -----------------------------------------------------
28!|| initbuf ../engine/share/resol/initbuf.F
29!||--- uses -----------------------------------------------------
30!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
31!|| initbuf_mod ../engine/share/resol/initbuf.F
32!||====================================================================
33 SUBROUTINE thsph(ELBUF_TAB, NTHGRP2, ITHGRP, IPARG, ITHBUF,
34 1 SPBUF , KXSP, NOD2SP, PM, WA )
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE initbuf_mod
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 "vect01_c.inc"
48#include "com01_c.inc"
49#include "sphcom.inc"
50#include "task_c.inc"
51#include "param_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER IPARG(NPARG,*),ITHBUF(*),KXSP(NISP,*),NOD2SP(*)
56 INTEGER, INTENT(in) :: NTHGRP2
57 INTEGER, DIMENSION(NITHGR,*), INTENT(in) :: ITHGRP
58
59 my_real
60 . wa(*),spbuf(nspbuf,*),pm(npropm,*)
61
62 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET ::
63 . elbuf_tab
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER II,JJ, I, J, N, IH, NG, MTE,
68 . k, ist, ip, l, lwa, nel,kk(6)
69 INTEGER :: NITER,IADR,NN,IADV,NVAR,ITYP,IJK
70
71 my_real
72 . wwa(100)
73
74 TYPE(g_bufel_) ,POINTER :: GBUF
75 TYPE(l_bufel_) ,POINTER :: LBUF
76C-----------------------------------------------
77C D e s c r i p t i o n
78C-----------------------------------------------
79C Time History output for SPH cells.
80C
81C-------------------------
82C SMOOTH PARTICLES (CELLS).
83C-------------------------
84C VAR(OLD) KEY DESCRIPTION [MAT LAW]
85C
86C 1 OFF
87C 2 SX SIGX
88C 3 SY SIGY
89C 4 SZ SIGZ
90C 5 SXY SIGXY
91C 6 SYZ SIGYZ
92C 7 SXZ SIGZX
93C 8 IE INTERNAL ENERGIE / VOLUME0
94C 9 DENS DENSITY
95C 10 WFVIS ARTIFICIAL VISCOSITY FORCES WORK
96C 11 VOL VOLUME (ALE) OR INITIAL VOLUME (LAG)
97C 12 PLAS EPS PLASTIQUE [2,3,4,7,8,9,16,22,23,26,33-38]
98C 13 TEMP TEMPERATURE [4,6,7,8,9,11,16,17,26,33-38]
99C 14 PLSR STRAIN RATE [4,7,8,9,16,26,33-38]
100C 15 DAMA1 DAMAGE 1 [14]
101C 16 DAMA2 DAMAGE 2 [14]
102C 17 DAMA3 DAMAGE 3 [14]
103C 18 DAMA4 DAMAGE 4 [14]
104C 19 DAMA DAMAGE [24]
105C 20(14) SA1 STRESS RE1 [24]
106C 21(15) SA2 STRESS RE2 [24]
107C 22(16) SA3 STRESS RE3 [24]
108C 23(17) CR CRACKS VOL [24]
109C 24(18) CAP CAP PARAM [24]
110C 25(13) K0 HARD. PARAM [24]
111C 26(12) RK TURBUL. ENER. [6,11,17]
112C 27(14) TD TURBUL. DISS. [6,11,17]
113C 28(14) EFIB FIBER STRAIN [14]
114C 29(16) ISTA PHASE STATE [16]
115C 30(12) VPLA VOL. EPS PLA. [10,21]
116C 31(12) BFRAC BURN FRACTION [5,51]
117C 32(12) WPLA PLAS. WORK [14]
118C 35 LSX SIGMA-X IN LOCAL SYSTEM (ONLY BRICKS)
119C 36 LSY SIGMA-Y IN LOCAL SYSTEM (ONLY BRICKS)
120C 37 LSZ SIGMA-Z IN LOCAL SYSTEM (ONLY BRICKS)
121C 38 LSXY SIGMA-XY IN LOCAL SYSTEM (ONLY BRICKS)
122C 39 LSYZ SIGMA-YZ IN LOCAL SYSTEM (ONLY BRICKS)
123C 40 LSXZ SIGMA-XZ IN LOCAL SYSTEM (ONLY BRICKS)
124C 41 DIAMETER PARTICLE DIAMETER
125C======================================================================|
126
127
128 ijk = 0
129 DO niter=1,nthgrp2
130 ityp=ithgrp(2,niter)
131 nn =ithgrp(4,niter)
132 iadr =ithgrp(5,niter)
133 nvar=ithgrp(6,niter)
134 iadv=ithgrp(7,niter)
135 ii=0
136 IF(ityp==51)THEN
137! -------------------------------
138 ii=0
139 ih=iadr
140
141 DO WHILE((ithbuf(ih+nn)/=ispmd).AND.(ih<iadr+nn))
142 ih = ih + 1
143 ENDDO
144 IF (ih>=iadr+nn) GOTO 666
145 DO ng=1,ngroup
146 ity=iparg(5,ng)
147
148 IF(ity==51.OR.ity==52) THEN
149 CALL initbuf(iparg ,ng ,
150 2 mte ,nel ,nft ,iad ,ity ,
151 3 npt ,jale ,ismstr ,jeul ,jtur ,
152 4 jthe ,jlag ,jmult ,jhbe ,jivf ,
153 5 nvaux ,jpor ,jcvt ,jclose ,jplasol ,
154 6 irep ,iint ,igtyp ,israt ,isrot ,
155 7 icsen ,isorth ,isorthg ,ifailure,jsms )
156 gbuf => elbuf_tab(ng)%GBUF
157 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
158
159 DO i=1,6
160 kk(i) = nel*(i-1)
161 ENDDO
162
163 DO i=1,nel
164 n=i+nft
165 jj = 6*(i-1)
166 k=ithbuf(ih)
167 ip=ithbuf(ih+nn)
168
169 IF (k==n)THEN
170 ih=ih+1
171 !---spmd specific treatment---!
172 !---search for ii---!
173 ii = ((ih-1) - iadr)*nvar
174 DO WHILE((ithbuf(ih+nn)/=ispmd).AND.(ih<iadr+nn))
175 ih = ih + 1
176 ENDDO
177 IF(ih>iadr+nn) GOTO 666
178 !---PROP type VOID ---!
179 DO l=1,100
180 wwa(l)=zero
181 ENDDO
182 !-----------
183 wwa(1) = gbuf%OFF(i)
184 wwa(8) = gbuf%EINT(i)
185 wwa(9) = gbuf%RHO(i)
186 !artificial viscosity forces work.
187 wwa(10)= spbuf(10,k)
188 wwa(11)= gbuf%VOL(i)
189 wwa(2 )= gbuf%SIG(kk(1)+i)
190 wwa(3 )= gbuf%SIG(kk(2)+i)
191 wwa(4 )= gbuf%SIG(kk(3)+i)
192 wwa(5 )= gbuf%SIG(kk(4)+i)
193 wwa(6 )= gbuf%SIG(kk(5)+i)
194 wwa(7 )= gbuf%SIG(kk(6)+i)
195 !-----------
196 GO TO (150,102,102,104,105,106,104,104,104,110,
197 . 106,150,150,114,150,104,106,118,150,120,
198 . 110,102,102,124,150,104,150,150,104,104,
199 . 104,104,104,104,104,104,104,104,104,104,
200 . 104,104,104,104,104,104,104,104,104,104),mte
201 GO TO 150
202 102 wwa(12)=gbuf%PLA(i)
203 GO TO 150
204 104 CONTINUE
205 IF (gbuf%G_PLA/=0) wwa(12)=gbuf%PLA(i)
206 IF (gbuf%G_EPSD/=0)wwa(14)=gbuf%EPSD(i)
207 IF (jthe /= 0) wwa(13)=gbuf%TEMP(i)
208 GOTO 150
209 105 wwa(31)=gbuf%BFRAC(i)
210 GOTO 150
211 106 IF (jthe /= 0) wwa(13)=lbuf%TEMP(i)
212 wwa(26)=lbuf%RK(i)
213 wwa(27)=lbuf%RE(i)
214 GOTO 150
215 110 wwa(30)=gbuf%PLA(i)
216 GO TO 150
217 114 wwa(32)=lbuf%PLA(i) !N1
218 wwa(33)=lbuf%SIGF(i) !N2
219 wwa(28)=lbuf%EPSF(i) !N3
220 wwa(15)=lbuf%DAM(kk(1)+i) !N4
221 wwa(16)=lbuf%DAM(kk(2)+i)
222 wwa(17)=lbuf%DAM(kk(3)+i)
223 wwa(18)=lbuf%DAM(kk(4)+i)
224 wwa(34)=lbuf%DAM(kk(5)+i)
225 GOTO 150
226 118 IF (jthe /= 0) wwa(13)= lbuf%TEMP(i)
227 GOTO 150
228 120 wwa(12)=zero
229 wwa(13)=zero
230 GOTO 150
231 124 wwa(19)=lbuf%DAM(kk(1)+i)+lbuf%DAM(kk(2)+i)+lbuf%DAM(kk(3)+i)
232 wwa(20)=lbuf%SIGA(kk(1)+i)
233 wwa(21)=lbuf%SIGA(kk(2)+i)
234 wwa(22)=lbuf%SIGA(kk(3)+i)
235 wwa(23)=lbuf%CRAK(kk(1)+i)+lbuf%CRAK(kk(2)+i)+lbuf%CRAK(kk(3)+i)
236 wwa(24)=lbuf%DSUM(i)
237 wwa(25)=lbuf%VK(i)
238 150 CONTINUE
239 !---diameter---!
240 wwa(41)=spbuf(1,k)
241
242 DO l=iadv,iadv+nvar-1
243 k=ithbuf(l)
244 ijk=ijk+1
245 wa(ijk)=wwa(k)
246 ENDDO
247 ijk = ijk + 1
248 wa(ijk)= ii
249 ENDIF
250 ENDDO
251 ENDIF
252 ENDDO
253 666 continue
254! -------------------------------
255 ENDIF
256 ENDDO
257
258C-----------
259 RETURN
260 END SUBROUTINE thsph
my_real
#define my_real
Definition cppsort.cpp:32
initbuf_mod
Definition initbuf.F:160
initbuf_mod::initbuf
subroutine initbuf(iparg, ng, mtn, llt, nft, iad, ity, npt, jale, ismstr, jeul, jtur, jthe, jlag, jmult, jhbe, jivf, mid, jpor, jcvt, jclose, jpla, irep, iint, igtyp, israt, isrot, icsen, isorth, isorthg, ifailure, jsms)
Definition initbuf.F:261
thsph
subroutine thsph(elbuf_tab, nthgrp2, ithgrp, iparg, ithbuf, spbuf, kxsp, nod2sp, pm, wa)
Definition thsph.F:35