OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inivoid.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "scr03_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr12_c.inc"
#include "units_c.inc"
#include "random_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ inivoid()

subroutine inivoid ( type(elbuf_struct_), target elbuf_str,
integer, dimension(nixc,*) ixc,
integer, dimension(nixs,*) ixs,
integer, dimension(nixtg,*) ixtg,
x,
v,
pm,
geo,
ms,
in,
ptg,
msc,
mss,
mstg,
inc,
intg,
thkc,
thkt,
partsav,
integer, dimension(*) iparts,
integer, dimension(*) ipartc,
integer, dimension(*) ipartt,
veul,
dtelem,
integer ihbe,
integer isolnod,
integer nvc,
integer*8, dimension(6,*) i8mi,
msnf,
mssf,
integer, dimension(npropgi,*) igeo,
etnod,
integer, dimension(*) nshnod,
stc,
sttg,
wma,
integer, dimension(*) sh4tree,
integer, dimension(*) sh3tree,
mcp,
mcpc,
temp,
mcps,
xrefc,
xreftg,
xrefs,
mssa,
volnod,
bvolnod,
vns,
bns,
integer, dimension(*) sh3trim,
integer isubstack,
type (stack_ply) stack,
rnoise,
integer, dimension(nperturb) perturb,
ele_area,
part_area,
integer, dimension(*) iparttr,
integer, dimension(nixt,*) ixt,
integer, dimension(*) ipartp,
integer, dimension(nixp,*) ixp,
mst,
msp,
stt,
stp,
strp,
inp,
stifint,
mcpp,
inr,
msr,
msrt,
str,
integer, dimension(*) ipartr,
integer, dimension(*) itab,
integer, dimension(nixr,*) ixr,
integer, dimension(numnod+1) imerge2,
integer, dimension(numnod+1) iadmerge2,
integer nel,
type(defaults_), intent(in) defaults,
type(glob_therm_), intent(inout) glob_therm,
integer, dimension(numelp), intent(in) ibeam_vector,
dimension(3,numelp), intent(in) rbeam_vector )

Definition at line 58 of file inivoid.F.

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
87C-----------------------------------------------
88C I m p l i c i t T y p e s
89C-----------------------------------------------
90#include "implicit_f.inc"
91C-----------------------------------------------
92C G l o b a l P a r a m e t e r s
93C-----------------------------------------------
94#include "mvsiz_p.inc"
95C-----------------------------------------------
96C C o m m o n B l o c k s
97C-----------------------------------------------
98#include "vect01_c.inc"
99#include "param_c.inc"
100#include "scr03_c.inc"
101#include "com01_c.inc"
102#include "com04_c.inc"
103#include "scr12_c.inc"
104#include "units_c.inc"
105#include "random_c.inc"
106#include "scr17_c.inc"
107C-----------------------------------------------
108C D u m m y A r g u m e n t s
109C-----------------------------------------------
110 INTEGER NVC, IHBE, ISOLNOD, NDDIM, ILEV,ISUBSTACK
111 INTEGER IXC(NIXC,*),IXS(NIXS,*),IXTG(NIXTG,*),
112 . IPARTS(*),IPARTC(*),IPARTT(*),IGEO(NPROPGI,*),
113 . NSHNOD(*), SH4TREE(*), SH3TREE(*),SH3TRIM(*),
114 . PERTURB(NPERTURB),IXT(NIXT,*),IPARTTR(*),IXP(NIXP,*),IPARTP(*),
115 . ITAB(*),IXR(NIXR,*),IMERGE2(NUMNOD+1),NEL,IPARTR(*),
116 . IADMERGE2(NUMNOD+1)
117 INTEGER*8 I8MI(6,*)
118 INTEGER,INTENT(IN) :: IBEAM_VECTOR(NUMELP)
119 my_real
120 . pm(npropm,*), geo(npropg,*),ms(*),msc(*),mss(8,*),
121 . mstg(*),intg(*),ptg(3,*),in(*),inc(*),thkc(*),thkt(*),
122 . x(3,*),v(3,*),veul(lveul,*),dtelem(*),partsav(20,*),
123 . msnf(*), mssf(8,*), wma(*), etnod(*), stc(*), sttg(*),
124 . mcp(*),mcpc(*),temp(*),mcps(8,*),
125 . xrefc(4,3,*),xreftg(3,3,*),xrefs(8,3,*), mssa(*), volnod(*),
126 . bvolnod(*), bns(8,*), vns(8,*),rnoise(*),part_area(*),ele_area(*),
127 . mst(*),msp(*),stt(*),stp(*),strp(*),inp(*),stifint(*),mcpp(*),
128 . inr(3,*),msr(3,*),msrt(*),str(*)
129 my_real,INTENT(IN) :: rbeam_vector(3,numelp)
130 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
131 TYPE(DEFAULTS_), INTENT(IN) :: DEFAULTS
132 type(glob_therm_) ,intent(inout) :: glob_therm
133C-----------------------------------------------
134C L o c a l V a r i a b l e s
135C-----------------------------------------------
136 INTEGER I, IGTYP,IMAT,IPROP, NDEPAR, NREFSTA, NCC, NF1
137 INTEGER MXT(MVSIZ), PID(MVSIZ), NGL(MVSIZ),
138 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),
139 . IX5(MVSIZ),IX6(MVSIZ),IX7(MVSIZ),IX8(MVSIZ),IBID(MVSIZ),IP,II(6),
140 . ID, IPID, J, I0,I1,I2,I3,ITMP, KK, K,ILENG,IMASS,KK1,IMAS_DS,
141 . IVECT(MVSIZ)
142 my_real
143 . area(mvsiz), rho(mvsiz),vol(mvsiz),
144 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
145 . x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
146 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
147 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
148 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
149 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,tz(mvsiz) ,
150 . e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
151 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
152 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
153 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz),bid(mvsiz),rhocp(mvsiz),
154 . temp0(mvsiz) ,fill(mvsiz),bidg(mvsiz),
155 . px1(mvsiz),px2(mvsiz),px3(mvsiz),px4(mvsiz),
156 . py1(mvsiz),py2(mvsiz),py3(mvsiz),py4(mvsiz),
157 . pz1(mvsiz),pz2(mvsiz),pz3(mvsiz),pz4(mvsiz),volu(mvsiz),
158 . x2l(mvsiz),x3l(mvsiz),y3l(mvsiz),
159 . x31(mvsiz),y31(mvsiz),z31(mvsiz), deltax(mvsiz),
160 . bidon, noise, xl(mvsiz),length,uiner(mvsiz),massr(mvsiz),
161 . xm, xine,ratio,sti,kx,ems(mvsiz),rhor,vect(3,mvsiz)
162 my_real, DIMENSION(:), ALLOCATABLE :: stifntmp !numnod
163 double precision
164 . xd1(mvsiz), xd2(mvsiz), xd3(mvsiz), xd4(mvsiz),
165 . xd5(mvsiz), xd6(mvsiz), xd7(mvsiz), xd8(mvsiz),
166 . yd1(mvsiz), yd2(mvsiz), yd3(mvsiz), yd4(mvsiz),
167 . yd5(mvsiz), yd6(mvsiz), yd7(mvsiz), yd8(mvsiz),
168 . zd1(mvsiz), zd2(mvsiz), zd3(mvsiz), zd4(mvsiz),
169 . zd5(mvsiz), zd6(mvsiz), zd7(mvsiz), zd8(mvsiz),voldp(mvsiz)
170 CHARACTER(LEN=NCHARTITLE) :: TITR
171C
172 TYPE(ELBUF_STRUCT_) ,POINTER :: BIDBUF
173 TYPE (STACK_PLY) :: STACK
174 TYPE(G_BUFEL_),POINTER :: GBUF
175 TYPE (DRAPE_), DIMENSION(NUMELC_DRAPE + NUMELTG_DRAPE) :: DRAPE
176
177C-----------------------------------------------
178 ALLOCATE(stifntmp(numnod))
179 gbuf => elbuf_str%GBUF
180
181 bidbuf => null()
182C
183 ibid(1:mvsiz) = 0
184 bid(1:mvsiz) = zero
185 nrefsta = nxref
186 nxref = 0
187 nf1=nft+1
188 IF (ity == 1.AND. ismstr == 10) ismstr = 4
189 imas_ds = defaults%SOLID%IMAS
190C--------------------------------------
191 IF(ity == 1.AND.isolnod == 4)THEN
192C Solid 4 nodes tetrahedron
193 CALL s4coor3(x ,xrefs(1,1,nft+1),ixs(1,nft+1),ngl ,
194 . mxt ,pid ,ix1 ,ix2 ,ix3 ,ix4 ,
195 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
196 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 )
197 DO i=1,nel
198 rho(i) = pm(89,mxt(i))
199 dtelem(nft+i) = ep30
200 fill(i) = one
201 rhocp(i) = pm(69,mxt(i))
202 temp0(i) = pm(79,mxt(i))
203 ENDDO
204 CALL s4deri3(vol,veul(1,nft+1) ,geo ,igeo ,rx ,
205 . ry ,rz ,sx ,sy ,
206 . sz ,tx ,ty ,tz ,
207 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
208 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
209 . px1 ,px2 ,px3 ,px4 ,
210 . py1 ,py2 ,py3 ,py4 ,
211 . pz1 ,pz2 ,pz3 ,pz4 ,bidg,
212 . deltax,volu ,ngl ,pid ,mxt ,
213 . pm ,voldp )
214 IF(jlag+jale+jeul /= 0) THEN
215 CALL s4mass3(
216 1 rho ,ms ,partsav,x ,v ,
217 2 iparts(nft+1),mss(1,nft+1),msnf ,mssf(1,nft+1),wma ,
218 3 rhocp ,mcp ,mcps(1,nft+1) ,temp0,
219 4 temp ,mssa ,ix1 ,ix2 ,ix3 ,ix4 ,
220 5 fill, volu ,imas_ds ,glob_therm%NINTEMP)
221 ENDIF
222 IF(i7stifs /= 0)THEN
223 ncc=4
224 CALL sbulk3(volu ,ix1 ,ncc,mxt,pm ,
225 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
226 3 bid ,fill )
227 ENDIF
228C------------------------------------------
229 ELSEIF(ity == 1.AND.isolnod == 10)THEN
230C Solid 10 nodes tetrahedron not supported
231 ELSEIF(ity == 1.AND.isolnod == 16)THEN
232C Solid 16 nodes brick not supported
233 ELSEIF(ity == 1.AND.isolnod == 20)THEN
234C Solid 20 nodes brick not supported
235C--------------------------------------
236 ELSEIF(ity == 1)THEN
237C Solid 8 nodes brick
238 DO i=1,nel
239 rhocp(i) = zero
240 temp0(i) = zero
241 ENDDO
242 CALL scoor3(x,xrefs(1,1,nft+1),ixs(1,nft+1),geo ,mxt ,pid ,ngl ,
243 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
244 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
245 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
246 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
247 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
248 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
249 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0, temp,glob_therm%NINTEMP,
250 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
251 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
252 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 )
253 IF((jeul == 0.OR.integ8 == 0).AND. npt /= 8) THEN
254 DO i=1,nel
255 rho(i) = pm(89,mxt(i))
256 dtelem(nft+i) = ep30
257 fill(i) = one
258 ENDDO
259 CALL sderi3(vol ,veul(1,nft+1) ,geo ,igeo ,
260 . xd1 ,xd2 ,xd3 ,xd4 ,xd5 ,xd6 ,xd7 ,xd8 ,
261 . yd1 ,yd2 ,yd3 ,yd4 ,yd5 ,yd6 ,yd7 ,yd8 ,
262 . zd1 ,zd2 ,zd3 ,zd4 ,zd5 ,zd6 ,zd7 ,zd8 ,
263 . rx ,ry ,rz ,sx ,sy ,sz ,ngl ,pid ,
264 . px1 ,px2 ,px3 ,px4 ,py1 ,py2 ,py3 ,py4 ,
265 . pz1 ,pz2 ,pz3 ,pz4, volu ,voldp,nel ,jeul ,
266 . nxref,imulti_fvm )
267 CALL sdlen3(
268 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
269 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
270 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8,
271 . deltax, volu)
272 CALL smass3(
273 1 rho , ms , partsav, x , v ,
274 2 iparts(nft+1), mss(1,nft+1) , volu ,
275 3 msnf , mssf(1,nft+1), bid ,
276 4 bid , bid , wma , rhocp, mcp,
277 5 mcps(1,nft+1), mssa ,bid , bid ,fill ,
278 6 ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
279 ENDIF
280 IF(i7stifs /= 0)THEN
281 ncc=8
282 CALL sbulk3(volu ,ix1 ,ncc,mxt,pm ,
283 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
284 3 bid ,fill )
285 ENDIF
286C--------------------------------------
287 ELSEIF (ity == 3) THEN
288C 4 nodes shell
289 imat = ixc(1,1+nft) ! material number
290 iprop = ixc(nixc-1,1+nft) ! property number
291C
292 CALL ccoori(x,xrefc(1,1,nft+1),ixc(1,nft+1),
293 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
294 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
295 . ix1 ,ix2 ,ix3 ,ix4 ,ngl )
296 CALL cveok3(nvc,4,ix1,ix2,ix3,ix4)
297C
298 CALL ceveci(lft ,llt ,area,
299 . x1 ,x2 ,x3 ,x4 ,y1 ,y2 ,
300 . y3 ,y4 ,z1 ,z2 ,z3 ,z4 ,
301 . e1x ,e2x ,e3x ,e1y ,e2y ,e3y ,e1z ,e2z ,e3z )
302C----------------------------------------------------------
303C Save element area (needed in /ADMAS for shells)
304 IF (imasadd > 0) THEN
305 DO i=1,nel
306 ele_area(i+nft) = area(i)
307 ENDDO
308 ENDIF
309C
310 CALL cinmas(x,xrefc(1,1,nft+1),ixc,geo,pm,ms,in,
311 . thkc,ihbe,partsav,v,ipartc(nft+1),
312 . msc(nft+1),inc(nft+1),area,
313 . i8mi ,igeo ,etnod ,imat ,iprop ,
314 . nshnod ,stc(nft+1),sh4tree ,mcp ,mcpc(nft+1) ,
315 . temp ,bid , bid,bid,bid,
316 . bid,bid,isubstack,ibid,bidbuf,
317 . stack,bidg ,rnoise,drape,glob_therm%NINTEMP,
318 . perturb,ix1 ,ix2 ,ix3 ,ix4 ,ibid, ibid)
319
320 ndepar=numels+nft
321 DO i=1,nel
322 dtelem(ndepar+i) = ep30
323 ENDDO
324C--------------------------------------
325 ELSEIF(ity == 7)THEN
326C 3 nodes shell
327 imat = ixtg(1,1+nft) ! material number
328 iprop = ixtg(nixtg-1,1+nft) ! property number
329C
330 CALL c3coori(x,xreftg(1,1,nft+1),ixtg(1,nft+1),ngl,
331 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
332 . z1 ,z2 ,z3 ,ix1 ,ix2 ,ix3 )
333 CALL c3veok3(nvc,ix1 ,ix2 ,ix3 )
334 CALL c3evec3(lft ,llt ,area,
335 . x1 ,x2 ,x3 ,y1 ,y2 ,y3 ,
336 . z1 ,z2 ,z3 ,e1x ,e2x ,e3x ,
337 . e1y ,e2y ,e3y ,e1z ,e2z ,e3z ,
338 . x31, y31, z31 ,x2l ,x3l ,y3l )
339C-------------------------------------------------
340C Save element area (needed in /ADMAS for shells)
341 IF (imasadd > 0) THEN
342 DO i=1,nel
343 ele_area(i+nft+numelc) = area(i)
344 ENDDO
345 ENDIF
346C
347 CALL c3inmas(x,xreftg(1,1,nft+1),ixtg,geo,pm,ms,in,thkt,
348 . partsav,v,ipartt(nft+1),mstg(nft+1),intg(nft+1),
349 . ptg(1,nft+1),igeo ,imat ,iprop ,area ,
350 . etnod,nshnod,sttg(nft+1), sh3tree,mcp ,
351 . mcps(1,nft+1) , temp,sh3trim,isubstack,ibid,
352 . bidbuf, stack,bidg ,rnoise, drape,
353 . perturb,ix1 ,ix2 ,ix3 ,glob_therm%NINTEMP,
354 . x2l ,x3l ,y3l ,ibid, ibid)
355
356 ndepar=numels+numelc+numelt+numelp+numelr+nft
357 DO i=1,nel
358 dtelem(ndepar+i) = ep30
359 ENDDO
360C--------------------------------------
361 ELSEIF(ity == 4)THEN
362C Truss element
363 stifntmp(1:numnod)=zero
364 CALL tcoori(x,ixt(1,nft+1),mxt, pid, ix1, ix2,
365 . x1, x2, y1, y2, z1, z2)
366C Avoid fail in output subroutine (Anim division by AREA)
367 gbuf%AREA(1:nel)= geo(1,pid(1:nel))
368 CALL tmass(x ,ixt ,geo ,pm ,ms ,
369 . stifntmp ,partsav ,v ,iparttr(nft+1),mst(nft+1),
370 . stifint,stt(nft+1) ,gbuf%AREA , mxt, ix1, ix2,
371 . x1, x2, y1, y2, z1, z2)
372 ndepar=numels+numelc+nft
373 DO i=1,nel
374 dtelem(ndepar + i) = ep30
375 ENDDO
376C--------------------------------------
377 ELSEIF(ity == 5)THEN
378C Beam element
379 stifntmp(1:numnod)=zero
380 CALL pcoori(x,ixp(1,nft+1),
381 . mxt,pid ,ix1,ix2,ix3,deltax,
382 . x1,x2,x3, y1,y2,y3, z1,z2,z3,
383 . ibeam_vector(nft+1),rbeam_vector(1,nft+1),ivect,vect)
384c
385 CALL pmass(geo,pm,
386 . stifntmp,stifntmp,partsav,v,ipartp(nft+1),
387 . msp(nft+1),inp(nft+1),igeo , stp(nft+1),
388 . x1,x2, y1,y2, z1,z2,
389 . ix1,ix2,mxt,pid,area,deltax,strp(nft+1),
390 . mcpp,temp,glob_therm%NINTEMP)
391 ndepar=numels+numelc+numelt+nft
392 DO i=1,nel
393 dtelem(ndepar+i)=ep30
394 ENDDO
395C--------------------------------------
396 ELSEIF (ity == 6) THEN
397C Spring element
398 i0=ixr(1,1+nft)
399 igtyp = igeo(11,i0)
400C
401 IF(igtyp == 23) THEN
402 bidon = zero
403 DO i=1,6
404 ii(i) = (i-1)*nel + 1
405 ENDDO
406C
407 noise = two*sqrt(three)*xalea
408C
409 DO i=1,numgeo
410 igtyp=igeo(11,i)
411 id=igeo(1,i)
412 CALL fretitl2(titr,igeo(npropgi-ltitr+1,i),ltitr)
413 IF(igtyp == 23) geo(4,i) = ep30 !
414 ENDDO ! DO I=1,NUMGEO
415C-----------------
416 ipid=ixr(1,nft+1)
417 id=igeo(1,ipid)
418 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid),ltitr)
419 DO i=1,nel
420 j=i+nft
421 i0=ixr(1,j)
422 i1=ixr(2,j)
423 i2=ixr(3,j)
424 i3=ixr(4,j)
425C----------------------- to check
426 IF (i1 == i2 .OR. i1 == i3 .OR. i2 == i3) THEN
427 IF (i1 == i2 .OR. i1 == i3) itmp = i1
428 IF (i2 == i3) itmp = i2
429 IF (imerge2(itmp) /= 0) THEN
430 CALL ancmsg(msgid=682,
431 . msgtype=msgwarning,
432 . anmode=aninfo_blind_1,
433 . i1=ixr(nixr,j),
434 . i2=itab(itmp))
435 WRITE (iout,1000) itab(itmp)
436 kk = 0
437 DO k=1,iadmerge2(itmp+1) - iadmerge2(itmp)
438 kk = kk + 1
439 IF (kk == 10) THEN
440 WRITE (iout,fmt=fmt_10i)
441 . (itab(imerge2(iadmerge2(itmp)+kk1)),kk1=0,kk-1)
442 kk = 0
443 ENDIF
444 ENDDO
445 IF (kk /= 0) THEN
446 WRITE (iout,fmt=fmt_10i)
447 . (itab(imerge2(iadmerge2(itmp)+kk1)),kk1=0,kk-1)
448 ENDIF
449 ELSE
450 CALL ancmsg(msgid=681,
451 . msgtype=msgerror,
452 . anmode=aninfo_blind_1,
453 . i1=ixr(nixr,j) )
454 ENDIF ! IF (IMERGE2(ITMP) /= 0)
455 ENDIF ! IF (I1 == I2 .OR. I1 == I3 .OR. I2 == I3)
456C
457 igtyp=igeo(11,i0)
458 IF (igtyp /= 23 ) THEN
459 CALL ancmsg(msgid=243,
460 . msgtype=msgerror,
461 . anmode=aninfo_blind_1,
462 . i1=id,
463 . c1=titr)
464 ENDIF
465 ENDDO
466C
467 DO i=1,nel
468 j=i+nft
469 i0=ixr(1,j)
470 i1=ixr(2,j)
471 i2=ixr(3,j)
472 i3=ixr(4,j)
473 igtyp=igeo(11,i0)
474C
475 length = sqrt(
476 + (x(1,i1)-x(1,i2))*(x(1,i1)-x(1,i2))
477 + + (x(2,i1)-x(2,i2))*(x(2,i1)-x(2,i2))
478 + + (x(3,i1)-x(3,i2))*(x(3,i1)-x(3,i2)) )
479 IF(igtyp == 23) THEN
480 imat = ixr(5,i+nft)
481 rhor = pm(1,imat)
482 imass = igeo(4,i0)
483 mtn = 0
484 uiner(i) = zero
485C
486 IF(imass == 1) THEN
487 massr(i) = geo(1,i0)*length*rhor
488 IF (length == zero .AND. rhor /= zero) THEN
489 ipid = ixr(1,i)
490 CALL fretitl2(titr,igeo(npropgi-ltitr+1,i0),ltitr)
491 CALL ancmsg(msgid=1664,
492 . msgtype=msgerror,
493 . anmode=aninfo_blind_1,
494 . i1=id,
495 . c1=titr,
496 . i2=ixr(nixr,i))
497 ENDIF
498 ELSEIF(imass == 2) THEN
499 massr(i) = geo(1,i0)*rhor
500 ENDIF
501C
502 xm = massr(i)
503 xine= geo(2,i0)
504C
505 ratio = xm * length * length
506 ENDIF ! IGTYP == 23
507 ENDDO ! DO I=1,NEL
508C---------------------------------------------------------
509C Initialization of nodal stiffness for contact interfaces
510 IF (i7stifs /= 0) THEN
511 DO i=1,nel
512 j=i+nft
513 imat = ixr(5,i+nft)
514 kx = pm(32, imat)
515 str(j)= kx
516 ENDDO
517 ENDIF ! I7STIFS /= 0
518C-------------------------------------------------------------------
519C Spring type23
520 mtn = 0
521C
522 CALL r23mass(ixr ,geo ,ms ,in,partsav ,
523 2 x ,v ,ipartr(nft+1),xl ,msr(1,nft+1),
524 3 inr(1,nft+1),msrt,ems ,massr ,uiner,mtn)
525C
526C----------------------------------------------
527C Compute element time step and nodal time step
528 ndepar=numels+numelc+numelt+numelp+nft
529 DO i=1,nel
530 j=i+nft
531 i0=ixr(1,j)
532 igtyp=igeo(11,i0)
533 ipid=ixr(1,i+nft)
534 IF (igtyp == 23) THEN ! to be checked carrefuly
535 imat = ixr(5,i+nft)
536 mtn = 0
537 dtelem(ndepar+i) = ep20
538 geo(4,i0)= min(geo(4,i0),dtelem(ndepar+i))
539 ENDIF
540 ENDDO
541 ENDIF ! IGTYP = 23
542 ENDIF ! ITY element type
543C
544 nxref = nrefsta
545 DEALLOCATE(stifntmp)
546C-----------
547 1000 FORMAT('LIST OF POSSIBLE CNODES MERGED WITH NODE ID=',i10)
548 RETURN
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
#define my_real
Definition cppsort.cpp:32
subroutine cveok3(nvc, nod, ix1, ix2, ix3, ix4)
Definition cveok3.F:35
subroutine area(d1, x, x2, y, y2, eint, stif0)
#define min(a, b)
Definition macros.h:20
initmumps id
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:122
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:42
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:889
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
subroutine bidon
Definition machine.F:41
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:33