C      SUBROUTINE FISH(M, X, VLAB, RLAB, TITLE, K, DMWORK, WORK, DMIWRK,
C     *                IWORK, OUNIT)
      SUBROUTINE FISH(M, X, K, DMWORK, WORK, DMIWRK, IWORK, LLOUT)
C
C<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
C
C   PURPOSE
C   -------
C
C      CLUSTERS A SEQUENCE OF CASES INTO SUBSEQUENCES BY FISHER'S
C      METHOD OF EXACT OPTIMIZATION
C
C   DESCRIPTION
C   -----------
C
C   1.  THE "EXACT OPTIMIZATION" METHOD OF W.  D.  FISHER MAXIMIZES THE
C       BETWEEN-CLUSTER SUM OF SQUARES.  NOTE THAT THE PARTITION IS
C       GUARANTEED OPTIMAL BUT NOT UNIQUE.
C
C   2.  IF A PARTITION INTO K CLUSTERS IS REQUESTED, OPTIMAL PARTITIONS
C       INTO K-1, K-2, ..., 2, 1 CLUSTERS ARE ALSO FOUND AND INCLUDED
C       IN THE OUTPUT.
C
C   3.  THE OUTPUT IS WRITTEN ON FORTRAN UNIT OUNIT AND CONSISTS OF THE
C       VECTOR OF CASE LABELS AND THE VECTOR OF THE OBSERVATIONS.  THEN
C       THE OPTIMAL PARTITIONS INTO K, K-1, ..., 2, 1 SUBSETS WITH
C       SUMMARY STATISTICS ARE PRINTED.  THEY INCLUDE THE MEAN AND
C       STANDARD DEVIATION OF THE OBSER- VATIONS FOR EACH CLUSTER FOR
C       EACH PARTIION.  THE MEMBERS OF THE FIRST CLUSTER FOR ANY
C       PARTITION BEGIN AT THE TOP OF THE VECTOR OF LABELS AND CONTINUE
C       FOR THE NUMBER IN THE CLUSTER.
C
C   INPUT PARAMETERS
C   ----------------
C  R1MACH(2) = B**EMAX*(1 - B**(-T)), the largest magnitude.
C
C   M     INTEGER SCALAR (UNCHANGED ON OUTPUT).
C         THE NUMBER OF CASES.
C
C   X     REAL VECTOR DIMENSIONED AT LEAST M (UNCHANGED ON OUTPUT)
C         OBSERVED VALUES.
C
C   K     INTEGER SCALAR (UNCHANGED ON OUTPUT).
C         THE NUMBER OF CLUSTER SUBSEQUENCES REQUESTED.
C
C   VLAB  4-CHARACTER VARIABLE (UNCHANGED ON OUTPUT).
C         THE LABEL OF THE VARIABLE.
C
C   RLAB  VECTOR OF 4-CHARACTER VARIABLES DIMENSIONED AT LEAST M.
C            (UNCHANGED ON OUTPUT).
C         THE LABELS OF THE CASES.
C
C   TITLE 10-CHARACTER VARIABLE (UNCHANGED ON OUTPUT).
C         TITLE OF THE DATA SET.
C
C   DMWORK INTEGER SCALAR (UNCHANGED ON OUTPUT).
C         THE LEADING DIMENSION OF THE MATRIX WORK.  MUST BE AT LEAST M.
C
C   WORK  REAL MATRIX WHOSE FIRST DIMENSION MUST BE DMWORK AND SECOND
C            DIMENSION MUST BE AT LEAST K.
C         WORK MATRIX.
C
C   DMIWRK INTEGER SCALAR (UNCHANGED ON OUTPUT).
C         THE LEADING DIMENSION OF THE MATRIX IWORK. MUST BE AT LEAST M.
C
C   IWORK INTEGER MATRIX WHOSE FIRST DIMENSION MUST BE DMIWRK AND SECOND
C            DIMENSION MUST BE AT LEAST K.
C         WORK MATRIX.
C
C   OUNIT INTEGER SCALAR (UNCHANGED ON OUTPUT).
C         UNIT NUMBER FOR OUTPUT.
C
C   REFERENCES
C   ----------
C
C     FISHER, W. D. (1958).  "ON GROUPING FOR MAXIMAL HOMOGENEITY,"
C     JOURNAL OF THE AMERICAN STATISTICAL ASSOCIATION 53, 789-798.
C
C     HARTIGAN, J. A. (1975).  CLUSTERING ALGORITHMS, JOHN WILEY &
C        SONS, INC., NEW YORK.  PAGES 130-142.
C
C<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
C
C      INTEGER DMWORK, DMIWRK, OUNIT
      IMPLICIT LOGICAL(A-Z)
      INTEGER DMWORK, DMIWRK, IWORK
      INTEGER I, J, K, M, II, III, IK, JJ, L, LL, IL, IU
      DOUBLE PRECISION X, WORK, LLOUT
      DIMENSION X(*), WORK(DMWORK,*), IWORK(DMIWRK,*), LLOUT(K,*)
C      CHARACTER*4 VLAB, RLAB(*)
C      CHARACTER*10 TITLE
      DOUBLE PRECISION R1MACH2, SS, S, SN, VAR, AMINL, AMAXL
C
C     INITIALIZE AND OUTPUT DATA
C
      R1MACH2=10.E30
      DO 10 J=1,K
         IWORK(1,J)=1
         WORK(1,J)=0.
         DO 11 I=1,M
            WORK(I,J)=R1MACH2
C   10       WORK(I,J)=R1MACH(2)
   11    CONTINUE
   10 CONTINUE
C      IF (OUNIT .GT. 0) THEN
C         WRITE(OUNIT,1)
C    1    FORMAT('1')
C         CALL OUT(1,M,1,X,VLAB,RLAB,TITLE,OUNIT)
C      ENDIF
C
C     COMPUTE WORK AND IWORK ITERATIVELY
C
      DO 40 I=1,M
         SS=0.
         S=0.
         DO 30 II=1,I
            III=I-II+1
            SS=SS+X(III)**2
            S=S+X(III)
            SN=II
            VAR=SS-S**2/SN
            IK=III-1
            IF (IK.NE.0) THEN
               DO 20 J=2,K
                  IF (WORK(I,J).GE.VAR+WORK(IK,J-1))THEN
                     IWORK(I,J)=III
                     WORK(I,J)=VAR+WORK(IK,J-1)
                  ENDIF
   20          CONTINUE
            ENDIF
   30    CONTINUE
         WORK(I,1)=VAR
         IWORK(I,1)=1
   40 CONTINUE
C
C     PRINT RESULTS
C
C      IF (OUNIT .GT. 0) CALL PFISH(M, X, K, DMWORK, WORK, DMIWRK,
C     *                             IWORK, OUNIT)

C      DO 130 J=1,K
         J=1
         JJ=K-J+1
         IL=M+1
         DO 120 L=1,JJ
            LL=JJ-L+1
            AMINL=R1MACH2
            AMAXL=-R1MACH2
            S=0.
            SS=0.
            IU=IL-1
            IL=IWORK(IU,LL)
            DO 110 II=IL,IU
               IF(X(II).GE.AMAXL) AMAXL=X(II)
               IF(X(II).LE.AMINL) AMINL=X(II)
               S=S+X(II)
               SS=SS+X(II)**2
  110       CONTINUE
            SN=IU-IL+1
            S=S/SN
            SS=SS/SN-S**2
            SS=SQRT(ABS(SS))
            LLOUT(L,1)=AMINL
            LLOUT(L,2)=AMAXL
            LLOUT(L,3)=S
            LLOUT(L,4)=SS
C            WRITE(OUNIT,4) LL,SN,S,SS
C    4       FORMAT(I5,5X,3F10.4)
  120    CONTINUE
C  130 CONTINUE



      RETURN
      END
