SUBROUTINE COMPIC (IC, C, LENG)

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      IMPLICIT INTEGER (I-N)

      DIMENSION IC(*), C(*)

      NEWLEN = 0

      DO 20 I = 1, LENG 
        IF(IC(I) .NE. -1) THEN
           NEWLEN = NEWLEN + 1
           C(NEWLEN) = C(I)
           IC(NEWLEN) = IC(I)
           IF(I .LT. LENG) THEN
             DO 10 J = (I + 1), LENG
                IF (IC(I).EQ.IC(J)) THEN
                   C(NEWLEN) = C(NEWLEN) + C(J)
                   IC(J) = -1
                ENDIF
   10        CONTINUE
           ENDIF
        ENDIF
   20 CONTINUE

      LENG = NEWLEN

      RETURN
      END