OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
scinit3.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 scinit3 (elbuf_str, mas, ixs, pm, x, mss, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, ipart, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, mssa, strsglob, straglob, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, glob_therm, mat_param)
subroutine svalue0 (rho, vol, off, sig, eint, dtx, rhog, volg, offg, sigg, eintg, dtxg, nel)
subroutine sczero3 (rhog, sigg, eintg, nel)
subroutine sdlensh (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)
subroutine clsys3 (rx, ry, rz, sx, sy, sz, vq, det, nel, mvsiz)

Function/Subroutine Documentation

◆ clsys3()

subroutine clsys3 ( intent(in) rx,
intent(in) ry,
intent(in) rz,
intent(in) sx,
intent(in) sy,
intent(in) sz,
intent(out) vq,
intent(out) det,
integer, intent(in) nel,
integer, intent(in) mvsiz )

Definition at line 717 of file scinit3.F.

718C-----------------------------------------------
719C I m p l i c i t T y p e s
720C-----------------------------------------------
721#include "implicit_f.inc"
722C-----------------------------------------------
723C D u m m y A r g u m e n t s
724C-----------------------------------------------
725 INTEGER ,INTENT(IN) :: NEL,MVSIZ
726C
727 my_real,DIMENSION(MVSIZ),INTENT(IN) ::
728 . rx , ry , rz,
729 . sx , sy , sz
730 my_real,DIMENSION(MVSIZ),INTENT(OUT) :: det
731 my_real,DIMENSION(MVSIZ,3,3),INTENT(OUT) :: vq
732C-----------------------------------------------
733C C o m m o n B l o c k s
734C-----------------------------------------------
735C---------+---------+---+---+--------------------------------------------
736C VAR | SIZE |TYP| RW| DEFINITION
737C---------+---------+---+---+--------------------------------------------
738C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
739C RX | NEL | R | R | X-of covariant vector g1
740C RY | NEL | R | R | Y-of covariant vector g1
741C RZ | NEL | R | R | Z-of covariant vector g1
742C SX | NEL | R | R | X-of covariant vector g2
743C SY | NEL | R | R | Y-of covariant vector g2
744C SZ | NEL | R | R | Z-of covariant vector g2
745C VQ |3*3*NEL | R | W | Local elem sys bases
746C DET | NEL | R | W | det of g1 ^ g2
747C---------+---------+---+---+--------------------------------------------
748C-----------------------------------------------
749C L o c a l V a r i a b l e s
750C-----------------------------------------------
751 INTEGER I
752C
753 my_real
754 . e1x(nel), e1y(nel), e1z(nel),
755 . e2x(nel), e2y(nel), e2z(nel),
756 . e3x(nel), e3y(nel), e3z(nel),
757 . c1,c2,cc,c1c1,c2c2,c1_1,c2_1
758C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
759 DO i=1,nel
760C---------E3------------
761 e3x(i) = ry(i) * sz(i) - rz(i) * sy(i)
762 e3y(i) = rz(i) * sx(i) - rx(i) * sz(i)
763 e3z(i) = rx(i) * sy(i) - ry(i) * sx(i)
764 det(i) = sqrt(e3x(i)*e3x(i) + e3y(i)*e3y(i) + e3z(i)*e3z(i))
765C ----- EM20=1.0E-20
766 det(i) = max(em20,det(i))
767 e3x(i) = e3x(i) / det(i)
768 e3y(i) = e3y(i) / det(i)
769 e3z(i) = e3z(i) / det(i)
770 ENDDO
771C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
772 DO i=1,nel
773 c1c1 = rx(i)*rx(i) + ry(i)*ry(i) + rz(i)*rz(i)
774 c2c2 = sx(i)*sx(i) + sy(i)*sy(i) + sz(i)*sz(i)
775C ----- ZERO=0., ONE=1.0
776 IF(c1c1 /= zero) THEN
777 c2_1 = sqrt(c2c2/max(em20,c1c1))
778 c1_1 = one
779 ELSEIF(c2c2 /= zero)THEN
780 c2_1 = one
781 c1_1 = sqrt(c1c1/max(em20,c2c2))
782 END IF
783 e1x(i) = rx(i)*c2_1+(sy(i)*e3z(i)-sz(i)*e3y(i))*c1_1
784 e1y(i) = ry(i)*c2_1+(sz(i)*e3x(i)-sx(i)*e3z(i))*c1_1
785 e1z(i) = rz(i)*c2_1+(sx(i)*e3y(i)-sy(i)*e3x(i))*c1_1
786 ENDDO
787C
788 DO i=1,nel
789 c1 = sqrt(e1x(i)*e1x(i) + e1y(i)*e1y(i) + e1z(i)*e1z(i))
790 IF ( c1 /= zero) c1 = one / max(em20,c1)
791 e1x(i) = e1x(i)*c1
792 e1y(i) = e1y(i)*c1
793 e1z(i) = e1z(i)*c1
794 e2x(i) = e3y(i) * e1z(i) - e3z(i) * e1y(i)
795 e2y(i) = e3z(i) * e1x(i) - e3x(i) * e1z(i)
796 e2z(i) = e3x(i) * e1y(i) - e3y(i) * e1x(i)
797 ENDDO
798 DO i=1,nel
799 vq(i,1,1)=e1x(i)
800 vq(i,2,1)=e1y(i)
801 vq(i,3,1)=e1z(i)
802 vq(i,1,2)=e2x(i)
803 vq(i,2,2)=e2y(i)
804 vq(i,3,2)=e2z(i)
805 vq(i,1,3)=e3x(i)
806 vq(i,2,3)=e3y(i)
807 vq(i,3,3)=e3z(i)
808 ENDDO
809C-----------
810 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21

◆ scinit3()

subroutine scinit3 ( type(elbuf_struct_), target elbuf_str,
mas,
integer, dimension(nixs,*) ixs,
pm,
x,
mss,
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,
integer, dimension(lipart1,*) ipart,
sigsp,
integer nsigi,
msnf,
mssf,
integer, dimension(npropmi,*) ipm,
integer iuser,
integer nsigs,
volnod,
bvolnod,
vns,
bns,
wma,
integer, dimension(*) ptsol,
bufmat,
mcp,
mcps,
temp,
integer, dimension(*) npf,
tf,
mssa,
integer, dimension(*) strsglob,
integer, dimension(*) straglob,
integer, dimension(*) orthoglob,
integer, dimension(*) fail_ini,
integer, dimension(sizloadp,*), intent(in) iloadp,
dimension(lfacload,*), intent(in) facload,
rnoise,
integer, dimension(nperturb) perturb,
type (glob_therm_), intent(in) glob_therm,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param )

Definition at line 48 of file scinit3.F.

59C-----------------------------------------------
60C D e s c r i p t i o n
61C Initialize 8-nodes thick shell HQEPH, co-rotational formulation
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE message_mod
66 USE elbufdef_mod
67 USE detonators_mod
68 USE ale_connectivity_mod
69 USE names_and_titles_mod , ONLY : nchartitle
70 USE glob_therm_mod
71 USE matparam_def_mod
72 use element_mod , only : nixs
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 "scr12_c.inc"
87#include "scr17_c.inc"
88#include "scry_c.inc"
89#include "vect01_c.inc"
90C-----------------------------------------------
91C D u m m y A r g u m e n t s
92C-----------------------------------------------
93 INTEGER NEL,NSIGI, IUSER, NSIGS
94 INTEGER IXS(NIXS,*),IPARG(*),IPARTS(*),IPART(LIPART1,*),
95 . IPM(NPROPMI,*),PTSOL(*), NPF(*),IGEO(NPROPGI,*),
96 . STRSGLOB(*),STRAGLOB(*),ORTHOGLOB(*),FAIL_INI(*),PERTURB(NPERTURB)
97 my_real
98 . mas(*), pm(npropm,*), x(*), geo(npropg,*),
99 . veul(lveul,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),stifn(*),
100 . partsav(20,*), v(*), mss(8,*),
101 . sigsp(nsigi, *),msnf(*), mssf(8,*), wma(*),
102 . volnod(*), bvolnod(*), vns(8,*), bns(8,*), bufmat(*),
103 . mcp(*),mcps(8,*),temp(*), tf(*), mssa(*),rnoise(nperturb,*)
104 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
105 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
106 my_real,INTENT(IN) :: facload(lfacload,*)
107 TYPE(DETONATORS_STRUCT_)::DETONATORS
108 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
109 type (glob_therm_) ,intent(in) :: glob_therm
110 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
111C-----------------------------------------------
112C L o c a l V a r i a b l e s
113C-----------------------------------------------
114 INTEGER NF1, IBID, I, NLAY,IGTYP,NLYMAX,IS,NUVAR,IREP,NCC,JHBE,
115 . IDEF, IP, IPANG, IPTHK, IPPOS, IPMAT,IG,IM,MTN0,IPID1,
116 . NPTR,NPTS,NPTT,L_PLA,L_SIGB
117 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
118 . IX5(MVSIZ), IX6(MVSIZ), IX7(MVSIZ), IX8(MVSIZ)
119 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ) , MAT0(MVSIZ)
120 CHARACTER(LEN=NCHARTITLE)::TITR1
121 my_real
122 . bid, fv, sti, zi,wi
123 my_real
124 . v8loc(51,mvsiz),volu(mvsiz),dtx(mvsiz),vzl(mvsiz),vzq(mvsiz),
125 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
126 . x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
127 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
128 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
129 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
130 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,
131 . tz(mvsiz) ,e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
132 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
133 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
134 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz) ,gama(6,mvsiz),
135 . rhocp(mvsiz) ,temp0(mvsiz),angle(mvsiz),dtx0(mvsiz),
136 . deltax(mvsiz), aire(mvsiz),llsh(mvsiz)
137 my_real, DIMENSION(8,MVSIZ) :: bid8mvsiz
138 my_real, DIMENSION(MVSIZ) :: bidmvsiz
139 my_real :: tempel(nel)
140C--------------------------------
141C-----------------------------------------------
142 TYPE(G_BUFEL_) ,POINTER :: GBUF
143 TYPE(BUF_LAY_) ,POINTER :: BUFLY
144 TYPE(L_BUFEL_) ,POINTER :: LBUF
145 TYPE(BUF_MAT_) ,POINTER :: MBUF
146C-----------------------------------------------
147 my_real
148 . w_gauss(9,9),a_gauss(9,9)
149C-----------------------------------------------
150 DATA w_gauss /
151 1 2. ,0. ,0. ,
152 1 0. ,0. ,0. ,
153 1 0. ,0. ,0. ,
154 2 1. ,1. ,0. ,
155 2 0. ,0. ,0. ,
156 2 0. ,0. ,0. ,
157 3 0.555555555555556,0.888888888888889,0.555555555555556,
158 3 0. ,0. ,0. ,
159 3 0. ,0. ,0. ,
160 4 0.347854845137454,0.652145154862546,0.652145154862546,
161 4 0.347854845137454,0. ,0. ,
162 4 0. ,0. ,0. ,
163 5 0.236926885056189,0.478628670499366,0.568888888888889,
164 5 0.478628670499366,0.236926885056189,0. ,
165 5 0. ,0. ,0. ,
166 6 0.171324492379170,0.360761573048139,0.467913934572691,
167 6 0.467913934572691,0.360761573048139,0.171324492379170,
168 6 0. ,0. ,0. ,
169 7 0.129484966168870,0.279705391489277,0.381830050505119,
170 7 0.417959183673469,0.381830050505119,0.279705391489277,
171 7 0.129484966168870,0. ,0. ,
172 8 0.101228536290376,0.222381034453374,0.313706645877887,
173 8 0.362683783378362,0.362683783378362,0.313706645877887,
174 8 0.222381034453374,0.101228536290376,0. ,
175 9 0.081274388361574,0.180648160694857,0.260610696402935,
176 9 0.312347077040003,0.330239355001260,0.312347077040003,
177 9 0.260610696402935,0.180648160694857,0.081274388361574/
178 DATA a_gauss /
179 1 0. ,0. ,0. ,
180 1 0. ,0. ,0. ,
181 1 0. ,0. ,0. ,
182 2 -.577350269189626,0.577350269189626,0. ,
183 2 0. ,0. ,0. ,
184 2 0. ,0. ,0. ,
185 3 -.774596669241483,0. ,0.774596669241483,
186 3 0. ,0. ,0. ,
187 3 0. ,0. ,0. ,
188 4 -.861136311594053,-.339981043584856,0.339981043584856,
189 4 0.861136311594053,0. ,0. ,
190 4 0. ,0. ,0. ,
191 5 -.906179845938664,-.538469310105683,0. ,
192 5 0.538469310105683,0.906179845938664,0. ,
193 5 0. ,0. ,0. ,
194 6 -.932469514203152,-.661209386466265,-.238619186083197,
195 6 0.238619186083197,0.661209386466265,0.932469514203152,
196 6 0. ,0. ,0. ,
197 7 -.949107912342759,-.741531185599394,-.405845151377397,
198 7 0. ,0.405845151377397,0.741531185599394,
199 7 0.949107912342759,0. ,0. ,
200 8 -.960289856497536,-.796666477413627,-.525532409916329,
201 8 -.183434642495650,0.183434642495650,0.525532409916329,
202 8 0.796666477413627,0.960289856497536,0. ,
203 9 -.968160239507626,-.836031107326636,-.613371432700590,
204 9 -.324253423403809,0. ,0.324253423403809,
205 9 0.613371432700590,0.836031107326636,0.968160239507626/
206C-----------------------------------------------
207C S o u r c e L i n e s
208C=======================================================================
209 gbuf => elbuf_str%GBUF
210 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
211 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
212 bufly => elbuf_str%BUFLY(1)
213 nptr = elbuf_str%NPTR
214 npts = elbuf_str%NPTS
215 nptt = elbuf_str%NPTT
216 nlay = elbuf_str%NLAY
217C
218 jeul = iparg(11)
219 irep = iparg(35)
220 igtyp = iparg(38)
221 jhbe = iparg(23)
222 nf1=nft+1
223 IF (jcvt==1.AND.isorth/=0) jcvt=2
224 IF (igtyp /= 22) isorth = 0
225 ibid = 0
226 idef = 0
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
232 CALL sccoor3(x ,ixs(1,nf1),geo ,mat ,pid ,ngl ,
233 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
234 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
235 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
236 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
237 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
238 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
239 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0, temp,glob_therm%NINTEMP)
240 IF (igtyp == 21 .OR. igtyp == 22) THEN
241 DO i=1,nel
242 angle(i) = geo(1,pid(i))
243 END DO
244 CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
245 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
246 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
247 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1) ,1 ,
248 . orthoglob,ptsol,nel)
249 IF (igtyp == 22) THEN
250 nlymax= 200
251 ipang = 200
252 ipthk = ipang+nlymax
253 ippos = ipthk+nlymax
254 ipmat = 100
255 ig=pid(1)
256 mtn0=mtn
257 DO i=1,nel
258 mat0(i) = mat(i)
259 dtx0(i) = ep20
260 ENDDO
261 END IF
262 END IF
263 CALL scderi3(nel,gbuf%VOL,jeul,veul(1,nf1),geo ,
264 . vzl ,vzq ,ngl ,pid ,
265 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
266 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
267 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 , volu)
268C
269 CALL sdlen3(x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
270 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
271 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
272 . deltax, volu)
273 IF (idttsh > 0) THEN
274 CALL sdlensh(nel,llsh,
275 . x1, x2, x3, x4, x5, x6, x7, x8,
276 . y1, y2, y3, y4, y5, y6, y7, y8,
277 . z1, z2, z3, z4, z5, z6, z7, z8)
278 DO i=1,nel
279 IF (gbuf%IDT_TSH(i)>0)
280 . deltax(i)=max(llsh(i),deltax(i))
281 ENDDO
282 END IF
283C
284 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
285 DO i=1,nel
286 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
287 . + temp(ixs(4,i)) + temp(ixs(5,i))
288 . + temp(ixs(6,i)) + temp(ixs(7,i))
289 . + temp(ixs(8,i)) + temp(ixs(9,i)))
290 ENDDO
291 ELSE
292 tempel(1:nel) = temp0(1:nel)
293 END IF
294!
295 ip=0
296 CALL matini(pm ,ixs ,nixs ,x ,
297 . geo ,ale_connectivity ,detonators ,iparg ,
298 . sigi ,nel ,skew ,igeo ,
299 . ipart ,iparts ,
300 . mat ,ipm ,nsigs ,numsol ,ptsol ,
301 . ip ,ngl ,npf ,tf ,bufmat ,
302 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
303 . facload, deltax ,tempel ,mat_param )
304C
305 IF (igtyp == 22) CALL sczero3(gbuf%RHO,gbuf%SIG,gbuf%EINT,nel)
306C----------------------------------------
307C Thermal initialization
308 IF(jthe /=0) CALL atheri(mat,pm,gbuf%TEMP)
309C------------------------
310C Loop on integration points
311 DO is=1,nlay
312C
313 lbuf => elbuf_str%BUFLY(is)%LBUF(1,1,1)
314 mbuf => elbuf_str%BUFLY(is)%MAT(1,1,1)
315 l_pla = elbuf_str%BUFLY(is)%L_PLA
316 l_sigb= elbuf_str%BUFLY(is)%L_SIGB
317C
318 IF (igtyp == 22) THEN
319 zi = geo(ippos+is,ig)
320 wi = geo(ipthk+is,ig)
321 im=igeo(ipmat+is,ig)
322 mtn=nint(pm(19,im))
323 DO i=1,nel
324 mat(i)=im
325 angle(i) = geo(ipang+is,pid(i))
326 ENDDO
327 ELSE
328 zi = a_gauss(is,nlay)
329 wi = w_gauss(is,nlay)
330 ENDIF
331 DO i=1,nel
332 lbuf%VOL0DP(i) = half*wi*(gbuf%VOL(i)+vzl(i)*zi)
333 lbuf%VOL(i) = lbuf%VOL0DP(i)
334 ENDDO
335 IF (igtyp == 22)
336 . CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,lbuf%GAMA ,
337 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
338 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
339 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1) ,is ,
340 . orthoglob,ptsol,nel)
341C
342 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
343 DO i=1,nel
344 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
345 . + temp(ixs(4,i)) + temp(ixs(5,i))
346 . + temp(ixs(6,i)) + temp(ixs(7,i))
347 . + temp(ixs(8,i)) + temp(ixs(9,i)))
348 ENDDO
349 ELSE
350 tempel(1:nel) = temp0(1:nel)
351 END IF
352!
353 CALL matini(pm ,ixs ,nixs ,x ,
354 . geo ,ale_connectivity ,detonators ,iparg ,
355 . sigi ,nel ,skew ,igeo ,
356 . ipart ,iparts,
357 . mat ,ipm ,nsigs ,numsol ,ptsol,
358 . is ,ngl ,npf ,tf ,bufmat,
359 . gbuf ,lbuf ,mbuf ,elbuf_str,iloadp,
360 . facload, deltax ,tempel ,mat_param )
361c
362 nuvar = elbuf_str%BUFLY(is)%NVAR_MAT
363 IF(mtn>=28)THEN
364 idef =1
365 ELSE
366 IF(mtn == 14 .OR. mtn == 12)THEN
367 idef =1
368 ELSEIF(mtn == 24)THEN
369 idef =1
370 ELSEIF(istrain == 1)THEN
371 IF(mtn == 1)THEN
372 idef =1
373 ELSEIF(mtn == 2)THEN
374 idef =1
375 ELSEIF(mtn == 4)THEN
376 idef =1
377 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10.OR.
378 . mtn == 21.OR.mtn == 22.OR.mtn == 23.
379 . or.mtn == 49)THEN
380 idef =1
381 ENDIF
382 ENDIF
383 ENDIF
384c
385 CALL sigin20b(lbuf%SIG,
386 . pm, lbuf%VOL,sigsp,sigi,lbuf%EINT,lbuf%RHO,mbuf%VAR ,
387 . lbuf%STRA,ixs ,nixs,nsigi, is, nuvar,nel,iuser,idef,
388 . nsigs,strsglob,straglob,jhbe,igtyp,x,gbuf%GAMA,
389 . mat ,lbuf%PLA,l_pla,ptsol,lbuf%SIGB,l_sigb,ipm ,
390 . bufmat,lbuf%VOL0DP)
391 IF(igtyp == 22) THEN
392C
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 Average density, stresses, ...
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 ! IS=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 Masses initialization
413 bid8mvsiz(1:8,1:mvsiz) = zero
414 bidmvsiz(1:mvsiz) = zero
415 CALL smass3(
416 . gbuf%RHO ,mas ,partsav ,x ,v ,
417 . iparts(nf1),mss(1,nf1),volu ,
418 . msnf ,mssf(1,nf1),bid ,
419 . bid ,bid8mvsiz ,wma ,rhocp ,mcp ,
420 . mcps(1,nf1),mssa ,bidmvsiz ,bidmvsiz ,gbuf%FILL,
421 . ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
422C----------------------------------------
423C Failure model initialization
424 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
425 . ipm,sigsp,nsigi,fail_ini ,
426 . sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,bufmat)
427C------------------------------------------
428C Assemble nodal volumes and moduli for interface stiffness
429C Warning : IX1, IX2 ... IX8 <=> NC(MVSIZ,8)
430 IF(i7stifs/=0)THEN
431 ncc=8
432 CALL sbulk3(volu ,ix1 ,ncc,mat,pm ,
433 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
434 3 bid ,gbuf%FILL)
435 ENDIF
436C------------------------------------------
437C Time Step element
438 aire(:) = zero
439 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
440 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
441 . volu, dtx , igeo ,igtyp)
442C
443 IF(igtyp == 22) THEN
444 DO i=1,nel
445 dtx(i)=dtx0(i)
446 ENDDO
447 ENDIF
448C
449 DO i=1,nel
450 IF (ixs(10,i+nft) /= 0) THEN
451 IF (igtyp < 20 .OR. igtyp > 22) THEN
452 ipid1=ixs(nixs-1,i+nft)
453 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
454 CALL ancmsg(msgid=226,
455 . msgtype=msgerror,
456 . anmode=aninfo_blind_1,
457 . i1=igeo(1,ipid1),
458 . c1=titr1,
459 . i2=igtyp)
460 ENDIF
461 ENDIF
462 dtelem(nft+i)=dtx(i)
463C STI = 0.25 * RHO * VOL / (DT*DT)
464 sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i) /
465 . max(em20,dtx(i)*dtx(i))
466 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
467 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
468 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
469 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
470 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
471 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
472 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
473 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
474 END DO
475C-----------
476 RETURN
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
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
sbulk3
subroutine sbulk3(volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)
Definition sbulk3.F:43
sccoor3
subroutine sccoor3(x, 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, r11, r21, r31, r12, r22, r32, r13, r23, r33, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp)
Definition sccoor3.F:43
sczero3
subroutine sczero3(rhog, sigg, eintg, nel)
Definition scinit3.F:535
sdlensh
subroutine sdlensh(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)
Definition scinit3.F:574
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
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
scderi3
subroutine scderi3(nel, vol, jeul, veul, geo, vzl, vzq, 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)
Definition scderi3.F:37
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

◆ sczero3()

subroutine sczero3 ( rhog,
sigg,
eintg,
integer nel )

Definition at line 534 of file scinit3.F.

535C-----------------------------------------------
536C I m p l i c i t T y p e s
537C-----------------------------------------------
538#include "implicit_f.inc"
539C-----------------------------------------------
540C D u m m y A r g u m e n t s
541C-----------------------------------------------
542 INTEGER NEL
543 my_real
544 . sigg(nel,6),eintg(*),rhog(*)
545C-----------------------------------------------
546C L o c a l V a r i a b l e s
547C-----------------------------------------------
548 INTEGER I
549C
550 DO i=1,nel
551 sigg(i,1) = zero
552 sigg(i,2) = zero
553 sigg(i,3) = zero
554 sigg(i,4) = zero
555 sigg(i,5) = zero
556 sigg(i,6) = zero
557 rhog(i) = zero
558 eintg(i) = zero
559 ENDDO
560C
561 RETURN

◆ sdlensh()

subroutine sdlensh ( integer nel,
intent(out) llsh,
intent(in) x1,
intent(in) x2,
intent(in) x3,
intent(in) x4,
intent(in) x5,
intent(in) x6,
intent(in) x7,
intent(in) x8,
intent(in) y1,
intent(in) y2,
intent(in) y3,
intent(in) y4,
intent(in) y5,
intent(in) y6,
intent(in) y7,
intent(in) y8,
intent(in) z1,
intent(in) z2,
intent(in) z3,
intent(in) z4,
intent(in) z5,
intent(in) z6,
intent(in) z7,
intent(in) z8 )

Definition at line 570 of file scinit3.F.

574C-----------------------------------------------
575C I m p l i c i t T y p e s
576C-----------------------------------------------
577#include "implicit_f.inc"
578C-----------------------------------------------
579C G l o b a l P a r a m e t e r s
580C-----------------------------------------------
581#include "mvsiz_p.inc"
582C-----------------------------------------------
583C C o m m o n B l o c k s
584C-----------------------------------------------
585#include "scr17_c.inc"
586C-----------------------------------------------
587C D u m m y A r g u m e n t s
588C-----------------------------------------------
589 INTEGER :: NEL
590 my_real,DIMENSION(MVSIZ),INTENT(IN) ::
591 . x1, x2, x3, x4, x5, x6, x7, x8,
592 . y1, y2, y3, y4, y5, y6, y7, y8,
593 . z1, z2, z3, z4, z5, z6, z7, z8
594 my_real,DIMENSION(MVSIZ),INTENT(OUT) :: llsh
595C-----------------------------------------------
596C L o c a l V a r i a b l e s
597C-----------------------------------------------
598 INTEGER I, J, N
599 my_real
600 . rx(mvsiz),ry(mvsiz),rz(mvsiz),sx(mvsiz),sy(mvsiz),sz(mvsiz),
601 . vq(mvsiz,3,3), lxyz0(3),deta1(mvsiz),xx,yy,zz,
602 . xl2(mvsiz),xl3(mvsiz),xl4(mvsiz),yl2(mvsiz),
603 . yl3(mvsiz),yl4(mvsiz),zl1(mvsiz),area(mvsiz),
604 . xn(mvsiz,4) , yn(mvsiz,4) , zn(mvsiz,4)
605 my_real
606 . al1,al2,ll(mvsiz),corel(2,4)
607 my_real
608 . x13,x24,y13,y24,l13,l24,c1,c2,thkly,posly,
609 . fac,visce,rx1,ry1,sx1,sy1,s1,fac1,fac2,faci,fac11,facdt
610C=======================================================================
611 DO i=1,nel
612 xn(i,1) = half*(x1(i)+x5(i))
613 yn(i,1) = half*(y1(i)+y5(i))
614 zn(i,1) = half*(z1(i)+z5(i))
615 xn(i,2) = half*(x2(i)+x6(i))
616 yn(i,2) = half*(y2(i)+y6(i))
617 zn(i,2) = half*(z2(i)+z6(i))
618 xn(i,3) = half*(x3(i)+x7(i))
619 yn(i,3) = half*(y3(i)+y7(i))
620 zn(i,3) = half*(z3(i)+z7(i))
621 xn(i,4) = half*(x4(i)+x8(i))
622 yn(i,4) = half*(y4(i)+y8(i))
623 zn(i,4) = half*(z4(i)+z8(i))
624 ENDDO
625C------g1,g2 :
626 DO i=1,nel
627 rx(i)=xn(i,2)+xn(i,3)-xn(i,1)-xn(i,4)
628 ry(i)=yn(i,2)+yn(i,3)-yn(i,1)-yn(i,4)
629 rz(i)=zn(i,2)+zn(i,3)-zn(i,1)-zn(i,4)
630 sx(i)=xn(i,3)+xn(i,4)-xn(i,1)-xn(i,2)
631 sy(i)=yn(i,3)+yn(i,4)-yn(i,1)-yn(i,2)
632 sz(i)=zn(i,3)+zn(i,4)-zn(i,1)-zn(i,2)
633 ENDDO
634C------Local elem. base:
635 CALL clsys3(rx, ry, rz, sx, sy, sz,
636 . vq, deta1,nel ,mvsiz)
637C------ Global -> Local Coordinate FOURTH=0.25 ;
638 DO i=1,nel
639 lxyz0(1)=fourth*(xn(i,1)+xn(i,2)+xn(i,3)+xn(i,4))
640 lxyz0(2)=fourth*(yn(i,1)+yn(i,2)+yn(i,3)+yn(i,4))
641 lxyz0(3)=fourth*(zn(i,1)+zn(i,2)+zn(i,3)+zn(i,4))
642 xx=xn(i,2)-xn(i,1)
643 yy=yn(i,2)-yn(i,1)
644 zz=zn(i,2)-zn(i,1)
645 xl2(i)=vq(i,1,1)*xx+vq(i,2,1)*yy+vq(i,3,1)*zz
646 yl2(i)=vq(i,1,2)*xx+vq(i,2,2)*yy+vq(i,3,2)*zz
647 xx=xn(i,2)-lxyz0(1)
648 yy=yn(i,2)-lxyz0(2)
649 zz=zn(i,2)-lxyz0(3)
650 zl1(i)=vq(i,1,3)*xx+vq(i,2,3)*yy+vq(i,3,3)*zz
651C
652 xx=xn(i,3)-xn(i,1)
653 yy=yn(i,3)-yn(i,1)
654 zz=zn(i,3)-zn(i,1)
655 xl3(i)=vq(i,1,1)*xx+vq(i,2,1)*yy+vq(i,3,1)*zz
656 yl3(i)=vq(i,1,2)*xx+vq(i,2,2)*yy+vq(i,3,2)*zz
657C
658 xx=xn(i,4)-xn(i,1)
659 yy=yn(i,4)-yn(i,1)
660 zz=zn(i,4)-zn(i,1)
661 xl4(i)=vq(i,1,1)*xx+vq(i,2,1)*yy+vq(i,3,1)*zz
662 yl4(i)=vq(i,1,2)*xx+vq(i,2,2)*yy+vq(i,3,2)*zz
663 area(i)=fourth*deta1(i)
664 ENDDO
665 fac = two
666 facdt = five_over_4
667C-------same as QBAT
668 IF (idt1sol>0) facdt =four_over_3
669C---- compute COREL(2,4) mean surface and area
670 DO i=1,nel
671 lxyz0(1)=fourth*(xl2(i)+xl3(i)+xl4(i))
672 lxyz0(2)=fourth*(yl2(i)+yl3(i)+yl4(i))
673 corel(1,1)=-lxyz0(1)
674 corel(1,2)=xl2(i)-lxyz0(1)
675 corel(1,3)=xl3(i)-lxyz0(1)
676 corel(1,4)=xl4(i)-lxyz0(1)
677 corel(2,1)=-lxyz0(2)
678 corel(2,2)=yl2(i)-lxyz0(2)
679 corel(2,3)=yl3(i)-lxyz0(2)
680 corel(2,4)=yl4(i)-lxyz0(2)
681 x13=(corel(1,1)-corel(1,3))*half
682 x24=(corel(1,2)-corel(1,4))*half
683 y13=(corel(2,1)-corel(2,3))*half
684 y24=(corel(2,2)-corel(2,4))*half
685C
686 l13=x13*x13+y13*y13
687 l24=x24*x24+y24*y24
688 al1=max(l13,l24)
689 c1 =corel(1,2)*corel(2,4)-corel(2,2)*corel(1,4)
690 c2 =corel(1,1)*corel(2,3)-corel(2,1)*corel(1,3)
691 al2 =max(abs(c1),abs(c2))/area(i)
692 rx1=x24-x13
693 ry1=y24-y13
694 sx1=-x24-x13
695 sy1=-y24-y13
696 c1=sqrt(rx1*rx1+ry1*ry1)
697 c2=sqrt(sx1*sx1+sy1*sy1)
698 s1=fourth*(max(c1,c2)/min(c1,c2)-one)
699 fac1=min(half,s1)+one
700 fac2=area(i)/(c1*c2)
701 fac2=3.413*max(zero,fac2-0.7071)
702 fac2=0.78+0.22*fac2*fac2*fac2
703 faci=two*fac1*fac2
704 s1 = sqrt(faci*(facdt+al2)*al1)
705 s1 = max(s1,em20)
706 llsh(i) = area(i)/s1
707 ENDDO
708C
709 RETURN
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
clsys3
subroutine clsys3(rx, ry, rz, sx, sy, sz, vq, det, nel, mvsiz)
Definition scinit3.F:718

◆ svalue0()

subroutine svalue0 ( rho,
vol,
off,
sig,
eint,
dtx,
rhog,
volg,
offg,
sigg,
eintg,
dtxg,
integer nel )

Definition at line 487 of file scinit3.F.

490C
491C-----------------------------------------------
492C I m p l i c i t T y p e s
493C-----------------------------------------------
494#include "implicit_f.inc"
495C-----------------------------------------------
496C D u m m y A r g u m e n t s
497C-----------------------------------------------
498 INTEGER NEL
499 my_real
500 . rho(*), vol(*),sig(nel,6),eint(*),off(*),dtx(*),
501 . sigg(nel,6),eintg(*),rhog(*),offg(*),volg(*),dtxg(*)
502C-----------------------------------------------
503C L o c a l V a r i a b l e s
504C-----------------------------------------------
505 INTEGER I
506 my_real
507 . fac
508C
509 DO i=1,nel
510 fac = off(i)*vol(i)/volg(i)
511 sigg(i,1) = sigg(i,1) + fac * sig(i,1)
512 sigg(i,2) = sigg(i,2) + fac * sig(i,2)
513 sigg(i,3) = sigg(i,3) + fac * sig(i,3)
514 sigg(i,4) = sigg(i,4) + fac * sig(i,4)
515 sigg(i,5) = sigg(i,5) + fac * sig(i,5)
516 sigg(i,6) = sigg(i,6) + fac * sig(i,6)
517 rhog(i) = rhog(i) + fac * rho(i)
518 eintg(i) = eintg(i) + fac * eint(i)
519 dtxg(i) = min(dtxg(i),dtx(i))
520 ENDDO
521C
522 RETURN