Viewing contents of file '../idllib/contrib/meron/extend_array.pro'
Function extend_array, arr, off, newsize = nsiz, value = val, edge_extend = ext
;+
; NAME:
; EXTEND_ARRAY
; VERSION:
; 3.0
; PURPOSE:
; Extends an array to a larger size, filling the blanks according to
; keyword specifications.
; CATEGORY:
; Array function.
; CALLING SEQUENCE:
; Result = EXTEND_ARRAY( ARR, [, OFF] [,keywords]])
; INPUTS:
; ARR
; Array, arbitrary.
; OFF
; Vector containing the offset of ARR into the result array. Defaults
; to zero(s). If the number of entries is smaller then the dimension
; (either of ARR or of the result) missing entries are replaced with 0,
; from left. Thus if the result has dimensions of (4,5,6) but offset
; is given as [2,2], an offset of [0,2,2] is used.
; OPTIONAL INPUT PARAMETERS:
; None.
; KEYWORD PARAMETERS:
; NEWSIZE
; A vector, containing the parameters of the result array, in the format
; of the output of the IDL SIZE function. If not given, the size used is
; the minimal size capable of containing the original array with the
; specified offset.
; VALUE
; A scalar value used to fill the blanks in the result array. Defaults
; to 0. Warning: VALUE and EDGE_EXTEND cannot be specified at the same
; time
; /EDGE_EXTEND
; Switch. If set, the blanks in the result array are filled with the
; adjoining edge values of ARR. Warning: EDGE_EXTEND and VALUE cannot
; be specified at the same time
; OUTPUTS:
; Returns an array of size specified either by NEWSIZE or combination of
; the original size and offset. The original arry is imbedded in the
; result, and the blanks are filled according to the keywords VALUE or
; EDGE_EXTEND.
; OPTIONAL OUTPUT PARAMETERS:
; None.
; COMMON BLOCKS:
; None.
; SIDE EFFECTS:
; None.
; RESTRICTIONS:
; The new size, as provided by NEWSIZE, must be large enough to contain
; the original array with the offset.
; PROCEDURE:
; Straightforward. Calls DEFAULT and ONE_OF from MIDL.
; MODIFICATION HISTORY:
; Created 20-JAN-1997 by Mati Meron.
;-
on_error, 1
ndm = 7
siz = size([arr])
nda = siz(0)
if nda lt ndm then sir = [ndm,replicate(1l,ndm-nda),siz(1:*)] else sir = siz
nof = n_elements(off)
if nof eq 0 then l = replicate(0l,ndm) else $
if nof lt ndm then l = [replicate(0l,ndm-nof),off] else $
if nof eq ndm then l = off else message, 'Offset dimension error!'
h = l + sir(1:ndm) - 1
nds = nda > nof
if n_elements(nsiz) gt 0 then begin
nds = nsiz(0)
if nds ge nda then begin
sir(ndm-nds+1:ndm) = nsiz(1:nds)
sir(ndm + 1) = sir(ndm+1) > nsiz(nds+1)
endif else message, 'Insufficient number of result dimensions!'
dum = where((sir(1:ndm) - h) lt 1, ndum)
if ndum gt 0 then message, 'Insufficient new size!'
endif else sir(1:ndm) = h + 1
s = sir(1:ndm) - h - 1
prod = 1l
for i = 1, ndm do prod = prod*sir(i)
sir(ndm + 2) = prod
exfl = One_of(val,ext) > 0
val = Default(val,0)
res = make_array(size = sir, value = val)
res(l(0):h(0),l(1):h(1),l(2):h(2),l(3):h(3),$
l(4):h(4),l(5):h(5),l(6):h(6)) = arr
if exfl then begin
if l(0) gt 0 then $
res(0:l(0)-1,*,*,*,*,*,*) = res(replicate(l(0),l(0)),*,*,*,*,*,*)
if s(0) gt 0 then $
res(h(0)+1:*,*,*,*,*,*,*) = res(replicate(h(0),s(0)),*,*,*,*,*,*)
if l(1) gt 0 then $
res(*,0:l(1)-1,*,*,*,*,*) = res(*,replicate(l(1),l(1)),*,*,*,*,*)
if s(1) gt 0 then $
res(*,h(1)+1:*,*,*,*,*,*) = res(*,replicate(h(1),s(1)),*,*,*,*,*)
if l(2) gt 0 then $
res(*,*,0:l(2)-1,*,*,*,*) = res(*,*,replicate(l(2),l(2)),*,*,*,*)
if s(2) gt 0 then $
res(*,*,h(2)+1:*,*,*,*,*) = res(*,*,replicate(h(2),s(2)),*,*,*,*)
if l(3) gt 0 then $
res(*,*,*,0:l(3)-1,*,*,*) = res(*,*,*,replicate(l(3),l(3)),*,*,*)
if s(3) gt 0 then $
res(*,*,*,h(3)+1:*,*,*,*) = res(*,*,*,replicate(h(3),s(3)),*,*,*)
if l(4) gt 0 then $
res(*,*,*,*,0:l(4)-1,*,*) = res(*,*,*,*,replicate(l(4),l(4)),*,*)
if s(4) gt 0 then $
res(*,*,*,*,h(4)+1:*,*,*) = res(*,*,*,*,replicate(h(4),s(4)),*,*)
if l(5) gt 0 then $
res(*,*,*,*,*,0:l(5)-1,*) = res(*,*,*,*,*,replicate(l(5),l(5)),*)
if s(5) gt 0 then $
res(*,*,*,*,*,h(5)+1:*,*) = res(*,*,*,*,*,replicate(h(5),s(5)),*)
if l(6) gt 0 then $
res(*,*,*,*,*,*,0:l(6)-1) = res(*,*,*,*,*,*,replicate(l(6),l(6)))
if s(6) gt 0 then $
res(*,*,*,*,*,*,h(6)+1:*) = res(*,*,*,*,*,*,replicate(h(6),s(6)))
endif
return, reform(res,sir(ndm-nds+1:ndm))
end