70 use element_mod , only : nixs
71
72
73
74#include "implicit_f.inc"
75
76
77
78#include "com04_c.inc"
79
80
81
82 INTEGER IXS(NIXS,*),IPARTS(*),IXS10(6,*),IXS20(12,*),IXS16(8,*),
83 1 TAGBUF(*),IDGRN
84 CHARACTER(LEN=NCHARTITLE) :: TITR
85
86
87
88 INTEGER I,J,L,ITETRA10
89
90 DO j=1,numels8
91 IF (tagbuf(iparts(j)) == 1)THEN
92 DO l=2,9
93 tagbuf(ixs(l,j)+npart)=1
94 ENDDO
95 ENDIF
96 ENDDO
97 DO j=1,numels8
98 IF (tagbuf(iparts(j)) == -1)THEN
99 DO l=2,9
100 tagbuf(ixs(l,j)+npart)=0
101 ENDDO
102 ENDIF
103 ENDDO
104 itetra10=0
105
106 DO i=1,numels10
107 j = i + numels8
108 IF (tagbuf(iparts(j)) == 1)THEN
109 itetra10=itetra10+1
110 DO l=2,9
111 tagbuf(ixs(l,j)+npart)=1
112 ENDDO
113 DO l=1,6
114 IF (ixs10(l,i) /= 0) tagbuf(ixs10(l,i)+npart)=1
115 ENDDO
116 ENDIF
117 ENDDO
118 DO i=1,numels10
119 j = i + numels8
120 IF (tagbuf(iparts(j)) == -1)THEN
121 itetra10=itetra10+1
122 DO l=2,9
123 tagbuf(ixs(l,j)+npart)=0
124 ENDDO
125 DO l=1,6
126 IF (ixs10(l,i) /= 0) tagbuf(ixs10(l,i)+npart)=1
127 ENDDO
128 ENDIF
129 ENDDO
130
131 DO i=1,numels20
132 j = i + numels8 + numels10
133 IF (tagbuf(iparts(j)) == 1)THEN
134 DO l=2,9
135 tagbuf(ixs(l,j)+npart)=1
136 ENDDO
137 DO l=1,12
138 IF (ixs20(l,i) /= 0) tagbuf(ixs20(l,i)+npart)=1
139 ENDDO
140 ENDIF
141 ENDDO
142 DO i=1,numels20
143 j = i + numels8 + numels10
144 IF (tagbuf(iparts(j)) == -1)THEN
145 DO l=2,9
146 tagbuf(ixs(l,j)+npart)=0
147 ENDDO
148 DO l=1,12
149 IF (ixs20(l,i) /= 0) tagbuf(ixs20(l
150 ENDDO
151 ENDIF
152 ENDDO
153
154 DO i=1,numels16
155 j = i + numels8 + numels10 + numels20
156 IF (tagbuf(iparts(j)) == 1)THEN
157 DO l=2,9
158 tagbuf(ixs(l,j)+npart)=1
159 ENDDO
160 DO l=1,8
161 IF (ixs16(l,i) /= 0) tagbuf(ixs16(l,i)+npart)=1
162 ENDDO
163 ENDIF
164 ENDDO
165 DO i=1,numels16
166 j = i + numels8 + numels10 + numels20
167 IF (tagbuf(iparts(j)) == -1)THEN
168 DO l=2,9
169 tagbuf(ixs(l,j)+npart)=0
170 ENDDO
171 DO l=1,8
172 IF (ixs16(l,i) /= 0) tagbuf(ixs16(l,i)+npart)=1
173 ENDDO
174 ENDIF
175 ENDDO
176
177 RETURN
integer, parameter nchartitle