program main
implicit none
integer nsamp,mdim,mpc
double precision sample(100,100),princomp(100,100),transdata(100,100)
integer i,j,k
sample(1,1)=2.5d0
sample(2,1)=0.5d0
sample(3,1)=2.2d0
sample(4,1)=1.9d0
sample(5,1)=3.1d0
sample(6,1)=2.3d0
sample(7,1)=2.0d0
sample(8,1)=1.0d0
sample(9,1)=1.5d0
sample(10,1)=1.1d0
sample(1,2)=2.4d0
sample(2,2)=0.7d0
sample(3,2)=2.9d0
sample(4,2)=2.2d0
sample(5,2)=3.0d0
sample(6,2)=2.7d0
sample(7,2)=1.6d0
sample(8,2)=1.1d0
sample(9,2)=1.6d0
sample(10,2)=0.9d0
nsamp=10
mdim=2
mpc=2
call princompana(nsamp,mdim,sample,mpc,princomp(1:nsamp,1:mpc),transdata(1:nsamp,1:mdim))
do i=1,mpc
  do j=1,nsamp
    write(*,*)j,princomp(j,1)
  enddo
enddo
do i=1,mdim
  do j=1,nsamp
    write(*,*)j,transdata(j,i)
  enddo
enddo

end

subroutine princompana(nsamp,mdim,sample,mpc,princomp,transdata)
implicit none
!-----------Inputs----------------------------------------
!mpc is the number of principal components to keep
integer nsamp,mdim,mpc
double precision sample(nsamp,mdim)
!-----------Outputs---------------------------------------
!princomp is the projection of a sample on the principal axes
!transdata is the data of the orginal sample filtered with mpc principal components
double precision eigenvalue(mdim),eigenvector(mdim,mdim),sampmean(mdim),princomp(nsamp,mpc),transdata(nsamp,mdim)
!---------------------------------------------------------
integer i,j,k
call geteigen(nsamp,mdim,sample(1:nsamp,1:mdim),eigenvalue,eigenvector(1:mdim,1:mdim),sampmean,sampadj(1:nsamp,1:mdim))
do i=1,mpc
  do j=1,nsamp
    princomp(j,i)=0.0d0
    do k=1,mdim
      princomp(j,i)=princomp(j,i)+eigenvector(k,i)*sampadj(j,k)
    enddo
  enddo
enddo
do j=1,mdim
  do i=1,nsamp
    transdata(i,j)=sampmean(j)
    do k=1,mpc
      transdata(i,j)=transdata(i,j)+eigenvector(j,k)*princomp(i,k)
    enddo
  enddo
enddo
return
end

subroutine geteigen(nsamp,mdim,sample,eigenvalue,eigenvector,sampmean,sampadj)
integer nsamp,mdim
double precision sample(nsamp,mdim),eigenvalue(mdim),eigenvector(mdim,mdim),sampmean(mdim),sampadj(nsamp,mdim)
!Each column is an eigenvector. The first column corresponds to the largest eigenvalue and the last column corresponds
!to the smallest eigenvalue 
call covariancematrix(nsamp,mdim,sample(1:nsamp,1:mdim),covarmatrix(1:mdim,1:mdim),sampmean,sampadj(1:nsamp,1:mdim))
call eigensystem
return
end

subroutine covariancematrix(nsamp,mdim,sample,covarmatrix,sampmean,sampadj)
implicit none
integer nsamp, mdim
double precision sample(nsamp,mdim),covarmatrix(mdim,mdim),sampmean(mdim),sampadj(nsamp,mdim)
integer i,j,k
do j=1,mdim
  sampmean(j)=0.0d0
  do i=1,nsamp
    sampmean(j)=sampmean(j)+sample(i,j)
  enddo
  sampmean(j)=sampmean(j)/dble(nsamp)
  do i=1,nsamp
    sampadj(i,j)=sample(i,j)-sampmean(j)
  enddo
enddo
do i=1,mdim
  do j=i,mdim
    covarmatrix(i,j)=0.0d0
    do k=1,nsamp
      covarmatrix(i,j)=covarmatrix(i,j)+sampadj(k,i)*sampadj(k,j)
    enddo
  enddo
  covarmatrix(i,j)=covarmatrix(i,j)/dble(nsamp-1)
enddo
return
end