Viewing contents of file '../idllib/contrib/esrg_ucsb/finterp.pro'
function finterp,tbl,uvar
;+
; FUNCTION       finterp 
;
; USEAGE         result=finterp(table,uvar)
;
; PURPOSE:       Compute the floating point interpolation index of
;                UVAR(i,j,k...) into TABLE(*,i,j,k...) or TABLE(*).
;                For example, if uvar(i,j) is half way between
;                table(4,i,j) and table(5,i,j) then result(i,j)=4.5.
;
;                NOTE: If TABLE is a vector the action of FINTERP is
;                the same as INTERPOL(findgen(n),TABLE,UVAR). However,
;                FINTERP should be much faster whenever UVAR is large
;                and the number of TABLE values (first dimension of
;                TABLE) is small.
;
;
; INPUT    
;
;    table       A matrix or vector.  If TABLE is not a vector, the 
;                first dimension of TABLE is interpreted as a vector
;                of values that correspond to each element of UVAR.
;                If TABLE is a vector, the action of FINTERP is the
;                same as INTERPOL(findgen(n),TABLE,UVAR)
;
;
;    uvar       a matrix of field values.
;
; OUTPUT:
;    result      the floating point interpolation index of  UVAR(i,j,k...)
;                into TABLE(*,i,j,k,...). 
; 
;; EXAMPLE:
;
; a=[[5.1,8.4],[6.7,3.1]]
; tbl=fltarr(5,2,2)
; 
; tbl(*,0,0)=3+findgen(5)
; tbl(*,1,0)=4+findgen(5)
; tbl(*,0,1)=4+findgen(5)*2
; tbl(*,1,1)=findgen(5)
; fi=finterp(tbl,a)
; print,f='(8a9)',' ','UVAR','/---','----','TBL','----','---\','FI' &$
; print,f='(a9,7f9.2)','(0,0):',a(0,0),tbl(*,0,0),fi(0,0) &$
; print,f='(a9,7f9.2)','(1,0):',a(1,0),tbl(*,1,0),fi(1,0) &$
; print,f='(a9,7f9.2)','(0,1):',a(0,1),tbl(*,0,1),fi(0,1) &$
; print,f='(a9,7f9.2)','(1,1):',a(1,1),tbl(*,1,1),fi(1,1) 
;   
; 
;; EXAMPLE:
;                Map surface albedo over some area, given satellite
;                radiance measurement on a 2d grid.  Assumptions:
;
;                 1. ff(m,i,j) = irradiance predictions at each point
;                    in a 2d grid.  The m index is over different
;                    values of surface albedo.  The table values vary
;                    from point-to point (the i and j indecies) due to
;                    changes in satellite and solar viewing angles as
;                    well as surface albedo.
;
;                 2. salb(m) = a vector of different surface albedos
;                    used in the model caculations.  
;
;                 3.  aa(i,j) = actual measured values of radiance
;                     on the same grid. 
;
;                To retrieve the optical surface albedo at each point
;                in the image use INTERPOLATE to compute the surface
;                albedo at each point:
;
;                     salb_map=interpolate(salb,finterp(ff,aa))
;
;                or if logrithmic interpolation is desired
;
;                     fndx=finterp(ff,aa)
;                     salb_map=interpolate(alog(salb_map+1),fndx)
;                     salb_map=exp(salb_map)-1.
;
; PROCEDURE:     uses WHERE to identify regions for interpolation.
;                a separate call to WHERE is used for each table interval.
;                The floating point index may extrapolate beyond the
;                limits of the TABLE. Hence UVAR values less-to or
;                greater-than the corresponding TABLE entries will
;                produce return values which are outside the TABLE
;                subscript range (INTERPOLATE knows how to handle this).
;
; RESTRICTIONS:  Table entries (first index of TABLE) must be monitonically 
;                increasing. If the table is not monitonically increasing
;                FINTERP only finds solutions for that part of the table
;                which is monitonically increasing.  In this case, the return
;                value for UVAR elements less than the relative minimum of
;                TABLE is set to -9999.
;
;  author:  Paul Ricchiazzi                            apr93
;           Institute for Computational Earth System Science
;           University of California, Santa Barbara
;- 

if n_params() eq 0 then begin
  xhelp,'finterp'
  return,0
endif

sz=size(uvar)
ndim=sz(0)

fndx=float(uvar)
fndx(*)=0.

szt=size(tbl)
nv=szt(1)


ndimtab=szt(0)

if ndimtab eq 1 then begin                      ; TBL is a vector

; if UVAR is actually a scalor, use FINDEX and return

  if ndim eq 0 then return, findex(tbl,float(uvar))

  tabmin=min(tbl)
  for i=0,nv-2 do begin
    tabbot=tbl(i)
    tabtop=tbl(i+1)
    ii=where(uvar gt tabbot and uvar le tabtop,nc)
    if nc gt 0 then fndx(ii)=i+float(uvar(ii)-tabbot)/(tabtop-tabbot)
  endfor

  tabbot=tbl(0)
  tabtop=tbl(1)
  ii=where(uvar le tabbot,nc)
  if nc gt 0 then fndx(ii)=float(uvar(ii)-tabbot)/(tabtop-tabbot)

  tabbot=tbl(nv-2)
  tabtop=tbl(nv-1)
  ii=where(uvar gt tabtop,nc)  
  if nc gt 0 then fndx(ii)=nv-2+float(uvar(ii)-tabbot)/(tabtop-tabbot)

  tabbot=tbl(0)
  ii=where(uvar lt tabmin and tabmin lt tabbot,nc)
  if nc gt 0 then fndx(ii)=-9999.

endif else begin                                ; TBL is a matrix

  nnarr=n_elements(uvar)
  nntab=n_elements(tbl)

  if nntab ne nnarr*nv then  message,'TBL size does not mesh with UVAR'
  
  jj=lindgen(nnarr)*nv

  tabmin=tbl(0+jj)                            ; same as tbl(0,*,*,*,...)
  
  for i=0,nv-2 do begin
    tabbot=tbl(i+jj)                          ; same as tbl(i,*,*,*,...)
    tabtop=tbl(i+1+jj)
    ii=where(uvar gt tabbot and uvar le tabtop,nc)
    if nc gt 0 then fndx(ii)=i+float(uvar(ii)-tabbot(ii))/ $
                                      (tabtop(ii)-tabbot(ii))
    tabmin=tabmin < tabbot
  endfor
  tabmin=tabmin < tabtop
  
  tabbot=tbl(0+jj)
  tabtop=tbl(1+jj)
  ii=where(uvar le tabbot,nc)
  if nc gt 0 then fndx(ii)=float(uvar(ii)-tabbot(ii))/(tabtop(ii)-tabbot(ii))
  
  tabbot=tbl(nv-2+jj)
  tabtop=tbl(nv-1+jj)
  ii=where(uvar gt tabtop,nc)  
  if nc gt 0 then fndx(ii)=nv-2+float(uvar(ii)-tabbot(ii))/ $
                                       (tabtop(ii)-tabbot(ii))
  
  tabbot=tbl(0+jj)
  ii=where(uvar lt tabmin and tabmin lt tabbot,nc)
  if nc gt 0 then fndx(ii)=-9999.

endelse

return,fndx

end