1      SUBROUTINE WCOV(MM, M, N, A, CLAB, RLAB, TITLE, NC, DMCOV, COV,
2     1                COVLAB, COVTIT, WORK)
3C
4C<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
5C
6C   PURPOSE
7C   -------
8C
9C      COMPUTES COVARIANCES WITHIN EACH CLUSTER
10C
11C   DESCRIPTION
12C   -----------
13C
14C   1.  THE ARRAY NC DEFINES THE CLUSTER MEMBERSHIP FOR EACH CASE.  IF
15C       NC(I) = J  THEN CASE I IS IN CLUSTER J.
16C
17C   2.  THE MEAN FOR EACH CLUSTER IS DETERMINED, AND THE CROSS PRODUCTS
18C       BETWEEN EACH VARIABLE WITHIN EACH CLUSTER ARE ACCUMULATED.
19C       FINALLY, THE CROSS PRODUCTS ARE DIVIDED BY THE DEGREES OF
20C       FREEDOM (THE NUMBER OF CASES - THE NUMBER OF CLUSTERS).
21C
22C   3.  THE ROUTINE ASSUMES THERE ARE NO MISSING VALUES.  IF SOME
23C       MISSING VALUES EXIST, CALL CLUSTER SUBROUTINE "TWO" TO REPLACE
24C       THEM BY THE OVERALL MEAN OF THE VARIABLE, OR CALL CLUSTER
25C       ROUTINE "MISS" TO REPLACE THEM BY THE CLUSTER MEAN OF THE
26C       VARIABLE .  SINCE THE LABELS FOR THE WITHIN-GROUP COVARIANCE
27C       MATRIX ARE SYMMETRIC, ONLY ONE VECTOR OF LABELS ARE GENERATED
28C       AND THAT VECTOR CAN BE USED FOR BOTH LABEL ARGUMENTS FOR THE
29C       CLUSTER SUBROUTINE "OUT".  SEE "WCOV" IN THE SAMPLE FILE UNDER
30C       ACCOUNT HARTIGA FOR AN EXAMPLE OF CALLING "OUT" AFTER WCOV.
31C
32C   INPUT PARAMETERS
33C   ----------------
34C
35C   MM    INTEGER SCALAR (UNCHANGED ON OUTPUT).
36C         THE FIRST DIMENSION OF THE MATRIX A.  MUST BE AT LEAST M.
37C
38C   M     INTEGER SCALAR (UNCHANGED ON OUTPUT).
39C         THE NUMBER OF CASES.
40C
41C   N     INTEGER SCALAR (UNCHANGED ON OUTPUT).
42C         THE NUMBER OF VARIABLES.
43C
44C   A     REAL MATRIX WHOSE FIRST DIMENSION MUST BE MM AND WHOSE SECOND
45C            DIMENSION MUST BE AT LEAST N. (UNCHANGED ON OUTPUT).
46C
47C         A(I,J) IS THE VALUE FOR THE J-TH VARIABLE FOR THE I-TH CASE.
48C
49C   CLAB  VECTOR OF 4-CHARACTER VARIABLES DIMENSIONED AT LEAST N.
50C            (UNCHANGED ON OUTPUT).
51C         THE LABELS OF THE VARIABLES.
52C
53C   RLAB  VECTOR OF 4-CHARACTER VARIABLES DIMENSIONED AT LEAST M.
54C            (UNCHANGED ON OUTPUT).
55C         THE LABELS OF THE CASES.
56C
57C   TITLE 10-CHARACTER VARIABLE (UNCHANGED ON OUTPUT).
58C         TITLE OF THE DATA SET.
59C
60C   NC    INTEGER VECTOR DIMENSIONED AT LEAST M (UNCHANGED ON OUTPUT).
61C         NC(I) INDICATES THE CLUSTER NUMBER FOR CASE I.
62C
63C   DMCOV INTEGER SCALAR (UNCHANGED ON OUTPUT).
64C         THE FIRST DIMENSION OF THE COVARIANCE MATRIX.  MUST BE AT
65C            LEAST N.
66C
67C   WORK  REAL VECTOR DIMENSIONED AT LEAST N.
68C         WORK VECTOR.
69C
70C   OUTPUT PARAMETERS
71C   -----------------
72C
73C   COV   REAL MATRIX WHOSE FIRST DIMENSION MUST BE DMCOV AND WHOSE
74C            SECOND DIMENSION MUST BE AT LEAST N.
75C         THE WITHIN-GROUP COVARIANCE MATRIX.
76C
77C   COVLAB VECTOR OF 4-CHARACTER VARIABLES DIMENSIONED AT LEAST N.
78C         THE LABELS OF THE VARIABLES FOR THE WITHIN-GROUP COVARIANCE
79C            MATRIX.
80C
81C   COVTIT 10-CHARACTER VARIABLE.
82C         TITLE OF THE WITHIN-GROUP COVARIANCE MATRIX.
83C
84C   REFERENCE
85C   ---------
86C
87C     HARTIGAN, J. A. (1975).  CLUSTERING ALGORITHMS, JOHN WILEY &
88C        SONS, INC., NEW YORK.  PAGES 69, 70.
89C
90C<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
91C
92      INTEGER DMCOV
93      DIMENSION A(MM,*), COV(DMCOV,*), NC(*), WORK(*)
94      CHARACTER*4 CLAB(*), RLAB(*), COVLAB(*)
95      CHARACTER*10 TITLE, COVTIT
96C
97C     INITIALIZE COVARIANCES AND COUNT TOTAL NUMBER OF CLUSTERS
98C
99      DO 10 I=1,N
100         DO 10 J=1,N
101   10       COV(I,J)=0.
102      K=0
103      DO 20 I=1,M
104   20    IF(NC(I).GT.K) K=NC(I)
105C
106C     COMPUTE MEAN FOR EACH CLUSTER
107C
108      Q=0.
109      DO 90 L=1,K
110         P=0.
111         DO 30 J=1,N
112   30       WORK(J)=0.
113         DO 50 I=1,M
114            IF(NC(I).EQ.L) THEN
115               P=P+1.
116               DO 40 J=1,N
117   40             WORK(J)=WORK(J)+A(I,J)
118            ENDIF
119   50    CONTINUE
120         DO 60 J=1,N
121   60       IF(P.NE.0.) WORK(J)=WORK(J)/P
122         IF(P.GT.0.) Q=Q+P-1.
123C
124C     ADD ON CROSS PRODUCTS
125C
126         DO 80 I=1,M
127            IF(NC(I).EQ.L) THEN
128               DO 70 J=1,N
129                  DO 70 JJ=1,J
130   70             COV(J,JJ)=COV(J,JJ)+(A(I,J)-WORK(J))*(A(I,JJ)
131     *                      -WORK(JJ))
132            ENDIF
133   80    CONTINUE
134   90 CONTINUE
135C
136C     DIVIDE BY DEGREES OF FREEDOM
137C
138      DO 100 J=1,N
139         DO 100 JJ=1,J
140            IF(Q.GT.0.) COV(J,JJ)=COV(J,JJ)/Q
141  100       COV(JJ,J)=COV(J,JJ)
142C
143C     LABEL
144C
145      DO 110 J=1,N
146  110    COVLAB(J)=CLAB(J)
147      COVTIT = 'WITHIN COV'
148      RETURN
149      END
150