diff --git a/changelog b/changelog index 5f9f796..188e4d3 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +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 +20090901 tpd src/interp/nag-f04.boot removed, rewritten to nag-f04.lisp 20090901 tpd src/axiom-website/patches.html 20090901.04.tpd.patch 20090901 tpd src/interp/Makefile move nag-f02.boot to nag-f02.lisp 20090901 tpd src/interp/nag-f02.lisp added, rewritten from nag-f02.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index c0257cc..f8798c5 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1966,5 +1966,7 @@ src/interp/nag-e04.lisp rewrite from boot to lisp
src/interp/nag-f01.lisp rewrite from boot to lisp
20090901.04.tpd.patch src/interp/nag-f02.lisp rewrite from boot to lisp
+20090901.05.tpd.patch +src/interp/nag-f04.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 7893ab0..16ff34a 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -1671,41 +1671,32 @@ ${MID}/nag-f02.lisp: ${IN}/nag-f02.lisp.pamphlet @ -\subsection{nag-f04.boot \cite{55}} +\subsection{nag-f04.lisp} <>= ${AUTO}/nag-f04.${O}: ${OUT}/nag-f04.${O} - @ echo 198 making ${AUTO}/nag-f04.${O} from ${OUT}/nag-f04.${O} + @ echo 154 making ${AUTO}/nag-f04.${O} from ${OUT}/nag-f04.${O} @ cp ${OUT}/nag-f04.${O} ${AUTO} @ <>= -${OUT}/nag-f04.${O}: ${MID}/nag-f04.clisp - @ echo 199 making ${OUT}/nag-f04.${O} from ${MID}/nag-f04.clisp - @ (cd ${MID} ; \ +${OUT}/nag-f04.${O}: ${MID}/nag-f04.lisp + @ echo 136 making ${OUT}/nag-f04.${O} from ${MID}/nag-f04.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/nag-f04.clisp"' \ + echo '(progn (compile-file "${MID}/nag-f04.lisp"' \ ':output-file "${OUT}/nag-f04.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/nag-f04.clisp"' \ + echo '(progn (compile-file "${MID}/nag-f04.lisp"' \ ':output-file "${OUT}/nag-f04.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/nag-f04.clisp: ${IN}/nag-f04.boot.pamphlet - @ echo 200 making ${MID}/nag-f04.clisp from ${IN}/nag-f04.boot.pamphlet +<>= +${MID}/nag-f04.lisp: ${IN}/nag-f04.lisp.pamphlet + @ echo 137 making ${MID}/nag-f04.lisp from ${IN}/nag-f04.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/nag-f04.boot.pamphlet >nag-f04.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-f04.boot") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-f04.boot") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ; \ - rm nag-f04.boot ) + ${TANGLE} ${IN}/nag-f04.lisp.pamphlet >nag-f04.lisp ) @ @@ -4663,7 +4654,7 @@ clean: <> <> -<> +<> <> <> diff --git a/src/interp/nag-f04.boot.pamphlet b/src/interp/nag-f04.boot.pamphlet deleted file mode 100644 index 6564119..0000000 --- a/src/interp/nag-f04.boot.pamphlet +++ /dev/null @@ -1,2331 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-f04.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. - -@ -<<*>>= -<> - -f04adf() == - htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain I (Integer))) - (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04adf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates the approximate solution of a set of complex linear ") - (text . "equations {\it AX = B} using an {\it LU} factorization with ") - (text . "partial pivoting, where {\it A} is an n * n matrix, {\it X} is ") - (text . "an {\it n} by {\it m} matrix of unknowns and {\it B} is an ") - (text . "{\it n} by {\it m} matrix of right-hand sides.") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "{\it n} order of matrix A:") - (text . "\tab{28} \menuitemstyle{}\tab{30} ") - (text . "{\it m} number of right-hand sides \htbitmap{great=} 0 :") - (text . "\newline\tab{2} ") - (bcStrings (10 3 n I)) - (text . "\tab{30} ") - (bcStrings (10 1 m I)) --- (text . "\blankline ") --- (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IA} first dimension of A:") --- (text . "\tab{32} \menuitemstyle{}\tab{34} ") --- (text . "{\it IB} first dimension of B:") --- (text . "\newline\tab{2} ") --- (bcStrings (10 3 ia I)) --- (text . "\tab{34} ") --- (bcStrings (10 3 ib I)) --- (text . "\blankline ") --- (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IC} first dimension of C:") --- (text . "\newline\tab{2} ") --- (bcStrings (10 3 ic I)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04adfSolve) - htShowPage() - -f04adfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ib := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) --- objValUnwrap htpLabelSpadValue(htPage, 'ib) - ic := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ic) --- objValUnwrap htpLabelSpadValue(htPage, 'ic) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '3 and m = '1) => f04adfDefaultSolve(htPage,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - ianam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[12, "0.0 + 0.0*%i", ianam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[fb(i,m) for i in 1..ib] where fb(i,m) == - blabelList := - "append"/[gb(i,j) for j in 1..m] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[12, "0.0 + 0.0*%i", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - blabelList := [['text,:prefix],:blabelList] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :matList,:bmatList] - page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04adfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'ic,ic) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04adfDefaultSolve (htPage, ifail) == - n := '3 - m := '1 - ia := '3 - ib := '3 - ic := '3 - page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (12 "1" a11 F)) - (bcStrings (12 "1 + 2*%i" a12 F)) - (bcStrings (12 "2 + 10*%i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (12 "1 + %i" a21 F)) - (bcStrings (12 "3*%i" a22 F)) - (bcStrings (12 "-5 + 14*%i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (12 "1 + %i" a31 F)) - (bcStrings (12 "5*%i" a32 F)) - (bcStrings (12 "-8 + 20*%i" a33 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (12 "1" b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (12 "0" b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (12 "0" b3 F))) - htMakeDoneButton('"Continue",'f04adfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'ic,ic) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04adfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- ia := htpProperty(htPage,'ia) --- ib := htpProperty(htPage,'ib) --- ic := htpProperty(htPage,'ic) - ia := n - ib := n - ic := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - -- will probably need to change this as its a vector not an array - for i in 1..m repeat - for j in 1..ib repeat - right := STRCONC((first y).1," ") - y := rest y - bList := [right,:bList] - bstring := bcwords2liststring bList - boutList := [bstring,:boutList] - bList := [] - boutstring := bcwords2liststring boutList - y := REVERSE y - k := -1 - matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04adf(",STRINGIMAGE ia,",",boutstring,",") - prefix := STRCONC(prefix,STRINGIMAGE ib,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE m,", ",STRINGIMAGE ic) - prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") - bcGen prefix - -f04arf() == - htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain I (Integer))) - (text . "\windowlink{Manual Page}{manpageXXf04arf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04arf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates the approximate solution of a set of real linear ") - (text . "equations {\it Ax = b} using an {\it LU} factorization with ") - (text . "pivoting, where {\it A} is an n * n matrix, {\it x} is an n ") - (text . "element vector of unknowns and {\it b} is an n element ") - (text . "right-hand side vector.") - (text . "\blankline ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IA} first dimension of A:") --- (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\it n} order of matrix A:") - (text . "\newline\tab{2} ") --- (bcStrings (10 8 ia I)) --- (text . "\tab{34} ") - (bcStrings (10 3 n I)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04arfSolve) - htShowPage() - -f04arfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '3 => f04arfDefaultSolve(htPage,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", ianam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k) for k in 1..n] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :matList,:bmatList] - page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04arfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04arfDefaultSolve (htPage, ifail) == - n := '3 - ia := '3 - page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 33 ia11 F)) - (bcStrings (6 16 ia12 F)) - (bcStrings (6 72 ia13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-24" ia21 F)) - (bcStrings (6 "-10" ia22 F)) - (bcStrings (6 "-57" ia23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-8" ia31 F)) - (bcStrings (6 "-4" ia32 F)) - (bcStrings (6 "-17" ia33 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia41 F)) --- (bcStrings (6 0 ia42 F)) --- (bcStrings (6 0 ia43 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia51 F)) --- (bcStrings (6 0 ia52 F)) --- (bcStrings (6 0 ia53 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia61 F)) --- (bcStrings (6 0 ia62 F)) --- (bcStrings (6 0 ia63 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia71 F)) --- (bcStrings (6 0 ia72 F)) --- (bcStrings (6 0 ia73 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia81 F)) --- (bcStrings (6 0 ia82 F)) --- (bcStrings (6 0 ia83 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-359" b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "281" b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "85" b3 F))) - htMakeDoneButton('"Continue",'f04arfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04arfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) - ia := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - right := STRCONC((first y).1," ") - y := rest y - bList := [right,:bList] - bstring := bcwords2liststring bList - y := REVERSE y - k := -1 - matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04arf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n) - prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") - bcGen prefix - -f04asf() == - htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain I (Integer))) - (text . "\windowlink{Manual Page}{manpageXXf04asf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04asf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates the accurate solution of a set of real symmetric ") - (text . "positive-definite linear equations {\it Ax = b} using an a ") - (text . "Cholesky factorization and iterative refinement, ") - (text . "where {\it A} is an n * n matrix, {\it x} is an n ") - (text . "element vector of unknowns and {\it b} is an n element ") - (text . "right-hand side vector.") - (text . "\blankline ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IA} first dimension of A:") --- (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\it n} order of matrix A:") - (text . "\newline\tab{2} ") --- (bcStrings (10 8 ia I)) --- (text . "\tab{34} ") - (bcStrings (10 4 n I)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04asfSolve) - htShowPage() - -f04asfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 --- (n = '4 and ia = '8) => f04asfDefaultSolve(htPage,ifail) - n = '4 => f04asfDefaultSolve(htPage,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", ianam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k) for k in 1..n] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :matList,:bmatList] - page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04asfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04asfDefaultSolve (htPage, ifail) == - n := '4 - ia := '4 - page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 5 ia11 F)) - (bcStrings (6 7 ia12 F)) - (bcStrings (6 6 ia13 F)) - (bcStrings (6 5 ia14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 7 ia21 F)) - (bcStrings (6 10 ia22 F)) - (bcStrings (6 8 ia23 F)) - (bcStrings (6 7 ia24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 6 ia31 F)) - (bcStrings (6 8 ia32 F)) - (bcStrings (6 10 ia33 F)) - (bcStrings (6 9 ia34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 5 ia41 F)) - (bcStrings (6 7 ia42 F)) - (bcStrings (6 9 ia43 F)) - (bcStrings (6 10 ia44 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia51 F)) --- (bcStrings (6 0 ia52 F)) --- (bcStrings (6 0 ia53 F)) --- (bcStrings (6 0 ia54 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia61 F)) --- (bcStrings (6 0 ia62 F)) --- (bcStrings (6 0 ia63 F)) --- (bcStrings (6 0 ia64 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia71 F)) --- (bcStrings (6 0 ia72 F)) --- (bcStrings (6 0 ia73 F)) --- (bcStrings (6 0 ia74 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia81 F)) --- (bcStrings (6 0 ia82 F)) --- (bcStrings (6 0 ia83 F)) --- (bcStrings (6 0 ia84 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 23 b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 32 b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 33 b3 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 31 b4 F))) - htMakeDoneButton('"Continue",'f04asfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04asfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) - ia := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - right := STRCONC((first y).1," ") - y := rest y - bList := [right,:bList] - bstring := bcwords2liststring bList - y := REVERSE y - k := -1 - matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04asf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n) - prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") - bcGen prefix - -f04atf() == - htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain I (Integer))) - (text . "\windowlink{Manual Page}{manpageXXf04atf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04atf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates the approximate solution of a set of real linear ") - (text . "equations {\it Ax = b} using an {\it LU} factorization with ") - (text . "pivoting and iterative refinement, ") - (text . "where {\it A} is an n * n matrix, {\it x} is an n ") - (text . "element vector of unknowns and {\it b} is an n element ") - (text . "right-hand side vector.") - (text . "\blankline ") - (text . "\newline ") - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") --- (text . "{\it IA} first dimension of A:") --- (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "{\it n} order of matrix A:") - (text . "\newline\tab{2} ") --- (bcStrings (10 8 ia I)) --- (text . "\tab{34} ") - (bcStrings (10 3 n I)) --- (text . "\blankline ") --- (text . "\newline \menuitemstyle{} \tab{2} ") --- (text . "{\it IAA} first dimension of AA:") --- (text . "\newline \tab{2} ") --- (bcStrings (10 8 iaa I)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{} \tab{2} ") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04atfSolve) - htShowPage() - -f04atfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - iaa := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaa) --- objValUnwrap htpLabelSpadValue(htPage, 'iaa) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 --- (n = '3 and ia = '8) => f04atfDefaultSolve(htPage,iaa,ifail) - n = '3 => f04atfDefaultSolve(htPage,iaa,ifail) - matList := - "append"/[f(i,n) for i in 1..ia] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", ianam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k) for k in 1..n] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :matList,:bmatList] - page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04atfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iaa,iaa) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04atfDefaultSolve (htPage, iaa, ifail) == - n := '3 - ia := '3 - page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 33 ia11 F)) - (bcStrings (6 16 ia12 F)) - (bcStrings (6 72 ia13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-24" ia21 F)) - (bcStrings (6 "-10" ia22 F)) - (bcStrings (6 "-57" ia23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-8" ia31 F)) - (bcStrings (6 "-4" ia32 F)) - (bcStrings (6 "-17" ia33 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia41 F)) --- (bcStrings (6 0 ia42 F)) --- (bcStrings (6 0 ia43 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia51 F)) --- (bcStrings (6 0 ia52 F)) --- (bcStrings (6 0 ia53 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia61 F)) --- (bcStrings (6 0 ia62 F)) --- (bcStrings (6 0 ia63 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia71 F)) --- (bcStrings (6 0 ia72 F)) --- (bcStrings (6 0 ia73 F)) --- (text . "\newline \tab{2} ") --- (bcStrings (6 0 ia81 F)) --- (bcStrings (6 0 ia82 F)) --- (bcStrings (6 0 ia83 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-359" b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "281" b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "85" b3 F))) - htMakeDoneButton('"Continue",'f04atfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iaa,iaa) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04atfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) --- iaa := htpProperty(htPage,'iaa) - ia := n - iaa := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - right := STRCONC((first y).1," ") - y := rest y - bList := [right,:bList] - bstring := bcwords2liststring bList - y := REVERSE y - k := -1 - matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04atf(",matstring,", ",STRINGIMAGE ia,", [",bstring) - prefix := STRCONC(prefix,"],",STRINGIMAGE n,", ",STRINGIMAGE iaa,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - bcGen prefix - - -f04faf() == - htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04faf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates the approximate solution of a set of real symmetric ") - (text . "positive-definite tridiagonal linear equations {\it Tx = b} ") - (text . "using a modified symmetric Gaussian Elimination algorithm, ") - (text . "where {\it T} is an n * n matrix, {\it x} is an n ") - (text . "element vector of unknowns and {\it b} is an n element ") - (text . "right-hand side vector. {\it T} is factorized as ") - (text . "\inputbitmap{\htbmdir{}/mkm.bitmap}, where {\it K} is a diagonal matrix ") - (text . "and {\it M} is a matrix of multipliers. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "{\it JOB} to be performed by f04faf: ") - (radioButtons job - ("" " = 0. {\it T} is factorized and equations {\it Tx = b} are solved for x." jobZero) - ("" " = 1. {\it T} assumed to be already factorized by previous call to f04faf, the equations {\it Tx = b} are solved for x." jobOne)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Order of the matrix T {\it n}:") - (text . "\newline \tab{2} ") - (bcStrings (6 5 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04fafSolve) - htShowPage() - -f04fafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - number := htpButtonValue(htPage,'job) - job := - number = 'jobOne => '1 - '0 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '5 => f04fafDefaultSolve(htPage,job,ifail) - dList := - "append"/[f(i) for i in 1..n] where f(i) == - prefix := ('"\newline \tab{2} ") - dnam := INTERN STRCONC ('"d",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[10, 0.0, dnam, 'F]]] - prefix := ('"\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T: ") - prefix := STRCONC(prefix,"\newline \tab{2} ") - dList := [['text,:prefix],:dList] - eList := - "append"/[g(j) for j in 1..(n-1)] where g(j) == - prefix := ('"\newline \tab{2} ") - enam := INTERN STRCONC ('"e",STRINGIMAGE j) - [['text,:prefix],['bcStrings,[10, 0.0, enam, 'F]]] - prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it E} E(2) ") - prefix := STRCONC(prefix,"to E(N)\newline \tab{2} Job = 0 => super-diagonal") - prefix := STRCONC(prefix," elements of {\it T}. \newline \tab{2} Job = 1 =>") - prefix := STRCONC(prefix," off-diagonal elements of {\it M} from previous ") - prefix := STRCONC(prefix,"call to F04FAF. ") - eList := [['text,:prefix],:eList] - bList := - "append"/[h(k) for k in 1..n] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[10, 0.0, bnam, 'F]]] - prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it B} Right-hand") - prefix := STRCONC(prefix," side vector b: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :dList,:eList,:bList] - page := htInitPage("F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage equationPart - htMakeDoneButton('"Continue",'f04fafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'job,job) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f04fafDefaultSolve (htPage,job,ifail) == - n := '5 - page := htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T:") - (text . "\newline \tab{2} ") - (bcStrings (10 4 d1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 10 d2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 29 d3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 25 d4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 5 d5 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} {\it E}\space{1} E(2) to E(N) ") - (text . "\newline \tab{2} ") - (text . "Job = 0 => super-diagonal elements of {\it T}. \newline \tab{2}") - (text . "Job = 1 => off-diagonal elements of {\it M} from ") - (text . "previous call to F04FAF \newline \tab{2} ") - (bcStrings (10 "-2" e2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 "-6" e3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 15 e4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 8 e5 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} {\it B} Right-hand side vector b:") - (text . "\newline \tab{2} ") - (bcStrings (10 6 b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 9 b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 2 b3 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 14 b4 F)) - (text . "\newline \tab{2} ") - (bcStrings (10 7 b5 F))) - htMakeDoneButton('"Continue",'f04fafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'job,job) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04fafGen htPage == - n := htpProperty(htPage,'n) - job := htpProperty(htPage,'job) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - b := STRCONC((first y).1," ") - bList := [b,:bList] - y := rest y - bstring := bcwords2liststring bList - for i in 1..(n-1) repeat - e := STRCONC((first y).1," ") - eList := [e,:eList] - y := rest y - eList := ['"0",:eList] - estring := bcwords2liststring eList - for i in 1..n repeat - d := STRCONC((first y).1," ") - dList := [d,:dList] - y := rest y - dstring := bcwords2liststring dList - prefix := STRCONC('"f04faf(",STRINGIMAGE job,", ",STRINGIMAGE n,",[") - prefix := STRCONC(prefix,dstring,"], [",estring,"], [",bstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - bcGen prefix - - -f04jgf() == - htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} it n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf04jgf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04jgf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Finds the solution of a linear least squares problem {\it Ax=b},") - (text . " where A is a real m by n matrix, (m \inputbitmap{\htbmdir{}/great=.bitmap}") - (text . " n), x is an n element vector of unknowns and b is an m element ") - (text . "right-hand side vector. The routine uses a QU factorization if ") - (text . "rank A = n and the SVD if A < n. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Rows of matrix A, {\it m}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") - (bcStrings (6 6 m PI)) - (text . "\tab{34} ") - (bcStrings (6 4 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it nra}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Tolerance, {\it tol}: ") - (text . "\newline \tab{2} ") --- (bcStrings (6 8 nra PI)) --- (text . "\tab{34} ") - (bcStrings (8 "5.0e-4" tol F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\newline Dimension of workspace array {\it lwork}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 32 lwork PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04jgfSolve) - htShowPage() - -f04jgfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nra := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nra) --- objValUnwrap htpLabelSpadValue(htPage, 'nra) - lwork := 4*n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork) --- objValUnwrap htpLabelSpadValue(htPage, 'lwork) - tol := htpLabelInputString(htPage,'tol) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '6 and n = '4) => f04jgfDefaultSolve(htPage,nra,lwork,tol,ifail) - matList := - "append"/[f(i,n) for i in 1..m] where f(i,n) == - labelList := - "append"/[g(i,j) for j in 1..n] where g(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bmatList := - "append"/[h(k) for k in 1..m] where h(k) == - prefix := ('"\newline \tab{2} ") - bnam := INTERN STRCONC ('"b",STRINGIMAGE k) - [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] - start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F04JGF - Least-squares (if rank = {\it n}) or minimal least-squares (if rank < {\it n}) solution of {\it m} real equations in {\it n} unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} {\it n}, {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} {\it n}",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04jgfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'nra,nra) --- htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f04jgfDefaultSolve (htPage,nra,lwork,tol,ifail) == - n := '4 - m := '6 - page := htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.05" a11 F)) - (bcStrings (6 "0.05" a12 F)) - (bcStrings (6 "0.25" a13 F)) - (bcStrings (6 "-0.25" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.25" a21 F)) - (bcStrings (6 "0.25" a22 F)) - (bcStrings (6 "0.05" a23 F)) - (bcStrings (6 "-0.05" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.35" a31 F)) - (bcStrings (6 "0.35" a32 F)) - (bcStrings (6 "1.75" a33 F)) - (bcStrings (6 "-1.75" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.75" a41 F)) - (bcStrings (6 "1.75" a42 F)) - (bcStrings (6 "0.35" a43 F)) - (bcStrings (6 "-0.35" a44 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.30" a51 F)) - (bcStrings (6 "-0.30" a52 F)) - (bcStrings (6 "0.30" a53 F)) - (bcStrings (6 "0.30" a54 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.40" a61 F)) - (bcStrings (6 "-0.40" a62 F)) - (bcStrings (6 "0.40" a63 F)) - (bcStrings (6 "0.40" a64 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 b1 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 2 b2 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 3 b3 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 4 b4 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 5 b5 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 6 b6 F))) - htMakeDoneButton('"Continue",'f04jgfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'nra,nra) --- htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04jgfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) --- nra := htpProperty(htPage,'nra) --- lwork := htpProperty(htPage,'lwork) - nra := m - lwork := 4*n - tol := htpProperty(htPage,'tol) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..m repeat - b := STRCONC((first y).1," ") - bList := [b,:bList] - y := rest y - bstring := bcwords2liststring bList - y := REVERSE y - for i in 1..m repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - for i in 1..n repeat - null := STRCONC('"0.0"," ") - nullList := [:nullList,null] - for i in m..(nra-1) repeat - matform := [:matform,nullList] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f04jgf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE nra,", ",tol,", ",STRINGIMAGE lwork) - prefix := STRCONC(prefix,", ",matstring,", [",bstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - bcGen prefix - -f04mcf() == - htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04mcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mcf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "Computes the approximate solution of a system of real linear ") - (text . "equations AX = B, where the n by n symmetric positive-definite ") - (text . "variable-bandwidth matrix A has previously been factorized as ") - (text . "\htbitmap{ldlt} by F01MCF, X is an n by r matrix of unknowns ") - (text . "and B is an n by r matrix of right-hand sides. Related systems ") - (text . "may also be solved. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the order of the matrix A, {\it n} ") - (text ."\htbitmap{great=} 1:") - (text . "\newline\tab{2} ") - (bcStrings (9 6 n PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Enter the dimension of AL, {\it lal}: ") - (text . "\newline\tab{2} ") - (bcStrings (9 14 lal PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Enter the number of right-hand sides, {\it ir}: ") - (text . "\newline\tab{2} ") - (bcStrings (9 2 ir PI)) --- (text . "\blankline") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\newline Enter the first dimension of B, {\it nrb}: ") --- (text . "\newline\tab{2} ") --- (bcStrings (9 6 nrb PI)) --- (text . "\blankline") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\newline Enter the first dimension of X, {\it nrx}: ") --- (text . "\newline\tab{2} ") --- (bcStrings (9 6 nrx PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "Type of system to be solved, {\it iselct}:") - (radioButtons iselct - ("" " {\em \htbitmap{ldlt}X = B} is solved" selone) - ("" " {\em LDX = B} is solved" seltwo) - ("" " {\em D\htbitmap{lt}X = B} is solved" selthree) - ("" " {\em L\htbitmap{lt}X = B} is solved" selfour) - ("" " {\em LX = B} is solved" selfive) - ("" " {\em \htbitmap{lt}X = B} is solved" selsix)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04mcfSolve) - htShowPage() - -f04mcfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lal := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lal) - objValUnwrap htpLabelSpadValue(htPage, 'lal) - ir := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ir) - objValUnwrap htpLabelSpadValue(htPage, 'ir) - nrb := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrb) --- objValUnwrap htpLabelSpadValue(htPage, 'nrb) - nrx := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrx) --- objValUnwrap htpLabelSpadValue(htPage, 'nrx) - select := htpButtonValue(htPage,'iselct) - iselct := - select = 'selone => '1 - select = 'seltwo => '2 - select = 'selthree => '3 - select = 'selfour => '4 - select = 'selfive => '5 - '6 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '6 and lal = '14 and ir = '2) => f04mcfDefaultSolve(htPage,iselct,ifail) - labelList := - "append"/[fal(i) for i in 1..lal] where fal(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[6, "0.0", xnam, 'F]]] - dList := - "append"/[fd(i) for i in 1..n] where fd(i) == - dnam := INTERN STRCONC ('"d",STRINGIMAGE i) - [['bcStrings,[6, "0.0", dnam, 'F]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} Diagonal elements of diagon") - prefix := STRCONC(prefix,"al matrix D as returned by F01MCF: \newline") - dList := [['text,:prefix],:dList] - nrowList := - "append"/[gj(j) for j in 1..n] where gj(j) == - nam := INTERN STRCONC ('"n",STRINGIMAGE j) - [['bcStrings,[6, 0, nam, 'PI]]] - prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it NROW(n)} the width ") - prefix := STRCONC(prefix,"of the ith row of A: \newline ") - nrowList := [['text,:prefix],:nrowList] - bList := - "append"/[f(i,ir) for i in 1..nrb] where f(i,ir) == - labelList := - "append"/[g(i,j) for j in 1..ir] where g(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - prefix := ('"\blankline \menuitemstyle{}\tab{2} The n by r right-hand side ") - prefix := STRCONC(prefix,"matrix B: \newline ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :labelList,:dList,:nrowList,:bList] - page := htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) - htSay '"\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by row " - htSay '"order as returned by F01MCF: \newline " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04mcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'lal,lal) - htpSetProperty(page,'ir,ir) --- htpSetProperty(page,'nrb,nrb) --- htpSetProperty(page,'nrx,nrx) - htpSetProperty(page,'iselct,iselct) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f04mcfDefaultSolve (htPage,iselct,ifail) == - n := '6 - lal := '14 - ir := '2 - nrb := '6 - nrx := '6 - page := htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) - htMakePage '( - (domainConditions - (isDomain PI (Positive Integer)) - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by ") - (text . "row order as returned by F01MCF: ") - (text . "\newline ") - (bcStrings (6 "1.0" x1 F)) - (bcStrings (6 "2.0" x2 F)) - (bcStrings (6 "1.0" x3 F)) - (bcStrings (6 "3.0" x4 F)) - (bcStrings (6 "1.0" x5 F)) - (bcStrings (6 "1.0" x6 F)) - (bcStrings (6 "5.0" x7 F)) - (bcStrings (6 "4.0" x8 F)) - (bcStrings (6 "1.5" x9 F)) - (bcStrings (6 "0.5" x10 F)) - (bcStrings (6 "1.0" x11 F)) - (bcStrings (6 "1.5" x12 F)) - (bcStrings (6 "5.0" x13 F)) - (bcStrings (6 "1.0" x14 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Diagonal elements of diagonal matrix ") - (text . "D as returned by F01MCF: ") - (text . "\newline ") - (bcStrings (6 "1.0" d1 F)) - (bcStrings (6 "1.0" d2 F)) - (bcStrings (6 "4.0" d3 F)) - (bcStrings (6 "16.0" d4 F)) - (bcStrings (6 "1.0" d5 F)) - (bcStrings (6 "16.0" d6 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} {\it NROW(n)} the width of the ith row ") - (text . "of A: ") - (text . "\newline ") - (bcStrings (6 1 n1 PI)) - (bcStrings (6 2 n2 PI)) - (bcStrings (6 2 n3 PI)) - (bcStrings (6 1 n4 PI)) - (bcStrings (6 5 n5 PI)) - (bcStrings (6 3 n6 PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} The n by r right-hand side matrix B:") - (text . "\newline ") - (bcStrings (6 "6" b11 F)) - (text . "\tab{10} ") - (bcStrings (6 "-10" b12 PI)) - (text . "\newline ") - (bcStrings (6 "15" b21 F)) - (text . "\tab{10} ") - (bcStrings (6 "-21" b22 PI)) - (text . "\newline ") - (bcStrings (6 "11" b31 F)) - (text . "\tab{10} ") - (bcStrings (6 "-3" b32 PI)) - (text . "\newline ") - (bcStrings (6 "0" b41 F)) - (text . "\tab{10} ") - (bcStrings (6 "24" b42 PI)) - (text . "\newline ") - (bcStrings (6 "51" b51 F)) - (text . "\tab{10} ") - (bcStrings (6 "-39" b52 PI)) - (text . "\newline ") - (bcStrings (6 "46" b61 F)) - (text . "\tab{10} ") - (bcStrings (6 "67" b62 PI)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f04mcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'lal,lal) - htpSetProperty(page,'ir,ir) --- htpSetProperty(page,'nrb,nrb) --- htpSetProperty(page,'nrx,nrx) - htpSetProperty(page,'iselct,iselct) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04mcfGen htPage == - n := htpProperty(htPage,'n) - lal := htpProperty(htPage,'lal) - ir := htpProperty(htPage,'ir) --- nrb := htpProperty(htPage,'nrb) --- nrx := htpProperty(htPage,'nrx) - nrb := n - nrx := n - iselct := htpProperty(htPage,'iselct) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..nrb repeat - for j in 1..ir repeat - elm := STRCONC((first y).1," ") - rowList := [elm,:rowList] - y := rest y - matform := [rowList,:matform] - rowList := [] - matfrom := REVERSE matform - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..n repeat - right := STRCONC ((first y).1," ") - y := rest y - nrowList := [right,:nrowList] - nrowstring := bcwords2liststring nrowList - for i in 1..n repeat - right := STRCONC ((first y).1," ") - y := rest y - dList := [right,:dList] - dstring := bcwords2liststring dList - while y repeat - right := STRCONC ((first y).1," ") - y := rest y - alList := [right,:alList] - alstring := bcwords2liststring alList - prefix := STRCONC('"f04mcf(",STRINGIMAGE n,", [",alstring,"], ") - prefix := STRCONC(prefix,STRINGIMAGE lal,", [",dstring,"],[",nrowstring) - prefix := STRCONC(prefix,"]::Matrix Integer,") - prefix := STRCONC(prefix,STRINGIMAGE ir,", ",matstring,", ",STRINGIMAGE nrb) - prefix := STRCONC(prefix,", ",STRINGIMAGE iselct,", ",STRINGIMAGE nrx,", ") - bcGen STRCONC(prefix,STRINGIMAGE ifail,")") - - -f04axf() == - htInitPage('"F04AXF - Approximate solution of a a set of real sparse linear equations after factorization by F01BRF or by F01BSF",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04axf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04axf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F04AXF calculates the approximate solution of a set of real ") - (text . "sparse linear equations {\it Ax=b} or ") - (text . "\htbitmap{atxequalb}, where the {\it n} by {\it n} matrix ") - (text . "{\it A} has been factorized by F01BRF or F01BSF, {\it x} ") - (text . "is an {\it n} element vector of unknowns and {\it b} is an ") - (text . "{\it n} element right-hand side vector. ") - (text . "\blankline") - (text . "\newline ") - (text . "Read the input file to see the example program. ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\spadcommand{)read f04axf \bound{s0}} ")) - htShowPage() - -f04maf() == - htInitPage('"F04MAF - Solution of a real sparse symmetric positive-definite system of linear equations after factorization by F01MAF",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04maf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04maf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F04MAF solves a real sparse symmetric positive-definite system ") - (text . "of linear equations {\it Ax=b} using a pre-conditioned ") - (text . "conjugate gradient method, where the {\it n} by {\it n} ") - (text . "matrix {\it A} has been factorized by F01MAF, {\it x} is an ") - (text . "{\it n} element vector of unknowns and {\it b} is an {\it n} ") - (text . "element right-hand side vector. ") - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\spadcommand{)read f04maf \bound{s0}} ")) - htShowPage() - -f04mbf() == - htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F04MBF solve a system of real symmetric linear equations ") - (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ") - (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ") - (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ") - (text . "and {\it b} is an {\it n} element right-hand side vector. ") - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the order {\it n} of matrix {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 10 n PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Is preconditioning required? ") - (radioButtons precon - ("" " Yes" true) - ("" " No" false)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the shift in the equations \lambda, {\it shift} : ") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.0" shift F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the tolerance for convergence, {\it rtol}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 "0.00001" rtol F)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter an upper limit for the number of iterations, {\it itnlim}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 100 itnlim PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the printing level, {\it msglvl}: ") - (text . "\newline \tab{2} ") - (bcStrings (10 1 msglvl PI)) - (text . "\blankline") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04mbfSolve) - htShowPage() - -f04mbfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - msolve := htpButtonValue(htPage,'precon) - precon := - msolve = 'true => 'true - 'false - shift := htpLabelInputString(htPage,'shift) - rtol := htpLabelInputString(htPage,'rtol) - itnlim := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim) - objValUnwrap htpLabelSpadValue(htPage, 'itnlim) - msglvl := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl) - objValUnwrap htpLabelSpadValue(htPage, 'msglvl) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = '10 and precon ='true) => f04mbfDefaultSolve(htPage,shift,rtol,itnlim,msglvl,ifail) - bmatList := - "append"/[f(i) for i in 1..n] where f(i) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i) - [['bcStrings,[6, "0.0", bnam, 'F]]] - amatList := - "append"/[h(ia,n) for ia in 1..n] where h(ia,n) == - alabelList := - "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) == - anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - alabelList := [['text,:prefix],:alabelList] - start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ") - amatList := [['text,:start],:amatList] - mmatList:= - precon = 'true => - alabelList:= - "append"/[l(im,n) for im in 1..n] where l(im,n) == - mlabelList := - "append"/[o(im,jm) for jm in 1..n] where o(im,jm) == - mnam := INTERN STRCONC ('"m",STRINGIMAGE im,STRINGIMAGE jm) - [['bcStrings,[6, "0.0", mnam, 'F]]] - prefix := ('"\newline \tab{2} ") - mlabelList := [['text,:prefix],:mlabelList] - start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it m}: ") - [['text,:start],:alabelList] - [] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :bmatList,:amatList,:mmatList] - page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) - htSay '"\newline \menuitemstyle{}\tab{2} " - htSay '"Enter the right-hand side vector {\it b(n)}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04mbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'precon,precon) - htpSetProperty(page,'shift,shift) - htpSetProperty(page,'rtol,rtol) - htpSetProperty(page,'itnlim,itnlim) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04mbfDefaultSolve (htPage,shift,rtol,itnlim,msglvl,ifail) == - n := '10 - precon := 'true - page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the right-hand side vector {\it b(n)}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "6.0" b1 F)) - (bcStrings (6 "4.0" b2 F)) - (bcStrings (6 "4.0" b3 F)) - (bcStrings (6 "4.0" b4 F)) - (bcStrings (6 "4.0" b5 F)) - (bcStrings (6 "4.0" b6 F)) - (bcStrings (6 "4.0" b7 F)) - (bcStrings (6 "4.0" b8 F)) - (bcStrings (6 "4.0" b9 F)) - (bcStrings (6 "6.0" b10 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the matrix {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a11 F)) - (bcStrings (6 "1.0" a12 F)) - (bcStrings (6 "0.0" a13 F)) - (bcStrings (6 "0.0" a14 F)) - (bcStrings (6 "0.0" a15 F)) - (bcStrings (6 "0.0" a16 F)) - (bcStrings (6 "0.0" a17 F)) - (bcStrings (6 "0.0" a18 F)) - (bcStrings (6 "0.0" a19 F)) - (bcStrings (6 "3.0" a110 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.0" a21 F)) - (bcStrings (6 "2.0" a22 F)) - (bcStrings (6 "1.0" a23 F)) - (bcStrings (6 "0.0" a24 F)) - (bcStrings (6 "0.0" a25 F)) - (bcStrings (6 "0.0" a26 F)) - (bcStrings (6 "0.0" a27 F)) - (bcStrings (6 "0.0" a28 F)) - (bcStrings (6 "0.0" a29 F)) - (bcStrings (6 "0.0" a210 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a31 F)) - (bcStrings (6 "1.0" a32 F)) - (bcStrings (6 "2.0" a33 F)) - (bcStrings (6 "1.0" a34 F)) - (bcStrings (6 "0.0" a35 F)) - (bcStrings (6 "0.0" a36 F)) - (bcStrings (6 "0.0" a37 F)) - (bcStrings (6 "0.0" a38 F)) - (bcStrings (6 "0.0" a39 F)) - (bcStrings (6 "0.0" a310 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a41 F)) - (bcStrings (6 "0.0" a42 F)) - (bcStrings (6 "1.0" a43 F)) - (bcStrings (6 "2.0" a44 F)) - (bcStrings (6 "1.0" a45 F)) - (bcStrings (6 "0.0" a46 F)) - (bcStrings (6 "0.0" a47 F)) - (bcStrings (6 "0.0" a48 F)) - (bcStrings (6 "0.0" a49 F)) - (bcStrings (6 "0.0" a410 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a51 F)) - (bcStrings (6 "0.0" a52 F)) - (bcStrings (6 "0.0" a53 F)) - (bcStrings (6 "1.0" a54 F)) - (bcStrings (6 "2.0" a55 F)) - (bcStrings (6 "1.0" a56 F)) - (bcStrings (6 "0.0" a57 F)) - (bcStrings (6 "0.0" a58 F)) - (bcStrings (6 "0.0" a59 F)) - (bcStrings (6 "0.0" a510 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a61 F)) - (bcStrings (6 "0.0" a62 F)) - (bcStrings (6 "0.0" a63 F)) - (bcStrings (6 "0.0" a64 F)) - (bcStrings (6 "1.0" a65 F)) - (bcStrings (6 "2.0" a66 F)) - (bcStrings (6 "1.0" a67 F)) - (bcStrings (6 "0.0" a68 F)) - (bcStrings (6 "0.0" a69 F)) - (bcStrings (6 "0.0" a610 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a71 F)) - (bcStrings (6 "0.0" a72 F)) - (bcStrings (6 "0.0" a73 F)) - (bcStrings (6 "0.0" a74 F)) - (bcStrings (6 "0.0" a75 F)) - (bcStrings (6 "1.0" a76 F)) - (bcStrings (6 "2.0" a77 F)) - (bcStrings (6 "1.0" a78 F)) - (bcStrings (6 "0.0" a79 F)) - (bcStrings (6 "0.0" a710 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a81 F)) - (bcStrings (6 "0.0" a82 F)) - (bcStrings (6 "0.0" a83 F)) - (bcStrings (6 "0.0" a84 F)) - (bcStrings (6 "0.0" a85 F)) - (bcStrings (6 "0.0" a86 F)) - (bcStrings (6 "1.0" a87 F)) - (bcStrings (6 "2.0" a88 F)) - (bcStrings (6 "1.0" a89 F)) - (bcStrings (6 "0.0" a810 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a91 F)) - (bcStrings (6 "0.0" a92 F)) - (bcStrings (6 "0.0" a93 F)) - (bcStrings (6 "0.0" a94 F)) - (bcStrings (6 "0.0" a95 F)) - (bcStrings (6 "0.0" a96 F)) - (bcStrings (6 "0.0" a97 F)) - (bcStrings (6 "1.0" a98 F)) - (bcStrings (6 "2.0" a99 F)) - (bcStrings (6 "1.0" a910 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "3.0" a101 F)) - (bcStrings (6 "0.0" a102 F)) - (bcStrings (6 "0.0" a103 F)) - (bcStrings (6 "0.0" a104 F)) - (bcStrings (6 "0.0" a105 F)) - (bcStrings (6 "0.0" a106 F)) - (bcStrings (6 "0.0" a107 F)) - (bcStrings (6 "0.0" a108 F)) - (bcStrings (6 "1.0" a109 F)) - (bcStrings (6 "2.0" a1010 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the matrix {\it m}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" m11 F)) - (bcStrings (6 "1.0" m12 F)) - (bcStrings (6 "0.0" m13 F)) - (bcStrings (6 "0.0" m14 F)) - (bcStrings (6 "0.0" m15 F)) - (bcStrings (6 "0.0" m16 F)) - (bcStrings (6 "0.0" m17 F)) - (bcStrings (6 "0.0" m18 F)) - (bcStrings (6 "0.0" m19 F)) - (bcStrings (6 "0.0" m110 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.0" m21 F)) - (bcStrings (6 "2.0" m22 F)) - (bcStrings (6 "1.0" m23 F)) - (bcStrings (6 "0.0" m24 F)) - (bcStrings (6 "0.0" m25 F)) - (bcStrings (6 "0.0" m26 F)) - (bcStrings (6 "0.0" m27 F)) - (bcStrings (6 "0.0" m28 F)) - (bcStrings (6 "0.0" m29 F)) - (bcStrings (6 "0.0" m210 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m31 F)) - (bcStrings (6 "1.0" m32 F)) - (bcStrings (6 "2.0" m33 F)) - (bcStrings (6 "1.0" m34 F)) - (bcStrings (6 "0.0" m35 F)) - (bcStrings (6 "0.0" m36 F)) - (bcStrings (6 "0.0" m37 F)) - (bcStrings (6 "0.0" m38 F)) - (bcStrings (6 "0.0" m39 F)) - (bcStrings (6 "0.0" m310 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m41 F)) - (bcStrings (6 "0.0" m42 F)) - (bcStrings (6 "1.0" m43 F)) - (bcStrings (6 "2.0" m44 F)) - (bcStrings (6 "1.0" m45 F)) - (bcStrings (6 "0.0" m46 F)) - (bcStrings (6 "0.0" m47 F)) - (bcStrings (6 "0.0" m48 F)) - (bcStrings (6 "0.0" m49 F)) - (bcStrings (6 "0.0" m410 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m51 F)) - (bcStrings (6 "0.0" m52 F)) - (bcStrings (6 "0.0" m53 F)) - (bcStrings (6 "1.0" m54 F)) - (bcStrings (6 "2.0" m55 F)) - (bcStrings (6 "1.0" m56 F)) - (bcStrings (6 "0.0" m57 F)) - (bcStrings (6 "0.0" m58 F)) - (bcStrings (6 "0.0" m59 F)) - (bcStrings (6 "0.0" m510 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m61 F)) - (bcStrings (6 "0.0" m62 F)) - (bcStrings (6 "0.0" m63 F)) - (bcStrings (6 "0.0" m64 F)) - (bcStrings (6 "1.0" m65 F)) - (bcStrings (6 "2.0" m66 F)) - (bcStrings (6 "1.0" m67 F)) - (bcStrings (6 "0.0" m68 F)) - (bcStrings (6 "0.0" m69 F)) - (bcStrings (6 "0.0" m610 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m71 F)) - (bcStrings (6 "0.0" m72 F)) - (bcStrings (6 "0.0" m73 F)) - (bcStrings (6 "0.0" m74 F)) - (bcStrings (6 "0.0" m75 F)) - (bcStrings (6 "1.0" m76 F)) - (bcStrings (6 "2.0" m77 F)) - (bcStrings (6 "1.0" m78 F)) - (bcStrings (6 "0.0" m79 F)) - (bcStrings (6 "0.0" m710 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m81 F)) - (bcStrings (6 "0.0" m82 F)) - (bcStrings (6 "0.0" m83 F)) - (bcStrings (6 "0.0" m84 F)) - (bcStrings (6 "0.0" m85 F)) - (bcStrings (6 "0.0" m86 F)) - (bcStrings (6 "1.0" m87 F)) - (bcStrings (6 "2.0" m88 F)) - (bcStrings (6 "1.0" m89 F)) - (bcStrings (6 "0.0" m810 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m91 F)) - (bcStrings (6 "0.0" m92 F)) - (bcStrings (6 "0.0" m93 F)) - (bcStrings (6 "0.0" m94 F)) - (bcStrings (6 "0.0" m95 F)) - (bcStrings (6 "0.0" m96 F)) - (bcStrings (6 "0.0" m97 F)) - (bcStrings (6 "1.0" m98 F)) - (bcStrings (6 "2.0" m99 F)) - (bcStrings (6 "1.0" m910 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" m101 F)) - (bcStrings (6 "0.0" m102 F)) - (bcStrings (6 "0.0" m103 F)) - (bcStrings (6 "0.0" m104 F)) - (bcStrings (6 "0.0" m105 F)) - (bcStrings (6 "0.0" m106 F)) - (bcStrings (6 "0.0" m107 F)) - (bcStrings (6 "0.0" m108 F)) - (bcStrings (6 "1.0" m109 F)) - (bcStrings (6 "2.0" m1010 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f04mbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'precon,precon) - htpSetProperty(page,'shift,shift) - htpSetProperty(page,'rtol,rtol) - htpSetProperty(page,'itnlim,itnlim) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04mbfGen htPage == - n := htpProperty(htPage,'n) - precon := htpProperty(htPage,'precon) - shift := htpProperty(htPage,'shift) - rtol := htpProperty(htPage,'rtol) - itnlim := htpProperty(htPage,'itnlim) - msglvl := htpProperty(htPage,'msglvl) - ifail := htpProperty(htPage,'ifail) - lrwork := '1 - liwork := '1 - alist := htpInputAreaAlist htPage - y := alist - if (precon = 'true) then - for i in 1..n repeat - for j in 1..n repeat - melm := STRCONC((first y).1," ") - mrowlist := [melm,:mrowlist] - y := rest y - matm := [mrowlist,:matm] - mrowlist := [] - mstring := bcwords2liststring [bcwords2liststring x for x in matm] - for k in 1..n repeat - for l in 1..n repeat - aelm := STRCONC((first y).1," ") - arowlist := [aelm,:arowlist] - y := rest y - mata := [arowlist,:mata] - arowlist := [] - astring := bcwords2liststring [bcwords2liststring y for y in mata] - for z in 1..n repeat - belm := STRCONC((first y).1," ") - blist := [belm,:blist] - y := rest y - bstring := bcwords2liststring blist - if (precon = 'false) then - mstring := astring - prefix := STRCONC('"f04mbf(",STRINGIMAGE n,",[",bstring,"]::Matrix DoubleFloat,",precon,",") - prefix := STRCONC(prefix,STRINGIMAGE shift,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",") - prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",") - prefix := STRCONC(prefix,STRINGIMAGE rtol,",",STRINGIMAGE ifail,",((") - prefix := STRCONC(prefix,astring,"::Matrix MachineFloat)::ASP28(APROD)),((") - prefix := STRCONC(prefix,mstring,"::Matrix MachineFloat)::ASP34(MSOLVE)))") - linkGen prefix - - --- f04qaf() == --- htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) --- htMakePage '( --- (domainConditions --- (isDomain EM $EmptyMode) --- (isDomain F (Float))) --- (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ") --- (text . "\newline ") --- (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine") --- (text . "\newline \horizontalline ") --- (text . "\newline ") --- (text . "F04QAF solves sparse unsymmetric equations, sparse linear ") --- (text . "least-squares problems and sparse damped least-squares ") --- (text . "problems, using a Lanczos algorithm. Specifically, the ") --- (text . "routine can be used to solve a system of linear equations ") --- (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ") --- (text . "sparse unsymmetric matrix, or can be used to solve linear ") --- (text . "least-squares problems, so that it minimizes the the value ") --- (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ") --- (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ") --- (text . "sparse matrix. A damping parameter \lambda may ") --- (text . "be included in the least squares problem in which case the ") --- (text . "routine minimizes the value {\htbitmap{newrho}} given by ") --- (text . "{\htbitmap{rhosq=}}. \newline ") --- (text . "\blankline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "\spadcommand{)read f04qaf \bound{s0}} ")) --- htShowPage() - --- f04mbf() == --- htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) --- htMakePage '( --- (domainConditions --- (isDomain EM $EmptyMode) --- (isDomain F (Float))) --- (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ") --- (text . "\newline ") --- (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine") --- (text . "\newline \horizontalline ") --- (text . "\newline ") --- (text . "\newline ") --- (text . "F04MBF solve a system of real symmetric linear equations ") --- (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ") --- (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ") --- (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ") --- (text . "and {\it b} is an {\it n} element right-hand side vector. ") --- (text . "\blankline") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2} ") --- (text . "\spadcommand{)read f04mbf \bound{s0}} ")) --- htShowPage() - -f04qaf() == - htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "F04QAF solves sparse unsymmetric equations, sparse linear ") - (text . "least-squares problems and sparse damped least-squares ") - (text . "problems, using a Lanczos algorithm. Specifically, the ") - (text . "routine can be used to solve a system of linear equations ") - (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ") - (text . "sparse unsymmetric matrix, or can be used to solve linear ") - (text . "least-squares problems, so that it minimizes the the value ") - (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ") - (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ") - (text . "sparse matrix. A damping parameter \lambda may ") - (text . "be included in the least squares problem in which case the ") - (text . "routine minimizes the value {\htbitmap{newrho}} given by ") - (text . "{\htbitmap{rhosq=}}. \newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of rows of the matrix {\it A}, {\it m}:") - (text . "\newline \tab{2}") - (bcStrings (10 13 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of columns of the matrix {\it A}, {\it n}:") - (text . "\newline \tab{2}") - (bcStrings (10 12 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the damping parameter \lambda, {\it damp}:") - (text . "\newline \tab{2}") - (bcStrings (10 "0.0" damp F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the tolerance for elements of {\it A}, {\it atol}:") - (text . "\newline \tab{2}") - (bcStrings (10 "0.00001" atol F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the tolerance for elements of {\it b}, {\it btol}:") - (text . "\newline \tab{2}") - (bcStrings (10 "0.0001" btol F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the maximum number of iterations {\it itnlim}:") - (text . "\newline \tab{2}") - (bcStrings (10 100 itnlim PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the printing level {\it msglvl}:") - (text . "\newline \tab{2}") - (bcStrings (10 1 msglvl PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value: ") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'f04qafSolve) - htShowPage() - -f04qafSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - damp := htpLabelInputString(htPage,'damp) - atol := htpLabelInputString(htPage,'atol) - btol := htpLabelInputString(htPage,'btol) - itnlim := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim) - objValUnwrap htpLabelSpadValue(htPage, 'itnlim) - msglvl := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl) - objValUnwrap htpLabelSpadValue(htPage, 'msglvl) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '13 and n = '12) => f04qafDefaultSolve(htPage,damp,atol,btol,itnlim,msglvl,ifail) - bmatList := - "append"/[f(i) for i in 1..m] where f(i) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i) - [['bcStrings,[6, "0.0", bnam, 'F]]] - amatList := - "append"/[h(ia,n) for ia in 1..m] where h(ia,n) == - alabelList := - "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) == - anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - alabelList := [['text,:prefix],:alabelList] - start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ") - amatList := [['text,:start],:amatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain F (Float))), - :bmatList,:amatList] - page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) - htSay '"\newline \menuitemstyle{}\tab{2} " - htSay '"Enter the right-hand side vector {\it b(m)}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f04qafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'n,n) - htpSetProperty(page,'damp,damp) - htpSetProperty(page,'atol,atol) - htpSetProperty(page,'btol,btol) - htpSetProperty(page,'itnlim,itnlim) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - - -f04qafDefaultSolve (htPage,damp,atol,btol,itnlim,msglvl,ifail) == - m := '13 - n := '12 - page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) - htMakePage '( - (domainConditions - (isDomain F (Float))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the right-hand side vector {\it b(n)}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b1 F)) - (bcStrings (6 "0.0" b2 F)) - (bcStrings (6 "0.0" b3 F)) - (bcStrings (6 "-0.01" b4 F)) - (bcStrings (6 "-0.01" b5 F)) - (bcStrings (6 "0.0" b6 F)) - (bcStrings (6 "0.0" b7 F)) - (bcStrings (6 "-0.01" b8 F)) - (bcStrings (6 "-0.01" b9 F)) - (bcStrings (6 "0.0" b10 F)) - (bcStrings (6 "0.0" b11 F)) - (bcStrings (6 "0.0" b12 F)) - (bcStrings (6 "10.0" b13 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the matrix {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "1.0" a0101 F)) - (bcStrings (6 "0.0" a0102 F)) - (bcStrings (6 "0.0" a0103 F)) - (bcStrings (6 "-1.0" a0104 F)) - (bcStrings (6 "0.0" a0105 F)) - (bcStrings (6 "0.0" a0106 F)) - (bcStrings (6 "0.0" a0107 F)) - (bcStrings (6 "0.0" a0108 F)) - (bcStrings (6 "0.0" a0109 F)) - (bcStrings (6 "0.0" a0110 F)) - (bcStrings (6 "0.0" a0111 F)) - (bcStrings (6 "0.0" a0112 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0201 F)) - (bcStrings (6 "1.0" a0202 F)) - (bcStrings (6 "0.0" a0203 F)) - (bcStrings (6 "0.0" a0204 F)) - (bcStrings (6 "-1.0" a0205 F)) - (bcStrings (6 "0.0" a0206 F)) - (bcStrings (6 "0.0" a0207 F)) - (bcStrings (6 "0.0" a0208 F)) - (bcStrings (6 "0.0" a0209 F)) - (bcStrings (6 "0.0" a0210 F)) - (bcStrings (6 "0.0" a0211 F)) - (bcStrings (6 "0.0" a0212 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0301 F)) - (bcStrings (6 "0.0" a0302 F)) - (bcStrings (6 "1.0" a0303 F)) - (bcStrings (6 "-1.0" a0304 F)) - (bcStrings (6 "0.0" a0305 F)) - (bcStrings (6 "0.0" a0306 F)) - (bcStrings (6 "0.0" a0307 F)) - (bcStrings (6 "0.0" a0308 F)) - (bcStrings (6 "0.0" a0309 F)) - (bcStrings (6 "0.0" a0310 F)) - (bcStrings (6 "0.0" a0311 F)) - (bcStrings (6 "0.0" a0312 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-1.0" a0401 F)) - (bcStrings (6 "0.0" a0402 F)) - (bcStrings (6 "-1.0" a0403 F)) - (bcStrings (6 "4.0" a0404 F)) - (bcStrings (6 "-1.0" a0405 F)) - (bcStrings (6 "0.0" a0406 F)) - (bcStrings (6 "0.0" a0407 F)) - (bcStrings (6 "-1.0" a0408 F)) - (bcStrings (6 "0.0" a0409 F)) - (bcStrings (6 "0.0" a0410 F)) - (bcStrings (6 "0.0" a0411 F)) - (bcStrings (6 "0.0" a0412 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0501 F)) - (bcStrings (6 "-1.0" a0502 F)) - (bcStrings (6 "0.0" a0503 F)) - (bcStrings (6 "-1.0" a0504 F)) - (bcStrings (6 "4.0" a0505 F)) - (bcStrings (6 "-1.0" a0506 F)) - (bcStrings (6 "0.0" a0507 F)) - (bcStrings (6 "0.0" a0508 F)) - (bcStrings (6 "-1.0" a0509 F)) - (bcStrings (6 "0.0" a0510 F)) - (bcStrings (6 "0.0" a0511 F)) - (bcStrings (6 "0.0" a0512 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0601 F)) - (bcStrings (6 "0.0" a0602 F)) - (bcStrings (6 "0.0" a0603 F)) - (bcStrings (6 "0.0" a0604 F)) - (bcStrings (6 "-1.0" a0605 F)) - (bcStrings (6 "1.0" a0606 F)) - (bcStrings (6 "0.0" a0607 F)) - (bcStrings (6 "0.0" a0608 F)) - (bcStrings (6 "0.0" a0609 F)) - (bcStrings (6 "0.0" a0610 F)) - (bcStrings (6 "0.0" a0611 F)) - (bcStrings (6 "0.0" a0612 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0701 F)) - (bcStrings (6 "0.0" a0702 F)) - (bcStrings (6 "0.0" a0703 F)) - (bcStrings (6 "0.0" a0704 F)) - (bcStrings (6 "0.0" a0705 F)) - (bcStrings (6 "0.0" a0706 F)) - (bcStrings (6 "1.0" a0707 F)) - (bcStrings (6 "-1.0" a0708 F)) - (bcStrings (6 "0.0" a0709 F)) - (bcStrings (6 "0.0" a0710 F)) - (bcStrings (6 "0.0" a0711 F)) - (bcStrings (6 "0.0" a0712 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0801 F)) - (bcStrings (6 "0.0" a0802 F)) - (bcStrings (6 "0.0" a0803 F)) - (bcStrings (6 "-1.0" a0804 F)) - (bcStrings (6 "0.0" a0805 F)) - (bcStrings (6 "0.0" a0806 F)) - (bcStrings (6 "-1.0" a0807 F)) - (bcStrings (6 "4.0" a0808 F)) - (bcStrings (6 "-1.0" a0809 F)) - (bcStrings (6 "0.0" a0810 F)) - (bcStrings (6 "-1.0" a0811 F)) - (bcStrings (6 "0.0" a0812 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a0901 F)) - (bcStrings (6 "0.0" a0902 F)) - (bcStrings (6 "0.0" a0903 F)) - (bcStrings (6 "0.0" a0904 F)) - (bcStrings (6 "-1.0" a0905 F)) - (bcStrings (6 "0.0" a0906 F)) - (bcStrings (6 "0.0" a0907 F)) - (bcStrings (6 "-1.0" a0908 F)) - (bcStrings (6 "4.0" a0909 F)) - (bcStrings (6 "-1.0" a0910 F)) - (bcStrings (6 "0.0" a0911 F)) - (bcStrings (6 "-1.0" a0912 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a1001 F)) - (bcStrings (6 "0.0" a1002 F)) - (bcStrings (6 "0.0" a1003 F)) - (bcStrings (6 "0.0" a1004 F)) - (bcStrings (6 "0.0" a1005 F)) - (bcStrings (6 "0.0" a1006 F)) - (bcStrings (6 "0.0" a1007 F)) - (bcStrings (6 "0.0" a1008 F)) - (bcStrings (6 "-1.0" a1009 F)) - (bcStrings (6 "1.0" a1010 F)) - (bcStrings (6 "0.0" a1011 F)) - (bcStrings (6 "0.0" a1012 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a1101 F)) - (bcStrings (6 "0.0" a1102 F)) - (bcStrings (6 "0.0" a1103 F)) - (bcStrings (6 "0.0" a1104 F)) - (bcStrings (6 "0.0" a1105 F)) - (bcStrings (6 "0.0" a1106 F)) - (bcStrings (6 "0.0" a1107 F)) - (bcStrings (6 "-1.0" a1108 F)) - (bcStrings (6 "0.0" a1109 F)) - (bcStrings (6 "0.0" a1110 F)) - (bcStrings (6 "1.0" a1111 F)) - (bcStrings (6 "0.0" a1112 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a1201 F)) - (bcStrings (6 "0.0" a1202 F)) - (bcStrings (6 "0.0" a1203 F)) - (bcStrings (6 "0.0" a1204 F)) - (bcStrings (6 "0.0" a1205 F)) - (bcStrings (6 "0.0" a1206 F)) - (bcStrings (6 "0.0" a1207 F)) - (bcStrings (6 "0.0" a1208 F)) - (bcStrings (6 "-1.0" a1209 F)) - (bcStrings (6 "0.0" a1210 F)) - (bcStrings (6 "0.0" a1211 F)) - (bcStrings (6 "1.0" a1212 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.0" a1301 F)) - (bcStrings (6 "1.0" a1302 F)) - (bcStrings (6 "1.0" a1303 F)) - (bcStrings (6 "0.0" a1304 F)) - (bcStrings (6 "0.0" a1305 F)) - (bcStrings (6 "1.0" a1306 F)) - (bcStrings (6 "1.0" a1307 F)) - (bcStrings (6 "0.0" a1308 F)) - (bcStrings (6 "0.0" a1309 F)) - (bcStrings (6 "1.0" a1310 F)) - (bcStrings (6 "1.0" a1311 F)) - (bcStrings (6 "1.0" a1312 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f04qafGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'n,n) - htpSetProperty(page,'damp,damp) - htpSetProperty(page,'atol,atol) - htpSetProperty(page,'btol,btol) - htpSetProperty(page,'itnlim,itnlim) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f04qafGen htPage == - m := htpProperty(htPage,'m) - n := htpProperty(htPage,'n) - damp := htpProperty(htPage,'damp) - atol := htpProperty(htPage,'atol) - btol := htpProperty(htPage,'btol) - divisor := READ_-FROM_-STRING(atol) - if (divisor < 1.0e-7) then divisor:=1.0e-7 - conlim := 1.0/divisor - itnlim := htpProperty(htPage,'itnlim) - msglvl := htpProperty(htPage,'msglvl) - ifail := htpProperty(htPage,'ifail) - lrwork := 1 - liwork := 1 - alist := htpInputAreaAlist htPage - y := alist - for k in 1..m repeat - for l in 1..n repeat - aelm := STRCONC((first y).1," ") - arowlist := [aelm,:arowlist] - y := rest y - mata := [arowlist,:mata] - arowlist := [] - astring := bcwords2liststring [bcwords2liststring y for y in mata] - for z in 1..m repeat - belm := STRCONC((first y).1," ") - blist := [belm,:blist] - y := rest y - bstring := bcwords2liststring blist - prefix := STRCONC('"f04qaf(",STRINGIMAGE m,",",STRINGIMAGE n,",") - prefix := STRCONC(prefix,STRINGIMAGE damp,",") - prefix := STRCONC(prefix,STRINGIMAGE atol,",",STRINGIMAGE btol,",") - prefix := STRCONC(prefix,STRINGIMAGE conlim,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",") - prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",") - prefix := STRCONC(prefix,"[",bstring,"]::Matrix DoubleFloat,") - prefix := STRCONC(prefix,STRINGIMAGE ifail,",((",astring,"::Matrix MachineFloat)::ASP30(APROD)))") - linkGen prefix - - - - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-f04.lisp.pamphlet b/src/interp/nag-f04.lisp.pamphlet new file mode 100644 index 0000000..ca8902a --- /dev/null +++ b/src/interp/nag-f04.lisp.pamphlet @@ -0,0 +1,5772 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp nag-f04.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-PACKAGE "BOOT" ) + +;f04adf() == +; htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain I (Integer))) +; (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04adf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Calculates the approximate solution of a set of complex linear ") +; (text . "equations {\it AX = B} using an {\it LU} factorization with ") +; (text . "partial pivoting, where {\it A} is an n * n matrix, {\it X} is ") +; (text . "an {\it n} by {\it m} matrix of unknowns and {\it B} is an ") +; (text . "{\it n} by {\it m} matrix of right-hand sides.") +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "{\it n} order of matrix A:") +; (text . "\tab{28} \menuitemstyle{}\tab{30} ") +; (text . "{\it m} number of right-hand sides \htbitmap{great=} 0 :") +; (text . "\newline\tab{2} ") +; (bcStrings (10 3 n I)) +; (text . "\tab{30} ") +; (bcStrings (10 1 m I)) +;-- (text . "\blankline ") +;-- (text . "\newline \menuitemstyle{}\tab{2} ") +;-- (text . "{\it IA} first dimension of A:") +;-- (text . "\tab{32} \menuitemstyle{}\tab{34} ") +;-- (text . "{\it IB} first dimension of B:") +;-- (text . "\newline\tab{2} ") +;-- (bcStrings (10 3 ia I)) +;-- (text . "\tab{34} ") +;-- (bcStrings (10 3 ib I)) +;-- (text . "\blankline ") +;-- (text . "\newline \menuitemstyle{}\tab{2} ") +;-- (text . "{\it IC} first dimension of C:") +;-- (text . "\newline\tab{2} ") +;-- (bcStrings (10 3 ic I)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{} \tab{2} ") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'f04adfSolve) +; htShowPage() + +(DEFUN |f04adf| () + (PROGN + (|htInitPage| + '|F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)| + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| I (|Integer|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04adf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04adf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Calculates the approximate solution of a set of complex linear ") + (|text| + . "equations {\\it AX = B} using an {\\it LU} factorization with ") + (|text| + . "partial pivoting, where {\\it A} is an n * n matrix, {\\it X} is ") + (|text| + . "an {\\it n} by {\\it m} matrix of unknowns and {\\it B} is an ") + (|text| . "{\\it n} by {\\it m} matrix of right-hand sides.") + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "{\\it n} order of matrix A:") + (|text| . "\\tab{28} \\menuitemstyle{}\\tab{30} ") + (|text| + . "{\\it m} number of right-hand sides \\htbitmap{great=} 0 :") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (10 3 |n| I)) + (|text| . "\\tab{30} ") (|bcStrings| (10 1 |m| I)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{} \\tab{2} ") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04adfSolve|) + (|htShowPage|))) + +;f04adfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; ib := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ib) +; ic := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ic) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ic) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; (n = '3 and m = '1) => f04adfDefaultSolve(htPage,ifail) +; matList := +; "append"/[f(i,n) for i in 1..ia] where f(i,n) == +; labelList := +; "append"/[g(i,j) for j in 1..n] where g(i,j) == +; ianam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[12, "0.0 + 0.0*%i", ianam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; bmatList := +; "append"/[fb(i,m) for i in 1..ib] where fb(i,m) == +; blabelList := +; "append"/[gb(i,j) for j in 1..m] where gb(i,j) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[12, "0.0 + 0.0*%i", bnam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; blabelList := [['text,:prefix],:blabelList] +; start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") +; bmatList := [['text,:start],:bmatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain F (Float))), +; :matList,:bmatList] +; page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f04adfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ib,ib) +;-- htpSetProperty(page,'ic,ic) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04adfSolve,g| (|i| |j|) + (PROG (|ianam|) + (RETURN + (SEQ (SPADLET |ianam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 12 + (CONS '|0.0 + 0.0*%i| + (CONS |ianam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04adfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166071) + (SPADLET G166071 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166071) + (SEQ (EXIT (SETQ G166071 + (APPEND G166071 + (|f04adfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f04adfSolve,gb| (|i| |j|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 12 + (CONS '|0.0 + 0.0*%i| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04adfSolve,fb| (|i| |m|) + (PROG (|prefix| |blabelList|) + (RETURN + (SEQ (SPADLET |blabelList| + (PROG (G166094) + (SPADLET G166094 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |m|) G166094) + (SEQ (EXIT (SETQ G166094 + (APPEND G166094 + (|f04adfSolve,gb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |blabelList| + (CONS (CONS '|text| |prefix|) |blabelList|))))))) + +(DEFUN |f04adfSolve| (|htPage|) + (PROG (|n| |m| |ia| |ib| |ic| |error| |ifail| |matList| |start| + |bmatList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |ia| |n|) + (SPADLET |ib| |n|) + (SPADLET |ic| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |n| '3) (BOOT-EQUAL |m| '1)) + (|f04adfDefaultSolve| |htPage| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166111) + (SPADLET G166111 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166111) + (SEQ (EXIT + (SETQ G166111 + (APPEND G166111 + (|f04adfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G166119) + (SPADLET G166119 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ib|) G166119) + (SEQ (EXIT + (SETQ G166119 + (APPEND G166119 + (|f04adfSolve,fb| |i| |m|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter values of {\\it b}:")) + (SPADLET |bmatList| + (CONS (CONS '|text| |start|) |bmatList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| F (|Float|))) + (APPEND |matList| |bmatList|))) + (SPADLET |page| + (|htInitPage| + '|F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f04adfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +; +; +;f04adfDefaultSolve (htPage, ifail) == +; n := '3 +; m := '1 +; ia := '3 +; ib := '3 +; ic := '3 +; page := htInitPage("F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (12 "1" a11 F)) +; (bcStrings (12 "1 + 2*%i" a12 F)) +; (bcStrings (12 "2 + 10*%i" a13 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (12 "1 + %i" a21 F)) +; (bcStrings (12 "3*%i" a22 F)) +; (bcStrings (12 "-5 + 14*%i" a23 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (12 "1 + %i" a31 F)) +; (bcStrings (12 "5*%i" a32 F)) +; (bcStrings (12 "-8 + 20*%i" a33 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (12 "1" b1 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (12 "0" b2 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (12 "0" b3 F))) +; htMakeDoneButton('"Continue",'f04adfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ib,ib) +;-- htpSetProperty(page,'ic,ic) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04adfDefaultSolve| (|htPage| |ifail|) + (PROG (|n| |m| |ia| |ib| |ic| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '1) + (SPADLET |ia| '3) + (SPADLET |ib| '3) + (SPADLET |ic| '3) + (SPADLET |page| + (|htInitPage| + '|F04ADF - Solution of complex simultaneous linear equations, with multiple right-hand sides (Black box)| + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (12 "1" |a11| F)) + (|bcStrings| (12 "1 + 2*%i" |a12| F)) + (|bcStrings| (12 "2 + 10*%i" |a13| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (12 "1 + %i" |a21| F)) + (|bcStrings| (12 "3*%i" |a22| F)) + (|bcStrings| (12 "-5 + 14*%i" |a23| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (12 "1 + %i" |a31| F)) + (|bcStrings| (12 "5*%i" |a32| F)) + (|bcStrings| (12 "-8 + 20*%i" |a33| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it b}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (12 "1" |b1| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (12 "0" |b2| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (12 "0" |b3| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04adfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f04adfGen htPage == +; n := htpProperty(htPage,'n) +; m := htpProperty(htPage,'m) +;-- ia := htpProperty(htPage,'ia) +;-- ib := htpProperty(htPage,'ib) +;-- ic := htpProperty(htPage,'ic) +; ia := n +; ib := n +; ic := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; -- will probably need to change this as its a vector not an array +; for i in 1..m repeat +; for j in 1..ib repeat +; right := STRCONC((first y).1," ") +; y := rest y +; bList := [right,:bList] +; bstring := bcwords2liststring bList +; boutList := [bstring,:boutList] +; bList := [] +; boutstring := bcwords2liststring boutList +; y := REVERSE y +; k := -1 +; matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f04adf(",STRINGIMAGE ia,",",boutstring,",") +; prefix := STRCONC(prefix,STRINGIMAGE ib,", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE m,", ",STRINGIMAGE ic) +; prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") +; bcGen prefix + +(DEFUN |f04adfGen| (|htPage|) + (PROG (|n| |m| |ia| |ib| |ic| |ifail| |alist| |right| |bstring| + |boutList| |bList| |boutstring| |y| |k| |matform| + |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |ia| |n|) + (SPADLET |ib| |n|) + (SPADLET |ic| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |m|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ib|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |right| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |bList| + (CONS |right| |bList|)) + (SPADLET |bstring| + (|bcwords2liststring| |bList|)))))) + (SPADLET |boutList| + (CONS |bstring| |boutList|)) + (SPADLET |bList| NIL))))) + (SPADLET |boutstring| (|bcwords2liststring| |boutList|)) + (SPADLET |y| (REVERSE |y|)) + (SPADLET |k| (SPADDIFFERENCE 1)) + (SPADLET |matform| + (PROG (G166185) + (SPADLET G166185 NIL) + (RETURN + (DO ((G166190 (SPADDIFFERENCE |ia| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G166190) + (NREVERSE0 G166185)) + (SEQ (EXIT (SETQ G166185 + (CONS + (PROG (G166198) + (SPADLET G166198 NIL) + (RETURN + (DO + ((G166203 + (SPADDIFFERENCE |n| 1)) + (|j| 0 (QSADD1 |j|))) + ((QSGREATERP |j| + G166203) + (NREVERSE0 G166198)) + (SEQ + (EXIT + (SETQ G166198 + (CONS + (ELT + (ELT |y| + (SPADLET |k| + (PLUS |k| 1))) + 1) + G166198))))))) + G166185)))))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166211) + (SPADLET G166211 NIL) + (RETURN + (DO ((G166216 |matform| + (CDR G166216)) + (|x| NIL)) + ((OR (ATOM G166216) + (PROGN + (SETQ |x| (CAR G166216)) + NIL)) + (NREVERSE0 G166211)) + (SEQ (EXIT + (SETQ G166211 + (CONS (|bcwords2liststring| |x|) + G166211))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f04adf(") + (STRINGIMAGE |ia|) '|,| |boutstring| + '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ib|) '|, | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |m|) '|, | + (STRINGIMAGE |ic|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | |matstring| '|, | + (STRINGIMAGE |ifail|) '|)|)) + (|bcGen| |prefix|)))))) + +;f04arf() == +; htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain I (Integer))) +; (text . "\windowlink{Manual Page}{manpageXXf04arf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04arf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\blankline ") +; (text . "Calculates the approximate solution of a set of real linear ") +; (text . "equations {\it Ax = b} using an {\it LU} factorization with ") +; (text . "pivoting, where {\it A} is an n * n matrix, {\it x} is an n ") +; (text . "element vector of unknowns and {\it b} is an n element ") +; (text . "right-hand side vector.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +;-- (text . "{\it IA} first dimension of A:") +;-- (text . "\tab{32} \menuitemstyle{}\tab{34} ") +; (text . "{\it n} order of matrix A:") +; (text . "\newline\tab{2} ") +;-- (bcStrings (10 8 ia I)) +;-- (text . "\tab{34} ") +; (bcStrings (10 3 n I)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{} \tab{2} ") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'f04arfSolve) +; htShowPage() + +(DEFUN |f04arf| () + (PROGN + (|htInitPage| + '|F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)| + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| I (|Integer|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04arf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04arf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\blankline ") + (|text| + . "Calculates the approximate solution of a set of real linear ") + (|text| + . "equations {\\it Ax = b} using an {\\it LU} factorization with ") + (|text| + . "pivoting, where {\\it A} is an n * n matrix, {\\it x} is an n ") + (|text| + . "element vector of unknowns and {\\it b} is an n element ") + (|text| . "right-hand side vector.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "{\\it n} order of matrix A:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (10 3 |n| I)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{} \\tab{2} ") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04arfSolve|) + (|htShowPage|))) + +;f04arfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '3 => f04arfDefaultSolve(htPage,ifail) +; matList := +; "append"/[f(i,n) for i in 1..ia] where f(i,n) == +; labelList := +; "append"/[g(i,j) for j in 1..n] where g(i,j) == +; ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", ianam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; bmatList := +; "append"/[h(k) for k in 1..n] where h(k) == +; prefix := ('"\newline \tab{2} ") +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k) +; [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] +; start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") +; bmatList := [['text,:start],:bmatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain F (Float))), +; :matList,:bmatList] +; page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f04arfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04arfSolve,g| (|i| |j|) + (PROG (|ianam|) + (RETURN + (SEQ (SPADLET |ianam| + (INTERN (STRCONC (MAKESTRING "ia") + (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |ianam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04arfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166265) + (SPADLET G166265 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166265) + (SEQ (EXIT (SETQ G166265 + (APPEND G166265 + (|f04arfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f04arfSolve,h| (|k|) + (PROG (|prefix| |bnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") + (STRINGIMAGE |k|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL))))))) + +(DEFUN |f04arfSolve| (|htPage|) + (PROG (|n| |ia| |error| |ifail| |matList| |start| |bmatList| + |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |ia| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '3) + (|f04arfDefaultSolve| |htPage| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166289) + (SPADLET G166289 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166289) + (SEQ (EXIT + (SETQ G166289 + (APPEND G166289 + (|f04arfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G166297) + (SPADLET G166297 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |n|) G166297) + (SEQ (EXIT + (SETQ G166297 + (APPEND G166297 + (|f04arfSolve,h| |k|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter values of {\\it b}:")) + (SPADLET |bmatList| + (CONS (CONS '|text| |start|) |bmatList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| F (|Float|))) + (APPEND |matList| |bmatList|))) + (SPADLET |page| + (|htInitPage| + '|F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f04arfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +; +; +;f04arfDefaultSolve (htPage, ifail) == +; n := '3 +; ia := '3 +; page := htInitPage("F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 33 ia11 F)) +; (bcStrings (6 16 ia12 F)) +; (bcStrings (6 72 ia13 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-24" ia21 F)) +; (bcStrings (6 "-10" ia22 F)) +; (bcStrings (6 "-57" ia23 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-8" ia31 F)) +; (bcStrings (6 "-4" ia32 F)) +; (bcStrings (6 "-17" ia33 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia41 F)) +;-- (bcStrings (6 0 ia42 F)) +;-- (bcStrings (6 0 ia43 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia51 F)) +;-- (bcStrings (6 0 ia52 F)) +;-- (bcStrings (6 0 ia53 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia61 F)) +;-- (bcStrings (6 0 ia62 F)) +;-- (bcStrings (6 0 ia63 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia71 F)) +;-- (bcStrings (6 0 ia72 F)) +;-- (bcStrings (6 0 ia73 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia81 F)) +;-- (bcStrings (6 0 ia82 F)) +;-- (bcStrings (6 0 ia83 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-359" b1 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "281" b2 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "85" b3 F))) +; htMakeDoneButton('"Continue",'f04arfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04arfDefaultSolve| (|htPage| |ifail|) + (PROG (|n| |ia| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |ia| '3) + (SPADLET |page| + (|htInitPage| + '|F04ARF - Solution of real simultaneous linear equations, one right-hand side (Black box)| + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 33 |ia11| F)) + (|bcStrings| (6 16 |ia12| F)) + (|bcStrings| (6 72 |ia13| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-24" |ia21| F)) + (|bcStrings| (6 "-10" |ia22| F)) + (|bcStrings| (6 "-57" |ia23| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-8" |ia31| F)) + (|bcStrings| (6 "-4" |ia32| F)) + (|bcStrings| (6 "-17" |ia33| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it b}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-359" |b1| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "281" |b2| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "85" |b3| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04arfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f04arfGen htPage == +; n := htpProperty(htPage,'n) +;-- ia := htpProperty(htPage,'ia) +; ia := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; right := STRCONC((first y).1," ") +; y := rest y +; bList := [right,:bList] +; bstring := bcwords2liststring bList +; y := REVERSE y +; k := -1 +; matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f04arf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n) +; prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") +; bcGen prefix + +(DEFUN |f04arfGen| (|htPage|) + (PROG (|n| |ia| |ifail| |alist| |right| |bList| |bstring| |y| |k| + |matform| |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |ia| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |right| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |bList| (CONS |right| |bList|)))))) + (SPADLET |bstring| (|bcwords2liststring| |bList|)) + (SPADLET |y| (REVERSE |y|)) + (SPADLET |k| (SPADDIFFERENCE 1)) + (SPADLET |matform| + (PROG (G166342) + (SPADLET G166342 NIL) + (RETURN + (DO ((G166347 (SPADDIFFERENCE |ia| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G166347) + (NREVERSE0 G166342)) + (SEQ (EXIT (SETQ G166342 + (CONS + (PROG (G166355) + (SPADLET G166355 NIL) + (RETURN + (DO + ((G166360 + (SPADDIFFERENCE |n| 1)) + (|j| 0 (QSADD1 |j|))) + ((QSGREATERP |j| + G166360) + (NREVERSE0 G166355)) + (SEQ + (EXIT + (SETQ G166355 + (CONS + (ELT + (ELT |y| + (SPADLET |k| + (PLUS |k| 1))) + 1) + G166355))))))) + G166342)))))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166368) + (SPADLET G166368 NIL) + (RETURN + (DO ((G166373 |matform| + (CDR G166373)) + (|x| NIL)) + ((OR (ATOM G166373) + (PROGN + (SETQ |x| (CAR G166373)) + NIL)) + (NREVERSE0 G166368)) + (SEQ (EXIT + (SETQ G166368 + (CONS (|bcwords2liststring| |x|) + G166368))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f04arf(") + (STRINGIMAGE |ia|) '|, [| |bstring| + '|],| (STRINGIMAGE |n|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | |matstring| '|, | + (STRINGIMAGE |ifail|) '|)|)) + (|bcGen| |prefix|)))))) + +;f04asf() == +; htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain I (Integer))) +; (text . "\windowlink{Manual Page}{manpageXXf04asf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04asf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\blankline ") +; (text . "Calculates the accurate solution of a set of real symmetric ") +; (text . "positive-definite linear equations {\it Ax = b} using an a ") +; (text . "Cholesky factorization and iterative refinement, ") +; (text . "where {\it A} is an n * n matrix, {\it x} is an n ") +; (text . "element vector of unknowns and {\it b} is an n element ") +; (text . "right-hand side vector.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +;-- (text . "{\it IA} first dimension of A:") +;-- (text . "\tab{32} \menuitemstyle{}\tab{34} ") +; (text . "{\it n} order of matrix A:") +; (text . "\newline\tab{2} ") +;-- (bcStrings (10 8 ia I)) +;-- (text . "\tab{34} ") +; (bcStrings (10 4 n I)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{} \tab{2} ") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'f04asfSolve) +; htShowPage() + +(DEFUN |f04asf| () + (PROGN + (|htInitPage| + '|F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)| + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| I (|Integer|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04asf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04asf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\blankline ") + (|text| + . "Calculates the accurate solution of a set of real symmetric ") + (|text| + . "positive-definite linear equations {\\it Ax = b} using an a ") + (|text| + . "Cholesky factorization and iterative refinement, ") + (|text| + . "where {\\it A} is an n * n matrix, {\\it x} is an n ") + (|text| + . "element vector of unknowns and {\\it b} is an n element ") + (|text| . "right-hand side vector.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "{\\it n} order of matrix A:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (10 4 |n| I)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{} \\tab{2} ") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04asfSolve|) + (|htShowPage|))) + +;f04asfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +;-- (n = '4 and ia = '8) => f04asfDefaultSolve(htPage,ifail) +; n = '4 => f04asfDefaultSolve(htPage,ifail) +; matList := +; "append"/[f(i,n) for i in 1..ia] where f(i,n) == +; labelList := +; "append"/[g(i,j) for j in 1..n] where g(i,j) == +; ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", ianam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; bmatList := +; "append"/[h(k) for k in 1..n] where h(k) == +; prefix := ('"\newline \tab{2} ") +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k) +; [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] +; start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") +; bmatList := [['text,:start],:bmatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain F (Float))), +; :matList,:bmatList] +; page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f04asfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04asfSolve,g| (|i| |j|) + (PROG (|ianam|) + (RETURN + (SEQ (SPADLET |ianam| + (INTERN (STRCONC (MAKESTRING "ia") + (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |ianam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04asfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166414) + (SPADLET G166414 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166414) + (SEQ (EXIT (SETQ G166414 + (APPEND G166414 + (|f04asfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f04asfSolve,h| (|k|) + (PROG (|prefix| |bnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") + (STRINGIMAGE |k|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL))))))) + +(DEFUN |f04asfSolve| (|htPage|) + (PROG (|n| |ia| |error| |ifail| |matList| |start| |bmatList| + |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |ia| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f04asfDefaultSolve| |htPage| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166438) + (SPADLET G166438 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166438) + (SEQ (EXIT + (SETQ G166438 + (APPEND G166438 + (|f04asfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G166446) + (SPADLET G166446 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |n|) G166446) + (SEQ (EXIT + (SETQ G166446 + (APPEND G166446 + (|f04asfSolve,h| |k|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter values of {\\it b}:")) + (SPADLET |bmatList| + (CONS (CONS '|text| |start|) |bmatList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| F (|Float|))) + (APPEND |matList| |bmatList|))) + (SPADLET |page| + (|htInitPage| + '|F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f04asfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +; +; +;f04asfDefaultSolve (htPage, ifail) == +; n := '4 +; ia := '4 +; page := htInitPage("F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 5 ia11 F)) +; (bcStrings (6 7 ia12 F)) +; (bcStrings (6 6 ia13 F)) +; (bcStrings (6 5 ia14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 7 ia21 F)) +; (bcStrings (6 10 ia22 F)) +; (bcStrings (6 8 ia23 F)) +; (bcStrings (6 7 ia24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 6 ia31 F)) +; (bcStrings (6 8 ia32 F)) +; (bcStrings (6 10 ia33 F)) +; (bcStrings (6 9 ia34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 5 ia41 F)) +; (bcStrings (6 7 ia42 F)) +; (bcStrings (6 9 ia43 F)) +; (bcStrings (6 10 ia44 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia51 F)) +;-- (bcStrings (6 0 ia52 F)) +;-- (bcStrings (6 0 ia53 F)) +;-- (bcStrings (6 0 ia54 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia61 F)) +;-- (bcStrings (6 0 ia62 F)) +;-- (bcStrings (6 0 ia63 F)) +;-- (bcStrings (6 0 ia64 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia71 F)) +;-- (bcStrings (6 0 ia72 F)) +;-- (bcStrings (6 0 ia73 F)) +;-- (bcStrings (6 0 ia74 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia81 F)) +;-- (bcStrings (6 0 ia82 F)) +;-- (bcStrings (6 0 ia83 F)) +;-- (bcStrings (6 0 ia84 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 23 b1 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 32 b2 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 33 b3 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 31 b4 F))) +; htMakeDoneButton('"Continue",'f04asfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04asfDefaultSolve| (|htPage| |ifail|) + (PROG (|n| |ia| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |ia| '4) + (SPADLET |page| + (|htInitPage| + '|F04ASF - Solution of real symmetric positive-definite simultaneous linear equations, one right-hand side using iterative refinement (Black box)| + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 5 |ia11| F)) (|bcStrings| (6 7 |ia12| F)) + (|bcStrings| (6 6 |ia13| F)) (|bcStrings| (6 5 |ia14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 7 |ia21| F)) + (|bcStrings| (6 10 |ia22| F)) + (|bcStrings| (6 8 |ia23| F)) (|bcStrings| (6 7 |ia24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 6 |ia31| F)) (|bcStrings| (6 8 |ia32| F)) + (|bcStrings| (6 10 |ia33| F)) + (|bcStrings| (6 9 |ia34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 5 |ia41| F)) (|bcStrings| (6 7 |ia42| F)) + (|bcStrings| (6 9 |ia43| F)) + (|bcStrings| (6 10 |ia44| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it b}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 23 |b1| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 32 |b2| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 33 |b3| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 31 |b4| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04asfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f04asfGen htPage == +; n := htpProperty(htPage,'n) +;-- ia := htpProperty(htPage,'ia) +; ia := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; right := STRCONC((first y).1," ") +; y := rest y +; bList := [right,:bList] +; bstring := bcwords2liststring bList +; y := REVERSE y +; k := -1 +; matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f04asf(",STRINGIMAGE ia,", [",bstring,"],",STRINGIMAGE n) +; prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") +; bcGen prefix + +(DEFUN |f04asfGen| (|htPage|) + (PROG (|n| |ia| |ifail| |alist| |right| |bList| |bstring| |y| |k| + |matform| |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |ia| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |right| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |bList| (CONS |right| |bList|)))))) + (SPADLET |bstring| (|bcwords2liststring| |bList|)) + (SPADLET |y| (REVERSE |y|)) + (SPADLET |k| (SPADDIFFERENCE 1)) + (SPADLET |matform| + (PROG (G166491) + (SPADLET G166491 NIL) + (RETURN + (DO ((G166496 (SPADDIFFERENCE |ia| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G166496) + (NREVERSE0 G166491)) + (SEQ (EXIT (SETQ G166491 + (CONS + (PROG (G166504) + (SPADLET G166504 NIL) + (RETURN + (DO + ((G166509 + (SPADDIFFERENCE |n| 1)) + (|j| 0 (QSADD1 |j|))) + ((QSGREATERP |j| + G166509) + (NREVERSE0 G166504)) + (SEQ + (EXIT + (SETQ G166504 + (CONS + (ELT + (ELT |y| + (SPADLET |k| + (PLUS |k| 1))) + 1) + G166504))))))) + G166491)))))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166517) + (SPADLET G166517 NIL) + (RETURN + (DO ((G166522 |matform| + (CDR G166522)) + (|x| NIL)) + ((OR (ATOM G166522) + (PROGN + (SETQ |x| (CAR G166522)) + NIL)) + (NREVERSE0 G166517)) + (SEQ (EXIT + (SETQ G166517 + (CONS (|bcwords2liststring| |x|) + G166517))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f04asf(") + (STRINGIMAGE |ia|) '|, [| |bstring| + '|],| (STRINGIMAGE |n|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | |matstring| '|, | + (STRINGIMAGE |ifail|) '|)|)) + (|bcGen| |prefix|)))))) + +;f04atf() == +; htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain I (Integer))) +; (text . "\windowlink{Manual Page}{manpageXXf04atf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04atf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\blankline ") +; (text . "Calculates the approximate solution of a set of real linear ") +; (text . "equations {\it Ax = b} using an {\it LU} factorization with ") +; (text . "pivoting and iterative refinement, ") +; (text . "where {\it A} is an n * n matrix, {\it x} is an n ") +; (text . "element vector of unknowns and {\it b} is an n element ") +; (text . "right-hand side vector.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +;-- (text . "{\it IA} first dimension of A:") +;-- (text . "\tab{32} \menuitemstyle{}\tab{34} ") +; (text . "{\it n} order of matrix A:") +; (text . "\newline\tab{2} ") +;-- (bcStrings (10 8 ia I)) +;-- (text . "\tab{34} ") +; (bcStrings (10 3 n I)) +;-- (text . "\blankline ") +;-- (text . "\newline \menuitemstyle{} \tab{2} ") +;-- (text . "{\it IAA} first dimension of AA:") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (10 8 iaa I)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{} \tab{2} ") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'f04atfSolve) +; htShowPage() + +(DEFUN |f04atf| () + (PROGN + (|htInitPage| + '|F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)| + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| I (|Integer|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04atf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04atf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\blankline ") + (|text| + . "Calculates the approximate solution of a set of real linear ") + (|text| + . "equations {\\it Ax = b} using an {\\it LU} factorization with ") + (|text| . "pivoting and iterative refinement, ") + (|text| + . "where {\\it A} is an n * n matrix, {\\it x} is an n ") + (|text| + . "element vector of unknowns and {\\it b} is an n element ") + (|text| . "right-hand side vector.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "{\\it n} order of matrix A:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (10 3 |n| I)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{} \\tab{2} ") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04atfSolve|) + (|htShowPage|))) + +;f04atfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; iaa := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iaa) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iaa) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +;-- (n = '3 and ia = '8) => f04atfDefaultSolve(htPage,iaa,ifail) +; n = '3 => f04atfDefaultSolve(htPage,iaa,ifail) +; matList := +; "append"/[f(i,n) for i in 1..ia] where f(i,n) == +; labelList := +; "append"/[g(i,j) for j in 1..n] where g(i,j) == +; ianam := INTERN STRCONC ('"ia",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", ianam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; bmatList := +; "append"/[h(k) for k in 1..n] where h(k) == +; prefix := ('"\newline \tab{2} ") +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k) +; [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] +; start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") +; bmatList := [['text,:start],:bmatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain F (Float))), +; :matList,:bmatList] +; page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f04atfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'iaa,iaa) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04atfSolve,g| (|i| |j|) + (PROG (|ianam|) + (RETURN + (SEQ (SPADLET |ianam| + (INTERN (STRCONC (MAKESTRING "ia") + (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |ianam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04atfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166563) + (SPADLET G166563 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166563) + (SEQ (EXIT (SETQ G166563 + (APPEND G166563 + (|f04atfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f04atfSolve,h| (|k|) + (PROG (|prefix| |bnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") + (STRINGIMAGE |k|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL))))))) + +(DEFUN |f04atfSolve| (|htPage|) + (PROG (|n| |ia| |iaa| |error| |ifail| |matList| |start| |bmatList| + |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |ia| |n|) + (SPADLET |iaa| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '3) + (|f04atfDefaultSolve| |htPage| |iaa| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166587) + (SPADLET G166587 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166587) + (SEQ (EXIT + (SETQ G166587 + (APPEND G166587 + (|f04atfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G166595) + (SPADLET G166595 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |n|) G166595) + (SEQ (EXIT + (SETQ G166595 + (APPEND G166595 + (|f04atfSolve,h| |k|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter values of {\\it b}:")) + (SPADLET |bmatList| + (CONS (CONS '|text| |start|) |bmatList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| F (|Float|))) + (APPEND |matList| |bmatList|))) + (SPADLET |page| + (|htInitPage| + '|F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f04atfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +; +; +;f04atfDefaultSolve (htPage, iaa, ifail) == +; n := '3 +; ia := '3 +; page := htInitPage("F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 33 ia11 F)) +; (bcStrings (6 16 ia12 F)) +; (bcStrings (6 72 ia13 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-24" ia21 F)) +; (bcStrings (6 "-10" ia22 F)) +; (bcStrings (6 "-57" ia23 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-8" ia31 F)) +; (bcStrings (6 "-4" ia32 F)) +; (bcStrings (6 "-17" ia33 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia41 F)) +;-- (bcStrings (6 0 ia42 F)) +;-- (bcStrings (6 0 ia43 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia51 F)) +;-- (bcStrings (6 0 ia52 F)) +;-- (bcStrings (6 0 ia53 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia61 F)) +;-- (bcStrings (6 0 ia62 F)) +;-- (bcStrings (6 0 ia63 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia71 F)) +;-- (bcStrings (6 0 ia72 F)) +;-- (bcStrings (6 0 ia73 F)) +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 0 ia81 F)) +;-- (bcStrings (6 0 ia82 F)) +;-- (bcStrings (6 0 ia83 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-359" b1 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "281" b2 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "85" b3 F))) +; htMakeDoneButton('"Continue",'f04atfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'iaa,iaa) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04atfDefaultSolve| (|htPage| |iaa| |ifail|) + (PROG (|n| |ia| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |ia| '3) + (SPADLET |page| + (|htInitPage| + '|F04ATF - Solution of real simultaneous linear equations, one right-hand side using iterative refinement (Black box)| + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 33 |ia11| F)) + (|bcStrings| (6 16 |ia12| F)) + (|bcStrings| (6 72 |ia13| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-24" |ia21| F)) + (|bcStrings| (6 "-10" |ia22| F)) + (|bcStrings| (6 "-57" |ia23| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-8" |ia31| F)) + (|bcStrings| (6 "-4" |ia32| F)) + (|bcStrings| (6 "-17" |ia33| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it b}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-359" |b1| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "281" |b2| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "85" |b3| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04atfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f04atfGen htPage == +; n := htpProperty(htPage,'n) +;-- ia := htpProperty(htPage,'ia) +;-- iaa := htpProperty(htPage,'iaa) +; ia := n +; iaa := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; right := STRCONC((first y).1," ") +; y := rest y +; bList := [right,:bList] +; bstring := bcwords2liststring bList +; y := REVERSE y +; k := -1 +; matform := [[y.(k := k + 1).1 for j in 0..(n-1)] for i in 0..(ia-1)] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f04atf(",matstring,", ",STRINGIMAGE ia,", [",bstring) +; prefix := STRCONC(prefix,"],",STRINGIMAGE n,", ",STRINGIMAGE iaa,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; bcGen prefix + +(DEFUN |f04atfGen| (|htPage|) + (PROG (|n| |ia| |iaa| |ifail| |alist| |right| |bList| |bstring| |y| + |k| |matform| |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |ia| |n|) + (SPADLET |iaa| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |right| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |bList| (CONS |right| |bList|)))))) + (SPADLET |bstring| (|bcwords2liststring| |bList|)) + (SPADLET |y| (REVERSE |y|)) + (SPADLET |k| (SPADDIFFERENCE 1)) + (SPADLET |matform| + (PROG (G166641) + (SPADLET G166641 NIL) + (RETURN + (DO ((G166646 (SPADDIFFERENCE |ia| 1)) + (|i| 0 (QSADD1 |i|))) + ((QSGREATERP |i| G166646) + (NREVERSE0 G166641)) + (SEQ (EXIT (SETQ G166641 + (CONS + (PROG (G166654) + (SPADLET G166654 NIL) + (RETURN + (DO + ((G166659 + (SPADDIFFERENCE |n| 1)) + (|j| 0 (QSADD1 |j|))) + ((QSGREATERP |j| + G166659) + (NREVERSE0 G166654)) + (SEQ + (EXIT + (SETQ G166654 + (CONS + (ELT + (ELT |y| + (SPADLET |k| + (PLUS |k| 1))) + 1) + G166654))))))) + G166641)))))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166667) + (SPADLET G166667 NIL) + (RETURN + (DO ((G166672 |matform| + (CDR G166672)) + (|x| NIL)) + ((OR (ATOM G166672) + (PROGN + (SETQ |x| (CAR G166672)) + NIL)) + (NREVERSE0 G166667)) + (SEQ (EXIT + (SETQ G166667 + (CONS (|bcwords2liststring| |x|) + G166667))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f04atf(") |matstring| '|, | + (STRINGIMAGE |ia|) '|, [| |bstring|)) + (SPADLET |prefix| + (STRCONC |prefix| '|],| (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |iaa|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|bcGen| |prefix|)))))) + +;f04faf() == +; htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf04adf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04faf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\blankline ") +; (text . "Calculates the approximate solution of a set of real symmetric ") +; (text . "positive-definite tridiagonal linear equations {\it Tx = b} ") +; (text . "using a modified symmetric Gaussian Elimination algorithm, ") +; (text . "where {\it T} is an n * n matrix, {\it x} is an n ") +; (text . "element vector of unknowns and {\it b} is an n element ") +; (text . "right-hand side vector. {\it T} is factorized as ") +; (text . "\inputbitmap{\htbmdir{}/mkm.bitmap}, where {\it K} is a diagonal matrix ") +; (text . "and {\it M} is a matrix of multipliers. ") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "{\it JOB} to be performed by f04faf: ") +; (radioButtons job +; ("" " = 0. {\it T} is factorized and equations {\it Tx = b} are solved for x." jobZero) +; ("" " = 1. {\it T} assumed to be already factorized by previous call to f04faf, the equations {\it Tx = b} are solved for x." jobOne)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "\newline Order of the matrix T {\it n}:") +; (text . "\newline \tab{2} ") +; (bcStrings (6 5 n PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "Ifail value: ") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'f04fafSolve) +; htShowPage() + +(DEFUN |f04faf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04adf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04faf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\blankline ") + (|text| + . "Calculates the approximate solution of a set of real symmetric ") + (|text| + . "positive-definite tridiagonal linear equations {\\it Tx = b} ") + (|text| + . "using a modified symmetric Gaussian Elimination algorithm, ") + (|text| + . "where {\\it T} is an n * n matrix, {\\it x} is an n ") + (|text| + . "element vector of unknowns and {\\it b} is an n element ") + (|text| + . "right-hand side vector. {\\it T} is factorized as ") + (|text| + . "\\inputbitmap{\\htbmdir{}/mkm.bitmap}, where {\\it K} is a diagonal matrix ") + (|text| . "and {\\it M} is a matrix of multipliers. ") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") + (|text| . "{\\it JOB} to be performed by f04faf: ") + (|radioButtons| |job| + ("" + " = 0. {\\it T} is factorized and equations {\\it Tx = b} are solved for x." + |jobZero|) + ("" + " = 1. {\\it T} assumed to be already factorized by previous call to f04faf, the equations {\\it Tx = b} are solved for x." + |jobOne|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "\\newline Order of the matrix T {\\it n}:") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 5 |n| PI)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") (|text| . "Ifail value: ") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04fafSolve|) + (|htShowPage|))) + +;f04fafSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; number := htpButtonValue(htPage,'job) +; job := +; number = 'jobOne => '1 +; '0 +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '5 => f04fafDefaultSolve(htPage,job,ifail) +; dList := +; "append"/[f(i) for i in 1..n] where f(i) == +; prefix := ('"\newline \tab{2} ") +; dnam := INTERN STRCONC ('"d",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[10, 0.0, dnam, 'F]]] +; prefix := ('"\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T: ") +; prefix := STRCONC(prefix,"\newline \tab{2} ") +; dList := [['text,:prefix],:dList] +; eList := +; "append"/[g(j) for j in 1..(n-1)] where g(j) == +; prefix := ('"\newline \tab{2} ") +; enam := INTERN STRCONC ('"e",STRINGIMAGE j) +; [['text,:prefix],['bcStrings,[10, 0.0, enam, 'F]]] +; prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it E} E(2) ") +; prefix := STRCONC(prefix,"to E(N)\newline \tab{2} Job = 0 => super-diagonal") +; prefix := STRCONC(prefix," elements of {\it T}. \newline \tab{2} Job = 1 =>") +; prefix := STRCONC(prefix," off-diagonal elements of {\it M} from previous ") +; prefix := STRCONC(prefix,"call to F04FAF. ") +; eList := [['text,:prefix],:eList] +; bList := +; "append"/[h(k) for k in 1..n] where h(k) == +; prefix := ('"\newline \tab{2} ") +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k) +; [['text,:prefix],['bcStrings,[10, 0.0, bnam, 'F]]] +; prefix := ('"\blankline \newline \menuitemstyle{}\tab{2} {\it B} Right-hand") +; prefix := STRCONC(prefix," side vector b: ") +; bList := [['text,:prefix],:bList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :dList,:eList,:bList] +; page := htInitPage("F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) +; htMakePage equationPart +; htMakeDoneButton('"Continue",'f04fafGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'job,job) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04fafSolve,f| (|i|) + (PROG (|prefix| |dnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |dnam| + (INTERN (STRCONC (MAKESTRING "d") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 10 + (CONS 0.0 + (CONS |dnam| (CONS 'F NIL)))) + NIL)) + NIL))))))) + +(DEFUN |f04fafSolve,g| (|j|) + (PROG (|prefix| |enam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |enam| + (INTERN (STRCONC (MAKESTRING "e") + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 10 + (CONS 0.0 + (CONS |enam| (CONS 'F NIL)))) + NIL)) + NIL))))))) + + +(DEFUN |f04fafSolve,h| (|k|) + (PROG (|prefix| |bnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") + (STRINGIMAGE |k|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 10 + (CONS 0.0 + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL))))))) + +(DEFUN |f04fafSolve| (|htPage|) + (PROG (|n| |number| |job| |error| |ifail| |dList| |eList| |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 |number| (|htpButtonValue| |htPage| '|job|)) + (SPADLET |job| + (COND + ((BOOT-EQUAL |number| '|jobOne|) '1) + ('T '0))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '5) + (|f04fafDefaultSolve| |htPage| |job| |ifail|)) + ('T + (SPADLET |dList| + (PROG (G166731) + (SPADLET G166731 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166731) + (SEQ (EXIT + (SETQ G166731 + (APPEND G166731 + (|f04fafSolve,f| |i|))))))))) + (SPADLET |prefix| + (MAKESTRING + "\\menuitemstyle{}\\tab{2} {\\it D} Diagonal elements of T: ")) + (SPADLET |prefix| + (STRCONC |prefix| '|\\newline \\tab{2} |)) + (SPADLET |dList| + (CONS (CONS '|text| |prefix|) |dList|)) + (SPADLET |eList| + (PROG (G166739) + (SPADLET G166739 NIL) + (RETURN + (DO ((G166744 (SPADDIFFERENCE |n| 1)) + (|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| G166744) G166739) + (SEQ (EXIT + (SETQ G166739 + (APPEND G166739 + (|f04fafSolve,g| |j|))))))))) + (SPADLET |prefix| + (MAKESTRING + "\\blankline \\newline \\menuitemstyle{}\\tab{2} {\\it E} E(2) ")) + (SPADLET |prefix| + (STRCONC |prefix| + '|to E(N)\\newline \\tab{2} Job = 0 => super-diagonal|)) + (SPADLET |prefix| + (STRCONC |prefix| + '| elements of {\\it T}. \\newline \\tab{2} Job = 1 =>|)) + (SPADLET |prefix| + (STRCONC |prefix| + '| off-diagonal elements of {\\it M} from previous |)) + (SPADLET |prefix| + (STRCONC |prefix| '|call to F04FAF. |)) + (SPADLET |eList| + (CONS (CONS '|text| |prefix|) |eList|)) + (SPADLET |bList| + (PROG (G166748) + (SPADLET G166748 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |n|) G166748) + (SEQ (EXIT + (SETQ G166748 + (APPEND G166748 + (|f04fafSolve,h| |k|))))))))) + (SPADLET |prefix| + (MAKESTRING + "\\blankline \\newline \\menuitemstyle{}\\tab{2} {\\it B} Right-hand")) + (SPADLET |prefix| + (STRCONC |prefix| '| side vector b: |)) + (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |dList| + (APPEND |eList| |bList|)))) + (SPADLET |page| + (|htInitPage| + '|F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)| + NIL)) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f04fafGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|job| |job|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f04fafDefaultSolve (htPage,job,ifail) == +; n := '5 +; page := htInitPage('"F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} {\it D} Diagonal elements of T:") +; (text . "\newline \tab{2} ") +; (bcStrings (10 4 d1 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 10 d2 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 29 d3 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 25 d4 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 5 d5 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} {\it E}\space{1} E(2) to E(N) ") +; (text . "\newline \tab{2} ") +; (text . "Job = 0 => super-diagonal elements of {\it T}. \newline \tab{2}") +; (text . "Job = 1 => off-diagonal elements of {\it M} from ") +; (text . "previous call to F04FAF \newline \tab{2} ") +; (bcStrings (10 "-2" e2 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 "-6" e3 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 15 e4 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 8 e5 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} {\it B} Right-hand side vector b:") +; (text . "\newline \tab{2} ") +; (bcStrings (10 6 b1 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 9 b2 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 2 b3 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 14 b4 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (10 7 b5 F))) +; htMakeDoneButton('"Continue",'f04fafGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'job,job) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04fafDefaultSolve| (|htPage| |job| |ifail|) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '5) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F04FAF - Solution of real symmetric positive-definite tridiagonal simultaneous linear equations, one right-hand side (Black box)") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} {\\it D} Diagonal elements of T:") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 4 |d1| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 10 |d2| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 29 |d3| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 25 |d4| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 5 |d5| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} {\\it E}\\space{1} E(2) to E(N) ") + (|text| . "\\newline \\tab{2} ") + (|text| + . "Job = 0 => super-diagonal elements of {\\it T}. \\newline \\tab{2}") + (|text| + . "Job = 1 => off-diagonal elements of {\\it M} from ") + (|text| . "previous call to F04FAF \\newline \\tab{2} ") + (|bcStrings| (10 "-2" |e2| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 "-6" |e3| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 15 |e4| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 8 |e5| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} {\\it B} Right-hand side vector b:") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 6 |b1| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 9 |b2| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 2 |b3| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 14 |b4| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 7 |b5| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04fafGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|job| |job|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f04fafGen htPage == +; n := htpProperty(htPage,'n) +; job := htpProperty(htPage,'job) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; b := STRCONC((first y).1," ") +; bList := [b,:bList] +; y := rest y +; bstring := bcwords2liststring bList +; for i in 1..(n-1) repeat +; e := STRCONC((first y).1," ") +; eList := [e,:eList] +; y := rest y +; eList := ['"0",:eList] +; estring := bcwords2liststring eList +; for i in 1..n repeat +; d := STRCONC((first y).1," ") +; dList := [d,:dList] +; y := rest y +; dstring := bcwords2liststring dList +; prefix := STRCONC('"f04faf(",STRINGIMAGE job,", ",STRINGIMAGE n,",[") +; prefix := STRCONC(prefix,dstring,"], [",estring,"], [",bstring,"], ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; bcGen prefix + +(DEFUN |f04fafGen| (|htPage|) + (PROG (|n| |job| |ifail| |alist| |b| |bList| |bstring| |e| |eList| + |estring| |d| |dList| |y| |dstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |job| (|htpProperty| |htPage| '|job|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |b| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |bList| (CONS |b| |bList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bstring| (|bcwords2liststring| |bList|)) + (DO ((G166809 (SPADDIFFERENCE |n| 1)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166809) NIL) + (SEQ (EXIT (PROGN + (SPADLET |e| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |eList| (CONS |e| |eList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |eList| (CONS (MAKESTRING "0") |eList|)) + (SPADLET |estring| (|bcwords2liststring| |eList|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |d| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |dList| (CONS |d| |dList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |dstring| (|bcwords2liststring| |dList|)) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f04faf(") + (STRINGIMAGE |job|) '|, | + (STRINGIMAGE |n|) '|,[|)) + (SPADLET |prefix| + (STRCONC |prefix| |dstring| '|], [| |estring| + '|], [| |bstring| '|], |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|bcGen| |prefix|)))))) + +;f04jgf() == +; htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} it n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf04jgf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04jgf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\blankline ") +; (text . "Finds the solution of a linear least squares problem {\it Ax=b},") +; (text . " where A is a real m by n matrix, (m \inputbitmap{\htbmdir{}/great=.bitmap}") +; (text . " n), x is an n element vector of unknowns and b is an m element ") +; (text . "right-hand side vector. The routine uses a QU factorization if ") +; (text . "rank A = n and the SVD if A < n. ") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Rows of matrix A, {\it m}: ") +; (text . "\tab{32} \menuitemstyle{} \tab{34} ") +; (text . "Columns of matrix A, {\it n}: \newline \tab{2} ") +; (bcStrings (6 6 m PI)) +; (text . "\tab{34} ") +; (bcStrings (6 4 n PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it nra}: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +; (text . "Tolerance, {\it tol}: ") +; (text . "\newline \tab{2} ") +;-- (bcStrings (6 8 nra PI)) +;-- (text . "\tab{34} ") +; (bcStrings (8 "5.0e-4" tol F)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "\newline Dimension of workspace array {\it lwork}: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 32 lwork PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "Ifail value: ") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'f04jgfSolve) +; htShowPage() + +(DEFUN |f04jgf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \\inputbitmap{\\htbmdir{}/less=.bitmap} it n, m \\inputbitmap{\\htbmdir{}/great=.bitmap} n") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04jgf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04jgf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\blankline ") + (|text| + . "Finds the solution of a linear least squares problem {\\it Ax=b},") + (|text| + . " where A is a real m by n matrix, (m \\inputbitmap{\\htbmdir{}/great=.bitmap}") + (|text| + . " n), x is an n element vector of unknowns and b is an m element ") + (|text| + . "right-hand side vector. The routine uses a QU factorization if ") + (|text| . "rank A = n and the SVD if A < n. ") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Rows of matrix A, {\\it m}: ") + (|text| . "\\tab{32} \\menuitemstyle{} \\tab{34} ") + (|text| + . "Columns of matrix A, {\\it n}: \\newline \\tab{2} ") + (|bcStrings| (6 6 |m| PI)) (|text| . "\\tab{34} ") + (|bcStrings| (6 4 |n| PI)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "Tolerance, {\\it tol}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (8 "5.0e-4" |tol| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") (|text| . "Ifail value: ") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04jgfSolve|) + (|htShowPage|))) + +;f04jgfSolve htPage == +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; nra := m +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nra) +;-- objValUnwrap htpLabelSpadValue(htPage, 'nra) +; lwork := 4*n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork) +;-- objValUnwrap htpLabelSpadValue(htPage, 'lwork) +; tol := htpLabelInputString(htPage,'tol) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; (m = '6 and n = '4) => f04jgfDefaultSolve(htPage,nra,lwork,tol,ifail) +; matList := +; "append"/[f(i,n) for i in 1..m] where f(i,n) == +; labelList := +; "append"/[g(i,j) for j in 1..n] where g(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; bmatList := +; "append"/[h(k) for k in 1..m] where h(k) == +; prefix := ('"\newline \tab{2} ") +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k) +; [['text,:prefix],['bcStrings,[6, "0.0", bnam, 'F]]] +; start := ('"\blankline \menuitemstyle{} \tab{2} Enter values of {\it b}:") +; bmatList := [['text,:start],:bmatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList,:bmatList] +; page := htInitPage("F04JGF - Least-squares (if rank = {\it n}) or minimal least-squares (if rank < {\it n}) solution of {\it m} real equations in {\it n} unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} {\it n}, {\it m} \inputbitmap{\htbmdir{}/great=.bitmap} {\it n}",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f04jgfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +;-- htpSetProperty(page,'nra,nra) +;-- htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04jgfSolve,g| (|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.0| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04jgfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166860) + (SPADLET G166860 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166860) + (SEQ (EXIT (SETQ G166860 + (APPEND G166860 + (|f04jgfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f04jgfSolve,h| (|k|) + (PROG (|prefix| |bnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") + (STRINGIMAGE |k|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL))))))) + +(DEFUN |f04jgfSolve| (|htPage|) + (PROG (|m| |n| |nra| |lwork| |tol| |error| |ifail| |matList| |start| + |bmatList| |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 |nra| |m|) + (SPADLET |lwork| (TIMES 4 |n|)) + (SPADLET |tol| (|htpLabelInputString| |htPage| '|tol|)) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '6) (BOOT-EQUAL |n| '4)) + (|f04jgfDefaultSolve| |htPage| |nra| |lwork| |tol| + |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166884) + (SPADLET G166884 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |m|) G166884) + (SEQ (EXIT + (SETQ G166884 + (APPEND G166884 + (|f04jgfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G166892) + (SPADLET G166892 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |m|) G166892) + (SEQ (EXIT + (SETQ G166892 + (APPEND G166892 + (|f04jgfSolve,h| |k|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter values of {\\it b}:")) + (SPADLET |bmatList| + (CONS (CONS '|text| |start|) |bmatList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |matList| |bmatList|))) + (SPADLET |page| + (|htInitPage| + '|F04JGF - Least-squares (if rank = {\\it n}) or minimal least-squares (if rank < {\\it n}) solution of {\\it m} real equations in {\\it n} unknowns, rank \\inputbitmap{\\htbmdir{}/less=.bitmap} {\\it n}, {\\it m} \\inputbitmap{\\htbmdir{}/great=.bitmap} {\\it n}| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f04jgfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f04jgfDefaultSolve (htPage,nra,lwork,tol,ifail) == +; n := '4 +; m := '6 +; page := htInitPage('"F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \inputbitmap{\htbmdir{}/less=.bitmap} n, m \inputbitmap{\htbmdir{}/great=.bitmap} n",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.05" a11 F)) +; (bcStrings (6 "0.05" a12 F)) +; (bcStrings (6 "0.25" a13 F)) +; (bcStrings (6 "-0.25" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.25" a21 F)) +; (bcStrings (6 "0.25" a22 F)) +; (bcStrings (6 "0.05" a23 F)) +; (bcStrings (6 "-0.05" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.35" a31 F)) +; (bcStrings (6 "0.35" a32 F)) +; (bcStrings (6 "1.75" a33 F)) +; (bcStrings (6 "-1.75" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.75" a41 F)) +; (bcStrings (6 "1.75" a42 F)) +; (bcStrings (6 "0.35" a43 F)) +; (bcStrings (6 "-0.35" a44 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.30" a51 F)) +; (bcStrings (6 "-0.30" a52 F)) +; (bcStrings (6 "0.30" a53 F)) +; (bcStrings (6 "0.30" a54 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.40" a61 F)) +; (bcStrings (6 "-0.40" a62 F)) +; (bcStrings (6 "0.40" a63 F)) +; (bcStrings (6 "0.40" a64 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it b}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 b1 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 2 b2 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 3 b3 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 b4 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 5 b5 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 6 b6 F))) +; htMakeDoneButton('"Continue",'f04jgfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +;-- htpSetProperty(page,'nra,nra) +;-- htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04jgfDefaultSolve| (|htPage| |nra| |lwork| |tol| |ifail|) + (PROG (|n| |m| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |m| '6) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F04JGF - Least-squares (if rank = n) or minimal least-squares (if rank < n) solution of m real equations in n unknowns, rank \\inputbitmap{\\htbmdir{}/less=.bitmap} n, m \\inputbitmap{\\htbmdir{}/great=.bitmap} n") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.05" |a11| F)) + (|bcStrings| (6 "0.05" |a12| F)) + (|bcStrings| (6 "0.25" |a13| F)) + (|bcStrings| (6 "-0.25" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.25" |a21| F)) + (|bcStrings| (6 "0.25" |a22| F)) + (|bcStrings| (6 "0.05" |a23| F)) + (|bcStrings| (6 "-0.05" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.35" |a31| F)) + (|bcStrings| (6 "0.35" |a32| F)) + (|bcStrings| (6 "1.75" |a33| F)) + (|bcStrings| (6 "-1.75" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.75" |a41| F)) + (|bcStrings| (6 "1.75" |a42| F)) + (|bcStrings| (6 "0.35" |a43| F)) + (|bcStrings| (6 "-0.35" |a44| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.30" |a51| F)) + (|bcStrings| (6 "-0.30" |a52| F)) + (|bcStrings| (6 "0.30" |a53| F)) + (|bcStrings| (6 "0.30" |a54| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.40" |a61| F)) + (|bcStrings| (6 "-0.40" |a62| F)) + (|bcStrings| (6 "0.40" |a63| F)) + (|bcStrings| (6 "0.40" |a64| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it b}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |b1| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 2 |b2| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 3 |b3| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 4 |b4| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 5 |b5| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 6 |b6| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04jgfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f04jgfGen htPage == +; n := htpProperty(htPage,'n) +; m := htpProperty(htPage,'m) +;-- nra := htpProperty(htPage,'nra) +;-- lwork := htpProperty(htPage,'lwork) +; nra := m +; lwork := 4*n +; tol := htpProperty(htPage,'tol) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..m repeat +; b := STRCONC((first y).1," ") +; bList := [b,:bList] +; y := rest y +; bstring := bcwords2liststring bList +; y := REVERSE y +; for i in 1..m repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; matform := [:matform,rowList] +; rowList := [] +; for i in 1..n repeat +; null := STRCONC('"0.0"," ") +; nullList := [:nullList,null] +; for i in m..(nra-1) repeat +; matform := [:matform,nullList] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f04jgf(",STRINGIMAGE m,", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE nra,", ",tol,", ",STRINGIMAGE lwork) +; prefix := STRCONC(prefix,", ",matstring,", [",bstring,"], ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; bcGen prefix + +(DEFUN |f04jgfGen| (|htPage|) + (PROG (|n| |m| |nra| |lwork| |tol| |ifail| |alist| |b| |bList| + |bstring| |elm| |y| |rowList| NULL |nullList| |matform| + |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |nra| |m|) + (SPADLET |lwork| (TIMES 4 |n|)) + (SPADLET |tol| (|htpProperty| |htPage| '|tol|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |m|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |b| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |bList| (CONS |b| |bList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bstring| (|bcwords2liststring| |bList|)) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |m|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |matform| + (APPEND |matform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET NULL + (STRCONC (MAKESTRING "0.0") '| |)) + (SPADLET |nullList| + (APPEND |nullList| + (CONS NULL NIL))))))) + (DO ((G166971 (SPADDIFFERENCE |nra| 1)) + (|i| |m| (+ |i| 1))) + ((> |i| G166971) NIL) + (SEQ (EXIT (SPADLET |matform| + (APPEND |matform| + (CONS |nullList| NIL)))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166979) + (SPADLET G166979 NIL) + (RETURN + (DO ((G166984 |matform| + (CDR G166984)) + (|x| NIL)) + ((OR (ATOM G166984) + (PROGN + (SETQ |x| (CAR G166984)) + NIL)) + (NREVERSE0 G166979)) + (SEQ (EXIT + (SETQ G166979 + (CONS (|bcwords2liststring| |x|) + G166979))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f04jgf(") (STRINGIMAGE |m|) + '|, | (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |nra|) '|, | |tol| + '|, | (STRINGIMAGE |lwork|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | |matstring| '|, [| + |bstring| '|], |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|bcGen| |prefix|)))))) + +;f04mcf() == +; htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXf04mcf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mcf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "Computes the approximate solution of a system of real linear ") +; (text . "equations AX = B, where the n by n symmetric positive-definite ") +; (text . "variable-bandwidth matrix A has previously been factorized as ") +; (text . "\htbitmap{ldlt} by F01MCF, X is an n by r matrix of unknowns ") +; (text . "and B is an n by r matrix of right-hand sides. Related systems ") +; (text . "may also be solved. ") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the order of the matrix A, {\it n} ") +; (text ."\htbitmap{great=} 1:") +; (text . "\newline\tab{2} ") +; (bcStrings (9 6 n PI)) +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "\newline Enter the dimension of AL, {\it lal}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (9 14 lal PI)) +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "\newline Enter the number of right-hand sides, {\it ir}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (9 2 ir PI)) +;-- (text . "\blankline") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "\newline Enter the first dimension of B, {\it nrb}: ") +;-- (text . "\newline\tab{2} ") +;-- (bcStrings (9 6 nrb PI)) +;-- (text . "\blankline") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "\newline Enter the first dimension of X, {\it nrx}: ") +;-- (text . "\newline\tab{2} ") +;-- (bcStrings (9 6 nrx PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "Type of system to be solved, {\it iselct}:") +; (radioButtons iselct +; ("" " {\em \htbitmap{ldlt}X = B} is solved" selone) +; ("" " {\em LDX = B} is solved" seltwo) +; ("" " {\em D\htbitmap{lt}X = B} is solved" selthree) +; ("" " {\em L\htbitmap{lt}X = B} is solved" selfour) +; ("" " {\em LX = B} is solved" selfive) +; ("" " {\em \htbitmap{lt}X = B} is solved" selsix)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'f04mcfSolve) +; htShowPage() + +(DEFUN |f04mcf| () + (PROGN + (|htInitPage| + '|F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)| + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04mcf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mcf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| + . "Computes the approximate solution of a system of real linear ") + (|text| + . "equations AX = B, where the n by n symmetric positive-definite ") + (|text| + . "variable-bandwidth matrix A has previously been factorized as ") + (|text| + . "\\htbitmap{ldlt} by F01MCF, X is an n by r matrix of unknowns ") + (|text| + . "and B is an n by r matrix of right-hand sides. Related systems ") + (|text| . "may also be solved. ") (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the order of the matrix A, {\\it n} ") + (|text| . "\\htbitmap{great=} 1:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (9 6 |n| PI)) + (|text| . "\\blankline") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "\\newline Enter the dimension of AL, {\\it lal}: ") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (9 14 |lal| PI)) + (|text| . "\\blankline") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "\\newline Enter the number of right-hand sides, {\\it ir}: ") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (9 2 |ir| PI)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "Type of system to be solved, {\\it iselct}:") + (|radioButtons| |iselct| + ("" " {\\em \\htbitmap{ldlt}X = B} is solved" |selone|) + ("" " {\\em LDX = B} is solved" |seltwo|) + ("" " {\\em D\\htbitmap{lt}X = B} is solved" |selthree|) + ("" " {\\em L\\htbitmap{lt}X = B} is solved" |selfour|) + ("" " {\\em LX = B} is solved" |selfive|) + ("" " {\\em \\htbitmap{lt}X = B} is solved" |selsix|)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04mcfSolve|) + (|htShowPage|))) + +;f04mcfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; lal := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lal) +; objValUnwrap htpLabelSpadValue(htPage, 'lal) +; ir := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ir) +; objValUnwrap htpLabelSpadValue(htPage, 'ir) +; nrb := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrb) +;-- objValUnwrap htpLabelSpadValue(htPage, 'nrb) +; nrx := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrx) +;-- objValUnwrap htpLabelSpadValue(htPage, 'nrx) +; select := htpButtonValue(htPage,'iselct) +; iselct := +; select = 'selone => '1 +; select = 'seltwo => '2 +; select = 'selthree => '3 +; select = 'selfour => '4 +; select = 'selfive => '5 +; '6 +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; (n = '6 and lal = '14 and ir = '2) => f04mcfDefaultSolve(htPage,iselct,ifail) +; labelList := +; "append"/[fal(i) for i in 1..lal] where fal(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; [['bcStrings,[6, "0.0", xnam, 'F]]] +; dList := +; "append"/[fd(i) for i in 1..n] where fd(i) == +; dnam := INTERN STRCONC ('"d",STRINGIMAGE i) +; [['bcStrings,[6, "0.0", dnam, 'F]]] +; prefix := ('"\blankline \menuitemstyle{}\tab{2} Diagonal elements of diagon") +; prefix := STRCONC(prefix,"al matrix D as returned by F01MCF: \newline") +; dList := [['text,:prefix],:dList] +; nrowList := +; "append"/[gj(j) for j in 1..n] where gj(j) == +; nam := INTERN STRCONC ('"n",STRINGIMAGE j) +; [['bcStrings,[6, 0, nam, 'PI]]] +; prefix := ('"\blankline \menuitemstyle{}\tab{2} {\it NROW(n)} the width ") +; prefix := STRCONC(prefix,"of the ith row of A: \newline ") +; nrowList := [['text,:prefix],:nrowList] +; bList := +; "append"/[f(i,ir) for i in 1..nrb] where f(i,ir) == +; labelList := +; "append"/[g(i,j) for j in 1..ir] where g(i,j) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; prefix := ('"\blankline \menuitemstyle{}\tab{2} The n by r right-hand side ") +; prefix := STRCONC(prefix,"matrix B: \newline ") +; bList := [['text,:prefix],:bList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :labelList,:dList,:nrowList,:bList] +; page := htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) +; htSay '"\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by row " +; htSay '"order as returned by F01MCF: \newline " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f04mcfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'lal,lal) +; htpSetProperty(page,'ir,ir) +;-- htpSetProperty(page,'nrb,nrb) +;-- htpSetProperty(page,'nrx,nrx) +; htpSetProperty(page,'iselct,iselct) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04mcfSolve,fal| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04mcfSolve,fd| (|i|) + (PROG (|dnam|) + (RETURN + (SEQ (SPADLET |dnam| + (INTERN (STRCONC (MAKESTRING "d") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |dnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04mcfSolve,gj| (|j|) + (PROG (|nam|) + (RETURN + (SEQ (SPADLET |nam| + (INTERN (STRCONC (MAKESTRING "n") + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |nam| (CONS 'PI NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04mcfSolve,g| (|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.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04mcfSolve,f| (|i| |ir|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167054) + (SPADLET G167054 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ir|) G167054) + (SEQ (EXIT (SETQ G167054 + (APPEND G167054 + (|f04mcfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f04mcfSolve| (|htPage|) + (PROG (|n| |lal| |ir| |nrb| |nrx| |select| |iselct| |error| |ifail| + |labelList| |dList| |nrowList| |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 |lal| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|lal|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lal|))))) + (SPADLET |ir| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|ir|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|ir|))))) + (SPADLET |nrb| |n|) + (SPADLET |nrx| |n|) + (SPADLET |select| (|htpButtonValue| |htPage| '|iselct|)) + (SPADLET |iselct| + (COND + ((BOOT-EQUAL |select| '|selone|) '1) + ((BOOT-EQUAL |select| '|seltwo|) '2) + ((BOOT-EQUAL |select| '|selthree|) '3) + ((BOOT-EQUAL |select| '|selfour|) '4) + ((BOOT-EQUAL |select| '|selfive|) '5) + ('T '6))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |n| '6) (BOOT-EQUAL |lal| '14) + (BOOT-EQUAL |ir| '2)) + (|f04mcfDefaultSolve| |htPage| |iselct| |ifail|)) + ('T + (SPADLET |labelList| + (PROG (G167071) + (SPADLET G167071 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lal|) G167071) + (SEQ (EXIT + (SETQ G167071 + (APPEND G167071 + (|f04mcfSolve,fal| |i|))))))))) + (SPADLET |dList| + (PROG (G167079) + (SPADLET G167079 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G167079) + (SEQ (EXIT + (SETQ G167079 + (APPEND G167079 + (|f04mcfSolve,fd| |i|))))))))) + (SPADLET |prefix| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Diagonal elements of diagon")) + (SPADLET |prefix| + (STRCONC |prefix| + '|al matrix D as returned by F01MCF: \\newline|)) + (SPADLET |dList| + (CONS (CONS '|text| |prefix|) |dList|)) + (SPADLET |nrowList| + (PROG (G167087) + (SPADLET G167087 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167087) + (SEQ (EXIT + (SETQ G167087 + (APPEND G167087 + (|f04mcfSolve,gj| |j|))))))))) + (SPADLET |prefix| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} {\\it NROW(n)} the width ")) + (SPADLET |prefix| + (STRCONC |prefix| + '|of the ith row of A: \\newline |)) + (SPADLET |nrowList| + (CONS (CONS '|text| |prefix|) |nrowList|)) + (SPADLET |bList| + (PROG (G167095) + (SPADLET G167095 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |nrb|) G167095) + (SEQ (EXIT + (SETQ G167095 + (APPEND G167095 + (|f04mcfSolve,f| |i| |ir|))))))))) + (SPADLET |prefix| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} The n by r right-hand side ")) + (SPADLET |prefix| + (STRCONC |prefix| '|matrix B: \\newline |)) + (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (APPEND |labelList| + (APPEND |dList| + (APPEND |nrowList| |bList|))))) + (SPADLET |page| + (|htInitPage| + '|F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)| + NIL)) + (|htSay| (MAKESTRING + "\\menuitemstyle{}\\tab{2} Elements of matrix {\\it AL} in row by row ")) + (|htSay| (MAKESTRING + "order as returned by F01MCF: \\newline ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f04mcfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|lal| |lal|) + (|htpSetProperty| |page| '|ir| |ir|) + (|htpSetProperty| |page| '|iselct| |iselct|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f04mcfDefaultSolve (htPage,iselct,ifail) == +; n := '6 +; lal := '14 +; ir := '2 +; nrb := '6 +; nrx := '6 +; page := htInitPage("F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (Positive Integer)) +; (isDomain F (Float))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Elements of matrix {\it AL} in row by ") +; (text . "row order as returned by F01MCF: ") +; (text . "\newline ") +; (bcStrings (6 "1.0" x1 F)) +; (bcStrings (6 "2.0" x2 F)) +; (bcStrings (6 "1.0" x3 F)) +; (bcStrings (6 "3.0" x4 F)) +; (bcStrings (6 "1.0" x5 F)) +; (bcStrings (6 "1.0" x6 F)) +; (bcStrings (6 "5.0" x7 F)) +; (bcStrings (6 "4.0" x8 F)) +; (bcStrings (6 "1.5" x9 F)) +; (bcStrings (6 "0.5" x10 F)) +; (bcStrings (6 "1.0" x11 F)) +; (bcStrings (6 "1.5" x12 F)) +; (bcStrings (6 "5.0" x13 F)) +; (bcStrings (6 "1.0" x14 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} Diagonal elements of diagonal matrix ") +; (text . "D as returned by F01MCF: ") +; (text . "\newline ") +; (bcStrings (6 "1.0" d1 F)) +; (bcStrings (6 "1.0" d2 F)) +; (bcStrings (6 "4.0" d3 F)) +; (bcStrings (6 "16.0" d4 F)) +; (bcStrings (6 "1.0" d5 F)) +; (bcStrings (6 "16.0" d6 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} {\it NROW(n)} the width of the ith row ") +; (text . "of A: ") +; (text . "\newline ") +; (bcStrings (6 1 n1 PI)) +; (bcStrings (6 2 n2 PI)) +; (bcStrings (6 2 n3 PI)) +; (bcStrings (6 1 n4 PI)) +; (bcStrings (6 5 n5 PI)) +; (bcStrings (6 3 n6 PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} The n by r right-hand side matrix B:") +; (text . "\newline ") +; (bcStrings (6 "6" b11 F)) +; (text . "\tab{10} ") +; (bcStrings (6 "-10" b12 PI)) +; (text . "\newline ") +; (bcStrings (6 "15" b21 F)) +; (text . "\tab{10} ") +; (bcStrings (6 "-21" b22 PI)) +; (text . "\newline ") +; (bcStrings (6 "11" b31 F)) +; (text . "\tab{10} ") +; (bcStrings (6 "-3" b32 PI)) +; (text . "\newline ") +; (bcStrings (6 "0" b41 F)) +; (text . "\tab{10} ") +; (bcStrings (6 "24" b42 PI)) +; (text . "\newline ") +; (bcStrings (6 "51" b51 F)) +; (text . "\tab{10} ") +; (bcStrings (6 "-39" b52 PI)) +; (text . "\newline ") +; (bcStrings (6 "46" b61 F)) +; (text . "\tab{10} ") +; (bcStrings (6 "67" b62 PI)) +; (text . "\blankline ")) +; htMakeDoneButton('"Continue",'f04mcfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'lal,lal) +; htpSetProperty(page,'ir,ir) +;-- htpSetProperty(page,'nrb,nrb) +;-- htpSetProperty(page,'nrx,nrx) +; htpSetProperty(page,'iselct,iselct) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04mcfDefaultSolve| (|htPage| |iselct| |ifail|) + (PROG (|n| |lal| |ir| |nrb| |nrx| |page|) + (RETURN + (PROGN + (SPADLET |n| '6) + (SPADLET |lal| '14) + (SPADLET |ir| '2) + (SPADLET |nrb| '6) + (SPADLET |nrx| '6) + (SPADLET |page| + (|htInitPage| + '|F04MCF - Approximate solution of real symmetric positive-definite variable-bandwidth simultaneous linear equations (coefficient matrix already factorized)| + NIL)) + (|htMakePage| + '((|domainConditions| + (|isDomain| PI (|Positive| |Integer|)) + (|isDomain| F (|Float|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Elements of matrix {\\it AL} in row by ") + (|text| . "row order as returned by F01MCF: ") + (|text| . "\\newline ") (|bcStrings| (6 "1.0" |x1| F)) + (|bcStrings| (6 "2.0" |x2| F)) + (|bcStrings| (6 "1.0" |x3| F)) + (|bcStrings| (6 "3.0" |x4| F)) + (|bcStrings| (6 "1.0" |x5| F)) + (|bcStrings| (6 "1.0" |x6| F)) + (|bcStrings| (6 "5.0" |x7| F)) + (|bcStrings| (6 "4.0" |x8| F)) + (|bcStrings| (6 "1.5" |x9| F)) + (|bcStrings| (6 "0.5" |x10| F)) + (|bcStrings| (6 "1.0" |x11| F)) + (|bcStrings| (6 "1.5" |x12| F)) + (|bcStrings| (6 "5.0" |x13| F)) + (|bcStrings| (6 "1.0" |x14| F)) (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Diagonal elements of diagonal matrix ") + (|text| . "D as returned by F01MCF: ") + (|text| . "\\newline ") (|bcStrings| (6 "1.0" |d1| F)) + (|bcStrings| (6 "1.0" |d2| F)) + (|bcStrings| (6 "4.0" |d3| F)) + (|bcStrings| (6 "16.0" |d4| F)) + (|bcStrings| (6 "1.0" |d5| F)) + (|bcStrings| (6 "16.0" |d6| F)) (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} {\\it NROW(n)} the width of the ith row ") + (|text| . "of A: ") (|text| . "\\newline ") + (|bcStrings| (6 1 |n1| PI)) (|bcStrings| (6 2 |n2| PI)) + (|bcStrings| (6 2 |n3| PI)) (|bcStrings| (6 1 |n4| PI)) + (|bcStrings| (6 5 |n5| PI)) (|bcStrings| (6 3 |n6| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} The n by r right-hand side matrix B:") + (|text| . "\\newline ") (|bcStrings| (6 "6" |b11| F)) + (|text| . "\\tab{10} ") (|bcStrings| (6 "-10" |b12| PI)) + (|text| . "\\newline ") (|bcStrings| (6 "15" |b21| F)) + (|text| . "\\tab{10} ") (|bcStrings| (6 "-21" |b22| PI)) + (|text| . "\\newline ") (|bcStrings| (6 "11" |b31| F)) + (|text| . "\\tab{10} ") (|bcStrings| (6 "-3" |b32| PI)) + (|text| . "\\newline ") (|bcStrings| (6 "0" |b41| F)) + (|text| . "\\tab{10} ") (|bcStrings| (6 "24" |b42| PI)) + (|text| . "\\newline ") (|bcStrings| (6 "51" |b51| F)) + (|text| . "\\tab{10} ") (|bcStrings| (6 "-39" |b52| PI)) + (|text| . "\\newline ") (|bcStrings| (6 "46" |b61| F)) + (|text| . "\\tab{10} ") (|bcStrings| (6 "67" |b62| PI)) + (|text| . "\\blankline "))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04mcfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|lal| |lal|) + (|htpSetProperty| |page| '|ir| |ir|) + (|htpSetProperty| |page| '|iselct| |iselct|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f04mcfGen htPage == +; n := htpProperty(htPage,'n) +; lal := htpProperty(htPage,'lal) +; ir := htpProperty(htPage,'ir) +;-- nrb := htpProperty(htPage,'nrb) +;-- nrx := htpProperty(htPage,'nrx) +; nrb := n +; nrx := n +; iselct := htpProperty(htPage,'iselct) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..nrb repeat +; for j in 1..ir repeat +; elm := STRCONC((first y).1," ") +; rowList := [elm,:rowList] +; y := rest y +; matform := [rowList,:matform] +; rowList := [] +; matfrom := REVERSE matform +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; for i in 1..n repeat +; right := STRCONC ((first y).1," ") +; y := rest y +; nrowList := [right,:nrowList] +; nrowstring := bcwords2liststring nrowList +; for i in 1..n repeat +; right := STRCONC ((first y).1," ") +; y := rest y +; dList := [right,:dList] +; dstring := bcwords2liststring dList +; while y repeat +; right := STRCONC ((first y).1," ") +; y := rest y +; alList := [right,:alList] +; alstring := bcwords2liststring alList +; prefix := STRCONC('"f04mcf(",STRINGIMAGE n,", [",alstring,"], ") +; prefix := STRCONC(prefix,STRINGIMAGE lal,", [",dstring,"],[",nrowstring) +; prefix := STRCONC(prefix,"]::Matrix Integer,") +; prefix := STRCONC(prefix,STRINGIMAGE ir,", ",matstring,", ",STRINGIMAGE nrb) +; prefix := STRCONC(prefix,", ",STRINGIMAGE iselct,", ",STRINGIMAGE nrx,", ") +; bcGen STRCONC(prefix,STRINGIMAGE ifail,")") + +(DEFUN |f04mcfGen| (|htPage|) + (PROG (|n| |lal| |ir| |nrb| |nrx| |iselct| |ifail| |alist| |elm| + |matform| |rowList| |matfrom| |matstring| |nrowList| + |nrowstring| |dList| |dstring| |right| |y| |alList| + |alstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |lal| (|htpProperty| |htPage| '|lal|)) + (SPADLET |ir| (|htpProperty| |htPage| '|ir|)) + (SPADLET |nrb| |n|) + (SPADLET |nrx| |n|) + (SPADLET |iselct| (|htpProperty| |htPage| '|iselct|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |nrb|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ir|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |elm| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |matform| + (CONS |rowList| |matform|)) + (SPADLET |rowList| NIL))))) + (SPADLET |matfrom| (REVERSE |matform|)) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167175) + (SPADLET G167175 NIL) + (RETURN + (DO ((G167180 |matform| + (CDR G167180)) + (|x| NIL)) + ((OR (ATOM G167180) + (PROGN + (SETQ |x| (CAR G167180)) + NIL)) + (NREVERSE0 G167175)) + (SEQ (EXIT + (SETQ G167175 + (CONS (|bcwords2liststring| |x|) + G167175))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |right| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |nrowList| + (CONS |right| |nrowList|)))))) + (SPADLET |nrowstring| (|bcwords2liststring| |nrowList|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |right| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |dList| (CONS |right| |dList|)))))) + (SPADLET |dstring| (|bcwords2liststring| |dList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |right| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |alList| (CONS |right| |alList|)))))) + (SPADLET |alstring| (|bcwords2liststring| |alList|)) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f04mcf(") (STRINGIMAGE |n|) + '|, [| |alstring| '|], |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lal|) '|, [| + |dstring| '|],[| |nrowstring|)) + (SPADLET |prefix| + (STRCONC |prefix| '|]::Matrix Integer,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ir|) '|, | + |matstring| '|, | (STRINGIMAGE |nrb|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | (STRINGIMAGE |iselct|) + '|, | (STRINGIMAGE |nrx|) '|, |)) + (|bcGen| (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|))))))) + +;f04axf() == +; htInitPage('"F04AXF - Approximate solution of a a set of real sparse linear equations after factorization by F01BRF or by F01BSF",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXf04axf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04axf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "F04AXF calculates the approximate solution of a set of real ") +; (text . "sparse linear equations {\it Ax=b} or ") +; (text . "\htbitmap{atxequalb}, where the {\it n} by {\it n} matrix ") +; (text . "{\it A} has been factorized by F01BRF or F01BSF, {\it x} ") +; (text . "is an {\it n} element vector of unknowns and {\it b} is an ") +; (text . "{\it n} element right-hand side vector. ") +; (text . "\blankline") +; (text . "\newline ") +; (text . "Read the input file to see the example program. ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "\spadcommand{)read f04axf \bound{s0}} ")) +; htShowPage() + +(DEFUN |f04axf| () + (declare (special |$EmptyMode|)) + (PROGN + (|htInitPage| + (MAKESTRING + "F04AXF - Approximate solution of a a set of real sparse linear equations after factorization by F01BRF or by F01BSF") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04axf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04axf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "F04AXF calculates the approximate solution of a set of real ") + (|text| . "sparse linear equations {\\it Ax=b} or ") + (|text| + . "\\htbitmap{atxequalb}, where the {\\it n} by {\\it n} matrix ") + (|text| + . "{\\it A} has been factorized by F01BRF or F01BSF, {\\it x} ") + (|text| + . "is an {\\it n} element vector of unknowns and {\\it b} is an ") + (|text| . "{\\it n} element right-hand side vector. ") + (|text| . "\\blankline") (|text| . "\\newline ") + (|text| . "Read the input file to see the example program. ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "\\spadcommand{)read f04axf \\bound{s0}} "))) + (|htShowPage|))) + +;f04maf() == +; htInitPage('"F04MAF - Solution of a real sparse symmetric positive-definite system of linear equations after factorization by F01MAF",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXf04maf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04maf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "F04MAF solves a real sparse symmetric positive-definite system ") +; (text . "of linear equations {\it Ax=b} using a pre-conditioned ") +; (text . "conjugate gradient method, where the {\it n} by {\it n} ") +; (text . "matrix {\it A} has been factorized by F01MAF, {\it x} is an ") +; (text . "{\it n} element vector of unknowns and {\it b} is an {\it n} ") +; (text . "element right-hand side vector. ") +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "\spadcommand{)read f04maf \bound{s0}} ")) +; htShowPage() + +(DEFUN |f04maf| () + (declare (special |$EmptyMode|)) + (PROGN + (|htInitPage| + (MAKESTRING + "F04MAF - Solution of a real sparse symmetric positive-definite system of linear equations after factorization by F01MAF") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04maf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04maf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "F04MAF solves a real sparse symmetric positive-definite system ") + (|text| + . "of linear equations {\\it Ax=b} using a pre-conditioned ") + (|text| + . "conjugate gradient method, where the {\\it n} by {\\it n} ") + (|text| + . "matrix {\\it A} has been factorized by F01MAF, {\\it x} is an ") + (|text| + . "{\\it n} element vector of unknowns and {\\it b} is an {\\it n} ") + (|text| . "element right-hand side vector. ") + (|text| . "\\blankline") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "\\spadcommand{)read f04maf \\bound{s0}} "))) + (|htShowPage|))) + +;f04mbf() == +; htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain PI (PositiveInteger)) +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "F04MBF solve a system of real symmetric linear equations ") +; (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ") +; (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ") +; (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ") +; (text . "and {\it b} is an {\it n} element right-hand side vector. ") +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the order {\it n} of matrix {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (10 10 n PI)) +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Is preconditioning required? ") +; (radioButtons precon +; ("" " Yes" true) +; ("" " No" false)) +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the shift in the equations \lambda, {\it shift} : ") +; (text . "\newline \tab{2} ") +; (bcStrings (10 "0.0" shift F)) +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the tolerance for convergence, {\it rtol}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (10 "0.00001" rtol F)) +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter an upper limit for the number of iterations, {\it itnlim}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (10 100 itnlim PI)) +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the printing level, {\it msglvl}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (10 1 msglvl PI)) +; (text . "\blankline") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Ifail value: ") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'f04mbfSolve) +; htShowPage() + +(DEFUN |f04mbf| () + (declare (special |$EmptyMode|)) + (PROGN + (|htInitPage| + (MAKESTRING + "F04MBF - Real sparse symmetric simultaneous linear equations") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| PI (|PositiveInteger|)) + (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04mbf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "F04MBF solve a system of real symmetric linear equations ") + (|text| + . "({\\it A} - \\lambda {\\it I}){\\it x} = {\\it b} using a Lanczos ") + (|text| + . "algorithm, where {\\it A} is an {\\it n} by {\\it n} sparse ") + (|text| + . "symmetric matrix, {\\it x} is an {\\it n} vector of unknowns ") + (|text| + . "and {\\it b} is an {\\it n} element right-hand side vector. ") + (|text| . "\\blankline") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Enter the order {\\it n} of matrix {\\it A}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (10 10 |n| PI)) + (|text| . "\\blankline") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Is preconditioning required? ") + (|radioButtons| |precon| ("" " Yes" |true|) + ("" " No" |false|)) + (|text| . "\\blankline") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Enter the shift in the equations \\lambda, {\\it shift} : ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 "0.0" |shift| F)) (|text| . "\\blankline") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Enter the tolerance for convergence, {\\it rtol}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 "0.00001" |rtol| F)) + (|text| . "\\blankline") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Enter an upper limit for the number of iterations, {\\it itnlim}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 100 |itnlim| PI)) (|text| . "\\blankline") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Enter the printing level, {\\it msglvl}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (10 1 |msglvl| PI)) (|text| . "\\blankline") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Ifail value: ") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04mbfSolve|) + (|htShowPage|))) + +;f04mbfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; msolve := htpButtonValue(htPage,'precon) +; precon := +; msolve = 'true => 'true +; 'false +; shift := htpLabelInputString(htPage,'shift) +; rtol := htpLabelInputString(htPage,'rtol) +; itnlim := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim) +; objValUnwrap htpLabelSpadValue(htPage, 'itnlim) +; msglvl := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl) +; objValUnwrap htpLabelSpadValue(htPage, 'msglvl) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; (n = '10 and precon ='true) => f04mbfDefaultSolve(htPage,shift,rtol,itnlim,msglvl,ifail) +; bmatList := +; "append"/[f(i) for i in 1..n] where f(i) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE i) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; amatList := +; "append"/[h(ia,n) for ia in 1..n] where h(ia,n) == +; alabelList := +; "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja) +; [['bcStrings,[6, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; alabelList := [['text,:prefix],:alabelList] +; start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ") +; amatList := [['text,:start],:amatList] +; mmatList:= +; precon = 'true => +; alabelList:= +; "append"/[l(im,n) for im in 1..n] where l(im,n) == +; mlabelList := +; "append"/[o(im,jm) for jm in 1..n] where o(im,jm) == +; mnam := INTERN STRCONC ('"m",STRINGIMAGE im,STRINGIMAGE jm) +; [['bcStrings,[6, "0.0", mnam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; mlabelList := [['text,:prefix],:mlabelList] +; start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it m}: ") +; [['text,:start],:alabelList] +; [] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain F (Float))), +; :bmatList,:amatList,:mmatList] +; page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} " +; htSay '"Enter the right-hand side vector {\it b(n)}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f04mbfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'precon,precon) +; htpSetProperty(page,'shift,shift) +; htpSetProperty(page,'rtol,rtol) +; htpSetProperty(page,'itnlim,itnlim) +; htpSetProperty(page,'msglvl,msglvl) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04mbfSolve,f| (|i|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04mbfSolve,k| (|ia| |ja|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") + (STRINGIMAGE |ia|) + (STRINGIMAGE |ja|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04mbfSolve,h| (|ia| |n|) + (PROG (|prefix| |alabelList|) + (RETURN + (SEQ (SPADLET |alabelList| + (PROG (G167280) + (SPADLET G167280 NIL) + (RETURN + (DO ((|ja| 1 (QSADD1 |ja|))) + ((QSGREATERP |ja| |n|) G167280) + (SEQ (EXIT (SETQ G167280 + (APPEND G167280 + (|f04mbfSolve,k| |ia| |ja|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |alabelList| + (CONS (CONS '|text| |prefix|) |alabelList|))))))) + +(DEFUN |f04mbfSolve,o| (|im| |jm|) + (PROG (|mnam|) + (RETURN + (SEQ (SPADLET |mnam| + (INTERN (STRCONC (MAKESTRING "m") + (STRINGIMAGE |im|) + (STRINGIMAGE |jm|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |mnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04mbfSolve,l| (|im| |n|) + (PROG (|prefix| |mlabelList|) + (RETURN + (SEQ (SPADLET |mlabelList| + (PROG (G167303) + (SPADLET G167303 NIL) + (RETURN + (DO ((|jm| 1 (QSADD1 |jm|))) + ((QSGREATERP |jm| |n|) G167303) + (SEQ (EXIT (SETQ G167303 + (APPEND G167303 + (|f04mbfSolve,o| |im| |jm|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |mlabelList| + (CONS (CONS '|text| |prefix|) |mlabelList|))))))) + +(DEFUN |f04mbfSolve| (|htPage|) + (PROG (|n| |msolve| |precon| |shift| |rtol| |itnlim| |msglvl| |error| + |ifail| |bmatList| |amatList| |alabelList| |start| + |mmatList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |msolve| (|htpButtonValue| |htPage| '|precon|)) + (SPADLET |precon| + (COND + ((BOOT-EQUAL |msolve| '|true|) '|true|) + ('T '|false|))) + (SPADLET |shift| + (|htpLabelInputString| |htPage| '|shift|)) + (SPADLET |rtol| (|htpLabelInputString| |htPage| '|rtol|)) + (SPADLET |itnlim| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|itnlim|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|itnlim|))))) + (SPADLET |msglvl| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|msglvl|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|msglvl|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |n| '10) + (BOOT-EQUAL |precon| '|true|)) + (|f04mbfDefaultSolve| |htPage| |shift| |rtol| |itnlim| + |msglvl| |ifail|)) + ('T + (SPADLET |bmatList| + (PROG (G167322) + (SPADLET G167322 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G167322) + (SEQ (EXIT + (SETQ G167322 + (APPEND G167322 + (|f04mbfSolve,f| |i|))))))))) + (SPADLET |amatList| + (PROG (G167330) + (SPADLET G167330 NIL) + (RETURN + (DO ((|ia| 1 (QSADD1 |ia|))) + ((QSGREATERP |ia| |n|) G167330) + (SEQ (EXIT + (SETQ G167330 + (APPEND G167330 + (|f04mbfSolve,h| |ia| |n|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter the matrix {\\it A}: ")) + (SPADLET |amatList| + (CONS (CONS '|text| |start|) |amatList|)) + (SPADLET |mmatList| + (COND + ((BOOT-EQUAL |precon| '|true|) + (SPADLET |alabelList| + (PROG (G167338) + (SPADLET G167338 NIL) + (RETURN + (DO ((|im| 1 (QSADD1 |im|))) + ((QSGREATERP |im| |n|) + G167338) + (SEQ + (EXIT + (SETQ G167338 + (APPEND G167338 + (|f04mbfSolve,l| |im| + |n|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter the matrix {\\it m}: ")) + (CONS (CONS '|text| |start|) |alabelList|)) + ('T NIL))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| F (|Float|))) + (APPEND |bmatList| + (APPEND |amatList| |mmatList|)))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F04MBF - Real sparse symmetric simultaneous linear equations") + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING "Enter the right-hand side vector {\\it b(n)}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f04mbfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|precon| |precon|) + (|htpSetProperty| |page| '|shift| |shift|) + (|htpSetProperty| |page| '|rtol| |rtol|) + (|htpSetProperty| |page| '|itnlim| |itnlim|) + (|htpSetProperty| |page| '|msglvl| |msglvl|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f04mbfDefaultSolve (htPage,shift,rtol,itnlim,msglvl,ifail) == +; n := '10 +; precon := 'true +; page := htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the right-hand side vector {\it b(n)}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "6.0" b1 F)) +; (bcStrings (6 "4.0" b2 F)) +; (bcStrings (6 "4.0" b3 F)) +; (bcStrings (6 "4.0" b4 F)) +; (bcStrings (6 "4.0" b5 F)) +; (bcStrings (6 "4.0" b6 F)) +; (bcStrings (6 "4.0" b7 F)) +; (bcStrings (6 "4.0" b8 F)) +; (bcStrings (6 "4.0" b9 F)) +; (bcStrings (6 "6.0" b10 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the matrix {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "2.0" a11 F)) +; (bcStrings (6 "1.0" a12 F)) +; (bcStrings (6 "0.0" a13 F)) +; (bcStrings (6 "0.0" a14 F)) +; (bcStrings (6 "0.0" a15 F)) +; (bcStrings (6 "0.0" a16 F)) +; (bcStrings (6 "0.0" a17 F)) +; (bcStrings (6 "0.0" a18 F)) +; (bcStrings (6 "0.0" a19 F)) +; (bcStrings (6 "3.0" a110 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.0" a21 F)) +; (bcStrings (6 "2.0" a22 F)) +; (bcStrings (6 "1.0" a23 F)) +; (bcStrings (6 "0.0" a24 F)) +; (bcStrings (6 "0.0" a25 F)) +; (bcStrings (6 "0.0" a26 F)) +; (bcStrings (6 "0.0" a27 F)) +; (bcStrings (6 "0.0" a28 F)) +; (bcStrings (6 "0.0" a29 F)) +; (bcStrings (6 "0.0" a210 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a31 F)) +; (bcStrings (6 "1.0" a32 F)) +; (bcStrings (6 "2.0" a33 F)) +; (bcStrings (6 "1.0" a34 F)) +; (bcStrings (6 "0.0" a35 F)) +; (bcStrings (6 "0.0" a36 F)) +; (bcStrings (6 "0.0" a37 F)) +; (bcStrings (6 "0.0" a38 F)) +; (bcStrings (6 "0.0" a39 F)) +; (bcStrings (6 "0.0" a310 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a41 F)) +; (bcStrings (6 "0.0" a42 F)) +; (bcStrings (6 "1.0" a43 F)) +; (bcStrings (6 "2.0" a44 F)) +; (bcStrings (6 "1.0" a45 F)) +; (bcStrings (6 "0.0" a46 F)) +; (bcStrings (6 "0.0" a47 F)) +; (bcStrings (6 "0.0" a48 F)) +; (bcStrings (6 "0.0" a49 F)) +; (bcStrings (6 "0.0" a410 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a51 F)) +; (bcStrings (6 "0.0" a52 F)) +; (bcStrings (6 "0.0" a53 F)) +; (bcStrings (6 "1.0" a54 F)) +; (bcStrings (6 "2.0" a55 F)) +; (bcStrings (6 "1.0" a56 F)) +; (bcStrings (6 "0.0" a57 F)) +; (bcStrings (6 "0.0" a58 F)) +; (bcStrings (6 "0.0" a59 F)) +; (bcStrings (6 "0.0" a510 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a61 F)) +; (bcStrings (6 "0.0" a62 F)) +; (bcStrings (6 "0.0" a63 F)) +; (bcStrings (6 "0.0" a64 F)) +; (bcStrings (6 "1.0" a65 F)) +; (bcStrings (6 "2.0" a66 F)) +; (bcStrings (6 "1.0" a67 F)) +; (bcStrings (6 "0.0" a68 F)) +; (bcStrings (6 "0.0" a69 F)) +; (bcStrings (6 "0.0" a610 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a71 F)) +; (bcStrings (6 "0.0" a72 F)) +; (bcStrings (6 "0.0" a73 F)) +; (bcStrings (6 "0.0" a74 F)) +; (bcStrings (6 "0.0" a75 F)) +; (bcStrings (6 "1.0" a76 F)) +; (bcStrings (6 "2.0" a77 F)) +; (bcStrings (6 "1.0" a78 F)) +; (bcStrings (6 "0.0" a79 F)) +; (bcStrings (6 "0.0" a710 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a81 F)) +; (bcStrings (6 "0.0" a82 F)) +; (bcStrings (6 "0.0" a83 F)) +; (bcStrings (6 "0.0" a84 F)) +; (bcStrings (6 "0.0" a85 F)) +; (bcStrings (6 "0.0" a86 F)) +; (bcStrings (6 "1.0" a87 F)) +; (bcStrings (6 "2.0" a88 F)) +; (bcStrings (6 "1.0" a89 F)) +; (bcStrings (6 "0.0" a810 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a91 F)) +; (bcStrings (6 "0.0" a92 F)) +; (bcStrings (6 "0.0" a93 F)) +; (bcStrings (6 "0.0" a94 F)) +; (bcStrings (6 "0.0" a95 F)) +; (bcStrings (6 "0.0" a96 F)) +; (bcStrings (6 "0.0" a97 F)) +; (bcStrings (6 "1.0" a98 F)) +; (bcStrings (6 "2.0" a99 F)) +; (bcStrings (6 "1.0" a910 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "3.0" a101 F)) +; (bcStrings (6 "0.0" a102 F)) +; (bcStrings (6 "0.0" a103 F)) +; (bcStrings (6 "0.0" a104 F)) +; (bcStrings (6 "0.0" a105 F)) +; (bcStrings (6 "0.0" a106 F)) +; (bcStrings (6 "0.0" a107 F)) +; (bcStrings (6 "0.0" a108 F)) +; (bcStrings (6 "1.0" a109 F)) +; (bcStrings (6 "2.0" a1010 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the matrix {\it m}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "2.0" m11 F)) +; (bcStrings (6 "1.0" m12 F)) +; (bcStrings (6 "0.0" m13 F)) +; (bcStrings (6 "0.0" m14 F)) +; (bcStrings (6 "0.0" m15 F)) +; (bcStrings (6 "0.0" m16 F)) +; (bcStrings (6 "0.0" m17 F)) +; (bcStrings (6 "0.0" m18 F)) +; (bcStrings (6 "0.0" m19 F)) +; (bcStrings (6 "0.0" m110 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.0" m21 F)) +; (bcStrings (6 "2.0" m22 F)) +; (bcStrings (6 "1.0" m23 F)) +; (bcStrings (6 "0.0" m24 F)) +; (bcStrings (6 "0.0" m25 F)) +; (bcStrings (6 "0.0" m26 F)) +; (bcStrings (6 "0.0" m27 F)) +; (bcStrings (6 "0.0" m28 F)) +; (bcStrings (6 "0.0" m29 F)) +; (bcStrings (6 "0.0" m210 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" m31 F)) +; (bcStrings (6 "1.0" m32 F)) +; (bcStrings (6 "2.0" m33 F)) +; (bcStrings (6 "1.0" m34 F)) +; (bcStrings (6 "0.0" m35 F)) +; (bcStrings (6 "0.0" m36 F)) +; (bcStrings (6 "0.0" m37 F)) +; (bcStrings (6 "0.0" m38 F)) +; (bcStrings (6 "0.0" m39 F)) +; (bcStrings (6 "0.0" m310 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" m41 F)) +; (bcStrings (6 "0.0" m42 F)) +; (bcStrings (6 "1.0" m43 F)) +; (bcStrings (6 "2.0" m44 F)) +; (bcStrings (6 "1.0" m45 F)) +; (bcStrings (6 "0.0" m46 F)) +; (bcStrings (6 "0.0" m47 F)) +; (bcStrings (6 "0.0" m48 F)) +; (bcStrings (6 "0.0" m49 F)) +; (bcStrings (6 "0.0" m410 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" m51 F)) +; (bcStrings (6 "0.0" m52 F)) +; (bcStrings (6 "0.0" m53 F)) +; (bcStrings (6 "1.0" m54 F)) +; (bcStrings (6 "2.0" m55 F)) +; (bcStrings (6 "1.0" m56 F)) +; (bcStrings (6 "0.0" m57 F)) +; (bcStrings (6 "0.0" m58 F)) +; (bcStrings (6 "0.0" m59 F)) +; (bcStrings (6 "0.0" m510 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" m61 F)) +; (bcStrings (6 "0.0" m62 F)) +; (bcStrings (6 "0.0" m63 F)) +; (bcStrings (6 "0.0" m64 F)) +; (bcStrings (6 "1.0" m65 F)) +; (bcStrings (6 "2.0" m66 F)) +; (bcStrings (6 "1.0" m67 F)) +; (bcStrings (6 "0.0" m68 F)) +; (bcStrings (6 "0.0" m69 F)) +; (bcStrings (6 "0.0" m610 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" m71 F)) +; (bcStrings (6 "0.0" m72 F)) +; (bcStrings (6 "0.0" m73 F)) +; (bcStrings (6 "0.0" m74 F)) +; (bcStrings (6 "0.0" m75 F)) +; (bcStrings (6 "1.0" m76 F)) +; (bcStrings (6 "2.0" m77 F)) +; (bcStrings (6 "1.0" m78 F)) +; (bcStrings (6 "0.0" m79 F)) +; (bcStrings (6 "0.0" m710 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" m81 F)) +; (bcStrings (6 "0.0" m82 F)) +; (bcStrings (6 "0.0" m83 F)) +; (bcStrings (6 "0.0" m84 F)) +; (bcStrings (6 "0.0" m85 F)) +; (bcStrings (6 "0.0" m86 F)) +; (bcStrings (6 "1.0" m87 F)) +; (bcStrings (6 "2.0" m88 F)) +; (bcStrings (6 "1.0" m89 F)) +; (bcStrings (6 "0.0" m810 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" m91 F)) +; (bcStrings (6 "0.0" m92 F)) +; (bcStrings (6 "0.0" m93 F)) +; (bcStrings (6 "0.0" m94 F)) +; (bcStrings (6 "0.0" m95 F)) +; (bcStrings (6 "0.0" m96 F)) +; (bcStrings (6 "0.0" m97 F)) +; (bcStrings (6 "1.0" m98 F)) +; (bcStrings (6 "2.0" m99 F)) +; (bcStrings (6 "1.0" m910 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" m101 F)) +; (bcStrings (6 "0.0" m102 F)) +; (bcStrings (6 "0.0" m103 F)) +; (bcStrings (6 "0.0" m104 F)) +; (bcStrings (6 "0.0" m105 F)) +; (bcStrings (6 "0.0" m106 F)) +; (bcStrings (6 "0.0" m107 F)) +; (bcStrings (6 "0.0" m108 F)) +; (bcStrings (6 "1.0" m109 F)) +; (bcStrings (6 "2.0" m1010 F)) +; (text . "\blankline ")) +; htMakeDoneButton('"Continue",'f04mbfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'precon,precon) +; htpSetProperty(page,'shift,shift) +; htpSetProperty(page,'rtol,rtol) +; htpSetProperty(page,'itnlim,itnlim) +; htpSetProperty(page,'msglvl,msglvl) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04mbfDefaultSolve| + (|htPage| |shift| |rtol| |itnlim| |msglvl| |ifail|) + (PROG (|n| |precon| |page|) + (RETURN + (PROGN + (SPADLET |n| '10) + (SPADLET |precon| '|true|) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F04MBF - Real sparse symmetric simultaneous linear equations") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Enter the right-hand side vector {\\it b(n)}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "6.0" |b1| F)) + (|bcStrings| (6 "4.0" |b2| F)) + (|bcStrings| (6 "4.0" |b3| F)) + (|bcStrings| (6 "4.0" |b4| F)) + (|bcStrings| (6 "4.0" |b5| F)) + (|bcStrings| (6 "4.0" |b6| F)) + (|bcStrings| (6 "4.0" |b7| F)) + (|bcStrings| (6 "4.0" |b8| F)) + (|bcStrings| (6 "4.0" |b9| F)) + (|bcStrings| (6 "6.0" |b10| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Enter the matrix {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "2.0" |a11| F)) + (|bcStrings| (6 "1.0" |a12| F)) + (|bcStrings| (6 "0.0" |a13| F)) + (|bcStrings| (6 "0.0" |a14| F)) + (|bcStrings| (6 "0.0" |a15| F)) + (|bcStrings| (6 "0.0" |a16| F)) + (|bcStrings| (6 "0.0" |a17| F)) + (|bcStrings| (6 "0.0" |a18| F)) + (|bcStrings| (6 "0.0" |a19| F)) + (|bcStrings| (6 "3.0" |a110| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.0" |a21| F)) + (|bcStrings| (6 "2.0" |a22| F)) + (|bcStrings| (6 "1.0" |a23| F)) + (|bcStrings| (6 "0.0" |a24| F)) + (|bcStrings| (6 "0.0" |a25| F)) + (|bcStrings| (6 "0.0" |a26| F)) + (|bcStrings| (6 "0.0" |a27| F)) + (|bcStrings| (6 "0.0" |a28| F)) + (|bcStrings| (6 "0.0" |a29| F)) + (|bcStrings| (6 "0.0" |a210| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a31| F)) + (|bcStrings| (6 "1.0" |a32| F)) + (|bcStrings| (6 "2.0" |a33| F)) + (|bcStrings| (6 "1.0" |a34| F)) + (|bcStrings| (6 "0.0" |a35| F)) + (|bcStrings| (6 "0.0" |a36| F)) + (|bcStrings| (6 "0.0" |a37| F)) + (|bcStrings| (6 "0.0" |a38| F)) + (|bcStrings| (6 "0.0" |a39| F)) + (|bcStrings| (6 "0.0" |a310| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a41| F)) + (|bcStrings| (6 "0.0" |a42| F)) + (|bcStrings| (6 "1.0" |a43| F)) + (|bcStrings| (6 "2.0" |a44| F)) + (|bcStrings| (6 "1.0" |a45| F)) + (|bcStrings| (6 "0.0" |a46| F)) + (|bcStrings| (6 "0.0" |a47| F)) + (|bcStrings| (6 "0.0" |a48| F)) + (|bcStrings| (6 "0.0" |a49| F)) + (|bcStrings| (6 "0.0" |a410| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a51| F)) + (|bcStrings| (6 "0.0" |a52| F)) + (|bcStrings| (6 "0.0" |a53| F)) + (|bcStrings| (6 "1.0" |a54| F)) + (|bcStrings| (6 "2.0" |a55| F)) + (|bcStrings| (6 "1.0" |a56| F)) + (|bcStrings| (6 "0.0" |a57| F)) + (|bcStrings| (6 "0.0" |a58| F)) + (|bcStrings| (6 "0.0" |a59| F)) + (|bcStrings| (6 "0.0" |a510| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a61| F)) + (|bcStrings| (6 "0.0" |a62| F)) + (|bcStrings| (6 "0.0" |a63| F)) + (|bcStrings| (6 "0.0" |a64| F)) + (|bcStrings| (6 "1.0" |a65| F)) + (|bcStrings| (6 "2.0" |a66| F)) + (|bcStrings| (6 "1.0" |a67| F)) + (|bcStrings| (6 "0.0" |a68| F)) + (|bcStrings| (6 "0.0" |a69| F)) + (|bcStrings| (6 "0.0" |a610| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a71| F)) + (|bcStrings| (6 "0.0" |a72| F)) + (|bcStrings| (6 "0.0" |a73| F)) + (|bcStrings| (6 "0.0" |a74| F)) + (|bcStrings| (6 "0.0" |a75| F)) + (|bcStrings| (6 "1.0" |a76| F)) + (|bcStrings| (6 "2.0" |a77| F)) + (|bcStrings| (6 "1.0" |a78| F)) + (|bcStrings| (6 "0.0" |a79| F)) + (|bcStrings| (6 "0.0" |a710| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a81| F)) + (|bcStrings| (6 "0.0" |a82| F)) + (|bcStrings| (6 "0.0" |a83| F)) + (|bcStrings| (6 "0.0" |a84| F)) + (|bcStrings| (6 "0.0" |a85| F)) + (|bcStrings| (6 "0.0" |a86| F)) + (|bcStrings| (6 "1.0" |a87| F)) + (|bcStrings| (6 "2.0" |a88| F)) + (|bcStrings| (6 "1.0" |a89| F)) + (|bcStrings| (6 "0.0" |a810| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a91| F)) + (|bcStrings| (6 "0.0" |a92| F)) + (|bcStrings| (6 "0.0" |a93| F)) + (|bcStrings| (6 "0.0" |a94| F)) + (|bcStrings| (6 "0.0" |a95| F)) + (|bcStrings| (6 "0.0" |a96| F)) + (|bcStrings| (6 "0.0" |a97| F)) + (|bcStrings| (6 "1.0" |a98| F)) + (|bcStrings| (6 "2.0" |a99| F)) + (|bcStrings| (6 "1.0" |a910| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "3.0" |a101| F)) + (|bcStrings| (6 "0.0" |a102| F)) + (|bcStrings| (6 "0.0" |a103| F)) + (|bcStrings| (6 "0.0" |a104| F)) + (|bcStrings| (6 "0.0" |a105| F)) + (|bcStrings| (6 "0.0" |a106| F)) + (|bcStrings| (6 "0.0" |a107| F)) + (|bcStrings| (6 "0.0" |a108| F)) + (|bcStrings| (6 "1.0" |a109| F)) + (|bcStrings| (6 "2.0" |a1010| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Enter the matrix {\\it m}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "2.0" |m11| F)) + (|bcStrings| (6 "1.0" |m12| F)) + (|bcStrings| (6 "0.0" |m13| F)) + (|bcStrings| (6 "0.0" |m14| F)) + (|bcStrings| (6 "0.0" |m15| F)) + (|bcStrings| (6 "0.0" |m16| F)) + (|bcStrings| (6 "0.0" |m17| F)) + (|bcStrings| (6 "0.0" |m18| F)) + (|bcStrings| (6 "0.0" |m19| F)) + (|bcStrings| (6 "0.0" |m110| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.0" |m21| F)) + (|bcStrings| (6 "2.0" |m22| F)) + (|bcStrings| (6 "1.0" |m23| F)) + (|bcStrings| (6 "0.0" |m24| F)) + (|bcStrings| (6 "0.0" |m25| F)) + (|bcStrings| (6 "0.0" |m26| F)) + (|bcStrings| (6 "0.0" |m27| F)) + (|bcStrings| (6 "0.0" |m28| F)) + (|bcStrings| (6 "0.0" |m29| F)) + (|bcStrings| (6 "0.0" |m210| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |m31| F)) + (|bcStrings| (6 "1.0" |m32| F)) + (|bcStrings| (6 "2.0" |m33| F)) + (|bcStrings| (6 "1.0" |m34| F)) + (|bcStrings| (6 "0.0" |m35| F)) + (|bcStrings| (6 "0.0" |m36| F)) + (|bcStrings| (6 "0.0" |m37| F)) + (|bcStrings| (6 "0.0" |m38| F)) + (|bcStrings| (6 "0.0" |m39| F)) + (|bcStrings| (6 "0.0" |m310| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |m41| F)) + (|bcStrings| (6 "0.0" |m42| F)) + (|bcStrings| (6 "1.0" |m43| F)) + (|bcStrings| (6 "2.0" |m44| F)) + (|bcStrings| (6 "1.0" |m45| F)) + (|bcStrings| (6 "0.0" |m46| F)) + (|bcStrings| (6 "0.0" |m47| F)) + (|bcStrings| (6 "0.0" |m48| F)) + (|bcStrings| (6 "0.0" |m49| F)) + (|bcStrings| (6 "0.0" |m410| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |m51| F)) + (|bcStrings| (6 "0.0" |m52| F)) + (|bcStrings| (6 "0.0" |m53| F)) + (|bcStrings| (6 "1.0" |m54| F)) + (|bcStrings| (6 "2.0" |m55| F)) + (|bcStrings| (6 "1.0" |m56| F)) + (|bcStrings| (6 "0.0" |m57| F)) + (|bcStrings| (6 "0.0" |m58| F)) + (|bcStrings| (6 "0.0" |m59| F)) + (|bcStrings| (6 "0.0" |m510| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |m61| F)) + (|bcStrings| (6 "0.0" |m62| F)) + (|bcStrings| (6 "0.0" |m63| F)) + (|bcStrings| (6 "0.0" |m64| F)) + (|bcStrings| (6 "1.0" |m65| F)) + (|bcStrings| (6 "2.0" |m66| F)) + (|bcStrings| (6 "1.0" |m67| F)) + (|bcStrings| (6 "0.0" |m68| F)) + (|bcStrings| (6 "0.0" |m69| F)) + (|bcStrings| (6 "0.0" |m610| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |m71| F)) + (|bcStrings| (6 "0.0" |m72| F)) + (|bcStrings| (6 "0.0" |m73| F)) + (|bcStrings| (6 "0.0" |m74| F)) + (|bcStrings| (6 "0.0" |m75| F)) + (|bcStrings| (6 "1.0" |m76| F)) + (|bcStrings| (6 "2.0" |m77| F)) + (|bcStrings| (6 "1.0" |m78| F)) + (|bcStrings| (6 "0.0" |m79| F)) + (|bcStrings| (6 "0.0" |m710| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |m81| F)) + (|bcStrings| (6 "0.0" |m82| F)) + (|bcStrings| (6 "0.0" |m83| F)) + (|bcStrings| (6 "0.0" |m84| F)) + (|bcStrings| (6 "0.0" |m85| F)) + (|bcStrings| (6 "0.0" |m86| F)) + (|bcStrings| (6 "1.0" |m87| F)) + (|bcStrings| (6 "2.0" |m88| F)) + (|bcStrings| (6 "1.0" |m89| F)) + (|bcStrings| (6 "0.0" |m810| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |m91| F)) + (|bcStrings| (6 "0.0" |m92| F)) + (|bcStrings| (6 "0.0" |m93| F)) + (|bcStrings| (6 "0.0" |m94| F)) + (|bcStrings| (6 "0.0" |m95| F)) + (|bcStrings| (6 "0.0" |m96| F)) + (|bcStrings| (6 "0.0" |m97| F)) + (|bcStrings| (6 "1.0" |m98| F)) + (|bcStrings| (6 "2.0" |m99| F)) + (|bcStrings| (6 "1.0" |m910| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |m101| F)) + (|bcStrings| (6 "0.0" |m102| F)) + (|bcStrings| (6 "0.0" |m103| F)) + (|bcStrings| (6 "0.0" |m104| F)) + (|bcStrings| (6 "0.0" |m105| F)) + (|bcStrings| (6 "0.0" |m106| F)) + (|bcStrings| (6 "0.0" |m107| F)) + (|bcStrings| (6 "0.0" |m108| F)) + (|bcStrings| (6 "1.0" |m109| F)) + (|bcStrings| (6 "2.0" |m1010| F)) + (|text| . "\\blankline "))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04mbfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|precon| |precon|) + (|htpSetProperty| |page| '|shift| |shift|) + (|htpSetProperty| |page| '|rtol| |rtol|) + (|htpSetProperty| |page| '|itnlim| |itnlim|) + (|htpSetProperty| |page| '|msglvl| |msglvl|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f04mbfGen htPage == +; n := htpProperty(htPage,'n) +; precon := htpProperty(htPage,'precon) +; shift := htpProperty(htPage,'shift) +; rtol := htpProperty(htPage,'rtol) +; itnlim := htpProperty(htPage,'itnlim) +; msglvl := htpProperty(htPage,'msglvl) +; ifail := htpProperty(htPage,'ifail) +; lrwork := '1 +; liwork := '1 +; alist := htpInputAreaAlist htPage +; y := alist +; if (precon = 'true) then +; for i in 1..n repeat +; for j in 1..n repeat +; melm := STRCONC((first y).1," ") +; mrowlist := [melm,:mrowlist] +; y := rest y +; matm := [mrowlist,:matm] +; mrowlist := [] +; mstring := bcwords2liststring [bcwords2liststring x for x in matm] +; for k in 1..n repeat +; for l in 1..n repeat +; aelm := STRCONC((first y).1," ") +; arowlist := [aelm,:arowlist] +; y := rest y +; mata := [arowlist,:mata] +; arowlist := [] +; astring := bcwords2liststring [bcwords2liststring y for y in mata] +; for z in 1..n repeat +; belm := STRCONC((first y).1," ") +; blist := [belm,:blist] +; y := rest y +; bstring := bcwords2liststring blist +; if (precon = 'false) then +; mstring := astring +; prefix := STRCONC('"f04mbf(",STRINGIMAGE n,",[",bstring,"]::Matrix DoubleFloat,",precon,",") +; prefix := STRCONC(prefix,STRINGIMAGE shift,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",") +; prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",") +; prefix := STRCONC(prefix,STRINGIMAGE rtol,",",STRINGIMAGE ifail,",((") +; prefix := STRCONC(prefix,astring,"::Matrix MachineFloat)::ASP28(APROD)),((") +; prefix := STRCONC(prefix,mstring,"::Matrix MachineFloat)::ASP34(MSOLVE)))") +; linkGen prefix + +(DEFUN |f04mbfGen| (|htPage|) + (PROG (|n| |precon| |shift| |rtol| |itnlim| |msglvl| |ifail| |lrwork| + |liwork| |alist| |melm| |matm| |mrowlist| |aelm| |mata| + |arowlist| |astring| |belm| |blist| |y| |bstring| + |mstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |precon| (|htpProperty| |htPage| '|precon|)) + (SPADLET |shift| (|htpProperty| |htPage| '|shift|)) + (SPADLET |rtol| (|htpProperty| |htPage| '|rtol|)) + (SPADLET |itnlim| (|htpProperty| |htPage| '|itnlim|)) + (SPADLET |msglvl| (|htpProperty| |htPage| '|msglvl|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |lrwork| '1) + (SPADLET |liwork| '1) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (COND + ((BOOT-EQUAL |precon| '|true|) + (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 |melm| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |mrowlist| + (CONS |melm| |mrowlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |matm| + (CONS |mrowlist| |matm|)) + (SPADLET |mrowlist| NIL))))) + (SPADLET |mstring| + (|bcwords2liststring| + (PROG (G167409) + (SPADLET G167409 NIL) + (RETURN + (DO ((G167414 |matm| + (CDR G167414)) + (|x| NIL)) + ((OR (ATOM G167414) + (PROGN + (SETQ |x| (CAR G167414)) + NIL)) + (NREVERSE0 G167409)) + (SEQ + (EXIT + (SETQ G167409 + (CONS (|bcwords2liststring| |x|) + G167409))))))))))) + (DO ((|k| 1 (QSADD1 |k|))) ((QSGREATERP |k| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|l| 1 (QSADD1 |l|))) + ((QSGREATERP |l| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |aelm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |arowlist| + (CONS |aelm| |arowlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |mata| (CONS |arowlist| |mata|)) + (SPADLET |arowlist| NIL))))) + (SPADLET |astring| + (|bcwords2liststring| + (PROG (G167445) + (SPADLET G167445 NIL) + (RETURN + (DO ((G167450 |mata| (CDR G167450)) + (|y| NIL)) + ((OR (ATOM G167450) + (PROGN + (SETQ |y| (CAR G167450)) + NIL)) + (NREVERSE0 G167445)) + (SEQ (EXIT + (SETQ G167445 + (CONS (|bcwords2liststring| |y|) + G167445))))))))) + (DO ((|z| 1 (QSADD1 |z|))) ((QSGREATERP |z| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |belm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |blist| (CONS |belm| |blist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bstring| (|bcwords2liststring| |blist|)) + (COND + ((BOOT-EQUAL |precon| '|false|) + (SPADLET |mstring| |astring|))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f04mbf(") (STRINGIMAGE |n|) + '|,[| |bstring| + '|]::Matrix DoubleFloat,| |precon| '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |shift|) '|,| + (STRINGIMAGE |itnlim|) '|,| + (STRINGIMAGE |msglvl|) '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lrwork|) '|,| + (STRINGIMAGE |liwork|) '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |rtol|) '|,| + (STRINGIMAGE |ifail|) '|,((|)) + (SPADLET |prefix| + (STRCONC |prefix| |astring| + '|::Matrix MachineFloat)::ASP28(APROD)),((|)) + (SPADLET |prefix| + (STRCONC |prefix| |mstring| + '|::Matrix MachineFloat)::ASP34(MSOLVE)))|)) + (|linkGen| |prefix|)))))) + +;-- f04qaf() == +;-- htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) +;-- htMakePage '( +;-- (domainConditions +;-- (isDomain EM $EmptyMode) +;-- (isDomain F (Float))) +;-- (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ") +;-- (text . "\newline ") +;-- (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine") +;-- (text . "\newline \horizontalline ") +;-- (text . "\newline ") +;-- (text . "F04QAF solves sparse unsymmetric equations, sparse linear ") +;-- (text . "least-squares problems and sparse damped least-squares ") +;-- (text . "problems, using a Lanczos algorithm. Specifically, the ") +;-- (text . "routine can be used to solve a system of linear equations ") +;-- (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ") +;-- (text . "sparse unsymmetric matrix, or can be used to solve linear ") +;-- (text . "least-squares problems, so that it minimizes the the value ") +;-- (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ") +;-- (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ") +;-- (text . "sparse matrix. A damping parameter \lambda may ") +;-- (text . "be included in the least squares problem in which case the ") +;-- (text . "routine minimizes the value {\htbitmap{newrho}} given by ") +;-- (text . "{\htbitmap{rhosq=}}. \newline ") +;-- (text . "\blankline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "\spadcommand{)read f04qaf \bound{s0}} ")) +;-- htShowPage() +;-- f04mbf() == +;-- htInitPage('"F04MBF - Real sparse symmetric simultaneous linear equations",nil) +;-- htMakePage '( +;-- (domainConditions +;-- (isDomain EM $EmptyMode) +;-- (isDomain F (Float))) +;-- (text . "\windowlink{Manual Page}{manpageXXf04mbf} for this routine ") +;-- (text . "\newline ") +;-- (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04mbf| '|NagLinearEquationSolvingPackage|)} for this routine") +;-- (text . "\newline \horizontalline ") +;-- (text . "\newline ") +;-- (text . "\newline ") +;-- (text . "F04MBF solve a system of real symmetric linear equations ") +;-- (text . "({\it A} - \lambda {\it I}){\it x} = {\it b} using a Lanczos ") +;-- (text . "algorithm, where {\it A} is an {\it n} by {\it n} sparse ") +;-- (text . "symmetric matrix, {\it x} is an {\it n} vector of unknowns ") +;-- (text . "and {\it b} is an {\it n} element right-hand side vector. ") +;-- (text . "\blankline") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{}\tab{2} ") +;-- (text . "\spadcommand{)read f04mbf \bound{s0}} ")) +;-- htShowPage() +;f04qaf() == +; htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain PI (PositiveInteger)) +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXf04qaf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "F04QAF solves sparse unsymmetric equations, sparse linear ") +; (text . "least-squares problems and sparse damped least-squares ") +; (text . "problems, using a Lanczos algorithm. Specifically, the ") +; (text . "routine can be used to solve a system of linear equations ") +; (text . "{\it Ax=b}, where {\it A} is an {\it n} by {\it n} real ") +; (text . "sparse unsymmetric matrix, or can be used to solve linear ") +; (text . "least-squares problems, so that it minimizes the the value ") +; (text . "{\htbitmap{newrho}} given by {\htbitmap{rho=r}}, ") +; (text . "{\it r=b-AX} where {\it A} is an {\it m} by {\it n} real ") +; (text . "sparse matrix. A damping parameter \lambda may ") +; (text . "be included in the least squares problem in which case the ") +; (text . "routine minimizes the value {\htbitmap{newrho}} given by ") +; (text . "{\htbitmap{rhosq=}}. \newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the number of rows of the matrix {\it A}, {\it m}:") +; (text . "\newline \tab{2}") +; (bcStrings (10 13 m PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the number of columns of the matrix {\it A}, {\it n}:") +; (text . "\newline \tab{2}") +; (bcStrings (10 12 n PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the damping parameter \lambda, {\it damp}:") +; (text . "\newline \tab{2}") +; (bcStrings (10 "0.0" damp F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the tolerance for elements of {\it A}, {\it atol}:") +; (text . "\newline \tab{2}") +; (bcStrings (10 "0.00001" atol F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the tolerance for elements of {\it b}, {\it btol}:") +; (text . "\newline \tab{2}") +; (bcStrings (10 "0.0001" btol F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the maximum number of iterations {\it itnlim}:") +; (text . "\newline \tab{2}") +; (bcStrings (10 100 itnlim PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the printing level {\it msglvl}:") +; (text . "\newline \tab{2}") +; (bcStrings (10 1 msglvl PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value: ") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'f04qafSolve) +; htShowPage() + +(DEFUN |f04qaf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| PI (|PositiveInteger|)) + (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf04qaf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f04qaf| '|NagLinearEquationSolvingPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "F04QAF solves sparse unsymmetric equations, sparse linear ") + (|text| + . "least-squares problems and sparse damped least-squares ") + (|text| + . "problems, using a Lanczos algorithm. Specifically, the ") + (|text| + . "routine can be used to solve a system of linear equations ") + (|text| + . "{\\it Ax=b}, where {\\it A} is an {\\it n} by {\\it n} real ") + (|text| + . "sparse unsymmetric matrix, or can be used to solve linear ") + (|text| + . "least-squares problems, so that it minimizes the the value ") + (|text| + . "{\\htbitmap{newrho}} given by {\\htbitmap{rho=r}}, ") + (|text| + . "{\\it r=b-AX} where {\\it A} is an {\\it m} by {\\it n} real ") + (|text| . "sparse matrix. A damping parameter \\lambda may ") + (|text| + . "be included in the least squares problem in which case the ") + (|text| + . "routine minimizes the value {\\htbitmap{newrho}} given by ") + (|text| . "{\\htbitmap{rhosq=}}. \\newline ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the number of rows of the matrix {\\it A}, {\\it m}:") + (|text| . "\\newline \\tab{2}") (|bcStrings| (10 13 |m| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the number of columns of the matrix {\\it A}, {\\it n}:") + (|text| . "\\newline \\tab{2}") (|bcStrings| (10 12 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the damping parameter \\lambda, {\\it damp}:") + (|text| . "\\newline \\tab{2}") + (|bcStrings| (10 "0.0" |damp| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the tolerance for elements of {\\it A}, {\\it atol}:") + (|text| . "\\newline \\tab{2}") + (|bcStrings| (10 "0.00001" |atol| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the tolerance for elements of {\\it b}, {\\it btol}:") + (|text| . "\\newline \\tab{2}") + (|bcStrings| (10 "0.0001" |btol| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the maximum number of iterations {\\it itnlim}:") + (|text| . "\\newline \\tab{2}") + (|bcStrings| (10 100 |itnlim| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the printing level {\\it msglvl}:") + (|text| . "\\newline \\tab{2}") + (|bcStrings| (10 1 |msglvl| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value: ") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04qafSolve|) + (|htShowPage|))) + +;f04qafSolve htPage == +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; damp := htpLabelInputString(htPage,'damp) +; atol := htpLabelInputString(htPage,'atol) +; btol := htpLabelInputString(htPage,'btol) +; itnlim := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itnlim) +; objValUnwrap htpLabelSpadValue(htPage, 'itnlim) +; msglvl := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'msglvl) +; objValUnwrap htpLabelSpadValue(htPage, 'msglvl) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; (m = '13 and n = '12) => f04qafDefaultSolve(htPage,damp,atol,btol,itnlim,msglvl,ifail) +; bmatList := +; "append"/[f(i) for i in 1..m] where f(i) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE i) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; amatList := +; "append"/[h(ia,n) for ia in 1..m] where h(ia,n) == +; alabelList := +; "append"/[k(ia,ja) for ja in 1..n] where k(ia,ja) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE ia,STRINGIMAGE ja) +; [['bcStrings,[6, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; alabelList := [['text,:prefix],:alabelList] +; start := ('"\blankline \menuitemstyle{}\tab{2} Enter the matrix {\it A}: ") +; amatList := [['text,:start],:amatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain F (Float))), +; :bmatList,:amatList] +; page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} " +; htSay '"Enter the right-hand side vector {\it b(m)}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f04qafGen) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'damp,damp) +; htpSetProperty(page,'atol,atol) +; htpSetProperty(page,'btol,btol) +; htpSetProperty(page,'itnlim,itnlim) +; htpSetProperty(page,'msglvl,msglvl) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04qafSolve,f| (|i|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04qafSolve,k| (|ia| |ja|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") + (STRINGIMAGE |ia|) + (STRINGIMAGE |ja|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f04qafSolve,h| (|ia| |n|) + (PROG (|prefix| |alabelList|) + (RETURN + (SEQ (SPADLET |alabelList| + (PROG (G167526) + (SPADLET G167526 NIL) + (RETURN + (DO ((|ja| 1 (QSADD1 |ja|))) + ((QSGREATERP |ja| |n|) G167526) + (SEQ (EXIT (SETQ G167526 + (APPEND G167526 + (|f04qafSolve,k| |ia| |ja|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |alabelList| + (CONS (CONS '|text| |prefix|) |alabelList|))))))) + +(DEFUN |f04qafSolve| (|htPage|) + (PROG (|m| |n| |damp| |atol| |btol| |itnlim| |msglvl| |error| |ifail| + |bmatList| |start| |amatList| |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 |damp| (|htpLabelInputString| |htPage| '|damp|)) + (SPADLET |atol| (|htpLabelInputString| |htPage| '|atol|)) + (SPADLET |btol| (|htpLabelInputString| |htPage| '|btol|)) + (SPADLET |itnlim| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|itnlim|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|itnlim|))))) + (SPADLET |msglvl| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|msglvl|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|msglvl|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '13) (BOOT-EQUAL |n| '12)) + (|f04qafDefaultSolve| |htPage| |damp| |atol| |btol| + |itnlim| |msglvl| |ifail|)) + ('T + (SPADLET |bmatList| + (PROG (G167543) + (SPADLET G167543 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |m|) G167543) + (SEQ (EXIT + (SETQ G167543 + (APPEND G167543 + (|f04qafSolve,f| |i|))))))))) + (SPADLET |amatList| + (PROG (G167551) + (SPADLET G167551 NIL) + (RETURN + (DO ((|ia| 1 (QSADD1 |ia|))) + ((QSGREATERP |ia| |m|) G167551) + (SEQ (EXIT + (SETQ G167551 + (APPEND G167551 + (|f04qafSolve,h| |ia| |n|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter the matrix {\\it A}: ")) + (SPADLET |amatList| + (CONS (CONS '|text| |start|) |amatList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| F (|Float|))) + (APPEND |bmatList| |amatList|))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm") + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the right-hand side vector {\\it b(m)}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f04qafGen|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|damp| |damp|) + (|htpSetProperty| |page| '|atol| |atol|) + (|htpSetProperty| |page| '|btol| |btol|) + (|htpSetProperty| |page| '|itnlim| |itnlim|) + (|htpSetProperty| |page| '|msglvl| |msglvl|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f04qafDefaultSolve (htPage,damp,atol,btol,itnlim,msglvl,ifail) == +; m := '13 +; n := '12 +; page := htInitPage('"F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the right-hand side vector {\it b(n)}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" b1 F)) +; (bcStrings (6 "0.0" b2 F)) +; (bcStrings (6 "0.0" b3 F)) +; (bcStrings (6 "-0.01" b4 F)) +; (bcStrings (6 "-0.01" b5 F)) +; (bcStrings (6 "0.0" b6 F)) +; (bcStrings (6 "0.0" b7 F)) +; (bcStrings (6 "-0.01" b8 F)) +; (bcStrings (6 "-0.01" b9 F)) +; (bcStrings (6 "0.0" b10 F)) +; (bcStrings (6 "0.0" b11 F)) +; (bcStrings (6 "0.0" b12 F)) +; (bcStrings (6 "10.0" b13 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the matrix {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.0" a0101 F)) +; (bcStrings (6 "0.0" a0102 F)) +; (bcStrings (6 "0.0" a0103 F)) +; (bcStrings (6 "-1.0" a0104 F)) +; (bcStrings (6 "0.0" a0105 F)) +; (bcStrings (6 "0.0" a0106 F)) +; (bcStrings (6 "0.0" a0107 F)) +; (bcStrings (6 "0.0" a0108 F)) +; (bcStrings (6 "0.0" a0109 F)) +; (bcStrings (6 "0.0" a0110 F)) +; (bcStrings (6 "0.0" a0111 F)) +; (bcStrings (6 "0.0" a0112 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a0201 F)) +; (bcStrings (6 "1.0" a0202 F)) +; (bcStrings (6 "0.0" a0203 F)) +; (bcStrings (6 "0.0" a0204 F)) +; (bcStrings (6 "-1.0" a0205 F)) +; (bcStrings (6 "0.0" a0206 F)) +; (bcStrings (6 "0.0" a0207 F)) +; (bcStrings (6 "0.0" a0208 F)) +; (bcStrings (6 "0.0" a0209 F)) +; (bcStrings (6 "0.0" a0210 F)) +; (bcStrings (6 "0.0" a0211 F)) +; (bcStrings (6 "0.0" a0212 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a0301 F)) +; (bcStrings (6 "0.0" a0302 F)) +; (bcStrings (6 "1.0" a0303 F)) +; (bcStrings (6 "-1.0" a0304 F)) +; (bcStrings (6 "0.0" a0305 F)) +; (bcStrings (6 "0.0" a0306 F)) +; (bcStrings (6 "0.0" a0307 F)) +; (bcStrings (6 "0.0" a0308 F)) +; (bcStrings (6 "0.0" a0309 F)) +; (bcStrings (6 "0.0" a0310 F)) +; (bcStrings (6 "0.0" a0311 F)) +; (bcStrings (6 "0.0" a0312 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-1.0" a0401 F)) +; (bcStrings (6 "0.0" a0402 F)) +; (bcStrings (6 "-1.0" a0403 F)) +; (bcStrings (6 "4.0" a0404 F)) +; (bcStrings (6 "-1.0" a0405 F)) +; (bcStrings (6 "0.0" a0406 F)) +; (bcStrings (6 "0.0" a0407 F)) +; (bcStrings (6 "-1.0" a0408 F)) +; (bcStrings (6 "0.0" a0409 F)) +; (bcStrings (6 "0.0" a0410 F)) +; (bcStrings (6 "0.0" a0411 F)) +; (bcStrings (6 "0.0" a0412 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a0501 F)) +; (bcStrings (6 "-1.0" a0502 F)) +; (bcStrings (6 "0.0" a0503 F)) +; (bcStrings (6 "-1.0" a0504 F)) +; (bcStrings (6 "4.0" a0505 F)) +; (bcStrings (6 "-1.0" a0506 F)) +; (bcStrings (6 "0.0" a0507 F)) +; (bcStrings (6 "0.0" a0508 F)) +; (bcStrings (6 "-1.0" a0509 F)) +; (bcStrings (6 "0.0" a0510 F)) +; (bcStrings (6 "0.0" a0511 F)) +; (bcStrings (6 "0.0" a0512 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a0601 F)) +; (bcStrings (6 "0.0" a0602 F)) +; (bcStrings (6 "0.0" a0603 F)) +; (bcStrings (6 "0.0" a0604 F)) +; (bcStrings (6 "-1.0" a0605 F)) +; (bcStrings (6 "1.0" a0606 F)) +; (bcStrings (6 "0.0" a0607 F)) +; (bcStrings (6 "0.0" a0608 F)) +; (bcStrings (6 "0.0" a0609 F)) +; (bcStrings (6 "0.0" a0610 F)) +; (bcStrings (6 "0.0" a0611 F)) +; (bcStrings (6 "0.0" a0612 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a0701 F)) +; (bcStrings (6 "0.0" a0702 F)) +; (bcStrings (6 "0.0" a0703 F)) +; (bcStrings (6 "0.0" a0704 F)) +; (bcStrings (6 "0.0" a0705 F)) +; (bcStrings (6 "0.0" a0706 F)) +; (bcStrings (6 "1.0" a0707 F)) +; (bcStrings (6 "-1.0" a0708 F)) +; (bcStrings (6 "0.0" a0709 F)) +; (bcStrings (6 "0.0" a0710 F)) +; (bcStrings (6 "0.0" a0711 F)) +; (bcStrings (6 "0.0" a0712 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a0801 F)) +; (bcStrings (6 "0.0" a0802 F)) +; (bcStrings (6 "0.0" a0803 F)) +; (bcStrings (6 "-1.0" a0804 F)) +; (bcStrings (6 "0.0" a0805 F)) +; (bcStrings (6 "0.0" a0806 F)) +; (bcStrings (6 "-1.0" a0807 F)) +; (bcStrings (6 "4.0" a0808 F)) +; (bcStrings (6 "-1.0" a0809 F)) +; (bcStrings (6 "0.0" a0810 F)) +; (bcStrings (6 "-1.0" a0811 F)) +; (bcStrings (6 "0.0" a0812 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a0901 F)) +; (bcStrings (6 "0.0" a0902 F)) +; (bcStrings (6 "0.0" a0903 F)) +; (bcStrings (6 "0.0" a0904 F)) +; (bcStrings (6 "-1.0" a0905 F)) +; (bcStrings (6 "0.0" a0906 F)) +; (bcStrings (6 "0.0" a0907 F)) +; (bcStrings (6 "-1.0" a0908 F)) +; (bcStrings (6 "4.0" a0909 F)) +; (bcStrings (6 "-1.0" a0910 F)) +; (bcStrings (6 "0.0" a0911 F)) +; (bcStrings (6 "-1.0" a0912 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a1001 F)) +; (bcStrings (6 "0.0" a1002 F)) +; (bcStrings (6 "0.0" a1003 F)) +; (bcStrings (6 "0.0" a1004 F)) +; (bcStrings (6 "0.0" a1005 F)) +; (bcStrings (6 "0.0" a1006 F)) +; (bcStrings (6 "0.0" a1007 F)) +; (bcStrings (6 "0.0" a1008 F)) +; (bcStrings (6 "-1.0" a1009 F)) +; (bcStrings (6 "1.0" a1010 F)) +; (bcStrings (6 "0.0" a1011 F)) +; (bcStrings (6 "0.0" a1012 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a1101 F)) +; (bcStrings (6 "0.0" a1102 F)) +; (bcStrings (6 "0.0" a1103 F)) +; (bcStrings (6 "0.0" a1104 F)) +; (bcStrings (6 "0.0" a1105 F)) +; (bcStrings (6 "0.0" a1106 F)) +; (bcStrings (6 "0.0" a1107 F)) +; (bcStrings (6 "-1.0" a1108 F)) +; (bcStrings (6 "0.0" a1109 F)) +; (bcStrings (6 "0.0" a1110 F)) +; (bcStrings (6 "1.0" a1111 F)) +; (bcStrings (6 "0.0" a1112 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a1201 F)) +; (bcStrings (6 "0.0" a1202 F)) +; (bcStrings (6 "0.0" a1203 F)) +; (bcStrings (6 "0.0" a1204 F)) +; (bcStrings (6 "0.0" a1205 F)) +; (bcStrings (6 "0.0" a1206 F)) +; (bcStrings (6 "0.0" a1207 F)) +; (bcStrings (6 "0.0" a1208 F)) +; (bcStrings (6 "-1.0" a1209 F)) +; (bcStrings (6 "0.0" a1210 F)) +; (bcStrings (6 "0.0" a1211 F)) +; (bcStrings (6 "1.0" a1212 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.0" a1301 F)) +; (bcStrings (6 "1.0" a1302 F)) +; (bcStrings (6 "1.0" a1303 F)) +; (bcStrings (6 "0.0" a1304 F)) +; (bcStrings (6 "0.0" a1305 F)) +; (bcStrings (6 "1.0" a1306 F)) +; (bcStrings (6 "1.0" a1307 F)) +; (bcStrings (6 "0.0" a1308 F)) +; (bcStrings (6 "0.0" a1309 F)) +; (bcStrings (6 "1.0" a1310 F)) +; (bcStrings (6 "1.0" a1311 F)) +; (bcStrings (6 "1.0" a1312 F)) +; (text . "\blankline ")) +; htMakeDoneButton('"Continue",'f04qafGen) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'damp,damp) +; htpSetProperty(page,'atol,atol) +; htpSetProperty(page,'btol,btol) +; htpSetProperty(page,'itnlim,itnlim) +; htpSetProperty(page,'msglvl,msglvl) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f04qafDefaultSolve| + (|htPage| |damp| |atol| |btol| |itnlim| |msglvl| |ifail|) + (PROG (|m| |n| |page|) + (RETURN + (PROGN + (SPADLET |m| '13) + (SPADLET |n| '12) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F04QAF - Solution of sparse unsymmetric equations, linear and damped least-squares problems using a Lanczos algorithm") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Enter the right-hand side vector {\\it b(n)}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |b1| F)) + (|bcStrings| (6 "0.0" |b2| F)) + (|bcStrings| (6 "0.0" |b3| F)) + (|bcStrings| (6 "-0.01" |b4| F)) + (|bcStrings| (6 "-0.01" |b5| F)) + (|bcStrings| (6 "0.0" |b6| F)) + (|bcStrings| (6 "0.0" |b7| F)) + (|bcStrings| (6 "-0.01" |b8| F)) + (|bcStrings| (6 "-0.01" |b9| F)) + (|bcStrings| (6 "0.0" |b10| F)) + (|bcStrings| (6 "0.0" |b11| F)) + (|bcStrings| (6 "0.0" |b12| F)) + (|bcStrings| (6 "10.0" |b13| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Enter the matrix {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.0" |a0101| F)) + (|bcStrings| (6 "0.0" |a0102| F)) + (|bcStrings| (6 "0.0" |a0103| F)) + (|bcStrings| (6 "-1.0" |a0104| F)) + (|bcStrings| (6 "0.0" |a0105| F)) + (|bcStrings| (6 "0.0" |a0106| F)) + (|bcStrings| (6 "0.0" |a0107| F)) + (|bcStrings| (6 "0.0" |a0108| F)) + (|bcStrings| (6 "0.0" |a0109| F)) + (|bcStrings| (6 "0.0" |a0110| F)) + (|bcStrings| (6 "0.0" |a0111| F)) + (|bcStrings| (6 "0.0" |a0112| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a0201| F)) + (|bcStrings| (6 "1.0" |a0202| F)) + (|bcStrings| (6 "0.0" |a0203| F)) + (|bcStrings| (6 "0.0" |a0204| F)) + (|bcStrings| (6 "-1.0" |a0205| F)) + (|bcStrings| (6 "0.0" |a0206| F)) + (|bcStrings| (6 "0.0" |a0207| F)) + (|bcStrings| (6 "0.0" |a0208| F)) + (|bcStrings| (6 "0.0" |a0209| F)) + (|bcStrings| (6 "0.0" |a0210| F)) + (|bcStrings| (6 "0.0" |a0211| F)) + (|bcStrings| (6 "0.0" |a0212| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a0301| F)) + (|bcStrings| (6 "0.0" |a0302| F)) + (|bcStrings| (6 "1.0" |a0303| F)) + (|bcStrings| (6 "-1.0" |a0304| F)) + (|bcStrings| (6 "0.0" |a0305| F)) + (|bcStrings| (6 "0.0" |a0306| F)) + (|bcStrings| (6 "0.0" |a0307| F)) + (|bcStrings| (6 "0.0" |a0308| F)) + (|bcStrings| (6 "0.0" |a0309| F)) + (|bcStrings| (6 "0.0" |a0310| F)) + (|bcStrings| (6 "0.0" |a0311| F)) + (|bcStrings| (6 "0.0" |a0312| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-1.0" |a0401| F)) + (|bcStrings| (6 "0.0" |a0402| F)) + (|bcStrings| (6 "-1.0" |a0403| F)) + (|bcStrings| (6 "4.0" |a0404| F)) + (|bcStrings| (6 "-1.0" |a0405| F)) + (|bcStrings| (6 "0.0" |a0406| F)) + (|bcStrings| (6 "0.0" |a0407| F)) + (|bcStrings| (6 "-1.0" |a0408| F)) + (|bcStrings| (6 "0.0" |a0409| F)) + (|bcStrings| (6 "0.0" |a0410| F)) + (|bcStrings| (6 "0.0" |a0411| F)) + (|bcStrings| (6 "0.0" |a0412| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a0501| F)) + (|bcStrings| (6 "-1.0" |a0502| F)) + (|bcStrings| (6 "0.0" |a0503| F)) + (|bcStrings| (6 "-1.0" |a0504| F)) + (|bcStrings| (6 "4.0" |a0505| F)) + (|bcStrings| (6 "-1.0" |a0506| F)) + (|bcStrings| (6 "0.0" |a0507| F)) + (|bcStrings| (6 "0.0" |a0508| F)) + (|bcStrings| (6 "-1.0" |a0509| F)) + (|bcStrings| (6 "0.0" |a0510| F)) + (|bcStrings| (6 "0.0" |a0511| F)) + (|bcStrings| (6 "0.0" |a0512| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a0601| F)) + (|bcStrings| (6 "0.0" |a0602| F)) + (|bcStrings| (6 "0.0" |a0603| F)) + (|bcStrings| (6 "0.0" |a0604| F)) + (|bcStrings| (6 "-1.0" |a0605| F)) + (|bcStrings| (6 "1.0" |a0606| F)) + (|bcStrings| (6 "0.0" |a0607| F)) + (|bcStrings| (6 "0.0" |a0608| F)) + (|bcStrings| (6 "0.0" |a0609| F)) + (|bcStrings| (6 "0.0" |a0610| F)) + (|bcStrings| (6 "0.0" |a0611| F)) + (|bcStrings| (6 "0.0" |a0612| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a0701| F)) + (|bcStrings| (6 "0.0" |a0702| F)) + (|bcStrings| (6 "0.0" |a0703| F)) + (|bcStrings| (6 "0.0" |a0704| F)) + (|bcStrings| (6 "0.0" |a0705| F)) + (|bcStrings| (6 "0.0" |a0706| F)) + (|bcStrings| (6 "1.0" |a0707| F)) + (|bcStrings| (6 "-1.0" |a0708| F)) + (|bcStrings| (6 "0.0" |a0709| F)) + (|bcStrings| (6 "0.0" |a0710| F)) + (|bcStrings| (6 "0.0" |a0711| F)) + (|bcStrings| (6 "0.0" |a0712| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a0801| F)) + (|bcStrings| (6 "0.0" |a0802| F)) + (|bcStrings| (6 "0.0" |a0803| F)) + (|bcStrings| (6 "-1.0" |a0804| F)) + (|bcStrings| (6 "0.0" |a0805| F)) + (|bcStrings| (6 "0.0" |a0806| F)) + (|bcStrings| (6 "-1.0" |a0807| F)) + (|bcStrings| (6 "4.0" |a0808| F)) + (|bcStrings| (6 "-1.0" |a0809| F)) + (|bcStrings| (6 "0.0" |a0810| F)) + (|bcStrings| (6 "-1.0" |a0811| F)) + (|bcStrings| (6 "0.0" |a0812| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a0901| F)) + (|bcStrings| (6 "0.0" |a0902| F)) + (|bcStrings| (6 "0.0" |a0903| F)) + (|bcStrings| (6 "0.0" |a0904| F)) + (|bcStrings| (6 "-1.0" |a0905| F)) + (|bcStrings| (6 "0.0" |a0906| F)) + (|bcStrings| (6 "0.0" |a0907| F)) + (|bcStrings| (6 "-1.0" |a0908| F)) + (|bcStrings| (6 "4.0" |a0909| F)) + (|bcStrings| (6 "-1.0" |a0910| F)) + (|bcStrings| (6 "0.0" |a0911| F)) + (|bcStrings| (6 "-1.0" |a0912| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a1001| F)) + (|bcStrings| (6 "0.0" |a1002| F)) + (|bcStrings| (6 "0.0" |a1003| F)) + (|bcStrings| (6 "0.0" |a1004| F)) + (|bcStrings| (6 "0.0" |a1005| F)) + (|bcStrings| (6 "0.0" |a1006| F)) + (|bcStrings| (6 "0.0" |a1007| F)) + (|bcStrings| (6 "0.0" |a1008| F)) + (|bcStrings| (6 "-1.0" |a1009| F)) + (|bcStrings| (6 "1.0" |a1010| F)) + (|bcStrings| (6 "0.0" |a1011| F)) + (|bcStrings| (6 "0.0" |a1012| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a1101| F)) + (|bcStrings| (6 "0.0" |a1102| F)) + (|bcStrings| (6 "0.0" |a1103| F)) + (|bcStrings| (6 "0.0" |a1104| F)) + (|bcStrings| (6 "0.0" |a1105| F)) + (|bcStrings| (6 "0.0" |a1106| F)) + (|bcStrings| (6 "0.0" |a1107| F)) + (|bcStrings| (6 "-1.0" |a1108| F)) + (|bcStrings| (6 "0.0" |a1109| F)) + (|bcStrings| (6 "0.0" |a1110| F)) + (|bcStrings| (6 "1.0" |a1111| F)) + (|bcStrings| (6 "0.0" |a1112| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a1201| F)) + (|bcStrings| (6 "0.0" |a1202| F)) + (|bcStrings| (6 "0.0" |a1203| F)) + (|bcStrings| (6 "0.0" |a1204| F)) + (|bcStrings| (6 "0.0" |a1205| F)) + (|bcStrings| (6 "0.0" |a1206| F)) + (|bcStrings| (6 "0.0" |a1207| F)) + (|bcStrings| (6 "0.0" |a1208| F)) + (|bcStrings| (6 "-1.0" |a1209| F)) + (|bcStrings| (6 "0.0" |a1210| F)) + (|bcStrings| (6 "0.0" |a1211| F)) + (|bcStrings| (6 "1.0" |a1212| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.0" |a1301| F)) + (|bcStrings| (6 "1.0" |a1302| F)) + (|bcStrings| (6 "1.0" |a1303| F)) + (|bcStrings| (6 "0.0" |a1304| F)) + (|bcStrings| (6 "0.0" |a1305| F)) + (|bcStrings| (6 "1.0" |a1306| F)) + (|bcStrings| (6 "1.0" |a1307| F)) + (|bcStrings| (6 "0.0" |a1308| F)) + (|bcStrings| (6 "0.0" |a1309| F)) + (|bcStrings| (6 "1.0" |a1310| F)) + (|bcStrings| (6 "1.0" |a1311| F)) + (|bcStrings| (6 "1.0" |a1312| F)) + (|text| . "\\blankline "))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f04qafGen|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|damp| |damp|) + (|htpSetProperty| |page| '|atol| |atol|) + (|htpSetProperty| |page| '|btol| |btol|) + (|htpSetProperty| |page| '|itnlim| |itnlim|) + (|htpSetProperty| |page| '|msglvl| |msglvl|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f04qafGen htPage == +; m := htpProperty(htPage,'m) +; n := htpProperty(htPage,'n) +; damp := htpProperty(htPage,'damp) +; atol := htpProperty(htPage,'atol) +; btol := htpProperty(htPage,'btol) +; divisor := READ_-FROM_-STRING(atol) +; if (divisor < 1.0e-7) then divisor:=1.0e-7 +; conlim := 1.0/divisor +; itnlim := htpProperty(htPage,'itnlim) +; msglvl := htpProperty(htPage,'msglvl) +; ifail := htpProperty(htPage,'ifail) +; lrwork := 1 +; liwork := 1 +; alist := htpInputAreaAlist htPage +; y := alist +; for k in 1..m repeat +; for l in 1..n repeat +; aelm := STRCONC((first y).1," ") +; arowlist := [aelm,:arowlist] +; y := rest y +; mata := [arowlist,:mata] +; arowlist := [] +; astring := bcwords2liststring [bcwords2liststring y for y in mata] +; for z in 1..m repeat +; belm := STRCONC((first y).1," ") +; blist := [belm,:blist] +; y := rest y +; bstring := bcwords2liststring blist +; prefix := STRCONC('"f04qaf(",STRINGIMAGE m,",",STRINGIMAGE n,",") +; prefix := STRCONC(prefix,STRINGIMAGE damp,",") +; prefix := STRCONC(prefix,STRINGIMAGE atol,",",STRINGIMAGE btol,",") +; prefix := STRCONC(prefix,STRINGIMAGE conlim,",",STRINGIMAGE itnlim,",",STRINGIMAGE msglvl,",") +; prefix := STRCONC(prefix,STRINGIMAGE lrwork,",",STRINGIMAGE liwork,",") +; prefix := STRCONC(prefix,"[",bstring,"]::Matrix DoubleFloat,") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,",((",astring,"::Matrix MachineFloat)::ASP30(APROD)))") +; linkGen prefix + +(DEFUN |f04qafGen| (|htPage|) + (PROG (|m| |n| |damp| |atol| |btol| |divisor| |conlim| |itnlim| + |msglvl| |ifail| |lrwork| |liwork| |alist| |aelm| |mata| + |arowlist| |astring| |belm| |blist| |y| |bstring| + |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |damp| (|htpProperty| |htPage| '|damp|)) + (SPADLET |atol| (|htpProperty| |htPage| '|atol|)) + (SPADLET |btol| (|htpProperty| |htPage| '|btol|)) + (SPADLET |divisor| (READ-FROM-STRING |atol|)) + (COND + ((> 9.9999999999999995E-8 |divisor|) + (SPADLET |divisor| 9.9999999999999995E-8))) + (SPADLET |conlim| (QUOTIENT 1.0 |divisor|)) + (SPADLET |itnlim| (|htpProperty| |htPage| '|itnlim|)) + (SPADLET |msglvl| (|htpProperty| |htPage| '|msglvl|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |lrwork| 1) + (SPADLET |liwork| 1) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|k| 1 (QSADD1 |k|))) ((QSGREATERP |k| |m|) NIL) + (SEQ (EXIT (PROGN + (DO ((|l| 1 (QSADD1 |l|))) + ((QSGREATERP |l| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |aelm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |arowlist| + (CONS |aelm| |arowlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |mata| (CONS |arowlist| |mata|)) + (SPADLET |arowlist| NIL))))) + (SPADLET |astring| + (|bcwords2liststring| + (PROG (G167615) + (SPADLET G167615 NIL) + (RETURN + (DO ((G167620 |mata| (CDR G167620)) + (|y| NIL)) + ((OR (ATOM G167620) + (PROGN + (SETQ |y| (CAR G167620)) + NIL)) + (NREVERSE0 G167615)) + (SEQ (EXIT + (SETQ G167615 + (CONS (|bcwords2liststring| |y|) + G167615))))))))) + (DO ((|z| 1 (QSADD1 |z|))) ((QSGREATERP |z| |m|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |belm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |blist| (CONS |belm| |blist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bstring| (|bcwords2liststring| |blist|)) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f04qaf(") (STRINGIMAGE |m|) + '|,| (STRINGIMAGE |n|) '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |damp|) '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |atol|) '|,| + (STRINGIMAGE |btol|) '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |conlim|) '|,| + (STRINGIMAGE |itnlim|) '|,| + (STRINGIMAGE |msglvl|) '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lrwork|) '|,| + (STRINGIMAGE |liwork|) '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| '[ |bstring| + '|]::Matrix DoubleFloat,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|,((| + |astring| + '|::Matrix MachineFloat)::ASP30(APROD)))|)) + (|linkGen| |prefix|)))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}