diff --git a/changelog b/changelog index 188e4d3..d497ed9 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090901 tpd src/axiom-website/patches.html 20090901.06.tpd.patch +20090901 tpd src/interp/Makefile move nag-f07.boot to nag-f07.lisp +20090901 tpd src/interp/nag-f07.lisp added, rewritten from nag-f07.boot +20090901 tpd src/interp/nag-f07.boot removed, rewritten to nag-f07.lisp 20090901 tpd src/axiom-website/patches.html 20090901.05.tpd.patch 20090901 tpd src/interp/Makefile move nag-f04.boot to nag-f04.lisp 20090901 tpd src/interp/nag-f04.lisp added, rewritten from nag-f04.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index f8798c5..e917c63 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1968,5 +1968,7 @@ src/interp/nag-f01.lisp rewrite from boot to lisp
src/interp/nag-f02.lisp rewrite from boot to lisp
20090901.05.tpd.patch src/interp/nag-f04.lisp rewrite from boot to lisp
+20090901.06.tpd.patch +src/interp/nag-f07.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 16ff34a..1969ca5 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -1700,41 +1700,32 @@ ${MID}/nag-f04.lisp: ${IN}/nag-f04.lisp.pamphlet @ -\subsection{nag-f07.boot \cite{56}} +\subsection{nag-f07.lisp} <>= ${AUTO}/nag-f07.${O}: ${OUT}/nag-f07.${O} - @ echo 202 making ${AUTO}/nag-f07.${O} from ${OUT}/nag-f07.${O} + @ echo 154 making ${AUTO}/nag-f07.${O} from ${OUT}/nag-f07.${O} @ cp ${OUT}/nag-f07.${O} ${AUTO} @ <>= -${OUT}/nag-f07.${O}: ${MID}/nag-f07.clisp - @ echo 203 making ${OUT}/nag-f07.${O} from ${MID}/nag-f07.clisp - @ (cd ${MID} ; \ +${OUT}/nag-f07.${O}: ${MID}/nag-f07.lisp + @ echo 136 making ${OUT}/nag-f07.${O} from ${MID}/nag-f07.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/nag-f07.clisp"' \ + echo '(progn (compile-file "${MID}/nag-f07.lisp"' \ ':output-file "${OUT}/nag-f07.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/nag-f07.clisp"' \ + echo '(progn (compile-file "${MID}/nag-f07.lisp"' \ ':output-file "${OUT}/nag-f07.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/nag-f07.clisp: ${IN}/nag-f07.boot.pamphlet - @ echo 204 making ${MID}/nag-f07.clisp from ${IN}/nag-f07.boot.pamphlet +<>= +${MID}/nag-f07.lisp: ${IN}/nag-f07.lisp.pamphlet + @ echo 137 making ${MID}/nag-f07.lisp from ${IN}/nag-f07.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/nag-f07.boot.pamphlet >nag-f07.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-f07.boot") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-f07.boot") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ; \ - rm nag-f07.boot ) + ${TANGLE} ${IN}/nag-f07.lisp.pamphlet >nag-f07.lisp ) @ @@ -4658,7 +4649,7 @@ clean: <> <> -<> +<> <> <> diff --git a/src/interp/nag-f07.boot.pamphlet b/src/interp/nag-f07.boot.pamphlet deleted file mode 100644 index f72903c..0000000 --- a/src/interp/nag-f07.boot.pamphlet +++ /dev/null @@ -1,726 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-f07.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -f07adf() == - htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf07adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07adf| '|NagLapack|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F07ADF computes the {\it LU} factorization of a real {\it m}") - (text . " by {\it n} matrix ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of rows {\it m}:") - (text . "\newline\tab{2} ") - (bcStrings (5 4 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of columns {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 4 n PI)) - ) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of array A, {\it lda}:") --- (text . "\newline\tab{2} ") --- (bcStrings (5 4 lda PI)) - htMakeDoneButton('"Continue", 'f07adfSolve) - htShowPage() - -f07adfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m - (n = '4 and m = '4) => f07adfDefaultSolve(htPage,lda) - aList := - "append"/[fa(i,n) for i in 1..m] where fa(i,n) == - labelList := - "append"/[fb(i,j) for j in 1..n] where fb(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :aList] - page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the array {\it A}:" - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'f07adfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07adfDefaultSolve (htPage,lda) == - n := '4 - m := '4 - page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the array {\it A}:") - (text . "\newline ") - (bcStrings (5 "1.8" a11 F)) - (bcStrings (5 "2.88" a12 F)) - (bcStrings (5 "2.05" a13 F)) - (bcStrings (5 "-0.89" a14 F)) - (text . "\newline ") - (bcStrings (5 "5.25" a21 F)) - (bcStrings (5 "-2.95" a22 F)) - (bcStrings (5 "-0.95" a23 F)) - (bcStrings (5 "-3.8" a24 F)) - (text . "\newline ") - (bcStrings (5 "1.58" a31 F)) - (bcStrings (5 "-2.69" a32 F)) - (bcStrings (5 "-2.9" a33 F)) - (bcStrings (5 "-1.04" a34 F)) - (text . "\newline ") - (bcStrings (5 "-1.11" a41 F)) - (bcStrings (5 "-0.66" a42 F)) - (bcStrings (5 "-0.59" a43 F)) - (bcStrings (5 "0.8" a44 F))) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) - htMakeDoneButton('"Continue",'f07adfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07adfGen htPage == - n := htpProperty(htPage, 'n) - m := htpProperty(htPage, 'm) - lda := m - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - for j in 1..m repeat - a := STRCONC((first y).1," ") - rowList := [a,:rowList] - y := rest y - aList := [rowList,:aList] - rowList := [] - astring := bcwords2liststring [bcwords2liststring x for x in aList] - prefix := STRCONC("f07adf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")") - linkGen prefix - - -f07aef() == - htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf07aef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07aef| '|NagLapack|)} for this routine") - (text . "\newline \horizontalline ") - (text . "F07AEF solves a real system of linear equations with multiple right-hand sides, {\it AX=B} or ") - (text . "\htbitmap{atxequalb} , where {\it a} has been factorized by F07ADF ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Form of the equations:") - (text . "\blankline ") - (radioButtons trans - ("" " N, the equations are {\it AX=B}" norm) - ("" " T, the equations are \htbitmap{atxequalb}" transp)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The order {\it n} of {\it A}: ") - (text . "\newline ") - (bcStrings (5 4 n PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "The order {\it m} of {\it A} used by F07AEF: ") --- (text . "\newline ") --- (bcStrings (5 4 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The number of right-hand sides, {\it nrhs}: ") - (text . "\newline ") - (bcStrings (5 2 nrhs PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it A}, {\it lda}: ") --- (text . "\newline ") --- (bcStrings (5 4 lda PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it B}, {\it ldb}: ") --- (text . "\newline ") --- (bcStrings (5 4 ldb PI)) - ) - htMakeDoneButton('"Continue", 'f07aefSolve) - htShowPage() - -f07aefSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) --- m := --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) --- objValUnwrap htpLabelSpadValue(htPage, 'm) - nrhs := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs) - objValUnwrap htpLabelSpadValue(htPage, 'nrhs) - lda := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - equa := htpButtonValue(htPage, 'trans) - trans := - equa = 'norm => '"N" - '"T" - (n = '4 and nrhs = '2 ) => f07aefDefaultSolve (htPage,trans) - aList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[faa(i,j) for j in 1..n] where faa(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings, [6, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - ipList := - [fp(i) for i in 1..n] where fp(i) == - ipnam := INTERN STRCONC ('"ip",STRINGIMAGE i) - ['bcStrings,[5, 0, ipnam, 'I]] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the pivot ") - middle := STRCONC(middle,'"indices {\it IPIV} from F07ADF: ") - middle := STRCONC(middle,'"\newline ") - ipList := [['text,:middle],:ipList] - bList := - "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) == - labelList := - "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings, [6, 0, bnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))) - ,:aList,:ipList,:bList] - page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the matrix {\it A}:" - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'f07aefGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'m,m) - htpSetProperty(page,'nrhs,nrhs) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07aefDefaultSolve (htPage,trans) == - n := '4 - nrhs := '2 - lda := '4 - ldb := '4 - length := '4 - page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it A}:") - (text . "\newline ") - (bcStrings (5 "5.25" a11 F)) - (bcStrings (5 "-2.95" a12 F)) - (bcStrings (5 "-0.95" a13 F)) - (bcStrings (5 "-3.8" a14 F)) - (text . "\newline ") - (bcStrings (5 "0.34" a21 F)) - (bcStrings (5 "3.89" a22 F)) - (bcStrings (5 "2.38" a23 F)) - (bcStrings (5 "0.41" a24 F)) - (text . "\newline ") - (bcStrings (5 "0.3" a31 F)) - (bcStrings (5 "-0.46" a32 F)) - (bcStrings (5 "-1.51" a33 F)) - (bcStrings (5 "0.29" a34 F)) - (text . "\newline ") - (bcStrings (5 "-0.21" a41 F)) - (bcStrings (5 "-0.33" a42 F)) - (bcStrings (5 "0.00" a43 F)) - (bcStrings (5 "0.13" a44 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the pivot indices {\it IPIV} from F07ADF: ") - (text . "\newline ") - (bcStrings (5 2 ip1 PI)) - (bcStrings (5 2 ip2 PI)) - (bcStrings (5 3 ip3 PI)) - (bcStrings (5 4 ip4 PI)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it B}:") - (text . "\newline ") - (bcStrings (5 "9.52" b11 F)) - (bcStrings (5 "18.47" b12 F)) - (text . "\newline ") - (bcStrings (5 "24.35" b21 F)) - (bcStrings (5 "2.25" b22 F)) - (text . "\newline ") - (bcStrings (5 "0.77" b31 F)) - (bcStrings (5 "-13.28" b32 F)) - (text . "\newline ") - (bcStrings (5 "-6.22" b41 F)) - (bcStrings (5 "-6.21" b42 F))) - htpSetProperty(page,'trans,trans) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nrhs,nrhs) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'length,length) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htMakeDoneButton('"Continue",'f07aefGen) - htShowPage() - -f07aefGen htPage == - n := htpProperty(htPage, 'n) - nrhs := htpProperty(htPage, 'nrhs) --- lda := htpProperty(htPage, 'lda) --- ldb := htpProperty(htPage, 'ldb) - lda := n - ldb := n - length := htpProperty(htPage, 'length) - trans := htpProperty(htPage,'trans) - aplist := htpInputAreaAlist htPage - y := aplist - for i in 1..n repeat - for j in 1..nrhs repeat - b := STRCONC((first y).1," ") - rowList := [b,:rowList] - y := rest y - bList := [rowList,:bList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bList] - for i in 1..length repeat - ip := STRCONC((first y).1," ") - ipList := [ip,:ipList] - y := rest y - ipstring := bcwords2liststring ipList - for i in 1..lda repeat - for j in 1..n repeat - a := STRCONC((first y).1," ") - rowList := [a,:rowList] - y := rest y - aList := [rowList,:aList] - rowList := [] - astring := bcwords2liststring [bcwords2liststring x for x in aList] - prefix := STRCONC("f07aef(_"", trans,"_", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", [",ipstring,"]::Matrix INT, ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)") - linkGen prefix - -f07fdf() == - htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf07fdf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fdf| '|NagLapack|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F07FDF computes the Cholesky factorization of a real symmetric positive-definite ") - (text . "matrix {\it A} ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Method of factorization of {\it A}, {\it UPLO}:") - (text . "\blankline ") - (radioButtons uplo - ("" " L, {\it A} factorized as lower triangular" lower) - ("" " U, {\it A} factorized as upper triangular" upper)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The order {\it n} of {\it A}: ") - (text . "\newline ") - (bcStrings (5 4 n PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it A}, {\it lda}:") --- (text . "\newline ") --- (bcStrings (5 4 lda PI))) - ) - htMakeDoneButton('"Continue", 'f07fdfSolve) - htShowPage() - -f07fdfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - upl := htpButtonValue(htPage, 'uplo) - uplo:= - upl = 'lower => '"L" - '"U" - (n = '4 ) => f07fdfDefaultSolve(htPage,uplo) - aList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[fb(i,j) for j in 1..n] where fb(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings, [6, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :aList] - page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the matrix {\it A}:" - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'f07fdfGen) - htpSetProperty(page,'uplo,uplo) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'lda,lda) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07fdfDefaultSolve (htPage,uplo) == - n := '4 - lda := '4 - page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it A}:") - (text . "\newline ") - (bcStrings (5 "4.16" a11 F)) - (bcStrings (5 "0.0" a12 F)) - (bcStrings (5 "0.0" a13 F)) - (bcStrings (5 "0.0" a14 F)) - (text . "\newline ") - (bcStrings (5 "-3.12" a21 F)) - (bcStrings (5 "5.03" a22 F)) - (bcStrings (5 "0.0" a23 F)) - (bcStrings (5 "0.0" a24 F)) - (text . "\newline ") - (bcStrings (5 "0.56" a31 F)) - (bcStrings (5 "-0.83" a32 F)) - (bcStrings (5 "0.76" a33 F)) - (bcStrings (5 "0.0" a34 F)) - (text . "\newline ") - (bcStrings (5 "-0.1" a41 F)) - (bcStrings (5 "1.18" a42 F)) - (bcStrings (5 "0.34" a43 F)) - (bcStrings (5 "1.18" a44 F))) - htpSetProperty(page,'uplo,uplo) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'lda,lda) - htMakeDoneButton('"Continue",'f07fdfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07fdfGen htPage == - n := htpProperty(htPage, 'n) --- lda := htpProperty(htPage, 'lda) - lda := n - uplo := htpProperty(htPage,'uplo) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - for j in 1..n repeat - a := STRCONC((first y).1," ") - rowList := [a,:rowList] - y := rest y - aList := [rowList,:aList] - rowList := [] - astring := bcwords2liststring [bcwords2liststring x for x in aList] - prefix := STRCONC("f07fdf(_"", uplo,"_", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")") - linkGen prefix - - -f07fef() == - htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf07fef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fef| '|NagLapack|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F07FEF solves a real symmetric positive-definite system of linear ") - (text . "equations with multiple right-hand sides, {\it AX=B}, where ") - (text . "{\it A} has been factorized by F07FDF ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Method of factorization of {\it A}, {\it UPLO}:") - (text . "\blankline ") - (radioButtons uplo - ("" " L, {\it A} factorized as lower triangular" lower) - ("" " U, {\it A} factorized as upper triangular" upper)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The order {\it n} of {\it A}: ") - (text . "\newline ") - (bcStrings (5 4 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The number of right-hand sides, {\it nrhs}: ") - (text . "\newline ") - (bcStrings (5 2 nrhs PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it A}, {\it lda}: ") --- (text . "\newline ") --- (bcStrings (5 4 lda PI)) --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "First dimension of {\it B}, {\it ldb}: ") --- (text . "\newline ") --- (bcStrings (5 4 ldb PI))) - ) - htMakeDoneButton('"Continue", 'f07fefSolve) - htShowPage() - -f07fefSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nrhs := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs) - objValUnwrap htpLabelSpadValue(htPage, 'nrhs) - lda := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - upl := htpButtonValue(htPage, 'uplo) - uplo:= - upl = 'lower => '"L" - '"U" - (n = '4 and nrhs = '2) => f07fefDefaultSolve(htPage,uplo) - aList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[faa(i,j) for j in 1..n] where faa(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings, [8, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) == - labelList := - "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings, [8, 0, bnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))) - ,:aList,:bList] - page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the matrix {\it A}:" - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'f07fefGen) - htpSetProperty(page,'uplo,uplo) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nrhs,nrhs) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f07fefDefaultSolve (htPage,uplo) == - n := '4 - nrhs := '2 - lda := '4 - ldb := '4 - page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it A}:") - (text . "\newline ") - (bcStrings (8 "2.04" a11 F)) - (bcStrings (8 "0.0" a12 F)) - (bcStrings (8 "0.0" a13 F)) - (bcStrings (8 "0.0" a14 F)) - (text . "\newline ") - (bcStrings (8 "-1.53" a21 F)) - (bcStrings (8 "1.64" a22 F)) - (bcStrings (8 "0.0" a23 F)) - (bcStrings (8 "0.0" a24 F)) - (text . "\newline ") - (bcStrings (8 "0.28" a31 F)) - (bcStrings (8 "-0.25" a32 F)) - (bcStrings (8 "0.79" a33 F)) - (bcStrings (8 "0.0" a34 F)) - (text . "\newline ") - (bcStrings (8 "-0.05" a41 F)) - (bcStrings (8 "0.67" a42 F)) - (bcStrings (8 "0.66" a43 F)) - (bcStrings (8 "0.54" a44 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it B}:") - (text . "\newline ") - (bcStrings (8 "8.7" b11 F)) - (bcStrings (8 "8.3" b12 F)) - (text . "\newline ") - (bcStrings (8 "-13.35" b21 F)) - (bcStrings (8 "2.13" b22 F)) - (text . "\newline ") - (bcStrings (8 "1.89" b31 F)) - (bcStrings (8 "1.61" b32 F)) - (text . "\newline ") - (bcStrings (8 "-4.14" b41 F)) - (bcStrings (8 "5" b42 F))) - htpSetProperty(page,'uplo,uplo) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nrhs,nrhs) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htMakeDoneButton('"Continue",'f07fefGen) - htShowPage() - -f07fefGen htPage == - n := htpProperty(htPage, 'n) - nrhs := htpProperty(htPage, 'nrhs) --- lda := htpProperty(htPage, 'lda) --- ldb := htpProperty(htPage, 'ldb) - lda := n - ldb := n - uplo := htpProperty(htPage,'uplo) - aplist := htpInputAreaAlist htPage - y := aplist - for i in 1..n repeat - for j in 1..nrhs repeat - b := STRCONC((first y).1," ") - rowList := [b,:rowList] - y := rest y - bList := [rowList,:bList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bList] - for i in 1..lda repeat - for j in 1..n repeat - a := STRCONC((first y).1," ") - rowList := [a,:rowList] - y := rest y - aList := [rowList,:aList] - rowList := [] - astring := bcwords2liststring [bcwords2liststring x for x in aList] - prefix := STRCONC("f07fef(_"", uplo,"_", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)") - linkGen prefix - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-f07.lisp.pamphlet b/src/interp/nag-f07.lisp.pamphlet new file mode 100644 index 0000000..a899dae --- /dev/null +++ b/src/interp/nag-f07.lisp.pamphlet @@ -0,0 +1,1794 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp nag-f07.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= + +(IN-PACKAGE "BOOT" ) + +;f07adf() == +; htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf07adf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07adf| '|NagLapack|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "F07ADF computes the {\it LU} factorization of a real {\it m}") +; (text . " by {\it n} matrix ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of rows {\it m}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 4 m PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of columns {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 4 n PI)) +; ) +;-- (text . "\blankline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "First dimension of array A, {\it lda}:") +;-- (text . "\newline\tab{2} ") +;-- (bcStrings (5 4 lda PI)) +; htMakeDoneButton('"Continue", 'f07adfSolve) +; htShowPage() + +(DEFUN |f07adf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F07ADF - {\\it LU} factorization of real {\\it m} by {\\it n} matrix") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf07adf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07adf| '|NagLapack|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "F07ADF computes the {\\it LU} factorization of a real {\\it m}") + (|text| . " by {\\it n} matrix ") (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of rows {\\it m}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 4 |m| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of columns {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 4 |n| PI)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f07adfSolve|) + (|htShowPage|))) + +;f07adfSolve htPage == +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; lda := m +; (n = '4 and m = '4) => f07adfDefaultSolve(htPage,lda) +; aList := +; "append"/[fa(i,n) for i in 1..m] where fa(i,n) == +; labelList := +; "append"/[fb(i,j) for j in 1..n] where fb(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[6, 0, anam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :aList] +; page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the array {\it A}:" +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'f07adfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +;-- htpSetProperty(page,'lda,lda) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f07adfSolve,fb| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f07adfSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166070) + (SPADLET G166070 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166070) + (SEQ (EXIT (SETQ G166070 + (APPEND G166070 + (|f07adfSolve,fb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f07adfSolve| (|htPage|) + (PROG (|m| |n| |lda| |aList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |m|) + (COND + ((AND (BOOT-EQUAL |n| '4) (BOOT-EQUAL |m| '4)) + (|f07adfDefaultSolve| |htPage| |lda|)) + ('T + (SPADLET |aList| + (PROG (G166087) + (SPADLET G166087 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |m|) G166087) + (SEQ (EXIT + (SETQ G166087 + (APPEND G166087 + (|f07adfSolve,fa| |i| |n|))))))))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + |aList|)) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F07ADF - {\\it LU} factorization of real {\\it m} by {\\it n} matrix") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING "Enter the array {\\it A}:")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f07adfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f07adfDefaultSolve (htPage,lda) == +; n := '4 +; m := '4 +; page := htInitPage('"F07ADF - {\it LU} factorization of real {\it m} by {\it n} matrix",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the array {\it A}:") +; (text . "\newline ") +; (bcStrings (5 "1.8" a11 F)) +; (bcStrings (5 "2.88" a12 F)) +; (bcStrings (5 "2.05" a13 F)) +; (bcStrings (5 "-0.89" a14 F)) +; (text . "\newline ") +; (bcStrings (5 "5.25" a21 F)) +; (bcStrings (5 "-2.95" a22 F)) +; (bcStrings (5 "-0.95" a23 F)) +; (bcStrings (5 "-3.8" a24 F)) +; (text . "\newline ") +; (bcStrings (5 "1.58" a31 F)) +; (bcStrings (5 "-2.69" a32 F)) +; (bcStrings (5 "-2.9" a33 F)) +; (bcStrings (5 "-1.04" a34 F)) +; (text . "\newline ") +; (bcStrings (5 "-1.11" a41 F)) +; (bcStrings (5 "-0.66" a42 F)) +; (bcStrings (5 "-0.59" a43 F)) +; (bcStrings (5 "0.8" a44 F))) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +;-- htpSetProperty(page,'lda,lda) +; htMakeDoneButton('"Continue",'f07adfGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f07adfDefaultSolve| (|htPage| |lda|) + (declare (ignore |lda|)) + (PROG (|n| |m| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |m| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F07ADF - {\\it LU} factorization of real {\\it m} by {\\it n} matrix") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the array {\\it A}:") + (|text| . "\\newline ") (|bcStrings| (5 "1.8" |a11| F)) + (|bcStrings| (5 "2.88" |a12| F)) + (|bcStrings| (5 "2.05" |a13| F)) + (|bcStrings| (5 "-0.89" |a14| F)) (|text| . "\\newline ") + (|bcStrings| (5 "5.25" |a21| F)) + (|bcStrings| (5 "-2.95" |a22| F)) + (|bcStrings| (5 "-0.95" |a23| F)) + (|bcStrings| (5 "-3.8" |a24| F)) (|text| . "\\newline ") + (|bcStrings| (5 "1.58" |a31| F)) + (|bcStrings| (5 "-2.69" |a32| F)) + (|bcStrings| (5 "-2.9" |a33| F)) + (|bcStrings| (5 "-1.04" |a34| F)) (|text| . "\\newline ") + (|bcStrings| (5 "-1.11" |a41| F)) + (|bcStrings| (5 "-0.66" |a42| F)) + (|bcStrings| (5 "-0.59" |a43| F)) + (|bcStrings| (5 "0.8" |a44| F)))) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f07adfGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f07adfGen htPage == +; n := htpProperty(htPage, 'n) +; m := htpProperty(htPage, 'm) +; lda := m +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; for j in 1..m repeat +; a := STRCONC((first y).1," ") +; rowList := [a,:rowList] +; y := rest y +; aList := [rowList,:aList] +; rowList := [] +; astring := bcwords2liststring [bcwords2liststring x for x in aList] +; prefix := STRCONC("f07adf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")") +; linkGen prefix + +(DEFUN |f07adfGen| (|htPage|) + (PROG (|n| |m| |lda| |alist| |a| |y| |aList| |rowList| |astring| + |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |lda| |m|) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |m|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |a| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |a| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |aList| (CONS |rowList| |aList|)) + (SPADLET |rowList| NIL))))) + (SPADLET |astring| + (|bcwords2liststring| + (PROG (G166140) + (SPADLET G166140 NIL) + (RETURN + (DO ((G166145 |aList| (CDR G166145)) + (|x| NIL)) + ((OR (ATOM G166145) + (PROGN + (SETQ |x| (CAR G166145)) + NIL)) + (NREVERSE0 G166140)) + (SEQ (EXIT + (SETQ G166140 + (CONS (|bcwords2liststring| |x|) + G166140))))))))) + (SPADLET |prefix| + (STRCONC '|f07adf(| (STRINGIMAGE |m|) '|, | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lda|) '|, | + |astring| '|)|)) + (|linkGen| |prefix|)))))) + +;f07aef() == +; htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf07aef} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07aef| '|NagLapack|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "F07AEF solves a real system of linear equations with multiple right-hand sides, {\it AX=B} or ") +; (text . "\htbitmap{atxequalb} , where {\it a} has been factorized by F07ADF ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Form of the equations:") +; (text . "\blankline ") +; (radioButtons trans +; ("" " N, the equations are {\it AX=B}" norm) +; ("" " T, the equations are \htbitmap{atxequalb}" transp)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "The order {\it n} of {\it A}: ") +; (text . "\newline ") +; (bcStrings (5 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "The order {\it m} of {\it A} used by F07AEF: ") +;-- (text . "\newline ") +;-- (bcStrings (5 4 m PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "The number of right-hand sides, {\it nrhs}: ") +; (text . "\newline ") +; (bcStrings (5 2 nrhs PI)) +;-- (text . "\blankline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "First dimension of {\it A}, {\it lda}: ") +;-- (text . "\newline ") +;-- (bcStrings (5 4 lda PI)) +;-- (text . "\blankline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "First dimension of {\it B}, {\it ldb}: ") +;-- (text . "\newline ") +;-- (bcStrings (5 4 ldb PI)) +; ) +; htMakeDoneButton('"Continue", 'f07aefSolve) +; htShowPage() + +(DEFUN |f07aef| () + (PROGN + (|htInitPage| + (MAKESTRING + "F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf07aef} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07aef| '|NagLapack|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| + . "F07AEF solves a real system of linear equations with multiple right-hand sides, {\\it AX=B} or ") + (|text| + . "\\htbitmap{atxequalb} , where {\\it a} has been factorized by F07ADF ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Form of the equations:") (|text| . "\\blankline ") + (|radioButtons| |trans| + ("" " N, the equations are {\\it AX=B}" |norm|) + ("" " T, the equations are \\htbitmap{atxequalb}" + |transp|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "The order {\\it n} of {\\it A}: ") + (|text| . "\\newline ") (|bcStrings| (5 4 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "The number of right-hand sides, {\\it nrhs}: ") + (|text| . "\\newline ") (|bcStrings| (5 2 |nrhs| PI)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f07aefSolve|) + (|htShowPage|))) + +;f07aefSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +;-- m := +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +;-- objValUnwrap htpLabelSpadValue(htPage, 'm) +; nrhs := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs) +; objValUnwrap htpLabelSpadValue(htPage, 'nrhs) +; lda := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +;-- objValUnwrap htpLabelSpadValue(htPage, 'lda) +; ldb := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) +; equa := htpButtonValue(htPage, 'trans) +; trans := +; equa = 'norm => '"N" +; '"T" +; (n = '4 and nrhs = '2 ) => f07aefDefaultSolve (htPage,trans) +; aList := +; "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == +; labelList := +; "append"/[faa(i,j) for j in 1..n] where faa(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings, [6, 0, anam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; ipList := +; [fp(i) for i in 1..n] where fp(i) == +; ipnam := INTERN STRCONC ('"ip",STRINGIMAGE i) +; ['bcStrings,[5, 0, ipnam, 'I]] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the pivot ") +; middle := STRCONC(middle,'"indices {\it IPIV} from F07ADF: ") +; middle := STRCONC(middle,'"\newline ") +; ipList := [['text,:middle],:ipList] +; bList := +; "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) == +; labelList := +; "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings, [6, 0, bnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ") +; bList := [['text,:prefix],:bList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; ,:aList,:ipList,:bList] +; page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the matrix {\it A}:" +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'f07aefGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'m,m) +; htpSetProperty(page,'nrhs,nrhs) +;-- htpSetProperty(page,'lda,lda) +;-- htpSetProperty(page,'ldb,ldb) +; htpSetProperty(page,'trans,trans) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f07aefSolve,faa| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f07aefSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166182) + (SPADLET G166182 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166182) + (SEQ (EXIT (SETQ G166182 + (APPEND G166182 + (|f07aefSolve,faa| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f07aefSolve,fp| (|i|) + (PROG (|ipnam|) + (RETURN + (SEQ (SPADLET |ipnam| + (INTERN (STRCONC (MAKESTRING "ip") + (STRINGIMAGE |i|)))) + (EXIT (CONS '|bcStrings| + (CONS (CONS 5 + (CONS 0 + (CONS |ipnam| (CONS 'I NIL)))) + NIL))))))) + +(DEFUN |f07aefSolve,fbb| (|i| |j|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f07aefSolve,fb| (|i| |nrhs|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166211) + (SPADLET G166211 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |nrhs|) G166211) + (SEQ (EXIT (SETQ G166211 + (APPEND G166211 + (|f07aefSolve,fbb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f07aefSolve| (|htPage|) + (PROG (|n| |nrhs| |lda| |ldb| |equa| |trans| |aList| |middle| + |ipList| |prefix| |bList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |nrhs| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nrhs|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nrhs|))))) + (SPADLET |lda| |n|) + (SPADLET |ldb| |n|) + (SPADLET |equa| (|htpButtonValue| |htPage| '|trans|)) + (SPADLET |trans| + (COND + ((BOOT-EQUAL |equa| '|norm|) (MAKESTRING "N")) + ('T (MAKESTRING "T")))) + (COND + ((AND (BOOT-EQUAL |n| '4) (BOOT-EQUAL |nrhs| '2)) + (|f07aefDefaultSolve| |htPage| |trans|)) + ('T + (SPADLET |aList| + (PROG (G166228) + (SPADLET G166228 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G166228) + (SEQ (EXIT + (SETQ G166228 + (APPEND G166228 + (|f07aefSolve,fa| |i| |n|))))))))) + (SPADLET |ipList| + (PROG (G166240) + (SPADLET G166240 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) + (NREVERSE0 G166240)) + (SEQ (EXIT + (SETQ G166240 + (CONS (|f07aefSolve,fp| |i|) + G166240)))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter the pivot ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "indices {\\it IPIV} from F07ADF: "))) + (SPADLET |middle| + (STRCONC |middle| (MAKESTRING "\\newline "))) + (SPADLET |ipList| + (CONS (CONS '|text| |middle|) |ipList|)) + (SPADLET |bList| + (PROG (G166248) + (SPADLET G166248 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166248) + (SEQ (EXIT + (SETQ G166248 + (APPEND G166248 + (|f07aefSolve,fb| |i| |nrhs|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter the matrix {\\it B}: |) + (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |aList| + (APPEND |ipList| |bList|)))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING "Enter the matrix {\\it A}:")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f07aefGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nrhs| |nrhs|) + (|htpSetProperty| |page| '|trans| |trans|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f07aefDefaultSolve (htPage,trans) == +; n := '4 +; nrhs := '2 +; lda := '4 +; ldb := '4 +; length := '4 +; page := htInitPage('"F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the matrix {\it A}:") +; (text . "\newline ") +; (bcStrings (5 "5.25" a11 F)) +; (bcStrings (5 "-2.95" a12 F)) +; (bcStrings (5 "-0.95" a13 F)) +; (bcStrings (5 "-3.8" a14 F)) +; (text . "\newline ") +; (bcStrings (5 "0.34" a21 F)) +; (bcStrings (5 "3.89" a22 F)) +; (bcStrings (5 "2.38" a23 F)) +; (bcStrings (5 "0.41" a24 F)) +; (text . "\newline ") +; (bcStrings (5 "0.3" a31 F)) +; (bcStrings (5 "-0.46" a32 F)) +; (bcStrings (5 "-1.51" a33 F)) +; (bcStrings (5 "0.29" a34 F)) +; (text . "\newline ") +; (bcStrings (5 "-0.21" a41 F)) +; (bcStrings (5 "-0.33" a42 F)) +; (bcStrings (5 "0.00" a43 F)) +; (bcStrings (5 "0.13" a44 F)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the pivot indices {\it IPIV} from F07ADF: ") +; (text . "\newline ") +; (bcStrings (5 2 ip1 PI)) +; (bcStrings (5 2 ip2 PI)) +; (bcStrings (5 3 ip3 PI)) +; (bcStrings (5 4 ip4 PI)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the matrix {\it B}:") +; (text . "\newline ") +; (bcStrings (5 "9.52" b11 F)) +; (bcStrings (5 "18.47" b12 F)) +; (text . "\newline ") +; (bcStrings (5 "24.35" b21 F)) +; (bcStrings (5 "2.25" b22 F)) +; (text . "\newline ") +; (bcStrings (5 "0.77" b31 F)) +; (bcStrings (5 "-13.28" b32 F)) +; (text . "\newline ") +; (bcStrings (5 "-6.22" b41 F)) +; (bcStrings (5 "-6.21" b42 F))) +; htpSetProperty(page,'trans,trans) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'nrhs,nrhs) +;-- htpSetProperty(page,'lda,lda) +;-- htpSetProperty(page,'ldb,ldb) +; htpSetProperty(page,'length,length) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htMakeDoneButton('"Continue",'f07aefGen) +; htShowPage() + +(DEFUN |f07aefDefaultSolve| (|htPage| |trans|) + (PROG (|n| |nrhs| |lda| |ldb| |length| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |nrhs| '2) + (SPADLET |lda| '4) + (SPADLET |ldb| '4) + (SPADLET |length| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F07AEF - Solution of a real system of linear equations with multiple right-hand sides after factorization by F07ADF") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the matrix {\\it A}:") + (|text| . "\\newline ") (|bcStrings| (5 "5.25" |a11| F)) + (|bcStrings| (5 "-2.95" |a12| F)) + (|bcStrings| (5 "-0.95" |a13| F)) + (|bcStrings| (5 "-3.8" |a14| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.34" |a21| F)) + (|bcStrings| (5 "3.89" |a22| F)) + (|bcStrings| (5 "2.38" |a23| F)) + (|bcStrings| (5 "0.41" |a24| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.3" |a31| F)) + (|bcStrings| (5 "-0.46" |a32| F)) + (|bcStrings| (5 "-1.51" |a33| F)) + (|bcStrings| (5 "0.29" |a34| F)) (|text| . "\\newline ") + (|bcStrings| (5 "-0.21" |a41| F)) + (|bcStrings| (5 "-0.33" |a42| F)) + (|bcStrings| (5 "0.00" |a43| F)) + (|bcStrings| (5 "0.13" |a44| F)) (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the pivot indices {\\it IPIV} from F07ADF: ") + (|text| . "\\newline ") (|bcStrings| (5 2 |ip1| PI)) + (|bcStrings| (5 2 |ip2| PI)) (|bcStrings| (5 3 |ip3| PI)) + (|bcStrings| (5 4 |ip4| PI)) (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the matrix {\\it B}:") + (|text| . "\\newline ") (|bcStrings| (5 "9.52" |b11| F)) + (|bcStrings| (5 "18.47" |b12| F)) (|text| . "\\newline ") + (|bcStrings| (5 "24.35" |b21| F)) + (|bcStrings| (5 "2.25" |b22| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.77" |b31| F)) + (|bcStrings| (5 "-13.28" |b32| F)) + (|text| . "\\newline ") (|bcStrings| (5 "-6.22" |b41| F)) + (|bcStrings| (5 "-6.21" |b42| F)))) + (|htpSetProperty| |page| '|trans| |trans|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nrhs| |nrhs|) + (|htpSetProperty| |page| '|length| |length|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f07aefGen|) + (|htShowPage|))))) + +;f07aefGen htPage == +; n := htpProperty(htPage, 'n) +; nrhs := htpProperty(htPage, 'nrhs) +;-- lda := htpProperty(htPage, 'lda) +;-- ldb := htpProperty(htPage, 'ldb) +; lda := n +; ldb := n +; length := htpProperty(htPage, 'length) +; trans := htpProperty(htPage,'trans) +; aplist := htpInputAreaAlist htPage +; y := aplist +; for i in 1..n repeat +; for j in 1..nrhs repeat +; b := STRCONC((first y).1," ") +; rowList := [b,:rowList] +; y := rest y +; bList := [rowList,:bList] +; rowList := [] +; bstring := bcwords2liststring [bcwords2liststring x for x in bList] +; for i in 1..length repeat +; ip := STRCONC((first y).1," ") +; ipList := [ip,:ipList] +; y := rest y +; ipstring := bcwords2liststring ipList +; for i in 1..lda repeat +; for j in 1..n repeat +; a := STRCONC((first y).1," ") +; rowList := [a,:rowList] +; y := rest y +; aList := [rowList,:aList] +; rowList := [] +; astring := bcwords2liststring [bcwords2liststring x for x in aList] +; prefix := STRCONC("f07aef(_"", trans,"_", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ") +; prefix := STRCONC(prefix,STRINGIMAGE lda,", [",ipstring,"]::Matrix INT, ") +; prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)") +; linkGen prefix + +(DEFUN |f07aefGen| (|htPage|) + (PROG (|n| |nrhs| |lda| |ldb| |length| |trans| |aplist| |b| |bList| + |bstring| |ip| |ipList| |ipstring| |a| |y| |aList| + |rowList| |astring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |nrhs| (|htpProperty| |htPage| '|nrhs|)) + (SPADLET |lda| |n|) + (SPADLET |ldb| |n|) + (SPADLET |length| (|htpProperty| |htPage| '|length|)) + (SPADLET |trans| (|htpProperty| |htPage| '|trans|)) + (SPADLET |aplist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |aplist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |nrhs|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |b| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |b| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bList| (CONS |rowList| |bList|)) + (SPADLET |rowList| NIL))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G166320) + (SPADLET G166320 NIL) + (RETURN + (DO ((G166325 |bList| (CDR G166325)) + (|x| NIL)) + ((OR (ATOM G166325) + (PROGN + (SETQ |x| (CAR G166325)) + NIL)) + (NREVERSE0 G166320)) + (SEQ (EXIT + (SETQ G166320 + (CONS (|bcwords2liststring| |x|) + G166320))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |length|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |ip| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |ipList| (CONS |ip| |ipList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |ipstring| (|bcwords2liststring| |ipList|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |a| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |a| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |aList| (CONS |rowList| |aList|)) + (SPADLET |rowList| NIL))))) + (SPADLET |astring| + (|bcwords2liststring| + (PROG (G166365) + (SPADLET G166365 NIL) + (RETURN + (DO ((G166370 |aList| (CDR G166370)) + (|x| NIL)) + ((OR (ATOM G166370) + (PROGN + (SETQ |x| (CAR G166370)) + NIL)) + (NREVERSE0 G166365)) + (SEQ (EXIT + (SETQ G166365 + (CONS (|bcwords2liststring| |x|) + G166365))))))))) + (SPADLET |prefix| + (STRCONC '|f07aef("| |trans| '|", | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |nrhs|) '|, | + |astring| '|::Matrix DoubleFloat, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lda|) '|, [| + |ipstring| '|]::Matrix INT, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ldb|) '|, | + |bstring| '|::Matrix DoubleFloat)|)) + (|linkGen| |prefix|)))))) + +;f07fdf() == +; htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf07fdf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fdf| '|NagLapack|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "F07FDF computes the Cholesky factorization of a real symmetric positive-definite ") +; (text . "matrix {\it A} ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Method of factorization of {\it A}, {\it UPLO}:") +; (text . "\blankline ") +; (radioButtons uplo +; ("" " L, {\it A} factorized as lower triangular" lower) +; ("" " U, {\it A} factorized as upper triangular" upper)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "The order {\it n} of {\it A}: ") +; (text . "\newline ") +; (bcStrings (5 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "First dimension of {\it A}, {\it lda}:") +;-- (text . "\newline ") +;-- (bcStrings (5 4 lda PI))) +; ) +; htMakeDoneButton('"Continue", 'f07fdfSolve) +; htShowPage() + +(DEFUN |f07fdf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\\it A}") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf07fdf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fdf| '|NagLapack|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "F07FDF computes the Cholesky factorization of a real symmetric positive-definite ") + (|text| . "matrix {\\it A} ") (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Method of factorization of {\\it A}, {\\it UPLO}:") + (|text| . "\\blankline ") + (|radioButtons| |uplo| + ("" " L, {\\it A} factorized as lower triangular" + |lower|) + ("" " U, {\\it A} factorized as upper triangular" + |upper|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "The order {\\it n} of {\\it A}: ") + (|text| . "\\newline ") (|bcStrings| (5 4 |n| PI)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f07fdfSolve|) + (|htShowPage|))) + +;f07fdfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; lda := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +;-- objValUnwrap htpLabelSpadValue(htPage, 'lda) +; upl := htpButtonValue(htPage, 'uplo) +; uplo:= +; upl = 'lower => '"L" +; '"U" +; (n = '4 ) => f07fdfDefaultSolve(htPage,uplo) +; aList := +; "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == +; labelList := +; "append"/[fb(i,j) for j in 1..n] where fb(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings, [6, 0, anam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :aList] +; page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the matrix {\it A}:" +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'f07fdfGen) +; htpSetProperty(page,'uplo,uplo) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'lda,lda) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f07fdfSolve,fb| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f07fdfSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166422) + (SPADLET G166422 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166422) + (SEQ (EXIT (SETQ G166422 + (APPEND G166422 + (|f07fdfSolve,fb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f07fdfSolve| (|htPage|) + (PROG (|n| |lda| |upl| |uplo| |aList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |n|) + (SPADLET |upl| (|htpButtonValue| |htPage| '|uplo|)) + (SPADLET |uplo| + (COND + ((BOOT-EQUAL |upl| '|lower|) (MAKESTRING "L")) + ('T (MAKESTRING "U")))) + (COND + ((BOOT-EQUAL |n| '4) + (|f07fdfDefaultSolve| |htPage| |uplo|)) + ('T + (SPADLET |aList| + (PROG (G166439) + (SPADLET G166439 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G166439) + (SEQ (EXIT + (SETQ G166439 + (APPEND G166439 + (|f07fdfSolve,fa| |i| |n|))))))))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + |aList|)) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\\it A}") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING "Enter the matrix {\\it A}:")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f07fdfGen|) + (|htpSetProperty| |page| '|uplo| |uplo|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f07fdfDefaultSolve (htPage,uplo) == +; n := '4 +; lda := '4 +; page := htInitPage('"F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\it A}",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the matrix {\it A}:") +; (text . "\newline ") +; (bcStrings (5 "4.16" a11 F)) +; (bcStrings (5 "0.0" a12 F)) +; (bcStrings (5 "0.0" a13 F)) +; (bcStrings (5 "0.0" a14 F)) +; (text . "\newline ") +; (bcStrings (5 "-3.12" a21 F)) +; (bcStrings (5 "5.03" a22 F)) +; (bcStrings (5 "0.0" a23 F)) +; (bcStrings (5 "0.0" a24 F)) +; (text . "\newline ") +; (bcStrings (5 "0.56" a31 F)) +; (bcStrings (5 "-0.83" a32 F)) +; (bcStrings (5 "0.76" a33 F)) +; (bcStrings (5 "0.0" a34 F)) +; (text . "\newline ") +; (bcStrings (5 "-0.1" a41 F)) +; (bcStrings (5 "1.18" a42 F)) +; (bcStrings (5 "0.34" a43 F)) +; (bcStrings (5 "1.18" a44 F))) +; htpSetProperty(page,'uplo,uplo) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'lda,lda) +; htMakeDoneButton('"Continue",'f07fdfGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f07fdfDefaultSolve| (|htPage| |uplo|) + (PROG (|n| |lda| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |lda| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F07FDF - Cholesky factorization of a real symmmetric positive-definite matrix {\\it A}") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the matrix {\\it A}:") + (|text| . "\\newline ") (|bcStrings| (5 "4.16" |a11| F)) + (|bcStrings| (5 "0.0" |a12| F)) + (|bcStrings| (5 "0.0" |a13| F)) + (|bcStrings| (5 "0.0" |a14| F)) (|text| . "\\newline ") + (|bcStrings| (5 "-3.12" |a21| F)) + (|bcStrings| (5 "5.03" |a22| F)) + (|bcStrings| (5 "0.0" |a23| F)) + (|bcStrings| (5 "0.0" |a24| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.56" |a31| F)) + (|bcStrings| (5 "-0.83" |a32| F)) + (|bcStrings| (5 "0.76" |a33| F)) + (|bcStrings| (5 "0.0" |a34| F)) (|text| . "\\newline ") + (|bcStrings| (5 "-0.1" |a41| F)) + (|bcStrings| (5 "1.18" |a42| F)) + (|bcStrings| (5 "0.34" |a43| F)) + (|bcStrings| (5 "1.18" |a44| F)))) + (|htpSetProperty| |page| '|uplo| |uplo|) + (|htpSetProperty| |page| '|n| |n|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f07fdfGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f07fdfGen htPage == +; n := htpProperty(htPage, 'n) +;-- lda := htpProperty(htPage, 'lda) +; lda := n +; uplo := htpProperty(htPage,'uplo) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; for j in 1..n repeat +; a := STRCONC((first y).1," ") +; rowList := [a,:rowList] +; y := rest y +; aList := [rowList,:aList] +; rowList := [] +; astring := bcwords2liststring [bcwords2liststring x for x in aList] +; prefix := STRCONC("f07fdf(_"", uplo,"_", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE lda,", ",astring,")") +; linkGen prefix + +(DEFUN |f07fdfGen| (|htPage|) + (PROG (|n| |lda| |uplo| |alist| |a| |y| |aList| |rowList| |astring| + |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |lda| |n|) + (SPADLET |uplo| (|htpProperty| |htPage| '|uplo|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |a| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |a| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |aList| (CONS |rowList| |aList|)) + (SPADLET |rowList| NIL))))) + (SPADLET |astring| + (|bcwords2liststring| + (PROG (G166493) + (SPADLET G166493 NIL) + (RETURN + (DO ((G166498 |aList| (CDR G166498)) + (|x| NIL)) + ((OR (ATOM G166498) + (PROGN + (SETQ |x| (CAR G166498)) + NIL)) + (NREVERSE0 G166493)) + (SEQ (EXIT + (SETQ G166493 + (CONS (|bcwords2liststring| |x|) + G166493))))))))) + (SPADLET |prefix| + (STRCONC '|f07fdf("| |uplo| '|", | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lda|) '|, | + |astring| '|)|)) + (|linkGen| |prefix|)))))) + +;f07fef() == +; htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf07fef} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fef| '|NagLapack|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "F07FEF solves a real symmetric positive-definite system of linear ") +; (text . "equations with multiple right-hand sides, {\it AX=B}, where ") +; (text . "{\it A} has been factorized by F07FDF ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Method of factorization of {\it A}, {\it UPLO}:") +; (text . "\blankline ") +; (radioButtons uplo +; ("" " L, {\it A} factorized as lower triangular" lower) +; ("" " U, {\it A} factorized as upper triangular" upper)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "The order {\it n} of {\it A}: ") +; (text . "\newline ") +; (bcStrings (5 4 n PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "The number of right-hand sides, {\it nrhs}: ") +; (text . "\newline ") +; (bcStrings (5 2 nrhs PI)) +;-- (text . "\blankline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "First dimension of {\it A}, {\it lda}: ") +;-- (text . "\newline ") +;-- (bcStrings (5 4 lda PI)) +;-- (text . "\blankline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "First dimension of {\it B}, {\it ldb}: ") +;-- (text . "\newline ") +;-- (bcStrings (5 4 ldb PI))) +; ) +; htMakeDoneButton('"Continue", 'f07fefSolve) +; htShowPage() + +(DEFUN |f07fef| () + (PROGN + (|htInitPage| + (MAKESTRING + "F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf07fef} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f07fef| '|NagLapack|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "F07FEF solves a real symmetric positive-definite system of linear ") + (|text| + . "equations with multiple right-hand sides, {\\it AX=B}, where ") + (|text| . "{\\it A} has been factorized by F07FDF ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Method of factorization of {\\it A}, {\\it UPLO}:") + (|text| . "\\blankline ") + (|radioButtons| |uplo| + ("" " L, {\\it A} factorized as lower triangular" + |lower|) + ("" " U, {\\it A} factorized as upper triangular" + |upper|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "The order {\\it n} of {\\it A}: ") + (|text| . "\\newline ") (|bcStrings| (5 4 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "The number of right-hand sides, {\\it nrhs}: ") + (|text| . "\\newline ") (|bcStrings| (5 2 |nrhs| PI)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f07fefSolve|) + (|htShowPage|))) + +;f07fefSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; nrhs := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrhs) +; objValUnwrap htpLabelSpadValue(htPage, 'nrhs) +; lda := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +;-- objValUnwrap htpLabelSpadValue(htPage, 'lda) +; ldb := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) +; upl := htpButtonValue(htPage, 'uplo) +; uplo:= +; upl = 'lower => '"L" +; '"U" +; (n = '4 and nrhs = '2) => f07fefDefaultSolve(htPage,uplo) +; aList := +; "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == +; labelList := +; "append"/[faa(i,j) for j in 1..n] where faa(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings, [8, 0, anam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; bList := +; "append"/[fb(i,nrhs) for i in 1..n] where fb(i,nrhs) == +; labelList := +; "append"/[fbb(i,j) for j in 1..nrhs] where fbb(i,j) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings, [8, 0, bnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; prefix := ("\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it B}: ") +; bList := [['text,:prefix],:bList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; ,:aList,:bList] +; page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the matrix {\it A}:" +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'f07fefGen) +; htpSetProperty(page,'uplo,uplo) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'nrhs,nrhs) +;-- htpSetProperty(page,'lda,lda) +;-- htpSetProperty(page,'ldb,ldb) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f07fefSolve,faa| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS 0 + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f07fefSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166535) + (SPADLET G166535 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166535) + (SEQ (EXIT (SETQ G166535 + (APPEND G166535 + (|f07fefSolve,faa| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f07fefSolve,fbb| (|i| |j|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS 0 + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f07fefSolve,fb| (|i| |nrhs|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166558) + (SPADLET G166558 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |nrhs|) G166558) + (SEQ (EXIT (SETQ G166558 + (APPEND G166558 + (|f07fefSolve,fbb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f07fefSolve| (|htPage|) + (PROG (|n| |nrhs| |lda| |ldb| |upl| |uplo| |aList| |prefix| |bList| + |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |nrhs| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nrhs|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nrhs|))))) + (SPADLET |lda| |n|) + (SPADLET |ldb| |n|) + (SPADLET |upl| (|htpButtonValue| |htPage| '|uplo|)) + (SPADLET |uplo| + (COND + ((BOOT-EQUAL |upl| '|lower|) (MAKESTRING "L")) + ('T (MAKESTRING "U")))) + (COND + ((AND (BOOT-EQUAL |n| '4) (BOOT-EQUAL |nrhs| '2)) + (|f07fefDefaultSolve| |htPage| |uplo|)) + ('T + (SPADLET |aList| + (PROG (G166575) + (SPADLET G166575 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G166575) + (SEQ (EXIT + (SETQ G166575 + (APPEND G166575 + (|f07fefSolve,fa| |i| |n|))))))))) + (SPADLET |bList| + (PROG (G166583) + (SPADLET G166583 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166583) + (SEQ (EXIT + (SETQ G166583 + (APPEND G166583 + (|f07fefSolve,fb| |i| |nrhs|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter the matrix {\\it B}: |) + (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |aList| |bList|))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING "Enter the matrix {\\it A}:")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f07fefGen|) + (|htpSetProperty| |page| '|uplo| |uplo|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nrhs| |nrhs|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f07fefDefaultSolve (htPage,uplo) == +; n := '4 +; nrhs := '2 +; lda := '4 +; ldb := '4 +; page := htInitPage('"F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the matrix {\it A}:") +; (text . "\newline ") +; (bcStrings (8 "2.04" a11 F)) +; (bcStrings (8 "0.0" a12 F)) +; (bcStrings (8 "0.0" a13 F)) +; (bcStrings (8 "0.0" a14 F)) +; (text . "\newline ") +; (bcStrings (8 "-1.53" a21 F)) +; (bcStrings (8 "1.64" a22 F)) +; (bcStrings (8 "0.0" a23 F)) +; (bcStrings (8 "0.0" a24 F)) +; (text . "\newline ") +; (bcStrings (8 "0.28" a31 F)) +; (bcStrings (8 "-0.25" a32 F)) +; (bcStrings (8 "0.79" a33 F)) +; (bcStrings (8 "0.0" a34 F)) +; (text . "\newline ") +; (bcStrings (8 "-0.05" a41 F)) +; (bcStrings (8 "0.67" a42 F)) +; (bcStrings (8 "0.66" a43 F)) +; (bcStrings (8 "0.54" a44 F)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the matrix {\it B}:") +; (text . "\newline ") +; (bcStrings (8 "8.7" b11 F)) +; (bcStrings (8 "8.3" b12 F)) +; (text . "\newline ") +; (bcStrings (8 "-13.35" b21 F)) +; (bcStrings (8 "2.13" b22 F)) +; (text . "\newline ") +; (bcStrings (8 "1.89" b31 F)) +; (bcStrings (8 "1.61" b32 F)) +; (text . "\newline ") +; (bcStrings (8 "-4.14" b41 F)) +; (bcStrings (8 "5" b42 F))) +; htpSetProperty(page,'uplo,uplo) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'nrhs,nrhs) +;-- htpSetProperty(page,'lda,lda) +;-- htpSetProperty(page,'ldb,ldb) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htMakeDoneButton('"Continue",'f07fefGen) +; htShowPage() + +(DEFUN |f07fefDefaultSolve| (|htPage| |uplo|) + (PROG (|n| |nrhs| |lda| |ldb| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |nrhs| '2) + (SPADLET |lda| '4) + (SPADLET |ldb| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F07FEF - Solution of a real symmetric positive-definite system of linear equations with multiple right-hand sides after factorization by F07FDF") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the matrix {\\it A}:") + (|text| . "\\newline ") (|bcStrings| (8 "2.04" |a11| F)) + (|bcStrings| (8 "0.0" |a12| F)) + (|bcStrings| (8 "0.0" |a13| F)) + (|bcStrings| (8 "0.0" |a14| F)) (|text| . "\\newline ") + (|bcStrings| (8 "-1.53" |a21| F)) + (|bcStrings| (8 "1.64" |a22| F)) + (|bcStrings| (8 "0.0" |a23| F)) + (|bcStrings| (8 "0.0" |a24| F)) (|text| . "\\newline ") + (|bcStrings| (8 "0.28" |a31| F)) + (|bcStrings| (8 "-0.25" |a32| F)) + (|bcStrings| (8 "0.79" |a33| F)) + (|bcStrings| (8 "0.0" |a34| F)) (|text| . "\\newline ") + (|bcStrings| (8 "-0.05" |a41| F)) + (|bcStrings| (8 "0.67" |a42| F)) + (|bcStrings| (8 "0.66" |a43| F)) + (|bcStrings| (8 "0.54" |a44| F)) (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the matrix {\\it B}:") + (|text| . "\\newline ") (|bcStrings| (8 "8.7" |b11| F)) + (|bcStrings| (8 "8.3" |b12| F)) (|text| . "\\newline ") + (|bcStrings| (8 "-13.35" |b21| F)) + (|bcStrings| (8 "2.13" |b22| F)) (|text| . "\\newline ") + (|bcStrings| (8 "1.89" |b31| F)) + (|bcStrings| (8 "1.61" |b32| F)) (|text| . "\\newline ") + (|bcStrings| (8 "-4.14" |b41| F)) + (|bcStrings| (8 "5" |b42| F)))) + (|htpSetProperty| |page| '|uplo| |uplo|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nrhs| |nrhs|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f07fefGen|) + (|htShowPage|))))) + +;f07fefGen htPage == +; n := htpProperty(htPage, 'n) +; nrhs := htpProperty(htPage, 'nrhs) +;-- lda := htpProperty(htPage, 'lda) +;-- ldb := htpProperty(htPage, 'ldb) +; lda := n +; ldb := n +; uplo := htpProperty(htPage,'uplo) +; aplist := htpInputAreaAlist htPage +; y := aplist +; for i in 1..n repeat +; for j in 1..nrhs repeat +; b := STRCONC((first y).1," ") +; rowList := [b,:rowList] +; y := rest y +; bList := [rowList,:bList] +; rowList := [] +; bstring := bcwords2liststring [bcwords2liststring x for x in bList] +; for i in 1..lda repeat +; for j in 1..n repeat +; a := STRCONC((first y).1," ") +; rowList := [a,:rowList] +; y := rest y +; aList := [rowList,:aList] +; rowList := [] +; astring := bcwords2liststring [bcwords2liststring x for x in aList] +; prefix := STRCONC("f07fef(_"", uplo,"_", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE nrhs,", ",astring,"::Matrix DoubleFloat, ") +; prefix := STRCONC(prefix,STRINGIMAGE lda,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",bstring,"::Matrix DoubleFloat)") +; linkGen prefix + +(DEFUN |f07fefGen| (|htPage|) + (PROG (|n| |nrhs| |lda| |ldb| |uplo| |aplist| |b| |bList| |bstring| + |a| |y| |aList| |rowList| |astring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |nrhs| (|htpProperty| |htPage| '|nrhs|)) + (SPADLET |lda| |n|) + (SPADLET |ldb| |n|) + (SPADLET |uplo| (|htpProperty| |htPage| '|uplo|)) + (SPADLET |aplist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |aplist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |nrhs|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |b| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |b| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bList| (CONS |rowList| |bList|)) + (SPADLET |rowList| NIL))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G166647) + (SPADLET G166647 NIL) + (RETURN + (DO ((G166652 |bList| (CDR G166652)) + (|x| NIL)) + ((OR (ATOM G166652) + (PROGN + (SETQ |x| (CAR G166652)) + NIL)) + (NREVERSE0 G166647)) + (SEQ (EXIT + (SETQ G166647 + (CONS (|bcwords2liststring| |x|) + G166647))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |a| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |a| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |aList| (CONS |rowList| |aList|)) + (SPADLET |rowList| NIL))))) + (SPADLET |astring| + (|bcwords2liststring| + (PROG (G166683) + (SPADLET G166683 NIL) + (RETURN + (DO ((G166688 |aList| (CDR G166688)) + (|x| NIL)) + ((OR (ATOM G166688) + (PROGN + (SETQ |x| (CAR G166688)) + NIL)) + (NREVERSE0 G166683)) + (SEQ (EXIT + (SETQ G166683 + (CONS (|bcwords2liststring| |x|) + G166683))))))))) + (SPADLET |prefix| + (STRCONC '|f07fef("| |uplo| '|", | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |nrhs|) '|, | + |astring| '|::Matrix DoubleFloat, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lda|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ldb|) '|, | + |bstring| '|::Matrix DoubleFloat)|)) + (|linkGen| |prefix|)))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}