C--------------------------------------------------------------------------
C
C  Program name:  MULTI
C
C  Description:   Computes multivariate sample statistics
C
C  Last revised:  August 1988
C
C--------------------------------------------------------------------------
C
       REAL    XBAR(10),COV(10,10),D(500,10),X,XF(10),COVF(10,10),
     +         MEAN(10),B(10),B1(10),C,Q
       INTEGER P,S,U,IPIVOT(10)
C
      WRITE(*,1)
    1 FORMAT(8(/),25X,'MULTI',
     +2(/),12X,'Multivariate sample statistics')
C
C  Get the multivariate data:
C
      CALL INPUT(P,M,N,D)
C
C  Zero out the covariance matrix:
C
       DO 11 I=1,P
         XF(I)=0.0
         DO 12 J=1,P
           COVF(I,J)=0.0
 12      CONTINUE
 11    CONTINUE
C
C  Write titles for output:
C
       WRITE(*,181)
181    FORMAT(4(/),2X,'SAMPLE #',2X,'SAMPLE MEAN',
     +            10X,'SAMPLE COVARIANCE')
C
C  Compute and print means and sample covariance values:
C
       DO 70 S=1,N
         L=(S-1)*M+1
         U=S*M
C
         DO 10 J=1,P
           X=0.0
           DO 20 I=L,U
             X=X+D(I,J)
 20        CONTINUE
           XBAR(J)=X/FLOAT(M)
           XF(J)=XF(J)+XBAR(J)/FLOAT(N)
 10      CONTINUE
C
         DO 30 I=1,P
           DO 40 J=1,P
             C=0.0
             DO 50 K=L,U
               C=C+(D(K,I)-XBAR(I))*(D(K,J)-XBAR(J))
 50          CONTINUE
             COV(I,J)=C/FLOAT(M-1)
             COVF(I,J)=COVF(I,J)+COV(I,J)/FLOAT(N)
 40        CONTINUE
 30      CONTINUE
         DO 60 I=1,P
           IF (I .EQ. 1) THEN
             WRITE(*,101) S,XBAR(1),(COV(1,K),K=1,P)
101          FORMAT(//,4X,I2,7X,F9.4,2X,10(2X,F9.4))
           ELSE
             WRITE(*,102) XBAR(I),(COV(I,K),K=1,P)
102          FORMAT(/,13X,F9.4,2X,10(2X,F9.4))
           END IF
 60      CONTINUE
         CALL PAUSE
 70    CONTINUE
C
C  If there is only one sample, exit program
C
       IF (N.EQ.1) GOTO 999
C
C  If there are two or more samples, compute and display
C  pooled mean and pooled covariance matrix:
C
       WRITE(*,80)
 80    FORMAT(4(/),2X,'POOLED SAMPLE MEAN',
     +            10X,'POOLED SAMPLE COVARIANCE',/)
C
       DO 90 I=1,P
         WRITE(*,100) XF(I),(COVF(I,K),K=1,P)
100      FORMAT(/,7X,F9.4,5X,10(2X,F9.4))
 90    CONTINUE
C
  999  WRITE(*,81)
   81  FORMAT(////)
C
C  Give user option to save input multivariate data:
C
       CALL SAVE(P,M,N,D)
C
       STOP
       END
C
C
C------------------------------------------------------------------------------
C
      SUBROUTINE INPUT(P,M,N,D)
C
      REAL    D(500,10)
      INTEGER P,M,N,SEL
C
  201 WRITE(*,203)
  203 FORMAT(8(/),1X,'CHOOSE OPTION FOR ENTERING DATA:  ',
     +////,5X,' (1) ENTER DATA FROM KEYBOARD',
     +/,5X,' (2) FETCH STORED DATA FILE ',
     +////,1X,'ENTER NUMBER OF SELECTION:  ',/)
C
      READ(*,*) SEL
      IF (SEL.GE.1.AND.SEL.LE.2) GOTO 207
C
      WRITE(*,205)
  205 FORMAT(//,1X,'INVALID SELECTION.  PLEASE TRY ',
     +'AGAIN')
      GOTO 201
C
  207 GOTO (310,320), SEL
C
  310 CALL KEYBD(P,M,N,D)
      GOTO 330
C
  320 CALL FETCH(P,M,N,D)
C
  330 RETURN
      END
C
C
C------------------------------------------------------------------------------
C
      SUBROUTINE KEYBD(P,M,N,D)
C
      REAL    D(500,10)
      INTEGER P,M,N
C
       WRITE(*,160)
160    FORMAT(//,1X,'ENTER NUMBER OF QUALITY CHARACTERISTICS ',
     +        '(P<=10):',/)
       READ(*,*) P
C
       WRITE(*,170)
170    FORMAT(//,1X,'ENTER NUMBER OF VECTOR OBSERVATIONS ',
     + 'PER SAMPLE (M<=25):',/)
       READ(*,*) M
C
       WRITE(*,180)
180    FORMAT(//,1X,'ENTER NUMBER OF SAMPLES (N<=20):',/)
       READ(*,*) N
C
       MN=M*N
       WRITE(*,190)
190    FORMAT(//,1X,'ENTER DATA: ',
     + /,5X,'ENTER ONE VECTOR OBSERVATION PER ROW,',
     + /,5X,'LEAVE ONE BLANK SPACE BETWEEN NUMBERS, AND',
     + /,5X,'HIT RETURN KEY AFTER EACH ROW OF DATA ENTERED.',/)
       READ(*,*) ((D(I,J),J=1,P),I=1,MN)
C
      RETURN
      END
C
C----------------------------------------------------------------
C
      SUBROUTINE FETCH(P,M,N,DATA)
C
      INTEGER     P,M,N
      REAL        DATA(500,10)
      CHARACTER*8 FILENAME
C
   70 WRITE(*,61)
   61 FORMAT(//,' PLEASE ENTER DATA FILE NAME:  ',/)
      READ(*,63) FILENAME
   63 FORMAT(A8)
      IF (FILENAME.EQ.' ') GO TO 70
      OPEN (1,FILE=FILENAME,STATUS='OLD')
         READ(1,192) P
         READ(1,192) M
         READ(1,192) N
  192    FORMAT(I3)
         MN=M*N
         READ(1,*) ((DATA(I,J),J=1,P),I=1,MN)
         CLOSE(1)
C
      RETURN
      END
C
C
C----------------------------------------------------
C
      SUBROUTINE SAVE(P,M,N,DATA)
C
      REAL        DATA(500,10)
      INTEGER     P,M,N,SEL
      CHARACTER*8 FILENAME
C
  100 WRITE(*,7001)
 7001 FORMAT(8(/),1X,'CHOOSE OPTION:',
     +//,5X,'(1) SAVE INPUT DATA, THEN EXIT PROGRAM',
     +/,5X,'(2) EXIT PROGRAM',
     +///,1X,'ENTER NUMBER OF SELECTION:  ',/)
C
      READ(*,*) SEL
      IF (SEL.GE.1.AND.SEL.LE.2) GOTO 110
C
      WRITE(*,105)
  105 FORMAT(//,1X,'INVALID SELECTION.  PLEASE TRY AGAIN')
      GOTO 100
C
  110 GOTO (130,140),SEL
C
  130 WRITE(*,80)
   80 FORMAT(//,' PLEASE ENTER DATA FILE NAME (UP TO 8 CHARS):  ',/)

      READ(*,81) FILENAME
   81 FORMAT(A8)
      IF (FILENAME.EQ.' ') GO TO 130

      OPEN (1,FILE=FILENAME,STATUS='NEW')
        WRITE(1,92) P
        WRITE(1,92) M
        WRITE(1,92) N
   92   FORMAT(I3)
        MN=M*N
        WRITE(1,*) ((DATA(I,J),J=1,P),I=1,MN)
        CLOSE(1)
C
  140 RETURN
      END
C
C
C----------------------------------------------------
C
      SUBROUTINE PAUSE
C
      CHARACTER*1 GO
C
C  Pause to let user view the display
C
      WRITE(*,70)
   70 FORMAT(/,1X,'STRIKE CARRIAGE RETURN WHEN YOU ',
     +'WISH TO CONTINUE',/)
      READ(*,75) GO
   75 FORMAT(A1)
C
      RETURN
      END
C
C----------------------------------------------------