source: trunk/MATRICE/colle.pro @ 2

;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
;+
; NAME:colle
;
; PURPOSE: Cette fonction de concatenation existe ds IDL (avec [] cf
; ds le programme ds le case pour direc egale 1,2,3) tant que l''on ne
; cherche pas a coller suivant une dimensionsuperieure ou egale a 4.  
;
; CATEGORY:bidouillage de matrice
;
; CALLING SEQUENCE:res=colle(bableau_de_pointeur,direc) ou bien
;                  res=colle(tab1,tab2,tab3,tab4,.....,direc)
;
; INPUTS:
;         
;        CAS 1:
;        tableau_de_pointeur:comme son nom l''indique c'est un tableau
;        de pointeur, dont chaque elements pointe sur tableau a coller
;
;        par ex ds un programme, on veut coller n tableaux entre eux
;
;          tab=ptrarr(n,/allocate_heap)
;          for i=0,n-1 do begin
;             *tab[n]=replicate(n,2,3)
;          endfor
;          res=colle(tab,1)
;
;        CAS 2:
;        on donne directement les tableaux a coller
;        rq: ds ce cas on peut au plus donner 20 tableaux en entree.
;
;        ATTENTION : sans le mot cle /SAUVE les arguments en entree
;        sont detruits lorsque l''on construit res. ds le cas 1 on
;        detruit le tableau de pointeurs et les variables sur
;        lesquelles on pointe.
;
;        direc: la direction suivant laquelle les coller, 1,2,3... 
;
; KEYWORD PARAMETERS:
;
;         /SAUVE: mot cle qui force a sauvegarder le tableau de
;         pointeur et les tableaux a coller.
;
; OUTPUTS:res=matrice resultat
;
; RESTRICTIONS:
;
; EXAMPLE:
; 
;         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
;
; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
;                       13/1/98
;-
;------------------------------------------------------------
;------------------------------------------------------------
;------------------------------------------------------------
; pour suprimer une variable.
;------------------------------------------------------------
   PRO UNDEFINE, varname  
      tempvar = SIZE(TEMPORARY(varname))
   END
;------------------------------------------------------------
;------------------------------------------------------------
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
   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
         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
            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 
 
;------------------------------------------------------------