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

Last change on this file since 114 was 114, checked in by smasson, 18 years ago

new compilation options (compile_opt idl2, strictarrsubs) in each routine
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.0 KB
Line 
1;------------------------------------------------------------
2;------------------------------------------------------------
3;------------------------------------------------------------
4;+
5; NAME:colle
6;
7; PURPOSE: Cette fonction de concatenation existe ds IDL (avec [] cf
8; ds le programme ds le case pour direc egale 1,2,3) tant que l''on ne
9; cherche pas a coller suivant une dimensionsuperieure ou egale a 4. 
10;
11; CATEGORY:bidouillage de matrice
12;
13; CALLING SEQUENCE:res=colle(bableau_de_pointeur,direc) ou bien
14;                  res=colle(tab1,tab2,tab3,tab4,.....,direc)
15;
16; INPUTS:
17;         
18;        CAS 1:
19;        tableau_de_pointeur:comme son nom l''indique c'est un tableau
20;        de pointeur, dont chaque elements pointe sur tableau a coller
21;
22;        par ex ds un programme, on veut coller n tableaux entre eux
23;
24;          tab=ptrarr(n,/allocate_heap)
25;          for i=0,n-1 do begin
26;             *tab[n]=replicate(n,2,3)
27;          endfor
28;          res=colle(tab,1)
29;
30;        CAS 2:
31;        on donne directement les tableaux a coller
32;        rq: ds ce cas on peut au plus donner 20 tableaux en entree.
33;
34;        ATTENTION : sans le mot cle /SAUVE les arguments en entree
35;        sont detruits lorsque l''on construit res. ds le cas 1 on
36;        detruit le tableau de pointeurs et les variables sur
37;        lesquelles on pointe.
38;
39;        direc: la direction suivant laquelle les coller, 1,2,3...
40;
41; KEYWORD PARAMETERS:
42;
43;         /SAUVE: mot cle qui force a sauvegarder le tableau de
44;         pointeur et les tableaux a coller.
45;
46; OUTPUTS:res=matrice resultat
47;
48; RESTRICTIONS:
49;
50; EXAMPLE:
51;
52;         IDL> print, colle(replicate(1,2,2,2),indgen(2,2,2),2)   
53;                1       1
54;                1       1
55;                0       1
56;                2       3
57;
58;                1       1
59;                1       1
60;                4       5
61;                6       7
62;
63; MODIFICATION HISTORY: Sebastien Masson (smasson@lodyc.jussieu.fr)
64;                       13/1/98
65;-
66;------------------------------------------------------------
67;------------------------------------------------------------
68;------------------------------------------------------------
69; pour suprimer une variable.
70;------------------------------------------------------------
71   PRO UNDEFINE, varname 
72;
73  compile_opt idl2, strictarrsubs
74;
75      tempvar = SIZE(TEMPORARY(varname))
76   END
77;------------------------------------------------------------
78;------------------------------------------------------------
79FUNCTION colle, a0, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, SAUVE = sauve
80;
81  compile_opt idl2, strictarrsubs
82;
83   res = -1
84;------------------------------------------------------------
85; on met en place ptrtab et direc en fonction des arguments en entree
86;------------------------------------------------------------
87   case 1 of
88      n_params() EQ 2:BEGIN     ; cas ou l'on donne directement le tableau de pointeurs
89         ptrtab = a0
90         direc = a1
91         if NOT keyword_set(sauve) then undefine, a0
92; on recupere le nombre de tableaux a coller
93         nbretab = (size(ptrtab))[1]
94      end
95      n_params() GT 2:BEGIN
96; on recupere le nombre de tableaux a coller
97         nbretab = n_params()-1
98         bidon = execute('direc = a'+strtrim(n_params()-1, 2))
99; on ecrit le tableau de pointeur dont chaque element pointe sur un tableau
100         ptrtab=ptrarr(nbretab,/allocate_heap)
101         for n = 0,nbretab-1 do begin
102            bidon = execute('*ptrtab[n]=a'+strtrim(n, 2))
103            if NOT keyword_set(sauve) then bidon = execute('undefine, a'+strtrim(n, 2))
104         endfor
105         sauve = 0
106      end
107      ELSE:
108   endcase
109;------------------------------------------------------------
110; case sur la valeure de direc
111;------------------------------------------------------------
112   case direc of
113      1:BEGIN                   ; on colle suivant la dimension 1
114         res = *ptrtab[0]
115         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
116         FOR n = 1,nbretab-1 DO BEGIN
117            res = [temporary(res), *ptrtab[n]]
118            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
119         ENDFOR
120      END
121      2:BEGIN                   ; on colle suivant la dimension 2
122         res = *ptrtab[0]
123         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
124         FOR n = 1,nbretab-1 DO BEGIN
125            res = [[temporary(res)], [*ptrtab[n]]]
126            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
127         ENDFOR
128      END
129      3:BEGIN                   ; on colle suivant la dimension 3
130         res = *ptrtab[0]
131         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
132         FOR n = 1,nbretab-1 DO BEGIN
133            res = [[[temporary(res)]], [[*ptrtab[n]]]]
134            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
135         ENDFOR
136      END
137      ELSE:BEGIN
138; on transpose res de facon a mettre la dimension a coller numero 1.
139; pour cela on contient le vecteur permute qui donne la place que
140; doivent prendre les dimensions ds la matrice transposee
141        siz = (size(*ptrtab[0]))[0]
142         if siz LT direc then $
143          *ptrtab[0] = reform(*ptrtab[0], [(size(*ptrtab[0]))[1:siz], replicate(1, direc-siz)], /over)
144         permute = indgen((size(*ptrtab[0]))[0])
145         permute[0] = direc-1
146         permute[direc-1] = 0
147         res = transpose(*ptrtab[0], permute)
148         if NOT keyword_set(sauve) then ptr_free, ptrtab[0]
149         FOR n = 1,nbretab-1 DO BEGIN ; on colle suivant la dimension 1
150            if (size(*ptrtab[n]))[0] LT direc then $
151             *ptrtab[n] = reform(*ptrtab[n], [(size(*ptrtab[n]))[1:siz], replicate(1, direc-siz)])           
152            res = [temporary(res), transpose(*ptrtab[n], permute)]
153            if NOT keyword_set(sauve) then ptr_free, ptrtab[n]
154         ENDFOR
155         res = transpose(temporary(res), permute)
156      END
157   ENDCASE
158;------------------------------------------------------------
159   if NOT keyword_set(sauve) then undefine, ptrtab
160sortie:
161   return,  res
162
163   
164END
165 
166;------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.