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

Go to the source code of this file.

Functions/Subroutines

subroutine s6cinit3 (elbuf_str, mas, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, glob_therm, sigsp, nsigi, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, ptsol, bufmat, mcp, mcps, mcpsx, temp, npf, tf, strsglob, straglob, mssa, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, mat_param, defaults_solid)
subroutine sdlensh3n (nel, llsh3n, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)

Function/Subroutine Documentation

◆ s6cinit3()

subroutine s6cinit3 ( 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(lipart1,*) ipart,
type (glob_therm_), intent(in) glob_therm,
sigsp,
integer nsigi,
integer, dimension(npropmi,*) ipm,
integer iuser,
integer nsigs,
volnod,
bvolnod,
vns,
bns,
integer, dimension(*) ptsol,
bufmat,
mcp,
mcps,
mcpsx,
temp,
integer, dimension(*) npf,
tf,
integer, dimension(*) strsglob,
integer, dimension(*) straglob,
mssa,
integer, dimension(*) orthoglob,
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 48 of file s6cinit3.F.

60C-----------------------------------------------
61C D e s c r i p t i o n
62C Initialization of thick shell PA6 element
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 defaults_mod
72 USE names_and_titles_mod , ONLY : nchartitle
73 use glob_therm_mod
74 use element_mod , only : nixs
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 "com04_c.inc"
87#include "param_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,*),sigsp(nsigi,*),
104 . volnod(*), bvolnod(*), vns(8,*), bns(8,*),bufmat(*),mcp(*),
105 . mcps(8,*), mcpsx(12,*),temp(*), tf(*), mssa(*),rnoise(nperturb,*)
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(SOLID_DEFAULTS_), INTENT(IN) :: DEFAULTS_SOLID
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,IREP,IP,ILAY,NLAY,NUVAR,NCC,JHBE,
118 . NUVARR,IDEF,IPANG,IPTHK,IPPOS,IPMAT,IG,IM,MTN0,NLYMAX,
119 . IPID1,NPTR,NPTS,NPTT,L_PLA,L_SIGB,IMAS_DS
120 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ), MAT0(MVSIZ)
121 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
122 . IX5(MVSIZ), IX6(MVSIZ)
123 my_real
124 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz), x5(mvsiz), x6(mvsiz),
125 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz), y5(mvsiz), y6(mvsiz),
126 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz), z5(mvsiz), z6(mvsiz)
127 CHARACTER(LEN=NCHARTITLE)::TITR1
128 my_real
129 . bid, fv, sti, zi,wi
130 my_real
131 . v8loc(51,mvsiz),volu(mvsiz),dtx(mvsiz),vzl(mvsiz),vzq(mvsiz),
132 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
133 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
134 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),
135 . e2x(mvsiz),e2y(mvsiz),e2z(mvsiz),
136 . e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
137 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,llsh(mvsiz) ,
138 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz) ,rhocp(mvsiz),temp0(mvsiz), deltax(mvsiz), aire(mvsiz)
139 my_real :: tempel(nel)
140C-----------------------------------------------
141 TYPE(G_BUFEL_) ,POINTER :: GBUF
142 TYPE(BUF_LAY_) ,POINTER :: BUFLY
143 TYPE(L_BUFEL_) ,POINTER :: LBUF
144 TYPE(BUF_MAT_) ,POINTER :: MBUF
145C-----------------------------------------------
146 my_real
147 . w_gauss(9,9),a_gauss(9,9),angle(mvsiz),dtx0(mvsiz)
148 DATA w_gauss /
149 1 2. ,0. ,0. ,
150 1 0. ,0. ,0. ,
151 1 0. ,0. ,0. ,
152 2 1. ,1. ,0. ,
153 2 0. ,0. ,0. ,
154 2 0. ,0. ,0. ,
155 3 0.555555555555556,0.888888888888889,0.555555555555556,
156 3 0. ,0. ,0. ,
157 3 0. ,0. ,0. ,
158 4 0.347854845137454,0.652145154862546,0.652145154862546,
159 4 0.347854845137454,0. ,0. ,
160 4 0. ,0. ,0. ,
161 5 0.236926885056189,0.478628670499366,0.568888888888889,
162 5 0.478628670499366,0.236926885056189,0. ,
163 5 0. ,0. ,0. ,
164 6 0.171324492379170,0.360761573048139,0.467913934572691,
165 6 0.467913934572691,0.360761573048139,0.171324492379170,
166 6 0. ,0. ,0. ,
167 7 0.129484966168870,0.279705391489277,0.381830050505119,
168 7 0.417959183673469,0.381830050505119,0.279705391489277,
169 7 0.129484966168870,0. ,0. ,
170 8 0.101228536290376,0.222381034453374,0.313706645877887,
171 8 0.362683783378362,0.362683783378362,0.313706645877887,
172 8 0.222381034453374,0.101228536290376,0. ,
173 9 0.081274388361574,0.180648160694857,0.260610696402935,
174 9 0.312347077040003,0.330239355001260,0.312347077040003,
175 9 0.260610696402935,0.180648160694857,0.081274388361574/
176 DATA a_gauss /
177 1 0. ,0. ,0. ,
178 1 0. ,0. ,0. ,
179 1 0. ,0. ,0. ,
180 2 -.577350269189626,0.577350269189626,0. ,
181 2 0. ,0. ,0. ,
182 2 0. ,0. ,0. ,
183 3 -.774596669241483,0. ,0.774596669241483,
184 3 0. ,0. ,0. ,
185 3 0. ,0. ,0. ,
186 4 -.861136311594053,-.339981043584856,0.339981043584856,
187 4 0.861136311594053,0. ,0. ,
188 4 0. ,0. ,0. ,
189 5 -.906179845938664,-.538469310105683,0. ,
190 5 0.538469310105683,0.906179845938664,0. ,
191 5 0. ,0. ,0. ,
192 6 -.932469514203152,-.661209386466265,-.238619186083197,
193 6 0.238619186083197,0.661209386466265,0.932469514203152,
194 6 0. ,0. ,0. ,
195 7 -.949107912342759,-.741531185599394,-.405845151377397,
196 7 0. ,0.405845151377397,0.741531185599394,
197 7 0.949107912342759,0. ,0. ,
198 8 -.960289856497536,-.796666477413627,-.525532409916329,
199 8 -.183434642495650,0.183434642495650,0.525532409916329,
200 8 0.796666477413627,0.960289856497536,0. ,
201 9 -.968160239507626,-.836031107326636,-.613371432700590,
202 9 -.324253423403809,0. ,0.324253423403809,
203 9 0.613371432700590,0.836031107326636,0.968160239507626/
204C-----------------------------------------------
205C S o u r c e L i n e s
206C=======================================================================
207 gbuf => elbuf_str%GBUF
208 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
209 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
210 bufly => elbuf_str%BUFLY(1)
211 nptr = elbuf_str%NPTR
212 npts = elbuf_str%NPTS
213 nptt = elbuf_str%NPTT
214 nlay = elbuf_str%NLAY
215C
216 jhbe = iparg(23)
217 irep = iparg(35)
218 igtyp = iparg(38)
219 nf1=nft+1
220 idef =0
221 ibid = 0
222 bid = zero
223 IF (igtyp /= 22) THEN
224 isorth = 0
225 END IF
226 imas_ds = defaults_solid%IMAS
227C
228 DO i=1,nel
229 rhocp(i) = pm(69,ixs(1,nft+i))
230 temp0(i) = pm(79,ixs(1,nft+i))
231 ENDDO
232C
233 CALL s6ccoor3(x ,ixs(1,nf1) ,geo ,ngl ,mat ,pid ,
234 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
235 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
236 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0, temp,glob_therm%NINTEMP,
237 . ix1, ix2, ix3, ix4, ix5, ix6,
238 . x1, x2, x3, x4, x5, x6,
239 . y1, y2, y3, y4, y5, y6,
240 . z1, z2, z3, z4, z5, z6)
241 IF (igtyp == 21 .OR. igtyp == 22) THEN
242 DO i=1,nel
243 angle(i) = geo(1,pid(i))
244 END DO
245 CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
246 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
247 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
248 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs ,1 ,
249 . orthoglob,ptsol,nel)
250 IF (igtyp == 22) THEN
251 nlymax= 200
252 ipang = 200
253 ipthk = ipang+nlymax
254 ippos = ipthk+nlymax
255 ipmat = 100
256 ig=pid(1)
257 mtn0=mtn
258 DO i=1,nel
259 mat0(i)=mat(i)
260 dtx0(i) = ep20
261 ENDDO
262 END IF
263 END IF
264 CALL s6cderi3(nel,gbuf%VOL,geo,vzl,ngl,deltax,volu ,
265 . x1, x2, x3, x4, x5, x6,
266 . y1, y2, y3, y4, y5, y6,
267 . z1, z2, z3, z4, z5, z6)
268 IF (idttsh > 0) THEN
269 CALL sdlensh3n(nel,llsh,
270 . x1, x2, x3, x4, x5, x6,
271 . y1, y2, y3, y4, y5, y6,
272 . z1, z2, z3, z4, z5, z6)
273 DO i=1,nel
274 IF (gbuf%IDT_TSH(i)>0)
275 . deltax(i)=max(llsh(i),deltax(i))
276 ENDDO
277 END IF
278!
279! Initialize element temperature from /initemp
280!
281 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
282 DO i=1,nel
283 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
284 . + temp(ixs(4,i)) + temp(ixs(5,i))
285 . + temp(ixs(6,i)) + temp(ixs(7,i))
286 . + temp(ixs(8,i)) + temp(ixs(9,i)))
287 ENDDO
288 ELSE
289 tempel(1:nel) = temp0(1:nel)
290 END IF
291!
292 ip=0
293 CALL matini(pm ,ixs ,nixs ,x ,
294 . geo ,ale_connectivity ,detonators ,iparg ,
295 . sigi ,nel ,skew ,igeo ,
296 . ipart ,iparts ,
297 . mat ,ipm ,nsigs ,numsol ,ptsol ,
298 . ip ,ngl ,npf ,tf ,bufmat ,
299 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
300 . facload, deltax ,tempel ,mat_param )
301C
302 IF (igtyp == 22) CALL sczero3(gbuf%RHO,gbuf%SIG,gbuf%EINT,nel)
303C----------------------------------------
304C Thermal initialization
305 IF(jthe /=0) CALL atheri(mat,pm,gbuf%TEMP)
306C-----------------------------
307C Loop on integration points
308 DO ilay=1,nlay
309 lbuf => elbuf_str%BUFLY(ilay)%LBUF(1,1,1)
310 mbuf => elbuf_str%BUFLY(ilay)%MAT(1,1,1)
311 l_pla = elbuf_str%BUFLY(ilay)%L_PLA
312 l_sigb= elbuf_str%BUFLY(ilay)%L_SIGB
313c
314 IF (igtyp == 22) THEN
315 zi = geo(ippos+ilay,ig)
316 wi = geo(ipthk+ilay,ig)
317 im=igeo(ipmat+ilay,ig)
318 mtn=nint(pm(19,im))
319 DO i=1,nel
320 mat(i)=im
321 angle(i) = geo(ipang+ilay,pid(i))
322 ENDDO
323 ELSE
324 zi = a_gauss(ilay,nlay)
325 wi = w_gauss(ilay,nlay)
326 ENDIF
327c
328 DO i=1,nel
329 lbuf%VOL0DP(i)= half*wi*(gbuf%VOL(i)+vzl(i)*zi)
330 lbuf%VOL(i)= lbuf%VOL0DP(i)
331 ENDDO
332 IF (igtyp == 22)
333 . CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,lbuf%GAMA ,
334 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
335 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
336 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs,ilay,
337 . orthoglob,ptsol,nel)
338!
339! Initialize element temperature from /initemp
340!
341 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
342 DO i=1,nel
343 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
344 . + temp(ixs(4,i)) + temp(ixs(5,i))
345 . + temp(ixs(6,i)) + temp(ixs(7,i))
346 . + temp(ixs(8,i)) + temp(ixs(9,i)))
347 ENDDO
348 ELSE
349 tempel(1:nel) = temp0(1:nel)
350 END IF
351!
352 CALL matini(pm ,ixs ,nixs ,x ,
353 . geo ,ale_connectivity ,detonators,iparg ,
354 . sigi ,nel ,skew ,igeo ,
355 . ipart ,iparts ,
356 . mat ,ipm ,nsigs ,numsol ,ptsol ,
357 . ilay ,ngl ,npf ,tf ,bufmat ,
358 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
359 . facload, deltax ,tempel ,mat_param )
360 IF (mtn >= 28) THEN
361 nuvar = ipm(8,ixs(1,nft+1))
362 idef =1
363 ELSE
364 nuvar = 0
365 IF(mtn == 14 .OR. mtn == 12)THEN
366 idef =1
367 ELSEIF(mtn == 24)THEN
368 idef =1
369 ELSEIF(istrain == 1)THEN
370 IF(mtn == 1)THEN
371 idef =1
372 ELSEIF(mtn == 2)THEN
373 idef =1
374 ELSEIF(mtn == 4)THEN
375 idef =1
376 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10
377 . .OR.mtn == 21.OR.mtn == 22.OR.mtn == 23.OR.mtn == 49)THEN
378 idef =1
379 ENDIF
380 ENDIF
381 ENDIF
382 CALL sigin20b(
383 . lbuf%SIG,pm ,lbuf%VOL ,sigsp ,
384 . sigi ,lbuf%EINT,lbuf%RHO,mbuf%VAR ,lbuf%STRA,
385 . ixs ,nixs ,nsigi ,ilay ,nuvar ,
386 . nel ,iuser ,idef ,nsigs ,strsglob ,
387 . straglob,jhbe ,igtyp ,x ,lbuf%GAMA,
388 . mat ,lbuf%PLA ,l_pla ,ptsol ,lbuf%SIGB,
389 . l_sigb ,ipm ,bufmat ,lbuf%VOL0DP)
390c
391 IF(igtyp == 22) THEN
392C moyene density,sig,...---
393 aire(:) = zero
394 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
395 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
396 . volu, dtx , igeo,igtyp)
397C
398 CALL svalue0(
399 . lbuf%RHO,lbuf%VOL,lbuf%OFF,lbuf%SIG,lbuf%EINT,dtx,
400 . gbuf%RHO,gbuf%VOL,gbuf%OFF,gbuf%SIG,gbuf%EINT,dtx0,
401 . nel )
402 ENDIF
403 ENDDO ! ILAY = 1,NLAY
404C----------------------------------------
405 IF(igtyp == 22) THEN
406 mtn=mtn0
407 DO i=1,nel
408 mat(i)=mat0(i)
409 ENDDO
410 ENDIF
411C----------------------------------------
412C Mass initialization
413 CALL s6mass3(gbuf%RHO,mas,partsav,x,v,iparts(nf1),mss(1,nf1),
414 . rhocp,mcp ,mcps(1,nf1),mssa(nf1),gbuf%FILL, volu,
415 . ix1, ix2, ix3, ix4, ix5, ix6,imas_ds)
416C----------------------------------------
417C Failure model initialization
418 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
419 . ipm,sigsp,nsigi,fail_ini ,
420 . sigi,nsigs,ixs,nixs,ptsol,
421 . rnoise,perturb,mat_param)
422C------------------------------------------
423C Assemble nodal volumes and moduli for interface stiffness
424C Warning : IX1, IX2 ... IX6 <=> NC(MVSIZ,6)
425 IF(i7stifs/=0)THEN
426 ncc=6
427 CALL sbulk3(volu ,ix1 ,ncc,mat,pm ,
428 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
429 3 bid ,gbuf%FILL)
430 ENDIF
431C------------------------------------------
432C Time Step element
433 aire(:) = zero
434 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
435 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
436 . volu, dtx, igeo,igtyp)
437C------------------------------------------
438 IF(igtyp == 22) THEN
439 DO i=1,nel
440 dtx(i)=dtx0(i)
441 ENDDO
442 ENDIF
443c
444 DO i=1,nel
445 IF(ixs(10,i+nft) /= 0) THEN
446 IF (igtyp < 20 .OR. igtyp > 22) THEN
447 ipid1=ixs(nixs-1,i+nft)
448 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
449 CALL ancmsg(msgid=226,
450 . msgtype=msgerror,
451 . anmode=aninfo_blind_1,
452 . i1=igeo(1,ipid1),
453 . c1=titr1,
454 . i2=igtyp)
455 ENDIF
456 ENDIF
457 dtelem(nft+i)=dtx(i)
458 sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i) /
459 . max(em20,dtx(i)*dtx(i))
460 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
461 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
462 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
463 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
464 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
465 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
466 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
467 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
468 ENDDO
469C-----------
470 RETURN
atheri
subroutine atheri(mat, pm, temp)
Definition atheri.F:42
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: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
s6ccoor3
subroutine s6ccoor3(x, ixs, geo, ngl, mxt, ngeo, rx, ry, rz, sx, sy, sz, tx, ty, tz, r11, r21, r31, r12, r22, r32, r13, r23, r33, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, ix1, ix2, ix3, ix4, ix5, ix6, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)
Definition s6ccoor3.F:42
sdlensh3n
subroutine sdlensh3n(nel, llsh3n, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)
Definition s6cinit3.F:481
s6mass3
subroutine s6mass3(rho, ms, partsav, x, v, ipart, mss, rhocp, mcp, mcps, mssa, fill, volu, nc1, nc2, nc3, nc4, nc5, nc6, imas_ds)
Definition s6mass3.F:34
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
s6cderi3
subroutine s6cderi3(nel, vol, geo, vzl, ngl, deltax, det, x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6, z1, z2, z3, z4, z5, z6)
Definition s6cderi3.F:39
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

◆ sdlensh3n()

subroutine sdlensh3n ( integer nel,
intent(out) llsh3n,
intent(in) x1,
intent(in) x2,
intent(in) x3,
intent(in) x4,
intent(in) x5,
intent(in) x6,
intent(in) y1,
intent(in) y2,
intent(in) y3,
intent(in) y4,
intent(in) y5,
intent(in) y6,
intent(in) z1,
intent(in) z2,
intent(in) z3,
intent(in) z4,
intent(in) z5,
intent(in) z6 )

Definition at line 477 of file s6cinit3.F.

481C-----------------------------------------------
482C I m p l i c i t T y p e s
483C-----------------------------------------------
484#include "implicit_f.inc"
485C-----------------------------------------------
486C G l o b a l P a r a m e t e r s
487C-----------------------------------------------
488#include "mvsiz_p.inc"
489C-----------------------------------------------
490C D u m m y A r g u m e n t s
491C-----------------------------------------------
492 INTEGER :: NEL
493 my_real,DIMENSION(MVSIZ),INTENT(OUT) :: llsh3n
494 my_real,DIMENSION(MVSIZ),INTENT(IN) ::
495 . x1, x2, x3, x4, x5, x6,
496 . y1, y2, y3, y4, y5, y6,
497 . z1, z2, z3, z4, z5, z6
498C-----------------------------------------------
499C L o c a l V a r i a b l e s
500C-----------------------------------------------
501 INTEGER I
502 my_real
503 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
504 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
505 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
506 . x31(mvsiz), y31(mvsiz), z31(mvsiz),
507 . x32(mvsiz), y32(mvsiz), z32(mvsiz),
508 . x21(mvsiz), y21(mvsiz), z21(mvsiz), area(mvsiz),
509 . x2l(mvsiz), x3l(mvsiz), y3l(mvsiz),
510 . xn(mvsiz,3) , yn(mvsiz,3) , zn(mvsiz,3)
511 my_real
512 . al1,al2,al3,almax,sum
513C=======================================================================
514 DO i=1,nel
515 xn(i,1) = half*(x1(i)+x4(i))
516 yn(i,1) = half*(y1(i)+y4(i))
517 zn(i,1) = half*(z1(i)+z4(i))
518 xn(i,2) = half*(x2(i)+x5(i))
519 yn(i,2) = half*(y2(i)+y5(i))
520 zn(i,2) = half*(z2(i)+z5(i))
521 xn(i,3) = half*(x3(i)+x6(i))
522 yn(i,3) = half*(y3(i)+y6(i))
523 zn(i,3) = half*(z3(i)+z6(i))
524 ENDDO
525 DO i=1,nel
526 x21(i)=xn(i,2)-xn(i,1)
527 y21(i)=yn(i,2)-yn(i,1)
528 z21(i)=zn(i,2)-zn(i,1)
529 x31(i)=xn(i,3)-xn(i,1)
530 y31(i)=yn(i,3)-yn(i,1)
531 z31(i)=zn(i,3)-zn(i,1)
532 x32(i)=xn(i,3)-xn(i,2)
533 y32(i)=yn(i,3)-yn(i,2)
534 z32(i)=zn(i,3)-zn(i,2)
535 ENDDO
536C
537 DO i=1,nel
538 e1x(i)= x21(i)
539 e1y(i)= y21(i)
540 e1z(i)= z21(i)
541 x2l(i) = sqrt(e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i))
542 e1x(i)=e1x(i)/x2l(i)
543 e1y(i)=e1y(i)/x2l(i)
544 e1z(i)=e1z(i)/x2l(i)
545 ENDDO
546C
547 DO i=1,nel
548 e3x(i)=y31(i)*z32(i)-z31(i)*y32(i)
549 e3y(i)=z31(i)*x32(i)-x31(i)*z32(i)
550 e3z(i)=x31(i)*y32(i)-y31(i)*x32(i)
551 sum = sqrt(e3x(i)*e3x(i)+e3y(i)*e3y(i)+e3z(i)*e3z(i))
552 e3x(i)=e3x(i)/sum
553 e3y(i)=e3y(i)/sum
554 e3z(i)=e3z(i)/sum
555 area(i) = half * sum
556 ENDDO
557C
558 DO i=1,nel
559 e2x(i)=e3y(i)*e1z(i)-e3z(i)*e1y(i)
560 e2y(i)=e3z(i)*e1x(i)-e3x(i)*e1z(i)
561 e2z(i)=e3x(i)*e1y(i)-e3y(i)*e1x(i)
562 sum = sqrt(e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i))
563 e2x(i)=e2x(i)/sum
564 e2y(i)=e2y(i)/sum
565 e2z(i)=e2z(i)/sum
566 y3l(i)=e2x(i)*x31(i)+e2y(i)*y31(i)+e2z(i)*z31(i)
567 x3l(i)=e1x(i)*x31(i)+e1y(i)*y31(i)+e1z(i)*z31(i)
568 ENDDO
569C
570 DO i=1,nel
571 al1 = x2l(i) * x2l(i)
572 al2 = (x3l(i)-x2l(i)) * (x3l(i)-x2l(i)) + y3l(i) * y3l(i)
573 al3 = x3l(i) * x3l(i) + y3l(i) * y3l(i)
574 almax = max(al1,al2,al3)
575 llsh3n(i)= two*area(i) / sqrt(almax)
576 ENDDO
577C
578 RETURN
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567