OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
spinit3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "scry_c.inc"
#include "sphcom.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ spinit3()

subroutine spinit3 ( integer igrtyp,
spbuf,
integer, dimension(nisp,*) kxsp,
x,
geo,
xmas,
integer, dimension(*) npc,
pld,
xin,
skew,
dtelem,
integer nel,
stifn,
stifr,
integer, dimension(*) igeo,
partsav,
v,
integer, dimension(*) ipartsp,
bufmat,
pm,
integer, dimension(*) itab,
msr,
inr,
integer, dimension(kvoisph,*) ixsp,
integer, dimension(*) nod2sp,
integer, dimension(*) iparg,
type(t_ale_connectivity), intent(inout) ale_connectivity,
type(detonators_struct_) detonators,
sigsph,
integer, dimension(*) isptag,
integer, dimension(lipart1,*) ipart,
integer, dimension(npropmi,*) ipm,
integer nsigsph,
integer, dimension(*) ptsph,
integer, dimension(*) npf,
tf,
type (elbuf_struct_), target elbuf_str,
mcp,
temp,
integer, dimension(sizloadp,*), intent(in) iloadp,
dimension(lfacload,*), intent(in) facload,
dimension(numnod), intent(inout) stifint,
integer, intent(in) i7stifs,
type (glob_therm_), intent(inout) glob_therm,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param )

Definition at line 42 of file spinit3.F.

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--------------------------------------------------
my_real
#define my_real
Definition cppsort.cpp:32
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
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
get_u_pid
integer function get_u_pid(ip)
Definition uaccess.F:625
get_u_pnu
integer function get_u_pnu(ivar, ip, k)
Definition uaccess.F:481
get_u_mid
integer function get_u_mid(im)
Definition uaccess.F:667
get_u_mnu
integer function get_u_mnu(ivar, im, k)
Definition uaccess.F:564