OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sinit3.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!|| sinit3 ../starter/source/elements/solid/solide/sinit3.f
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| atheri ../starter/source/ale/atheri.F
30!|| aturi3 ../starter/source/ale/ale3d/aturi3.F
31!|| dtmain ../starter/source/materials/time_step/dtmain.F
32!|| edlen3 ../starter/source/ale/ale3d/edlen3.F
33!|| enorm3 ../starter/source/ale/ale3d/enorm3.F
34!|| failini ../starter/source/elements/solid/solide/failini.f
35!|| fretitl2 ../starter/source/starter/freform.F
36!|| inimom_fvm ../starter/source/elements/solid/solide/inimom_fvm.F
37!|| m115_perturb ../starter/source/materials/mat/mat115/m115_perturb.F
38!|| matini ../starter/source/materials/mat_share/matini.F
39!|| s8erefcoor3 ../starter/source/elements/solid/solide8z/s8erefcoor3.F
40!|| sboltini ../starter/source/loads/bolt/sboltini.F
41!|| sbulk3 ../starter/source/elements/solid/solide/sbulk3.F
42!|| scoor3 ../starter/source/elements/solid/solide/scoor3.F
43!|| sderi3 ../starter/source/elements/solid/solide/sderi3.F
44!|| sderi3b ../starter/source/elements/solid/solid8p/sderi3b.F
45!|| sdlen3 ../starter/source/elements/solid/solide/sdlen3.F
46!|| sigin3b ../starter/source/elements/solid/solid8p/sigin3b.f
47!|| sjacidp ../starter/source/elements/solid/solide/sjacidp.F
48!|| smass3 ../starter/source/elements/solid/solide/smass3.F
49!|| smass3b ../starter/source/elements/solid/solid8p/smass3b.F
50!|| smorth3 ../starter/source/elements/solid/solide/smorth3.F
51!|| soltosphv8 ../starter/source/elements/sph/soltosph.F
52!|| srcoor3 ../starter/source/elements/solid/solide/srcoor3.F
53!|| sveok3 ../starter/source/elements/solid/solide/sveok3.f
54!|| szderi3 ../starter/source/elements/solid/solidez/szderi3.F
55!|| userin3 ../starter/source/elements/solid/solide/userin3.F
56!|| ustrsin3 ../starter/source/elements/solid/solide/userin3.F
57!||--- uses -----------------------------------------------------
58!|| bpreload_mod ../starter/share/modules1/bpreload_mod.F
59!|| detonators_mod ../starter/share/modules1/detonators_mod.F
60!|| message_mod ../starter/share/message_module/message_mod.F
61!||====================================================================
62 SUBROUTINE sinit3(ELBUF_STR,MAS ,IXS ,PM ,X ,
63 . DETONATORS,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG_GR,
64 . DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
65 . STIFN ,PARTSAV ,V ,IPARTS ,MSS ,
66 . IPART ,SIGSP ,NG ,IPARG ,
67 . NSIGI ,MSNF ,NVC ,MSSF ,IPM ,
68 . IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,VNS ,
69 . BNS ,IN ,VR ,INS ,WMA ,
70 . PTSOL ,BUFMAT ,MCP ,MCPS ,TEMP ,
71 . XREFS ,NPF ,TF ,MSSA ,STRSGLOB,
72 . STRAGLOB ,FAIL_INI ,SPBUF ,KXSP ,IPARTSP ,
73 . NOD2SP ,SOL2SPH ,IRST ,ILOADP ,FACLOAD ,
74 . RNOISE ,PERTURB ,MAT_PARAM,GLOB_THERM)
75C-----------------------------------------------
76C M o d u l e s
77C-----------------------------------------------
78 USE elbufdef_mod
79 USE message_mod
80 USE bpreload_mod
81 USE detonators_mod
82 USE ale_connectivity_mod
83 USE alefvm_mod , only:alefvm_param
84 USE matparam_def_mod
85 USE names_and_titles_mod , ONLY : nchartitle
86 use glob_therm_mod
87C-----------------------------------------------
88C I m p l i c i t T y p e s
89C-----------------------------------------------
90#include "implicit_f.inc"
91C-----------------------------------------------
92C G l o b a l P a r a m e t e r s
93C-----------------------------------------------
94#include "mvsiz_p.inc"
95C-----------------------------------------------
96C C o m m o n B l o c k s
97C-----------------------------------------------
98#include "com01_c.inc"
99#include "com04_c.inc"
100#include "param_c.inc"
101#include "scr03_c.inc"
102#include "scr12_c.inc"
103#include "scr17_c.inc"
104#include "scry_c.inc"
105#include "sphcom.inc"
106#include "vect01_c.inc"
107C-----------------------------------------------
108C D u m m y A r g u m e n t s
109C-----------------------------------------------
110 INTEGER IXS(NIXS,NUMELS),IPARG(NPARG,NGROUP),
111 . IPARG_GR(NPARG),IPARTS(*),IGEO(NPROPGI,NUMGEO),
112 . IPM(NPROPMI,NUMMAT),IPART(LIPART1,*),PTSOL(*),
113 . NG,NSIGI ,NVC,NEL,IUSER, NSIGS, NPF(*),
114 . STRSGLOB(*),STRAGLOB(*),FAIL_INI(*),
115 . KXSP(NISP,*), IPARTSP(*), NOD2SP(*), SOL2SPH(2,*), IRST(3,*),
116 . PERTURB(NPERTURB)
117 my_real MAS(*), PM(NPROPM,NUMMAT), X(3,NUMNOD),GEO(NPROPG,NUMGEO),
118 . VEUL(LVEUL,*), DTELEM(*),SIGI(NSIGS,*),SKEW(LSKEW,*),STIFN(*),
119 . PARTSAV(20,*), V(*), MSS(8,*),
120 . SIGSP(NSIGI,*),MSNF(*), MSSF(8,*), WMA(*),
121 . VOLNOD(*), BVOLNOD(*), VNS(8,*), BNS(8,*),
122 . in(*),vr(*), ins(8,*),bufmat(*),
123 . mcp(*), mcps(8,*), temp(*),
124 . xrefs(8,3,*), tf(*), mssa(*),
125 . spbuf(nspbuf,*),rnoise(nperturb,*)
126 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
127 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
128 my_real,INTENT(IN) :: FACLOAD(LFACLOAD,*)
129 TYPE(detonators_struct_)::DETONATORS
130 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
131 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
132 type (glob_therm_) ,intent(in) :: glob_therm
133C-----------------------------------------------
134C L o c a l V a r i a b l e s
135C-----------------------------------------------
136 INTEGER I,J, NF1, NCC, IBID, JHBE, IREP,IGTYP, NUVAR,NUVARR,IDEF,
137 . IR,IS,IT,IPT,LVLOC,IPID1,NPTR,NPTS,NPTT,NLAY,NDDIM,
138 . nsphdir, ncelf, ncell,l_pla,l_sigb,iboltp
139 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
140 . ix1(mvsiz),ix2(mvsiz),ix3(mvsiz),ix4(mvsiz),
141 . ix5(mvsiz),ix6(mvsiz),ix7(mvsiz),ix8(mvsiz)
142 my_real
143 . v8loc(51,mvsiz),volu(mvsiz),dtx(mvsiz),
144 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
145 . x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
146 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
147 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
148 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
149 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
150 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),
151 . e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
152 . e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
153 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
154 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz),rhocp(mvsiz),temp0(mvsiz),
155 . px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
156 . py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
157 . pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),
158 . rhof(mvsiz),alpha(mvsiz), aire(mvsiz),rho0(mvsiz)
159 my_real :: bid, fv, sti
160 my_real :: deltax(mvsiz)
161 DOUBLE PRECISION
162 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
163 . XD5(MVSIZ), XD6(MVSIZ), XD7(MVSIZ), XD8(MVSIZ),
164 . YD1(MVSIZ), YD2(MVSIZ), YD3(MVSIZ), YD4(MVSIZ),
165 . YD5(MVSIZ), YD6(MVSIZ), YD7(MVSIZ), YD8(MVSIZ),
166 . ZD1(MVSIZ), ZD2(MVSIZ), ZD3(MVSIZ), ZD4(MVSIZ),
167 . ZD5(MVSIZ), ZD6(MVSIZ), ZD7(MVSIZ), ZD8(MVSIZ)
168 my_real :: TEMPEL(NEL)
169C-----------------------------------------------
170 CHARACTER(LEN=NCHARTITLE)::TITR1
171C
172 parameter(lvloc = 51)
173C-----------------------------------------------
174 TYPE(l_bufel_) ,POINTER :: LBUF
175 TYPE(G_BUFEL_) ,POINTER :: GBUF
176 TYPE(BUF_MAT_) ,POINTER :: MBUF
177 TYPE(BUF_LAY_) ,POINTER :: BUFLY
178 TYPE(BUF_FAIL_) ,POINTER:: FBUF
179 my_real, DIMENSION(:), POINTER :: UVARF
180C-----------------------------------------------
181C S o u r c e L i n e s
182C-----------------------------------------------
183 gbuf => elbuf_str%GBUF
184 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
185 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
186 fbuf => elbuf_str%BUFLY(1)%FAIL(1,1,1)
187 bufly => elbuf_str%BUFLY(1)
188 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
189 nptr = elbuf_str%NPTR
190 npts = elbuf_str%NPTS
191 nptt = elbuf_str%NPTT
192 nlay = elbuf_str%NLAY
193 l_pla = elbuf_str%BUFLY(1)%L_PLA
194 l_sigb= elbuf_str%BUFLY(1)%L_SIGB
195c
196 jhbe = iparg_gr(23)
197 irep = iparg_gr(35)
198 jcvt = iparg_gr(37)
199 igtyp = iparg_gr(38)
200 IF (jcvt==1.AND.isorth/=0) jcvt=2
201 idef = 0 ! initialization flag for the total strain
202 bid = zero
203 ibid = 0
204 nddim = 0
205 nf1=nft+1
206 volu(1:nel)=zero
207C
208 iboltp = iparg_gr(72) !Bolt preloading
209C
210 DO i=1,nel
211 rhocp(i) = pm(69,ixs(1,nft+i))
212 temp0(i) = pm(79,ixs(1,nft+i))
213 rho0(i) = pm(1,ixs(1,nft+i))
214C For air + foam
215 rhof(i) = pm(192,ixs(1,nft+i))
216 alpha(i) = pm(193,ixs(1,nft+i))
217 ENDDO
218 IF (ismstr==10.OR.ismstr==12) THEN
219C Total Lagrange simulation
220 CALL scoor3(x,xrefs(1,1,nf1),ixs(1,nf1),geo ,mat ,pid ,ngl ,
221 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
222 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
223 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
224 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
225 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
226 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
227 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0,temp ,glob_therm%NINTEMP,
228 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
229 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
230 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
231 IF (nsigi > 0 ) THEN
232 CALL s8erefcoor3(gbuf%SMSTR,8,nel,
233 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
234 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
235 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
236 END IF
237C JAC_I : [J]^-1 is calculated in global system
238 CALL sjacidp(
239 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
240 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
241 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 ,
242 . gbuf%JAC_I ,nel)
243 END IF
244C Orthotropy wrt reference geometry
245 IF (jcvt == 0) THEN
246 CALL scoor3(x,xrefs(1,1,nf1),ixs(1,nf1),geo ,mat ,pid ,ngl ,
247 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
248 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
249 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
250 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
251 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
252 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
253 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0,temp ,glob_therm%NINTEMP,
254 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
255 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
256 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
257 ELSE
258 CALL srcoor3(x,xrefs(1,1,nf1),ixs(1,nf1),geo ,mat ,pid ,ngl ,jhbe ,
259 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
260 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
261 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
262 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
263 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
264 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
265 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0,temp ,glob_therm%NINTEMP,
266 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
267 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
268 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
269
270 ENDIF
271!
272! Initialize element temperature from /initemp
273!
274 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
275 DO i=1,nel
276 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
277 . + temp(ixs(4,i)) + temp(ixs(5,i))
278 . + temp(ixs(6,i)) + temp(ixs(7,i))
279 . + temp(ixs(8,i)) + temp(ixs(9,i)))
280 ENDDO
281 ELSE
282 tempel(1:nel) = temp0(1:nel)
283 END IF
284!
285C Orthotropy
286 IF (isorth == 1)
287 . CALL smorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
288 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
289 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
290 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,nsigi,sigsp,nsigs,
291 . sigi ,ixs ,x ,jhbe ,ptsol,nel ,iparg_gr(28))
292C
293 CALL sveok3(nvc,8, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
294C
295 IF(jeul /= 0.AND.integ8 /= 0) THEN
296 CALL sderi3b(gbuf%VOL,veul(1,nf1),lveul,geo,igeo ,ngl ,pid ,
297 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
298 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
299 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
300 . volu, deltax,nel ,jeul )
301 ELSEIF (npt == 8) THEN
302 CALL sderi3b(gbuf%VOL,v8loc ,lvloc,geo ,igeo ,ngl ,pid ,
303 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
304 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
305 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
306 . volu, deltax,nel ,jeul )
307 ELSE
308C LBUF%VOL0DP is not done for Isolid=12
309 IF (jhbe == 24) THEN
310 IF(ASSOCIATED(lbuf%VOL0DP)) CALL szderi3(
311 . gbuf%VOL ,veul(1,nf1),geo ,igeo ,
312 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
313 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
314 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 ,
315 . px1 ,px2 ,px3 ,px4 ,
316 . py1 ,py2 ,py3 ,py4 ,
317 . pz1 ,pz2 ,pz3 ,pz4 ,
318 . rx ,ry ,rz ,sx ,sy ,sz ,tz ,
319 . ngl ,pid ,volu ,lbuf%VOL0DP,nel ,jeul ,nxref)
320 ELSE
321 IF(ASSOCIATED(lbuf%VOL0DP)) CALL sderi3(
322 . gbuf%VOL ,veul(1,nf1),geo ,igeo ,
323 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
324 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
325 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 ,
326 . rx ,ry ,rz ,sx ,sy ,sz ,ngl ,pid ,
327 . px1 ,px2 ,px3 ,px4 ,py1 ,py2 ,py3 ,py4 ,
328 . pz1 ,pz2 ,pz3 ,pz4, volu ,lbuf%VOL0DP,nel ,jeul,
329 . nxref,imulti_fvm)
330 ENDIF
331 CALL sdlen3(
332 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
333 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
334 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8,
335 . deltax, volu)
336 ENDIF
337 IF(jeul /= 0)THEN
338 CALL edlen3(veul(1,nf1), deltax)
339 CALL enorm3(veul(1,nf1),
340 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
341 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
342 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 )
343 ENDIF
344c
345 ipt=1
346 DO ir =1,nptr
347 DO is =1,npts
348 DO it =1,nptt
349 lbuf => elbuf_str%BUFLY(1)%LBUF(ir,is,it)
350 mbuf => elbuf_str%BUFLY(1)%MAT(ir,is,it)
351 fbuf => elbuf_str%BUFLY(1)%FAIL(ir,is,it)
352 CALL matini(pm ,ixs ,nixs ,x ,
353 2 geo ,ale_connectivity ,detonators ,iparg_gr ,
354 3 sigi ,nel ,skew ,igeo ,
355 4 ipart ,iparts ,
356 5 mat ,ipm ,nsigs ,numsol ,ptsol ,
357 6 ipt ,ngl ,npf ,tf ,bufmat ,
358 7 gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
359 8 facload, deltax ,tempel )
360 END DO
361 END DO
362 END DO
363 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
364 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
365 fbuf => elbuf_str%BUFLY(1)%FAIL(1,1,1)
366C
367C Density perturbation for /MAT/LAW115
368 IF (mtn == 115) THEN
369 CALL m115_perturb(pm ,mat ,gbuf%RHO ,perturb ,rnoise )
370 ENDIF
371C
372 IF (iboltp /=0) THEN
373 CALL sboltini(e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
374 1 gbuf%BPRELD,nel ,ixs ,nixs ,vpreload, iflag_bpreload)
375 ENDIF
376C----------------------------------------
377C Thermal and Turbulence initialization
378C----------------------------------------
379 IF(jthe /=0) CALL atheri(mat,pm ,gbuf%TEMP)
380 IF(jtur /=0) CALL aturi3(iparg ,gbuf%RHO,pm,ixs,x,
381 . gbuf%RK ,gbuf%RE,volu)
382C----------------------------------------
383C Masses initialization
384C----------------------------------------
385 IF(jlag+jale+jeul /= 0) THEN
386 IF(integ8 /= 0 .AND. jeul /= 0) THEN
387 CALL smass3b(
388 1 gbuf%RHO,mas,veul(44,nf1),lveul ,mss(1,nf1),
389 2 partsav,x ,v ,iparts(nf1),msnf ,
390 3 mssf(1,nf1),wma , rhocp ,mcp ,
391 4 mcps(1,nf1),mssa, volu,
392 5 ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
393 ELSEIF (npt == 8) THEN
394 IF (mtn >= 28) idef = 1
395 CALL sigin3b(
396 1 mat ,pm ,ipm ,gbuf%SIG ,gbuf%VOL ,
397 2 sigsp ,sigi ,gbuf%EINT,gbuf%RHO ,
398 3 ixs ,nixs ,nsigi ,nsigs ,
399 4 nel ,idef ,bufmat ,npf ,
400 5 tf ,strsglob,straglob ,jhbe ,
401 6 igtyp ,x ,gbuf%GAMA,bufly ,l_pla ,
402 7 ptsol )
403 CALL smass3b(
404 1 gbuf%RHO ,mas ,v8loc(44,1),lvloc ,mss(1,nf1) ,
405 2 partsav,x ,v ,iparts(nf1),msnf ,
406 3 mssf(1,nf1),wma , rhocp ,mcp ,
407 4 mcps(1,nf1),mssa, volu,
408 5 ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
409 ELSE
410C Case /INIBRIS/STRS_FGLO missed
411 IF (isigi /= 0 .AND. (jcvt /= 0 .OR. isorth /= 0) ) THEN
412 IF(ASSOCIATED(lbuf%VOL0DP)) CALL ustrsin3( sigi ,lbuf%SIG ,ixs ,nixs ,nsigs ,
413 . nel ,strsglob ,jhbe ,igtyp ,x ,
414 . gbuf%GAMA,ptsol ,lbuf%VOL0DP,rho0,gbuf%RHO )
415 ENDIF
416 IF (((mtn>=28 .AND. mtn/=49) .OR. mtn==14 .OR. mtn==12) .OR.
417 . (istrain == 1 .AND.
418 . (mtn==1 .OR. mtn==2 .OR. mtn==3 .OR. mtn==4 .OR.
419 . mtn==6 .OR. mtn==10 .OR. mtn==21 .OR. mtn==22 .OR.
420 . mtn==23 .OR. mtn==24))) THEN
421 idef = 1
422 ENDIF
423c
424 IF (isigi /= 0 .AND. ((mtn >= 28 .AND. iuser == 1).OR.
425 . (nvsolid2 /= 0 .and .idef /=0)))
426 . CALL userin3(
427 . sigsp ,sigi ,mbuf%VAR ,lbuf%STRA,
428 . ixs ,nixs ,nsigi ,nuvar ,nel ,
429 . nsigs ,iuser ,idef ,straglob ,jhbe ,
430 . igtyp ,x ,gbuf%GAMA,ptsol ,lbuf%SIGB,
431 . l_sigb ,mat(1) ,ipm ,bufmat ,lbuf%PLA,
432 . l_pla )
433 CALL smass3(
434 . gbuf%RHO ,mas ,partsav ,x ,v ,
435 . iparts(nf1),mss(1,nf1) ,volu ,
436 . msnf ,mssf(1,nf1),in ,
437 . vr ,ins(1,nf1) ,wma ,rhocp ,mcp ,
438 . mcps(1,nf1),mssa ,rhof ,alpha ,gbuf%FILL,
439 . ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
440 ENDIF
441C
442C------------------------------------------------------------------
443c Initialization of stress tensor in case of Orthotropic properties
444C------------------------------------------------------------------
445 IF (isigi /= 0 .AND. isorth/=0) THEN
446 lbuf%SIGL = lbuf%SIG
447 ENDIF
448C----------------------------------------
449c Failure model initialization
450C----------------------------------------
451 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
452 . ipm,sigsp,nsigi,fail_ini ,
453 . sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,mat_param)
454C--------------------------------------------------------------------
455C Compute nodal volumes and moduli for contact stiffness
456C Note : IX1, IX2 ... IX8 are in NC(MVSIZ,8)
457C--------------------------------------------------------------------
458 IF (i7stifs /= 0) THEN
459 ncc=8
460 CALL sbulk3(volu ,ix1 ,ncc,mat,pm ,
461 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
462 3 bid ,gbuf%FILL)
463 ENDIF
464 ENDIF ! End masses initialization
465C----------------------------------------
466C Cell momentum for FVM
467C----------------------------------------
468 IF(alefvm_param%IEnabled /= 0) THEN
469 CALL inimom_fvm(v , gbuf%RHO, gbuf%VOL, gbuf%MOM, ixs,
470 . ipm , mat , iparg_gr, npf , tf ,
471 . pm , lbuf%SSP, gbuf%SIG, nel
472 . )
473 ENDIF
474C------------------------------------------
475C Compute element time step
476C------------------------------------------
477 aire(:) = zero
478 dtx(:) = zero
479 CALL dtmain(geo , pm , ipm , pid , mat , fv ,
480 . gbuf%EINT, gbuf%TEMP, gbuf%DELTAX, gbuf%RK, gbuf%RE, bufmat, deltax, aire,
481 . volu, dtx, igeo ,igtyp)
482C
483 DO i=1,nel
484 IF(ixs(10,i+nft) /= 0) THEN
485 IF(igtyp /= 0 .AND.igtyp /= 6 .AND. igtyp /= 14 .AND.igtyp /= 15.AND. igtyp /= 29) THEN
486 ipid1=ixs(nixs-1,i+nft)
487 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
488 CALL ancmsg(msgid=226,
489 . msgtype=msgerror,
490 . anmode=aninfo_blind_1,
491 . i1=igeo(1,ipid1),
492 . c1=titr1,
493 . i2=igtyp)
494 ENDIF
495 ENDIF
496 dtelem(nft+i)=dtx(i)
497C
498C STI = 0.25 * RHO * VOL / (DT*DT)
499 sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i) / max(em20,dtx(i)*dtx(i))
500 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
501 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
502 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
503 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
504 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
505 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
506 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
507 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
508 ENDDO
509C--------------------------------------------------------
510C Solid to SPH : compute particles initial volume and mass
511C--------------------------------------------------------
512 IF(nsphsol/=0)THEN
513 DO i=1,nel
514 IF(sol2sph(1,nft+i) < sol2sph(2,nft+i))THEN
515 nsphdir=igeo(37,ixs(10,nft+i))
516 ncelf =sol2sph(1,nft+i)+1
517 ncell =sol2sph(2,nft+i)-sol2sph(1,nft+i)
518 CALL soltosphv8(
519 . nsphdir ,gbuf%RHO(i) ,ncell ,x ,spbuf(1,ncelf),
520 . ixs(1,i+nft),kxsp(1,ncelf),ipartsp(ncelf),
521 . irst(1,ncelf-first_sphsol+1))
522 END IF
523 ENDDO
524 END IF
525C-----------
526 RETURN
527 END SUBROUTINE sinit3
atheri
subroutine atheri(mat, pm, temp)
Definition atheri.F:41
aturi3
subroutine aturi3(iparg, rho, pm, ix, x, rk, re, volu)
Definition aturi3.F: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
edlen3
subroutine edlen3(veul, deltax)
Definition edlen3.F:29
enorm3
subroutine enorm3(veul, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8)
Definition enorm3.F:32
alpha
#define alpha
Definition eval.h:35
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
inimom_fvm
subroutine inimom_fvm(v, rho, vol, mom, ixs, ipm, mat, iparg1, npf, tf, pm, ssp, sig, nel)
Definition inimom_fvm.F:36
m115_perturb
subroutine m115_perturb(pm, mat, rho, perturb, rnoise)
Definition m115_perturb.F:30
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
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121
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
s8erefcoor3
subroutine s8erefcoor3(sav, npe, nel, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition s8erefcoor3.F:33
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
sderi3b
subroutine sderi3b(vol, veul, lvloc, geo, igeo, ngl, ngeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, det, deltax, nel, jeul)
Definition sderi3b.F:38
sigin3b
subroutine sigin3b(mat, pm, ipm, sig, vol, sigsp, sigi, eint, rho, ix, nix, nsigi, nsigs, nel, idef, bufmat, npf, tf, strsglob, straglob, jhbe, igtyp, x, bufgama, bufly, l_pla, pt)
Definition sigin3b.F:40
sinit3
subroutine sinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg_gr, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, ng, iparg, nsigi, msnf, nvc, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, in, vr, ins, wma, ptsol, bufmat, mcp, mcps, temp, xrefs, npf, tf, mssa, strsglob, straglob, fail_ini, spbuf, kxsp, ipartsp, nod2sp, sol2sph, irst, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition sinit3.F:75
sjacidp
subroutine sjacidp(xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, jac_i, nel)
Definition sjacidp.F:35
smass3
subroutine smass3(rho, ms, partsav, x, v, ipart, mss, volu, msnf, mssf, in, vr, ins, wma, rhocp, mcp, mcps, mssa, rhof, frac, fill, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition smass3.F:44
smass3b
subroutine smass3b(rho, ms, volgp, lvloc, mss, partsav, x, v, ipart, msnf, mssf, wma, rhocp, mcp, mcps, mssa, volu, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition smass3b.F:36
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
scoor3
subroutine scoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition scoor3.F:52
sderi3
subroutine sderi3(vol, veul, geo, igeo, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, jac1, jac2, jac3, jac4, jac5, jac6, ngl, ngeo, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, voldp, nel, jeul, nxref, imulti_fvm)
Definition sderi3.F:44
sdlen3
subroutine sdlen3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, deltax, voln)
Definition sdlen3.F:41
srcoor3
subroutine srcoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, jhbe, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition srcoor3.F:52
szderi3
subroutine szderi3(vol, veul, geo, igeo, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, jac1, jac2, jac3, jac4, jac5, jac6, jac9, ngl, ngeo, det, voldp, nel, jeul, nxref)
Definition szderi3.F:42
soltosphv8
subroutine soltosphv8(nsphdir, rho, ncell, x, spbuf, ixs, kxsp, ipartsp, irst)
Definition soltosph.F:336
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
starter
program starter
Definition starter.F:39
detonators_mod::detonators_struct_
Definition detonators_mod.F:154
sveok3
subroutine sveok3(nvc, nod, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
Definition sveok3.F:33
userin3
subroutine userin3(sigsp, sigi, uvar, eps, ix, nix, nsigi, nuvar, nel, nsigs, iuser, idef, straglob, jhbe, igtyp, x, bufgama, pt, sigb, l_sigb, imat, ipm, bufmat, pla, l_pla)
Definition userin3.F:38
ustrsin3
subroutine ustrsin3(sigi, sig, ix, nix, nsigi, nel, strsglob, jhbe, igtyp, x, bufgama, pt, voldp, rho0, rho)
Definition userin3.F:168