Commit 235ac2e4756b7c3f03815b267d292a26e8e1df37

Authored by Raymond Toy
1 parent 0823acf4

Fix for complex args.

Showing 1 changed file with 13 additions and 11 deletions
qd-bessel.lisp
... ... @@ -183,18 +183,18 @@
183 183 (defun integer-bessel-j-exp-arc (v z)
184 184 (let* ((iz (* #c(0 1) z))
185 185 (i+ (exp-arc-i-2 iz v)))
186   - (cond ((= v (ftruncate v))
  186 + (cond ((and (= v (ftruncate v)) (realp z))
187 187 ;; We can simplify the result
188   - (let ((c (cis (* v (float-pi i+) -1/2))))
  188 + (let ((c (exp (* v (float-pi i+) #c(0 -1/2)))))
189 189 (/ (+ (* c i+)
190 190 (* (conjugate c) (conjugate i+)))
191 191 (float-pi i+)
192 192 2)))
193 193 (t
194 194 (let ((i- (exp-arc-i-2 (- iz ) v)))
195   - (/ (+ (* (cis (* v (float-pi i+) -1/2))
  195 + (/ (+ (* (exp (* v (float-pi i+) #c(0 -1/2)))
196 196 i+)
197   - (* (cis (* v (float-pi i+) 1/2))
  197 + (* (exp (* v (float-pi i+) #c(0 1/2)))
198 198 i-))
199 199 (float-pi i+)
200 200 2))))))
... ... @@ -394,19 +394,21 @@
394 394 ;; Clear the caches for now.
395 395 (an-clrhash)
396 396 (%big-a-clrhash)
397   - (cond ((= vv v)
398   - ;; v is an integer
  397 + (cond ((and (= vv v) (realp z))
  398 + ;; v is an integer and z is real
399 399 (integer-bessel-j-exp-arc v z))
400 400 (t
401 401 ;; Need to fine-tune the value of big-n.
402 402 (let ((big-n 100)
403 403 (vpi (* v (float-pi (realpart z)))))
404 404 (+ (integer-bessel-j-exp-arc v z)
405   - (* z
406   - (/ (sin vpi) vpi)
407   - (+ (/ -1 z)
408   - (sum-ab big-n v z)
409   - (sum-big-ia big-n v z)))))))))
  405 + (if (= vv v)
  406 + 0
  407 + (* z
  408 + (/ (sin vpi) vpi)
  409 + (+ (/ -1 z)
  410 + (sum-ab big-n v z)
  411 + (sum-big-ia big-n v z))))))))))
410 412  
411 413 ;; Bessel Y
412 414 ;;
... ...