OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
suinit3.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!|| suinit3 ../starter/source/elements/elbuf_init/suinit3.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| dtmain ../starter/source/materials/time_step/dtmain.F
30!|| failini ../starter/source/elements/solid/solide/failini.F
31!|| fretitl2 ../starter/source/starter/freform.F
32!|| matini ../starter/source/materials/mat_share/matini.F
33!|| sbulk3 ../starter/source/elements/solid/solide/sbulk3.f
34!|| scoor3 ../starter/source/elements/solid/solide/scoor3.F
35!|| sdlen3 ../starter/source/elements/solid/solide/sdlen3.F
36!|| sini43 ../starter/source/elements/solid/sconnect/sini43.F
37!|| spcoor3 ../starter/source/elements/solid/sconnect/spcoor3.F
38!|| srcoor3 ../starter/source/elements/solid/solide/srcoor3.F
39!|| suderi3 ../starter/source/elements/elbuf_init/suderi3.F
40!|| sumass3 ../starter/source/elements/elbuf_init/suinit3.F
41!||--- uses -----------------------------------------------------
42!|| detonators_mod ../starter/share/modules1/detonators_mod.F
43!|| message_mod ../starter/share/message_module/message_mod.F
44!||====================================================================
45 SUBROUTINE suinit3(ELBUF_STR,MS ,IXS ,PM ,X ,
46 . DETONATORS,GEO ,VEUL ,ALE_CONNECTIVITY ,IPARG ,
47 . DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
48 . STIFN ,PARTSAV ,V ,IPARTS ,MSS ,
49 . IPART ,SIGSP ,GLOB_THERM,TEMP ,
50 . NSIGI ,IN ,VR ,IPM ,NSIGS ,
51 . VOLNOD ,BVOLNOD ,VNS ,BNS ,PTSOL ,
52 . BUFMAT ,NPF ,TF ,FAIL_INI ,INS ,
53 . ILOADP ,FACLOAD ,RNOISE ,PERTURB ,MAT_PARAM)
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE elbufdef_mod
58 USE message_mod
59 USE detonators_mod
60 USE ale_connectivity_mod
61 USE matparam_def_mod
62 USE names_and_titles_mod , ONLY : nchartitle
63 use glob_therm_mod
64 use element_mod , only : nixs
65C-----------------------------------------------
66C I m p l i c i t T y p e s
67C-----------------------------------------------
68#include "implicit_f.inc"
69C-----------------------------------------------
70C G l o b a l P a r a m e t e r s
71C-----------------------------------------------
72#include "mvsiz_p.inc"
73C-----------------------------------------------
74C C o m m o n B l o c k s
75C-----------------------------------------------
76#include "com01_c.inc"
77#include "com04_c.inc"
78#include "param_c.inc"
79#include "scr03_c.inc"
80#include "scr12_c.inc"
81#include "scr17_c.inc"
82#include "scry_c.inc"
83#include "vect01_c.inc"
84#include "scr15_c.inc"
85#include "userlib.inc"
86C-----------------------------------------------
87C D u m m y A r g u m e n t s
88C-----------------------------------------------
89 INTEGER IXS(NIXS,*), IPARG(NPARG),IPARTS(*),
90 . NEL, IPART(LIPART1,*),
91 . IGEO(NPROPGI,*), IPM(NPROPMI,*), PTSOL(*), NSIGI, NSIGS,
92 . NPF(*),FAIL_INI(*),PERTURB(NPERTURB)
93 my_real
94 . MS(*), X(3,*), GEO(NPROPG,*),PM(NPROPM,*),
95 . VEUL(LVEUL,*), DTELEM(*),SIGI(NSIGS,*),SKEW(LSKEW,*),STIFN(*),
96 . PARTSAV(20,*), V(3,*), MSS(8,*),RNOISE(NPERTURB,*),
97 . sigsp(nsigi,*) , in(*), vr(3,*),temp(*),
98 . volnod(*), bvolnod(*), vns(8,*), bns(8,*),bufmat(*), tf(*),
99 . ins(8,*)
100 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
101 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
102 my_real,INTENT(IN) :: FACLOAD(LFACLOAD,*)
103 TYPE(DETONATORS_STRUCT_)::DETONATORS
104 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
105 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
106 type (glob_therm_) ,intent(in) :: glob_therm
107C-----------------------------------------------
108C L o c a l V a r i a b l e s
109C-----------------------------------------------
110 INTEGER I,J,NF1,JHBE,IGTYP,IREP,NCC,NUVAR,IP,NREFSTA,
111 . ipid1,nptr,npts,nptt,nlay,iadb,mlw,ii(6)
112 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
113 . iprop(mvsiz) ,imat(mvsiz) ,sid(mvsiz),
114 . nc1(mvsiz), nc2(mvsiz), nc3(mvsiz), nc4(mvsiz),
115 . nc5(mvsiz), nc6(mvsiz), nc7(mvsiz), nc8(mvsiz)
116 CHARACTER(LEN=NCHARTITLE)::TITR1
117 CHARACTER*50 OPTION
118 my_real :: bid, fv
119 my_real ,DIMENSION(MVSIZ,8) :: mas,inn,xx,yy,zz,vx,vy,vz,vrx,vry,vrz
120 my_real ,DIMENSION(MVSIZ) :: volu,area,aire,mass,dtx,deltax,sti,stir,viscm,viscr,
121 . x1,x2,x3,x4,x5,x6,x7,x8,y1,y2,y3,y4,y5,y6,y7,y8,z1,z2,z3,z4,z5,z6,z7,z8,
122 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
123 . e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,f1x,f1y,f1z,f2x,f2y,f2z
124 my_real :: sig_loc(6,nel)
125 DOUBLE PRECISION ,DIMENSION(MVSIZ) ::
126 . xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8,
127 . yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8,
128 . zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8
129 my_real ,DIMENSION(NEL) :: tempel,thick
130C-----------------------------------------------
131 TYPE(l_bufel_) ,POINTER :: LBUF
132 TYPE(g_bufel_) ,POINTER :: GBUF
133 TYPE(buf_mat_) ,POINTER :: MBUF
134C-----------------------------------------------
135C S o u r c e L i n e s
136C=======================================================================
137 dtx(1:mvsiz) = -huge(dtx(1))
138 gbuf => elbuf_str%GBUF
139 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
140 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
141 nptr = elbuf_str%NPTR
142 npts = elbuf_str%NPTS
143 nptt = elbuf_str%NPTT
144 nlay = elbuf_str%NLAY
145 mlw = elbuf_str%BUFLY(1)%ILAW
146c
147 nrefsta = nxref
148 nxref = 0
149 bid = zero
150 jhbe = iparg(23)
151 irep = iparg(35)
152 igtyp = iparg(38)
153C
154 nf1=nft+1
155!
156 DO i=1,6
157 ii(i) = nel*(i-1)
158 ENDDO
159!
160c--------------------------
161 IF (igtyp == 43) THEN
162 CALL spcoor3(
163 . x ,ixs(1,nf1) ,geo ,nel ,mat ,pid ,ngl ,
164 . nc1 ,nc2 ,nc3 ,nc4 ,nc5 ,nc6 ,nc7 ,nc8 ,
165 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
166 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
167 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
168 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
169 . area ,thick)
170 IF (elbuf_str%GBUF%G_THK == 1) elbuf_str%GBUF%THK(1:nel) = thick(1:nel)
171 ELSEIF (jcvt == 0) THEN
172 CALL scoor3(x ,bid ,ixs(1,nf1) ,geo ,mat ,pid ,ngl ,
173 . nc1 ,nc2 ,nc3 ,nc4 ,nc5 ,nc6 ,nc7 ,nc8 ,
174 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
175 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
176 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
177 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
178 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
179 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,bid, bid,glob_therm%NINTEMP,
180 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
181 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
182 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
183 ELSE
184 CALL srcoor3(x,bid ,ixs(1,nf1) ,geo ,mat ,pid ,ngl ,jhbe ,
185 . nc1 ,nc2 ,nc3 ,nc4 ,nc5 ,nc6 ,nc7 ,nc8 ,
186 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
187 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
188 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
189 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
190 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
191 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,bid , bid,glob_therm%NINTEMP,
192 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
193 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
194 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
195 ENDIF
196!
197! Initialize element temperature from /initemp
198!
199 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
200 DO i=1,nel
201 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
202 . + temp(ixs(4,i)) + temp(ixs(5,i))
203 . + temp(ixs(6,i)) + temp(ixs(7,i))
204 . + temp(ixs(8,i)) + temp(ixs(9,i)))
205 ENDDO
206 ELSE
207 tempel(1:nel) = pm(79,mat(1:nel))
208 END IF
209c--------------------------
210 CALL suderi3(nel ,gbuf%VOL,
211 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
212 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
213 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 )
214 CALL sdlen3(
215 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
216 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
217 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8,
218 . deltax, volu)
219C
220 IF (igtyp /= 43) THEN
221 ip = 0
222 CALL matini(pm ,ixs ,nixs ,x ,
223 . geo ,ale_connectivity ,detonators,iparg ,
224 . sigi ,nel ,skew ,igeo ,
225 . ipart ,iparts ,
226 . mat ,ipm ,nsigs ,numsol ,ptsol ,
227 . ip ,ngl ,npf ,tf ,bufmat ,
228 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
229 . facload, deltax ,tempel ,mat_param )
230 ENDIF
231C-----------------------------------------------
232 DO j=1,8
233 DO i=lft,llt
234 xx(i,j)=x(1,ixs(j+1,i+nft))
235 yy(i,j)=x(2,ixs(j+1,i+nft))
236 zz(i,j)=x(3,ixs(j+1,i+nft))
237 vx(i,j)=v(1,ixs(j+1,i+nft))
238 vy(i,j)=v(2,ixs(j+1,i+nft))
239 vz(i,j)=v(3,ixs(j+1,i+nft))
240 ENDDO
241 ENDDO
242 IF (iroddl > 0) THEN
243 DO j=1,8
244 DO i=lft,llt
245 vrx(i,j)=vr(1,ixs(j+1,i+nft))
246 vry(i,j)=vr(2,ixs(j+1,i+nft))
247 vrz(i,j)=vr(3,ixs(j+1,i+nft))
248 ENDDO
249 ENDDO
250 ELSE
251 vrx=zero
252 vry=zero
253 vrz=zero
254 ENDIF
255C-----------------------------------------------
256 DO i=lft,llt
257 iprop(i)=ixs(10,i+nft)
258 sid(i) =ixs(11,i+nft)
259 imat(i) =ixs(1,i+nft)
260 ENDDO
261 iadb = ipm(7,imat(1))
262 nuvar = elbuf_str%GBUF%G_NUVAR
263C----------------------------------------
264C INITIALISATION USER: VOLUME, RHO, MASSES et INERTIES
265C----------------------------------------
266 IF(igtyp == 29)THEN
267 DO i=lft,llt
268 sig_loc(1,i) = gbuf%SIG(ii(1)+i)
269 sig_loc(2,i) = gbuf%SIG(ii(2)+i)
270 sig_loc(3,i) = gbuf%SIG(ii(3)+i)
271 sig_loc(4,i) = gbuf%SIG(ii(4)+i)
272 sig_loc(5,i) = gbuf%SIG(ii(5)+i)
273 sig_loc(6,i) = gbuf%SIG(ii(6)+i)
274 ENDDO
275 IF (userl_avail==1)THEN
276 CALL st_userlib_siniusr(igtyp,rootnam,rootlen,
277 1 nel ,nuvar ,iprop ,imat ,sid ,
278 2 gbuf%EINT,gbuf%VOL,gbuf%VAR,gbuf%OFF,gbuf%RHO,sig_loc,
279 3 xx(1,1),xx(1,2),xx(1,3),xx(1,4),xx(1,5),xx(1,6),xx(1,7),xx(1,8),
280 4 yy(1,1),yy(1,2),yy(1,3),yy(1,4),yy(1,5),yy(1,6),yy(1,7),yy(1,8),
281 5 zz(1,1),zz(1,2),zz(1,3),zz(1,4),zz(1,5),zz(1,6),zz(1,7),zz(1,8),
282 6 vx(1,1),vx(1,2),vx(1,3),vx(1,4),vx(1,5),vx(1,6),vx(1,7),vx(1,8),
283 7 vy(1,1),vy(1,2),vy(1,3),vy(1,4),vy(1,5),vy(1,6),vy(1,7),vy(1,8),
284 8 vz(1,1),vz(1,2),vz(1,3),vz(1,4),vz(1,5),vz(1,6),vz(1,7),vz(1,8),
285 9 vrx(1,1),vrx(1,2),vrx(1,3),vrx(1,4),
286 9 vrx(1,5),vrx(1,6),vrx(1,7),vrx(1,8),
287 a vry(1,1),vry(1,2),vry(1,3),vry(1,4),
288 a vry(1,5),vry(1,6),vry(1,7),vry(1,8),
289 b vrz(1,1),vrz(1,2),vrz(1,3),vrz(1,4),
290 b vrz(1,5),vrz(1,6),vrz(1,7),vrz(1,8),
291 c mas(1,1),mas(1,2),mas(1,3),mas(1,4),
292 c mas(1,5),mas(1,6),mas(1,7),mas(1,8),
293 d inn(1,1),inn(1,2),inn(1,3),inn(1,4),
294 d inn(1,5),inn(1,6),inn(1,7),inn(1,8),
295 c sti ,stir ,viscm ,viscr)
296 ELSE
297 option='/PROP/USER29'
298 CALL ancmsg(msgid=1155,
299 . anmode=aninfo,
300 . msgtype=msgerror,
301 . c1=option)
302 ENDIF ! IF (USERL_AVAIL==1)THEN
303 DO i=lft,llt
304 gbuf%SIG(ii(1)+i) = sig_loc(1,i)
305 gbuf%SIG(ii(2)+i) = sig_loc(2,i)
306 gbuf%SIG(ii(3)+i) = sig_loc(3,i)
307 gbuf%SIG(ii(4)+i) = sig_loc(4,i)
308 gbuf%SIG(ii(5)+i) = sig_loc(5,i)
309 gbuf%SIG(ii(6)+i) = sig_loc(6,i)
310 ENDDO
311 ELSEIF(igtyp == 30)THEN
312 CONTINUE
313 ELSEIF(igtyp == 31)THEN
314 CONTINUE
315 ELSEIF(igtyp == 43)THEN
316c initialization of strain, stress, uvar
317 nuvar = elbuf_str%BUFLY(1)%NVAR_MAT
318c
319 CALL sini43(elbuf_str,
320 1 mlw ,nel ,area ,gbuf%VOL ,gbuf%RHO ,
321 2 sti ,stir ,viscm ,viscr ,bufmat(iadb),
322 3 mas(1,1) ,mas(1,2) ,mas(1,3) ,mas(1,4) ,mas(1,5) ,
323 4 mas(1,6) ,mas(1,7) ,mas(1,8) ,inn(1,1) ,inn(1,2) ,
324 5 inn(1,3) ,inn(1,4) ,inn(1,5) ,inn(1,6) ,inn(1,7) ,
325 6 inn(1,8) ,pm ,mat ,gbuf%OFF ,gbuf%EINT,
326 7 ptsol ,sigsp ,nsigi ,nuvar )
327 ENDIF
328C
329 DO j=1,8
330 DO i=lft,llt
331 v(1,ixs(j+1,i+nft)) = vx(i,j)
332 v(2,ixs(j+1,i+nft)) = vy(i,j)
333 v(3,ixs(j+1,i+nft)) = vz(i,j)
334 ENDDO
335 ENDDO
336 IF (iroddl > 0) THEN
337 DO j=1,8
338 DO i=lft,llt
339 vr(1,ixs(j+1,i+nft))= vrx(i,j)
340 vr(2,ixs(j+1,i+nft))= vry(i,j)
341 vr(3,ixs(j+1,i+nft))= vrz(i,j)
342 ENDDO
343 ENDDO
344 ENDIF
345C----------------------------------------
346C initialization of masses and inertias
347C----------------------------------------
348 CALL sumass3(ms,partsav,x,v,iparts(nf1),mss(1,nf1),
349 2 mas,inn,gbuf%VOL,volu,mass,in,
350 3 nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8,
351 4 ins(1,nf1),gbuf%FILL)
352C----------------------------------------
353c Failure model initialisation
354C----------------------------------------
355 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
356 . ipm,sigsp,nsigi,fail_ini ,
357 . sigi,nsigs,ixs,nixs,ptsol,
358 . rnoise,perturb,mat_param)
359C------------------------------------------
360C assembly of nodal volumes and nodal modules
361C (for interface rigidities)
362C------------------------------------------
363C Please note: NC1, NC2 ... NC8 are in the form NC (MVSIZ, 8)
364 IF(i7stifs/=0)THEN
365 ncc=8
366 CALL sbulk3(volu ,nc1 ,ncc,mat,pm ,
367 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
368 3 bid ,gbuf%FILL)
369 ENDIF
370C------------------------------------------
371C calculation of elementary dt
372C------------------------------------------
373 aire(:) = zero
374 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
375 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
376 . volu, dtx, igeo,igtyp)
377C------------------------------------------
378 DO i=lft,llt
379 dtelem(nft+i)=dtx(i)
380 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti(i)
381 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti(i)
382 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti(i)
383 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti(i)
384 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti(i)
385 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti(i)
386 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti(i)
387 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti(i)
388 ENDDO
389 IF (igtyp/=29 .AND. igtyp/=30 .AND. igtyp/=31 .AND.
390 . igtyp/=43) THEN
391 DO i=lft,llt
392 ipid1=ixs(nixs-1,i+nft)
393 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
394 CALL ancmsg(msgid=226,
395 . msgtype=msgerror,
396 . anmode=aninfo_blind_1,
397 . i1=igeo(1,ipid1),
398 . c1=titr1,
399 . i2=igtyp)
400 ENDDO
401 ENDIF
402C
403 nxref = nrefsta
404C-----------
405 RETURN
406 END
407C
408!||====================================================================
409!|| sumass3 ../starter/source/elements/elbuf_init/suinit3.F
410!||--- called by ------------------------------------------------------
411!|| suinit3 ../starter/source/elements/elbuf_init/suinit3.F
412!||====================================================================
413 SUBROUTINE sumass3(MS,PARTSAV,X,V,IPART,MSS,
414 2 MAS,INN,VOL,VOLU,MASS,IN,
415 3 NC1, NC2, NC3, NC4, NC5, NC6, NC7, NC8,
416 4 INS,FILL)
417C-----------------------------------------------
418C I m p l i c i t T y p e s
419C-----------------------------------------------
420#include "implicit_f.inc"
421C-----------------------------------------------
422C G l o b a l P a r a m e t e r s
423C-----------------------------------------------
424#include "com01_c.inc"
425#include "mvsiz_p.inc"
426C-----------------------------------------------
427C D u m m y A r g u m e n t s
428C-----------------------------------------------
429 INTEGER IPART(*)
430C REAL
431 my_real
432 . MS(*),IN(*),X(3,*),V(3,*),PARTSAV(20,*),VOL(*),VOLU(*),MASS(*),
433 . MSS(8,*),INS(8,*) ,FILL(*)
434 INTEGER NC1(*), NC2(*), NC3(*), NC4(*), NC5(*), NC6(*), NC7(*),
435 . NC8(*)
436C-----------------------------------------------
437C C o m m o n B l o c k s
438C-----------------------------------------------
439#include "vect01_c.inc"
440C-----------------------------------------------
441C L o c a l V a r i a b l e s
442C-----------------------------------------------
443 INTEGER I, IP,I1,I2,I3,I4,I5,I6,I7,I8
444C REAL
445 my_real
446 . xx,yy,zz,xy,yz,zx,
447 . mas(mvsiz,8),inn(mvsiz,8)
448C=======================================================================
449 DO i=lft,llt
450C
451 volu(i) = vol(i)
452 mass(i) = fill(i)*(mas(i,1)+mas(i,2)+mas(i,3)+mas(i,4)
453 + + mas(i,5)+mas(i,6)+mas(i,7)+mas(i,8))*one_over_8
454 i1 = nc1(i)
455 i2 = nc2(i)
456 i3 = nc3(i)
457 i4 = nc4(i)
458 i5 = nc5(i)
459 i6 = nc6(i)
460 i7 = nc7(i)
461 i8 = nc8(i)
462C
463 mss(1,i) = mas(i,1)
464 mss(2,i) = mas(i,2)
465 mss(3,i) = mas(i,3)
466 mss(4,i) = mas(i,4)
467 mss(5,i) = mas(i,5)
468 mss(6,i) = mas(i,6)
469 mss(7,i) = mas(i,7)
470 mss(8,i) = mas(i,8)
471C
472 IF (iroddl > 0) THEN
473 ins(1,i)= inn(i,1)
474 ins(2,i)= inn(i,2)
475 ins(3,i)= inn(i,3)
476 ins(4,i)= inn(i,4)
477 ins(5,i)= inn(i,5)
478 ins(6,i)= inn(i,6)
479 ins(7,i)= inn(i,7)
480 ins(8,i)= inn(i,8)
481 ENDIF
482C
483 ip=ipart(i)
484 partsav(1,ip)=partsav(1,ip) + eight*mass(i)
485 partsav(2,ip)=partsav(2,ip) + mass(i)*
486 . (x(1,i1)+x(1,i2)+x(1,i3)+x(1,i4)
487 . +x(1,i5)+x(1,i6)+x(1,i7)+x(1,i8))
488 partsav(3,ip)=partsav(3,ip) + mass(i)*
489 . (x(2,i1)+x(2,i2)+x(2,i3)+x(2,i4)
490 . +x(2,i5)+x(2,i6)+x(2,i7)+x(2,i8))
491 partsav(4,ip)=partsav(4,ip) + mass(i)*
492 . (x(3,i1)+x(3,i2)+x(3,i3)+x(3,i4)
493 . +x(3,i5)+x(3,i6)+x(3,i7)+x(3,i8))
494 xx = (x(1,i1)*x(1,i1)+x(1,i2)*x(1,i2)
495 . +x(1,i3)*x(1,i3)+x(1,i4)*x(1,i4)
496 . +x(1,i5)*x(1,i5)+x(1,i6)*x(1,i6)
497 . +x(1,i7)*x(1,i7)+x(1,i8)*x(1,i8))
498 xy = (x(1,i1)*x(2,i1)+x(1,i2)*x(2,i2)
499 . +x(1,i3)*x(2,i3)+x(1,i4)*x(2,i4)
500 . +x(1,i5)*x(2,i5)+x(1,i6)*x(2,i6)
501 . +x(1,i7)*x(2,i7)+x(1,i8)*x(2,i8))
502 yy = (x(2,i1)*x(2,i1)+x(2,i2)*x(2,i2)
503 . +x(2,i3)*x(2,i3)+x(2,i4)*x(2,i4)
504 . +x(2,i5)*x(2,i5)+x(2,i6)*x(2,i6)
505 . +x(2,i7)*x(2,i7)+x(2,i8)*x(2,i8))
506 yz = (x(2,i1)*x(3,i1)+x(2,i2)*x(3,i2)
507 . +x(2,i3)*x(3,i3)+x(2,i4)*x(3,i4)
508 . +x(2,i5)*x(3,i5)+x(2,i6)*x(3,i6)
509 . +x(2,i7)*x(3,i7)+x(2,i8)*x(3,i8))
510 zz = (x(3,i1)*x(3,i1)+x(3,i2)*x(3,i2)
511 . +x(3,i3)*x(3,i3)+x(3,i4)*x(3,i4)
512 . +x(3,i5)*x(3,i5)+x(3,i6)*x(3,i6)
513 . +x(3,i7)*x(3,i7)+x(3,i8)*x(3,i8))
514 zx = (x(3,i1)*x(1,i1)+x(3,i2)*x(1,i2)
515 . +x(3,i3)*x(1,i3)+x(3,i4)*x(1,i4)
516 . +x(3,i5)*x(1,i5)+x(3,i6)*x(1,i6)
517 . +x(3,i7)*x(1,i7)+x(3,i8)*x(1,i8))
518 partsav(5,ip) =partsav(5,ip) + mass(i) * (yy+zz)
519 partsav(6,ip) =partsav(6,ip) + mass(i) * (zz+xx)
520 partsav(7,ip) =partsav(7,ip) + mass(i) * (xx+yy)
521 partsav(8,ip) =partsav(8,ip) - mass(i) * xy
522 partsav(9,ip) =partsav(9,ip) - mass(i) * yz
523 partsav(10,ip)=partsav(10,ip) - mass(i) * zx
524C
525 partsav(11,ip)=partsav(11,ip) + mass(i)*
526 . (v(1,i1)+v(1,i2)+v(1,i3)+v(1,i4)
527 . +v(1,i5)+v(1,i6)+v(1,i7)+v(1,i8))
528 partsav(12,ip)=partsav(12,ip) + mass(i)*
529 . (v(2,i1)+v(2,i2)+v(2,i3)+v(2,i4)
530 . +v(2,i5)+v(2,i6)+v(2,i7)+v(2,i8))
531 partsav(13,ip)=partsav(13,ip) + mass(i)*
532 . (v(3,i1)+v(3,i2)+v(3,i3)+v(3,i4)
533 . +v(3,i5)+v(3,i6)+v(3,i7)+v(3,i8))
534 partsav(14,ip)=partsav(14,ip) + half * mass(i) *
535 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1)
536 . +v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2)
537 . +v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3)
538 . +v(1,i4)*v(1,i4)+v(2,i4)*v(2,i4)+v(3,i4)*v(3,i4)
539 . +v(1,i5)*v(1,i5)+v(2,i5)*v(2,i5)+v(3,i5)*v(3,i5)
540 . +v(1,i6)*v(1,i6)+v(2,i6)*v(2,i6)+v(3,i6)*v(3,i6)
541 . +v(1,i7)*v(1,i7)+v(2,i7)*v(2,i7)+v(3,i7)*v(3,i7)
542 . +v(1,i8)*v(1,i8)+v(2,i8)*v(2,i8)+v(3,i8)*v(3,i8))
543
544 ENDDO
545C-----------
546 RETURN
547 END
548
549
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
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
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
sbulk3
subroutine sbulk3(volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)
Definition sbulk3.F:43
sini43
subroutine sini43(elbuf_str, mlw, nel, area, volg, rhog, stifm, stifr, viscm, viscr, uparam, mas1, mas2, mas3, mas4, mas5, mas6, mas7, mas8, inn1, inn2, inn3, inn4, inn5, inn6, inn7, inn8, pm, mat, offg, eintg, ptsol, sigsp, nsigi, nuvar)
Definition sini43.F:37
spcoor3
subroutine spcoor3(x, ixs, geo, nel, mxt, pid, 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, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, volu, thick)
Definition spcoor3.F:41
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
sdlen3
subroutine sdlen3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, deltax, voln)
Definition sdlen3.F:41
srcoor3
subroutine srcoor3(x, xrefs, ixs, geo, mxt, ngeo, ngl, jhbe, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8)
Definition srcoor3.F:52
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
suderi3
subroutine suderi3(nel, vol, 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 suderi3.F:32
suinit3
subroutine suinit3(elbuf_str, ms, ixs, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, mss, ipart, sigsp, glob_therm, temp, nsigi, in, vr, ipm, nsigs, volnod, bvolnod, vns, bns, ptsol, bufmat, npf, tf, fail_ini, ins, iloadp, facload, rnoise, perturb, mat_param)
Definition suinit3.F:54
sumass3
subroutine sumass3(ms, partsav, x, v, ipart, mss, mas, inn, vol, volu, mass, in, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8, ins, fill)
Definition suinit3.F:417