` File: MDISC.FT of Tape: Various/ETH/eth11-1`
`(Source file text) `

```C	SAMPLE PROGRAM FOR DISCRIMINANT ANALYSIS - MDISC
C  USES THE FOLLOWING ROUTINES: DMATX,MINV,DISCR
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	NUMBER OF GROUPS, K.
DIMENSION N(4)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	NUMBER OF VARIABLES, M.
DIMENSION CMEAN(6)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF M*K.
DIMENSION XBAR(24)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF (M+1)*K.
DIMENSION C(28)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	PRODUCT OF M*M.
DIMENSION D(36)
C	THE FOLLOWING DIMENSIONS MUST BE GREATER THAN OR EQUAL TO THE
C	TOTAL OF SAMPLE SIZES OF K GROUPS COMBINED, T WHERE
C		T = N(1)+N(2)+...+N(K)
DIMENSION P(30),LG(30)
C	THE FOLLOWING DIMENSION MUST BE GREATER THAN OR EQUAL TO THE
C	TOTAL DATA POINTS WHICH IS EQUAL TO THE PRODUCT OF T*M.
DIMENSION X(180)
C	.....................................................
1	FORMAT(A4,A2,2I2,12I5/(14I5))
2	FORMAT(//' DISCRIMINANT ANALYSIS...'A4,A2/'   NUMBER OF GROUPS'
1 7X,I3/'   NUMBER OF VARIABLES'I7/'   SAMPLE SIZES..'/
2 12X,'GROUP')
3	FORMAT(12X,I3,8X,I4)
4	FORMAT(//2X)
5	FORMAT(12F6.0)
6	FORMAT(/' GROUP',I3,'  MEANS'/(6F13.5))
7	FORMAT(//' POOLED DISPERSION MATRIX')
8	FORMAT(/' ROW',I3/(6F13.5))
9	FORMAT(//' COMMON MEANS'/(6F13.5))
10	FORMAT(//' GENERALIZED MAHALANOBIS D-SQUARE',F15.5/)
11	FORMAT(/' DISCRIMINANT FUNCTION',I3//6X,'CONSTANT   *
1COEFFICIENTS'//F13.5,'  *  '4F13.5/(18X,4F13.5))
12	FORMAT(//' EVALUATION OF CLASSIFICATION FUNCTIONS FOR EACH
1 OBSERVATION')
13	FORMAT(/' GROUP',I3/19X'PROBABILITY ASSOCIATED WITH'11X,
1'LARGEST'/' OBSERVATION'6X'LARGEST DISCRIMINANT FUNCTION'8X
2'FUNCTION NO.')
14	FORMAT(I7,20X,F8.5,20X,I6)
C......................................................
C
C	OUTPUT CHANNEL = IOUT, INPUT CHANNEL = IN
IOUT=2
IN=1
C	PR=PROBLEM NUMBER (MAY BE ALPHAMERIC)
C	PR1=PROBLEM NUMBER CONTINUED
C	K=NUMBER OF GROUPS
C	M=NUMBER OF VARIABLES
C	N=VECTOR OF LENGTH K CONTAINING SAMPLE SIZES
IF(K.EQ.0) STOP
WRITE(IOUT,2) PR,PR1,K,M
DO 110 I=1,K
110	WRITE(IOUT,3) I,N(I)
WRITE(IOUT,4)
L=0
DO 130 I=1,K
N1=N(I)
DO 120 J=1,N1
L=L+1
N2=L-N1
DO 120 IJ=1,M
N2=N2+N1
120	X(N2)=CMEAN(IJ)
130	L=N2
CALL DMATX(K,M,N,X,XBAR,D,CMEAN)
C	PRINT MEANS AND POOLED DISPERSION MATRIX
L=0
DO 150 I=1,K
DO 140 J=1,M
L=L+1
140	CMEAN(J)=XBAR(L)
150	WRITE(IOUT,6) I,(CMEAN(J),J=1,M)
WRITE(IOUT,7)
DO 170 I=1,M
L=I-M
DO 160 J=1,M
L=L+M
160	CMEAN(J)=D(L)
170	WRITE(IOUT,8) I,(CMEAN(J),J=1,M)
CALL MINV(D,M,DET,CMEAN,C)
CALL DISCR(K,M,N,X,XBAR,D,CMEAN,V,C,P,LG)
C	PRINT COMMON MEANS
WRITE(IOUT,9) (CMEAN(I),I=1,M)
C	PRINT GENERALIZED MAHALANOBIS D-SQUARE
WRITE(IOUT,10) V
C	PRINT CONSTANTS AND COEFFICIENTS OF DISCRIMINANT FUNCTIONS
N1=1
N2=M+1
DO 180 I=1,K
WRITE(IOUT,11) I,(C(J),J=N1,N2)
N1=N1+(M+1)
180	N2=N2+(M+1)
C	PRINT EVALUATION OF CLASSIFICATION FUNCTIONS FOR EACH
C	OBSERVATION
WRITE(IOUT,12)
N1=1
N2=N(1)
DO 210 I=1,K
WRITE(IOUT,13) I
L=0
DO 190 J=N1,N2
L=L+1
190	WRITE(IOUT,14) L,P(J),LG(J)
IF(I-K) 200,100,100
200	N1=N1+N(I)
N2=N2+N(I+1)
210	CONTINUE
STOP
END
```