home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / library / ssp / statdscr / dmatx.for < prev   
Text File  |  1985-11-29  |  3KB  |  113 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE DMATX
  5. C
  6. C        PURPOSE
  7. C           COMPUTE MEANS OF VARIABLES IN EACH GROUP AND A POOLED
  8. C           DISPERSION MATRIX FOR ALL THE GROUPS. NORMALLY THIS SUB-
  9. C           ROUTINE IS USED IN THE PERFORMANCE OF DISCRIMINANT ANALYSIS.
  10. C
  11. C        USAGE
  12. C           CALL DMATX (K,M,N,X,XBAR,D,CMEAN)
  13. C
  14. C        DESCRIPTION OF PARAMETERS
  15. C           K     - NUMBER OF GROUPS
  16. C           M     - NUMBER OF VARIABLES (MUST BE THE SAME FOR ALL
  17. C                   GROUPS).
  18. C           N     - INPUT VECTOR OF LENGTH K CONTAINING SAMPLE SIZES OF
  19. C                   GROUPS.
  20. C           X     - INPUT VECTOR CONTAINING DATA IN THE MANNER EQUIVA-
  21. C                   LENT TO A 3-DIMENSIONAL FORTRAN ARRAY, X(1,1,1),
  22. C                   X(2,1,1), X(3,1,1), ETC.  THE FIRST SUBSCRIPT IS
  23. C                   CASE NUMBER, THE SECOND SUBSCRIPT IS VARIABLE NUMBER
  24. C                   AND THE THIRD SUBSCRIPT IS GROUP NUMBER.  THE
  25. C                   LENGTH OF VECTOR X IS EQUAL TO THE TOTAL NUMBER OF
  26. C                   DATA POINTS, T*M, WHERE T = N(1)+N(2)+...+N(K).
  27. C           XBAR  - OUTPUT MATRIX (M X K) CONTAINING MEANS OF VARIABLES
  28. C                   IN K GROUPS.
  29. C           D     - OUTPUT MATRIX (M X M) CONTAINING POOLED DISPERSION.
  30. C           CMEAN - WORKING VECTOR OF LENGTH M.
  31. C
  32. C        REMARKS
  33. C           THE NUMBER OF VARIABLES MUST BE GREATER THAN OR EQUAL TO
  34. C           THE NUMBER OF GROUPS.
  35. C
  36. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  37. C           NONE
  38. C
  39. C        METHOD
  40. C           REFER TO 'BMD COMPUTER PROGRAMS MANUAL', EDITED BY W. J.
  41. C           DIXON, UCLA, 1964, AND T. W. ANDERSON, 'INTRODUCTION TO
  42. C           MULTIVARIATE STATISTICAL ANALYSIS', JOHN WILEY AND SONS,
  43. C           1958, SECTION 6.6-6.8.
  44. C
  45. C     ..................................................................
  46. C
  47.       SUBROUTINE DMATX (K,M,N,X,XBAR,D,CMEAN)
  48.       DIMENSION N(1),X(1),XBAR(1),D(1),CMEAN(1)
  49. C
  50. C        ...............................................................
  51. C
  52. C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE
  53. C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION
  54. C        STATEMENT WHICH FOLLOWS.
  55. C
  56. C     DOUBLE PRECISION XBAR,D,CMEAN
  57. C
  58. C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS
  59. C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS
  60. C        ROUTINE.
  61. C
  62. C        ...............................................................
  63. C
  64. C     INITIALIZATION
  65. C
  66.       MM=M*M
  67.       DO 100 I=1,MM
  68.   100 D(I)=0.0
  69. C
  70. C     CALCULATE MEANS
  71. C
  72.       N4=0
  73.       L=0
  74.       LM=0
  75.       DO 160 NG=1,K
  76.       N1=N(NG)
  77.       FN=N1
  78.       DO 130 J=1,M
  79.       LM=LM+1
  80.       XBAR(LM)=0.0
  81.       DO 120 I=1,N1
  82.       L=L+1
  83.   120 XBAR(LM)=XBAR(LM)+X(L)
  84.   130 XBAR(LM)=XBAR(LM)/FN
  85. C
  86. C     CALCULATE SUMS OF CROSS-PRODUCTS OF DEVIATIONS
  87. C
  88.       LMEAN=LM-M
  89.       DO 150 I=1,N1
  90.       LL=N4+I-N1
  91.       DO 140 J=1,M
  92.       LL=LL+N1
  93.       N2=LMEAN+J
  94.   140 CMEAN(J)=X(LL)-XBAR(N2)
  95.       LL=0
  96.       DO 150 J=1,M
  97.       DO 150 JJ=1,M
  98.       LL=LL+1
  99.   150 D(LL)=D(LL)+CMEAN(J)*CMEAN(JJ)
  100.   160 N4=N4+N1*M
  101. C
  102. C     CALCULATE THE POOLED DISPERSION MATRIX
  103. C
  104.       LL=-K
  105.       DO 170 I=1,K
  106.   170 LL=LL+N(I)
  107.       FN=LL
  108.       DO 180 I=1,MM
  109.   180 D(I)=D(I)/FN
  110. C
  111.       RETURN
  112.       END
  113.