Viewing contents of file '../idllib/deutsch/imgroam/createf.pro'
pro createf,imgin,imgout,proc,nozoom
; This procedure handles the extraction of the desired image from the total
; image in the IMGroam environment. It is not useful by itself.
COMMON fparm,NAXIS1,NAXIS2,xsize,ysize,xcent,ycent,xll,yll,zoom,frtyp
COMMON fparm2,xso,yso,xmin,ymin
COMMON ANSI,cr,lf,ESC,up,clrscrn,bell
COMMON IR_ENVIR,stat,itype
if (n_params(0) lt 4) then nozoom=0
print,' [CREATEF] Working....',up
fac=fix(zoom) & key1=strn(fac)
xfac=fix(xso/zoom+.99) & yfac=fix(yso/zoom+.99)
xsize=xfac*fac & ysize=yfac*fac
xmin=xcent-xfac/2
ymin=ycent-yfac/2
xpiece=0 & ypiece=0 & xoff=0 & yoff=0
if (xmin lt 0) and (xsize+xmin gt NAXIS1) then begin
xpiece=1
xoff=-xmin
endif
if (ymin lt 0) and (ysize+ymin gt NAXIS2) then begin
ypiece=1
yoff=-ymin
endif
if (xpiece eq 0) and (ypiece eq 0) then begin
if (fac eq 1) then begin
zimg=extrac(imgin,xmin,ymin,xsize,ysize)
frtyp='STD'
endif else begin
zimg=extrac(imgin,xmin,ymin,xfac,yfac)
frtyp='EXPAND '+strn(fac)
endelse
endif else begin
s=size(imgin) & typofim=s(3)
if (fac eq 1) then begin
zimg=make_array(xsize,ysize,type=typofim)
zimg(xoff:xsize-1,yoff:ysize-1)= $
extrac(imgin,xmin+xoff,ymin+yoff,xsize-xoff,ysize-yoff)
frtyp='STD'
endif else begin
zimg=make_array(xfac,yfac,type=typofim)
zimg(xoff:xfac-1,yoff:yfac-1)= $
extrac(imgin,xmin+xoff,ymin+yoff,xfac-xoff,yfac-yoff)
frtyp='EXPAND '+strn(fac)
endelse
endelse
if (proc eq 1) then begin
tmp=zimg
fpr,tmp,zimg
print,' [CREATEF] Working.... ',up
endif
if (fac eq 1) or (nozoom eq 1) then begin
imgout=zimg
goto,BRK
endif
if (stat.ZTYPE eq 2) and (fac gt 1) then begin
imgout=congrid(zimg,xsize,ysize,/cubic)
imgout=extrac(imgout,-fac/2,-fac/2,xsize,ysize) ; silly kluge
endif
if (stat.ZTYPE eq 1) and (fac gt 1) then imgout=congrid(zimg,xsize,ysize)
if (stat.ZTYPE eq 0) and (fac gt 1) then begin
imgout=rebin(zimg,xsize,ysize)
imgout=extrac(imgout,-fac/2,-fac/2,xsize,ysize) ; silly kluge
endif
BRK:
print,' ',up
return
end