Viewing contents of file '../idllib/astron/contrib/freudenreich/mapfitw.pro'
function mapfitw,map,ndeg,w,xxx,  single=precision
;+
; NAME:
;	MAPFITW
;
; PURPOSE:
;	Fit a 2D surface to a map through call to REGRESS. Each pixel in the map
;	may be given a weight. (If pixels have equal weight, SURFACE_FIT 
;	suffices.)
;
; CALLING SEQUENCE:
;	surface = MAPFITW( map,ndeg,w )
;
; INPUT:
;	map = array to fit, floating-point
; ndeg= degree in X and Y of polynomials to be fitted
;       Maximum degree = 7 (35 terms)
; W   = array of same size and type as map containing the pixel weights.
;
;RETURNS:
; The calculated fitted surface at each pixel: an array like the input array.
;
;KEYWORDS:
; SINGLE  if set, single precision is used. This should be done only if there
;         is not enough memory for the default double-precision calculations.
;
;SUBROUTINES NEEDED:
; REGRESS (in USERLIB)
;
;NOTE:
; This routine merely convert the pixel coordinates into a form REGRESS can 
; digest.
;
;AUTHOR: H.T. Freudenreich, HSTX, 3/16/94
;-

on_error,2

if keyword_set(precision) then singlep=1    else singlep=0

nterms=[1,3,5,9,14,20,27,35]
maxdeg = n_elements(nterms)

if ndeg gt maxdeg then begin
   PRINT,'MAPFITW: Maximum degree = 7!'
   return,map   
endif

; Get the needed dimensions:

syz=size(map)
nx=syz(1)   &   ny=syz(2)
ntot=nx*ny

if ntot lt nterms(ndeg) then begin
   print,'MAPFITW: Too few points!'
   return,0.
endif

z=reform(map,ntot)
wt=reform(w,ntot)

; Obtain (X,Y) coordinates of the pixels, if not already available:
get_coords=1
if n_elements(old_nx) ne 0 then begin
   if (old_nx eq nx) and (old_ny eq ny) then get_coords=0
endif 
old_nx = nx  & old_ny = ny

if n_elements(xxx) eq 0 then get_coords=1 else get_coords=0

if get_coords eq 1 then begin      
   u=findgen(nx)     &  v=findgen(ny)
   xx=fltarr(nx,ny)  &  yy=fltarr(nx,ny)
   for i=0,ny-1 do xx(*,i)=u  &  u=0
   for i=0,nx-1 do yy(i,*)=v  &  v=0
   x=reform(xx,ntot) & xx=0
   y=reform(yy,ntot) & yy=0 

   if (singlep eq 0) then begin
      x=double(x)  &  y=double(y)  
      xxx=dblarr(nterms(ndeg),ntot)
   endif else begin
      xxx=fltarr(nterms(ndeg),ntot)
   endelse

   xxx(0,*)=x     & xxx(1,*)=y

   if ndeg gt 1 then begin
      x2 = x*x       & y2 = y*y
      xxx(2,*)=x2    & xxx(3,*)=y2
      xxx(4,*)=x*y  

      if ndeg gt 2 then begin
         xxx(5,*)=x2*x   & xxx(6,*)=y2*y
         xxx(7,*)=x2*y   & xxx(8,*)=y2*x

         if ndeg gt 3 then begin
            xxx(9,*) =x2*x2    & xxx(10,*)=y2*y2
            xxx(11,*)=x2*x*y   & xxx(12,*)=y2*y*x
            xxx(13,*)=x2*y2
      
            if ndeg gt 4 then begin
               xxx(14,*)=x^5      & xxx(15,*)=y^5
               xxx(16,*)=x2*x2*y  & xxx(17,*)=y2*y2*x
               xxx(18,*)=x^3*y2   & xxx(19,*)=y^3*x2

               if ndeg gt 5 then begin
                  xxx(20,*)=x^6      & xxx(21,*)=y^6
                  xxx(22,*)=x^5*y    & xxx(23,*)=y^5*x
                  xxx(24,*)=x^4*y2   & xxx(25,*)=y^4*x2
                  xxx(26,*)=x^3*y^3  

                  if ndeg gt 6 then begin
                     xxx(27,*)=x^7      & xxx(28,*)=y^7
                     xxx(29,*)=x^6*y    & xxx(30,*)=y^6*x
                     xxx(31,*)=x^5*y2   & xxx(32,*)=y^5*x2
                     xxx(33,*)=x^4*y^3  & xxx(34,*)=y^4*x^3
                  endif
               endif
            endif
         endif
      endif
   endif
endif

if singlep eq 0 then begin 
   wt=double(wt)
   z=double(z)
endif
cc=regress(xxx,z,wt,zfit)

if ndeg gt 1 then zfit=float(zfit)

; Convert back to 2D:
pap=reform(zfit,nx,ny)

return,pap
end