OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spinit3.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!|| spinit3 ../starter/source/elements/sph/spinit3.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| dtmain ../starter/source/materials/time_step/dtmain.F
29!|| get_u_func ../starter/source/user_interface/uaccess.F
30!|| get_u_geo ../starter/source/user_interface/uaccess.F
31!|| get_u_mat ../starter/source/user_interface/uaccess.F
32!|| get_u_mid ../starter/source/user_interface/uaccess.F
33!|| get_u_mnu ../starter/source/user_interface/uaccess.F
34!|| get_u_pid ../starter/source/user_interface/uaccess.F
35!|| get_u_pnu ../starter/source/user_interface/uaccess.F
36!|| matini ../starter/source/materials/mat_share/matini.F
37!|| sporth3 ../starter/source/elements/sph/sporth3.F
38!|| sppart3 ../starter/source/elements/sph/sppart3.F
39!||--- uses -----------------------------------------------------
40!|| detonators_mod ../starter/share/modules1/detonators_mod.F
41!||====================================================================
42 SUBROUTINE spinit3(IGRTYP ,SPBUF ,KXSP ,X ,GEO ,
43 . XMAS ,NPC ,PLD ,XIN ,SKEW ,
44 . DTELEM ,NEL ,STIFN ,STIFR ,IGEO ,
45 . PARTSAV ,V ,IPARTSP,BUFMAT,
46 . PM ,ITAB ,MSR ,INR ,IXSP ,
47 . NOD2SP ,IPARG ,ALE_CONNECTIVITY ,DETONATORS ,
48 . SIGSPH ,ISPTAG ,IPART,
49 . IPM ,NSIGSPH ,PTSPH ,NPF ,
50 . TF ,ELBUF_STR,MCP ,TEMP ,ILOADP ,
51 . FACLOAD ,STIFINT ,I7STIFS,GLOB_THERM,MAT_PARAM)
52C-----------------------------------------------
53C M o d u l e s
54C-----------------------------------------------
55 USE elbufdef_mod
56 USE detonators_mod
57 USE ale_connectivity_mod
58 USE glob_therm_mod
59 USE matparam_def_mod
60C-----------------------------------------------
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64C-----------------------------------------------
65C G l o b a l P a r a m e t e r s
66C-----------------------------------------------
67#include "mvsiz_p.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "com01_c.inc"
72#include "com04_c.inc"
73#include "param_c.inc"
74#include "scr17_c.inc"
75#include "scry_c.inc"
76#include "sphcom.inc"
77#include "vect01_c.inc"
78C-----------------------------------------------
79C D u m m y A r g u m e n t s
80C-----------------------------------------------
81 INTEGER KXSP(NISP,*), NPC(*),IPARTSP(*),ITAB(*),IGEO(*),
82 . IXSP(KVOISPH,*),NOD2SP(*),IPARG(*),ISPTAG(*),
83 . IPART(LIPART1,*),IPM(NPROPMI,*), PTSPH(*), NPF(*)
84 INTEGER IGRTYP, NEL,NSIGSPH
85 my_real
86 . X(3,*), GEO(NPROPG,*), XMAS(*), PLD(*), XIN(*),
87 . SKEW(LSKEW,*), DTELEM(*),STIFN(*),STIFR(*),PARTSAV(20,*), V(*),
88 . BUFMAT(*),PM(NPROPM,*), MSR(3,*), INR(3,*),
89 . SPBUF(NSPBUF,*),SIGSPH(NSIGSPH,*), TF(*), MCP(*), TEMP(*)
90 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
91 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
92 my_real,INTENT(IN) :: FACLOAD(LFACLOAD,*)
93 INTEGER,INTENT(IN) :: I7STIFS
94 my_real,INTENT(INOUT) :: stifint(numnod)
95 TYPE(detonators_struct_)::DETONATORS
96 type (glob_therm_) ,intent(inout) :: glob_therm
97 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
98C-----------------------------------------------
99C L o c a l V a r i a b l e s
100C-----------------------------------------------
101 INTEGER IPRT,IMAT,IG,N,I,J,INOD,IGTYP,IBID,NF1,NDEPAR,JJ,IP,II(6)
102 INTEGER MXT(MVSIZ),NGEO(MVSIZ),NC1(MVSIZ),NGL(MVSIZ)
103 my_real
104 . vol(mvsiz),mass(mvsiz),rho(mvsiz),deltax(mvsiz),dtx(mvsiz),
105 . x1(mvsiz),y1(mvsiz),z1(mvsiz),rbid(1), aire(mvsiz)
106 my_real
107 . sti,fv,mp,rhocp
108 my_real :: tempel(nel)
109 TYPE(g_bufel_) ,POINTER :: GBUF
110 TYPE(l_bufel_) ,POINTER :: LBUF
111 TYPE(buf_mat_) ,POINTER :: MBUF
112 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
113C-----------------------------------------------
114 INTEGER GET_U_PNU,GET_U_PID,GET_U_MID,GET_U_MNU
115 my_real
116 . get_u_mat,get_u_geo,get_u_func
117 EXTERNAL get_u_pnu,get_u_mnu,get_u_mat,get_u_geo,get_u_pid,
118 . get_u_mid,get_u_func
119C=======================================================================
120C GENERAL SPH CELLS.
121C--------------------------------------------------
122 gbuf => elbuf_str%GBUF
123 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
124 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
125 rbid = zero
126 ibid = 0
127!
128 DO i=1,6
129 ii(i) = nel*(i-1)
130 ENDDO
131!
132c
133 IF(isph2sol==0)THEN
134 DO i=lft,llt
135 n =i+nft
136 iprt=ipartsp(n)
137 imat=ipart(1,iprt)
138 ig =ipart(2,iprt)
139 mp =get_u_geo(1,ig)
140 rho(i)=pm(1,imat)
141 IF (nint(spbuf(13,n))==1) THEN
142C-- type = 1 - particle with mass input
143 vol(i)=spbuf(12,n)/rho(i)
144 ELSEIF (nint(spbuf(13,n))==2) THEN
145C-- type = 2 - particle with volume input
146 vol(i)=spbuf(12,n)
147 ELSE
148 vol(i)=mp/rho(i)
149 ENDIF
150 IF(nspcond/=0) vol(i)=vol(i)/isptag(n)
151 mass(i) =rho(i)*vol(i)
152 spbuf(2,n) =rho(i)
153 spbuf(12,n)=mass(i)
154 END DO
155 ELSE
156 DO i=lft,llt
157 n =i+nft
158 iprt=ipartsp(n)
159 imat=ipart(1,iprt)
160 ig =ipart(2,iprt)
161 rho(i)=pm(1,imat)
162C
163C Rho, Vol prepared in SINIT3
164 vol(i) =spbuf(12,n)
165 mass(i) =rho(i)*vol(i)
166 IF(mass(i)/=spbuf(2,n))THEN
167C error !
168 END IF
169 spbuf(2,n) =rho(i)
170 spbuf(12,n)=mass(i)
171 END DO
172 END IF
173C-----------------------------------------------
174 nf1 =nft+1
175C--------------------------------------------------
176C MATERIAL NUMBER AND PID.
177C--------------------------------------------------
178 DO i=lft,llt
179 n=nft+i
180 iprt =ipartsp(n)
181 mxt(i) =ipart(1,iprt)
182 ngeo(i)=ipart(2,iprt)
183 ngl(i) =kxsp(nisp,n)
184 nc1(i) =kxsp(3,n)
185 ENDDO
186C--------------------------------------------------
187C LONGUEUR CARACTERISTIQUE.
188C--------------------------------------------------
189 DO i=lft,llt
190 n=nft+i
191 deltax(i)=spbuf(1,n)
192 ENDDO
193C--------------------------------------------------
194C VOLUME INITIAL.
195C--------------------------------------------------
196 DO i=lft,llt
197 gbuf%RHO(i)=rho(i)
198 gbuf%VOL(i)=vol(i)
199 ENDDO
200C--------------------------------------------------
201C POSITION (for LAW NUMBER 5).
202C--------------------------------------------------
203 DO i=lft,llt
204 n=nft+i
205 inod =kxsp(3,n)
206 x1(i)=x(1,inod)
207 y1(i)=x(2,inod)
208 z1(i)=x(3,inod)
209 ENDDO
210C--------------------------------------------------
211 IF(isorth/=0)THEN
212 CALL sporth3(ipart ,ipartsp(nft+1) ,igeo ,gbuf%GAMA,skew,
213 . nel )
214 END IF
215!
216 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
217 tempel(1:nel) = temp(nc1(1:nel))
218 ELSE
219 tempel(1:nel) = pm(79,mxt(1:nel))
220 END IF
221C--------------------------------------------------
222C GENERAL CELLS, END.
223C--------------------------------------------------
224 ip=1
225 CALL matini(pm ,kxsp ,nisp ,x ,
226 . geo ,ale_connectivity ,detonators ,iparg ,
227 . sigsph ,nel ,skew ,igeo ,
228 . ipart ,ipartsp,
229 . mxt ,ipm ,nsigsph ,numsphy ,ptsph ,
230 . ip ,ngl ,npf ,tf ,bufmat ,
231 . gbuf ,lbuf ,mbuf ,elbuf_str,iloadp ,
232 . facload, deltax ,tempel ,mat_param )
233C--------------------------------------------------
234C INITIAL DIAMETER (Y files )
235C--------------------------------------------------
236 IF(isigi==3.OR.isigi==4.OR.isigi==5)THEN
237 DO i=lft,llt
238 n = i+nft
239 jj=ptsph(n)
240 IF(jj/=0) THEN
241 IF(sigsph(11,jj)/=0.)THEN
242 spbuf(1,n)=sigsph(11,jj)
243 ENDIF
244 ENDIF
245 spbuf(2,n) = gbuf%RHO(i)
246 ENDDO
247 ENDIF
248C----------------------------------------
249C INITIALISATION OF THERMAL BEHAVIOR
250C----------------------------------------
251 IF (jthe > 0)THEN
252 DO i=lft,llt
253 gbuf%TEMP(i)=pm(79,mxt(i))
254 ENDDO
255 ELSEIF (jthe < 0) THEN
256 glob_therm%INTHEAT = 1
257 DO i=lft,llt
258 j = nc1(i)
259 rhocp = pm(69,mxt(i))*vol(i)
260 mcp(j) = rhocp+mcp(j)
261 temp(j) = pm(79,mxt(i))
262 ENDDO
263 END IF
264C--------------------------------------------------
265C INITIALISATION OF MASSES
266C--------------------------------------------------
267 CALL sppart3(xmas,partsav,nc1,mass,x,v,ipartsp(nf1))
268C--------------------------------------------------
269C ELEMENTARY TIME STEP COMPUTATION
270C--------------------------------------------------
271 ndepar=numelc+numels+numelt+numelq+numelp+numelr+numeltg
272 . +numelx+nft
273
274 aire(:) = zero
275 igtyp = iparg(38)
276 CALL dtmain(geo ,pm ,ipm ,ngeo ,mxt ,fv ,
277 . gbuf%EINT ,gbuf%TEMP ,gbuf%DELTAX ,gbuf%RK ,gbuf%RE ,bufmat, deltax, aire,
278 . gbuf%VOL, dtx, igeo,igtyp)
279
280 DO i=lft,llt
281 dtelem(ndepar+i)=dtx(i)
282 sti = two * mass(i) / max(em20,dtx(i)*dtx(i))
283 stifn(kxsp(3,i+nft))=stifn(kxsp(3,i+nft))+sti
284 ENDDO
285C----------------------------------------------
286C INITIALISATION OF NODAL STIFFNESSES FOR CONTACT
287C----------------------------------------------
288 IF(i7stifs/=0)THEN
289 DO i=lft,llt
290 n = i+nft
291C stiff = 0.5*Bulk*VOL**1/3 (SPH only one element per node - no summation needed)
292 stifint(kxsp(3,i+nft))= half*pm(32,mxt(i))*vol(i)**third
293 ENDDO
294 ENDIF
295C--------------------------------------------------
296 DO i=lft,llt
297 n=nft+i
298 IF(kxsp(2,n) < 0.AND.
299 . (n < first_sphsol.OR.n >= first_sphsol+nsphsol))THEN
300 gbuf%OFF(i) = zero
301 gbuf%RHO(i) = zero
302 gbuf%EINT(i) = zero
303 gbuf%SIG(ii(1)+i) = zero
304 gbuf%SIG(ii(2)+i) = zero
305 gbuf%SIG(ii(3)+i) = zero
306 gbuf%SIG(ii(4)+i) = zero
307 gbuf%SIG(ii(5)+i) = zero
308 gbuf%SIG(ii(6)+i) = zero
309 ELSEIF(kxsp(2,n) < 0 .AND.
310 . first_sphsol <= n .AND. n < first_sphsol+nsphsol)THEN
311 gbuf%OFF(i) = -one
312 ENDIF
313 ENDDO
314C--------------------------------------------------
315 RETURN
316C--------------------------------------------------
317 END
dtmain
subroutine dtmain(geo, pm, ipm, pid, mat, fv, eint, temp, deltax, rk, re, bufmat, ddeltax, aire, vol, dtx, igeo, igtyp)
Definition dtmain.F:68
max
#define max(a, b)
Definition macros.h:21
matini
subroutine matini(pm, ix, nix, x, geo, ale_connectivity, detonators, iparg, sigi, nel, skew, igeo, ipart, ipartel, mat, ipm, nsig, nums, pt, ipt, ngl, npf, tf, bufmat, gbuf, lbuf, mbuf, elbuf_str, iloadp, facload, ddeltax, tempel, mat_param)
Definition matini.F:83
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
detonators_mod
Definition detonators_mod.F:80
spinit3
subroutine spinit3(igrtyp, spbuf, kxsp, x, geo, xmas, npc, pld, xin, skew, dtelem, nel, stifn, stifr, igeo, partsav, v, ipartsp, bufmat, pm, itab, msr, inr, ixsp, nod2sp, iparg, ale_connectivity, detonators, sigsph, isptag, ipart, ipm, nsigsph, ptsph, npf, tf, elbuf_str, mcp, temp, iloadp, facload, stifint, i7stifs, glob_therm, mat_param)
Definition spinit3.F:52
sporth3
subroutine sporth3(ipart, ipartsp, igeo, gama, skew, nel)
Definition sporth3.F:31
sppart3
subroutine sppart3(ms, partsav, nc1, mass, x, v, ipart)
Definition sppart3.F:29
ale_connectivity_mod::t_ale_connectivity
Definition ale_connectivity_mod.F:256
detonators_mod::detonators_struct_
Definition detonators_mod.F:155