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