OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qforc2.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!|| qforc2 ../engine/source/elements/solid_2d/quad/qforc2.F
25!||--- called by ------------------------------------------------------
26!|| alemain ../engine/source/ale/alemain.F
27!|| forint ../engine/source/elements/forint.F
28!||--- calls -----------------------------------------------------
29!|| alero2 ../engine/source/ale/ale2d/alero2.F
30!|| amomt2 ../engine/source/ale/ale2d/amomt2.F
31!|| check_off_ale ../engine/source/elements/solid/solide/check_off_ale.F
32!|| ede112 ../engine/source/ale/euler2d/ede112.F
33!|| edefo2 ../engine/source/ale/euler2d/edefo2.F
34!|| emomt2 ../engine/source/ale/euler2d/emomt2.F
35!|| eulro2 ../engine/source/ale/euler2d/eulro2.F
36!|| mmain ../engine/source/materials/mat_share/mmain.F90
37!|| qbilan ../engine/source/elements/solid_2d/quad/qbilan.F
38!|| qcoor2 ../engine/source/elements/solid_2d/quad/qcoor2.F
39!|| qcumu2 ../engine/source/elements/solid_2d/quad/qcumu2.f
40!|| qcumu2p ../engine/source/elements/solid_2d/quad/qcumu2p.F
41!|| qdefo2 ../engine/source/elements/solid_2d/quad/qdefo2.F
42!|| qdlen2 ../engine/source/elements/solid_2d/quad/qdlen2.F
43!|| qfint2 ../engine/source/elements/solid_2d/quad/qfint2.F
44!|| qhvis2 ../engine/source/elements/solid_2d/quad/qhvis2.F
45!|| qlagr2 ../engine/source/elements/solid_2d/quad/qlagr2.F
46!|| qmass2 ../engine/source/elements/solid_2d/quad/qmass2.F
47!|| qmass2p ../engine/source/elements/solid_2d/quad/qmass2p.F
48!|| qmassreal2 ../engine/source/elements/solid_2d/quad/qmassreal2.F
49!|| qmassreal2p ../engine/source/elements/solid_2d/quad/qmassreal2p.F
50!|| qrcoor2 ../engine/source/elements/solid_2d/quad/qrcoor2.F
51!|| qrdefo2 ../engine/source/elements/solid_2d/quad/qrdefo2.F
52!|| qrota2 ../engine/source/elements/solid_2d/quad/qrota2.F
53!|| qrrota2 ../engine/source/elements/solid_2d/quad/qrrota2.F
54!|| qvolu2 ../engine/source/elements/solid_2d/quad/qvolu2.F
55!||--- uses -----------------------------------------------------
56!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
57!|| ale_mod ../common_source/modules/ale/ale_mod.F
58!|| dt_mod ../engine/source/modules/dt_mod.F
59!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
60!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
61!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
62!|| mmain_mod ../engine/source/materials/mat_share/mmain.F90
63!|| nlocal_reg_mod ../common_source/modules/nlocal_reg_mod.F
64!|| output_mod ../common_source/modules/output/output_mod.F90
65!|| sensor_mod ../common_source/modules/sensor_mod.F90
66!|| table_mod ../engine/share/modules/table_mod.F
67!|| timer_mod ../engine/source/system/timer_mod.F90
68!||====================================================================
69 SUBROUTINE qforc2(TIMERS, OUTPUT, ELBUF_TAB ,NG ,
70 1 PM ,GEO ,IC ,X ,A ,
71 2 V ,MS ,W ,FLUX ,FLU1 ,
72 3 VEUL ,ALE_CONNECT ,IPARG ,NLOC_DMG ,
73 4 TF ,NPF ,BUFMAT ,PARTSAV ,
74 5 DT2T ,NELTST ,ITYPTST ,STIFN ,OFFSET ,
75 6 EANI ,IPARTQ ,NEL ,IADQ ,FSKY ,
76 9 IPM ,BUFVOIS ,QMV ,
77 A GRESAV ,GRTH ,IGRTH ,TABLE ,IGEO ,
78 B VOLN ,ITASK ,MS_2D ,FSKYM ,IOUTPRT ,
79 C MAT_ELEM ,H3D_STRAIN ,SZ_BUFVOIS ,SNPC ,STF ,SBUFMAT ,
80 D SVIS ,NSVOIS ,IRESP ,TT ,DT1 ,
81 . IDEL7NOK ,IDTMIN ,MAXFUNC ,
82 . IMON_MAT ,USERL_AVAIL ,impl_s ,idyna ,
83 . DT ,GLOB_THERM,SENSORS)
84C-----------------------------------------------
85C D e s c r i p t i o n
86C-----------------------------------------------
87c FUNCTION: Internal force compute of Quad element
88c
89c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
90c
91c TYPE NAME FUNCTION
92c I PM ,GEO Material and geometrical property data
93c I IC(7,NUM_QUAD) connectivity and mid,pid integer data
94c I X(3,NUMNOD) co-ordinate
95c IO A(3,NUMNOD) nodal internal force
96c I V(3,NUMNOD) nodal velocity
97c IO MS(NUMNOD) nodal masse
98c I EV() internal element(material) data
99c I FLUX(4,NEL) flux at each side used w/ ALE or EULER
100c I FLU1 ,VEUL ,IELVS used w/ ALE or EULER
101c I IPARG(NG) element group data
102c I ELBUF() internal element(material) data used w/ ALE or EULER
103c I TF() ,NPF() Radioss function (x=Time) data
104c I BUFMAT() internal material data
105c IO PARTSAV() output use per part
106c IO DT2T smallest elementary time step
107c O NELTST,ITYPTST element type (property type for spring) which determine DT2T
108c IO STIFN(NUMNOD) nodal stiffness to calcul nodal time step
109c IO EANI() anim output vector
110c I IPARTQ() quad element group data (output)
111c I NEL nb of quad element in this group
112c I IADQ() ,FSKY() work arrays for special option of internal force assemlage
113c IO XPHI,FPHI,VPHI,MSPHI,PV ,
114c X0PHI ,EVD : variables for sensibility(opt) no more used
115c I BUFVOIS() work table for fluide w/ SPMD
116c I QMV(8,) work table used w/ ALE or EULER
117c I GRESAV,GRTH,IGRTH work table used for TH (time history) output
118c I TABLE new alternative Radioss function(table) data
119c I IGEO geometrical property integer data
120C-----------------------------------------------
121C M o d u l e s
122C-----------------------------------------------
123 USE timer_mod
124 USE output_mod, only : output_
125 USE mmain_mod
126 USE table_mod
127 USE mat_elem_mod
130 USE ale_mod , ONLY : ale
131 USE elbufdef_mod
132 USE dt_mod
133 use glob_therm_mod
134 USE sensor_mod
135C-----------------------------------------------
136C I m p l i c i t T y p e s
137C-----------------------------------------------
138#include "implicit_f.inc"
139C-----------------------------------------------
140C G l o b a l P a r a m e t e r s
141C-----------------------------------------------
142#include "mvsiz_p.inc"
143#include "parit_c.inc"
144#include "param_c.inc"
145#include "comlock.inc"
146C-----------------------------------------------
147C D u m m y A r g u m e n t s
148C-----------------------------------------------
149 TYPE(timer_), INTENT(INOUT) :: TIMERS
150 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
151 my_real, INTENT(IN) :: DT1
152 my_real, INTENT(IN) :: TT
153 INTEGER,INTENT(IN) :: SNPC
154 INTEGER,INTENT(IN) :: STF
155 INTEGER, INTENT(IN) :: SBUFMAT
156 INTEGER, INTENT(IN) :: NSVOIS
157 INTEGER ,INTENT(IN) :: IRESP
158 INTEGER ,INTENT(INOUT) :: IDEL7NOK
159 integer,dimension(102) :: IDTMIN
160 INTEGER ,INTENT(IN) :: MAXFUNC
161 INTEGER, INTENT(IN) :: IMPL_S
162 INTEGER, INTENT(IN) :: IDYNA
163 INTEGER, INTENT(IN) :: USERL_AVAIL
164 INTEGER, INTENT(IN) :: IMON_MAT
165 INTEGER IC(*), IPARG(NPARG,NGROUP), NPF(*),IPARTQ(NUMELQ),
166 . ipm(*), grth(*),igrth(*),igeo(*), iadq(4,*), itask
167 INTEGER, INTENT(IN) :: SZ_BUFVOIS
168 INTEGER OFFSET,NEL,NG,NELTST,ITYPTST,IOUTPRT,H3D_STRAIN
169 my_real dt2t
170 my_real pm(*), geo(*), x(*), a(*), v(*), ms(*), w(*), flux(4,*),
171 . flu1(*), veul(*), tf(*), bufmat(*), fsky(*),
172 . partsav(*), stifn(*),eani(*), bufvois(6,*),qmv(8,*),gresav(*),voln(mvsiz),
173 . ms_2d(*),fskym(*)
174 my_real, DIMENSION(MVSIZ,6), INTENT(INOUT) :: svis
175 TYPE(ttable) TABLE(*)
176 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
177 TYPE (NLOCAL_STR_) , TARGET :: NLOC_DMG
178 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
179 TYPE (MAT_ELEM_) ,INTENT(INOUT) :: MAT_ELEM
180 TYPE (DT_), INTENT(IN) :: DT
181 type (glob_therm_) ,intent(inout) :: glob_therm
182 type (sensors_),INTENT(INOUT) :: sensors
183C-----------------------------------------------
184C C o m m o n B l o c k s
185C-----------------------------------------------
186#include "vect01_c.inc"
187#include "com01_c.inc"
188#include "com04_c.inc"
189C-----------------------------------------------
190C L o c a l V a r i a b l e s
191C-----------------------------------------------
192 INTEGER LCO, NF1, IFLAG,I,IPTR,IPTS,IPTT,ILAY,ISTRAIN
193 INTEGER IBIDON(1),IBID,SZ_IX,DUMMY_IPARG1(NPARG)
194
195 my_real rx(mvsiz),ry(mvsiz),rz(mvsiz),sx(mvsiz),sy(mvsiz),sz(mvsiz),tx(mvsiz),ty(mvsiz),tz(mvsiz)
196
197 INTEGER, DIMENSION(MVSIZ) :: MAT,NC1,NC2,NC3,NC4,NGL,NGEO
198 INTEGER :: NUM_ELEM_ALE
199 my_real, DIMENSION(MVSIZ) :: F11, F12, F21, F22
200 my_real, DIMENSION(MVSIZ) :: AX1, AX2
201 my_real, DIMENSION(MVSIZ) :: T11, T12, T13, T14, T21, T22, T23, T24
202 my_real, DIMENSION(MVSIZ) :: Y1, Y2, Y3, Y4, Z1, Z2, Z3, Z4
203 my_real, DIMENSION(MVSIZ) :: VY1, VY2, VY3, VY4, VZ1, VZ2, VZ3, VZ4
204 my_real, DIMENSION(MVSIZ) :: PY1, PY2, PZ1, PZ2
205 my_real, DIMENSION(MVSIZ) :: AIRE,AIREM,QVIS,VIS,WYZ
206 my_real, DIMENSION(MVSIZ) :: s1,s2,s3,s4,s5,s6
207 my_real, DIMENSION(MVSIZ) :: vd2,dvol,deltax
208 my_real, DIMENSION(MVSIZ) :: dyz,dzy,ssp
209 my_real, DIMENSION(MVSIZ) :: eyy,ezz,ett,eyz,eyt,ezt
210 my_real, DIMENSION(MVSIZ) :: vdy, vdz
211 my_real ehou(mvsiz),ssp_eq(mvsiz)
212 my_real wyy(mvsiz),wzz(mvsiz),vdx(mvsiz)
213
214 ! SPH case
215 my_real muvoid(mvsiz), sti(mvsiz),bid(mvsiz), mbid(mvsiz)
216 ! void MMAIN
217 my_real sigy(mvsiz),et(mvsiz),gama(mvsiz,6),r3_free(mvsiz),r4_free(mvsiz)
218 my_real r11(mvsiz),r12(mvsiz),r13(mvsiz),
219 . r21(mvsiz),r22(mvsiz),r23(mvsiz),
220 . r31(mvsiz),r32(mvsiz),r33(mvsiz),
221 . y234(mvsiz),y124(mvsiz),bidm(mvsiz)
222 my_real varnl(nel)
223 my_real, DIMENSION(:), POINTER :: eint
224
225 ! ale grid formulation 7 (flow-tracking)
226 my_real :: elem_mass
227 my_real :: sum_eps(9),sum_m,sum_vol
228
229 TYPE(g_bufel_) ,POINTER :: GBUF
230C-----------------------------------------------
231C S o u r c e L i n e s
232C-----------------------------------------------
233 gbuf => elbuf_tab(ng)%GBUF
234c
235 ibidon=0
236 ibid = 0
237 sz_ix=numelq+numels+nsvois ! Size of IX array (either IXS+NSVOIS or IXQ)
238 bidm(1:mvsiz) = zero
239 mbid(1:mvsiz) = zero
240 bid(:) = zero
241 DO i=1,nel
242 wyy(i)=zero
243 wzz(i)=zero
244 vdx(i)=zero
245 ENDDO
246C
247 IF (isorth == 0) THEN
248C propriete isotrope
249 DO i=1,nel
250 gama(i,1) = one
251 gama(i,2) = zero
252 gama(i,3) = zero
253 gama(i,4) = zero
254 gama(i,5) = one
255 gama(i,6) = zero
256 ENDDO
257 ELSE
258 DO i=1,nel
259 gama(i,1) = gbuf%GAMA(i )
260 gama(i,2) = gbuf%GAMA(i + nel)
261 gama(i,3) = gbuf%GAMA(i + 2*nel)
262 gama(i,4) = gbuf%GAMA(i + 3*nel)
263 gama(i,5) = gbuf%GAMA(i + 4*nel)
264 gama(i,6) = gbuf%GAMA(i + 5*nel)
265 ENDDO
266 ENDIF
267 istrain = iparg(44,ng)
268C
269 lco=1+7*nft
270 nf1=nft+1
271C
272 IF (jcvt == 0)THEN
273 CALL qcoor2(
274 1 x, ic(lco), y1, y2,
275 2 y3, y4, z1, z2,
276 3 z3, z4, nc1, nc2,
277 4 nc3, nc4, ngl, mat,
278 5 ngeo, vd2, vis, nel)
279 ELSE
280C------ Co-rotational system (convective local system)
281C JCVT/=0 => JLAG/=0
282 CALL qrcoor2(
283 1 x, ic(lco), y1, y2,
284 2 y3, y4, z1, z2,
285 3 z3, z4, nc1, nc2,
286 4 nc3, nc4, ngl, mat,
287 5 ngeo, vd2, r11, r12,
288 6 r13, r21, r22, r23,
289 7 r31, r32, r33, gama,
290 8 y234, y124, vis, nel,
291 9 isorth)
292 END IF
293c
294 IF (jlag/=0) THEN
295C--------------
296C LAGRANGE, VOLUME and CHARACTERISTIC length (for DT) compute
297C--------------
298 CALL qvolu2(
299 1 gbuf%OFF,aire, voln, ngl,
300 2 y1, y2, y3, y4,
301 3 z1, z2, z3, z4,
302 4 y234, y124, nel, jmult,
303 5 jcvt)
304 CALL qdlen2(y1,y2,y3,y4,z1,z2,z3,z4,aire,deltax,iparg(63,ng))
305 IF (jcvt == 0) THEN
306 CALL qdefo2(
307 1 v, v, y1, y2,
308 2 y3, y4, z1, z2,
309 3 z3, z4, vy1, vy2,
310 4 vy3, vy4, vz1, vz2,
311 5 vz3, vz4, py1, py2,
312 6 pz1, pz2, wyz, dyz,
313 7 dzy, eyy, ezz, ett,
314 8 eyz, eyt, ezt, rx,
315 9 ry, rz, sx, sy,
316 a sz, tx, ty, tz,
317 b voln, aire, airem, nc1,
318 c nc2, nc3, nc4, nel)
319 ELSE
320 CALL qrdefo2(
321 1 v, y1, y2, y3,
322 2 y4, z1, z2, z3,
323 3 z4, vy1, vy2, vy3,
324 4 vy4, vz1, vz2, vz3,
325 5 vz4, py1, py2, pz1,
326 6 pz2, wyz, dyz, dzy,
327 7 eyy, ezz, ett, eyz,
328 8 eyt, ezt, rx, ry,
329 9 rz, sx, sy, sz,
330 a tx, ty, tz, voln,
331 b aire, airem, nc1, nc2,
332 c nc3, nc4, r22, r23,
333 d r32, r33, nel, jcvt)
334 END IF
335c
336 CALL qlagr2(
337 1 pm, gbuf%VOL, gbuf%RHO, gbuf%EINT,
338 2 voln, dvol, mat, nel)
339 CALL qrota2(
340 1 gbuf%SIG,s1, s2, s3,
341 2 s4, s5, s6, wyz,
342 3 nel, jcvt)
343 ELSEIF (jale/=0) THEN
344C------------
345C A.L.E.
346C------------
347 CALL qvolu2(
348 1 gbuf%OFF,aire, voln, ngl,
349 2 y1, y2, y3, y4,
350 3 z1, z2, z3, z4,
351 4 bid, bid, nel, jmult,
352 5 jcvt)
353 CALL qdlen2(y1,y2,y3,y4,z1,z2,z3,z4,aire,deltax,iparg(63,ng))
354 CALL qdefo2(
355 1 v, w, y1, y2,
356 2 y3, y4, z1, z2,
357 3 z3, z4, vy1, vy2,
358 4 vy3, vy4, vz1, vz2,
359 5 vz3, vz4, py1, py2,
360 6 pz1, pz2, wyz, dyz,
361 7 dzy, eyy, ezz, ett,
362 8 eyz, eyt, ezt, rx,
363 9 ry, rz, sx, sy,
364 a sz, tx, ty, tz,
365 b voln, aire, airem, nc1,
366 c nc2, nc3, nc4, nel)
367 CALL alero2(
368 1 gbuf%OFF, gbuf%VOL, gbuf%RHO, flux(1,nf1),
369 2 flu1(nf1), w, vy1, vy2,
370 3 vy3, vy4, vz1, vz2,
371 4 vz3, vz4, voln, dvol,
372 5 vd2, nc1, nc2, nc3,
373 6 nc4, ngl)
374 CALL qrota2(
375 1 gbuf%SIG,s1, s2, s3,
376 2 s4, s5, s6, wyz,
377 3 nel, jcvt)
378 ELSEIF (jeul/=0) THEN
379C-----------
380C EULER
381C-----------
382 IF (mtn == 11) CALL ede112(
383 1 pm, v, x,
384 2 ic, ale_connect,wyz, dyz,
385 3 dzy, eyy, ezz)
386 CALL edefo2(
387 1 gbuf%VOL,v, veul, y1,
388 2 y2, y3, y4, z1,
389 3 z2, z3, z4, vy1,
390 4 vy2, vy3, vy4, vz1,
391 5 vz2, vz3, vz4, py1,
392 6 py2, pz1, pz2, wyz,
393 7 dyz, dzy, eyy, ezz,
394 8 ett, eyz, eyt, ezt,
395 9 voln, aire, deltax, vdy,
396 a vdz, vd2, nc1, nc2,
397 b nc3, nc4)
398 CALL eulro2(
399 1 gbuf%RHO, flux(1,nf1),flu1(nf1),
400 2 voln, dvol, ngl)
401 CALL qrota2(
402 1 gbuf%SIG,s1, s2, s3,
403 2 s4, s5, s6, wyz,
404 3 nel, jcvt)
405 ENDIF
406C-----------------------------------------------------
407C STRESS CALCULATION (Constitutive laws)
408C-----------------------------------------------------
409C SPMD + FLUID : BUFVOIS LOI11
410c
411 ilay = 1
412 iptr = 1
413 ipts = 1
414 iptt = 1
415c
416 CALL mmain(timers, output,
417 1 elbuf_tab, ng, pm, geo,
418 2 ale_connect, ic, iparg,
419 3 v, tf, npf, bufmat,
420 4 sti, x, dt2t, neltst,
421 5 ityptst, offset, nel, w,
422 6 gbuf%OFF, ngeo, mat, ngl,
423 7 voln, vd2, dvol, deltax,
424 8 vis, qvis, ssp, s1,
425 9 s2, s3, s4, s5,
426 a s6, eyy, ezz, ett,
427 b eyz, eyt, ezt, wyy,
428 c wzz, wyz, rx, ry,
429 d rz, sx, sy, sz,
430 e vdx, vdy, vdz, muvoid,
431 f ssp_eq, aire, sigy, et,
432 g bufvois, gbuf%PLA, r3_free, r4_free,
433 h eyy, ezz, ett, eyz,
434 i eyt, ezt, wyy, wzz,
435 j wyz, ipm, gama, bid,
436 k mbid, mbid, mbid, mbid,
437 l bid, bid, istrain, bid,
438 m bid, ibidon(1), ilay, mbid,
439 n mbid, iptr, ipts, iptt,
440 o table, bid, bid, bid,
441 p bid, dummy_iparg1,igeo, bid,
442 q itask, nloc_dmg, varnl, mat_elem,
443 r h3d_strain, jplasol, jsph, sz_bufvois,
444 s snpc, stf, sbufmat, glob_therm,
445 t svis, sz_ix, iresp,
446 u n2d, th_strain, ngroup, tt,
447 . dt1, ntable, numelq, nummat,
448 . numgeo, numnod, numels,
449 . idel7nok, idtmin, maxfunc,
450 . imon_mat, userl_avail, impl_s,
451 . idyna, dt , bid ,sensors)
452C--------------------------
453C SYNTHESIS PER MATERIAL (thermics)
454C--------------------------
455 IF(jlag+jale+jeul == 0)THEN
456 iflag=mod(ncycle,ncpri)
457 IF(ioutprt>0)THEN
458c
459 IF (mtn == 11) THEN
460 eint => elbuf_tab(ng)%GBUF%EINS(1:nel)
461 ELSE
462 eint => elbuf_tab(ng)%GBUF%EINT(1:nel)
463 ENDIF
464 CALL qbilan(
465 1 partsav, gbuf%OFF, eint, gbuf%RHO,
466 2 gbuf%RK, gbuf%VOL, vy1, vy2,
467 3 vy3, vy4, vz1, vz2,
468 4 vz3, vz4, voln, ipartq,
469 5 ehou, r22, r23, r32,
470 6 r33, gresav, grth, igrth,
471 7 ibidon(1), gbuf%EINTTH,itask, nel,
472 8 jtur, jcvt, igre, sensors,
473 9 gbuf%G_WPLA,gbuf%WPLA)
474 ENDIF
475 RETURN
476 ENDIF
477C----------------------------------
478C PETROV-GALERKIN PSEUDO MASSES & ALE MASSES
479C----------------------------------
480 IF (iparit == 0)THEN
481 CALL qmass2(
482 1 gbuf%OFF,gbuf%RHO,ms, aire,
483 2 nc1, nc2, nc3, nc4,
484 3 nel)
485 ELSE
486 CALL qmass2p(
487 1 gbuf%OFF,gbuf%RHO,aire, fsky,
488 2 fsky, iadq, nel, nft)
489 ENDIF
490C--------------------------
491C UPDATE OF MASSES : ALE physical masses
492C----------------------------
493 IF (jale+jeul > 0 )THEN
494 IF (iparit == 0)THEN
495 CALL qmassreal2(
496 1 gbuf%OFF,gbuf%RHO,ms_2d, voln,
497 2 nc1, nc2, nc3, nc4,
498 3 nel)
499 ELSE
500 CALL qmassreal2p(
501 1 gbuf%OFF,gbuf%RHO,voln, fskym,
502 2 iadq, nel, nft)
503 ENDIF
504 ENDIF
505
506C---------------------------------------------
507C /ALE/GRID/FLOW-TRACKING - BUFFER UPDATED
508C---------------------------------------------
509 ! this grid formulation needs an averaged tensor (E=GRAD U)
510 IF(ale%GRID%NWALE == 7 .AND. jale == 1)THEN
511 sum_eps(1:9) = zero
512 sum_m = zero
513 sum_vol = zero
514 num_elem_ale = nel
515 DO i=1,nel
516 elem_mass = gbuf%RHO(i)*gbuf%VOL(i)
517 sum_eps(2) = sum_eps(2) + elem_mass*eyy(i)
518 sum_eps(3) = sum_eps(3) + elem_mass*ezz(i)
519 sum_eps(6) = sum_eps(6) + elem_mass*dyz(i)
520 sum_eps(9) = sum_eps(9) + elem_mass*dzy(i)
521 sum_m = sum_m + elem_mass
522 sum_vol = sum_vol + gbuf%VOL(i)
523 ENDDO
524#include "lockon.inc"
525 ale%GRID%flow_tracking_data%EP(2) = ale%GRID%flow_tracking_data%EP(2) + sum_eps(2)
526 ale%GRID%flow_tracking_data%EP(3) = ale%GRID%flow_tracking_data%EP(3) + sum_eps(3)
527 ale%GRID%flow_tracking_data%EP(4) = ale%GRID%flow_tracking_data%EP(4) + sum_eps(4)
528 ale%GRID%flow_tracking_data%EP(6) = ale%GRID%flow_tracking_data%EP(6) + sum_eps(6)
529 ale%GRID%flow_tracking_data%EP(9) = ale%GRID%flow_tracking_data%EP(9) + sum_eps(9)
530 ale%GRID%flow_tracking_data%SUM_M = ale%GRID%flow_tracking_data%SUM_M + sum_m
531 ale%GRID%flow_tracking_data%SUM_VOL = ale%GRID%flow_tracking_data%SUM_VOL + sum_vol
532 ale%GRID%flow_tracking_data%NUM_ELEM_ALE = ale%GRID%flow_tracking_data%NUM_ELEM_ALE + num_elem_ale
533#include "lockoff.inc"
534 endif!(ALE%GRID%NWALE == 7)
535
536
537C------------------------
538C FORCES ANTI SABLIER (HOURGLASS CONTROL)
539C------------------------
540 CALL qhvis2(pm,gbuf%OFF,gbuf%RHO,
541 . y1,y2,y3,y4,z1,z2,z3,z4,
542 . vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4,
543 . py1,py2,pz1,pz2,
544 . t11,t12,t13,t14,t21,t22,t23,t24,
545 . aire,ssp,mat,vd2,vis,eani,ngeo,geo,
546 . partsav,ipartq,ehou,iparg(63,ng))
547C--------------------------
548C BILANS PAR MATERIAU (output Result summary)
549C--------------------------
550 iflag=mod(ncycle,ncpri)
551 IF(ioutprt>0)THEN
552c
553 IF (mtn == 11) THEN
554 eint => elbuf_tab(ng)%GBUF%EINS(1:nel)
555 ELSE
556 eint => elbuf_tab(ng)%GBUF%EINT(1:nel)
557 ENDIF
558 CALL qbilan(
559 1 partsav, gbuf%OFF, eint, gbuf%RHO,
560 2 gbuf%RK, gbuf%VOL, vy1, vy2,
561 3 vy3, vy4, vz1, vz2,
562 4 vz3, vz4, voln, ipartq,
563 5 ehou, r22, r23, r32,
564 6 r33, gresav, grth, igrth,
565 7 ibidon(1), gbuf%EINTTH,itask, nel,
566 8 jtur, jcvt, igre, sensors,
567 9 gbuf%G_WPLA,gbuf%WPLA)
568 ENDIF
569C
570C------------------------
571C FORCES DE TRANSPORT
572C------------------------
573 IF(jale > 0 .AND. mtn /= 11)THEN
574 CALL amomt2(
575 1 pm, w, gbuf%RHO,
576 2 y1, y2, y3, y4,
577 3 z1, z2, z3, z4,
578 4 t11, t12, t13, t14,
579 5 t21, t22, t23, t24,
580 6 py1, py2, pz1, pz2,
581 7 airem, vy1, vy2, vy3,
582 8 vy4, vz1, vz2, vz3,
583 9 vz4, eyy, ezz, dyz,
584 a dzy, nc1, nc2, nc3,
585 b nc4, mat, gbuf%OFF,qmv,
586 c bufmat, deltax, vis, ipm)
587 ENDIF
588
589 IF(jeul > 0)THEN
590 CALL emomt2(
591 1 pm, gbuf%RHO,y1, y2,
592 2 y3, y4, z1, z2,
593 3 z3, z4, vy1, vy2,
594 4 vy3, vy4, vz1, vz2,
595 5 vz3, vz4, t11, t12,
596 6 t13, t14, t21, t22,
597 7 t23, t24, py1, py2,
598 8 pz1, pz2, aire, eyy,
599 9 ezz, dyz, dzy, vdy,
600 a vdz, deltax, vis,
601 c mat, qmv, bufmat, ipm)
602 ENDIF
603C--------------------
604C FORCES INTERNES
605C--------------------
606 CALL qfint2(
607 1 gbuf%SIG,py1, py2, pz1,
608 2 pz2, aire, voln, qvis,
609 3 f11, f12, f21, f22,
610 4 ax1, ax2, r22, r23,
611 5 r32, r33, nel, jcvt,
612 6 svis)
613C--------------
614 IF(jcvt/=0)THEN
615 CALL qrrota2(
616 1 r22, r32, r23, r33,
617 2 f11, f21, f12, f22,
618 3 t11, t21, t12, t22,
619 4 t13, t23, t14, t24,
620 5 nel)
621 END IF
622 IF(jeul+jale/=0) CALL check_off_ale(t11 ,t21 ,t12 ,t22 ,t13 ,
623 1 t23 ,t14 ,t24 ,bidm,bidm,
624 2 bidm,bidm,bidm,bidm,bidm,
625 3 bidm,bidm,bidm,bidm,bidm,
626 4 bidm,bidm,bidm,bidm,gbuf%OFF,
627 5 1,nel,nel)
628C--------------
629C ASSEMBLE
630C--------------
631 IF(iparit == 0)THEN
632 CALL qcumu2(
633 1 a, f11, f12, f21,
634 2 f22, ax1, ax2, t11,
635 3 t12, t13, t14, t21,
636 4 t22, t23, t24, nc1,
637 5 nc2, nc3, nc4, sti,
638 6 stifn, nel)
639 ELSE
640 CALL qcumu2p(
641 1 f11, f12, f21, f22,
642 2 ax1, ax2, t11, t12,
643 3 t13, t14, t21, t22,
644 4 t23, t24, fsky, fsky,
645 5 iadq, sti, nel, nft)
646 ENDIF
647c-----------
648 RETURN
649 END
subroutine alero2(off, volo, rhon, flux, flu1, w, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, voln, dvol, vd2, nc1, nc2, nc3, nc4, ngl)
Definition alero2.F:37
subroutine amomt2(pm, w, rho, y1, y2, y3, y4, z1, z2, z3, z4, t11, t12, t13, t14, t21, t22, t23, t24, py1, py2, pz1, pz2, airem, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, dyy, dzz, dyz, dzy, nc1, nc2, nc3, nc4, mat, off, qmv, bufmat, deltax, vis, ipm)
Definition amomt2.F:41
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)
subroutine ede112(pm, v, x, ixq, ale_connect, wyz, dyz, dzy, eyy, ezz)
Definition ede112.F:32
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
subroutine emomt2(pm, rho, y1, y2, y3, y4, z1, z2, z3, z4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, t11, t12, t13, t14, t21, t22, t23, t24, py1, py2, pz1, pz2, aire, dyy, dzz, dyz, dzy, vdy, vdz, deltax, vis, mat, qmv, bufmat, ipm)
Definition emomt2.F:41
subroutine eulro2(rhon, flux, flu1, voln, dvol, ngl)
Definition eulro2.F:34
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
type(ale_) ale
Definition ale_mod.F:249
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
subroutine qcumu2(e, f11, f12, f21, f22, ax1, ax2, t11, t12, t13, t14, t21, t22, t23, t24, nc1, nc2, nc3, nc4, sti, stifn, nel)
Definition qcumu2.F:35
subroutine qcumu2p(f11, f12, f21, f22, ax1, ax2, t11, t12, t13, t14, t21, t22, t23, t24, fsky, fskyv, iadq, sti, nel, nft)
Definition qcumu2p.F:34
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
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
subroutine qforc2(timers, output, elbuf_tab, ng, pm, geo, ic, x, a, v, ms, w, flux, flu1, veul, ale_connect, iparg, nloc_dmg, tf, npf, bufmat, partsav, dt2t, neltst, ityptst, stifn, offset, eani, ipartq, nel, iadq, fsky, ipm, bufvois, qmv, gresav, grth, igrth, table, igeo, voln, itask, ms_2d, fskym, ioutprt, mat_elem, h3d_strain, sz_bufvois, snpc, stf, sbufmat, svis, nsvois, iresp, tt, dt1, idel7nok, idtmin, maxfunc, imon_mat, userl_avail, impl_s, idyna, dt, glob_therm, sensors)
Definition qforc2.F:84
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
subroutine qlagr2(pm, vol0, rho, eint, voln, dvol, mat, nel)
Definition qlagr2.F:32
subroutine qmass2(off, rho, ms, area, nc1, nc2, nc3, nc4, nel)
Definition qmass2.F:37
subroutine qmass2p(off, rho, area, fsky, fskyv, iadq, nel, nft)
Definition qmass2p.F:33
subroutine qmassreal2(off, rho, ms_2d, vnew, nc1, nc2, nc3, nc4, nel)
Definition qmassreal2.F:41
subroutine qmassreal2p(off, rho, vnew, fskym, iadq, nel, nft)
Definition qmassreal2p.F:33
subroutine qrdefo2(v, 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, r22, r23, r32, r33, nel, jcvt)
Definition qrdefo2.F:42
subroutine qrota2(sig, s1, s2, s3, s4, s5, s6, wyz, nel, jcvt)
Definition qrota2.F:34
subroutine qrrota2(r22, r23, r32, r33, f11, f21, f12, f22, t11, t21, t12, t22, t13, t23, t14, t24, nel)
Definition qrrota2.F:34
subroutine qvolu2(off, aire, volu, ngl, y1, y2, y3, y4, z1, z2, z3, z4, y234, y124, nel, jmult, jcvt)
Definition qvolu2.F:43
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
subroutine qdlen2(iparg, aire, deltax, y1, y2, y3, y4, z1, z2, z3, z4)
Definition qdlen2.F:39
subroutine qrcoor2(x, ixq, ngl, mxt, pid, ix1, ix2, ix3, ix4, y1, y2, y3, y4, z1, z2, z3, z4, sy, sz, ty, tz, e1y, e1z, e2y, e2z)
Definition qrcoor2.F:34