35 . P0ARS ,WASZ ,IXS ,GEO ,ELBUF_TAB,
36 . IXR ,IXP ,IXT ,OUTPUT , LIPART1 ,
37 . NPART ,IPART,NUMSPH,IPARTSP )
43 use element_mod ,
only
47#include "implicit_f.inc"
58 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),
59 . IPARG(NPARG,*),IPM(NPROPMI,*)
64 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
65 TYPE(output_),
INTENT(INOUT) :: OUTPUT
66 INTEGER,
INTENT(IN) :: LIPART1
67 INTEGER,
INTENT(IN) :: NPART
68 INTEGER,
INTENT(IN) :: NUMSPH
69 INTEGER,
INTENT(IN) :: IPARTSP(NUMSPH)
70 INTEGER,
INTENT(IN) :: IPART(LIPART1,NPART)
74 INTEGER ITY,NFT,LFT,LLT,NPT,NPTM,ISTRAIN,IHBE,
75 . NUVAR,MLW,NG,NEL,I,NPG,MPT,ISROT,
76 . RWASZ,WASZ2,P0ARSZ2,RWASZ2,ISOLNOD,
77 . nlay,nptr,npts,nptt,igtyp,
78 . nuvarr,nvarf,il,npt_all,iprop,
79 . el_fix,el_var,ismstr,nfail,iprt,mt
80 TYPE(buf_fail_) ,
POINTER :: FBUF
85 IF (stat_c(1) == 1.OR.stat_c(2) == 1.OR.stat_r(1) == 1.OR.
86 . stat_p(1) == 1.OR.stat_p(3) == 1.OR.stat_t(1) == 1.OR.
87 . output%STATE%STAT_SPH(3) == 1 )
THEN
89 wasz = 3*
max(stat_numelc,stat_numeltg,stat_numelr,stat_numelp
90 wasz =
max(wasz,4*output%STATE%STAT_NUMELSPH)
92 rwasz = 3*
max(stat_numelc_g,stat_numeltg_g,stat_numelr_g,stat_numelp_g,stat_numelt_g
93 rwasz=
max(rwasz,4*output%STATE%STAT_NUMELSPH_G)
94 IF (ispmd == 0) p0ars = rwasz
100 IF (stat_c(3) == 1)
THEN
108 IF (ity == 3 .OR. ity == 7)
THEN
111 nptm =
max(1,iabs(npt))
112 nlay = elbuf_tab(ng)%NLAY
113 nptr = elbuf_tab(ng)%NPTR
114 npts = elbuf_tab(ng)%NPTS
117 IF (ity==3 .AND. ihbe==23) npg=4
121 IF (igtyp == 51 .OR. igtyp == 52)
THEN
124 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
126 nptm =
max(1,npt_all)
128 wasz2 = wasz2+(6+nptm*npg)*nel
134 IF (ispmd == 0) p0arsz2 = rwasz2
137 p0ars=
max(p0ars,p0arsz2)+6
138 wasz =
max(wasz,wasz2)
143 IF (stat_c(4) == 1)
THEN
151 IF (ity == 3 .OR. ity == 7)
THEN
156 nlay = elbuf_tab(ng)%NLAY
157 nptr = elbuf_tab(ng)%NPTR
158 npts = elbuf_tab(ng)%NPTS
161 IF (ity==3.AND.ihbe==23) npg=4
165 IF (igtyp == 51 .OR. igtyp == 52)
THEN
168 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
172 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
174 wasz2 = wasz2 + 5*nel
176 wasz2 = wasz2 + (9*npg+7)*nel
178 wasz2 = wasz2 + (6*npg*mpt+7)*nel
185 IF (ispmd == 0) p0arsz2 = rwasz2
188 p0ars=
max(p0ars,p0arsz2)+6
189 wasz =
max(wasz,wasz2)
194 IF (stat_c(10) == 1)
THEN
202 IF (ity == 3 .OR. ity == 7)
THEN
207 nlay = elbuf_tab(ng)%NLAY
208 nptr = elbuf_tab(ng)%NPTR
209 npts = elbuf_tab(ng)%NPTS
218 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
221 IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
223 wasz2 = wasz2 + 5*nel
225 wasz2 = wasz2 + (13*npg+7)*nel
227 wasz2 = wasz2 + (8*npg*mpt+7)*nel
234 IF (ispmd == 0) p0arsz2 = rwasz2
237 p0ars=
max(p0ars,p0arsz2)+6
238 wasz =
max(wasz,wasz2)
243 IF (stat_c(11) == 1)
THEN
250 IF (ity == 3.OR.ity == 7)
THEN
254 nlay = elbuf_tab(ng)%NLAY
257 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
266 wasz2 = wasz2 + (7*npg*mpt+6)*nel
272 IF (ispmd == 0) p0arsz2 = rwasz2
275 p0ars=
max(p0ars,p0arsz2)+6
276 wasz =
max(wasz,wasz2)
281 IF (stat_c(5) == 1)
THEN
288 IF (ity == 3.OR.ity == 7)
THEN
292 IF (mlw == 1.OR.mlw == 3.OR.mlw == 23) mpt=0
298 wasz2 = wasz2 + 5*nel
299 wasz2 = wasz2 + (8*npg+1)*nel
305 IF (ispmd == 0) p0arsz2 = rwasz2
308 p0ars=
max(p0ars,p0arsz2)+6
309 wasz =
max(wasz,wasz2)
313 IF (stat_c(6) == 1)
THEN
322 IF (ity == 3.OR.ity == 7)
THEN
329 istrain= iparg(44,ng)
330 nlay = elbuf_tab(ng)%NLAY
331 nptr = elbuf_tab(ng)%NPTR
332 npts = elbuf_tab(ng)%NPTS
334 IF (mlw == 25.OR.mlw == 27.OR.mlw == 32) istrain=1
339 nuvar =
max(nuvar,ipm(8,ixc(1,i+nft
343 nuvar =
max(nuvar,ipm(8,ixtg(1,i+nft)))
348 ELSEIF (mlw == 87)
THEN
349 nuvar = elbuf_tab(ng)%BUFLY(1)%NVAR_MAT + 12
350 ELSEIF (mlw == 112)
THEN
352 ELSE IF (mlw == 36)
THEN
360 IF (igtyp == 51 .OR. igtyp == 52)
THEN
363 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
369 wasz2 = wasz2 + nel*(6+npg*nptm*nuvar)
375 IF (ispmd == 0) p0arsz2 = rwasz2
378 p0ars=
max(p0ars,p0arsz2)+6
379 wasz =
max(wasz,wasz2)
384 IF (stat_c(7) == 1)
THEN
393 IF (ity == 3.OR.ity == 7)
THEN
400 wasz2 = wasz2 + nel*(9+npt*5)
406 IF (ispmd == 0) p0arsz2 = rwasz2
409 p0ars=
max(p0ars,p0arsz2)+6
410 wasz =
max(wasz,wasz2)
415 IF (stat_c(8) == 1)
THEN
424 IF (ity == 3.OR.ity == 7)
THEN
430 istrain= iparg(44,ng)
432 nptr = elbuf_tab(ng)%NPTR
433 npts = elbuf_tab(ng)%NPTS
435 IF (mlw == 25.OR.mlw == 27.OR.mlw == 32) istrain=1
440 nuvarr =
max(nuvarr,ipm(221,ixc(1,i+nft)) + 1)
444 nuvarr =
max(nuvarr,ipm(221,ixtg(1,i+nft)) + 1)
453 IF (igtyp == 51 .OR. igtyp == 52)
THEN
456 npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
462 wasz2 = wasz2 + nel*(7 + npg*(3+npt *
max(1,nuvarr)* 15))
468 IF (ispmd == 0) p0arsz2 = rwasz2
471 p0ars=
max(p0ars,p0arsz2)+6
472 wasz =
max(wasz,wasz2)
479 IF (stat_s(4)==1 .OR. stat_s(8)==1)
THEN
484 nlay = elbuf_tab(ng)%NLAY
485 nptr = elbuf_tab(ng)%NPTR
486 npts = elbuf_tab(ng)%NPTS
487 nptt = elbuf_tab(ng)%NPTT
488 npt = nlay*nptr*npts*nptt
490 wasz2 = wasz2 + nel * (12 + 9 * npt)
495 IF (ispmd== 0) p0arsz2 = rwasz2
498 p0ars=
max(p0ars,p0arsz2)+8
499 wasz =
max(wasz,wasz2)
505 IF (stat_s(5)==1 .OR. stat_s(9)==1)
THEN
510 nlay = elbuf_tab(ng)%NLAY
511 nptr = elbuf_tab(ng)%NPTR
512 npts = elbuf_tab(ng)%NPTS
513 nptt = elbuf_tab(ng)%NPTT
514 npt = nlay*nptr*npts*nptt
516 wasz2 = wasz2 + nel * (11 + 6 * npt)
521 IF (ispmd==0 ) p0arsz2 = rwasz2
524 p0ars=
max(p0ars,p0arsz2)+6
525 wasz =
max(wasz,wasz2)
532 IF (stat_s(6)==1)
THEN
539 nlay = elbuf_tab(ng)%NLAY
540 nptr = elbuf_tab(ng)%NPTR
541 npts = elbuf_tab(ng)%NPTS
542 nptt = elbuf_tab(ng)%NPTT
543 npt = nlay*nptr*npts*nptt
549 nuvar =
max(nuvar,ipm(8,ixs(1,i+nft)))
552 wasz2 = wasz2 + nel * (11 + npt * nuvar)
557 IF (ispmd==0 ) p0arsz2 = rwasz2
560 p0ars=
max(p0ars,p0arsz2)+6
561 wasz =
max(wasz,wasz2)
568 IF (stat_s(7)==1.OR.stat_s(10)==1)
THEN
573 nlay = elbuf_tab(ng)%NLAY
574 nptr = elbuf_tab(ng)%NPTR
575 npts = elbuf_tab(ng)%NPTS
576 nptt = elbuf_tab(ng)%NPTT
577 npt = nlay*nptr*npts*nptt
579 wasz2 = wasz2 + nel * (11 + nlay * 6)
584 IF (ispmd ==0) p0arsz2 = rwasz2
587 p0ars=
max(p0ars,p0arsz2)+14
588 wasz =
max(wasz,wasz2)
595 IF (stat_s(11)==1)
THEN
599 nfail =
max(nfail,elbuf_tab(ng)%BUFLY(1)%NFAIL)
604 IF (elbuf_tab(ng)%BUFLY(1)%NFAIL > 0)
THEN
605 fbuf => elbuf_tab(ng)%BUFLY(1)%FAIL(1,1,1)
606 nvarf =
max(nvarf,fbuf%FLOC(1)%NVAR)
616 nlay = elbuf_tab(ng)%NLAY
617 nptr = elbuf_tab(ng)%NPTR
618 npts = elbuf_tab(ng)%NPTS
619 nptt = elbuf_tab(ng)%NPTT
620 npt = nlay*nptr*npts*nptt
622 wasz2 = wasz2 + nel * (10 + 5 * (npt * (nvarf+1) + 4) )
627 IF (ispmd==0 ) p0arsz2 = rwasz2
630 p0ars=
max(p0ars,p0arsz2)+6
631 wasz =
max(wasz,wasz2)
638 IF (stat_r(1) == 1)
THEN
646 igtyp = igeo(11,iprop)
651 ELSEIF (igtyp == 12)
THEN
653 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR. igtyp == 25
654 . .OR. igtyp == 23 )
THEN
656 ELSEIF (igtyp == 26)
THEN
658 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
659 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
660 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
666 nuvar = nint(geo(25,iprop))
667 el_var = el_var + nuvar
670 wasz2 = wasz2 + nel * el_var
675 IF (ispmd == 0) p0arsz2 = rwasz2
678 p0ars=
max(p0ars,p0arsz2)+6
679 wasz =
max(wasz,wasz2)
686 IF (stat_p(1) == 1)
THEN
695 igtyp = igeo(11,iprop)
700 ELSEIF (igtyp == 18)
THEN
701 el_var = 4*npt + el_fix
703 el_var = el_var + nuvar
706 wasz2 = wasz2 + nel * el_var
711 IF (ispmd == 0) p0arsz2 = rwasz2
714 p0ars=
max(p0ars,p0arsz2)+6
715 wasz =
max(wasz,wasz2)
722 IF (stat_p(3) == 1)
THEN
735 IF (igtyp == 18 .AND. mlw == 36)
THEN
737 nuvar =
max(nuvar,ipm(8,ixp(1,i+nft)))
741 wasz2 = wasz2 + nel*(6+npt*nuvar)
747 IF (ispmd == 0) p0arsz2 = rwasz2
750 p0ars=
max(p0ars,p0arsz2)+6
751 wasz =
max(wasz,wasz2)
758 IF (stat_t(1) == 1)
THEN
767 wasz2 = wasz2 + nel * el_fix
772 IF (ispmd == 0) p0arsz2 = rwasz2
775 p0ars=
max(p0ars,p0arsz2)+6
776 wasz =
max(wasz,wasz2)
783 IF (stat_s(13)==1)
THEN
792 wasz2 = wasz2 + nel * 7
793 IF (ismstr==1.OR.ismstr>=10)
THEN
794 wasz2 = wasz2 + nel * isolnod*3
795 IF (isolnod==4 .AND. isrot>0) wasz2 = wasz2 + nel * isolnod*10
801 IF (ispmd==0 ) p0arsz2 = rwasz2
804 p0ars=
max(p0ars,p0arsz2)+6
805 wasz =
max (wasz,wasz2)
809 IF (output%STATE%STAT_SPH(3) == 1)
THEN
820 nuvar =
max(nuvar,ipm(8,mt))
822 wasz2 = wasz2+(nuvar+12)*nel
827 IF (ispmd == 0) p0arsz2 = rwasz2
830 p0ars=
max(p0ars,p0arsz2)+6
831 wasz =
max(wasz,wasz2)