OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s8cinit3.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!|| s8cinit3 ../starter/source/elements/thickshell/solide8c/s8cinit3.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!|| dtmain ../starter/source/materials/time_step/dtmain.F
31!|| failini ../starter/source/elements/solid/solide/failini.F
32!|| fretitl2 ../starter/source/starter/freform.F
33!|| matini ../starter/source/materials/mat_share/matini.F
34!|| s8zderi3 ../starter/source/elements/solid/solide8z/s8zderi3.F
35!|| s8zderic3 ../starter/source/elements/solid/solide8z/s8zderi3.F
36!|| sbulk3 ../starter/source/elements/solid/solide/sbulk3.F
37!|| scmorth3 ../starter/source/elements/thickshell/solidec/scmorth3.F
38!|| scoor3 ../starter/source/elements/solid/solide/scoor3.F
39!|| sczero3 ../starter/source/elements/thickshell/solidec/scinit3.F
40!|| sdlensh14 ../starter/source/elements/thickshell/solide8c/sdlensh14.f
41!|| sigin20b ../starter/source/elements/solid/solide20/s20mass3.F
42!|| smass3 ../starter/source/elements/solid/solide/smass3.F
43!|| srcoor3 ../starter/source/elements/solid/solide/srcoor3.F
44!|| svalue0 ../starter/source/elements/thickshell/solidec/scinit3.F
45!||--- uses -----------------------------------------------------
46!|| detonators_mod ../starter/share/modules1/detonators_mod.F
47!|| message_mod ../starter/share/message_module/message_mod.F
48!||====================================================================
49 SUBROUTINE s8cinit3(ELBUF_STR,MAS ,IXS ,PM ,X ,
50 . DETONATORS,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG ,
51 . DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
52 . STIFN ,PARTSAV ,V ,IPARTS ,MSS ,
53 . IPART ,
54 . SIGSP ,NSIGI ,MSNF ,MSSF ,IPM ,
55 . IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,VNS ,
56 . BNS ,WMA ,PTSOL ,BUFMAT ,MCP ,
57 . MCPS ,TEMP ,NPF ,TF ,XREFS ,
58 . MSSA ,STRSGLOB,STRAGLOB,ORTHOGLOB,FAIL_INI ,
59 . ILOADP ,FACLOAD ,RNOISE ,PERTURB ,MAT_PARAM,GLOB_THERM)
60C-----------------------------------------------
61C D e s c r i p t i o n
62C Initialize 8-nodes thick shell HA8
63C-----------------------------------------------
64C M o d u l e s
65C-----------------------------------------------
66 USE elbufdef_mod
67 USE message_mod
68 USE detonators_mod
69 USE ale_connectivity_mod
70 USE matparam_def_mod
71 USE names_and_titles_mod , ONLY : nchartitle
72 use glob_therm_mod
73 use element_mod , only : nixs
74C-----------------------------------------------
75C I m p l i c i t T y p e s
76C-----------------------------------------------
77#include "implicit_f.inc"
78C-----------------------------------------------
79C G l o b a l P a r a m e t e r s
80C-----------------------------------------------
81#include "mvsiz_p.inc"
82C-----------------------------------------------
83C C o m m o n B l o c k s
84C-----------------------------------------------
85#include "com04_c.inc"
86#include "param_c.inc"
87#include "scr03_c.inc"
88#include "scr12_c.inc"
89#include "scr17_c.inc"
90#include "scry_c.inc"
91#include "vect01_c.inc"
92C-----------------------------------------------
93C D u m m y A r g u m e n t s
94C-----------------------------------------------
95 INTEGER IXS(NIXS,*), IPARG(*),IPARTS(*),
96 . NEL, IPART(LIPART1,*),PERTURB(NPERTURB),
97 . IPM(NPROPMI,*), PTSOL(*), NSIGI, IUSER, NSIGS, NPF(*)
98 INTEGER IGEO(NPROPGI,*),STRSGLOB(*),STRAGLOB(*),ORTHOGLOB(*),
99 . FAIL_INI(*)
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,*),
104 . SIGSP(NSIGI,*),MSNF(*), MSSF(8,*), WMA(*),RNOISE(NPERTURB,*),
105 . volnod(*), bvolnod(*), vns(8,*), bns(8,*),bufmat(*),
106 . mcp(*), mcps(8,*),temp(*), tf(*),xrefs(8,3,*), 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 (glob_therm_) ,intent(in) :: glob_therm
114C-----------------------------------------------
115C L o c a l V a r i a b l e s
116C-----------------------------------------------
117 INTEGER I,NF1,IBID,IGTYP,IP,IR,IS,IT,IL,NLAY,NPTR,NPTS,NPTT,NCC,
118 . jhbe,irep,mpt,nuvar,nuvarr,idef,nrefsta,
119 . ipthk, ippos,ig,im,mtn0,icstr,ipid1,l_pla,l_sigb
120 INTEGER PID(MVSIZ), NGL(MVSIZ),MAT(MVSIZ), MAT0(MVSIZ),
121 . ix1(mvsiz), ix2(mvsiz), ix3(mvsiz), ix4(mvsiz),
122 . ix5(mvsiz), ix6(mvsiz), ix7(mvsiz), ix8(mvsiz)
123 my_real
124 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
125 . x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
126 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
127 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
128 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
129 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
130 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
131 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
132 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
133 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz) ,
134 . ajc1(mvsiz) , ajc2(mvsiz) , ajc3(mvsiz) ,
135 . ajc4(mvsiz) , ajc5(mvsiz) , ajc6(mvsiz) ,
136 . ajc7(mvsiz) , ajc8(mvsiz) , ajc9(mvsiz) ,
137 . hx(4,mvsiz) , hy(4,mvsiz), hz(4,mvsiz),gama(6,mvsiz),
138 . smax(mvsiz) , volu(mvsiz), dtx(mvsiz), deltax(mvsiz),
139 . rhocp(mvsiz),temp0(mvsiz), aire(mvsiz),llsh(mvsiz)
140 my_real
141 . bid(mvsiz), fv, sti, wi
142 my_real
143 . angle(mvsiz),dtx0(mvsiz),wt,zr,zs,zt,zz
144 my_real :: tempel(nel)
145 DOUBLE PRECISION
146 . XD1(MVSIZ), XD2(MVSIZ), XD3(MVSIZ), XD4(MVSIZ),
147 . XD5(MVSIZ), XD6(MVSIZ), XD7(MVSIZ), XD8(MVSIZ),
148 . YD1(MVSIZ), YD2(MVSIZ), YD3(MVSIZ), YD4(MVSIZ),
149 . YD5(MVSIZ), YD6(MVSIZ), YD7(MVSIZ), YD8(MVSIZ),
150 . zd1(mvsiz), zd2(mvsiz), zd3(mvsiz), zd4(mvsiz),
151 . zd5(mvsiz), zd6(mvsiz), zd7(mvsiz), zd8(mvsiz)
152 INTEGER NLYMAX, IPMAT,IPANG
153 CHARACTER(LEN=NCHARTITLE)::TITR
154 parameter(nlymax = 200,ipmat = 100,ipang = 200)
155C-----------------------------------------------
156 TYPE(l_bufel_) ,POINTER :: LBUF
157 TYPE(G_BUFEL_) ,POINTER :: GBUF
158 TYPE(BUF_MAT_) ,POINTER :: MBUF
159C-----------------------------------------------
160 my_real
161 . W_GAUSS(9,9),A_GAUSS(9,9)
162 DATA w_gauss /
163 1 2. ,0. ,0. ,
164 1 0. ,0. ,0. ,
165 1 0. ,0. ,0. ,
166 2 1. ,1. ,0. ,
167 2 0. ,0. ,0. ,
168 2 0. ,0. ,0. ,
169 3 0.555555555555556,0.888888888888889,0.555555555555556,
170 3 0. ,0. ,0. ,
171 3 0. ,0. ,0. ,
172 4 0.347854845137454,0.652145154862546,0.652145154862546,
173 4 0.347854845137454,0. ,0. ,
174 4 0. ,0. ,0. ,
175 5 0.236926885056189,0.478628670499366,0.568888888888889,
176 5 0.478628670499366,0.236926885056189,0. ,
177 5 0. ,0. ,0. ,
178 6 0.171324492379170,0.360761573048139,0.467913934572691,
179 6 0.467913934572691,0.360761573048139,0.171324492379170,
180 6 0. ,0. ,0. ,
181 7 0.129484966168870,0.279705391489277,0.381830050505119,
182 7 0.417959183673469,0.381830050505119,0.279705391489277,
183 7 0.129484966168870,0. ,0. ,
184 8 0.101228536290376,0.222381034453374,0.313706645877887,
185 8 0.362683783378362,0.362683783378362,0.313706645877887,
186 8 0.222381034453374,0.101228536290376,0. ,
187 9 0.081274388361574,0.180648160694857,0.260610696402935,
188 9 0.312347077040003,0.330239355001260,0.312347077040003,
189 9 0.260610696402935,0.180648160694857,0.081274388361574/
190 DATA a_gauss /
191 1 0. ,0. ,0. ,
192 1 0. ,0. ,0. ,
193 1 0. ,0. ,0. ,
194 2 -.577350269189626,0.577350269189626,0. ,
195 2 0. ,0. ,0. ,
196 2 0. ,0. ,0. ,
197 3 -.774596669241483,0. ,0.774596669241483,
198 3 0. ,0. ,0. ,
199 3 0. ,0. ,0. ,
200 4 -.861136311594053,-.339981043584856,0.339981043584856,
201 4 0.861136311594053,0. ,0. ,
202 4 0. ,0. ,0. ,
203 5 -.906179845938664,-.538469310105683,0. ,
204 5 0.538469310105683,0.906179845938664,0. ,
205 5 0. ,0. ,0. ,
206 6 -.932469514203152,-.661209386466265,-.238619186083197,
207 6 0.238619186083197,0.661209386466265,0.932469514203152,
208 6 0. ,0. ,0. ,
209 7 -.949107912342759,-.741531185599394,-.405845151377397,
210 7 0. ,0.405845151377397,0.741531185599394,
211 7 0.949107912342759,0. ,0. ,
212 8 -.960289856497536,-.796666477413627,-.525532409916329,
213 8 -.183434642495650,0.183434642495650,0.525532409916329,
214 8 0.796666477413627,0.960289856497536,0. ,
215 9 -.968160239507626,-.836031107326636,-.613371432700590,
216 9 -.324253423403809,0. ,0.324253423403809,
217 9 0.613371432700590,0.836031107326636,0.968160239507626/
218C-----------------------------------------------
219C S o u r c e L i n e s
220C=======================================================================
221 gbuf => elbuf_str%GBUF
222 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
223 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
224c
225 bid(1:mvsiz) = zero
226 nrefsta = nxref
227 nxref = 0
228 DO i=1,nel
229 deltax(i)=ep30
230 ENDDO
231 jhbe = iparg(23)
232 irep = iparg(35)
233 igtyp = iparg(38)
234 IF (jcvt==1.AND.isorth/=0) jcvt=2
235C
236 nf1=nft+1
237 IF (igtyp /= 22) isorth = 0
238 icstr=iparg(17)
239C
240 DO i=1,nel
241 rhocp(i) = pm(69,ixs(1,nft+i))
242 temp0(i) = pm(79,ixs(1,nft+i))
243 ENDDO
244
245 IF (jcvt == 0) THEN
246 CALL scoor3(x ,bid(1),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,bid(1),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 ENDIF
270c
271 SELECT CASE (igtyp)
272c
273 CASE(21)
274 DO i=1,nel
275 angle(i) = geo(1,pid(i))
276 END DO
277 CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
278 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
279 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
280 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1) ,1 ,
281 . orthoglob ,ptsol,nel)
282c
283 CASE(22)
284 DO i=1,nel
285 angle(i) = geo(1,pid(i))
286 END DO
287 CALL scmorth3(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 . ngl ,angle ,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1),1 ,
291 . orthoglob ,ptsol,nel)
292 ipthk = ipang+nlymax
293 ippos = ipthk+nlymax
294 ig = pid(1)
295 mtn0 = mtn
296 DO i=1,nel
297 mat0(i) = mat(i)
298 dtx0(i) = ep20
299 ENDDO
300 END SELECT
301c
302 CALL s8zderic3(gbuf%VOL,hx, hy, hz,
303 . ajc1,ajc2,ajc3,
304 . ajc4,ajc5,ajc6,
305 . ajc7,ajc8,ajc9,smax, volu, ngl,
306 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
307 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
308 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
309 IF (idttsh > 0) THEN
310 CALL sdlensh14(nel,llsh,
311 . x1, x2, x3, x4, x5, x6, x7, x8,
312 . y1, y2, y3, y4, y5, y6, y7, y8,
313 . z1, z2, z3, z4, z5, z6, z7, z8,icstr,idt1sol)
314 END IF
315C
316!
317! initialize element temperature from /initemp
318!
319 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
320 DO i=1,nel
321 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
322 . + temp(ixs(4,i)) + temp(ixs(5,i))
323 . + temp(ixs(6,i)) + temp(ixs(7,i))
324 . + temp(ixs(8,i)) + temp(ixs(9,i)))
325 ENDDO
326 ELSE
327 tempel(1:nel) = temp0(1:nel)
328 END IF
329!
330 ip=0
331 CALL matini(pm ,ixs ,nixs ,x ,
332 . geo ,ale_connectivity ,detonators ,iparg ,
333 . sigi ,nel ,skew ,igeo ,
334 . ipart ,iparts ,
335 . mat ,ipm ,nsigs ,numsol ,ptsol ,
336 . ip ,ngl ,npf ,tf ,bufmat ,
337 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
338 . facload, deltax ,tempel ,mat_param )
339C
340 CALL sczero3(gbuf%RHO,gbuf%SIG,gbuf%EINT,nel)
341C
342C Thermal initialization
343 IF(jthe /=0) CALL atheri(mat,pm,gbuf%TEMP)
344C
345 nlay = elbuf_str%NLAY
346 nptr = elbuf_str%NPTR
347 npts = elbuf_str%NPTS
348 nptt = elbuf_str%NPTT
349 it = 1
350C
351C Begin integration points
352 DO ir=1,nptr
353 DO is=1,npts
354 DO il=1,nlay
355C-----------
356 lbuf => elbuf_str%BUFLY(il)%LBUF(ir,is,it)
357 mbuf => elbuf_str%BUFLY(il)%MAT(ir,is,it)
358 l_pla = elbuf_str%BUFLY(il)%L_PLA
359 l_sigb= elbuf_str%BUFLY(il)%L_SIGB
360C
361 IF (igtyp == 22) THEN
362 wt = geo(ipthk+il,ig)
363 zz = geo(ippos+il,ig)
364 im =igeo(ipmat+il,ig)
365 mtn=nint(pm(19,im))
366 DO i=1,nel
367 mat(i)=im
368 angle(i) = geo(ipang+il,pid(i))
369 ENDDO
370 ELSE
371 zz = a_gauss(il,nlay)
372 wt = w_gauss(il,nlay)
373 ENDIF
374C----------------
375 IF (icstr == 10) THEN
376 zr = a_gauss(ir,nptr)
377 zs = a_gauss(is,npts)
378 zt = zz
379 ELSEIF (icstr == 100) THEN
380 zr = a_gauss(ir,nptr)
381 zs = zz
382 zt = a_gauss(is,npts)
383 ELSEIF (icstr == 1) THEN
384 zr = zz
385 zs = a_gauss(ir,nptr)
386 zt = a_gauss(is,npts)
387 ENDIF
388 ip = ir + ( (is-1) + (il-1)*npts )*nptr
389 wi = w_gauss(ir,nptr)*w_gauss(is,npts)*wt
390C
391 CALL s8zderi3(lbuf%VOL,veul(1,nf1),geo,
392 . zr,zs,zt,wi,
393 . hx, hy, hz,
394 . ajc1,ajc2,ajc3,
395 . ajc4,ajc5,ajc6,
396 . ajc7,ajc8,ajc9,smax, deltax, ngl,lbuf%VOL0DP)
397 IF (idttsh > 0) THEN
398 DO i=1,nel
399 IF (gbuf%IDT_TSH(i)>0)
400 . deltax(i)=max(llsh(i),deltax(i))
401 ENDDO
402 END IF
403 IF (igtyp == 22)
404 . CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,lbuf%GAMA,
405 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
406 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
407 . ngl ,angle ,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1),il ,
408 . orthoglob, ptsol,nel)
409!
410 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
411 DO i=1,nel
412 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
413 . + temp(ixs(4,i)) + temp(ixs(5,i))
414 . + temp(ixs(6,i)) + temp(ixs(7,i))
415 . + temp(ixs(8,i)) + temp(ixs(9,i)))
416 ENDDO
417 ELSE
418 tempel(1:nel) = temp0(1:nel)
419 END IF
420!
421 CALL matini(pm ,ixs ,nixs ,x ,
422 . geo ,ale_connectivity ,detonators,iparg ,
423 . sigi ,nel ,skew ,igeo ,
424 . ipart ,iparts ,
425 . mat ,ipm ,nsigs ,numsol ,ptsol ,
426 . ip ,ngl ,npf ,tf ,bufmat ,
427 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
428 . facload,deltax ,tempel ,mat_param )
429c
430 idef =0
431 IF (mtn >= 28) THEN
432 nuvar = ipm(8,ixs(1,nft+1))
433 idef =1
434 ELSE
435 nuvar = 0
436 IF (mtn == 14 .OR. mtn == 12 .OR. mtn == 24) THEN
437 idef =1
438 ELSEIF (istrain == 1 .AND.
439 . (mtn == 1 .OR. mtn == 2 .OR. mtn == 3 .OR.
440 . mtn == 4 .OR. mtn == 6 .OR. mtn == 10 .OR.
441 . mtn == 21 .OR. mtn == 22 .OR. mtn == 23 .OR.
442 . mtn == 49)) THEN
443 idef =1
444 ENDIF
445 ENDIF
446c
447 CALL sigin20b(
448 . lbuf%SIG ,pm ,lbuf%VOL ,sigsp ,
449 . sigi ,lbuf%EINT,lbuf%RHO ,mbuf%VAR ,lbuf%STRA,
450 . ixs ,nixs ,nsigi ,ip ,nuvar ,
451 . nel ,iuser ,idef ,nsigs ,strsglob ,
452 . straglob ,jhbe ,igtyp ,x ,gbuf%GAMA,
453 . mat ,lbuf%PLA ,l_pla ,ptsol ,lbuf%SIGB,
454 . l_sigb ,ipm ,bufmat ,lbuf%VOL0DP)
455C
456 IF (igtyp == 22) THEN
457 aire(:) = zero
458 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
459 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
460 . volu, dtx,igeo,igtyp)
461C Average density, stresses, ...
462 CALL svalue0(
463 . lbuf%RHO,lbuf%VOL,lbuf%OFF,lbuf%SIG,lbuf%EINT,dtx,
464 . gbuf%RHO,gbuf%VOL,gbuf%OFF,gbuf%SIG,gbuf%EINT,dtx0,
465 . nel )
466 ELSE
467 CALL svalue0(
468 . lbuf%RHO,lbuf%VOL,lbuf%OFF,lbuf%SIG,lbuf%EINT,dtx,
469 . gbuf%RHO,gbuf%VOL,gbuf%OFF,gbuf%SIG,gbuf%EINT,dtx0,
470 . nel )
471 ENDIF
472C
473 ENDDO
474 ENDDO
475 ENDDO
476C-------------------------
477 IF (igtyp == 22) THEN
478 mtn=mtn0
479 DO i=1,nel
480 mat(i)=mat0(i)
481 ENDDO
482 ENDIF
483C
484C Masses initialization
485 CALL smass3(
486 . gbuf%RHO,mas,partsav,x,v,
487 . iparts(nf1),mss(1,nf1),volu ,
488 . msnf ,mssf(1,nf1) ,bid(1) ,
489 . bid(1) ,bid(1) ,wma ,rhocp ,mcp ,
490 . mcps(1,nf1) ,mssa ,bid(1) ,bid(1),gbuf%FILL,
491 . ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
492C
493C Assemble nodal volumes and moduli for interfaces stiffness
494C Warning : IX1, IX2 ... IX8 <=> NC(MVSIZ,8)
495 IF (i7stifs /= 0) THEN
496 ncc=8
497 CALL sbulk3(volu ,ix1 ,ncc,mat,pm ,
498 . volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid(1),
499 . bid(1) ,gbuf%FILL)
500 ENDIF
501C
502C Failure model initialization
503 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
504 . ipm,sigsp,nsigi,fail_ini ,
505 . sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,mat_param)
506C
507C Time Step element
508 aire(:) = zero
509 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
510 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
511 . volu, dtx,igeo,igtyp)
512c
513 IF (igtyp == 22) THEN
514 DO i=1,nel
515 dtx(i)=dtx0(i)
516 ENDDO
517 ENDIF
518 DO i=1,nel
519 IF (ixs(10,i+nft)/=0.AND.invers>14) THEN
520 IF(igtyp/=0.AND.igtyp/=6.AND.igtyp/=14.AND.igtyp/=15
521 . .AND.igtyp/=20.AND.igtyp/=21.AND.igtyp/=22)THEN
522 ipid1=ixs(nixs-1,i+nft)
523 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
524 CALL ancmsg(msgid=226,
525 . msgtype=msgerror,
526 . anmode=aninfo_blind_1,
527 . i1=igeo(1,ipid1),
528 . c1=titr,
529 . i2=igtyp)
530 ENDIF
531 ENDIF
532 dtelem(nft+i)=dtx(i)
533C STI = 0.25 * RHO * VOL / (DT*DT)
534 sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i)
535 . / max(em20,dtx(i)*dtx(i))
536 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
537 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
538 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
539 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
540 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
541 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
542 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
543 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
544 ENDDO
545c
546 nxref = nrefsta
547C-----------
548 RETURN
549 END SUBROUTINE s8cinit3
atheri
subroutine atheri(mat, pm, temp)
Definition atheri.F:42
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
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:44
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
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
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:351
s8cinit3
subroutine s8cinit3(elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, xrefs, mssa, strsglob, straglob, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, glob_therm)
Definition s8cinit3.F:60
sbulk3
subroutine sbulk3(volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)
Definition sbulk3.F:43
sczero3
subroutine sczero3(rhog, sigg, eintg, nel)
Definition scinit3.F:535
svalue0
subroutine svalue0(rho, vol, off, sig, eint, dtx, rhog, volg, offg, sigg, eintg, dtxg, nel)
Definition scinit3.F:490
scmorth3
subroutine scmorth3(pid, geo, igeo, skew, irep, gama, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, ngl, angle, nsigi, sigsp, nsigs, sigi, ixs, ilay, orthoglob, pt, nel)
Definition scmorth3.F:40
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
s8zderi3
subroutine s8zderi3(vol, veul, geo, ksi, eta, zeta, wi, hx, hy, hz, cj1, cj2, cj3, cj4, cj5, cj6, cj7, cj8, cj9, smax, deltax, ngl, voldp)
Definition s8zderi3.F:40
s8zderic3
subroutine s8zderic3(vol, hx, hy, hz, jac1, jac2, jac3, jac4, jac5, jac6, jac7, jac8, jac9, smax, det, ngl, 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 s8zderi3.F:142
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
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
sdlensh14
subroutine sdlensh14(nel, llsh, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, ics, idt1sol)
Definition sdlensh14.F:38
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:895
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
starter
program starter
Definition starter.F:39
detonators_mod::detonators_struct_
Definition detonators_mod.F:155