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