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