C     COMPUTATION OF CAMPBELL CORRELATION-BASED COMPOSITE INDICES
      PARAMETER(N=50,M=5,ITRN=50,NTYPE=2)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION Z(N,M),WT(M)
      DIMENSION X(N,M),V(M,M),AV(M),W(N),XD(M),D(N),VV(M,M),DN(N)
      CHARACTER *40 INFILE,OUTFILE
      DATA B1,B2,LP /2, 1.5,2/
C     READ DATA FROM FILE
      D0=DSQRT(DFLOAT(M))+B1/DSQRT(2.D0)
      B22=B2**2
      write(*,*)'COMPUTES CAMPBELL CORRELATION-BASED COMPOSITE INDICES'
      write(*,*)'------------------------------------------------------'
      WRITE(*,*)'NAME THE INPUT DATA FILE AND OUTPUT FILE'
      READ(*,*) INFILE, OUTFILE
      OPEN(7,FILE=INFILE)
      DO I=1,N
      READ(7,*)IX,(Z(I,J),J=1,M)
      DO J=1,M
      X(I,J)=Z(I,J)
      ENDDO
      ENDDO
      CLOSE(7)
C     STANDARDIZE
      DO J=1,M
      AV(J)=0.D0
      XD(J)=0.D0
      DO I=1,N
      AV(J)=AV(J)+X(I,J)
      XD(J)=XD(J)+X(I,J)**2
      ENDDO
      AV(J)=AV(J)/N
      XD(J)=DSQRT(XD(J)/N-AV(J)**2)
      ENDDO
      DO J=1,M
      DO I=1,N
      X(I,J)=(X(I,J)-AV(J))/XD(J)
      ENDDO
      ENDDO


C     INITIALIZE WEIGHT VECTOR BY UNITY
      DO I=1,N
      W(I)=1.D0
      ENDDO
C     FIND SUM OF WEIGHTS
      DO ITER=1,ITRN

       SW=0.D0
       SSW=0.D0
       DO I=1,N
       SW=SW+W(I)
       SSW=SSW+W(I)**2
       ENDDO
       SSW=SSW-1.D0

C     COMPUTE MEAN VECTOR AND COVARIANCE MATRIX
       DO J=1,M
       AV(J)=0.D0
       DO I=1,N
       AV(J)=AV(J)+X(I,J)*W(I)
       ENDDO
       AV(J)=AV(J)/SW
       ENDDO
       DO J=1,M
       DO JJ=J,M
       V(J,JJ)=0.D0
       DO I=1,N
       V(J,JJ)=V(J,JJ)+(X(I,J)-AV(J))*(X(I,JJ)-AV(JJ))*W(I)**2
       ENDDO
       V(J,JJ)=V(J,JJ)/SSW
       IF(J.NE.JJ) V(JJ,J)=V(J,JJ)
       ENDDO
       ENDDO
       DO J=1,M
       DO JJ=1,M
       VV(J,JJ)=V(J,JJ)
       ENDDO
       ENDDO
C     INVERT V
       CALL MINV(V,M,DD) ! ON RETURN V IS INVERTED V
       DO I=1,N
       D(I)=0.D0
       DO J=1,M
       XD(J)=0.D0
       DO JJ=1,M
       XD(J)=XD(J)+(X(I,JJ)-AV(JJ))*V(JJ,J)
       ENDDO
       ENDDO
       DD=0.D0
       DO J=1,M
       DD=DD+XD(J)*(X(I,J)-AV(J))
       ENDDO
       DD=DSQRT(DD)
       D(I)=DD
       DN(I)=DD
       ENDDO
      IF(NTYPE.EQ.2) THEN
       CALL MEDIAN(DN,N,DNA,DNV)
       DO I=1,N
       DN(I)=DABS(DN(I)-DNA)
       ENDDO
       CALL MEDIAN(DN,N,DNAA,DNVV)
       ENDIF
       DNAA=DNAA/0.6745
       DO I=1,N
       IF(NTYPE.EQ.1) THEN
       IF(D(I).LE.D0)THEN
       WD= D(I)
       ELSE
       WD=D0*DEXP(-0.5D0*(D(I)-D0)**2/B22)
       ENDIF
       W(I)=1.D0
       IF(DABS(D(I)).GT.0.00001) W(I)=WD/D(I)
       ENDIF
       IF(NTYPE.EQ.2) THEN
       W(I)=0.D0
      DX=DABS(D(I)-DNA)
      IF(DX.LE.DNAA) W(I)=1.D0
      IF(DX.LE.2*DNAA.AND.DX.GT.DNAA) W(I)=.25D0
      IF(DX.LE.3*DNAA.AND.DX.GT.2*DNAA) W(I)=0.111111111D0
      IF(DX.LE.4*DNAA.AND.DX.GT.3*DNAA) W(I)=0.0625D0
       ENDIF
       ENDDO
      ENDDO
      DO J=1,M
      DO JJ=1,M
      V(J,JJ)=VV(J,JJ)/DSQRT(VV(J,J)*VV(JJ,JJ))
      ENDDO
      ENDDO
      DO J=1,M
      WRITE(*,1)(V(J,JJ),JJ=1,M)
      ENDDO
    1 FORMAT(8F9.3)
       WRITE(*,*)'-----------------'
C       WRITE(*,1)(AV(J),J=1,M)
C     FIND FIRST WEIGENVALUE AND VECTOR

      ALL=0.D0
      DO J=1,M
      XD(J)=1.D0
      ENDDO
      DO ITER=1,500
      DO J=1,M
      AV(J)=0.D0
      DO JJ=1,M
      AV(J)=AV(J)+V(J,JJ)*XD(JJ)
      ENDDO
      ENDDO
      BL=0.D0
      BLSIG=1.D0
      DO J=1,M
      IF(DABS(AV(J)).GT.BL) THEN
      BL=DABS(AV(J))
      BLSIG=AV(J)/DABS(AV(J))
      ENDIF
      ENDDO
      DO J=1,M
      XD(J)=AV(J)/(BL*BLSIG)
      ENDDO
      WRITE(*,*)'BL=',BL*BLSIG
      WRITE(*,*)(XD(J),J=1,M)
      ENDDO ! ITER LOOP ENDS
      BL=BL*BLSIG
      ALL=0.D0
      DO J=1,M
      ALL=ALL+XD(J)**2
      ENDDO
      AK=DSQRT(ALL/BL) ! THIS IS TO MAKES NORM =LAMBDA
      DO J=1,M
      WT(J)=XD(J)/AK
      ENDDO
      DO I=1,N
      D(I)=0.D0
      DO J=1,M
      D(I)=D(I)+Z(I,J)*WT(J)
      ENDDO
      ENDDO
C     STANDARDIZE
      SMIN=D(1)
      SMAX=D(1)
      DO I=1,N
      IF(D(I).LT.SMIN) SMIN=D(I)
      IF(D(I).GT.SMAX) SMAX=D(I)
      ENDDO
      DO I=1,N
C      D(I)=(D(I)-SMIN)/(SMAX-SMIN)
      ENDDO


      OPEN(7,FILE=OUTFILE)
      write(7,*)'COMPUTES CAMPBELL CORRELATION-BASED COMPOSITE INDICES'
      write(7,*)'------------------------------------------------------'
      DO I=1,N
      WRITE(7,3)(Z(I,J),J=1,M),D(I)/BL
      ENDDO
    3 FORMAT(7F11.5)
      WRITE(7,*)'THE 1ST M COLUMNS ARE VARIABLES; THE LAST ONE IS INDEX'
      WRITE(*,*)'THE 1ST M COLUMNS ARE VARIABLES; THE LAST ONE IS INDEX'
      WRITE(*,*)'EIGENVALUE=',BL
      WRITE(7,*)'EIGENVALUE=',BL
      WRITE(7,*)'WEIGHTS (CORRELATIONS) ARE AS FOLLOWS'
      WRITE(*,*)'WEIGHTS (CORRELATIONS) ARE AS FOLLOWS'
      WRITE(7,3)(WT(J),J=1,M)
      WRITE(*,3)(WT(J),J=1,M)
      CLOSE(7)
      WRITE(*,*)'END'
      END
C     SUBROUTINE FOR MATRIX INVERSION
      SUBROUTINE MINV(A,N,D)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION A(N,N)
      U=1.D0
      D=U
      DO I=1,N
      D=D*A(I,I)
      A(I,I)=U/A(I,I)
         DO J=1,N
         IF(I.NE.J) A(J,I)=A(J,I)*A(I,I)
         ENDDO
         DO J=1,N
         DO K=1,N
         IF(I.NE.J.AND.K.NE.I) A(J,K)=A(J,K)-A(J,I)*A(I,K)
         ENDDO
         ENDDO
         DO J=1,N
         IF(J.NE.I) A(I,J)= -A(I,J)*A(I,I)
         ENDDO
      ENDDO
      RETURN
      END
C     -----------------------------------------------------------------
      SUBROUTINE MEDIAN(X,N,A,V) ! ------------------------------------
C     SUBROUTINE MEDIAN : FINDS MEDIAN (A) AND MEAN DEVIATION (V) OF A
C     GIVEN VARIATE, VARIATE X(N)
      PARAMETER (NMAX=1000)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION X(N),Z(NMAX)
C     STORE X IN Z
      DO I=1,N
      Z(I)=X(I)
      ENDDO
C     ARRANGE Z IN AN ASCENDING ORDER
      DO I=1,N-1
      DO J=I+1,N
      IF(Z(I).GT.Z(J)) THEN ! EXCHANGE
      TEMP=Z(I)
      Z(I)=Z(J)
      Z(J)=TEMP
      ENDIF
      ENDDO
      ENDDO
      K=(N+1)/2 ! K IS OBTAINED AS INT((N+1)/2.0D0)
      A=(Z(K)+Z(N+1-K))/2.D0 ! GIVES MEDIAN FOR ODD AS WELL AS EVEN N
C     FIND MEAN DEVIATION
      V=0.D0
      DO I=1,N
      V=V+DABS(Z(I)-A) ! A IS MEDIAN
      ENDDO
      V=V/N ! V IS MEAN DEVIATION FROM MEDIAN
C     WRITE(*,*)'MEDIAN =',A,'  MEAN DEVIATION =',V
      RETURN
      END