10  COM T[64],Q[64],M2,T1,N4
20  COM N2,N3,G[10],V[64]
30  REM ***** DISCRM  VERSION 1, AUGUST 5, 1971    R.J.M. TAYLOR
40  REM ***** TRANSLATED FROM 'FORTRAN PROGRAMMING FOR THE BEHAVIORAL
50  REM ***** SCIENCES' BY D.J. VELDMAN
60  FILES A,W,C,S
70  REM ENTER FILES STATEMENT HERE
80  DIM X[64],Y[64],Z[64],E[64]
90  M2=10
100  PRINT "NUMBER OF VARIABLES";
110  INPUT N2
120  MAT C=ZER
130  FOR I=1 TO N2
140  READ #1,I*2-1
150  READ #2,I*2-1
160  READ #3,I*2-1
170  READ #4,I*2-1
180  MAT  PRINT #1;C
190  MAT  PRINT #2;C
200  MAT  PRINT #3;C
210  MAT  PRINT #4;C
220  NEXT I
230  PRINT '10'13'10'13"NUMBER OF GROUPS";
240  INPUT N4
250  J1=0
260  FOR M=1 TO N4
270  PRINT '10'13
280  PRINT "NUMBER OF SUBJECTS IN GROUP";M;
290  INPUT N
300  G[M]=N
310  FOR I=1 TO N2
320  READ #4,I*2-1
330  MAT  READ #4;S[M2]
340  S[M]=0
350  READ #4,I*2-1
360  MAT  PRINT #4;S
370  FOR J=I TO N2
380  READ #1,I*2-1
390  MAT  READ #1;A[N2]
400  A[J]=0
410  READ #1,I*2-1
420  MAT  PRINT #1;A
430  NEXT J
440  NEXT I
450  FOR I=1 TO N
460  F5=INT(((J1+I)*2-1)/128)+5
470  I5=(J1+I)-64*(F5-5)
480  READ #F5,I5*2-1
490  MAT  READ #F5;X[N2]
500  FOR J=1 TO N2
510  READ #4,J*2-1
520  MAT  READ #4;S[M2]
530  S[M]=S[M]+X[J]
540  READ #4,J*2-1
550  MAT  PRINT #4;S
560  READ #1,J*2-1
570  MAT  READ #1;A[N2]
580  FOR K=J TO N2
590  A[K]=A[K]+X[J]*X[K]
600  NEXT K
610  READ #1,J*2-1
620  MAT  PRINT #1;A
630  NEXT J
640  NEXT I
650  J1=J1+N
660  G=G[M]
670  REM DO 35 I=1,NV
680  FOR I=1 TO N2
690  READ #3,I*2-1
700  MAT  READ #3;C[N2]
710  READ #1,I*2-1
720  MAT  READ #1;A[N2]
730  READ #2,I*2-1
740  MAT  READ #2;W[N2]
750  FOR J=I TO N2
760  READ #4,I*2-1
770  MAT  READ #4;S[M2]
780  S1=S[M]
790  READ #4,J*2-1
800  MAT  READ #4;S[M2]
810  S2=S[M]
820  C[J]=C[J]+A[J]
830  W[J]=W[J]+(A[J]-S1*S2/G)
840  NEXT J
850  READ #3,I*2-1
860  MAT  PRINT #3;C
870  READ #2,I*2-1
880  MAT  PRINT #2;W
890  NEXT I
900  NEXT M
910  T1=0
920  FOR K1=1 TO N4
930  T1=T1+G[K1]
940  NEXT K1
950  T2=1/T1
960  FOR I=1 TO N2
970  T[I]=0
980  READ #4,I*2-1
990  MAT  READ #4;S[M2]
1000  FOR K1=1 TO N4
1010  T[I]=T[I]+S[K1]
1020  NEXT K1
1030  T[I]=T[I]*T2
1040  READ #3,I*2-1
1050  MAT  READ #3;C[N2]
1060  Q[I]=C[I]
1070  NEXT I
1080  REM COMPUTE COVARIANCE
1090  FOR I=1 TO N2
1100  FOR J=I TO N2
1110  READ #3,I*2-1
1120  MAT  READ #3;C[N2]
1130  C[J]=C[J]*T2-T[I]*T[J]
1140  READ #3,I*2-1
1150  MAT  PRINT #3;C
1160  X1=C[J]
1170  READ #3,J*2-1
1180  MAT  READ #3;C[N2]
1190  C[I]=X1
1200  READ #3,J*2-1
1210  MAT  PRINT #3;C
1220  READ #2,I*2-1
1230  MAT  READ #2;W[N2]
1240  READ #1,I*2-1
1250  MAT  READ #1;A[N2]
1260  A[J]=X1*T1-W[J]
1270  READ #1,I*2-1
1280  MAT  PRINT #1;A
1290  X2=A[J]
1300  READ #1,J*2-1
1310  MAT  READ #1;A[N2]
1320  A[I]=X2
1330  READ #1,J*2-1
1340  MAT  PRINT #1;A
1350  READ #2,I*2-1
1360  MAT  READ #2;W[N2]
1370  X1=W[J]
1380  READ #2,J*2-1
1390  MAT  READ #2;W[N2]
1400  W[I]=X1
1410  READ #2,J*2-1
1420  MAT  PRINT #2;W
1430  NEXT J
1440  NEXT I
1450  F=2
1460  GOSUB 1690
1470  FOR I=1 TO N2
1480  READ #2,I*2-1
1490  MAT  READ #2;W[N2]
1500  FOR J=1 TO N2
1510  X[J]=W[J]
1520  NEXT J
1530  FOR J=1 TO N2
1540  S=0
1550  FOR I1=1 TO N2
1560  READ #1,I1*2-1
1570  MAT  READ #1;A[N2]
1580  S=S+X[I1]*A[J]
1590  NEXT I1
1600  READ #2,I*2-1
1610  MAT  READ #2;W[N2]
1620  W[J]=S
1630  READ #2,I*2-1
1640  MAT  PRINT #2;W
1650  NEXT J
1660  NEXT I
1670  N3=(N4-1) MIN N2
1680  CHAIN "$AEVS"
1690  REM *****MATRIX INVERSION SUBROUTINE
1700  REM *****INVERTS NEARLY SINGULAR MATRICES UP TO 64 X 64
1710  REM *****R.J.M. TAYLOR, UNIVERSITY OF LETHBRIDGE
1720  DIM P[64],W[64]
1730  MAT X=ZER
1740  N=D=1
1750  FOR I=1 TO N2
1760  T=0
1770  FOR J=1 TO N2
1780  IF X[J]=1 THEN 1900
1790  FOR K=1 TO N2
1800  IF X[K]-1<0 THEN 1830
1810  IF X[K]-1=0 THEN 1890
1820  IF X[K]-1>0 THEN 2710
1830  READ #F,J*2-1
1840  MAT  READ #F;W[N2]
1850  IF T >= ABS(W[K]) THEN 1890
1860  I1=J
1870  I2=K
1880  T=ABS(W[K])
1890  NEXT K
1900  NEXT J
1910  D=D*T
1920  P[N]=T
1930  N=N+1
1940  X[I2]=X[I2]+1
1950  IF I1=I2 THEN 2140
1960  FOR L=1 TO N2
1970  READ #F,I1*2-1
1980  MAT  READ #F;W[N2]
1990  T=W[L]
2000  READ #F,I2*2-1
2010  MAT  READ #F;W[N2]
2020  T3=W[L]
2030  READ #F,I1*2-1
2040  MAT  READ #F;W[N2]
2050  W[L]=T3
2060  READ #F,I1*2-1
2070  MAT  PRINT #F;W
2080  READ #F,I2*2-1
2090  MAT  READ #F;W[N2]
2100  W[L]=T
2110  READ #F,I2*2-1
2120  MAT  PRINT #F;W
2130  NEXT L
2140  Y[I]=I1
2150  Z[I]=I2
2160  READ #F,I2*2-1
2170  MAT  READ #F;W[N2]
2180  T=W[I2]
2190  W[I2]=1
2200  READ #F,I2*2-1
2210  MAT  PRINT #F;W
2220  FOR L=1 TO N2
2230  READ #F,I2*2-1
2240  MAT  READ #F;W[N2]
2250  IF T#0 THEN 2280
2260  W[L]=1.70141E+38
2270  GOTO 2290
2280  W[L]=W[L]/T
2290  READ #F,I2*2-1
2300  MAT  PRINT #F;W
2310  NEXT L
2320  FOR M=1 TO N2
2330  IF M=I2 THEN 2530
2340  READ #F,M*2-1
2350  MAT  READ #F;W[N2]
2360  T=W[I2]
2370  W[I2]=0
2380  READ #F,M*2-1
2390  MAT  PRINT #F;W
2400  FOR L=1 TO N2
2410  READ #F,M*2-1
2420  MAT  READ #F;W[N2]
2430  A1=W[L]
2440  READ #F,I2*2-1
2450  MAT  READ #F;W[N2]
2460  A2=W[L]
2470  READ #F,M*2-1
2480  MAT  READ #F;W[N2]
2490  W[L]=A1-A2*T
2500  READ #F,M*2-1
2510  MAT  PRINT #F;W
2520  NEXT L
2530  NEXT M
2540  NEXT I
2550  REM REORDER COLS
2560  FOR I=1 TO N2
2570  J=N2-I+1
2580  IF Y[J]=Z[J] THEN 2700
2590  K=Y[J]
2600  L=Z[J]
2610  FOR M=1 TO N2
2620  READ #F,M*2-1
2630  MAT  READ #F;W[N2]
2640  T=W[K]
2650  W[K]=W[L]
2660  W[L]=T
2670  READ #F,M*2-1
2680  MAT  PRINT #F;W
2690  NEXT M
2700  NEXT I
2710  RETURN 
2720  END 
