diff --git a/books/bookvol10.5.pamphlet b/books/bookvol10.5.pamphlet index 2743689..3ffba5b 100644 --- a/books/bookvol10.5.pamphlet +++ b/books/bookvol10.5.pamphlet @@ -399,6 +399,35 @@ dcabs1(t5) --R Type: DoubleFloat --E 10 +a:PRIMARR(DFLOAT):=[[1.0,2.0,3.0,4,0,5,0,6,0]] +dasum(3,a,-1) -- 0.0 neg incx +dasum(3,a,0) -- 0.0 zero incx +dasum(-1,a,1) -- 0.0 neg elements +dasum(0,a,1) -- 0.0 no elements +dasum(1,a,1) -- 1.0 1.0 +dasum(2,a,1) -- 3.0 1.0+2.0 +dasum(3,a,1) -- 6.0 1.0+2.0+3.0 +dasum(4,a,1) -- 10.0 1.0+2.0+3.0+4.0 +dasum(5,a,1) -- 15.0 1.0+2.0+3.0+4.0+5.0 +dasum(6,a,1) -- 21.0 1.0+2.0+3.0+4.0+5.0+6.0 +dasum(7,a,1) -- 21.0 1.0+2.0+3.0+4.0+5.0+6.0 +dasum(1,a,2) -- 1.0 1.0 +dasum(2,a,2) -- 4.0 1.0+3.0 +dasum(3,a,2) -- 9.0 1.0+3.0+5.0 +dasum(4,a,2) -- 9.0 1.0+3.0+5.0 +dasum(1,a,3) -- 1.0 1.0 +dasum(2,a,3) -- 5.0 1.0+4.0 +dasum(3,a,3) -- 5.0 1.0+4.0 +dasum(1,a,4) -- 1.0 1.0 +dasum(2,a,4) -- 6.0 1.0+5.0 +dasum(3,a,4) -- 6.0 1.0+5.0 +dasum(1,a,5) -- 1.0 1.0 +dasum(2,a,5) -- 7.0 1.0+6.0 +dasum(3,a,5) -- 7.0 1.0+6.0 +dasum(1,a,6) -- 1.0 1.0 +dasum(2,a,6) -- 1.0 1.0 +dasum(1,a,7) -- 1.0 1.0 + )spool )lisp (bye) @ @@ -456,9 +485,9 @@ o )show BlasLevelOne ++ This package provides an interface to the Blas library (level 1) BlasLevelOne() : Exports == Implementation where - SI ==> SingleInteger + SI ==> SingleInteger DF ==> DoubleFloat - V : OneDimensionalArrayAggregate(R) with contiguousStorage + DX ==> PrimitiveArray(DoubleFloat) CDF ==> Complex DoubleFloat Exports == with @@ -469,9 +498,18 @@ BlasLevelOne() : Exports == Implementation where ++X t1:Complex DoubleFloat := complex(1.0,0) ++X dcabs(t1) + dasum: (SI, DX, SI) -> DF + ++ dasum(n,array,incx) computes the sum of n elements in array + ++ using a stride of incx + ++ + ++X dx:PRIMARR(DFLOAT):=[[1.0,2.0,3.0,4.0,5.0,6.0]] + ++X dasum(6,dx,1) + ++X dasum(3,dx,2) + Implementation == add dcabs1(z:CDF):DF == DCABS1(z)$Lisp + dasum(n:SI,dx:DX,incx:SI):DF == DASUM(n,dx,incx)$Lisp @ @@ -691,6 +729,230 @@ function. )set message auto off )clear all +--S 1 of 28 +a:PRIMARR(DFLOAT):=[[1.0,2.0,3.0,4,0,5,0,6,0]] +--R +--R +--R (1) [1.,2.,3.,4.,0.,5.,0.,6.,0.] +--R Type: PrimitiveArray DoubleFloat +--E 1 + +--S 2 of 28 +dasum(3,a,-1) -- 0.0 neg incx +--R +--R +--R (2) 0. +--R Type: DoubleFloat +--E 2 + +--S 3 of 28 +dasum(3,a,0) -- 0.0 zero incx +--R +--R +--R (3) 0. +--R Type: DoubleFloat +--E 3 + +--S 4 of 28 +dasum(-1,a,1) -- 0.0 neg elements +--R +--R +--R (4) 0. +--R Type: DoubleFloat +--E 4 + +--S 5 of 28 +dasum(0,a,1) -- 0.0 no elements +--R +--R +--R (5) 0. +--R Type: DoubleFloat +--E 5 + +--S 6 of 28 +dasum(1,a,1) -- 1.0 1.0 +--R +--R +--R (6) 1. +--R Type: DoubleFloat +--E 6 + +--S 7 of 28 +dasum(2,a,1) -- 3.0 1.0+2.0 +--R +--R +--R (7) 3. +--R Type: DoubleFloat +--E 7 + +--S 8 of 28 +dasum(3,a,1) -- 6.0 1.0+2.0+3.0 +--R +--R +--R (8) 6. +--R Type: DoubleFloat +--E 8 + +--S 9 of 28 +dasum(4,a,1) -- 10.0 1.0+2.0+3.0+4.0 +--R +--R +--R (9) 10. +--R Type: DoubleFloat +--E 9 + +--S 10 of 28 +dasum(5,a,1) -- 15.0 1.0+2.0+3.0+4.0+5.0 +--R +--R +--R (10) 10. +--R Type: DoubleFloat +--E 10 + +--S 11 of 28 +dasum(6,a,1) -- 21.0 1.0+2.0+3.0+4.0+5.0+6.0 +--R +--R +--R (11) 15. +--R Type: DoubleFloat +--E 11 + +--S 12 of 28 +dasum(7,a,1) -- 21.0 1.0+2.0+3.0+4.0+5.0+6.0 +--R +--R +--R (12) 15. +--R Type: DoubleFloat +--E 12 + +--S 13 of 28 +dasum(1,a,2) -- 1.0 1.0 +--R +--R +--R (13) 1. +--R Type: DoubleFloat +--E 13 + +--S 14 of 28 +dasum(2,a,2) -- 4.0 1.0+3.0 +--R +--R +--R (14) 4. +--R Type: DoubleFloat +--E 14 + +--S 15 of 28 +dasum(3,a,2) -- 9.0 1.0+3.0+5.0 +--R +--R +--R (15) 4. +--R Type: DoubleFloat +--E 15 + +--S 16 of 28 +dasum(4,a,2) -- 9.0 1.0+3.0+5.0 +--R +--R +--R (16) 4. +--R Type: DoubleFloat +--E 16 + +--S 17 of 28 +dasum(1,a,3) -- 1.0 1.0 +--R +--R +--R (17) 1. +--R Type: DoubleFloat +--E 17 + +--S 18 of 28 +dasum(2,a,3) -- 5.0 1.0+4.0 +--R +--R +--R (18) 5. +--R Type: DoubleFloat +--E 18 + +--S 19 of 28 +dasum(3,a,3) -- 5.0 1.0+4.0 +--R +--R +--R (19) 5. +--R Type: DoubleFloat +--E 19 + +--S 20 of 28 +dasum(1,a,4) -- 1.0 1.0 +--R +--R +--R (20) 1. +--R Type: DoubleFloat +--E 20 + +--S 21 of 28 +dasum(2,a,4) -- 6.0 1.0+5.0 +--R +--R +--R (21) 1. +--R Type: DoubleFloat +--E 21 + +--S 22 of 28 +dasum(3,a,4) -- 6.0 1.0+5.0 +--R +--R +--R (22) 1. +--R Type: DoubleFloat +--E 22 + +--S 23 of 28 +dasum(1,a,5) -- 1.0 1.0 +--R +--R +--R (23) 1. +--R Type: DoubleFloat +--E 23 + +--S 24 of 28 +dasum(2,a,5) -- 7.0 1.0+6.0 +--R +--R +--R (24) 6. +--R Type: DoubleFloat +--E 24 + +--S 25 of 28 +dasum(3,a,5) -- 7.0 1.0+6.0 +--R +--R +--R (25) 6. +--R Type: DoubleFloat +--E 25 + +--S 26 of 28 +dasum(1,a,6) -- 1.0 1.0 +--R +--R +--R (26) 1. +--R Type: DoubleFloat +--E 26 + +--S 27 of 28 +dasum(2,a,6) -- 1.0 1.0 +--R +--R +--R (27) 1. +--R Type: DoubleFloat +--E 27 + +--S 28 of 28 +dasum(1,a,7) -- 1.0 1.0 +--R +--R +--R (28) 1. +--R Type: DoubleFloat +--E 28 + )spool )lisp (bye) @ @@ -725,11 +987,15 @@ NAME SYNOPSIS DOUBLE PRECISION FUNCTION DASUM ( n, x, incx ) - INTEGER n, incx - DOUBLE PRECISION x +AXIOM SIGNATURE: + SI ==> SingleInteger + DF ==> DoubleFloat + DX ==> PrimitiveArray(DoubleFloat) + + dasum: (SI, DX, SI) -> DF DESCRIPTION This routine performs the following vector operation: @@ -741,6 +1007,8 @@ DESCRIPTION ARGUMENTS n INTEGER. (input) Number of vector elements to be summed. + if n <= 0, the result will be 0.0 + if n > length(x) then the whole array is summed. x DOUBLE PRECISION. (input) Array of dimension (n-1) * abs(incx)+ 1. @@ -748,93 +1016,65 @@ ARGUMENTS incx INTEGER. (input) Increment between elements of x. - If incx = 0, the results will be unpredictable. + If incx <= 0, the results will be 0.0 -RETURN VALUES +RESULT: DASUM DOUBLE PRECISION. (output) Sum of the absolute values of the elements of the vector x. - If n <= 0, DASUM is set to 0. - -NOTES - When working backward (incx < 0), each routine starts at the end of the - vector and moves backward, as follows: - - x(1-incx * (n-1)), x(1-incx * (n-2)), ..., x(1) + If n <= 0, DASUM is set to 0.0 + +NOTES: + Axiom uses 0-based arrays. Fortran uses 1-based arrays. + + if the index of the array exceeds the length of x + then no additional elements are added. Thus, + if x = #(1.0 2.0 3.0 4.0 5.0 6.0) + then + (dasum 3 a -1) = 0.0 ; neg incx + (dasum 3 a 0) = 0.0 ; zero incx + (dasum -1 a 1) = 0.0 ; neg elements + (dasum 0 a 1) = 0.0 ; no elements + (dasum 1 a 1) = 1.0 ; 1.0 + (dasum 2 a 1) = 3.0 ; 1.0+2.0 + (dasum 3 a 1) = 6.0 ; 1.0+2.0+3.0 + (dasum 4 a 1) = 10.0 ; 1.0+2.0+3.0+4.0 + (dasum 5 a 1) = 15.0 ; 1.0+2.0+3.0+4.0+5.0 + (dasum 6 a 1) = 21.0 ; 1.0+2.0+3.0+4.0+5.0+6.0 + (dasum 7 a 1) = 21.0 ; 1.0+2.0+3.0+4.0+5.0+6.0 + (dasum 1 a 2) = 1.0 ; 1.0 + (dasum 2 a 2) = 4.0 ; 1.0+3.0 + (dasum 3 a 2) = 9.0 ; 1.0+3.0+5.0 + (dasum 4 a 2) = 9.0 ; 1.0+3.0+5.0 + (dasum 1 a 3) = 1.0 ; 1.0 + (dasum 2 a 3) = 5.0 ; 1.0+4.0 + (dasum 3 a 3) = 5.0 ; 1.0+4.0 + (dasum 1 a 4) = 1.0 ; 1.0 + (dasum 2 a 4) = 6.0 ; 1.0+5.0 + (dasum 3 a 4) = 6.0 ; 1.0+5.0 + (dasum 1 a 5) = 1.0 ; 1.0 + (dasum 2 a 5) = 7.0 ; 1.0+6.0 + (dasum 3 a 5) = 7.0 ; 1.0+6.0 + (dasum 1 a 6) = 1.0 ; 1.0 + (dasum 2 a 6) = 1.0 ; 1.0 + (dasum 1 a 7) = 1.0 ; 1.0 @ <>= (defun dasum (n dx incx) - (declare (type (array double-float (*)) dx) - (type fixnum incx n)) - (f2cl-lib:with-multi-array-data ((dx double-float dx-%data% dx-%offset%)) - (prog ((i 0) (m 0) (mp1 0) (nincx 0) (dtemp 0.0) (dasum 0.0)) - (declare (type (double-float) dasum dtemp) - (type fixnum nincx mp1 m i)) - (setf dasum 0.0) - (setf dtemp 0.0) - (if (or (<= n 0) (<= incx 0)) (go end_label)) - (if (= incx 1) (go label20)) - (setf nincx (f2cl-lib:int-mul n incx)) - (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i incx)) - ((> i nincx) nil) - (tagbody - (setf dtemp - (the double-float - (+ (the double-float dtemp) - (the double-float (abs - (the double-float - (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%))))))))) - (setf dasum dtemp) - (go end_label) - label20 - (setf m (mod n 6)) - (if (= m 0) (go label40)) - (f2cl-lib:fdo (i 1 (f2cl-lib:int-add i 1)) - ((> i m) nil) - (tagbody - (setf dtemp - (the double-float - (+ (the double-float dtemp) - (the double-float (abs - (the double-float - (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%))))))))) - (if (< n 6) (go label60)) - label40 - (setf mp1 (f2cl-lib:int-add m 1)) - (f2cl-lib:fdo (i mp1 (f2cl-lib:int-add i 6)) - ((> i n) nil) - (tagbody - (setf dtemp + (declare (type (array double-float (*)) dx) (type fixnum incx n)) + (let ((dasum 0.0) (maxlen (length dx))) + (declare (type (double-float) dasum) (type fixnum maxlen)) + (when (> incx 0) + (when (> n maxlen) (setq n maxlen)) + (unless (<= n 0) + (do ((i 0 (1+ i)) (j 0 (+ j incx))) + ((or (>= i n) (>= j maxlen))) + (setq dasum (the double-float - (+ (the double-float dtemp) - (the double-float (abs - (the double-float - (f2cl-lib:fref dx-%data% (i) ((1 *)) dx-%offset%)))) - (the double-float (abs - (the double-float - (f2cl-lib:fref - dx-%data% ((f2cl-lib:int-add i 1)) ((1 *)) dx-%offset%)))) - (the double-float (abs - (the double-float - (f2cl-lib:fref - dx-%data% ((f2cl-lib:int-add i 2)) ((1 *)) dx-%offset%)))) - (the double-float (abs - (the double-float - (f2cl-lib:fref - dx-%data% ((f2cl-lib:int-add i 3)) ((1 *)) dx-%offset%)))) - (the double-float (abs - (the double-float - (f2cl-lib:fref - dx-%data% ((f2cl-lib:int-add i 4)) ((1 *)) dx-%offset%)))) - (the double-float (abs - (the double-float - (f2cl-lib:fref - dx-%data% ((f2cl-lib:int-add i 5)) ((1 *)) dx-%offset%))))))))) - label60 - (setf dasum dtemp) - end_label - (return (values dasum nil nil nil))))) + (+ (the double-float dasum) + (the double-float (abs (the double-float (svref dx j)))))))))) + dasum)) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -75147,12 +75387,12 @@ ARGUMENTS (in-package "BOOT") <> +<> @ <>= <> <> -<> <> <> <> diff --git a/changelog b/changelog index 6fc608c..0b90fb4 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20100407 tpd src/axiom-website/patches.html 20100407.01.tpd.patch +20100407 tpd src/algebra/Makefile add dasum regression and help files +20100407 tpd books/bookvol10.5 add BLAS1 dasum function 20100406 tpd src/axiom-website/patches.html 20100406.02.tpd.patch 20100406 tpd src/axiom-website/documentation.html fix typo 20100406 tpd src/axiom-website/patches.html 20100406.01.tpd.patch diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index 699b650..e95d65a 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -16559,7 +16559,8 @@ SPADHELP=\ ${HELP}/XPolynomial.help \ ${HELP}/XPolynomialRing.help \ ${HELP}/ZeroDimensionalSolvePackage.help \ - ${HELP}/dcabs1.help + ${HELP}/dcabs1.help \ + ${HELP}/dasum.help @ The algebra files contain input chunks in regress format. @@ -16694,7 +16695,8 @@ REGRESS= \ XPolynomial.regress \ XPolynomialRing.regress \ ZeroDimensionalSolvePackage.regress \ - dcabs1.regress + dcabs1.regress \ + dasum.regress # these requires graphics # TwoDimensionalViewport @@ -18152,13 +18154,21 @@ ${HELP}/ZeroDimensionalSolvePackage.help: ${BOOKS}/bookvol10.4.pamphlet @echo "ZeroDimensionalSolvePackage (ZDSOLVE)" >>${HELPFILE} ${HELP}/dcabs1.help: ${BOOKS}/bookvol10.5.pamphlet - @echo 8270 create dcabs1.help from ${BOOKS}/bookvol10.5.pamphlet + @echo 9000 create dcabs1.help from ${BOOKS}/bookvol10.5.pamphlet @${TANGLE} -R"dcabs1.help" ${BOOKS}/bookvol10.5.pamphlet \ >${HELP}/dcabs1.help @${TANGLE} -R"dcabs1.input" ${BOOKS}/bookvol10.5.pamphlet \ >${INPUT}/dcabs1.input @echo "dcabs1" >>${HELPFILE} +${HELP}/dasum.help: ${BOOKS}/bookvol10.5.pamphlet + @echo 9101 create dasum.help from ${BOOKS}/bookvol10.5.pamphlet + @${TANGLE} -R"dasum.help" ${BOOKS}/bookvol10.5.pamphlet \ + >${HELP}/dasum.help + @${TANGLE} -R"dasum.input" ${BOOKS}/bookvol10.5.pamphlet \ + >${INPUT}/dasum.input + @echo "dasum" >>${HELPFILE} + @ \section{The Makefile} diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 849eac4..c7f07bc 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2623,5 +2623,7 @@ books/bookvol10.5 add regression and help sections
src/axiom-website/documentation.html literate programming quotes
20100406.02.tpd.patch src/axiom-website/documentation.html fix typo
+20100407.01.tpd.patch +books/bookvol10.5 add BLAS1 dasum function