89
90
91
92 USE timer_mod
94 USE mat_elem_mod
101 USE sensor_mod
104 USE output_mod
105 USE elbufdef_mod
107 use glob_therm_mod
108 use element_mod , only : nixc,nixtg
109
110
111
112#include "implicit_f.inc"
113#include "comlock.inc"
114
115
116
117#include "mvsiz_p.inc"
118#include "param_c.inc"
119
120
121
122#include "com01_c.inc"
123#include "com04_c.inc"
124#include "com06_c.inc"
125#include "com08_c.inc"
126#include "com_xfem1.inc"
127#include "vect01_c.inc"
128#include "scr06_c.inc"
129#include "scr07_c.inc"
130#include "scr17_c.inc"
131#include "task_c.inc"
132#include "couple_c.inc"
133#include "impl1_c.inc"
134#include "stati_c.inc"
135
136
137
138 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
139 INTEGER,INTENT(IN) :: USERL_AVAIL
140 INTEGER,INTENT(IN) :: MAXFUNC
141 INTEGER,INTENT(IN) :: SBUFMAT
142 INTEGER,INTENT(IN) :: STF
143 INTEGER,INTENT(IN) :: SNPC
144 INTEGER (NIXC,*), IXTG(NIXTG,*), IGEO(NPROPGI,*), IPM(NPROPMI,*),
145 . NPC(*), IPARG(NPARG,*), IPARI(NPARI,*),
146 . NSTRF(*), IPART(LIPART1,*), IPARTC(*), IPARTTG(*),
147 . IADC(4,*), IADTG(3,*),NELTST,
148 . ITYPTST,IXTG1(4,*),XEDGE4N(4,*),XEDGE3N(3,*),
149 . IADTG1(3,*),MADFAIL(*),ITASK,
150 . INOD_PXFEM(*),IEL_PXFEM(*) ,IADC_PXFEM(4,*), IGROUC(*),
151 . NGROUC,GRTH(*),IGRTH(*),KNOD2ELC(*),
152 . INOD_CRK(*),IEL_CRK(*),IADC_CRK(*),ELCUTC(2,*),
153 . NODENR(*),IBORDNODE(*),NODEDGE(2,*),CRKNODIAD(*),
154 . ITAB(*)
155
157 . x(3,*) ,d(3,*) ,v(3,*) ,vr(3,*),
158 . ms(*) ,in(*) ,pm(npropm,*),skew(lskew,*),
159 . geo(npropg,*),bufmat(*) ,tf(stf) ,fsav(nthvki,*) ,
160 . wa(*), thke(*),
161 . a(3,*) ,ar(3,*) ,fani(3,*) ,partsav(npsav,*) ,
162 . stifn(*) ,stifr(*),fsky(*) ,
163 . dr(3,*) ,tani(*),eani(*),
164 . bufgeo(*) ,dt2t, secfcum(7,numnod,nsect),
165 . fsavd(nthvki,*),
166 . fzero(3,4,(numelc+numeltg)),xsec(4,3,nsect),
167 . mcp(*),temp(*),fthe(*),fthesky(*),
168 . ms_ply(*), zi_ply(*),gresav(*),
169 . mstg(*), dmeltg(*), msc(*), dmelc(*),condn(*),condnsky(*),
170 . ptg(3,*),msz2(*),apinch(3,*),stifpinch(*),vpinch(3,*)
171 DOUBLE PRECISION :: XDP(3,*)
172 TYPE (TTABLE) TABLE(*)
173 TYPE (elbuf_struct_), DIMENSION(NGROUP) :: elbuf_tab
174 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL) ::
175 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
176 TYPE (XFEM_SKY_) , DIMENSION(*) :: CRKSKY
177 TYPE (STACK_PLY) :: STACK
178 TYPE (FAILWAVE_STR_) :: FAILWAVE
179 TYPE (NLOCAL_STR_) :: NLOC_DMG
180 TYPE (GROUP_PARAM_) , DIMENSION(NGROUP) :: GROUP_PARAM_TAB
181 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
182 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE),DRAPE_SH3N(NUMELTG_DRAPE)
183 TYPE (DRAPEG_) :: DRAPEG
184 TYPE (SENSORS_) ,INTENT(INOUT) ,TARGET :: SENSORS
185 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
186 TYPE (MAT_ELEM_) ,INTENT(INOUT) ::
187 TYPE (DT_) ,INTENT(IN) :: DT
188 type (glob_therm_) ,intent(inout) :: glob_therm
189
190
191
192 DOUBLE PRECISION, POINTER :: pFBSAV6
193 INTEGER INDXOF(MVSIZ)
194 INTEGER I,II,J,N, NG, NVC, , JFT, JLT,ISOLNOD,ITHK,IPLA,
195 . K2, NF1,IPRI, OFFSET,TYP,
196 . K0, K5, K9, NSG, NEL, KFTS,IOFC, ISTRA,
197 . ICNOD,NFT1,ISENS_ENERGY,
198 .
199 .
200 . IEXPAN, IG,ITG1,ITG2,ITG3,NLEVXF,ISEATBELT
201 INTEGER IPARSENS,ISECT
202 INTEGER ISH3N,ISHPLYXFEM,IXFEM
203 INTEGER IXEL,ACTIFXFEM,ISUBSTACK
205 . fx(mvsiz,20),fy(mvsiz,20),fz(mvsiz,20),
206 . mx(mvsiz,4),my(mvsiz,4),mz(mvsiz,4)
207
209 . uxint_mean(nxel*nxlaymax,mvsiz),uyint_mean(nxel*nxlaymax,mvsiz),
210 . uzint_mean(nxel*nxlaymax,mvsiz)
211
212 itg1 = 1+4*ecrkxfec
213 itg2 = 2*numelc
214 itg3 = 1+numelc
215 ipri = 0
216 IF(mod(ncycle,iabs(ncpri))==0.OR.tt >= output%TH%THIS.OR.
217 + mdess /= 0.OR.tt >= output%TH%THIS1(1).OR.tt >= output%TH%THIS1(2)
218 + .OR.tt >= output%TH%THIS1(3) .OR.tt >= output%TH%THIS1
219 + .OR.tt >= output%TH%THIS1(6) .OR.tt >= output%TH%THIS1(7).OR.tt >= output%TH%THIS1(8)
220 + .OR.tt >= output%TH%THIS1(9) .OR.nth /= 0.OR.nanim/=0
221 + .OR.tt >= tabfis(1).OR.tt >= tabfis(2)
222 + .OR. tt >= tabfis(3).OR.tt >= tabfis(4).OR.tt >= tabfis(5)
223 + .OR. tt >= tabfis(6).OR.tt >= tabfis(7).OR.tt >= tabfis(8)
224 + .OR. tt >= tabfis(9).OR. tt >= tabfis(10).OR. istat==3) ipri=1
225
226 isens_energy = 0
227 DO i=1,sensors%NSENSOR
228 typ = sensors%SENSOR_TAB(i)%TYPE
229 IF (typ == 14) isens_energy = 1
230 ENDDO
231
232
233
234
235 DO ig = 1, ngrouc
236
237 ng = igrouc(ig)
238 sensors%NGR_SENSOR(itask+1) = ng
240 IF (iparg(1, ng) == 151) THEN
241 cycle
242 ENDIF
243
244 ng_imp = ng
245 IF(iparg(8,ng)==1)GOTO 250
246 ity =iparg(5,ng)
247
249 offset = 0
250 mlw = iparg(1,ng)
251
252
253 IF (mlw == 0 .OR. mlw == 13) GOTO 250
254
255 nel = iparg(2,ng)
256 nft = iparg(3,ng)
257 npt = iparg(6,ng)
258 jale = iparg(7,ng)
259 ismstr = iparg(9,ng)
260 nsg = iparg(10,ng)
261 jeul = iparg(11,ng)
262 jtur = iparg(12,ng)
263 jthe = iparg(13,ng)
264 jlag = iparg(14,ng)
265 istra = iparg(44,ng)
266 nvc = iparg(19,ng)
267 jmult = iparg(20,ng)
268 jhbe = iparg(23,ng)
269 ish3n = iparg(23,ng)
270 jivf = iparg(24,ng)
271 jpor = iparg(27,ng)
272 ithk = iparg(28,ng)
273 isolnod = iparg(28,ng)
274 ipla = iparg(29,ng)
275 icnod = iparg(11,ng)
276 irep = iparg(35,ng)
277 iint = iparg(36,ng)
278 jcvt = iparg(37,ng)
279 igtyp = iparg(38,ng)
280 isorth = iparg(42,ng)
281 isorthg = isorth
282 israt = iparg(40,ng)
283 isrot = iparg(41,ng)
284 ifailure= iparg(43,ng)
285 kfts = iparg(30,ng)
286 jclose = iparg(33,ng)
287 icsen = iparg(39,ng)
288 iexpan = iparg(49,ng)
289 ishplyxfem = iparg(50,ng)
290 igre = iparg(51,ng)
291 jsms = iparg(52,ng)
292 ixfem = iparg(54,ng)
293 nlevxf = iparg(65,ng)
294 actifxfem=iparg(70,ng)
295 isubstack=iparg(71,ng)
296 iseatbelt=iparg(91,ng)
297 lft = 1
299 mtn = mlw
300 jft=lft
301 jlt=llt
302 nf1 = nft+1
303 jsph=0
304
305 IF(ity==3)THEN
306 iofc = 0
307
308
309 IF ((nslipring > 0).AND.(iseatbelt==1)) THEN
311 ENDIF
312
313 IF (isens_energy == 1 .AND. ipri == 0)
315 IF (jhbe >= 11.AND.jhbe <= 19) THEN
316
318 1 elbuf_tab(ng), jft, jlt, nft,
319 2 npt, ipari, mlw, ipri,
320 3 ithk, neltst, ityptst, itab,
321 4 mat_elem, istra, ipla, tt,
322 5 dt1, dt2t, pm, geo,
323 6 partsav,
324 7 tf, npc, iadc(1,nf1), x,
325 8 d, dr, v, vr,
326 9 a, ar, stifn, stifr,
327 a fsky, tani, offset, eani,
328 b indxof, ipartc(nf1), thke(nf1), nvc,
329 c iofc, jhbe, fx(1,1), fx(1,2),
330 d fx(1,3), fx(1,4), fy(1,1), fy(1,2),
331 e fy(1,3), fy(1,4), fz(1,1), fz(1,2)
332 f fz(1,3), fz(1,4), mx(1,1), mx(1,2),
333 g mx(1,3), mx(1,4), my(1,1), my(1,2),
334 h my(1,3), my(1,4), mz(1,1), mz(1,2),
335 i mz(1,3), mz(1,4), kfts, ismstr,
336 j igeo, group_param_tab(ng),ipm, ifailure,
337 k itask, jthe, temp, fthe,
338 l fthesky, iexpan, ishplyxfem, ms,
339 m in, ms_ply, zi_ply, inod_pxfem,
340 n iel_pxfem, iadc_pxfem, gresav, grth,
341 o igrth(nf1), msc(nf1), dmelc(nf1), jsms,
342 p table, iparg(1,ng), sensors, msz2,
343 q condn, condnsky, isubstack, stack,
344 r drape_sh4n, nel, nloc_dmg, vpinch,
345 s apinch, stifpinch, drapeg%INDX_SH4N, igre,
346 t jtur, dt, ncycle, snpc,
347 y stf, glob_therm, nxlaymax, idel7nok,
348 u userl_avail, maxfunc, sbufmat ,
349 x ipart , lipart1)
350
351 ELSEIF (jhbe >= 21 .AND. jhbe <= 29) THEN
352
354 1 elbuf_tab(ng), jft, jlt, nft,
355 2 npt, itab, mlw,
356 3 ipri, ithk, neltst, istra,
357 4 ipla, dt1, dt2t,
358 5 pm, geo, partsav, ixc(1,nf1),
359 6 ityptst, bufmat, tf, npc,
360 7 iadc(1,nf1), failwave, x,
361 8 dr, v, vr, a,
362 9 ar, stifn, stifr, fsky,
363 a tani, indxof, ismstr,
364 b group_param_tab(ng),ipartc(nf1), thke(nf1), nvc,
365 c iofc, jhbe, fx(1,1), fx(1,2),
366 d fx(1,3), fx(1,4), fy(1,1), fy(1,2),
367 e fy(1,3), fy(1,4), fz(1,1), fz(1,2),
368 f fz(1,3), fz(1,4), mx(1,1), mx(1,2),
369 g mx(1,3), mx(1,4), my(1,1), my(1,2),
370 h my(1,3), my(1,4), mz(1,1), mz(1,2),
371 i mz(1,3), mz(1,4), kfts, fzero(1,1,nf1),
372 j igeo, ipm, ifailure, itask,
373 k jthe, temp, fthe, fthesky,
374 l iexpan, gresav, grth, igrth(nf1),
375 m xedge4n, msc(nf1), dmelc(nf1), jsms,
376 n table, iparg(1,ng), mat_elem , ixfem,
377 o knod2elc, sensors, elcutc(1,nf1), inod_crk,
378 p iel_crk, nodenr, iadc_crk,
379 q nodedge, crknodiad, condn, condnsky,
380 r stack, isubstack, xfem_tab(ng,1:nxel),crkedge,
381 s drape_sh4n, nel, nloc_dmg, drapeg%INDX_SH4N,
382 t igre, jtur, dt , ncycle,
383 y snpc, stf, glob_therm, idel7nok,
384 u userl_avail, maxfunc,
385 x ipart , lipart1)
386
387 IF (icrack3d > 0 .AND. ixfem > 0 .AND. actifxfem > 0) THEN
388 DO ixel=1,nxel
390 1 jft ,jlt ,nft ,ityptst ,
391 2 ipari ,mlw ,ipri ,ithk ,neltst ,
392 3 istra ,ipla ,tt ,dt1 ,dt2t ,
393 4 pm ,geo ,partsav ,ixc(1,nf1),group_param_tab(ng),
394 5 bufmat ,tf ,npc ,iadc(1,nf1),failwave ,
395 6 x ,d ,dr ,v ,vr ,
396 7 a ,ar ,stifn ,stifr ,fsky ,
397 8 tani ,offset ,eani ,indxof ,
398 9 ipartc(nf1),thke(nf1) ,nvc ,iofc ,jhbe ,
399 a fx(1,1) ,fx(1,2) ,fx(1,3) ,fx(1,4) ,fy(1,1) ,
400 b fy(1,2) ,fy(1,3) ,fy(1,4) ,fz(1,1) ,fz(1,2) ,
401 c fz(1,3) ,fz(1,4) ,mx(1,1) ,mx(1,2) ,mx(1,3) ,
402 d mx(1,4) ,my(1,1) ,my(1,2) ,my(1,3) ,my(1,4) ,
403 e mz(1,1) ,mz(1,2) ,mz(1,3) ,mz(1,4),
404 f kfts ,fzero(1,1,nf1),ismstr,mat_elem ,
405 i igeo ,ipm ,ifailure ,itask ,jthe ,
406 j temp ,fthe ,fthesky ,iexpan ,gresav ,
407 k grth ,igrth(nf1) ,msc(nf1) ,dmelc(nf1),jsms ,
408 l table ,iparg(1,ng),ixfem ,inod_crk ,iel_crk ,
409 m iadc_crk ,elcutc(1,nf1),crksky ,
410 n sensors ,ixel ,
411 o isubstack ,uxint_mean ,uyint_mean,uzint_mean,nlevxf ,
412 p nodedge ,crkedge ,stack ,drape_sh4n ,nloc_dmg,drapeg%INDX_SH4N,igre,
413 * dt ,ncycle ,snpc , stf ,glob_therm ,
414 * idel7nok ,userl_avail,maxfunc ,sbufmat ,
415 x ipart , lipart1)
416 ENDDO
417 ENDIF
418
419 ELSE
421 1 elbuf_tab(ng), jft, jlt, pm,
422 2 ixc(1,nf1), x, a, ar,
423 3 v, vr, failwave, nvc,
424 4 mlw, geo, tf, npc,
425 5 bufmat, partsav, dt2t, neltst,
426 6 ityptst, stifn, stifr, fsky,
427 7 iadc(1,nf1), itab, d, dr,
428 8 tani, offset, eani, fx(1,1),
429 9 fx(1,2), fx(1,3), fx(1,4), fy(1,1),
430 a fy(1,2), fy(1,3), fy(1,4), fz(1,1),
431 b fz(1,2), fz(1,3), fz(1,4), mx(1,1),
432 c mx(1,2), mx(1,3), mx(1,4), my(1,1),
433 d my(1,2), my(1,3), my(1,4), mz(1,1),
434 e mz(1,2), mz(1,3), mz(1,4), indxof,
435 f ipartc(nf1), thke(nf1), group_param_tab(ng),mat_elem,
436 g nel, istra, jhbe, ithk,
437 h iofc, ipla, nft, ismstr,
438 i npt, kfts, fzero(1,1,nf1), igeo,
439 j ipm, ifailure, itask, jthe,
440 k temp, fthe, fthesky, iexpan,
441 l gresav, grth, xedge4n, igrth(nf1),
442 m msc(nf1), dmelc(nf1), jsms, table,
443 n iparg(1,ng), ixfem, knod2elc, sensors ,
444 o elcutc(1,nf1), inod_crk, iel_crk, ibordnode,
445 p nodenr, iadc_crk, nodedge, crknodiad,
446 q condn, condnsky, stack, isubstack,
447 r xfem_tab, ng ,crkedge, drape_sh4n, ipri,
448 s nloc_dmg, drapeg%INDX_SH4N, igre, jtur,
449 t output, dt, snpc, stf ,
450 u glob_therm, userl_avail, maxfunc, sbufmat ,
451 x ipart)
452
453 IF (icrack3d > 0 .AND. ixfem > 0 .AND. actifxfem > 0) THEN
454 DO ixel=1,nxel
456 1 jft ,jlt ,pm ,ixc(1,nf1),x ,
457 2 a ,ar ,v ,vr ,failwave ,
458 3 nvc ,mlw ,geo ,tf ,npc ,
459 4 bufmat ,partsav ,dt2t ,neltst ,ityptst ,
460 5 stifn ,stifr ,fsky ,crksky ,iadc(1,nf1),
461 6 d ,dr ,tani ,offset ,eani ,
462 7 fx(1,1) ,fx(1,2) ,fx(1,3) ,fx(1,4) ,fy(1,1) ,
463 8 fy(1,2) ,fy(1,3) ,fy(1,4) ,fz(1,1) ,fz(1,2) ,
464 9 fz(1,3) ,fz(1,4) ,mx(1,1) ,mx(1,2) ,mx(1,3) ,
465 a mx(1,4) ,my(1,1) ,my(1,2) ,my(1,3) ,my(1,4) ,
466 b mz(1,1) ,mz(1,2) ,mz(1,3) ,mz(1,4) ,indxof ,
467 c ipartc(nf1),thke(nf1),group_param_tab(ng),mat_elem ,
468 f nel ,istra ,jhbe ,kfts ,
469 g ithk ,iofc ,ipla ,nft ,ismstr ,
470 h fzero(1,1,nf1),igeo ,ipm ,ifailure ,itask ,
471 i jthe ,temp , fthe ,fthesky ,iexpan ,
472 j gresav ,grth ,
473 k igrth(nf1) ,msc(nf1) ,dmelc(nf1) ,jsms ,table ,
474 l iparg(1,ng) ,ixfem ,inod_crk ,iel_crk ,iadc_crk ,
475 m elcutc(1,nf1),
476 n sensors,ixel ,stack ,
477 o isubstack ,uxint_mean ,uyint_mean ,uzint_mean,nlevxf ,
478 p nodedge ,crkedge ,drape_sh4n ,ipri ,nloc_dmg ,
479 q drapeg%INDX_SH4N,igre ,dt ,snpc , stf ,
480 r glob_therm ,userl_avail, maxfunc,sbufmat ,
481 x ipart )
482 ENDDO
483 END IF
484
485 ENDIF
486
487 IF(nsect>0)THEN
488 k0=nstrf(25)
489 n=ninter+nrwall+nrbody
490 DO i=1,nsect
491 n=n+1
492 k2=k0+30+nstrf(k0+14)
493 k5=k0+30+nstrf(k0+14)+nstrf(k0+6)
494 . +2*nstrf(k0+7)+2*nstrf(k0+8)
495 iparsens=0
496 isect=0
497 IF (sensors%STABSEN > 0) isect=sensors%TABSENSOR(i+1)-sensors%TABSENSOR(i)
498 NULLIFY(pfbsav6)
499 IF(isect/=0) THEN
500 iparsens=1
501 pfbsav6 => sensors%FSAV(1,1,isect)
502 ENDIF
503
504 CALL section_c(jft,jlt,nft,nstrf(k0+9),nstrf(k0+3),
505 2 nstrf(k0+4),nstrf(k0+5),nstrf(k5),x,v,vr,fsav(1,n),
506 3 ixc ,fani(1,1+2*(i-1)), secfcum(1,1,i) ,
507 4 fx ,fy ,fz ,mx ,my ,mz ,
508 5 nstrf(k0),nstrf(k0+14),nstrf(k0+26),nstrf(k0+6),
509 6 nstrf(k2),ms,
510 8 xsec(1,1,i) ,pfbsav6,iparsens)
511 k0 = nstrf(k0+24)
512 ENDDO
513 ENDIF
514 IF(nexmad/=0.AND.iofc/=0)THEN
515 imadfsh4=1
516 DO j=1,iofc
517 ii=indxof(j)+jft-1+nft
518 madfail(ii)=1
519 ENDDO
520 ENDIF
521
522 ELSEIF(ity==7)THEN
523 iofc = 0
524 IF (isens_energy == 1 .AND. ipri == 0)
526 IF (icnod == 6) THEN
527 nft1 = nf1-numeltg+numeltg6
529 1 elbuf_tab(ng), jft, jlt, pm,
530 2 ixtg(1,nf1), x, a, ar,
531 3 v, vr, failwave, nvc,
532 4 mlw, geo, tf, npc,
533 5 bufmat, partsav, dt2t, neltst,
534 6 ityptst, stifn, stifr, fsky,
535 7 iadtg(1,nf1), group_param_tab(ng), tani(1+6*numelc),offset,
536 8 iparttg(nf1), thke(numelc+nf1), fx(1,1), fx(1,2),
537 9 fx(1,3), fy(1,1), fy(1,2), fy(1,3),
538 a fz(1,1), fz(1,2), fz(1,3), fx(1,4),
539 b fx(1,5), fx(1,6), fy(1,4), fy(1,5),
540 c fy(1,6), fz(1,4), fz(1,5), fz(1,6),
541 d mat_elem, nel, istra, ish3n,
542 e ithk, iofc, ipla, nft,
543 f ismstr, npt, kfts, ixtg1(1,nft1),
544 g iadtg1(1,nft1), igeo, ipm, ifailure,
545 h iexpan, gresav, grth, igrth(numelc+numelt+numelp+numelr+nf1),
546 i mstg(nf1), dmeltg(nf1), jsms, table,
547 j iparg(1,ng), sensors, ptg(1,nf1), jthe,
548 k condn, condnsky, isubstack, stack,
549 l itask, drape_sh3n, ipri, nloc_dmg,
550 m drapeg%INDX_SH3N,igre, jtur, dt ,
551 n ncycle, snpc, stf , glob_therm ,
552 o nxlaymax, idel7nok, userl_avail, maxfunc,
553 p sbufmat ,
554 x ipart , lipart1)
555 ELSE
556
557 IF (ish3n == 30) THEN
559 1 elbuf_tab(ng), jft, jlt, pm,
560 2 ixtg(1,nf1), x, a, ar,
561 3 v, vr, failwave, nvc,
562 4 mlw, geo, tf, npc,
563 5 bufmat, partsav, dt2t, neltst,
564 6 ityptst, stifn, stifr, fsky,
565 7 iadtg(1,nf1), itab, tani(1+6*numelc),iparttg(nf1),
566 8 thke(numelc+nf1), group_param_tab(ng), fx(1,1), fx(1,2),
567 9 fx(1,3), fy(1,1), fy(1,2), fy(1,3),
568 a fz(1,1), fz(1,2), fz(1,3), mx(1,1),
569 b mx(1,2), mx(1,3), my(1,1), my(1,2),
570 c my(1,3), mz(1,1), mz(1,2), mz(1,3),
571 d mat_elem, nel, istra, ish3n,
572 e ithk, iofc, ipla, nft,
573 f ismstr, npt, kfts, igeo,
574 g ipm, ifailure, gresav, grth,
575 h igrth(numelc+numelt+numelp+numelr+nf1),mstg(nf1), dmeltg(nf1), jsms,
576 i table, iparg(1,ng), sensors, ptg(1,nf1),
577 j jthe, condn, condnsky, isubstack,
578 k stack, itask, drape_sh3n, ipri,
579 l nloc_dmg, drapeg%INDX_SH3N, igre,
580 m dt, ncycle, snpc, stf,
581 m glob_therm , nxlaymax, idel7nok, userl_avail,
582 m maxfunc, sbufmat ,
583 x ipart , lipart1)
584
585 ELSE
587 1 elbuf_tab(ng), jft, jlt, pm,
588 2 ixtg(1,nf1), x, a,
589 3 v, vr, failwave,
590 4 mlw, geo, tf, npc,
591 5 bufmat, partsav, dt2t, neltst,
592 6 ityptst, stifn, stifr, fsky,
593 7 iadtg(1,nf1), itab, tani(1+
594 8 iparttg(nf1), thke(numelc+nf1), fx(1,1), fx(1,2),
595 9 fx(1,3), fy(1,1), fy(1,2), fy(1,3),
596 a fz(1,1), fz(1,2), fz(1,3), mx
597 b mx(1,2), mx(1,3), my(1,1), my(1,2
598 c my(1,3), mz(1,1), mz(1,2), mz(
599 d group_param_tab(ng), mat_elem,
600 e ish3n, xedge3n, ithk, iofc,
601 f ipla, nft, ismstr, npt,
602 g kfts, fzero(1,1,nf1+numelc),
603 h ifailure, itask, jthe, temp,
604 i fthe, fthesky, iexpan, gresav,
605 j grth, igrth(numelc+numelt+numelp+numelr+nf1),mstg(nf1), dmeltg
606 k jsms, table, iparg(1,ng), ixfem
607 l sensors, ptg(1,nf1), ibordnode, elcutc(1,nf1+itg3
608 m inod_crk, iel_crk(itg3), nodenr,
609 n nodedge, crknodiad, knod2elc, condn,
610 o condnsky, stack, isubstack, xfem_tab(ng,1:nxel)
611 p crkedge, drape_sh3n, ipri,
612 q xdp, drapeg%INDX_SH3N, igre, jtur
613 r dt, snpc, stf, glob_therm,
614 s idel7nok, userl_avail, maxfunc, sbufmat ,
615 x ipart , lipart1 )
616
617 IF (icrack3d > 0 .AND. ixfem > 0 .AND. actifxfem > 0) THEN
618 DO ixel=1,nxel
620 1 xfem_tab(ng,ixel), jft, jlt, pm,
621 2 ixtg(1,nf1), x, a, ar,
622 3 v, vr, failwave, nvc,
623 4 mlw, geo, tf, npc,
624 5 bufmat, partsav, dt2t,
625 6 ityptst, stifn, stifr, fsky
626 7 crksky, iadtg(1,nf1), tani(1+6*numelc), offset,
627 8 iparttg(nf1), thke(numelc+nf1), fx(1,1), fx(1,2),
628 9 fx(1,3), fy(1,1), fy(1,2), fy(1,3),
629 a fz(1,1), fz(1,2), fz(1,
630 b mx(1,2), mx(1,3), my(1,1), my
631 c my(1,3), mz(1,1), mz(1,2), mz(1,3),
632 d kfts, group_param_tab(ng), mat_elem, nel,
633 e istra, ish3n, ithk, iofc
634 f ipla, nft, ismstr, fzero
635 g igeo, ipm, ifailure, itask,
636 h jthe, temp, fthe, fthesky,
637 i iexpan, gresav, grth, igrth(numelc+numelt+numelp+numelr+nf1),
638 j mstg(nf1), dmeltg(nf1), jsms, table,
639 k iparg(1,ng), sensors, ptg(1,nf1), ixfem,
640 l inod_crk, iel_crk(itg3), iadc_crk(itg1), elcutc(1,nf1+itg3-1),
641 m ixel, stack, isubstack, uxint_mean,
642 n uyint_mean, uzint_mean, nlevxf, nodedge,
643 o crkedge, drape_sh3n, ipri, nloc_dmg,
644 p drapeg%INDX_SH3N, igre, dt , ncycle ,
645 q snpc, stf, glob_therm , idel7nok,
646 a userl_avail, maxfunc, sbufmat ,
647 x ipart , lipart1 )
648 ENDDO
649 ENDIF
650 ENDIF
651 ENDIF
652
653 IF(nsect>0)THEN
654 k0=nstrf(25)
655 n=ninter+nrwall+nrbody
656 DO i=1,nsect
657 n=n+1
658 k2=k0+30+nstrf(k0+14)
659 k9=k0+30+nstrf(k0+14)+nstrf(k0+6)
660 1 +2*nstrf(k0+7)+2*nstrf(k0+8)+2*nstrf(k0+9)
661 2 +2*nstrf(k0+10)+2*nstrf(k0+11)+2*nstrf(k0+12)
662 iparsens=0
663 isect=0
664 IF (sensors%STABSEN > 0) isect=sensors%TABSENSOR(i+1)-sensors%TABSENSOR(i)
665 NULLIFY(pfbsav6)
666 IF(isect/=0) THEN
667 iparsens=1
668 pfbsav6 => sensors%FSAV(1,1,isect)
669 ENDIF
670
671 CALL section_3n(jft,jlt,nft,nstrf(k0+13),nstrf(k0+3),
672 2 nstrf(k0+4),nstrf(k0+5),nstrf(k9),x,v,vr,fsav(1,n),
673 3 ixtg ,fani(1,1+2*(i-1)), secfcum(1,1,i) ,
674 4 fx ,fy ,fz ,mx ,my, mz,
675 5 nstrf(k0),nstrf(k0+14),nstrf(k0+26),nstrf(k0+6),
676 6 nstrf(k2),ms,
677 8 xsec(1,1,i) , pfbsav6,iparsens)
678 k0=nstrf(k0+24)
679 ENDDO
680 ENDIF
681 ENDIF
683
684 250 CONTINUE
685 END DO
686
687
688 RETURN
subroutine c3forc3(timers, elbuf_str, jft, jlt, pm, ixtg, x, f, m, v, r, failwave, nvc, mtn, geo, tf, npf, bufmat, pmsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadtg, itab, epsdot, offset, iparttg, thke, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, group_param, mat_elem, nel, istrain, ish3n, xedge3n, ithk, iofc, ipla, nft, ismstr, npt, kfts, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, igrth, mstg, dmeltg, jsms, table, iparg, ixfem, sensors, ptg, ibordnode, elcutc, inod_crk, iel_crk, nodenr, iadtg_crk, nodedge, crknodiad, knod2elc, condn, condnsky, stack, isubstack, xfem_str, crkedge, drape_sh3n, ipri, nloc_dmg, xdp, indx_drape, igre, jtur, dt, snpc, stf, glob_therm, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)
subroutine c3forc3_crk(timers, xfem_str, jft, jlt, pm, ixtg, x, f, m, v, r, failwave, nvc, mtn, geo, tf, npf, bufmat, pmsav, dt2t, neltst, ityptst, stifn, stifr, fsky, crksky, iadtg, epsdot, offset, iparttg, thke, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, kfts, group_param, mat_elem, nel, istrain, ish3n, ithk, iofc, ipla, nft, ismstr, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, igrth, mstg, dmeltg, jsms, table, iparg, sensors, ptg, ixfem, inod_crk, iel_crk, iadtg_crk, elcutc, ixel, stack, isubstack, uxint_mean, uyint_mean, uzint_mean, nlevxf, nodedge, crkedge, drape_sh3n, ipri, nloc_dmg, indx_drape, igre, dt, ncycle, snpc, stf, glob_therm, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)
subroutine cbaforc3(timers, elbuf_str, jft, jlt, nft, npt, ipari, mtn, ipri, ithk, neltst, ityptst, itab, mat_elem, istrain, ipla, tt, dt1, dt2t, pm, geo, partsav, ixc, failwave, bufmat, tf, npf, iadc, x, d, dr, v, vr, f, m, stifn, stifr, fsky, tani, offset, eani, indxof, ipartc, thke, nvc, iofc, ihbe, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, kfts, ismstr, igeo, group_param, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, ishplyxfem, ms, in, ms_ply, zi_ply, inod_pxfem, iel_pxfem, iadc_pxfem, gresav, grth, igrth, msc, dmelc, jsms, table, iparg, sensors, msz2, condn, condnsky, isubstack, stack, drape_sh4n, nel, nloc_dmg, vpinch, fpinch, stifpinch, indx_drape, igre, jtur, dt, ncycle, snpc, stf, glob_therm, nxlaymax, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)
subroutine cdk6forc3(timers, elbuf_str, jft, jlt, pm, ixtg, x, f, m, v, r, failwave, nvc, mtn, geo, tf, npf, bufmat, pmsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadtg, group_param, epsdot, offset, iparttg, thke, f11, f12, f13, f21, f22, f23, f31, f32, f33, f14, f15, f16, f24, f25, f26, f34, f35, f36, mat_elem, nel, istrain, ihbe, ithk, iofc, ipla, nft, ismstr, npt, kfts, ixtg1, iadtg1, igeo, ipm, ifailure, iexpan, gresav, grth, igrth, mstg, dmeltg, jsms, table, iparg, sensors, ptg, jthe, condn, condnsky, isubstack, stack, itask, drape_sh3n, ipri, nloc_dmg, indx_drape, igre, jtur, dt, ncycle, snpc, stf, glob_therm, nxlaymax, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)
subroutine cdkforc3(timers, elbuf_str, jft, jlt, pm, ixtg, x, f, m, v, r, failwave, nvc, mtn, geo, tf, npf, bufmat, pmsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadtg, itab, epsdot, iparttg, thke, group_param, f11, f12, f13, f21, f22, f23, f31, f32, f33, m11, m12, m13, m21, m22, m23, m31, m32, m33, mat_elem, nel, istrain, ihbe, ithk, iofc, ipla, nft, ismstr, npt, kfts, igeo, ipm, ifailure, gresav, grth, igrth, mstg, dmeltg, jsms, table, iparg, sensors, ptg, jthe, condn, condnsky, isubstack, stack, itask, drape_sh3n, ipri, nloc_dmg, indx_drape, igre, jtur, dt, ncycle, snpc, stf, glob_therm, nxlaymax, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)
subroutine cforc3(timers, elbuf_str, jft, jlt, pm, ixc, x, f, m, v, vr, failwave, nvc, mtn, geo, tf, npf, bufmat, partsav, dt2t, neltst, ityptst, stifn, stifr, fsky, iadc, itab, d, dr, tani, offset, eani, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, indxof, ipartc, thke, group_param, mat_elem, nel, istrain, ihbe, ithk, iofc, ipla, nft, ismstr, npt, kfts, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, xedge4n, igrth, msc, dmelc, jsms, table, iparg, ixfem, knod2elc, sensors, elcutc, inod_crk, iel_crk, ibordnode, nodenr, iadc_crk, nodedge, crknodiad, condn, condnsky, stack, isubstack, xfem_str, ig, crkedge, drape_sh4n, ipri, nloc_dmg, indx_drape, igre, jtur, output, dt, snpc, stf, glob_therm, userl_avail, maxfunc, sbufmat, ipart)
subroutine cforc3_crk(timers, xfem_str, jft, jlt, pm, ixc, x, f, m, v, vr, failwave, nvc, mtn, geo, tf, npf, bufmat, partsav, dt2t, neltst, ityptst, stifn, stifr, fsky, crksky, iadc, d, dr, tani, offset, eani, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, indxof, ipartc, thke, group_param, mat_elem, nel, istrain, ihbe, kfts, ithk, iofc, ipla, nft, ismstr, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, igrth, msc, dmelc, jsms, table, iparg, ixfem, inod_crk, iel_crk, iadc_crk, elcutc, sensors, ixel, stack, isubstack, uxint_mean, uyint_mean, uzint_mean, nlevxf, nodedge, crkedge, drape_sh4n, ipri, nloc_dmg, indx_drape, igre, dt, snpc, stf, glob_therm, userl_avail, maxfunc, sbufmat, ipart)
subroutine czforc3(timers, elbuf_str, jft, jlt, nft, npt, itab, mtn, ipri, ithk, neltst, istrain, ipla, dt1, dt2t, pm, geo, partsav, ixc, ityptst, bufmat, tf, npf, iadc, failwave, x, dr, v, vr, f, m, stifn, stifr, fsky, tani, indxof, ismstr, group_param, ipartc, thke, nvc, iofc, ihbe, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, kfts, fzero, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, igrth, xedge4n, msc, dmelc, jsms, table, iparg, mat_elem, ixfem, knod2elc, sensors, elcutc, inod_crk, iel_crk, nodenr, iadc_crk, nodedge, crknodiad, condn, condnsky, stack, isubstack, xfem_str, crkedge, drape_sh4n, nel, nloc_dmg, indx_drape, igre, jtur, dt, ncycle, snpc, stf, glob_therm, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)
subroutine czforc3_crk(timers, xfem_str, jft, jlt, nft, ityptst, ipari, mtn, ipri, ithk, neltst, istrain, ipla, tt, dt1, dt2t, pm, geo, partsav, ixc, group_param, bufmat, tf, npf, iadc, failwave, x, d, dr, v, vr, f, m, stifn, stifr, fsky, tani, offset, eani, indxof, ipartc, thke, nvc, iofc, ihbe, f11, f12, f13, f14, f21, f22, f23, f24, f31, f32, f33, f34, m11, m12, m13, m14, m21, m22, m23, m24, m31, m32, m33, m34, kfts, fzero, ismstr, mat_elem, igeo, ipm, ifailure, itask, jthe, temp, fthe, fthesky, iexpan, gresav, grth, igrth, msc, dmelc, jsms, table, iparg, ixfem, inod_crk, iel_crk, iadc_crk, elcutc, crksky, sensors, ixel, isubstack, uxint_mean, uyint_mean, uzint_mean, nlevxf, nodedge, crkedge, stack, drape_sh4n, nloc_dmg, indx_drape, igre, dt, ncycle, snpc, stf, glob_therm, idel7nok, userl_avail, maxfunc, sbufmat, ipart, lipart1)
subroutine seatbelt_reduction_factor(elbuf_str, jft, jlt, ixc, nel, x, nft)
subroutine section_3n(lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, vr, fsav, ixtg, fopta, secfcum, fx, fy, fz, mx, my, mz, type, nsint, ifram, nnod, nod, ms, xsec, fbsav6, iparsens)
subroutine section_c(lft, llt, nft, nseg, n1, n2, n3, nstrf, x, v, vr, fsav, ixc, fopta, secfcum, fx, fy, fz, mx, my, mz, type, nsint, ifram, nnod, nod, ms, xsec, fbsav6, iparsens)
subroutine sensor_energy_part(ipart, subset, ipri, sensors, itask)