       PROGRAM ZSSCHUR

C   K IS THE LENGTH OF THE AP 
C   R IS THE NUMBER OF COLORS:  0,1,2,...,R-1 ARE THE COLORS
   

       IMPLICIT NONE
       INTEGER*4  R,K,MAXLENGTH,MAXSOLNS
       PARAMETER (K=10,R=5,MAXLENGTH=300,MAXSOLNS=10000)
     
       CHARACTER*16 FILENUM      
       INTEGER*4  ADDPOINT,MAXL,I,J,L,S,C,FLGSTOP,PROG
       INTEGER*4  FLG4444,T,MEMBER,USEDCOLOR(R,MAXLENGTH)
       INTEGER*4  COLORING(MAXLENGTH),NUMUSEDCOLOR(MAXLENGTH)
       INTEGER*4  NSOLS,RR(K,MAXSOLNS),NN,SS(K)

       
C FORMAT FOR FILENAME:  KZSSchR, WHERE K=LENGTH, R=NUMBER COLORS

       FILENUM='10ZSSh5'
  
       ADDPOINT=1
       MAXL=0



 1111  NUMUSEDCOLOR(ADDPOINT)=0
         
       

 2222  CALL NEWCOL(COLORING,ADDPOINT,R,MAXLENGTH,USEDCOLOR,
     *NUMUSEDCOLOR,FLG4444,K,MAXSOLNS,NSOLS,FILENUM)
     
       IF (FLG4444.EQ.1) THEN
          GO TO 4444
       END IF



 3333  CALL ACCEPT(COLORING,ADDPOINT,MAXL,
     *MAXLENGTH,FILENUM,R,FLGSTOP)

       IF (FLGSTOP.EQ.1) THEN
         ADDPOINT=2
         NUMUSEDCOLOR(1)=R
         GO TO 4444
       ELSE
         GO TO 1111
       END IF



 4444  ADDPOINT=ADDPOINT-1
       IF (ADDPOINT.EQ.1.AND.NUMUSEDCOLOR(1).EQ.R) THEN
          OPEN(UNIT=10,FILE=FILENUM)
          WRITE(10,*) 'ANSWER IS ZSGS(',K, ',',R,')=' , MAXL+1
       ELSE
          GO TO 2222
       END IF
       STOP
       END



       SUBROUTINE NEWCOL(COLORING,ADDPOINT,R,MAXLENGTH,
     *USEDCOLOR,NUMUSEDCOLOR,FLG4444,K,MAXSOLNS,NSOLS,FILENUM)
       IMPLICIT NONE
       INTEGER*4  ADDPOINT,R,MAXLENGTH,J,D,K
       INTEGER*4  COLORING(MAXLENGTH),NUMUSEDCOLOR(MAXLENGTH)
       INTEGER*4  CL,PROG,UC(R),I,FLG4444
       INTEGER*4  USEDCOLOR(R,MAXLENGTH),N,MEMBER
       INTEGER*4  MAXSOLNS,NSOLS
       CHARACTER*16 FILENUM



  55   N=NUMUSEDCOLOR(ADDPOINT)
       
       IF (N.EQ.R) THEN
         FLG4444=1
         RETURN
       END IF

       IF (N.EQ.0) THEN
          J=0
          GO TO 77
       END IF

       DO I=1,N
          UC(I)=USEDCOLOR(I,ADDPOINT)
       END DO  

       FLG4444=0
       
       J=-1
       DO I=1,R
          IF (MEMBER(I,UC,N).EQ.0) THEN
             J=I
             GO TO 77
          END IF
       END DO
      
  77   IF (J.EQ.-1) THEN
          FLG4444=1
          RETURN
       ELSE
          NUMUSEDCOLOR(ADDPOINT)=N+1
          USEDCOLOR(N+1,ADDPOINT)=J


          CL=J

          IF (ADDPOINT.GE.K-1) THEN
            D=PROG(COLORING,ADDPOINT,CL,K,R,MAXLENGTH,
     *MAXSOLNS,NSOLS,FILENUM)
          ELSE
            D=0
          END IF
       END IF

       IF (D.EQ.1) THEN
          GO TO 55
       ELSE
          COLORING(ADDPOINT)=J
       END IF 
       END



       SUBROUTINE ACCEPT(COLORING,ADDPOINT,MAXL,
     *MAXLENGTH,FILENUM,R,FLGSTOP)
       IMPLICIT NONE
       INTEGER*4 ADDPOINT,MAXL,MAXLENGTH,R,FLGSTOP
       INTEGER*4 COLORING(MAXLENGTH),I
       CHARACTER*8 FILENUM

       FLGSTOP=0

       IF (ADDPOINT.GT.MAXL) THEN
          MAXL=ADDPOINT
          OPEN(UNIT=10,FILE=FILENUM)
          WRITE(10,*) 'MAXL UP TO' , MAXL
          WRITE(10,*) 'A VALID COLORING:',(COLORING(I),I=1,MAXL)
          IF (MAXL.GT.MAXLENGTH) THEN
            WRITE(10,*) 'OUT OF BOUNDS'
            FLGSTOP=1
          END IF
          CALL FLUSH() 
       END IF

       ADDPOINT=ADDPOINT+1
       
       END



       INTEGER*4 FUNCTION MEMBER(ELT,LST,LNGTH)
       IMPLICIT NONE
       INTEGER*4 LNGTH,F,ELT,LST(LNGTH)

       DO F=1,LNGTH
            IF (ELT.EQ.LST(F)) THEN
	      MEMBER=1
	      RETURN
	    END IF
       END DO
       MEMBER=0
       RETURN
       END



       INTEGER*4 FUNCTION PROG(COLORING,ADDPOINT,CL,K,R,
     *MAXLENGTH,MAXSOLNS,NSOLS,FILENUM)
       IMPLICIT NONE
       INTEGER*4 ADDPOINT,MAXLENGTH,CL,MAXSOLNS
       INTEGER*4 COLORING(MAXLENGTH),K,R,NSOLS
       INTEGER*4 TALLY,G,I,SS(K),RR(K,MAXSOLNS),X
       CHARACTER*16 FILENUM

C   RETURNS 0 IF NO ZERO SUM SOLNS TO x1+…x_{k-1}= ADDPOINT
C   COLORING IS THE CURRENT COLORING WITHOUT ADDPOINT
C   CL IS THE PROPOSED COLOR OF ADDPOINT
C   TALLY IS THE FUNCTION THAT BUILDS THE SUM OF COLORS OF AP

       NSOLS=0

       DO I=1,K-1
         SS(I)=0
       END DO
       SS(K)=ADDPOINT

       CALL SOLUTION(ADDPOINT,K-1,SS,RR,NSOLS,K,MAXSOLNS,FILENUM)


       TALLY=CL

       DO G=1,NSOLS
         DO I=1,K-1
           X=RR(I,G)
           TALLY=TALLY + COLORING(X)
         END DO
         IF (MOD(TALLY,R).EQ.0) THEN
           PROG=1
           RETURN
         ELSE
           TALLY=CL
         END IF
       END DO

       PROG=0

       END


       RECURSIVE SUBROUTINE SOLUTION(T,NN,SS,RR,NSOLS,
     *K,MAXSOLNS,FILENUM)
       IMPLICIT NONE
       INTEGER*4  K,T,NN,NSOLS,I,MAXSOLNS,A
       INTEGER*4  SS(K),RR(K,MAXSOLNS)
       CHARACTER*16 FILENUM 


       IF(NSOLS.GT.MAXSOLNS) THEN
         OPEN(UNIT=10,FILE=FILENUM)
         WRITE(10,*) 'TOO MANY SOLUTIONS'
         STOP
       END IF


       IF (T.LE.0) THEN
         RETURN
       END IF

       IF (NN.EQ.1) THEN
         NSOLS=NSOLS+1
         RR(1,NSOLS)=T
         DO I=2,K
           RR(I,NSOLS)=SS(I)
         END DO
         RETURN
       ELSE
         IF (MOD(T,NN).EQ.0) THEN
           A=T/NN
         ELSE
           A=T/NN+1
         END IF

         DO I=A,SS(NN+1)
           SS(NN)=I
           CALL SOLUTION(T-I,NN-1,SS,RR,NSOLS,K,MAXSOLNS,FILENUM)
         END DO
       END IF

       END



