This file is indexed.

/usr/share/gnudatalanguage/lib/interpol.pro is in gnudatalanguage 0.9.5-2+b1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
;
; under GNU GPL v2 or later
;
; by Sylwester Arabas <slayoo@igf.fuw.edu.pl>
; relies on findex.pro by Paul Ricchiazzi
;
; revised 27-Feb-2012 by Alain C. after bug report 3495104
; We have to manage also points in "p2" outside "p1" range ...
; (new cases not include in testsuite/test_interpol.pro)
;
; revised 18-Feb-2013 by Alain C. after bug report 3602770
; We have to manage NaN and Infinity ...
;
; resived 29-Oct-2013 by Alain C. thanks to Gael mixing
; of Double/Long64 types in HFI Planck Monte Carlo pipeline.
;
function INTERPOL, p0, p1, p2, lsquadratic=lsquadratic, $
                   quadratic=quadratic, spline=spline, $
                   test=test, help=help, debug=debug
;
ON_ERROR, 2
;
if KEYWORD_SET(help) then begin
    print, 'function INTERPOL, p0, p1, p2, lsquadratic=lsquadratic, $'
    print, '                   quadratic=quadratic, spline=spline, $'
    print, '                   test=test, help=help, debug=debug'
    print, '/lsquadratic and /quadratic not available, help welcome !'
    return, -1
endif
;
; input type sanity checks
;
; type of return output comes from "p0" type
;
p0_type=SIZE(p0, /type)
if ((p0_type EQ 7) OR (p0_type EQ 8) OR (p0_type EQ 10)) then $
  MESSAGE, 'expression TYPE not allowed in this context: p0'
;
p1_type=SIZE(p1, /type)
if ((p1_type EQ 7) OR (p1_type EQ 8) OR (p1_type EQ 10)) then $
  MESSAGE, 'expression TYPE not allowed in this context: p1'
;
;; sanity checks
;
if N_PARAMS() eq 1 then $
  MESSAGE, 'Two or three parameters required'
if KEYWORD_SET(lsquadratic) then $
  MESSAGE, 'LSQUADRATIC keyword not supported yet (FIXME!)'
if KEYWORD_SET(quadratic) then $
  MESSAGE, 'QUADRATIC keyword not supported yet (FIXME!)'
;
;  if N_PARAMS() eq 3 and N_ELEMENTS(p0) ne N_ELEMENTS(p1) then $
;    MESSAGE, 'In the three-parameter case the first and second argument must be of equal length'
; <see bug no. 3104537>
;
if N_PARAMS() eq 3 then begin
    if N_ELEMENTS(p0) ne N_ELEMENTS(p1) then $
      MESSAGE, 'In the three-parameter case the first and second argument must be of equal length'
    ;;
    ;; note by AC, 27-02-2012: is it really true ??
    all_equal_test=ABS((p1 - SHIFT(p1,+1))(1:*))
    if MIN(TEMPORARY(all_equal_test)) eq 0 then begin
        MESSAGE, /cont, $  ; usually only triggered for integer arrays
          'In the three-parameter case, the second argument must be strictly increasing or strictly decreasing.'
    endif
endif
; </...>
;
isint = SIZE(p0, /type) lt 4 || SIZE(p0, /type) gt 11
;
; AC, 29-oct-2013, other "bad" types exited before
; Float is "4", Dbl is 5, Cplx 6, DCplx 9 (TBC)
;
if ((p0_type LT 4) OR (p0_type GT 11)) then p0_type=4
;
; AC 2012/03/05: useful values ... may be updated later
nbp_inside=N_ELEMENTS(p0)
nbp_outside=0
;
ExistNotFinite=0
;
if N_PARAMS() eq 2 then begin
    ;; regular grid case
    if SIZE(p1, /dimensions) eq 0 then begin
        ind = FINDGEN(p1) / (p1 - (p1 eq 1 ? 0 : 1)) * (N_ELEMENTS(p0) - 1)
    endif else begin
        MESSAGE, 'In the two-parameter case the second parameter must be a scalar'
        ;; TODO: IDL does something else here...
    endelse
endif else if ~KEYWORD_SET(spline) then begin
    ;; first, we exclude the NaN and Infinity values ...
    ;; if fact, we copy in another array the not finite values ...
    p2_info=SIZE(p2,/dim)
    index_p2_finite=WHERE(FINITE(p2) EQ 1, nbp_ok)
    if (nbp_ok GT 0) then begin
        if (N_ELEMENTS(p2) GT nbp_ok) then begin
            ExistNotFinite=1
            index_p2_not_finite=WHERE(FINITE(p2) EQ 0)
            p2_not_finite=p2[index_p2_not_finite]
            p2=p2[index_p2_finite]
        endif else begin
            ;; all data are finite ... we don't need to recopy
            ExistNotFinite=0
        endelse
    endif else begin
        ;; all input data are not finite ...
        if KEYWORD_SET(test) then STOP
        return, p2
    endelse
    ;; irregular grid case
    ;; we need to manage points outside p1 range
    p1_min=MIN(p1, max=p1_max)
    outside_OK=WHERE((p2 LT p1_min) OR (p2 GT p1_max), nbp_outside)
    if (nbp_outside GT 0) then begin
        outside=p2[outside_OK]
        inside_OK=WHERE((p2 GE p1_min) AND (p2 LE p1_max), nbp_inside)
        if (nbp_inside GT 0) then begin
            p2_inside=p2[inside_OK]
            ind = FINDEX(p1, p2_inside)
        endif      
    endif else begin
        ;; if we are here, all the points in "p2" are inside "p1" range
        ind=FINDEX(p1,p2)
    endelse
endif
;
if KEYWORD_SET(spline) then begin
   if (N_ELEMENTS(p0) LT 4) then MESSAGE, 'as least 4 input points need !'
   ;; spline case
   if N_PARAMS() eq 2 then begin
        x = FINDGEN(N_ELEMENTS(p0))
        y = SPL_INTERP(x, p0, SPL_INIT(x, p0), ind)
    endif else begin
       if (N_ELEMENTS(p1) LT 4) then MESSAGE, 'as least 4 input points need !'
        y = SPL_INTERP(p1, p0, SPL_INIT(p1, p0), p2)
    endelse
    result=FIX(TEMPORARY(y), type=SIZE(p0, /type))
endif else begin
    ;; linear interpolation case
    if (nbp_inside GT 0) then result=INTERPOLATE(isint ? FLOAT(p0) : p0, ind)
    if (nbp_outside GT 0) then begin
        tmp=MAKE_ARRAY(p2_info, type=p0_type)
        if (nbp_inside GT 0) then tmp[inside_OK]=result
        last=N_ELEMENTS(p0)-1
        slope_begin=(1.*p0[1]-p0[0])/(p1[1]-p1[0])
        slope_end  =(1.*p0[last-1]-p0[last])/(p1[last-1]-p1[last])
        for ii=0, nbp_outside-1 do begin
            if outside[ii] LT p1_min then begin
                tmp[outside_OK[ii]]=slope_begin*(outside[ii]-p1[0])+p0[0]
            endif else begin
                tmp[outside_OK[ii]]=slope_end*(outside[ii]-p1[last-1])+p0[last-1]
            endelse
        endfor
        result=tmp
    endif
endelse
;
if ExistNotFinite then begin
    resres=MAKE_ARRAY(p2_info, type=p0_type)
    resres[index_p2_not_finite]=p2_not_finite
    resres[index_p2_finite]=result
    result=resres
endif
;
if KEYWORD_SET(test) or KEYWORD_SET(debug) then STOP
;
return, result
;
end