source: trunk/SRC/ToBeReviewed/MATRICE/colle.pro @ 327

;+
; @file_comments
; This concatenation function exist in IDL so long
; as we do not try to stick with a dimension superior or equal at 4.
;
; @categories
; Utilities
;
; @param a0 {in}{required}
;
; @param a1 {in}{required}
;
; @param a2 {in}{required}
;
; @param a3 {in}{required}
;
; @param a4 {in}{required}
;
; @param a5 {in}{required}
;
; @param a6 {in}{required}
;
; @param a7 {in}{required}
;
; @param a8 {in}{required}
;
; @param a9 {in}{required}
;
; @param a10 {in}{required}
;
; @param a11 {in}{required}
;
; @param a12 {in}{required}
;
; @param a13 {in}{required}
;
; @param a14 {in}{required}
;
; @param a15 {in}{required}
;
; @param a16 {in}{required}
;
; @param a17 {in}{required}
;
; @param a18 {in}{required}
;
; @param a19 {in}{required}
;
; @param a20 {in}{required}
;
; @keyword SAUVE
; force to save the pointer array and arrays to be stuck
;
; @returns
; matrice resultat
;
; @examples
; IDL> print, colle(replicate(1,2,2,2),indgen(2,2,2),2)
;                1       1
;                1       1
;                0       1
;                2       3
;
;                1       1
;                1       1
;                4       5
;                6       7
;
; @history
; Sebastien Masson (smasson\@lodyc.jussieu.fr)
;                       13/1/98
;
; @version
; $Id$
;
;-
FUNCTION colle, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9 $
              , a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20 $
              , SAUVE=sauve
;
  compile_opt idl2, strictarrsubs
;
   res = -1
;------------------------------------------------------------
; We put in place ptrtab and direc in function of input arguments
;------------------------------------------------------------
   case 1 of
      n_params() EQ 2:BEGIN     ; case where we directly give the pointer array
         ptrtab = a0
         direc = a1
         if NOT keyword_set(sauve) then undefine, a0
; on recuperate the number of array to be pasted.
         nbretab = (size(ptrtab))[1]
      end
      n_params() GT 2:BEGIN
; on recuperate the number of array to be pasted.
         nbretab = n_params()-1
         bidon = execute('direc = a'+strtrim(n_params()-1, 2))
; We write the pointer array whose each element point on an array.
         ptrtab=ptrarr(nbretab,/allocate_heap)
         for n = 0,nbretab-1 do begin
            bidon = execute('*ptrtab[n]=a'+strtrim(n, 2))
            if NOT keyword_set(sauve) then bidon = execute('undefine, a'+strtrim(n, 2))
         endfor
         sauve = 0
      end
      ELSE:
   endcase
;------------------------------------------------------------
; case on the direct's value.
;------------------------------------------------------------
   case direc of
      1:BEGIN                   ; we paste following the dimension 1
         res = *ptrtab[0]
         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
         FOR n = 1,nbretab-1 DO BEGIN
            res = [temporary(res), *ptrtab[n]]
            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
         ENDFOR
      END
      2:BEGIN                   ; we paste following the dimension 2
         res = *ptrtab[0]
         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
         FOR n = 1,nbretab-1 DO BEGIN
            res = [[temporary(res)], [*ptrtab[n]]]
            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
         ENDFOR
      END
      3:BEGIN                   ; we paste following the dimension 3
         res = *ptrtab[0]
         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
         FOR n = 1,nbretab-1 DO BEGIN
            res = [[[temporary(res)]], [[*ptrtab[n]]]]
            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
         ENDFOR
      END
      ELSE:BEGIN
; We transpose res in order to put the dimension to be pasted number 1
; To this, we contain the permuter vector which give the place that dimension
; in the transposed matrix must take.
        siz = (size(*ptrtab[0]))[0]
         if siz LT direc then $
          *ptrtab[0] = reform(*ptrtab[0], [(size(*ptrtab[0]))[1:siz], replicate(1, direc-siz)], /over)
         permute = indgen((size(*ptrtab[0]))[0])
         permute[0] = direc-1
         permute[direc-1] = 0
         res = transpose(*ptrtab[0], permute)
         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
         FOR n = 1,nbretab-1 DO BEGIN ; we paste following the dimension 1on colle suivant la dimension 1
            if (size(*ptrtab[n]))[0] LT direc then $
             *ptrtab[n] = reform(*ptrtab[n], [(size(*ptrtab[n]))[1:siz], replicate(1, direc-siz)])
            res = [temporary(res), transpose(*ptrtab[n], permute)]
            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
         ENDFOR
         res = transpose(temporary(res), permute)
      END
   ENDCASE
;------------------------------------------------------------
   if NOT keyword_set(sauve) then undefine, ptrtab
sortie:
   return,  res
END