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