Commit aefc0853 authored by liam's avatar liam

Rename defun-gsl, defvariable; clean up markup and header files; :size

to size; make-tests and assert-numerical-equal.


git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3294 a3d8a0fb-c1db-0310-ace7-a616afeb9e30
parent eb3bf5e5
TODO
remove cffi-array
Document letm
Document chapters
organize presentation
......@@ -9,6 +8,8 @@ Other regression errors
Do tests in ia32.
normalize terminology for solve-minimize-fit; make subdir?
Add bspline.
Include required parts per FDL.
Wishlist:
Sun Feb 10 2008 GSLL creation of objects within letm as from e.g. #'covariance.
......@@ -16,6 +17,8 @@ Sun Feb 10 2008 GSLL creation of objects within letm as from e.g. #'covariance.
Bulk changes needed:
Rename defun-gsl, defvariable.
Clean up markup and header files.
:size to size
String comparison of floats?
Features:
......
;; Load GSL
;; Liam Healy Sat Mar 4 2006 - 18:53
;; Time-stamp: <2008-01-21 12:33:11EST init.lisp>
;; Time-stamp: <2008-02-16 17:56:56EST init.lisp>
;; $Id: $
(defpackage gsll
......@@ -25,6 +25,17 @@
;;; be changed to something outside the keyword package to suppress
;;; warnings from CFFI.
(cffi:defctype uint32 :unsigned-int)
(cffi:defctype uint64 :unsigned-long)
(cffi:defctype size
#-cffi-features:no-long-long uint64
#+cffi-features:no-long-long
#.(progn (cerror "Use uint32 instead."
"This platform does not support long long types.")
uint32))
;;; obsolete
(cffi:defctype :uint32 :unsigned-int)
(cffi:defctype :uint64 :unsigned-long)
(cffi:defctype :size
......
;; Macros to interface GSL functions.
;; Liam Healy
;; Time-stamp: <2008-02-16 10:44:10EST interface.lisp>
;; Time-stamp: <2008-02-16 17:47:30EST interface.lisp>
;; $Id: $
(in-package :gsl)
......@@ -152,6 +152,107 @@
;;; invalidate Invalidate the CL array/matrix cache.
;;; after After method.
;;; enumeration The name of the enumeration return.
(defmacro defmfun
(name arglist gsl-name c-arguments
&key (c-return :error-code)
(return nil return-supplied-p)
(type :function) (index t) (export (not (eq type :method)))
null-pointer-info documentation invalidate after enumeration)
(let* ((cargs (substitute '(mode sf-mode) :mode c-arguments))
(carg-symbs
(remove-if-not #'symbolp
(mapcar #'st-symbol (remove :mode c-arguments))))
(clargs
(or arglist carg-symbs))
(arglist-symbs
(when arglist ; can be method, so get symbol
(mapcar (lambda (x) (if (listp x) (first x) x)) arglist)))
(cret-type (if (member c-return *special-c-return*)
:int
(if (listp c-return) (st-type c-return) c-return)))
(cret-name
(if (listp c-return) (st-symbol c-return) (make-symbol "CRETURN")))
(allocated ; Foreign objects to be allocated
(remove-if (lambda (s) (member s arglist-symbs)) carg-symbs))
(allocated-decl
(mapcar
(lambda (s) (find s cargs :key #'st-symbol))
allocated))
(clret (or (substitute cret-name :c-return return) ; better as a symbol macro
(mapcan #'cl-convert-form allocated-decl)
invalidate
(unless (eq c-return :void)
(list cret-name))))
(clargs-types (cl-argument-types clargs cargs)))
`(progn
(,(if (eq type :function) 'defun 'defmethod)
,name
,(if (member :mode c-arguments)
`(,@clargs &optional (mode :double-prec))
`(,@clargs))
,(declaration-form clargs-types)
,@(when documentation (list documentation))
(,@(if allocated
`(cffi:with-foreign-objects
,(mapcar #'wfo-declare allocated-decl))
'(let ()))
(let ((,cret-name
(cffi:foreign-funcall
,gsl-name
,@(mapcan
(lambda (arg)
(list (if (member (st-symbol arg) allocated)
:pointer
(st-type arg))
(st-symbol arg)))
cargs)
,cret-type)))
,@(case c-return
(:void `((declare (ignore ,cret-name))))
(:error-code ; fill in arguments
`((check-gsl-status ,cret-name ',name))))
,@(when invalidate `((cl-invalidate ,@invalidate)))
,@(when (or null-pointer-info (eq c-return :pointer))
`((check-null-pointer ,cret-name
,@(or null-pointer-info
'(:ENOMEM "No memory allocated")))))
,@after
(values
,@(case c-return
(:number-of-answers
(mapcan
(lambda (vbl seq)
`((when (> ,cret-name ,seq) ,vbl)))
clret
(loop for i below (length clret) collect i)))
(:success-failure
(if (equal clret invalidate)
;; success-failure more important than passed-in
`((success-failure ,cret-name))
(remove cret-name ; don't return c-return itself
`(,@clret (success-failure ,cret-name)))))
(:success-continue
(if (equal clret invalidate)
;; success-failure more important than passed-in
`((success-continue ,cret-name))
(remove cret-name ; don't return c-return itself
`(,@clret (success-continue ,cret-name)))))
(:true-false
`((not (zerop ,cret-name))))
(:enumerate
`((cffi:foreign-enum-keyword ',enumeration ,cret-name)))
(t (unless
(or
(and (eq c-return :error-code)
(not allocated)
(not return-supplied-p))
(and (null return) return-supplied-p))
clret)))))))
,@(when index `((map-name ',(if (eql index t) name index) ,gsl-name)))
,@(when export `((export ',name))))))
;;; to be removed
(defmacro defun-gsl
(name arglist gsl-name c-arguments
&key (c-return :error-code)
......@@ -251,6 +352,8 @@
,@(when index `((map-name ',(if (eql index t) name index) ,gsl-name)))
,@(when export `((export ',name))))))
(defmacro defun-optionals
(name arglist no-optional optionals &optional documentation)
"Define a function with and without optional arguments."
......@@ -272,6 +375,15 @@
;;;; Variables in library
;;;;****************************************************************************
(defmacro defmpar (cl-symbol gsl-symbol documentation)
"Define a library variable pointer."
`(progn
(cffi:defcvar (,gsl-symbol ,cl-symbol :read-only t) :pointer
,documentation)
(map-name ',cl-symbol ,gsl-symbol)
(export ',cl-symbol)))
;;; to be removed
(defmacro defvariable (cl-symbol gsl-symbol documentation)
"Define a library variable pointer."
`(progn
......
......@@ -11,15 +11,83 @@
;;; point numbers and a form for generating floating point tests.
(in-package :lisp-unit)
(defparameter *zero-threshold* 1.0d-12
"Threshold below which a number is to be considered zero.")
(defparameter *acceptable-fraction-error* 1.0d-12
"Fractional error which is considered acceptable when
comparing floating point numbers.")
(defun fp-equal (fp1 fp2)
"The floats fp1 and fp2 are to be considered equal."
;; For now, fp1 and fp2 must be actual floats and not nans/infs.
(or (and (<= (abs fp1) *zero-threshold*)
(<= (abs fp2) *zero-threshold*))
(<= (abs (/ (- fp1 fp2) fp1)) *acceptable-fraction-error*)))
(defun numerical-equal (result1 result2)
(and
(or
(typep result1 'vector) (typep result2 'vector)
(typep result1 'complex) (typep result2 'complex)
(eql (type-of result1) (type-of result2)))
(typecase result1
(integer (= result1 result2))
(float (fp-equal result1 result2))
(complex (and (fp-equal (realpart result1) (realpart result2))
(fp-equal (imagpart result1) (imagpart result2))))
(sequence
(and (eql (length result1) (length result2))
(every #'numerical-equal result1 result2)))
(array
(and (= (array-rank result1) (array-rank result2) 2)
(loop for i below (array-dimension result1 0)
always
(loop for j below (array-dimension result1 1)
always (numerical-equal (aref result1 i j)
(aref result2 i j)))))))))
(defun numerical-serialize (form)
(if (typep form 'list)
(cons 'list (mapcar #'numerical-serialize form))
form))
(defmacro assert-numerical-equal (expected form &rest extras)
(lisp-unit::expand-assert
:equal form form expected extras
:test #'numerical-equal))
;;; (make-test '(legendre-conicalP-half 3.5d0 10.0d0))
(defun gsl::make-test (form)
"Make a test for lisp-unit."
(let ((vals (multiple-value-list (ignore-errors (eval form)))))
(if (typep (second vals) 'error)
`(lisp-unit::assert-error
',(type-of (second vals))
,form)
`(lisp-unit::assert-numerical-equal
,(numerical-serialize vals)
(multiple-value-list ,form)))))
(defmacro gsl::make-tests (name &rest forms)
(append
`(lisp-unit:define-test ,name)
(mapcar #'gsl::make-test forms)))
;;;;;;;;;;;;;; OBSOLETE
(export '(assert-first-fp-equal fp-values fp-sequence))
(defmacro fp-values (results)
`(mapcar #'fp-record (multiple-value-list ,results)))
(defparameter *test-fp-decimal-digits* 12
"The number of decimal digits on which floating point
number must agree.")
(defparameter *zero-threshold* 1.0d-15
"Threshold below which a number is tpo be considered zero.")
(defun fp-string (fp &optional (decimal-digits *test-fp-decimal-digits*))
"Format the floating point number as a string for comparison."
(if (typep fp 'complex)
......@@ -42,14 +110,50 @@
(map 'list #'fp-string results))
#|
;;(gsl:double-float-unequal x y double-float-epsilon)
;;; (make-fp-test '(legendre-conicalP-half 3.5d0 10.0d0))
(defun gsl::make-fp-test (form)
"Make a test."
`(lisp-unit::assert-first-fp-equal
,(lisp-unit::fp-string (eval form))
,form))
;;; Tests:
;;; assert-float-equal: First value only
;;; turn multiple values into a list
;;; compare sequences including structure.
(defmacro assert-fp-equal (expected form &rest extras)
(lisp-unit::expand-assert
:equal form `(fp-string (nth-value 0 ,form)) expected extras
:test #'fp-equal))
(defun fp-record (fp)
"Record the floating point number for comparison."
(if (typep fp 'complex)
(list (fp-record (realpart fp)) (fp-record (imagpart fp)))
;; relies on ~g printing full precision per spec
(format nil "~g" fp)))
(defun fp-record (fp)
"Record the floating point number for comparison."
(etypecase fp
(complex
(list (fp-record (realpart fp)) (fp-record (imagpart fp))))
(sequence (map (type-of fp) #'fp-record))
;; relies on ~g printing full precision per spec
(float (format nil "~g" fp))))
(defun fp-sequence (results)
(map 'list #'fp-string results))
;;;;;;;;;;;;;;;;;
;;; Thinking about how to do floating point comparisons
......@@ -61,7 +165,6 @@
double-float-epsilon
single-float-epsilon))))
;;; Tests:
;;; assert-float-equal: First value only
;;; turn multiple values into a list
;;; compare sequences including structure.
|#
;********************************************************
; file: airy.lisp
; description: Airy functions
; date: Fri Mar 17 2006 - 18:41
; author: Liam M. Healy
; modified: Sun Feb 18 2007 - 12:16
;********************************************************
;; Airy functions
;; Liam Healy, Fri Mar 17 2006 - 18:41
;; Time-stamp: <2008-02-16 17:57:19EST airy.lisp>
;; $Id: $
(in-package :gsl)
......@@ -12,86 +9,130 @@
;;;; Airy functions
;;;;****************************************************************************
(defun-gsl airy-Ai (x)
(defmfun airy-Ai (x)
"gsl_sf_airy_Ai_e" ((x :double) :mode (ret sf-result))
:documentation "The Airy function Ai(x).")
:documentation ; FDL
"The Airy function Ai(x).")
(defun-gsl airy-Bi (x)
(defmfun airy-Bi (x)
"gsl_sf_airy_Bi_e" ((x :double) :mode (ret sf-result))
:documentation "The Airy function Bi(x).")
:documentation ; FDL
"The Airy function Bi(x).")
(defun-gsl airy-Ai-scaled (x)
(defmfun airy-Ai-scaled (x)
"gsl_sf_airy_Ai_scaled_e" ((x :double) :mode (ret sf-result))
:documentation
"The scaled Airy function @math{S_A(x) Ai(x)}.
For @math{x>0} the scaling factor @math{S_A(x)} is @math{\exp(+(2/3) x^(3/2))},
and is 1 for @math{x<0}.")
:documentation ; FDL
"The scaled Airy function S_A(x) Ai(x).
For x>0 the scaling factor S_A(x) is \exp(+(2/3) x^(3/2)),
and is 1 for x<0.")
(defun-gsl airy-Bi-scaled (x)
(defmfun airy-Bi-scaled (x)
"gsl_sf_airy_Bi_scaled_e" ((x :double) :mode (ret sf-result))
:documentation "The scaled Airy function @math{S_B(x) Bi(x)}.
For @math{x>0} the scaling factor @math{S_B(x)} is @math{exp(-(2/3) x^(3/2))},
and is 1 for @math{x<0}.")
:documentation ; FDL
"The scaled Airy function S_B(x) Bi(x).
For x>0 the scaling factor S_B(x) is exp(-(2/3) x^(3/2)),
and is 1 for x<0.")
(defun-gsl airy-Ai-deriv (x)
(defmfun airy-Ai-deriv (x)
"gsl_sf_airy_Ai_deriv_e" ((x :double) :mode (ret sf-result))
:documentation "The Airy function derivative Ai'(x).")
:documentation ; FDL
"The Airy function derivative Ai'(x).")
(defun-gsl airy-Bi-deriv (x)
(defmfun airy-Bi-deriv (x)
"gsl_sf_airy_Bi_deriv_e" ((x :double) :mode (ret sf-result))
:documentation "The Airy function derivative Bi'(x).")
(defun-gsl airy-Ai-deriv-scaled (x)
(defmfun airy-Ai-deriv-scaled (x)
"gsl_sf_airy_Ai_deriv_scaled_e" ((x :double) :mode (ret sf-result))
:documentation "The scaled Airy function derivative S_A(x) Ai'(x).
For @math{x>0} the scaling factor @math{S_A(x)} is @math{\exp(+(2/3) x^(3/2))},
and is 1 for @math{x<0}.")
:documentation ; FDL
"The scaled Airy function derivative S_A(x) Ai'(x).
For x>0 the scaling factor S_A(x) is exp(+(2/3) x^(3/2)),
and is 1 for x<0.")
(defun-gsl airy-Bi-deriv-scaled (x)
(defmfun airy-Bi-deriv-scaled (x)
"gsl_sf_airy_Bi_deriv_scaled_e" ((x :double) :mode (ret sf-result))
:documentation "The scaled Airy function derivative S_B(x) Bi'(x).
For @math{x>0} the scaling factor @math{S_B(x)} is
@math{exp(-(2/3) x^(3/2))}, and is 1 for @math{x<0}.")
(defun-gsl airy-zero-Ai (s)
"gsl_sf_airy_zero_Ai_e" ((s :size) (ret sf-result))
:documentation "The location of the @var{s}-th zero of the Airy
function @math{Ai(x)}.")
(defun-gsl airy-zero-Bi (s)
"gsl_sf_airy_zero_Bi_e" ((s :size) (ret sf-result))
:documentation "The location of the @var{s}-th zero of the Airy
function @math{Bi(x)}.")
(defun-gsl airy-zero-Ai-deriv (s)
"gsl_sf_airy_zero_Ai_deriv_e" ((s :size) (ret sf-result))
:documentation "The location of the @var{s}-th zero of the Airy
function derivative @math{Ai'(x)}.")
(defun-gsl airy-zero-Bi-deriv (s)
"gsl_sf_airy_zero_Bi_deriv_e" ((s :size) (ret sf-result))
:documentation "The location of the @var{s}-th zero of the Airy
function derivative @math{Bi'(x)}.")
:documentation ; FDL
"The scaled Airy function derivative S_B(x) Bi'(x).
For x>0 the scaling factor S_B(x) is
exp(-(2/3) x^(3/2)), and is 1 for x<0.")
(defmfun airy-zero-Ai (s)
"gsl_sf_airy_zero_Ai_e" ((s size) (ret sf-result))
:documentation ; FDL
"The location of the s-th zero of the Airy function Ai(x).")
(defmfun airy-zero-Bi (s)
"gsl_sf_airy_zero_Bi_e" ((s size) (ret sf-result))
:documentation ; FDL
"The location of the s-th zero of the Airy function Bi(x).")
(defmfun airy-zero-Ai-deriv (s)
"gsl_sf_airy_zero_Ai_deriv_e" ((s size) (ret sf-result))
:documentation ; FDL
"The location of the s-th zero of the Airy function derivative Ai'(x).")
(defmfun airy-zero-Bi-deriv (s)
"gsl_sf_airy_zero_Bi_deriv_e" ((s size) (ret sf-result))
:documentation ; FDL
"The location of the s-th zero of the Airy function derivative Bi'(x).")
;;;;****************************************************************************
;;;; Examples and unit test
;;;;****************************************************************************
(lisp-unit:define-test airy
(lisp-unit:assert-first-fp-equal "0.157259233805d-01" (airy-ai 2.5d0))
(lisp-unit:assert-first-fp-equal "0.648166073846d+01" (airy-bi 2.5d0))
(lisp-unit:assert-first-fp-equal "0.219322205129d+00" (airy-ai-scaled 2.5d0))
(lisp-unit:assert-first-fp-equal "0.464750480196d+00" (airy-bi-scaled 2.5d0))
(lisp-unit:assert-first-fp-equal "-0.262508810359d-01" (airy-ai-deriv 2.5d0))
(lisp-unit:assert-first-fp-equal "0.942142331733d+01" (airy-bi-deriv 2.5d0))
(lisp-unit:assert-first-fp-equal "-0.366108938475d+00"
(airy-ai-deriv-scaled 2.5d0))
(lisp-unit:assert-first-fp-equal "0.675538444164d+00"
(airy-bi-deriv-scaled 2.5d0))
(lisp-unit:assert-first-fp-equal "-0.233810741046d+01" (airy-zero-ai 1))
(lisp-unit:assert-first-fp-equal "-0.117371322271d+01" (airy-zero-bi 1))
(lisp-unit:assert-first-fp-equal "-0.101879297165d+01" (airy-zero-ai-deriv 1))
(lisp-unit:assert-first-fp-equal "-0.229443968261d+01" (airy-zero-bi-deriv 1)))
#|
(make-tests airy
(airy-ai 2.5d0)
(airy-bi 2.5d0)
(airy-ai-scaled 2.5d0)
(airy-bi-scaled 2.5d0)
(airy-ai-deriv 2.5d0)
(airy-bi-deriv 2.5d0)
(airy-ai-deriv-scaled 2.5d0)
(airy-bi-deriv-scaled 2.5d0)
(airy-zero-ai 1)
(airy-zero-bi 1)
(airy-zero-ai-deriv 1)
(airy-zero-bi-deriv 1))
|#
(LISP-UNIT:DEFINE-TEST AIRY
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(0.01572592338047048d0 2.1573014423586447d-17)
(MULTIPLE-VALUE-LIST (AIRY-AI 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(6.48166073846058d0 8.77836191730236d-15)
(MULTIPLE-VALUE-LIST (AIRY-BI 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(0.21932220512871203d0 5.966864198455728d-17)
(MULTIPLE-VALUE-LIST (AIRY-AI-SCALED 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(0.4647504801960925d0 1.1831869152362144d-16)
(MULTIPLE-VALUE-LIST (AIRY-BI-SCALED 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(-0.02625088103590322d0 4.306971270221159d-17)
(MULTIPLE-VALUE-LIST (AIRY-AI-DERIV 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(9.421423317334305d0 1.5213125884867257d-14)
(MULTIPLE-VALUE-LIST (AIRY-BI-DERIV 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(-0.36610893847516224d0 1.167515239400716d-16)
(MULTIPLE-VALUE-LIST (AIRY-AI-DERIV-SCALED 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(0.6755384441644995d0 1.978922049880242d-16)
(MULTIPLE-VALUE-LIST (AIRY-BI-DERIV-SCALED 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(-2.338107410459767d0 5.19164136227827d-16)
(MULTIPLE-VALUE-LIST (AIRY-ZERO-AI 1)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(-1.173713222709128d0 2.606166888317336d-16)
(MULTIPLE-VALUE-LIST (AIRY-ZERO-BI 1)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(-1.018792971647471d0 2.2621748288986134d-16)
(MULTIPLE-VALUE-LIST (AIRY-ZERO-AI-DERIV 1)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
'(-2.294439682614123d0 5.094679528503672d-16)
(MULTIPLE-VALUE-LIST (AIRY-ZERO-BI-DERIV 1))))
#|
......
This diff is collapsed.
;********************************************************
; file: clausen.lisp
; description: Clausen function
; date: Sat Mar 18 2006 - 23:18
; author: Liam M. Healy
; modified: Sun Jun 11 2006 - 21:03
;********************************************************
;;; $Id:$
;; Clausen function
;; Liam Healy, Sat Mar 18 2006 - 23:18
;; Time-stamp: <2008-02-16 19:20:29EST clausen.lisp>
;; $Id: $
(in-package :gsl)
(defun-gsl clausen (x)
(defmfun clausen (x)
"gsl_sf_clausen_e" ((x :double) (ret sf-result))
:documentation
"The Clausen integral @math{Cl_2(x)}.")
:documentation ; FDL
"The Clausen integral Cl_2(x).")
(lisp-unit:define-test clausen
(lisp-unit:assert-first-fp-equal "0.433598203236d+00" (clausen 2.5d0)))
#|
(make-tests clausen
(clausen 2.5d0))
|#
(LISP-UNIT:DEFINE-TEST CLAUSEN
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.4335982032355329d0 1.2032502825912828d-15)
(MULTIPLE-VALUE-LIST (CLAUSEN 2.5d0))))
;; Coulumb functions
;; Liam Healy, Sat Mar 18 2006 - 23:23
;; Time-stamp: <2008-02-03 19:18:56EST coulomb.lisp>
;; Time-stamp: <2008-02-16 19:57:49EST coulomb.lisp>
;; $Id: $
(in-package :gsl)
......@@ -42,8 +42,8 @@
(err F) (err Fp) (err G) (err Gp))
:documentation ; FDL
"The Coulomb wave functions F_L(\eta,x),
G_@{L-k@}(\eta,x) and their derivatives F'_L(\eta,x),
G'_@{L-k@}(\eta,x) with respect to x. The parameters are restricted to
G_{L-k}(\eta,x) and their derivatives F'_L(\eta,x),
G'_{L-k}(\eta,x) with respect to x. The parameters are restricted to
L, L-k > -1/2}, x > 0 and integer k. Note that L
itself is not restricted to being an integer. The results are stored in
the parameters F, G for the function values and Fp,
......@@ -127,44 +127,83 @@
;;;; Examples and unit test
;;;;****************************************************************************
(lisp-unit:define-test coulomb
(lisp-unit:assert-first-fp-equal
"0.164169997248d+00"
(hydrogenicr-1 1.0d0 2.5d0))
(lisp-unit:assert-first-fp-equal
"0.766646808415d-01"
(hydrogenicr 3 1 1.0d0 2.5d0))
(lisp-unit:assert-equal
'("0.620350520114d-01" "0.177098574917d+00" "0.360501756616d+01"
"-0.582826184164d+01" "0.000000000000d+01" "0.000000000000d+01")
(lisp-unit:fp-sequence
(subseq (multiple-value-list (coulomb-wave-FG 0.0d0 1.0d0 2.0d0 0)) 0 6)))
(lisp-unit:assert-equal
'("0.661781613833d+00" "0.361412857745d+00" "0.132677576099d+00")
(lisp-unit:fp-sequence
(letm ((arr (vector-double 3)))
(coulomb-wave-F-array 0.0d0 1.0d0 2.0d0 arr)
(data arr))))
(lisp-unit:assert-first-fp-equal
"0.716177996747d-01"
(coulomb-wave-fg 1.0d0 2.0d0 2.5d0 1))
(lisp-unit:assert-equal
'("0.350215846039d-01" "0.575250061420d-02" "0.711695560198d-03"
"0.647172649613d+01" "0.275745747216d+02" "0.170560372931d+03")
(lisp-unit:fp-sequence
(letm ((Farr (vector-double 3)) (Garr (vector-double 3)))
(coulomb-wave-FG-array 1.5d0 1.0d0 1.0d0 Farr Garr)
(append (coerce (data Farr) 'list) (coerce (data Garr) 'list)))))
(lisp-unit:assert-equal
'("0.330890806916d+00" "0.180706428873d+00" "0.663387880496d-01")
(lisp-unit:fp-sequence
(letm ((arr (vector-double 3)))
(coulomb-wave-sphF-array 0.0d0 1.0d0 2.0d0 arr) (data arr))))
(lisp-unit:assert-first-fp-equal
"0.138091464419d-02"
(coulomb-cl 1.0d0 2.5d0))
(lisp-unit:assert-equal
'("0.108422513102d+00" "0.511108628318d-01" "0.114287363681d-01")
(lisp-unit:fp-sequence
(letm ((cl (vector-double 3)))
(coulomb-CL-array 0.0d0 1.0d0 cl) (data cl)))))
#|
(make-tests coulomb
(hydrogenicr-1 1.0d0 2.5d0)
(hydrogenicr 3 1 1.0d0 2.5d0)
(coulomb-wave-FG 0.0d0 1.0d0 2.0d0 0)
(letm ((arr (vector-double 3)))
(coulomb-wave-F-array 0.0d0 1.0d0 2.0d0 arr)
(data arr))
(coulomb-wave-fg 1.0d0 2.0d0 2.5d0 1)
(letm ((Farr (vector-double 3)) (Garr (vector-double 3)))
(coulomb-wave-FG-array 1.5d0 1.0d0 1.0d0 Farr Garr)
(append (coerce (data Farr) 'list) (coerce (data Garr) 'list)))
(letm ((arr (vector-double 3)))
(coulomb-wave-sphF-array 0.0d0 1.0d0 2.0d0 arr) (data arr))
(coulomb-cl 1.0d0 2.5d0)
(letm ((cl (vector-double 3)))
(coulomb-CL-array 0.0d0 1.0d0 cl) (data cl)))
|#
(LISP-UNIT:DEFINE-TEST COULOMB
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.1641699972477976d0 1.8226531089715347d-16)
(MULTIPLE-VALUE-LIST (HYDROGENICR-1 1.0d0 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.07666468084146327d0 4.203054519905891d-16)
(MULTIPLE-VALUE-LIST (HYDROGENICR 3 1 1.0d0 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.06203505201137388d0 0.17709857491700906d0
3.6050175661599693d0 -5.8282618416439025d0 0.0d0
0.0d0 4.3793707124032857d-16
1.2502291640824433d-15 3.5328525523867457d-14
5.711592064490999d-14)
(MULTIPLE-VALUE-LIST
(COULOMB-WAVE-FG 0.0d0 1.0d0 2.0d0 0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#(0.6617816138326813d0 0.3614128577450535d0
0.13267757609917497d0))
(MULTIPLE-VALUE-LIST
(LETM ((ARR (VECTOR-DOUBLE 3)))
(COULOMB-WAVE-F-ARRAY 0.0d0 1.0d0 2.0d0 ARR)
(DATA ARR))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.07161779967468254d0 0.1278101031568499d0
2.2510703464871114d0 -1.4245543587641651d0 0.0d0
0.0d0 8.269219937869759d-15
1.4757362807662922d-14 2.5991577338697564d-13
1.644835970887306d-13)
(MULTIPLE-VALUE-LIST
(COULOMB-WAVE-FG 1.0d0 2.0d0 2.5d0 1)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
(LIST 0.035021584603913254d0 0.005752500614202263d0
7.116955601984411d-4 6.471726496134135d0
27.57457472159366d0 170.56037293106908d0))
(MULTIPLE-VALUE-LIST
(LETM
((FARR (VECTOR-DOUBLE 3)) (GARR (VECTOR-DOUBLE 3)))
(COULOMB-WAVE-FG-ARRAY 1.5d0 1.0d0 1.0d0 FARR GARR)
(APPEND (COERCE (DATA FARR) 'LIST)
(COERCE (DATA GARR) 'LIST)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#(0.33089080691634065d0 0.18070642887252675d0
0.06633878804958748d0))
(MULTIPLE-VALUE-LIST
(LETM ((ARR (VECTOR-DOUBLE 3)))
(COULOMB-WAVE-SPHF-ARRAY 0.0d0 1.0d0 2.0d0 ARR)
(DATA ARR))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.0013809146441856027d0 2.759621819430441d-17)
(MULTIPLE-VALUE-LIST (COULOMB-CL 1.0d0 2.5d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#(0.10842251310207264d0 0.05111086283184191d0
0.011428736368066591d0))
(MULTIPLE-VALUE-LIST
(LETM ((CL (VECTOR-DOUBLE 3)))
(COULOMB-CL-ARRAY 0.0d0 1.0d0 CL) (DATA CL)))))
;********************************************************
; file: coupling.lisp