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

;+
; @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}
;
; @param CAS 1 {in}{required}
;        table_of_pointer: It is a table of pointers, where each 
;        element point on a table to stick
;       
;        For exemple, in a program, we want to stick n table ones with others.
;
;          tab=ptrarr(n,/allocate_heap)
;          for i=0,n-1 do begin
;             *tab[n]=replicate(n,2,3)
;          endfor
;          res=colle(tab,1)
;
; @param CAS 2 {in}{required}
;        we directly give tables to stick
;        Comment: In this case, the plus we can give is 20 tables.
;
;        BEWARE: whitout the keyword /SAUVE entry arguments are 
;                delete when, we build res. In the first case,we 
;                delete the table of pointers and variables on which we point.
;
; @param direc {in}{required} The direction on which stick them, 1,2,3... 
;
; @keyword SAUVE mot cle qui force a sauvegarder le tableau de
;         pointeur et les tableaux a coller.
;
; @returns res=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
;------------------------------------------------------------
; on met en place ptrtab et direc en fonction des arguments en entree
;------------------------------------------------------------
   case 1 of
      n_params() EQ 2:BEGIN     ; cas ou l'on donne directement le tableau de pointeurs
         ptrtab = a0
         direc = a1
         if NOT keyword_set(sauve) then undefine, a0
; on recupere le nombre de tableaux a coller
         nbretab = (size(ptrtab))[1]
      end
      n_params() GT 2:BEGIN
; on recupere le nombre de tableaux a coller
         nbretab = n_params()-1
         bidon = execute('direc = a'+strtrim(n_params()-1, 2))
; on ecrit le tableau de pointeur dont chaque element pointe sur un tableau
         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 sur la valeure de direc
;------------------------------------------------------------
   case direc of
      1:BEGIN                   ; on colle suivant la 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                   ; on colle suivant la 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                   ; on colle suivant la 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 
; on transpose res de facon a mettre la dimension a coller numero 1.
; pour cela on contient le vecteur permute qui donne la place que
; doivent prendre les dimensions ds la matrice transposee
        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 ; on 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 
 
;------------------------------------------------------------