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

Go to the source code of this file.

Functions/Subroutines

subroutine s10init3 (elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ixs10, ipart, glob_therm, mssx, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, vnsx, bnsx, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, in, stifr, ins, mssa, strsglob, straglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, defaults_solid)

Function/Subroutine Documentation

◆ s10init3()

subroutine s10init3 ( type(elbuf_struct_), target elbuf_str,
mas,
integer, dimension(nixs,*) ixs,
pm,
x,
type(detonators_struct_) detonators,
geo,
veul,
type(t_ale_connectivity), intent(inout) ale_connectivity,
integer, dimension(*) iparg,
dtelem,
sigi,
integer nel,
skew,
integer, dimension(npropgi,*) igeo,
stifn,
partsav,
v,
integer, dimension(*) iparts,
mss,
integer, dimension(6,*) ixs10,
integer, dimension(lipart1,*) ipart,
type (glob_therm_), intent(in) glob_therm,
mssx,
sigsp,
integer nsigi,
integer, dimension(npropmi,*) ipm,
integer iuser,
integer nsigs,
volnod,
bvolnod,
vns,
bns,
vnsx,
bnsx,
integer, dimension(*) ptsol,
bufmat,
mcp,
mcps,
mcpsx,
temp,
integer, dimension(*) npf,
tf,
in,
stifr,
ins,
mssa,
integer, dimension(*) strsglob,
integer, dimension(*) straglob,
integer, dimension(*) fail_ini,
integer, dimension(sizloadp,*), intent(in) iloadp,
dimension(lfacload,*), intent(in) facload,
rnoise,
integer, dimension(nperturb) perturb,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param,
type(solid_defaults_), intent(in) defaults_solid )

Definition at line 50 of file s10init3.F.

63C-----------------------------------------------
64C M o d u l e s
65C-----------------------------------------------
66 USE elbufdef_mod
67 USE message_mod
68 USE bpreload_mod
69 USE detonators_mod
70 USE ale_connectivity_mod
71 USE matparam_def_mod
72 USE defaults_mod
73 USE names_and_titles_mod , ONLY : nchartitle
74 use glob_therm_mod
75C-----------------------------------------------
76C I m p l i c i t T y p e s
77C-----------------------------------------------
78#include "implicit_f.inc"
79C-----------------------------------------------
80C G l o b a l P a r a m e t e r s
81C-----------------------------------------------
82#include "mvsiz_p.inc"
83C-----------------------------------------------
84C C o m m o n B l o c k s
85C-----------------------------------------------
86#include "com01_c.inc"
87#include "com04_c.inc"
88#include "param_c.inc"
89#include "scr12_c.inc"
90#include "scry_c.inc"
91#include "vect01_c.inc"
92#include "scr17_c.inc"
93C-----------------------------------------------
94C D u m m y A r g u m e n t s
95C-----------------------------------------------
96 INTEGER IXS(NIXS,*), IPARG(*),IPARTS(*),IGEO(NPROPGI,*),
97 . IXS10(6,*), IPART(LIPART1,*),IPM(NPROPMI,*),
98 . NPF(*),STRSGLOB(*),STRAGLOB(*),PTSOL(*),FAIL_INI(*),PERTURB(NPERTURB)
99 INTEGER NEL ,NSIGI,IUSER, NSIGS
100 my_real
101 . mas(*),pm(npropm,*), x(*), geo(npropg,*),
102 . veul(lveul,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
103 . partsav(20,*), v(*), mss(8,*), mssx(12,*) , sigsp(nsigi,*),
104 . volnod(*),bvolnod(*), vns(8,*), bns(8,*),rnoise(nperturb,*),
105 . vnsx(12,*), bnsx(12,*) ,bufmat(*),mcp(*),mcps(8,*),mcpsx(12,*),
106 . temp(*), tf(*), in(*),stifr(*), ins(8,*), mssa(*)
107 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
108 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
109 my_real,INTENT(IN) :: facload(lfacload,*)
110 TYPE(DETONATORS_STRUCT_) :: DETONATORS
111 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
112 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
113 TYPE(SOLID_DEFAULTS_), INTENT(IN) :: DEFAULTS_SOLID
114 type (glob_therm_) , intent(in) :: glob_therm
115C-----------------------------------------------
116C L o c a l V a r i a b l e s
117C-----------------------------------------------
118 INTEGER I,J,IP,NF1,NF2,IBID,IGTYP,NUVAR,IREP,NCC,IDEF,JHBE,IPID
119 INTEGER ID,NPTR,NPTS,NPTT,NLAY,L_PLA,L_SIGB,IBOLTP,IINT,IMAS_DS
120 CHARACTER(LEN=NCHARTITLE)::TITR
121 INTEGER NC(MVSIZ,10),MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ)
122 double precision
123 . xx(mvsiz,10), yy(mvsiz,10), zz(mvsiz,10)
124 my_real
125 . bid, fv,
126 . volu(mvsiz), mass(mvsiz),volg(mvsiz),
127 . volp(mvsiz,5), sti(mvsiz),deltax(mvsiz),deltax2(mvsiz),
128 . vx(mvsiz,10), vy(mvsiz,10), vz(mvsiz,10),
129 . px(mvsiz,10,5),py(mvsiz,10,5),pz(mvsiz,10,5),
130 . rx(mvsiz),ry(mvsiz),rz(mvsiz),
131 . sx(mvsiz),sy(mvsiz),sz(mvsiz),
132 . tx(mvsiz),ty(mvsiz),tz(mvsiz),
133 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
134 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
135 . nx(mvsiz,10,5), wip(5,5) ,alph(5,5),beta(5,5),masscp(mvsiz),
136 . rhocp(mvsiz),temp0(mvsiz), aire(mvsiz), dtx(mvsiz)
137 my_real :: tempel(nel)
138C
139C-----------------------------------------------
140 TYPE(L_BUFEL_) ,POINTER :: LBUF
141 TYPE(G_BUFEL_) ,POINTER :: GBUF
142 TYPE(BUF_MAT_) ,POINTER :: MBUF
143C-----------------------------------------------
144 DATA wip / 1. ,0. ,0. ,0. ,0. ,
145 2 0. ,0. ,0. ,0. ,0. ,
146 3 0. ,0. ,0. ,0. ,0. ,
147 4 0.25,0.25,0.25,0.25,0. ,
148 5 0.45,0.45,0.45,0.45,-0.8/
149 DATA alph /0. ,0. ,0. ,0. ,0. ,
150 2 0. ,0. ,0. ,0. ,0. ,
151 3 0. ,0. ,0. ,0. ,0. ,
152 4 0.58541020,0.58541020,0.58541020,0.58541020,0. ,
153 5 0.5 ,0.5 ,0.5 ,0.5 ,0.25/
154 DATA beta /0. ,0. ,0. ,0. ,0. ,
155 2 0. ,0. ,0. ,0. ,0. ,
156 3 0. ,0. ,0. ,0. ,0. ,
157 4 0.13819660,0.13819660,0.13819660,0.13819660,0. ,
158 5 0.16666666666667,0.16666666666667,0.16666666666667,
159 5 0.16666666666667,0.25/
160C-----------------------------------------------
161C S o u r c e L i n e s
162C=======================================================================
163 gbuf => elbuf_str%GBUF
164c
165 irep = iparg(35)
166 igtyp = iparg(38)
167 jhbe = iparg(23)
168 iint = iparg(36)
169 nf1 = nft+1
170 nf2 = nf1-numels8
171 IF (isrot == 1) nf2=1
172 idef = 0
173 nptr = elbuf_str%NPTR
174 npts = elbuf_str%NPTS
175 nptt = elbuf_str%NPTT
176 nlay = elbuf_str%NLAY
177C
178 iboltp = iparg(72) !Bolt preloading
179 jcvt = iparg(37)
180 imas_ds = defaults_solid%IMAS
181C
182 DO i=lft,llt
183 rhocp(i) = pm(69,ixs(1,nft+i))
184 temp0(i) = pm(79,ixs(1,nft+i))
185 ENDDO
186C
187 CALL s10coor3(
188 1 x ,v ,ixs(1,nf1) ,ixs10(1,nf2) ,xx ,
189 2 yy ,zz ,vx ,vy ,vz ,
190 3 nc ,ngl ,mat ,pid ,mass ,
191 4 dtelem(nf1),sti ,gbuf%SIG ,gbuf%EINT ,gbuf%RHO,
192 5 gbuf%QVIS ,temp0 ,temp ,gbuf%SMSTR ,nel ,
193 6 glob_therm%NINTEMP)
194c
195 CALL s10deri3(volp,ngl,
196 . xx, yy, zz, px,py,pz, nx,
197 . rx, ry, rz, sx, sy, sz, tx, ty, tz,volu,gbuf%VOL,
198 . elbuf_str,volg)
199 CALL s10len3(volp,ngl,deltax,deltax2,
200 . px,py,pz, volu,gbuf%VOL,volg,
201 . rx, ry, rz, sx, sy, sz, tx, ty, tz,
202 . nel,mat,pm,gbuf%DT_PITER,iint)
203 CALL sreploc3(
204 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
205 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
206 IF (igtyp == 6 .OR. igtyp == 21)
207 . CALL smorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
208 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
209 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
210 . rx ,ry ,rz ,sx ,sy ,sz ,nsigi,sigsp,nsigs,
211 . sigi ,ixs ,x ,jhbe ,ptsol,nel ,iparg(28))
212C----------------------------------------
213C INITIALISATION DE LA THERMIQUE
214C----------------------------------------
215 IF(jthe < 0) THEN
216 DO i=lft,llt
217 masscp(i) = zero
218 ENDDO
219 ENDIF
220 IF(jthe /=0) CALL atheri(mat,pm,gbuf%TEMP)
221C-----------------------------
222C POINTS D'INTEGRATION
223C-----------------------------
224 DO ip=1,npt
225 lbuf => elbuf_str%BUFLY(1)%LBUF(ip,1,1)
226 mbuf => elbuf_str%BUFLY(1)%MAT(ip,1,1)
227 l_pla = elbuf_str%BUFLY(1)%L_PLA
228 l_sigb =elbuf_str%BUFLY(1)%L_SIGB
229C
230 IF(isrot /= 1)THEN
231 DO i=lft,llt
232 volu(i)=volp(i,ip)
233 lbuf%VOL(i)=volu(i)
234 ENDDO
235 ELSE
236 DO i=lft,llt
237 lbuf%VOL(i)=volu(i)
238 ENDDO
239 ENDIF
240 IF(jthe /=0) CALL atheri(mat,pm,lbuf%TEMP)
241 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
242 tempel(1:nel) = zero
243 DO j = 1,10
244 DO i=1,nel
245 tempel(i)= tempel(i) + nx(i,j,ip)*temp(nc(i,j))
246 ENDDO
247 ENDDO
248 ELSE
249 tempel(1:nel) = temp0(1:nel)
250 END IF
251
252 CALL matini(pm ,ixs ,nixs ,x ,
253 . geo ,ale_connectivity ,detonators,iparg ,
254 . sigi ,nel ,skew ,igeo ,
255 . ipart ,iparts ,
256 . mat ,ipm ,nsigs ,numsol ,ptsol ,
257 . ip ,ngl ,npf ,tf ,bufmat ,
258 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
259 . facload, deltax ,tempel )
260C------------------------------------------
261C CALCUL DES DT ELEMENTAIRES
262C------------------------------------------
263 aire(:) = zero
264 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
265 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
266 . volu, dtx , igeo,igtyp)
267C----------------------------------------
268C INITIALISATION DES MASSES
269C----------------------------------------
270 CALL s10msi(lbuf%RHO,mass,volu,dtelem(nft+1),sti,
271 . lbuf%OFF,lbuf%SIG ,lbuf%EINT ,
272 . gbuf%OFF,gbuf%SIG,gbuf%EINT,gbuf%RHO,wip(npt,ip),
273 . masscp ,rhocp ,gbuf%FILL,nel, dtx)
274C---------------------------------------------------------
275C INITIALATION DES CONTRAINTES
276C---------------------------------------------------------
277
278 IF(mtn>=28)THEN
279 nuvar = ipm(8,ixs(1,nft+1))
280 idef =1
281 ELSE
282 nuvar = 0
283 IF(mtn == 14 .OR. mtn == 12)THEN
284 idef =1
285 ELSEIF(mtn == 24)THEN
286 idef =1
287 ELSEIF(istrain == 1)THEN
288 IF(mtn == 1)THEN
289 idef =1
290 ELSEIF(mtn == 2)THEN
291 idef =1
292 ELSEIF(mtn == 4)THEN
293 idef =1
294 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10.OR.
295 . mtn == 21.OR.mtn == 22.OR.mtn == 23.
296 . or.mtn == 49)THEN
297 idef =1
298 ENDIF
299 ENDIF
300C
301 ENDIF
302C
303 CALL sigin20b(
304 . lbuf%SIG,pm, lbuf%VOL,sigsp,
305 . sigi,lbuf%EINT,lbuf%RHO,mbuf%VAR ,lbuf%STRA,
306 . ixs ,nixs,nsigi, ip, nuvar,
307 . nel,iuser,idef,nsigs ,strsglob,
308 . straglob,jhbe,igtyp,x,lbuf%GAMA,
309 . mat ,lbuf%PLA,l_pla,ptsol,lbuf%SIGB,
310 . l_sigb,ipm ,bufmat ,lbuf%VOL0DP)
311C
312C----------------------------------------
313c Initialization of stress tensor in case of Orthotropic properties
314C----------------------------------------
315 IF (isigi /= 0 .AND. isorth/=0) THEN
316 lbuf%SIGL = lbuf%SIG
317 ENDIF
318C
319 ENDDO
320C
321 IF (iboltp /=0) THEN
322 CALL sboltini(e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
323 1 gbuf%BPRELD,nel ,ixs ,nixs ,vpreload, iflag_bpreload)
324 ENDIF
325C----------------------------------------
326C INITIALISATION DES MASSES
327C----------------------------------------
328 CALL s10mass3(mass,mas,partsav,iparts(nf1),mss(1,nf1),volu,
329 . xx ,yy ,zz ,vx ,vy ,vz ,
330 . nc ,sti,stifn ,deltax2 ,mssx(1,nf1),masscp,
331 . mcp ,mcps(1,nf1),mcpsx(1,nf1),in ,stifr,
332 . ins(1,nf1),mssa(nf1),x ,gbuf%FILL ,imas_ds)
333C----------------------------------------
334c Failure model initialisation
335C----------------------------------------
336 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
337 . ipm,sigsp,nsigi,fail_ini ,
338 . sigi,nsigs,ixs,nixs,ptsol,
339 . rnoise,perturb,mat_param)
340C------------------------------------------
341C assemblage des Volumes nodaux et Modules nodaux
342C (pour rigidites d'interface)
343C------------------------------------------
344 IF(i7stifs/=0)THEN
345 ncc=10
346 CALL sbulk3(volu ,nc ,ncc,mat,pm ,
347 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),
348 3 vnsx(1,nf1),bnsx(1,nf1) ,gbuf%FILL)
349 ENDIF
350C------------------------------------------
351 DO i=lft,llt
352 IF(ixs(10,i+nft)/=0) THEN
353 IF( igtyp/=0 .AND.igtyp/=6
354 . .AND.igtyp/=14.AND.igtyp/=15)THEN
355 ipid=ixs(nixs-1,i+nft)
356 id=igeo(1,ipid)
357 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid),ltitr)
358 CALL ancmsg(msgid=496,
359 . msgtype=msgerror,
360 . anmode=aninfo_blind_1,
361 . i1=id,
362 . c1=titr)
363 ENDIF
364 ENDIF
365 ENDDO
366C---------------------------------------------------
367 RETURN
atheri
subroutine atheri(mat, pm, temp)
Definition atheri.F:41
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
failini
subroutine failini(elbuf_str, nptr, npts, nptt, nlay, ipm, sigsp, nsigi, fail_ini, sigi, nsigs, ix, nix, pt, rnoise, perturb, mat_param)
Definition failini.F:43
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
id
initmumps id
Definition multiplerhs_example.m:4
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
bpreload_mod
Definition bpreload_mod.F:40
bpreload_mod::iflag_bpreload
integer, dimension(:), allocatable iflag_bpreload
Definition bpreload_mod.F:48
detonators_mod
Definition detonators_mod.F:79
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
s10msi
subroutine s10msi(rho, mass, volu, dtelem, sti, off, sig, eint, offg, sigg, eintg, rhog, wip, masscp, rhocp, fill, nel, dtx)
Definition s10mass3.F:341
s10mass3
subroutine s10mass3(mass, ms, partsav, ipart, mss, volu, xx, yy, zz, vx, vy, vz, nc, sti, stifn, deltax2, mssx, masscp, mcp, mcps, mcpsx, in, stifr, ins, mssa, x, fill, imas_ds)
Definition s10mass3.F:37
sigin20b
subroutine sigin20b(sig, pm, vol, sigsp, sigi, eint, rho, uvar, eps, ix, nix, nsigi, ipt, nuvar, nel, iuser, idef, nsigs, strsglob, straglob, jhbe, igtyp, x, bufgama, mat, epsp, l_pla, pt, sigb, l_sigb, ipm, bufmat, voldp)
Definition s20mass3.F:350
sboltini
subroutine sboltini(e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, bpreld, nel, ix, nix, vpreload, iflag_bpreload)
Definition sboltini.F:33
sbulk3
subroutine sbulk3(volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)
Definition sbulk3.F:42
smorth3
subroutine smorth3(pid, geo, igeo, skew, irep, gama, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, nsigi, sigsp, nsigs, sigi, ixs, x, jhbe, pt, nel, isolnod)
Definition smorth3.F:43
s10coor3
subroutine s10coor3(x, v, ixs, ixs10, xx, yy, zz, vx, vy, vz, nc, ngl, mxt, ngeo, mass, dtelem, sti, sigg, eintg, rhog, qg, temp0, temp, sav, nel, nintemp)
Definition s10coor3.F:39
s10deri3
subroutine s10deri3(vol, ngl, xx, yy, zz, px, py, pz, nx, rx, ry, rz, sx, sy, sz, tx, ty, tz, volu, voln, elbuf_str, volg)
Definition s10deri3.F:39
s10len3
subroutine s10len3(vol, ngl, deltax, deltax2, px, py, pz, volu, voln, volg, rx, ry, rz, sx, sy, sz, tx, ty, tz, nel, mxt, pm, v_piter, iint)
Definition s10len3.F:33
sreploc3
subroutine sreploc3(rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition sreploc3.F:32
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804