69 SUBROUTINE qforc2(TIMERS, OUTPUT, ELBUF_TAB ,NG ,
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 ,
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)
124 USE output_mod,
only : output_
138#include
"implicit_f.inc"
142#include "mvsiz_p.inc"
143#include "parit_c.inc"
144#include "param_c.inc"
145#include "comlock.inc"
149 TYPE(timer_),
INTENT(INOUT) :: TIMERS
150 TYPE(OUTPUT_),
INTENT(INOUT) :: OUTPUT
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) ::
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
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),
174 my_real,
DIMENSION(MVSIZ,6),
INTENT(INOUT) :: svis
176 TYPE (ELBUF_STRUCT_),
TARGET,
DIMENSION(NGROUP) :: ELBUF_TAB
177 TYPE (NLOCAL_STR_) ,
TARGET :: NLOC_DMG
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
186#include
"vect01_c.inc"
187#include "com01_c.inc"
188#include "com04_c.inc"
192 INTEGER LCO, NF1, IFLAG,I,IPTR,IPTS,IPTT,ILAY,ISTRAIN
193 INTEGER IBIDON(1),IBID,SZ_IX,DUMMY_IPARG1(NPARG)
195 my_real rx(mvsiz),ry(mvsiz),rz(mvsiz),sx(mvsiz),sy(mvsiz),sz(mvsiz),tx(mvsiz),ty(mvsiz),tz(mvsiz)
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 ,
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)
215 my_real muvoid(mvsiz), sti(mvsiz),bid(mvsiz), mbid(mvsiz)
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)
223 my_real,
DIMENSION(:),
POINTER :: eint
227 my_real :: sum_eps(9),sum_m,sum_vol
229 TYPE(g_bufel_) ,
POINTER :: GBUF
233 gbuf => elbuf_tab(ng)%GBUF
237 sz_ix=numelq+numels+nsvois
247 IF (isorth == 0)
THEN
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)
267 istrain = iparg(44,ng)
274 1 x, ic(lco), y1, y2,
277 4 nc3, nc4, ngl, mat,
278 5 ngeo, vd2, vis, nel)
283 1 x, ic(lco), y1, y2,
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,
299 1 gbuf%OFF,aire, voln, ngl,
302 4 y234, y124, nel, jmult,
304 CALL qdlen2(y1,y2,y3,y4,z1,z2,z3,z4,aire,deltax,iparg(63,ng))
310 4 vy3, vy4, vz1, vz2,
311 5 vz3, vz4, py1, py2,
312 6 pz1, pz2, wyz, dyz,
313 7 dzy, eyy, ezz, ett,
317 b voln, aire, airem, nc1,
318 c nc2, nc3, nc4, nel)
324 4 vy4, vz1, vz2, vz3,
325 5 vz4, py1, py2, pz1,
326 6 pz2, wyz, dyz, dzy,
327 7 eyy, ezz, ett, eyz,
331 b aire, airem, nc1, nc2,
332 c nc3, nc4, r22, r23,
333 d r32, r33, nel, jcvt)
337 1 pm, gbuf%VOL, gbuf%RHO, gbuf%EINT,
338 2 voln, dvol, mat, nel)
340 1 gbuf%SIG,s1, s2, s3,
343 ELSEIF (jale/=0)
THEN
348 1 gbuf%OFF,aire, voln, ngl,
351 4 bid, bid, nel, jmult,
353 CALL qdlen2(y1,y2,y3,y4,z1,z2,z3,z4,aire,deltax,iparg(63,ng))
358 4 vy3, vy4, vz1, vz2,
359 5 vz3, vz4, py1, py2,
360 6 pz1, pz2, wyz, dyz,
361 7 dzy, eyy, ezz, ett,
365 b voln, aire, airem, nc1,
366 c nc2, nc3, nc4, nel)
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,
375 1 gbuf%SIG,s1, s2, s3,
378 ELSEIF (jeul/=0)
THEN
382 IF (mtn == 11)
CALL ede112(
384 2 ic, ale_connect,wyz, dyz,
387 1 gbuf%VOL,v, veul, y1,
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,
399 1 gbuf%RHO, flux(1,nf1),flu1(nf1),
402 1 gbuf%SIG,s1, s2, s3,
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,
427 b eyz, eyt, ezt, wyy,
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)
455 IF(jlag+jale+jeul == 0)
THEN
456 iflag=mod(ncycle,ncpri)
460 eint => elbuf_tab(ng)%GBUF%EINS(1:nel)
462 eint => elbuf_tab(ng)%GBUF%EINT(1:nel)
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)
482 1 gbuf%OFF,gbuf%RHO,ms, aire,
483 2 nc1, nc2, nc3, nc4,
487 1 gbuf%OFF,gbuf%RHO,aire, fsky,
488 2 fsky, iadq, nel, nft)
493 IF (jale+jeul > 0 )
THEN
496 1 gbuf%OFF,gbuf%RHO,ms_2d, voln,
497 2 nc1, nc2, nc3, nc4,
501 1 gbuf%OFF,gbuf%RHO,voln, fskym,
510 IF(
ale%GRID%NWALE == 7 .AND. jale == 1)
THEN
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)
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
532 ale%GRID%flow_tracking_data%NUM_ELEM_ALE =
ale%GRID%flow_tracking_data%NUM_ELEM_ALE + num_elem_ale
533#include "lockoff.inc"
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,
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))
550 iflag=mod(ncycle,ncpri)
554 eint => elbuf_tab(ng)%GBUF%EINS(1:nel)
556 eint => elbuf_tab(ng)%GBUF%EINT(1:nel)
559 1 partsav, gbuf%OFF, eint, gbuf%RHO,
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)
573 IF(jale > 0 .AND. mtn /= 11)
THEN
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)
591 1 pm, gbuf%RHO,y1, y2,
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,
601 c mat, qmv, bufmat, ipm)
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,
616 1 r22, r32, r23, r33,
617 2 f11, f21, f12, f22,
618 3 t11, t21, t12, t22,
619 4 t13, t23, t14, t24,
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,
634 2 f22, ax1, ax2, t11,
635 3 t12, t13, t14, t21,
636 4 t22, t23, t24, nc1,
637 5 nc2, nc3, nc4, sti,
641 1 f11, f12, f21, f22,
643 3 t13, t14, t21, t22,
644 4 t23, t24, fsky, fsky,
645 5 iadq, sti, nel, nft)
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)