OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inivoid.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!|| inivoid ../starter/source/elements/initia/inivoid.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.f
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| c3coori ../starter/source/elements/sh3n/coque3n/c3coori.F
30!|| c3evec3 ../starter/source/elements/sh3n/coque3n/c3evec3.F
31!|| c3inmas ../starter/source/elements/sh3n/coque3n/c3inmas.F
32!|| c3veok3 ../starter/source/elements/sh3n/coque3n/c3veok3.F
33!|| ccoori ../starter/source/elements/shell/coque/ccoori.F
34!|| ceveci ../starter/source/elements/shell/coque/ceveci.F
35!|| cinmas ../starter/source/elements/shell/coque/cinmas.F
36!|| cveok3 ../starter/source/elements/shell/coque/cveok3.F
37!|| fretitl2 ../starter/source/starter/freform.F
38!|| pcoori ../starter/source/elements/beam/pcoori.F
39!|| pmass ../starter/source/elements/beam/pmass.F
40!|| r23mass ../starter/source/elements/spring/rmass.F
41!|| s4coor3 ../starter/source/elements/solid/solide4/s4coor3.F
42!|| s4deri3 ../starter/source/elements/solid/solide4/s4deri3.F
43!|| s4mass3 ../starter/source/elements/solid/solide4/s4mass3.F
44!|| sbulk3 ../starter/source/elements/solid/solide/sbulk3.F
45!|| scoor3 ../starter/source/elements/solid/solide/scoor3.F
46!|| sderi3 ../starter/source/elements/solid/solide/sderi3.F
47!|| sdlen3 ../starter/source/elements/solid/solide/sdlen3.F
48!|| smass3 ../starter/source/elements/solid/solide/smass3.f
49!|| tcoori ../starter/source/elements/truss/tcoori.F
50!|| tmass ../starter/source/elements/truss/tmass.F
51!||--- uses -----------------------------------------------------
52!|| defaults_mod ../starter/source/modules/defaults_mod.F90
53!|| drape_mod ../starter/share/modules1/drape_mod.F
54!|| format_mod ../starter/share/modules1/format_mod.F90
55!|| message_mod ../starter/share/message_module/message_mod.f
56!|| stack_mod ../starter/share/modules1/stack_mod.F
57!||====================================================================
58 SUBROUTINE inivoid(ELBUF_STR ,
59 + IXC ,IXS ,IXTG ,X ,V ,
60 1 PM ,GEO ,MS ,IN ,PTG ,
61 2 MSC ,MSS ,MSTG ,INC ,INTG ,
62 3 THKC ,THKT ,PARTSAV,IPARTS ,
63 4 IPARTC ,IPARTT ,VEUL ,DTELEM ,IHBE ,
64 5 ISOLNOD,NVC ,I8MI ,MSNF ,MSSF ,
65 6 IGEO ,ETNOD ,NSHNOD ,STC ,STTG ,
66 7 WMA ,SH4TREE,SH3TREE,MCP ,MCPC ,
67 8 TEMP ,MCPS ,XREFC ,XREFTG ,XREFS ,
68 9 MSSA ,VOLNOD ,BVOLNOD,VNS ,BNS ,
69 A SH3TRIM,ISUBSTACK,STACK,RNOISE ,PERTURB,
70 B ELE_AREA,PART_AREA,IPARTTR,IXT ,IPARTP,
71 C IXP ,MST ,MSP ,STT ,STP ,
72 D STRP ,INP ,STIFINT,MCPP ,INR ,
73 E MSR ,MSRT ,STR ,IPARTR ,ITAB ,
74 F IXR ,IMERGE2 , IADMERGE2,NEL,DEFAULTS,
75 G GLOB_THERM,IBEAM_VECTOR,RBEAM_VECTOR)
76C-----------------------------------------------
77C M o d u l e s
78C-----------------------------------------------
79 USE elbufdef_mod
80 USE stack_mod
81 USE message_mod
82 USE defaults_mod
84 USE format_mod , ONLY : fmt_10i
85 use glob_therm_mod
86 USE drape_mod
87 use element_mod , only : nixs,nixc,nixt,nixp,nixr,nixtg
88C-----------------------------------------------
89C I m p l i c i t T y p e s
90C-----------------------------------------------
91#include "implicit_f.inc"
92C-----------------------------------------------
93C G l o b a l P a r a m e t e r s
94C-----------------------------------------------
95#include "mvsiz_p.inc"
96C-----------------------------------------------
97C C o m m o n B l o c k s
98C-----------------------------------------------
99#include "vect01_c.inc"
100#include "param_c.inc"
101#include "scr03_c.inc"
102#include "com01_c.inc"
103#include "com04_c.inc"
104#include "scr12_c.inc"
105#include "units_c.inc"
106#include "random_c.inc"
107#include "scr17_c.inc"
108C-----------------------------------------------
109C D u m m y A r g u m e n t s
110C-----------------------------------------------
111 INTEGER NVC, IHBE, ISOLNOD, ISUBSTACK
112 INTEGER IXC(NIXC,*),IXS(NIXS,*),IXTG(NIXTG,*),
113 . IPARTS(*),IPARTC(*),IPARTT(*),IGEO(NPROPGI,*),
114 . NSHNOD(*), SH4TREE(*), SH3TREE(*),SH3TRIM(*),
115 . PERTURB(NPERTURB),IXT(NIXT,*),IPARTTR(*),IXP(NIXP,*),IPARTP(*),
116 . ITAB(*),IXR(NIXR,*),IMERGE2(NUMNOD+1),NEL,IPARTR(*),
117 . IADMERGE2(NUMNOD+1)
118 INTEGER*8 I8MI(6,*)
119 INTEGER,INTENT(IN) :: IBEAM_VECTOR(NUMELP)
120 my_real
121 . PM(NPROPM,*), GEO(NPROPG,*),MS(*),MSC(*),MSS(8,*),
122 . MSTG(*),INTG(*),PTG(3,*),IN(*),INC(*),THKC(*),THKT(*),
123 . X(3,*),V(3,*),VEUL(LVEUL,*),DTELEM(*),PARTSAV(20,*),
124 . MSNF(*), MSSF(8,*), WMA(*), ETNOD(*), STC(*), STTG(*),
125 . MCP(*),MCPC(*),TEMP(*),MCPS(8,*),
126 . XREFC(4,3,*),XREFTG(3,3,*),XREFS(8,3,*), MSSA(*), VOLNOD(*),
127 . BVOLNOD(*), BNS(8,*), VNS(8,*),RNOISE(*),PART_AREA(*),ELE_AREA(*),
128 . mst(*),msp(*),stt(*),stp(*),strp(*),inp(*),stifint(*),mcpp(*),
129 . inr(3,*),msr(3,*),msrt(*),str(*)
130 my_real,INTENT(IN) :: rbeam_vector(3,numelp)
131 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
132 TYPE(DEFAULTS_), INTENT(IN) :: DEFAULTS
133 type(glob_therm_) ,intent(inout) :: glob_therm
134C-----------------------------------------------
135C L o c a l V a r i a b l e s
136C-----------------------------------------------
137 INTEGER I, IGTYP,IMAT,IPROP, NDEPAR, NREFSTA, NCC, NF1
138 INTEGER MXT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
139 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),
140 . IX5(MVSIZ),IX6(MVSIZ),IX7(MVSIZ),IX8(MVSIZ),IBID(MVSIZ),II(6),
141 . ID, IPID, J, I0,I1,I2,I3,ITMP, KK, K,IMASS,KK1,IMAS_DS,
142 . IVECT(MVSIZ)
143 my_real
144 . AREA(MVSIZ), RHO(MVSIZ),VOL(MVSIZ),
145 . X1(MVSIZ),X2(MVSIZ),X3(MVSIZ),X4(MVSIZ),X5(MVSIZ),X6(MVSIZ),
146 . X7(MVSIZ),X8(MVSIZ),Y1(MVSIZ),Y2(MVSIZ),Y3(MVSIZ),Y4(MVSIZ),
147 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
148 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
149 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
150 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
151 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
152 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
153 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
154 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz),bid(mvsiz),rhocp(mvsiz),
155 . temp0(mvsiz) ,fill(mvsiz),bidg(mvsiz),
156 . px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
157 . py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
158 . pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),volu(mvsiz),
159 . x2l(mvsiz),x3l(mvsiz),y3l(mvsiz),
160 . x31(mvsiz),y31(mvsiz),z31(mvsiz), deltax(mvsiz),
161 . bidon, noise, xl(mvsiz),length,uiner(mvsiz),massr(mvsiz),
162 . xm, xine,ratio,kx,ems(mvsiz),rhor,vect(3,mvsiz)
163 my_real, DIMENSION(:), ALLOCATABLE :: stifntmp !numnod
164 double precision
165 . xd1(mvsiz), xd2(mvsiz), xd3(mvsiz), xd4(mvsiz),
166 . xd5(mvsiz), xd6(mvsiz), xd7(mvsiz), xd8(mvsiz),
167 . yd1(mvsiz), yd2(mvsiz), yd3(mvsiz), yd4(mvsiz),
168 . yd5(mvsiz), yd6(mvsiz), yd7(mvsiz), yd8(mvsiz),
169 . zd1(mvsiz), zd2(mvsiz), zd3(mvsiz), zd4(mvsiz),
170 . zd5(mvsiz), zd6(mvsiz), zd7(mvsiz), zd8(mvsiz),voldp(mvsiz)
171 CHARACTER(LEN=NCHARTITLE) :: TITR
172C
173 TYPE(ELBUF_STRUCT_) ,POINTER :: BIDBUF
174 TYPE (STACK_PLY) :: STACK
175 TYPE(G_BUFEL_),POINTER :: GBUF
176 TYPE (DRAPE_), DIMENSION(NUMELC_DRAPE + NUMELTG_DRAPE) :: DRAPE
177
178C-----------------------------------------------
179 ALLOCATE(STIFNTMP(NUMNOD))
180 gbuf => elbuf_str%GBUF
181
182 bidbuf => null()
183C
184 ibid(1:mvsiz) = 0
185 bid(1:mvsiz) = zero
186 nrefsta = nxref
187 nxref = 0
188 nf1=nft+1
189 IF (ity == 1.AND. ismstr == 10) ismstr = 4
190 imas_ds = defaults%SOLID%IMAS
191C--------------------------------------
192 IF(ity == 1.AND.isolnod == 4)THEN
193C Solid 4 nodes tetrahedron
194 CALL s4coor3(x ,xrefs(1,1,nft+1),ixs(1,nft+1),ngl ,
195 . mxt ,pid ,ix1 ,ix2 ,ix3 ,ix4 ,
196 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
197 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 )
198 DO i=1,nel
199 rho(i) = pm(89,mxt(i))
200 dtelem(nft+i) = ep30
201 fill(i) = one
202 rhocp(i) = pm(69,mxt(i))
203 temp0(i) = pm(79,mxt(i))
204 ENDDO
205 CALL s4deri3(vol,veul(1,nft+1) ,geo ,igeo ,rx ,
206 . ry ,rz ,sx ,sy ,
207 . sz ,tx ,ty ,tz ,
208 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
209 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
210 . px1 ,px2 ,px3 ,px4 ,
211 . py1 ,py2 ,py3 ,py4 ,
212 . pz1 ,pz2 ,pz3 ,pz4 ,bidg,
213 . deltax,volu ,ngl ,pid ,mxt ,
214 . pm ,voldp )
215 IF(jlag+jale+jeul /= 0) THEN
216 CALL s4mass3(
217 1 rho ,ms ,partsav,x ,v ,
218 2 iparts(nft+1),mss(1,nft+1),msnf ,mssf(1,nft+1),wma ,
219 3 rhocp ,mcp ,mcps(1,nft+1) ,temp0,
220 4 temp ,mssa ,ix1 ,ix2 ,ix3 ,ix4 ,
221 5 fill, volu ,imas_ds ,glob_therm%NINTEMP)
222 ENDIF
223 IF(i7stifs /= 0)THEN
224 ncc=4
225 CALL sbulk3(volu ,ix1 ,ncc,mxt,pm ,
226 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
227 3 bid ,fill )
228 ENDIF
229C------------------------------------------
230 ELSEIF(ity == 1.AND.isolnod == 10)THEN
231C Solid 10 nodes tetrahedron not supported
232 ELSEIF(ity == 1.AND.isolnod == 16)THEN
233C Solid 16 nodes brick not supported
234 ELSEIF(ity == 1.AND.isolnod == 20)THEN
235C Solid 20 nodes brick not supported
236C--------------------------------------
237 ELSEIF(ity == 1)THEN
238C Solid 8 nodes brick
239 DO i=1,nel
240 rhocp(i) = zero
241 temp0(i) = zero
242 ENDDO
243 CALL scoor3(x,xrefs(1,1,nft+1),ixs(1,nft+1),geo ,mxt ,pid ,ngl ,
244 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
245 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
246 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
247 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
248 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
249 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
250 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0, temp,glob_therm%NINTEMP,
251 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
252 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
253 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
254 IF((jeul == 0.OR.integ8 == 0).AND. npt /= 8) THEN
255 DO i=1,nel
256 rho(i) = pm(89,mxt(i))
257 dtelem(nft+i) = ep30
258 fill(i) = one
259 ENDDO
260 CALL sderi3(vol ,veul(1,nft+1) ,geo ,igeo ,
261 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
262 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
263 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 ,
264 . rx ,ry ,rz ,sx ,sy ,sz ,ngl ,pid ,
265 . px1 ,px2 ,px3 ,px4 ,py1 ,py2 ,py3 ,py4 ,
266 . pz1 ,pz2 ,pz3 ,pz4, volu ,voldp,nel ,jeul ,
267 . nxref,imulti_fvm )
268 CALL sdlen3(
269 . 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 CALL smass3(
274 1 rho , ms , partsav, x , v ,
275 2 iparts(nft+1), mss(1,nft+1) , volu ,
276 3 msnf , mssf(1,nft+1), bid ,
277 4 bid , bid , wma , rhocp, mcp,
278 5 mcps(1,nft+1), mssa ,bid , bid ,fill ,
279 6 ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
280 ENDIF
281 IF(i7stifs /= 0)THEN
282 ncc=8
283 CALL sbulk3(volu ,ix1 ,ncc,mxt,pm ,
284 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
285 3 bid ,fill )
286 ENDIF
287C--------------------------------------
288 ELSEIF (ity == 3) THEN
289C 4 nodes shell
290 imat = ixc(1,1+nft) ! material number
291 iprop = ixc(nixc-1,1+nft) ! property number
292C
293 CALL ccoori(x,xrefc(1,1,nft+1),ixc(1,nft+1),
294 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
295 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
296 . ix1 ,ix2 ,ix3 ,ix4 ,ngl )
297 CALL cveok3(nvc,4,ix1,ix2,ix3,ix4)
298C
299 CALL ceveci(lft ,llt ,area,
300 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
301 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
302 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
303C----------------------------------------------------------
304C Save element area (needed in /ADMAS for shells)
305 IF (imasadd > 0) THEN
306 DO i=1,nel
307 ele_area(i+nft) = area(i)
308 ENDDO
309 ENDIF
310C
311 CALL cinmas(x,xrefc(1,1,nft+1),ixc,geo,pm,ms,in,
312 . thkc,ihbe,partsav,v,ipartc(nft+1),
313 . msc(nft+1),inc(nft+1),area,
314 . i8mi ,igeo ,etnod ,imat ,iprop ,
315 . nshnod ,stc(nft+1),sh4tree ,mcp ,mcpc(nft+1) ,
316 . temp ,bid , bid,bid,bid,
317 . bid,bid,isubstack,ibid,bidbuf,
318 . stack,bidg ,rnoise,drape,glob_therm%NINTEMP,
319 . perturb,ix1 ,ix2 ,ix3 ,ix4 ,ibid, ibid)
320
321 ndepar=numels+nft
322 DO i=1,nel
323 dtelem(ndepar+i) = ep30
324 ENDDO
325C--------------------------------------
326 ELSEIF(ity == 7)THEN
327C 3 nodes shell
328 imat = ixtg(1,1+nft) ! material number
329 iprop = ixtg(nixtg-1,1+nft) ! property number
330C
331 CALL c3coori(x,xreftg(1,1,nft+1),ixtg(1,nft+1),ngl,
332 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
333 . z1 ,z2 ,z3 ,ix1 ,ix2 ,ix3 )
334 CALL c3veok3(nvc,ix1 ,ix2 ,ix3 )
335 CALL c3evec3(lft ,llt ,area,
336 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
337 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
338 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
339 . x31, y31, z31 ,x2l ,x3l ,y3l )
340C-------------------------------------------------
341C Save element area (needed in /ADMAS for shells)
342 IF (imasadd > 0) THEN
343 DO i=1,nel
344 ele_area(i+nft+numelc) = area(i)
345 ENDDO
346 ENDIF
347C
348 CALL c3inmas(x,xreftg(1,1,nft+1),ixtg,geo,pm,ms,in,thkt,
349 . partsav,v,ipartt(nft+1),mstg(nft+1),intg(nft+1),
350 . ptg(1,nft+1),igeo ,imat ,iprop ,area ,
351 . etnod,nshnod,sttg(nft+1), sh3tree,mcp ,
352 . mcps(1,nft+1) , temp,sh3trim,isubstack,ibid,
353 . bidbuf, stack,bidg ,rnoise, drape,
354 . perturb,ix1 ,ix2 ,ix3 ,glob_therm%NINTEMP,
355 . x2l ,x3l ,y3l ,ibid, ibid)
356
357 ndepar=numels+numelc+numelt+numelp+numelr+nft
358 DO i=1,nel
359 dtelem(ndepar+i) = ep30
360 ENDDO
361C--------------------------------------
362 ELSEIF(ity == 4)THEN
363C Truss element
364 stifntmp(1:numnod)=zero
365 CALL tcoori(x,ixt(1,nft+1),mxt, pid, ix1, ix2,
366 . x1, x2, y1, y2, z1, z2)
367C Avoid fail in output subroutine (Anim division by AREA)
368 gbuf%AREA(1:nel)= geo(1,pid(1:nel))
369 CALL tmass(x ,ixt ,geo ,pm ,ms ,
370 . stifntmp ,partsav ,v ,iparttr(nft+1),mst(nft+1),
371 . stifint,stt(nft+1) ,gbuf%AREA , mxt, ix1, ix2,
372 . x1, x2, y1, y2, z1, z2)
373 ndepar=numels+numelc+nft
374 DO i=1,nel
375 dtelem(ndepar + i) = ep30
376 ENDDO
377C--------------------------------------
378 ELSEIF(ity == 5)THEN
379C Beam element
380 stifntmp(1:numnod)=zero
381 CALL pcoori(x,ixp(1,nft+1),
382 . mxt,pid ,ix1,ix2,ix3,deltax,
383 . x1,x2,x3, y1,y2,y3, z1,z2,z3,
384 . ibeam_vector(nft+1),rbeam_vector(1,nft+1),ivect,vect)
385c
386 CALL pmass(geo,pm,
387 . stifntmp,stifntmp,partsav,v,ipartp(nft+1),
388 . msp(nft+1),inp(nft+1),igeo , stp(nft+1),
389 . x1,x2, y1,y2, z1,z2,
390 . ix1,ix2,mxt,pid,area,deltax,strp(nft+1),
391 . mcpp,temp,glob_therm%NINTEMP)
392 ndepar=numels+numelc+numelt+nft
393 DO i=1,nel
394 dtelem(ndepar+i)=ep30
395 ENDDO
396C--------------------------------------
397 ELSEIF (ity == 6) THEN
398C Spring element
399 i0=ixr(1,1+nft)
400 igtyp = igeo(11,i0)
401C
402 IF(igtyp == 23) THEN
403 bidon = zero
404 DO i=1,6
405 ii(i) = (i-1)*nel + 1
406 ENDDO
407C
408 noise = two*sqrt(three)*xalea
409C
410 DO i=1,numgeo
411 igtyp=igeo(11,i)
412 id=igeo(1,i)
413 CALL fretitl2(titr,igeo(npropgi-ltitr+1,i),ltitr)
414 IF(igtyp == 23) geo(4,i) = ep30 !
415 ENDDO ! DO I=1,NUMGEO
416C-----------------
417 ipid=ixr(1,nft+1)
418 id=igeo(1,ipid)
419 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid),ltitr)
420 DO i=1,nel
421 j=i+nft
422 i0=ixr(1,j)
423 i1=ixr(2,j)
424 i2=ixr(3,j)
425 i3=ixr(4,j)
426C----------------------- to check
427 IF (i1 == i2 .OR. i1 == i3 .OR. i2 == i3) THEN
428 IF (i1 == i2 .OR. i1 == i3) itmp = i1
429 IF (i2 == i3) itmp = i2
430 IF (imerge2(itmp) /= 0) THEN
431 CALL ancmsg(msgid=682,
432 . msgtype=msgwarning,
433 . anmode=aninfo_blind_1,
434 . i1=ixr(nixr,j),
435 . i2=itab(itmp))
436 WRITE (iout,1000) itab(itmp)
437 kk = 0
438 DO k=1,iadmerge2(itmp+1) - iadmerge2(itmp)
439 kk = kk + 1
440 IF (kk == 10) THEN
441 WRITE (iout,fmt=fmt_10i)
442 . (itab(imerge2(iadmerge2(itmp)+kk1)),kk1=0,kk-1)
443 kk = 0
444 ENDIF
445 ENDDO
446 IF (kk /= 0) THEN
447 WRITE (iout,fmt=fmt_10i)
448 . (itab(imerge2(iadmerge2(itmp)+kk1)),kk1=0,kk-1)
449 ENDIF
450 ELSE
451 CALL ancmsg(msgid=681,
452 . msgtype=msgerror,
453 . anmode=aninfo_blind_1,
454 . i1=ixr(nixr,j) )
455 ENDIF ! IF (IMERGE2(ITMP) /= 0)
456 ENDIF ! IF (I1 == I2 .OR. I1 == I3 .OR. I2 == I3)
457C
458 igtyp=igeo(11,i0)
459 IF (igtyp /= 23 ) THEN
460 CALL ancmsg(msgid=243,
461 . msgtype=msgerror,
462 . anmode=aninfo_blind_1,
463 . i1=id,
464 . c1=titr)
465 ENDIF
466 ENDDO
467C
468 DO i=1,nel
469 j=i+nft
470 i0=ixr(1,j)
471 i1=ixr(2,j)
472 i2=ixr(3,j)
473 i3=ixr(4,j)
474 igtyp=igeo(11,i0)
475C
476 length = sqrt(
477 + (x(1,i1)-x(1,i2))*(x(1,i1)-x(1,i2))
478 + + (x(2,i1)-x(2,i2))*(x(2,i1)-x(2,i2))
479 + + (x(3,i1)-x(3,i2))*(x(3,i1)-x(3,i2)) )
480 IF(igtyp == 23) THEN
481 imat = ixr(5,i+nft)
482 rhor = pm(1,imat)
483 imass = igeo(4,i0)
484 mtn = 0
485 uiner(i) = zero
486C
487 IF(imass == 1) THEN
488 massr(i) = geo(1,i0)*length*rhor
489 IF (length == zero .AND. rhor /= zero) THEN
490 ipid = ixr(1,i)
491 CALL fretitl2(titr,igeo(npropgi-ltitr+1,i0),ltitr)
492 CALL ancmsg(msgid=1664,
493 . msgtype=msgerror,
494 . anmode=aninfo_blind_1,
495 . i1=id,
496 . c1=titr,
497 . i2=ixr(nixr,i))
498 ENDIF
499 ELSEIF(imass == 2) THEN
500 massr(i) = geo(1,i0)*rhor
501 ENDIF
502C
503 xm = massr(i)
504 xine= geo(2,i0)
505C
506 ratio = xm * length * length
507 ENDIF ! IGTYP == 23
508 ENDDO ! DO I=1,NEL
509C---------------------------------------------------------
510C Initialization of nodal stiffness for contact interfaces
511 IF (i7stifs /= 0) THEN
512 DO i=1,nel
513 j=i+nft
514 imat = ixr(5,i+nft)
515 kx = pm(32, imat)
516 str(j)= kx
517 ENDDO
518 ENDIF ! I7STIFS /= 0
519C-------------------------------------------------------------------
520C Spring type23
521 mtn = 0
522C
523 CALL r23mass(ixr ,geo ,ms ,in,partsav ,
524 2 x ,v ,ipartr(nft+1),xl ,msr(1,nft+1),
525 3 inr(1,nft+1),msrt,ems ,massr ,uiner,mtn)
526C
527C----------------------------------------------
528C Compute element time step and nodal time step
529 ndepar=numels+numelc+numelt+numelp+nft
530 DO i=1,nel
531 j=i+nft
532 i0=ixr(1,j)
533 igtyp=igeo(11,i0)
534 ipid=ixr(1,i+nft)
535 IF (igtyp == 23) THEN ! to be checked carrefuly
536 imat = ixr(5,i+nft)
537 mtn = 0
538 dtelem(ndepar+i) = ep20
539 geo(4,i0)= min(geo(4,i0),dtelem(ndepar+i))
540 ENDIF
541 ENDDO
542 ENDIF ! IGTYP = 23
543 ENDIF ! ITY element type
544C
545 nxref = nrefsta
546 DEALLOCATE(stifntmp)
547C-----------
548 1000 FORMAT('LIST OF POSSIBLE CNODES MERGED WITH NODE ID=',i10)
549 RETURN
550 END SUBROUTINE inivoid
551
subroutine c3coori(x, xreftg, ixp, ngl, x1, x2, x3, y1, y2, y3, z1, z2, z3, ix1, ix2, ix3)
Definition c3coori.F:39
subroutine c3inmas(x, xreftg, ixtg, geo, pm, ms, tiner, thke, partsav, v, ipart, mstg, intg, ptg, igeo, imat, iprop, area, etnod, nshnod, sttg, sh3tree, mcp, mcptg, temp, sh3trim, isubstack, nlay, elbuf_str, stack, thki, rnoise, drape, perturb, ix1, ix2, ix3, nintemp, x2, x3, y3, idrape, indx)
Definition c3inmas.F:46
subroutine c3veok3(nvc, ix1, ix2, ix3)
Definition c3veok3.F:36
subroutine ccoori(x, xrefc, ixc, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, ix1, ix2, ix3, ix4, ngl)
Definition ccoori.F:40
subroutine ceveci(jft, jlt, area, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
Definition ceveci.F:37
subroutine cinmas(x, xrefc, ix, geo, pm, ms, tiner, thke, ihbe, partsav, v, ipart, msc, inc, area, i8mi, igeo, etnod, imid, iprop, nshnod, stc, sh4tree, mcp, mcps, temp, ms_layer, zi_layer, ms_layerc, zi_layerc, msz2c, zply, isubstack, nlay, elbuf_str, stack, thki, rnoise, drape, nintemp, perturb, ix1, ix2, ix3, ix4, idrape, indx)
Definition cinmas.F:95
subroutine cveok3(nvc, nod, ix1, ix2, ix3, ix4)
Definition cveok3.F:35
subroutine initia(iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine, lsigi, lsigsp, srnoise, nprw, lprw, rwstif_pen, sln_pen)
Definition initia.F:198
subroutine inivoid(elbuf_str, ixc, ixs, ixtg, x, v, pm, geo, ms, in, ptg, msc, mss, mstg, inc, intg, thkc, thkt, partsav, iparts, ipartc, ipartt, veul, dtelem, ihbe, isolnod, nvc, i8mi, msnf, mssf, igeo, etnod, nshnod, stc, sttg, wma, sh4tree, sh3tree, mcp, mcpc, temp, mcps, xrefc, xreftg, xrefs, mssa, volnod, bvolnod, vns, bns, sh3trim, isubstack, stack, rnoise, perturb, ele_area, part_area, iparttr, ixt, ipartp, ixp, mst, msp, stt, stp, strp, inp, stifint, mcpp, inr, msr, msrt, str, ipartr, itab, ixr, imerge2, iadmerge2, nel, defaults, glob_therm, ibeam_vector, rbeam_vector)
Definition inivoid.F:76
#define min(a, b)
Definition macros.h:20
integer, parameter nchartitle
subroutine noise(dt2r, in, j, buf, v, a, ixs, elbuf_tab, iparg, weight, ixq)
Definition noise.F:41
subroutine pcoori(x, ncp, mxt, mxg, nc1, nc2, nc3, deltax, x1, x2, x3, y1, y2, y3, z1, z2, z3, ibeam_vector, rbeam_vector, ivect, vect)
Definition pcoori.F:37
subroutine pmass(geo, pm, stifn, stifr, partsav, v, ipart, msp, inp, igeo, stp, x1, x2, y1, y2, z1, z2, nc1, nc2, imat, mxg, area, al, strp, mcpp, temp, nintemp)
Definition pmass.F:35
subroutine r23mass(ixr, geo, ms, xin, partsav, x, v, ipart, xl, msr, inr, msrt, ems, mass, uiner, mtyp)
Definition rmass.F:125
subroutine s4mass3(rho, ms, partsav, x, v, ipart, mss, msnf, mssf, wma, rhocp, mcp, mcps, temp0, temp, mssa, ix1, ix2, ix3, ix4, fill, volu, imas_ds, nintemp)
Definition s4mass3.F:41
subroutine sbulk3(volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)
Definition sbulk3.F:43
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
subroutine c3evec3(jft, jlt, area, x1, x2, x3, y1, y2, y3, z1, z2, z3, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, x31, y31, z31, x2l, x3l, y3l)
Definition c3evec3.F:39
subroutine s4coor3(x, xrefs, ixs, ngl, mxt, ngeo, ix1, ix2, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4)
Definition s4coor3.F:40
subroutine s4deri3(vol, veul, geo, igeo, rx, ry, rz, sx, sy, sz, tx, ty, tz, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, jac_i, deltax, det, ngl, ngeo, mxt, pm, voldp)
Definition s4deri3.F:47
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
subroutine sderi3(vol, veul, geo, igeo, xd1, xd2, xd3, xd4, xd5, xd6, xd7, xd8, yd1, yd2, yd3, yd4, yd5, yd6, yd7, yd8, zd1, zd2, zd3, zd4, zd5, zd6, zd7, zd8, jac1, jac2, jac3, jac4, jac5, jac6, ngl, ngeo, px1, px2, px3, px4, py1, py2, py3, py4, pz1, pz2, pz3, pz4, det, voldp, nel, jeul, nxref, imulti_fvm)
Definition sderi3.F:44
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
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
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
subroutine bidon
Definition machine.F:41
program starter
Definition starter.F:39
subroutine tcoori(x, ncp, mxt, mxg, nc1, nc2, x1, x2, y1, y2, z1, z2)
Definition tcoori.F:32
subroutine tmass(x, nc, geo, pm, ms, stifn, partsav, v, ipart, mst, stifint, stt, area, mxt, nc1, nc2, x1, x2, y1, y2, z1, z2)
Definition tmass.F:34