OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
bforc2.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr07_c.inc"
#include "vect01_c.inc"
#include "parit_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine bforc2 (timers, elbuf_tab, ng, pm, geo, ic, x, a, v, ms, w, flux, flu1, veul, ale_connect, iparg, jparg, fill, dfill, ims, nloc_dmg, tf, npf, bufmat, partsav, dt2t, neltst, ityptst, stifn, offset, eani, ipartq, nel, iadq, fsky, ipm, bufvois, gresav, grth, igrth, table, igeo, voln, itask, ms_2d, fskym, mat_elem, h3d_strain, output, sz_bufvois, snpc, stf, sbufmat, svis, nsvois, iresp, idel7nok, idtmin, maxfunc, imon_mat, userl_avail, impl_s, idyna, dt, glob_therm, sensors)

Function/Subroutine Documentation

◆ bforc2()

subroutine bforc2 ( type(timer_), intent(inout) timers,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer ng,
pm,
geo,
integer, dimension(*) ic,
x,
a,
v,
ms,
w,
flux,
flu1,
veul,
type(t_ale_connectivity), intent(in) ale_connect,
integer, dimension(nparg,ngroup) iparg,
integer, dimension(*) jparg,
fill,
dfill,
integer, dimension(*) ims,
type (nlocal_str_), target nloc_dmg,
tf,
integer, dimension(*) npf,
bufmat,
partsav,
dt2t,
integer neltst,
integer ityptst,
stifn,
integer offset,
eani,
integer, dimension(numelq) ipartq,
integer nel,
integer, dimension(4,*) iadq,
fsky,
integer, dimension(*) ipm,
bufvois,
gresav,
integer, dimension(*) grth,
integer, dimension(*) igrth,
type (ttable), dimension(*) table,
integer, dimension(*) igeo,
voln,
integer itask,
ms_2d,
fskym,
type (mat_elem_), intent(inout) mat_elem,
integer h3d_strain,
type(output_), intent(inout) output,
integer, intent(in) sz_bufvois,
integer, intent(in) snpc,
integer, intent(in) stf,
integer, intent(in) sbufmat,
intent(inout) svis,
integer nsvois,
integer, intent(in) iresp,
integer, intent(inout) idel7nok,
integer, dimension(102) idtmin,
integer, intent(in) maxfunc,
integer, intent(in) imon_mat,
integer, intent(in) userl_avail,
integer, intent(in) impl_s,
integer, intent(in) idyna,
type (dt_), intent(in) dt,
type (glob_therm_), intent(inout) glob_therm,
type (sensors_), intent(inout) sensors )
Parameters
[in,out]outputoutput structure

Definition at line 71 of file bforc2.F.

87C-----------------------------------------------
88C M o d u l e s
89C-----------------------------------------------
90 USE timer_mod
91 USE mmain_mod
92 USE table_mod
93 USE message_mod
94 USE elbufdef_mod
95 USE nlocal_reg_mod
96 USE ale_connectivity_mod
97 USE output_mod
98 USE mat_elem_mod
99 USE dt_mod
100 use glob_therm_mod
101 USE sensor_mod
102C-----------------------------------------------
103C I m p l i c i t T y p e s
104C-----------------------------------------------
105#include "implicit_f.inc"
106C-----------------------------------------------
107C G l o b a l P a r a m e t e r s
108C-----------------------------------------------
109#include "mvsiz_p.inc"
110C-----------------------------------------------
111C C o m m o n B l o c k s
112C-----------------------------------------------
113#include "com01_c.inc"
114#include "com04_c.inc"
115#include "com06_c.inc"
116#include "com08_c.inc"
117#include "scr07_c.inc"
118#include "vect01_c.inc"
119#include "parit_c.inc"
120#include "param_c.inc"
121C-----------------------------------------------
122C D u m m y A r g u m e n t s
123C-----------------------------------------------
124 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
125 INTEGER OFFSET,NEL,NG,NSVOIS
126 INTEGER,INTENT(IN) :: SZ_BUFVOIS
127 INTEGER,INTENT(IN) :: SNPC
128 INTEGER,INTENT(IN) :: STF
129 INTEGER, INTENT(IN) :: SBUFMAT
130 INTEGER, INTENT(IN) :: IRESP
131 INTEGER ,INTENT(INOUT) :: IDEL7NOK
132 integer,dimension(102) :: IDTMIN
133 INTEGER ,INTENT(IN) :: MAXFUNC
134 INTEGER, INTENT(IN) :: IMPL_S
135 INTEGER, INTENT(IN) :: IDYNA
136 INTEGER, INTENT(IN) :: USERL_AVAIL
137 INTEGER, INTENT(IN) :: IMON_MAT
138 INTEGER IC(*), IPARG(NPARG,NGROUP), JPARG(*), IMS(*), NPF(*),IPARTQ(NUMELQ),IPM(*),IGEO(*),ITASK,H3D_STRAIN
139 INTEGER NELTST,ITYPTST, IADQ(4,*),GRTH(*),IGRTH(*)
140 my_real dt2t
141 my_real pm(*), geo(*), x(*), a(*), v(*), ms(*), w(*), flux(4,*),
142 . flu1(*), veul(*),fill(numnod,*),eani(*),fsky(*),
143 . dfill(numnod,*), tf(*), bufmat(*), partsav(*), stifn(*),
144 . bufvois(6,*),gresav(*),voln(mvsiz),ms_2d(*),fskym(*)
145 my_real, DIMENSION(MVSIZ,6), INTENT(INOUT) :: svis
146 TYPE (TTABLE) TABLE(*)
147 TYPE(ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
148 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
149 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
150 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT !< output structure
151 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
152 TYPE (DT_), INTENT(IN) :: DT
153 type (glob_therm_) ,intent(inout) :: glob_therm
154 type (sensors_),INTENT(INOUT) :: SENSORS
155C-----------------------------------------------
156C L o c a l V a r i a b l e s
157C-----------------------------------------------
158 INTEGER I,NF1,NF2, MTN1, MTN2, LCO, IMULT, IFLAG,IBID
159 INTEGER MAT(MVSIZ),NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),NC4(MVSIZ),
160 . NGL(MVSIZ),NGEO(MVSIZ), IBIDV(1) ,L_TEMP, L_PLA, L_BFRAC,L_BULK,SZ_IX
161 INTEGER :: ILAY
162 my_real y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
163 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
164 . aire(mvsiz),aires(mvsiz),airem(mvsiz),vd2(mvsiz),dvol(mvsiz),
165 . deltax(mvsiz),vis(mvsiz),
166 . vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz), vz1(mvsiz),
167 . vz2(mvsiz), vz3(mvsiz), vz4(mvsiz),
168 . py1(mvsiz), py2(mvsiz), pz1(mvsiz), pz2(mvsiz),
169 . wyz(mvsiz),dyz(mvsiz),dzy(mvsiz),qvis(mvsiz),ssp(mvsiz),
170 . s1(mvsiz),s2(mvsiz),s3(mvsiz),s4(mvsiz),s5(mvsiz),s6(mvsiz),
171 . eyy(mvsiz),ezz(mvsiz),ett(mvsiz),eyz(mvsiz),eyt(mvsiz),
172 . ezt(mvsiz),rx(mvsiz),ry(mvsiz),rz(mvsiz),sx(mvsiz),sy(mvsiz),
173 . sz(mvsiz), tx(mvsiz), ty(mvsiz), tz(mvsiz)
174 my_real f11(mvsiz), f12(mvsiz), f21(mvsiz), f22(mvsiz),ssp_eq(mvsiz),
175 . t11(mvsiz), t12(mvsiz), t13(mvsiz), t14(mvsiz), t21(mvsiz),
176 . t22(mvsiz), t23(mvsiz),t24(mvsiz), vdy(mvsiz), vdz(mvsiz),
177 . ax1(mvsiz),ax2(mvsiz), ehou(mvsiz)
178
179 my_real b11(mvsiz), b12(mvsiz), b13(mvsiz), b14(mvsiz),b21(mvsiz), b22(mvsiz), b23(mvsiz), b24(mvsiz) ! Advection term ('force')
180 my_real wyy(mvsiz),wzz(mvsiz),vdx(mvsiz)
181 my_real muvoid(mvsiz), sti(mvsiz),bid(mvsiz), mbid(1)
182 my_real sigy(mvsiz),et(mvsiz),gama(mvsiz,6), r3_free(mvsiz),r4_free(mvsiz)
183 my_real dalph1(mvsiz), dalph2(mvsiz)
184 my_real eyys(mvsiz), ezzs(mvsiz), etts(mvsiz), eyzs(mvsiz), eyts(mvsiz), ezts(mvsiz),bidm(mvsiz)
185 my_real varnl(nel)
186 INTEGER NPARG_BID(NPARG)
187C-------------------
188 TYPE(L_BUFEL_) ,POINTER :: LBUF, LBUF1,LBUF2
189 TYPE(G_BUFEL_) ,POINTER :: GBUF
190C-----------------------------------------------
191C S o u r c e L i n e s
192C-----------------------------------------------
193 sz_ix=numelq+numels+nsvois ! Size of IX array (either IXS+NSVOIS or IXQ)
194 gbuf => elbuf_tab(ng)%GBUF
195 lbuf1 => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1) ! buffer mat 1
196 lbuf2 => elbuf_tab(ng)%BUFLY(2)%LBUF(1,1,1) ! buffer mat 2
197 mtn1 = jparg(25)
198 mtn2 = jparg(26)
199 nf1 = nft + 1
200 nf2 = nf1+numelq
201 lco = nft*7 + 1
202
203 ibidv=0
204 ibid = 0
205 bid = zero
206 bidm(1:mvsiz) = zero
207
208 IF (nspmd > 1) THEN
209 CALL ancmsg(msgid=14,anmode=aninfo)
210 CALL arret(2)
211 ENDIF
212
213 DO i=1,nel
214 wyy(i)=zero
215 wzz(i)=zero
216 vdx(i)=zero
217 ENDDO
218C------------
219 CALL qcoor2(
220 1 x, ic(lco), y1, y2,
221 2 y3, y4, z1, z2,
222 3 z3, z4, nc1, nc2,
223 4 nc3, nc4, ngl, mat,
224 5 ngeo, vd2, vis, nel)
225C------------
226C A.L.E.
227C------------
228 IF (jale /= 0) THEN
229 CALL qvolu2(
230 1 gbuf%OFF,aire, voln, ngl,
231 2 y1, y2, y3, y4,
232 3 z1, z2, z3, z4,
233 4 bid, bid, nel, jmult,
234 5 jcvt)
235 CALL qdlen2(y1,y2,y3,y4,z1,z2,z3,z4,aire,deltax,iparg(63,ng))
236 CALL qdefo2(
237 1 v, w, y1, y2,
238 2 y3, y4, z1, z2,
239 3 z3, z4, vy1, vy2,
240 4 vy3, vy4, vz1, vz2,
241 5 vz3, vz4, py1, py2,
242 6 pz1, pz2, wyz, dyz,
243 7 dzy, eyy, ezz, ett,
244 8 eyz, eyt, ezt, rx,
245 9 ry, rz, sx, sy,
246 a sz, tx, ty, tz,
247 b voln, aire, airem, nc1,
248 c nc2, nc3, nc4, nel)
249 CALL balph2(pm,lbuf1%FRAC,lbuf2%FRAC,gbuf%VOL,fill,
250 . lbuf1%SIG,lbuf1%EINT,lbuf1%VOL,lbuf1%RHO,
251 . flux(1,nf1),flu1(nf1),lbuf1%OFF,
252 . lbuf2%SIG,lbuf2%EINT,lbuf2%VOL,lbuf2%RHO,
253 . flux(1,nf2),flu1(nf2),lbuf2%OFF,
254 . gbuf%SIG,gbuf%EINT,gbuf%RHO,gbuf%TEMP,
255 . gbuf%G_TEMP,gbuf%BFRAC,gbuf%G_BFRAC,
256 . gbuf%PLA,gbuf%G_PLA,voln,gbuf%QVIS,gbuf%G_QVIS,nel,
257 . aire, aires,
258 . eyy, ezz, ett, eyz, eyt, ezt,
259 . eyys, ezzs, etts, eyzs, eyts, ezts,
260 . mat, nc1, nc2, nc3, nc4,
261 . dalph1, dalph2)
262 CALL bafil2(v,w,fill,dfill,ims,x, dalph1, dalph2, nc1, nc2, nc3, nc4)
263C-----------
264C EULER
265C-----------
266 ELSEIF(jeul /= 0)THEN
267 CALL edefo2(gbuf%VOL,v,veul,
268 . y1,y2,y3,y4,z1,z2,z3,z4,
269 . vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4,
270 . py1,py2,pz1,pz2,
271 . wyz,dyz,dzy,eyy,ezz,ett,eyz,eyt,ezt,
272 . voln,aire,deltax,vdy,vdz,vd2,
273 . nc1,nc2,nc3,nc4)
274 CALL balph2(pm,lbuf1%FRAC,lbuf2%FRAC,gbuf%VOL,fill,
275 . lbuf1%SIG,lbuf1%EINT,lbuf1%VOL,lbuf1%RHO,
276 . flux(1,nf1),flu1(nf1),lbuf1%OFF,
277 . lbuf2%SIG,lbuf2%EINT,lbuf2%VOL,lbuf2%RHO,
278 . flux(1,nf2),flu1(nf2),lbuf2%OFF,
279 . gbuf%SIG,gbuf%EINT,gbuf%RHO,gbuf%TEMP,
280 . gbuf%G_TEMP,gbuf%BFRAC,gbuf%G_BFRAC,
281 . gbuf%PLA,gbuf%G_PLA,voln,gbuf%QVIS,gbuf%G_QVIS,nel,
282 . aire, aires,
283 . eyy, ezz, ett, eyz, eyt, ezt,
284 . eyys, ezzs, etts, eyzs, eyts, ezts,
285 . mat, nc1, nc2, nc3, nc4,
286 . dalph1, dalph2)
287 CALL befil2(v,fill,dfill,ims,x,
288 . dalph1, dalph2,
289 . nc1, nc2, nc3, nc4)
290 ENDIF
291C-----------------------------------------------------
292C SUBMATERIAL 1 (MAT LAW20)
293C-----------------------------------------------------
294 imult=jmult
295 jmult=1
296 ilay = -1
297 lbuf => elbuf_tab(ng)%BUFLY(jmult)%LBUF(1,1,1) ! buffer mat 1
298 mtn=jparg(25)
299 l_temp = elbuf_tab(ng)%BUFLY(jmult)%L_TEMP
300 l_pla = elbuf_tab(ng)%BUFLY(jmult)%L_PLA
301 l_bfrac= elbuf_tab(ng)%BUFLY(jmult)%L_BFRAC
302 l_bulk = elbuf_tab(ng)%BUFLY(jmult)%L_QVIS
303
304 CALL brest2(gbuf%VOL,ic(lco),voln,
305 . aire, aires,
306 . eyy, ezz, ett, eyz, eyt, ezt,
307 . eyys, ezzs, etts, eyzs, eyts, ezts,
308 . mat,mat_elem%MAT_PARAM, nummat)
309 CALL blero2(lbuf1%FRAC,lbuf1%VOL,lbuf1%RHO,
310 . flux(1,nf1),flu1(nf1),lbuf1%OFF,pm,ngl,voln,
311 . aire, eyy, ezz, ett, eyz, eyt, ezt, vd2, dvol,
312 . vy1, vy2, vy3, vy4,
313 . vz1, vz2, vz3, vz4,
314 . mat)
315 CALL qrota2( lbuf1%SIG,s1, s2, s3,
316 2 s4, s5, s6, wyz,
317 3 nel, jcvt)
318
319 IF (isorth == 0) THEN
320 !isotropic
321 DO i=1,nel
322 gama(i,1) = one
323 gama(i,2) = zero
324 gama(i,3) = zero
325 gama(i,4) = zero
326 gama(i,5) = one
327 gama(i,6) = zero
328 ENDDO
329 ELSE
330 DO i=1,nel
331 gama(i,1) = one
332 gama(i,2) = zero
333 gama(i,3) = zero
334 gama(i,4) = zero
335 gama(i,5) = one
336 gama(i,6) = zero
337 ENDDO
338 ENDIF
339C-----------------------------------------------------
340C STRESS TENSOR
341C-----------------------------------------------------
342 CALL mmain(timers, output,
343 1 elbuf_tab, ng, pm, geo,
344 2 ale_connect, ic, iparg,
345 3 v, tf, npf, bufmat,
346 4 sti, x, dt2t, neltst,
347 5 ityptst, offset, nel, w,
348 6 lbuf%OFF, ngeo, mat, ngl,
349 7 voln, vd2, dvol, deltax,
350 8 vis, qvis, ssp, s1,
351 9 s2, s3, s4, s5,
352 a s6, eyy, ezz, ett,
353 b eyz, eyt, ezt, wyy,
354 c wzz, wyz, rx, ry,
355 d rz, sx, sy, sz,
356 e vdx, vdy, vdz, muvoid,
357 f ssp_eq, aire, sigy, et,
358 g bufvois, lbuf%PLA, r3_free, r4_free,
359 h eyy, ezz, ett, eyz,
360 i eyt, ezt, wyy, wzz,
361 j wyz, ipm, gama, bid,
362 k bid, bid, bid, bid,
363 l bid, bid, ibid, bid,
364 m bid, ibid, ilay, mbid,
365 n mbid, 1, 1, 1,
366 o table, bid, bid, bid,
367 p bid, iparg(1,ng), igeo, bid,
368 q itask, nloc_dmg, varnl, mat_elem,
369 r h3d_strain, jplasol, jsph, sz_bufvois,
370 t snpc, stf, sbufmat, glob_therm,
371 . svis, sz_ix, iresp,
372 . n2d, th_strain, ngroup ,tt,
373 . dt1, ntable, numelq, nummat,
374 . numgeo, numnod, numels,
375 . idel7nok, idtmin, maxfunc,
376 . imon_mat, userl_avail, impl_s,
377 . idyna, dt ,bid ,sensors)
378C----------------------------------
379C PETROV-GALERKIN PSEUDO MASSES & ALE MASSES
380C----------------------------------
381 IF (iparit == 0) THEN
382 CALL qmass2(
383 1 lbuf%OFF,lbuf%RHO,ms, aire,
384 2 nc1, nc2, nc3, nc4,
385 3 nel)
386 ELSE
387 CALL qmass2p(
388 1 lbuf%OFF,lbuf%RHO,aire, fsky,
389 2 fsky, iadq, nel, nft)
390 ENDIF
391C--------------------------
392C UPDATE OF MASSES : ALE physical masses
393C----------------------------
394 IF (jale+jeul > 0 )THEN
395 IF (iparit == 0)THEN
396 CALL qmassreal2(
397 1 lbuf%OFF,lbuf%RHO,ms_2d, voln,
398 2 nc1, nc2, nc3, nc4,
399 3 nel)
400 ELSE
401 CALL qmassreal2p(
402 1 lbuf%OFF,lbuf%RHO,voln, fskym,
403 2 iadq, nel, nft)
404 ENDIF
405 ENDIF
406C------------------------
407C ANTI-HOURGLASS FORCES
408C------------------------
409 CALL qhvis2(pm,lbuf%OFF,lbuf%RHO,
410 . y1,y2,y3,y4,z1,z2,z3,z4,
411 . vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4,
412 . py1,py2,pz1,pz2,
413 . t11,t12,t13,t14,t21,t22,t23,t24,
414 . aire,ssp,mat,vd2,vis,eani,ngeo,geo,
415 . partsav,ipartq,ehou,iparg(63,ng))
416C--------------------------
417C SYNTHESIS PER SUBMATERIAL
418C--------------------------
419 iflag=mod(ncycle,ncpri)
420 IF(iflag == 0 .OR. tt >= output%TH%THIS .OR. mdess /= 0.
421 . or.tt>=output%TH%THIS1(1).OR.tt>=output%TH%THIS1(2).
422 . or.tt>=output%TH%THIS1(3).OR.tt>=output%TH%THIS1(4).OR.tt>=output%TH%THIS1(5).
423 . or.tt>=output%TH%THIS1(6).OR.tt>=output%TH%THIS1(7).OR.tt>=output%TH%THIS1(8).
424 . or.tt>=output%TH%THIS1(9).OR.nth/=0.OR.nanim/=0 .
425 . or.tt>=tabfis(1).OR.tt>=tabfis(2).
426 . or.tt>=tabfis(3).OR.tt>=tabfis(4).OR.tt>=tabfis(5).
427 . or.tt>=tabfis(6).OR.tt>=tabfis(7).OR.tt>=tabfis(8).
428 . or.tt>=tabfis(10))
429 . CALL qbilan(
430 1 partsav, lbuf%OFF, lbuf%EINT,lbuf%RHO,
431 2 lbuf%RK, lbuf%VOL, vy1, vy2,
432 3 vy3, vy4, vz1, vz2,
433 4 vz3, vz4, voln, ipartq,
434 5 ehou, bid, bid, bid,
435 6 bid, gresav, grth, igrth,
436 7 ibid, bid, itask, nel,
437 8 jtur, jcvt, igre, sensors,
438 9 gbuf%G_WPLA,gbuf%WPLA)
439C
440C--------------------
441C INTERNAL FORCES
442C--------------------
443 CALL qfint2(
444 1 lbuf%SIG,py1, py2, pz1,
445 2 pz2, aire, voln, qvis,
446 3 f11, f12, f21, f22,
447 4 ax1, ax2, bid, bid,
448 5 bid, bid, nel, jcvt,
449 6 svis)
450C------------------------
451C ADVECTION TERM (TRANSPORTATION 'FORCE')
452C------------------------
453 IF (jale > 0 .AND. mtn /= 11)
454 . CALL bamom2(
455 1 pm, v, w, lbuf%RHO,
456 2 lbuf1%FRAC,lbuf2%FRAC,fill(1,1), b11,
457 3 b12, b13, b14, b21,
458 4 b22, b23, b24, py1,
459 5 py2, pz1, pz2, aire,
460 6 mat, nc1, nc2, nc3,
461 7 nc4, nel)
462 IF (jeul > 0 .AND. mtn /= 11)
463 . CALL bemom2(
464 1 pm, v, lbuf%RHO, lbuf1%FRAC,
465 2 lbuf2%FRAC,fill(1,1), b11, b12,
466 3 b13, b14, b21, b22,
467 4 b23, b24, py1, py2,
468 5 pz1, pz2, aire, mat,
469 6 nc1, nc2, nc3, nc4,
470 7 nel)
471C--------------
472C ASSEMBLY
473C--------------
474 IF(jeul+jale /= 0) CALL check_off_ale(b11 ,b12 ,b13 ,b14 ,b21 ,
475 1 b22 ,b23 ,b24 ,bidm,bidm,
476 2 bidm,bidm,bidm,bidm,bidm,
477 3 bidm,bidm,bidm,bidm,bidm,
478 4 bidm,bidm,bidm,bidm,gbuf%OFF,
479 5 1,nel,nel)
480
481 IF (iparit == 0) THEN
482 CALL bcumu2 (lbuf1%FRAC,a,
483 . lbuf%SIG,lbuf%EINT,lbuf%RHO,lbuf%QVIS,gbuf%QVIS,
484 . gbuf%SIG,gbuf%EINT,gbuf%RHO,gbuf%TEMP,lbuf%TEMP,
485 . gbuf%PLA,lbuf%PLA,gbuf%BFRAC,lbuf%BFRAC,
486 . f11, f12, f21, f22, ax1,ax2,
487 . t11,t12,t13,t14,t21,t22,t23,t24,
488 . b11,b12,b13,b14,b21,b22,b23,b24,
489 . nc1,nc2,nc3,nc4,sti,stifn,
490 . l_temp, l_pla, l_bfrac, l_bulk, nel)
491 ELSE
492 CALL bcumu2p(lbuf1%FRAC,
493 . lbuf%SIG,lbuf%EINT,lbuf%RHO,lbuf%QVIS,gbuf%QVIS,
494 . gbuf%SIG,gbuf%EINT,gbuf%RHO,gbuf%TEMP,lbuf%TEMP,
495 . gbuf%PLA,lbuf%PLA,gbuf%BFRAC,lbuf%BFRAC,
496 . f11, f12, f21, f22, ax1,ax2,
497 . t11,t12,t13,t14,t21,t22,t23,t24,
498 . b11,b12,b13,b14,b21,b22,b23,b24,
499 . fsky,fsky,iadq,sti,
500 . l_temp,l_pla,l_bfrac,l_bulk,nel)
501 ENDIF
502
503
504
505
506
507
508C-----------------------------------------------------
509C SUBMATERIAL 2 (MAT LAW20)
510C-----------------------------------------------------
511 IF(imult > 1)THEN
512 jmult = 2
513 ilay = -2
514 lbuf => elbuf_tab(ng)%BUFLY(jmult)%LBUF(1,1,1) ! buffer mat 2
515 mtn=jparg(26)
516 l_temp = elbuf_tab(ng)%BUFLY(jmult)%L_TEMP
517 l_pla = elbuf_tab(ng)%BUFLY(jmult)%L_PLA
518 l_bfrac= elbuf_tab(ng)%BUFLY(jmult)%L_BFRAC
519 l_bulk = elbuf_tab(ng)%BUFLY(jmult)%L_QVIS
520
521 CALL brest2(gbuf%VOL,ic(lco),voln,
522 . aire, aires,
523 . eyy, ezz, ett, eyz, eyt, ezt,
524 . eyys, ezzs, etts, eyzs, eyts, ezts,
525 . mat, mat_elem%MAT_PARAM, nummat)
526 CALL blero2(lbuf2%FRAC,lbuf%VOL,lbuf%RHO,
527 . flux(1,nf2),flu1(nf2),lbuf%OFF,pm,ngl,voln,
528 . aire, eyy, ezz, ett, eyz, eyt, ezt, vd2, dvol,
529 . vy1, vy2, vy3, vy4,
530 . vz1, vz2, vz3, vz4,
531 . mat)
532 CALL qrota2(
533 1 lbuf%SIG,s1, s2, s3,
534 2 s4, s5, s6, wyz,
535 3 nel, jcvt)
536
537 IF (isorth == 0) THEN
538 !isotropic
539 DO i=1,nel
540 gama(i,1) = one
541 gama(i,2) = zero
542 gama(i,3) = zero
543 gama(i,4) = zero
544 gama(i,5) = one
545 gama(i,6) = zero
546 ENDDO
547 ELSE
548 DO i=1,nel
549 gama(i,1) = one
550 gama(i,2) = zero
551 gama(i,3) = zero
552 gama(i,4) = zero
553 gama(i,5) = one
554 gama(i,6) = zero
555 ENDDO
556 ENDIF
557C-----------------------------------------------------
558C STREE TENSOR
559C-----------------------------------------------------
560 CALL mmain(timers, output,
561 1 elbuf_tab, ng, pm, geo,
562 2 ale_connect, ic, iparg,
563 3 v, tf, npf, bufmat,
564 4 sti, x, dt2t, neltst,
565 5 ityptst, offset, nel, w,
566 6 lbuf%OFF, ngeo, mat, ngl,
567 7 voln, vd2, dvol, deltax,
568 8 vis, qvis, ssp, s1,
569 9 s2, s3, s4, s5,
570 a s6, eyy, ezz, ett,
571 b eyz, eyt, ezt, wyy,
572 c wzz, wyz, rx, ry,
573 d rz, sx, sy, sz,
574 e vdx, vdy, vdz, muvoid,
575 f ssp_eq, aire, sigy, et,
576 g bufvois, lbuf%PLA, r3_free, r4_free,
577 h eyy, ezz, ett, eyz,
578 i eyt, ezt, wyy, wzz,
579 j wyz, ipm, gama, bid,
580 k bid, bid, bid, bid,
581 l bid, bid, ibid, bid,
582 m bid, ibid, ilay, mbid,
583 n mbid, 1, 1, 1,
584 o table, bid, bid, bid,
585 p bid, nparg_bid, igeo, bid,
586 q itask, nloc_dmg, varnl, mat_elem,
587 r h3d_strain, jplasol, jsph, sz_bufvois,
588 s snpc, stf, sbufmat, glob_therm,
589 * svis, sz_ix, iresp,
590 t n2d, th_strain, ngroup, tt,
591 . dt1, ntable, numelq, nummat,
592 . numgeo, numnod, numels,
593 . idel7nok, idtmin, maxfunc,
594 . imon_mat, userl_avail, impl_s,
595 . idyna, dt ,bid ,sensors)
596C----------------------------------
597C PETROV-GALERKIN PSEUDO MASSES & MASSES ALE
598C----------------------------------
599 IF (iparit == 0) THEN
600 CALL qmass2(
601 1 lbuf%OFF,lbuf%RHO,ms, aire,
602 2 nc1, nc2, nc3, nc4,
603 3 nel)
604 ELSE
605 CALL qmass2ap(
606 1 lbuf%OFF,lbuf%RHO,aire, fsky,
607 2 fsky, iadq, nel, nft)
608 ENDIF
609C--------------------------
610C UPDATE OF MASSES : ALE physical masses
611C----------------------------
612 IF (jale+jeul > 0 )THEN
613 IF (iparit == 0)THEN
614 CALL qmassreal2(
615 1 lbuf%OFF,lbuf%RHO,ms_2d, voln,
616 2 nc1, nc2, nc3, nc4,
617 3 nel)
618 ELSE
619 CALL qmassreal2ap(
620 1 lbuf%OFF,lbuf%RHO,voln, fskym,
621 2 iadq, nel, nft)
622 ENDIF
623 ENDIF
624C------------------------
625C ANTI-HOURGLASS FORCES
626C------------------------
627 CALL qhvis2(pm,lbuf%OFF,lbuf%RHO,
628 . y1,y2,y3,y4,z1,z2,z3,z4,
629 . vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4,
630 . py1,py2,pz1,pz2,
631 . t11,t12,t13,t14,t21,t22,t23,t24,
632 . aire,ssp,mat,vd2,vis,eani,ngeo,geo,
633 . partsav,ipartq,ehou,iparg(63,ng))
634C--------------------------
635C SYNTHESIS PER SUBMATERIAL
636C--------------------------
637 iflag=mod(ncycle,ncpri)
638 IF(iflag == 0 .OR. tt >= output%TH%THIS .OR. mdess /= 0.
639 . or.tt>=output%TH%THIS1(1).OR.tt>=output%TH%THIS1(2).
640 . or.tt>=output%TH%THIS1(3).OR.tt>=output%TH%THIS1(4).OR.tt>=output%TH%THIS1(5).
641 . or.tt>=output%TH%THIS1(6).OR.tt>=output%TH%THIS1(7).OR.tt>=output%TH%THIS1(8).
642 . or.tt>=output%TH%THIS1(9).OR.nth/=0.OR.nanim/=0 .
643 . or.tt>=tabfis(1).OR.tt>=tabfis(2).
644 . or.tt>=tabfis(3).OR.tt>=tabfis(4).OR.tt>=tabfis(5).
645 . or.tt>=tabfis(6).OR.tt>=tabfis(7).OR.tt>=tabfis(8).
646 . or.tt>=tabfis(10))
647c
648 . CALL qbilan(
649 1 partsav, lbuf%OFF, lbuf%EINT,lbuf%RHO,
650 2 lbuf%RK, lbuf%VOL, vy1, vy2,
651 3 vy3, vy4, vz1, vz2,
652 4 vz3, vz4, voln, ipartq,
653 5 ehou, bid, bid, bid,
654 6 bid, gresav, grth, igrth,
655 7 ibid, bid, itask, nel,
656 8 jtur, jcvt, igre, sensors,
657 9 gbuf%G_WPLA,gbuf%WPLA)
658C--------------------
659C INTERNAL FORCES
660C--------------------
661 CALL qfint2(
662 1 lbuf%SIG,py1, py2, pz1,
663 2 pz2, aire, voln, qvis,
664 3 f11, f12, f21, f22,
665 4 ax1, ax2, bid, bid,
666 5 bid, bid, nel, jcvt,
667 6 svis)
668C------------------------
669C ADVECTION TERM (TRANSPORTATION 'FORCE')
670C------------------------
671 IF(jale > 0 .AND. mtn /= 11)
672 . CALL bamom2(
673 1 pm, v, w, lbuf%RHO,
674 2 lbuf2%FRAC,lbuf1%FRAC,fill(1,2), b11,
675 3 b12, b13, b14, b21,
676 4 b22, b23, b24, py1,
677 5 py2, pz1, pz2, aire,
678 6 mat, nc1, nc2, nc3,
679 7 nc4, nel)
680 IF(jeul > 0 .AND. mtn /= 11)
681 . CALL bemom2(
682 1 pm, v, lbuf%RHO, lbuf2%FRAC,
683 2 lbuf1%FRAC,fill(1,2), b11, b12,
684 3 b13, b14, b21, b22,
685 4 b23, b24, py1, py2,
686 5 pz1, pz2, aire, mat,
687 6 nc1, nc2, nc3, nc4,
688 7 nel)
689C--------------
690C ASSEMBLY
691C--------------
692 IF(jeul+jale /= 0) CALL check_off_ale(b11 ,b12 ,b13 ,b14 ,b21 ,
693 1 b22 ,b23 ,b24 ,bidm,bidm,
694 2 bidm,bidm,bidm,bidm,bidm,
695 3 bidm,bidm,bidm,bidm,bidm,
696 4 bidm,bidm,bidm,bidm,gbuf%OFF,
697 5 1,nel,nel)
698 IF(iparit == 0)THEN
699 CALL bcumu2(lbuf2%FRAC,a,
700 . lbuf%SIG,lbuf%EINT,lbuf%RHO,lbuf%QVIS,gbuf%QVIS,
701 . gbuf%SIG,gbuf%EINT,gbuf%RHO,gbuf%TEMP,lbuf%TEMP,
702 . gbuf%PLA,lbuf%PLA,gbuf%BFRAC,lbuf%BFRAC,
703 . f11, f12, f21, f22, ax1,ax2,
704 . t11,t12,t13,t14,t21,t22,t23,t24,
705 . b11,b12,b13,b14,b21,b22,b23,b24,
706 . nc1,nc2,nc3,nc4,sti,stifn,
707 . l_temp,l_pla,l_bfrac,l_bulk,nel)
708 ELSE
709 CALL bcumu2pa(lbuf2%FRAC,
710 . lbuf%SIG,lbuf%EINT,lbuf%RHO,lbuf%QVIS,gbuf%QVIS,
711 . gbuf%SIG,gbuf%EINT,gbuf%RHO,gbuf%TEMP,lbuf%TEMP,
712 . gbuf%PLA,lbuf%PLA,gbuf%BFRAC,lbuf%BFRAC,
713 . f11, f12, f21, f22, ax1,ax2,
714 . t11,t12,t13,t14,t21,t22,t23,t24,
715 . b11,b12,b13,b14,b21,b22,b23,b24,
716 . fsky,fsky,iadq,sti,l_temp,l_pla,
717 . l_bfrac,l_bulk,nel)
718 ENDIF
719 ENDIF
720C-----------
721 RETURN
bafil2
subroutine bafil2(v, w, fill, dfill, ims, x, dalph1, dalph2, nc1, nc2, nc3, nc4)
Definition bafil2.F:32
balph2
subroutine balph2(pm, alph1, alph2, volt, fill, sig1, eint1, volo1, rhon1, flux1, flu11, off1, sig2, eint2, volo2, rhon2, flux2, flu12, off2, sigt, eintt, rhot, tempt, l_temp, bfract, l_bfrac, plast, l_plas, voln, bulkt, l_bulk, nel, aire, aires, d1, d2, d3, d4, d5, d6, d1s, d2s, d3s, d4s, d5s, d6s, mat, nc1, nc2, nc3, nc4, dalph1, dalph2)
Definition balph2.F:43
bamom2
subroutine bamom2(pm, v, w, rho, alph, alphc, fill, b11, b12, b13, b14, b21, b22, b23, b24, py1, py2, pz1, pz2, aire, mat, nc1, nc2, nc3, nc4, nel)
Definition bamom2.F:36
bcumu2pa
subroutine bcumu2pa(alph, sig, eint, rho, bulk, bulkt, sigt, eintt, rhot, tempt, temp, plast, plas, bfract, bfrac, f11, f12, f21, f22, ax1, ax2, t11, t12, t13, t14, t21, t22, t23, t24, b11, b12, b13, b14, b21, b22, b23, b24, fsky, fskyv, iadq, sti, l_temp, l_pla, l_bfrac, l_bulk, nel)
Definition bcumu2.F:322
bcumu2
subroutine bcumu2(alph, e, sig, eint, rho, bulk, bulkt, sigt, eintt, rhot, tempt, temp, plast, plas, bfract, bfrac, f11, f12, f21, f22, ax1, ax2, t11, t12, t13, t14, t21, t22, t23, t24, b11, b12, b13, b14, b21, b22, b23, b24, nc1, nc2, nc3, nc4, sti, stifn, l_temp, l_pla, l_bfrac, l_bulk, nel)
Definition bcumu2.F:37
bcumu2p
subroutine bcumu2p(alph, sig, eint, rho, bulk, bulkt, sigt, eintt, rhot, tempt, temp, plast, plas, bfract, bfrac, f11, f12, f21, f22, ax1, ax2, t11, t12, t13, t14, t21, t22, t23, t24, b11, b12, b13, b14, b21, b22, b23, b24, fsky, fskyv, iadq, sti, l_temp, l_pla, l_bfrac, l_bulk, nel)
Definition bcumu2.F:159
befil2
subroutine befil2(v, fill, dfill, ims, x, dalph1, dalph2, nc1, nc2, nc3, nc4)
Definition befil2.F:34
bemom2
subroutine bemom2(pm, v, rho, alph, alphc, fill, b11, b12, b13, b14, b21, b22, b23, b24, py1, py2, pz1, pz2, aire, mat, nc1, nc2, nc3, nc4, nel)
Definition bemom2.F:36
blero2
subroutine blero2(alph, volo, rhon, flux, flu1, off, pm, ngl, voln, aire, d1, d2, d3, d4, d5, d6, vd2, dvol, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, mat)
Definition blero2.F:38
brest2
subroutine brest2(volt, ic, voln, aire, aires, d1, d2, d3, d4, d5, d6, d1s, d2s, d3s, d4s, d5s, d6s, mat, mat_param, nummat)
Definition brest2.F:35
check_off_ale
subroutine check_off_ale(f11, f21, f31, f12, f22, f32, f13, f23, f33, f14, f24, f34, f15, f25, f35, f16, f26, f36, f17, f27, f37, f18, f28, f38, off, lft, llt, nel)
Definition check_off_ale.F:38
my_real
#define my_real
Definition cppsort.cpp:32
edefo2
subroutine edefo2(vol, v, veul, y1, y2, y3, y4, z1, z2, z3, z4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, py1, py2, pz1, pz2, wyz, dyz, dzy, eyy, ezz, ett, eyz, eyt, ezt, voln, aire, deltax, vdy, vdz, vd2, nc1, nc2, nc3, nc4)
Definition edefo2.F:36
mmain
subroutine mmain(pm, elbuf_str, ix, nix, x, geo, iparg, nel, skew, bufmat, ipart, ipartel, nummat, matparam, imat, ipm, ngl, pid, npf, tf, mfxx, mfxy, mfxz, mfyx, mfyy, mfyz, mfzx, mfzy, mfzz, rx, ry, rz, sx, sy, sz, gama, voln, dvol, s1, s2, s3, s4, s5, s6, dxx, dyy, dzz, d4, d5, d6, wxx, wyy, wzz)
Definition mmain.F:43
ale_connectivity_mod
Definition ale_connectivity_mod.F:223
dt_mod
Definition dt_mod.F:79
message_mod
Definition message_mod.F:1249
nlocal_reg_mod
Definition nlocal_reg_mod.F:117
table_mod
Definition table_mod.F:112
qbilan
subroutine qbilan(partsav, off, eint, rho, rk, vol, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, vnew, ipartq, ehou, r22, r23, r32, r33, gresav, grth, igrth, iexpan, eintth, itask, nel, jtur, jcvt, igre, sensors, g_wpla, wpla)
Definition qbilan.F:45
qdefo2
subroutine qdefo2(v, w, y1, y2, y3, y4, z1, z2, z3, z4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, py1, py2, pz1, pz2, wyz, dyz, dzy, eyy, ezz, ett, eyz, eyt, ezt, rx, ry, rz, sx, sy, sz, tx, ty, tz, voln, aire, airem, nc1, nc2, nc3, nc4, nel)
Definition qdefo2.F:42
qfint2
subroutine qfint2(sig, py1, py2, pz1, pz2, area, vol, qvis, f11, f12, f21, f22, ax1, ax2, r22, r23, r32, r33, nel, jcvt, svis)
Definition qfint2.F:36
qhvis2
subroutine qhvis2(pm, off, rho, y1, y2, y3, y4, z1, z2, z3, z4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, py1, py2, pz1, pz2, t11, t12, t13, t14, t21, t22, t23, t24, area, cxx, mat, vd2, vis, eani, pid, geo, partsav, ipartq, ehou, iparg)
Definition qhvis2.F:38
qmass2
subroutine qmass2(off, rho, ms, area, nc1, nc2, nc3, nc4, nel)
Definition qmass2.F:37
qmass2ap
subroutine qmass2ap(off, rho, area, fsky, fskyv, iadq, nel, nft)
Definition qmass2ap.F:31
qmass2p
subroutine qmass2p(off, rho, area, fsky, fskyv, iadq, nel, nft)
Definition qmass2p.F:33
qmassreal2
subroutine qmassreal2(off, rho, ms_2d, vnew, nc1, nc2, nc3, nc4, nel)
Definition qmassreal2.F:41
qmassreal2ap
subroutine qmassreal2ap(off, rho, vnew, fskym, iadq, nel, nft)
Definition qmassreal2ap.F:32
qmassreal2p
subroutine qmassreal2p(off, rho, vnew, fskym, iadq, nel, nft)
Definition qmassreal2p.F:33
qrota2
subroutine qrota2(sig, s1, s2, s3, s4, s5, s6, wyz, nel, jcvt)
Definition qrota2.F:34
qvolu2
subroutine qvolu2(off, aire, volu, ngl, y1, y2, y3, y4, z1, z2, z3, z4, y234, y124, nel, jmult, jcvt)
Definition qvolu2.F:43
qcoor2
subroutine qcoor2(x, ixq, ngl, mxt, pid, ix1, ix2, ix3, ix4, y1, y2, y3, y4, z1, z2, z3, z4, sy, sz, ty, tz)
Definition qcoor2.F:37
qdlen2
subroutine qdlen2(iparg, aire, deltax, y1, y2, y3, y4, z1, z2, z3, z4)
Definition qdlen2.F:39
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
arret
subroutine arret(nn)
Definition arret.F:87