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