! programme de fit polynomial de donnees bidimensionnelles
! methodes des moindres carres.
! notations :
! f_00 + f_10x + f_01y + f_11xy + f_20 x^2 + ....
!
! Valide par comparaison a sfit d'IDL (le 2/4/2000)
! Attention les coefficients du polynome sont differents de ceux d'idl
! qui considere que f(x,y)=sum_ij Kx_ji x^iy^j ou x et y sont des
! entiers.

	module m_polyfit

contains

	subroutine polyfit(a,x,y,z,coef,n)

	implicit none

	real(kind(0d0)), dimension(:,:), intent(out) :: coef,z
	real(kind(0d0)), dimension(:,:), intent(in) :: a,x,y
	integer, intent(in) :: n

	integer :: k,i,ndeg,ndegx,npoints,ixa,iya,ixj,iyj,j,lw,info,m,nx,ny
	real(kind(0d0)), allocatable :: c(:,:),b(:,:),work(:)
	integer, allocatable :: ipiv(:),ix(:),iy(:)


! taille de la matrice des moindres carres=nb d'exposants
! Methode d'IDL : degres de x vont de 0 a n, idem pour y ==> le 
! polynome a 2 variable b'est pas vraiment de degres n.

	m=(n+1)*(n+1)
	nx=size(a,1); ny=size(a,2)
	allocate(ix(m),iy(m))

	i=1
	do ndeg=0,n
  	 do ndegx=0,n
   	  ix(i)=ndeg
   	  iy(i)=ndegx
   	  i=i+1
  	 enddo
	enddo

!print,'degres de x',ix
!print,'degres de y',iy

! calcul de la matrice des moindres carres

	lw=m**2
	allocate(c(m,m),b(m,1),ipiv(m),work(lw))
	c=0d0; b=0d0; ipiv=0; work=0d0

	do j=1,m
 	 do i=j,m                        ! la matrice est symetrique
  	  ixa=ix(i)+ix(j) ; iya=iy(i)+iy(j)
	  if (ixa == 0 .and. iya==0) c(i,j)=size(x)
	  if (ixa == 0 .and. iya/=0) c(i,j)=sum(y**iya)
	  if (ixa /= 0 .and. iya==0) c(i,j)=sum(x**ixa)
	  if (ixa /= 0 .and. iya/=0) c(i,j)=sum(x**ixa*y**iya) 
          c(j,i)=c(i,j)
 	 enddo
 	 ixj=ix(j) ; iyj=iy(j)
	 if (ixj == 0 .and. iyj==0) b(j,1)=sum(a)
	 if (ixj /= 0 .and. iyj==0) b(j,1)=sum(a*x**ixj)
	 if (ixj == 0 .and. iyj/=0) b(j,1)=sum(a*y**iyj)
	 if (ixj /= 0 .and. iyj/=0) b(j,1)=sum(a*x**ixj*y**iyj)
	enddo
	
! resolution du systeme
!	print*,'ix',ix
!	print*,'iy',iy
!	print*,'test',sum(real(x)**2)
!	print*,'c',c
!	print*,'b',b

	call dsytrf('u',m,c,m,ipiv,work,lw,info)
	if (info /= 0) stop'problem in factorization of lsq matrix'
!	print*,'optimal lw',work(1)
	call dsytrs('u',m,1,c,m,ipiv,b,m,info)
!	coef(1:m)=b(1:m,1)
!	coef=reshape(b, shape=(/ n+1,n+1/) ) 
        do j=1,n+1
         do i=1,n+1
          coef(i,j)=b(i+(n+1)*(j-1),1)
         enddo
        enddo

!ludc,c,index
!coef=lusol(c,index,b)

! calcul du fit

	z=b(1,1)
        do k=1,m
         if (ix(k) == 0 .and. iy(k) /= 0) z=z+b(k,1)*y**iy(k)
         if (ix(k) /= 0 .and. iy(k) == 0) z=z+b(k,1)*x**ix(k)
         if (ix(k) /= 0 .and. iy(k) /= 0) z=z+b(k,1)*x**ix(k)*y**iy(k)
        enddo

	deallocate(ix,iy,ipiv,b,c,work)

	end subroutine

	end module
