pro zpick,r0,theta0,sizz,srcfits,destfits,in=src,ihdr=shdr,out=dest,ohdr=dhdr,lerp=lerp sizz = float(sizz) if(n_elements(sizz) eq 2) then begin w = sizz(0) h = sizz(1) end else begin w = sizz(0) h = sizz(0) end r0 = float(r0) theta0 = float(theta0) if((size(srcfits))((size(srcfits))(0)+1) ne 0) then begin src = readfits(srcfits) shdr = headfits(srcfits) endif sx0 = sxpar(shdr,'CRPIX1') sy0 = sxpar(shdr,'CRPIX2') sscal = sxpar(shdr,'CDELT1') * zunits(sxpar(shdr,'CTYPE1'),'solar-radii') srot = sxpar(shdr,'CROT') srefl = (string(sxpar(shdr,'REFLECT')) eq 'T') ; Figure out where the new origin goes dx0 = w/2/sscal dy0 = h/2/sscal - r0/sscal drot = (3600 + theta0) mod 360 dhdr = shdr; sxdelpar,dhdr,'CRPIX1' sxaddpar,dhdr,'CRPIX1',dx0 sxdelpar,dhdr,'CRPIX2' sxaddpar,dhdr,'CRPIX2',dy0 sxdelpar,dhdr,'CROT' sxaddpar,dhdr,'CROT',drot sxdelpar,dhdr,'REFLECT' sxaddpar,dhdr,'REFLECT','F' ;minimum is the value to which undefined points (outside orig. image) are set. if keyword_set(clean_min) then begin print,"Finding minimum value..." minimum = min(src) end else minimum = 0 snx = (size(src))(1) lerpsny = (size(src))(2) nw = long(w/sscal) nh = long(h/sscal) print,'Transferring to ',nw,'x',nh,' array...' sxaddpar,dhdr,'NAXIS1',nw sxaddpar,dhdr,'NAXIS2',nh ; Generate indices to feed to coord... dest = fltarr(nw,nh) dx = lindgen(nw*nh) dy = dx / nw dx(*) = dx(*) mod nw snx = (size(src))(1) sny = (size(src))(2) print,"---Source---" zprfits,shdr print,"---Dest---" zprfits,dhdr sxy = zcoord(dx,dy,dhdr,shdr,/zero,/fug) help,sxy a = src(0,0) src(0,0) = minimum print,'Copying...' if keyword_set(lerp) then $ dest(dx(*),dy(*)) = interpolate(src,sxy(*,0),sxy(*,1))$ else $ dest(dx(*),dy(*)) = src(sxy(*,0),sxy(*,1)) src(0,0) = a sxaddpar,dhdr,'NAXIS1',(size(dest))(1) sxaddpar,dhdr,'NAXIS2',(size(dest))(2) if((size(destfits))((size(destfits))(0)+1) ne 0) then begin print,"Writing ",destfits,"..." ;Write out the transformed fits image writefits,destfits,dest,dhdr endif end