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)

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 )

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
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
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: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
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:626
get_u_pnu
integer function get_u_pnu(ivar, ip, k)
Definition uaccess.F:482
get_u_mid
integer function get_u_mid(im)
Definition uaccess.F:668
get_u_mnu
integer function get_u_mnu(ivar, im, k)
Definition uaccess.F:565