33
34
35
36 USE elbufdef_mod
37 use element_mod , only : nixs,nixq,nixc,nixt,nixr,nixp,nixtg
38
39
40
41#include "implicit_f.inc"
42
43
44
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48
49
50
51 INTEGER IXS(NIXS,*),IXQ(NIXQ,*), IXC(NIXC,*),
52 . IXT(NIXT,*), IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*),
53 . IBUF(*), NN, IPARG(NPARG,*)
55 . bufel(*), bufel0(*)
56 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
57
58
59
60 INTEGER I, ITAG(NUMNOD), NG, MLW, ITY, NEL, NFT, NBX, II,
61 . NALL
62
63 DO i=1,lbufel
64 bufel0(i)=bufel(i)
65 ENDDO
66 DO i=1,numnod
67 itag(i)=0
68 ENDDO
69 DO i=1,nn
70 itag(ibuf(i))=1
71 ENDDO
72
73 DO ng=1,ngroup
74 mlw=iparg(1,ng)
75 ity=iparg(5,ng)
76 nel=iparg(2,ng)
77 nft=iparg(3,ng)
78 nbx=iparg(4,ng) -1
79 IF (ity==1) THEN
80 DO i=1,nel
81 ii=i+nft
82 nall = itag(ixs(2,ii)) * itag(ixs(3,ii)) *
83 + itag(ixs(4,ii)) * itag(ixs(5,ii)) *
84 + itag(ixs(6,ii)) * itag(ixs(7,ii)) *
85 + itag(ixs(8,ii)) * itag(ixs(9,ii))
86 IF (nall == 0) elbuf_tab(ng)%GBUF%OFF(i) = zero
87 ENDDO
88 ELSEIF (ity==3) THEN
89 DO i=1,nel
90 ii=i+nft
91 nall = itag(ixc(2,ii)) * itag(ixc(3,ii)) *
92 + itag(ixc(4,ii)) * itag(ixc(5,ii))
93 IF (nall == 0) elbuf_tab(ng)%GBUF%OFF(i) = zero
94 ENDDO
95 ELSEIF (ity==7) THEN
96 DO i=1,nel
97 ii=i+nft
98 nall = itag(ixtg(2,ii)) * itag(ixtg(3,ii)) *
99 + itag(ixtg(4,ii))
100 IF (nall == 0) elbuf_tab(ng)%GBUF%OFF(i) = zero
101 ENDDO
102 ELSEIF (ity==50) THEN
103 DO i=1,nel
104 bufel0(nbx+i)=zero
105 ENDDO
106 ELSEIF (ity==4) THEN
107 DO i=1,nel
108 ii=i+nft
109 nall = itag(ixt(2,ii)) * itag(ixt(3,ii))
110 IF (nall == 0) elbuf_tab(ng)%GBUF%OFF(i) = zero
111
112 ENDDO
113 ELSEIF (ity==5) THEN
114 DO i=1,nel
115 ii=i+nft
116 nall = itag(ixp(2,ii)) * itag(ixp(3,ii))
117 IF (nall == 0) elbuf_tab(ng)%GBUF%OFF(i) = zero
118
119 ENDDO
120 ELSEIF (ity==6) THEN
121 DO i=1,nel
122 ii=i+nft
123 nall = itag(ixr(2,ii)) * itag(ixr(3,ii))
124 IF (nall == 0) elbuf_tab(ng)%GBUF%OFF(i) = zero
125
126 ENDDO
127 ENDIF
128 ENDDO
129
130 RETURN