Changeset 114 for trunk/SRC/ToBeReviewed/MATRICE/cmset_op.pro

Timestamp:

06/19/06 16:14:56 (18 years ago)

Author:

smasson

Message:

new compilation options (compile_opt idl2, strictarrsubs) in each routine

File:

• trunk/SRC/ToBeReviewed/MATRICE/cmset_op.pro (modified) (15 diffs)

trunk/SRC/ToBeReviewed/MATRICE/cmset_op.pro

@@ -154 +154 @@
 ;   if keyword_set(sortit) then begin
 ;       ;; Sort it manually
-;       ii = sort(a) & b = a(ii)
+;       ii = sort(a) & b = a[ii]
 ;       if keyword_set(non) then wh = where(b EQ shift(b, sh), ct) $
 ;       else                     wh = where(b NE shift(b, sh), ct)
-;       if ct GT 0 then return, ii(wh)
+;       if ct GT 0 then return, ii[wh]
 ;   endif else begin
 ;       ;; Use the user's values directly
@@ -171 +171 @@
 ;; "first" value, whatever that may mean.
 function cmset_op_uniq, a
+;
+  compile_opt idl2, strictarrsubs
+;
   if n_elements(a) LE 1 then return, 0L
 
-  ii = sort(a) & b = a(ii)
+  ii = sort(a) & b = a[ii]
   wh = where(b NE shift(b, +1L), ct)
-  if ct GT 0 then return, ii(wh)
+  if ct GT 0 then return, ii[wh]
 
   return, 0L
@@ -182 +185 @@
 function cmset_op, a, op0, b, not1=not1, not2=not2, count=count, $
               empty1=empty1, empty2=empty2, maxarray=ma, index=index
+;
+  compile_opt idl2, strictarrsubs
+;
 
   on_error, 2 ;; return on error
@@ -204 +210 @@
   ;; Check the operation
   sz = size(op0)
-  if sz(sz(0)+1) NE 7 then begin
+  if sz[sz[0]+1] NE 7 then begin
       OP_ERR:
       message, "ERROR: OP must be 'AND', 'OR' or 'XOR'"
@@ -247 +253 @@
          if count GT 0 then return, a1 else return, -1L
      endif
-     if count GT 0 then return, a(a1) else return, -1L
+     if count GT 0 then return, a[a1] else return, -1L
      RET_B1:
      count = n2
@@ -253 +259 @@
          if count GT 0 then return, b1+n1 else return, -1L
      endif         
-     if count GT 0 then return, b(b1) else return, -1L
+     if count GT 0 then return, b[b1] else return, -1L
  endif
 
@@ -266 +272 @@
 
   ;; Check types of operands
-  sz1 = size(a) & tp1 = sz1(sz1(0)+1)
-  sz2 = size(b) & tp2 = sz2(sz2(0)+1)
+  sz1 = size(a) & tp1 = sz1[sz1[0]+1]
+  sz2 = size(b) & tp2 = sz2[sz2[0]+1]
   if tp1 LT 0 OR tp1 GE 16 OR tp2 LT 0 OR tp2 GE 16 then begin
       message, 'ERROR: unrecognized data types for operands'
       return, -1
   endif
-  if basetype(tp1) NE basetype(tp2) then begin
+  if basetype[tp1] NE basetype[tp2] then begin
       TYPE1_ERR:
       message, 'ERROR: both A and B must be of the same type'
@@ -297 +303 @@
               count = n_elements(index0)
               if kind then return, index0
-              return, uu(index0)
+              return, uu[index0]
           end
 
@@ -305 +311 @@
               bi = cmset_op_uniq(b) & nb = n_elements(bi)
               ui = [ai, bi+n1]
-              uu = [a,b]    & uu = uu(ui) ;; Raw union...
-              us = sort(uu) & uu = uu(us) ;; ...and sort
-              if kind then ui = ui(temporary(us)) else ui = 0
+              uu = [a,b]    & uu = uu[ui] ;; Raw union...
+              us = sort(uu) & uu = uu[us] ;; ...and sort
+              if kind then ui = ui[temporary(us)] else ui = 0
 
               ;; Values in one set only will not have duplicates
               wh1 = where(uu NE shift(uu, -1), count1)
               if count1 EQ 0 then return, -1L
-              wh = where(wh1(1:*)-wh1 EQ 1, count)
-              if wh1(0) EQ 0 then begin
+              wh = where(wh1[1:*]-wh1 EQ 1, count)
+              if wh1[0] EQ 0 then begin
                   if count GT 0 then wh = [-1L, wh] else wh = [-1L]
                   count = n_elements(wh)
               endif
               if count EQ 0 then return, -1
-              if kind then return, ui(wh1(wh+1))
-              return, uu(wh1(wh+1))
+              if kind then return, ui[wh1[wh+1]]
+              return, uu[wh1[wh+1]]
           end
 
@@ -327 +333 @@
               bi = cmset_op_uniq(b) & nb = n_elements(bi)
               ui = [ai, bi+n1]
-              uu = [a,b]    & uu = uu(ui)  ;; Raw union...
-              us = sort(uu) & uu = uu(us)  ;; ...and sort
-              if kind then ui = ui(us) else ui = 0
+              uu = [a,b]    & uu = uu[ui]  ;; Raw union...
+              us = sort(uu) & uu = uu[us]  ;; ...and sort
+              if kind then ui = ui[us] else ui = 0
 
               if NOT keyword_set(not1) AND NOT keyword_set(not2) then begin
@@ -336 +342 @@
                   ;; they are equal, then the SHIFT() technique below
                   ;; fails.  Do this one by hand.
-                  if na EQ 1 AND nb EQ 1 AND uu(0) EQ uu(1) then begin
+                  if na EQ 1 AND nb EQ 1 AND uu[0] EQ uu[1] then begin
                       count = 1L
                       if kind then return, 0L
-                      return, [uu(0)]
+                      return, [uu[0]]
                   endif
 
@@ -348 +354 @@
                   ;; This should always select the element from A
                   ;; rather than B (the smaller of the two)
-                  if kind then return, (ui(wh) < ui(wh+1))
-                  return, uu(wh)
+                  if kind then return, (ui[wh] < ui[wh+1])
+                  return, uu[wh]
               endif
 
               ;; For "NOT" cases, we need to identify by set
               ii = make_array(na+nb, value=1b)
-              if keyword_set(not1) then ii(0:na-1) = 0
-              if keyword_set(not2) then ii(na:*)   = 0
-              ii = ii(temporary(us))
+              if keyword_set(not1) then ii[0:na-1] = 0
+              if keyword_set(not2) then ii[na:*]   = 0
+              ii = ii[temporary(us)]
 
               ;; Remove any duplicates
               wh1 = where(uu EQ shift(uu, -1L), count1) ;; Find non-unique
-              if count1 GT 0 then ii([wh1, wh1+1]) = 0
+              if count1 GT 0 then ii[wh1, wh1+1] = 0
               ;; Remainder is the desired set
               wh = where(ii, count)
               if count EQ 0 then return, -1L
-              if kind then return, ui(wh)
-              return, uu(wh)
+              if kind then return, ui[wh]
+              return, uu[wh]
           end
 
@@ -380 +386 @@
       minn = min1 < min2 & maxx = max1 > max2
       nbins = maxx-minn+1
-      if (maxx-minn) GT floor(ma(0)) then goto, SLOW_SET_OP
+      if (maxx-minn) GT floor(ma[0]) then goto, SLOW_SET_OP
 
       ;; Work around a stupidity in the built-in IDL HISTOGRAM routine
@@ -405 +411 @@
       result = temporary(wh+minn)
       if tp1 NE tp2 then return, result
-      szr = size(result) & tpr = szr(szr(0)+1)
+      szr = size(result) & tpr = szr[szr[0]+1]
 
       ;; Cast to the original type if necessary
       if tpr NE tp1 then begin
           fresult = make_array(n_elements(result), type=tp1)
-          fresult(0) = temporary(result)
+          fresult[0] = temporary(result)
           result = temporary(fresult)
       endif
@@ -424 +430 @@
 ;     works, but is complicated, so I forced it to go to SLOW_SET_OP.
 ;     ha = histogram(a, min=minn, max=maxx, reverse=ra) < 1
-;     rr = ra(0:nbins) & mask = rr NE rr(1:*) & ra = ra(rr)*mask-1L+mask
+;     rr = ra[0:nbins] & mask = rr NE rr[1:*] & ra = ra[rr]*mask-1L+mask
 ;     hb = histogram(b, min=minn, max=maxx, reverse=rb) < 1
-;     rr = rb(0:nbins) & mask = rr NE rr(1:*) & rb = rb(rr)*mask-1L+mask
+;     rr = rb[0:nbins] & mask = rr NE rr[1:*] & rb = rb[rr]*mask-1L+mask
 ;     ...  AND/OR/XOR NOT masking here ...
-;     ra = ra(wh) & rb = rb(wh)
+;     ra = ra[wh] & rb = rb[wh]
 ;     return, ra*(ra GE 0) + (rb+n1)*(ra LT 0) ;; is last 'ra' right?