diff --git a/changelog b/changelog index f82afd1..5f9f796 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +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 +20090901 tpd src/interp/nag-f02.boot removed, rewritten to nag-f02.lisp 20090901 tpd src/axiom-website/patches.html 20090901.03.tpd.patch 20090901 tpd src/interp/Makefile move nag-f01.boot to nag-f01.lisp 20090901 tpd src/interp/nag-f01.lisp added, rewritten from nag-f01.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 76cf090..c0257cc 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1964,5 +1964,7 @@ src/interp/nag-e02.lisp rewrite from boot to lisp
src/interp/nag-e04.lisp rewrite from boot to lisp
20090901.03.tpd.patch src/interp/nag-f01.lisp rewrite from boot to lisp
+20090901.04.tpd.patch +src/interp/nag-f02.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 8ddd319..7893ab0 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -1642,41 +1642,32 @@ ${MID}/nag-f01.lisp: ${IN}/nag-f01.lisp.pamphlet @ -\subsection{nag-f02.boot \cite{54}} +\subsection{nag-f02.lisp} <>= ${AUTO}/nag-f02.${O}: ${OUT}/nag-f02.${O} - @ echo 194 making ${AUTO}/nag-f02.${O} from ${OUT}/nag-f02.${O} + @ echo 154 making ${AUTO}/nag-f02.${O} from ${OUT}/nag-f02.${O} @ cp ${OUT}/nag-f02.${O} ${AUTO} @ <>= -${OUT}/nag-f02.${O}: ${MID}/nag-f02.clisp - @ echo 195 making ${OUT}/nag-f02.${O} from ${MID}/nag-f02.clisp - @ (cd ${MID} ; \ +${OUT}/nag-f02.${O}: ${MID}/nag-f02.lisp + @ echo 136 making ${OUT}/nag-f02.${O} from ${MID}/nag-f02.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/nag-f02.clisp"' \ + echo '(progn (compile-file "${MID}/nag-f02.lisp"' \ ':output-file "${OUT}/nag-f02.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/nag-f02.clisp"' \ + echo '(progn (compile-file "${MID}/nag-f02.lisp"' \ ':output-file "${OUT}/nag-f02.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/nag-f02.clisp: ${IN}/nag-f02.boot.pamphlet - @ echo 196 making ${MID}/nag-f02.clisp from ${IN}/nag-f02.boot.pamphlet +<>= +${MID}/nag-f02.lisp: ${IN}/nag-f02.lisp.pamphlet + @ echo 137 making ${MID}/nag-f02.lisp from ${IN}/nag-f02.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/nag-f02.boot.pamphlet >nag-f02.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-f02.boot") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-f02.boot") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ; \ - rm nag-f02.boot ) + ${TANGLE} ${IN}/nag-f02.lisp.pamphlet >nag-f02.lisp ) @ @@ -4668,7 +4659,7 @@ clean: <> <> -<> +<> <> <> diff --git a/src/interp/nag-f02.boot.pamphlet b/src/interp/nag-f02.boot.pamphlet deleted file mode 100644 index ccbd74f..0000000 --- a/src/interp/nag-f02.boot.pamphlet +++ /dev/null @@ -1,2755 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-f02.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. - -@ -<<*>>= -<> - -f02aaf() == - htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02aaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aaf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues of a real symmetric matrix ") - (text . "{\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia 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", 'f02aafSolve) - htShowPage() - -f02aafSolve 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 => f02aafDefaultSolve(htPage,ia,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) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02aafGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02aafDefaultSolve (htPage,ia,ifail) == - n := '4 - page := htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (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 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "2.3" a13 F)) - (bcStrings (6 "-2.6" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "-1.4" a23 F)) - (bcStrings (6 "-0.7" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.3" a31 F)) - (bcStrings (6 "-1.4" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.6" a41 F)) - (bcStrings (6 "-0.7" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F))) - htMakeDoneButton('"Continue",'f02aafGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02aafGen htPage == - n := htpProperty(htPage,'n) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) - ia := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02aaf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -f02abf() == - htInitPage('"F02ABF - All eigenvalues and eignevectors of real symmetric matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02abf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02abf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and eigenvectors of a real ") - (text . "symmetric matrix ") - (text . "{\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of V, {\it v} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 v 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", 'f02abfSolve) - htShowPage() - -f02abfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - iv := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'v) --- objValUnwrap htpLabelSpadValue(htPage, 'v) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02abfDefaultSolve(htPage,ia,iv,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) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02abfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02abfDefaultSolve (htPage,ia,iv,ifail) == - n := '4 - page := htInitPage('"F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (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 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "2.3" a13 F)) - (bcStrings (6 "-2.6" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "-1.4" a23 F)) - (bcStrings (6 "-0.7" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.3" a31 F)) - (bcStrings (6 "-1.4" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.6" a41 F)) - (bcStrings (6 "-0.7" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F))) - htMakeDoneButton('"Continue",'f02abfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02abfGen htPage == - n := htpProperty(htPage,'n) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) --- iv := htpProperty(htPage,'iv) - ia := n - iv := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02abf(",matstring,", ",STRINGIMAGE ia,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - -f02adf() == - htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02adf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02adf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates all the eigenvalues of Ax = \lambda Bx, where ") - (text . "A and B are real symmetric matrices of order n and B is positive-definite ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrices A and B, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "\newline First dimension of B, {\it ib}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 ib 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('"Continue", 'f02adfSolve) - htShowPage() - -f02adfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ib := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) --- objValUnwrap htpLabelSpadValue(htPage, 'ib) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02adfDefaultSolve(htPage,ia,ib,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) == - 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,n) for k in 1..ib] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - 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("F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02adfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02adfDefaultSolve (htPage,ia,ib,ifail) == - n := '4 - page := htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",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.5" a11 F)) - (bcStrings (6 "1.5" a12 F)) - (bcStrings (6 "6.6" a13 F)) - (bcStrings (6 "4.8" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" a21 F)) - (bcStrings (6 "6.5" a22 F)) - (bcStrings (6 "16.2" a23 F)) - (bcStrings (6 "8.6" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "6.6" a31 F)) - (bcStrings (6 "16.2" a32 F)) - (bcStrings (6 "37.6" a33 F)) - (bcStrings (6 "9.8" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.8" a41 F)) - (bcStrings (6 "8.6" a42 F)) - (bcStrings (6 "9.8" a43 F)) - (bcStrings (6 "-17.1" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 b11 F)) - (bcStrings (6 3 b12 F)) - (bcStrings (6 4 b13 F)) - (bcStrings (6 1 b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 3 b21 F)) - (bcStrings (6 13 b22 F)) - (bcStrings (6 16 b23 F)) - (bcStrings (6 11 b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 4 b31 F)) - (bcStrings (6 16 b32 F)) - (bcStrings (6 24 b33 F)) - (bcStrings (6 18 b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b41 F)) - (bcStrings (6 11 b42 F)) - (bcStrings (6 18 b43 F)) - (bcStrings (6 27 b44 F))) - htMakeDoneButton('"Continue",'f02adfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02adfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) --- ib := htpProperty(htPage,'ib) - ia := n - ib := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia 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..ib repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02adf(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02aef() == - htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02aef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aef| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates all the eigenvalues and eigenvectors of Ax = ") - (text . "\lambda Bx, where A and B are real symmetric matrices of order ") - (text . "n and B is positive-definite ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrices A and B, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "\newline First dimension of B, {\it ib}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 ib F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of V, {\it iv}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 iv 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", 'f02aefSolve) - htShowPage() - -f02aefSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ib := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) --- objValUnwrap htpLabelSpadValue(htPage, 'ib) - iv := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) --- objValUnwrap htpLabelSpadValue(htPage, 'iv) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02aefDefaultSolve(htPage,ia,ib,iv,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) == - 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,n) for k in 1..ib] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - 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("F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02aefGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02aefDefaultSolve (htPage,ia,ib,iv,ifail) == - n := '4 - page := htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",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.5" a11 F)) - (bcStrings (6 "1.5" a12 F)) - (bcStrings (6 "6.6" a13 F)) - (bcStrings (6 "4.8" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" a21 F)) - (bcStrings (6 "6.5" a22 F)) - (bcStrings (6 "16.2" a23 F)) - (bcStrings (6 "8.6" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "6.6" a31 F)) - (bcStrings (6 "16.2" a32 F)) - (bcStrings (6 "37.6" a33 F)) - (bcStrings (6 "9.8" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.8" a41 F)) - (bcStrings (6 "8.6" a42 F)) - (bcStrings (6 "9.8" a43 F)) - (bcStrings (6 "-17.1" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 b11 F)) - (bcStrings (6 3 b12 F)) - (bcStrings (6 4 b13 F)) - (bcStrings (6 1 b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 3 b21 F)) - (bcStrings (6 13 b22 F)) - (bcStrings (6 16 b23 F)) - (bcStrings (6 11 b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 4 b31 F)) - (bcStrings (6 16 b32 F)) - (bcStrings (6 24 b33 F)) - (bcStrings (6 18 b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b41 F)) - (bcStrings (6 11 b42 F)) - (bcStrings (6 18 b43 F)) - (bcStrings (6 27 b44 F))) - htMakeDoneButton('"Continue",'f02aefGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02aefGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) --- ib := htpProperty(htPage,'ib) --- iv := htpProperty(htPage,'iv) - ia := n - ib := n - iv := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia 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..ib repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02aef(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ") - prefix := STRCONC(prefix,matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - - -f02aff() == - htInitPage('"F02AFF - All eigenvalues of real matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02aff} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aff| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues of a real unsymmetric matrix ") - (text . "{\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia 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", 'f02affSolve) - htShowPage() - -f02affSolve 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 => f02affDefaultSolve(htPage,ia,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) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F02AFF - All eigenvalues of real matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02affGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02affDefaultSolve (htPage,ia,ifail) == - n := '4 - page := htInitPage('"F02AFF - All eigenvalues of real matrix (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 "1.5" a11 F)) - (bcStrings (6 "0.1" a12 F)) - (bcStrings (6 "4.5" a13 F)) - (bcStrings (6 "-1.5" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-22.5" a21 F)) - (bcStrings (6 "3.5" a22 F)) - (bcStrings (6 "12.5" a23 F)) - (bcStrings (6 "-2.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" a31 F)) - (bcStrings (6 "0.3" a32 F)) - (bcStrings (6 "4.5" a33 F)) - (bcStrings (6 "-2.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" a41 F)) - (bcStrings (6 "0.1" a42 F)) - (bcStrings (6 "4.5" a43 F)) - (bcStrings (6 "2.5" a44 F))) - htMakeDoneButton('"Continue",'f02affGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02affGen htPage == - n := htpProperty(htPage,'n) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) - ia := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02aff(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -f02agf() == - htInitPage('"F02AGF - All eigenvalues and eignevectors of real matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02agf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02agf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and eigenvectors of a real ") - (text . "unsymmetric matrix {\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of VR, {\it ivr} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 ivr PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of VI, {\it ivi} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ivi 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", 'f02agfSolve) - htShowPage() - -f02agfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ivr := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) --- objValUnwrap htpLabelSpadValue(htPage, 'ivr) - ivi := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) --- objValUnwrap htpLabelSpadValue(htPage, 'ivi) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02agfDefaultSolve(htPage,ia,ivr,ivi,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) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage("F02AGF - All eigenvalues and eigenvectors of real matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02agfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02agfDefaultSolve (htPage,ia,ivr,ivi,ifail) == - n := '4 - page := htInitPage('"F02AGF - All eigenvalues and eigenvectors of real matrix (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 "1.5" a11 F)) - (bcStrings (6 "0.1" a12 F)) - (bcStrings (6 "4.5" a13 F)) - (bcStrings (6 "-1.5" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-22.5" a21 F)) - (bcStrings (6 "3.5" a22 F)) - (bcStrings (6 "12.5" a23 F)) - (bcStrings (6 "-2.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" a31 F)) - (bcStrings (6 "0.3" a32 F)) - (bcStrings (6 "4.5" a33 F)) - (bcStrings (6 "-2.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" a41 F)) - (bcStrings (6 "0.1" a42 F)) - (bcStrings (6 "4.5" a43 F)) - (bcStrings (6 "2.5" a44 F))) - htMakeDoneButton('"Continue",'f02agfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02agfGen htPage == - n := htpProperty(htPage,'n) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) --- ivr := htpProperty(htPage,'ivr) --- ivi := htpProperty(htPage,'ivi) - ia := n - ivr := n - ivi := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02agf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ") - linkGen STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") - -f02ajf() == - htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02ajf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02ajf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates all the eigenvalues of a complex matrix {\it A} ") - (text . "of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing real parts, ") --- (text . " {\it iar}: \newline \tab{2} ") --- (bcStrings (6 4 iar PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing imaginary parts,") --- (text . " {\it iai}: \newline \tab{2} ") --- (bcStrings (6 4 iai 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('"Continue", 'f02ajfSolve) - htShowPage() - -f02ajfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - iar := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) --- objValUnwrap htpLabelSpadValue(htPage, 'iar) - iai := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) --- objValUnwrap htpLabelSpadValue(htPage, 'iai) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02ajfDefaultSolve(htPage,iar,iai,ifail) - matList := - "append"/[f(i,n) for i in 1..iar] 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,n) for k in 1..iai] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02AJF - All eigenvalues of complex matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02ajfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02ajfDefaultSolve (htPage,iar,iai,ifail) == - n := '4 - page := htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-21.0" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "13.6" a13 F)) - (bcStrings (6 "0.0" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "26.0" a22 F)) - (bcStrings (6 "7.5" a23 F)) - (bcStrings (6 "2.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.0" a31 F)) - (bcStrings (6 "1.68" a32 F)) - (bcStrings (6 "4.5" a33 F)) - (bcStrings (6 "1.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a41 F)) - (bcStrings (6 "-2.6" a42 F)) - (bcStrings (6 "-2.7" a43 F)) - (bcStrings (6 "2.5" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-5.0" b11 F)) - (bcStrings (6 "24.6" b12 F)) - (bcStrings (6 "10.2"b13 F)) - (bcStrings (6 "4.0" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "22.5" b21 F)) - (bcStrings (6 "-5.0" b22 F)) - (bcStrings (6 "-10.0" b23 F)) - (bcStrings (6 "0.0" b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" b31 F)) - (bcStrings (6 "2.24" b32 F)) - (bcStrings (6 "-5.0" b33 F)) - (bcStrings (6 "2.0" b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" b41 F)) - (bcStrings (6 "0.0" b42 F)) - (bcStrings (6 "3.6" b43 F)) - (bcStrings (6 "-5.0" b44 F))) - htMakeDoneButton('"Continue",'f02ajfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02ajfGen htPage == - n := htpProperty(htPage,'n) --- iar := htpProperty(htPage,'iar) --- iai := htpProperty(htPage,'iai) - iar := n - iai := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..iar 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..iai repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02ajf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ") - prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02akf() == - htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02akf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02akf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and eigenvectors of a complex ") - (text . "matrix {\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing real parts, ") --- (text . " {\it iar}: \newline \tab{2} ") --- (bcStrings (6 4 iar PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing imaginary parts,") --- (text . " {\it iai}: \newline \tab{2} ") --- (bcStrings (6 4 iai F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} \newline ") --- (text . "First dimension of array of real parts of the eigenvectors, ") --- (text . " {\it ivr}: \newline \tab{2} ") --- (bcStrings (6 4 ivr PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} \newline ") --- (text . "First dimension of array of imaginary parts of the eigenvectors,") --- (text . " {\it ivi}: \newline \tab{2} ") --- (bcStrings (6 4 ivi 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", 'f02akfSolve) - htShowPage() - -f02akfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - iar := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) --- objValUnwrap htpLabelSpadValue(htPage, 'iar) - iai := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) --- objValUnwrap htpLabelSpadValue(htPage, 'iai) - ivr := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) --- objValUnwrap htpLabelSpadValue(htPage, 'ivr) - ivi := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) --- objValUnwrap htpLabelSpadValue(htPage, 'ivi) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02akfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail) - matList := - "append"/[f(i,n) for i in 1..iar] 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,n) for k in 1..iai] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02akfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02akfDefaultSolve (htPage,iar,iai,ivr,ivi,ifail) == - n := '4 - page := htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-21.0" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "13.6" a13 F)) - (bcStrings (6 "0.0" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "26.0" a22 F)) - (bcStrings (6 "7.5" a23 F)) - (bcStrings (6 "2.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.0" a31 F)) - (bcStrings (6 "1.68" a32 F)) - (bcStrings (6 "4.5" a33 F)) - (bcStrings (6 "1.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a41 F)) - (bcStrings (6 "-2.6" a42 F)) - (bcStrings (6 "-2.7" a43 F)) - (bcStrings (6 "2.5" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-5.0" b11 F)) - (bcStrings (6 "24.6" b12 F)) - (bcStrings (6 "10.2"b13 F)) - (bcStrings (6 "4.0" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "22.5" b21 F)) - (bcStrings (6 "-5.0" b22 F)) - (bcStrings (6 "-10.0" b23 F)) - (bcStrings (6 "0.0" b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.5" b31 F)) - (bcStrings (6 "2.24" b32 F)) - (bcStrings (6 "-5.0" b33 F)) - (bcStrings (6 "2.0" b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.5" b41 F)) - (bcStrings (6 "0.0" b42 F)) - (bcStrings (6 "3.6" b43 F)) - (bcStrings (6 "-5.0" b44 F))) - htMakeDoneButton('"Continue",'f02akfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02akfGen htPage == - n := htpProperty(htPage,'n) --- iar := htpProperty(htPage,'iar) --- iai := htpProperty(htPage,'iai) --- ivr := htpProperty(htPage,'ivr) --- ivi := htpProperty(htPage,'ivi) - iar := n - iai := n - ivr := n - ivi := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..iar 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..iai repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02akf(",STRINGIMAGE iar,", ",STRINGIMAGE iai,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE ivr,", ") - prefix := STRCONC(prefix,STRINGIMAGE ivi,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02awf() == - htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02awf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02awf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\blankline ") - (text . "Calculates all the eigenvalues of a complex Hermitian matrix ") - (text . "{\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of the complex Hermitian matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing real parts, ") --- (text . " {\it iar}: \newline \tab{2} ") --- (bcStrings (6 4 iar PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing imaginary parts,") --- (text . " {\it iai}: \newline \tab{2} ") --- (bcStrings (6 4 iai 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('"Continue", 'f02awfSolve) - htShowPage() - -f02awfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - iar := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) --- objValUnwrap htpLabelSpadValue(htPage, 'iar) - iai := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) --- objValUnwrap htpLabelSpadValue(htPage, 'iai) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02awfDefaultSolve(htPage,iar,iai,ifail) - matList := - "append"/[f(i,n) for i in 1..iar] 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,n) for k in 1..iai] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values {\it AI}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it AR}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02awfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02awfDefaultSolve (htPage,iar,iai,ifail) == - n := '4 - page := htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter real values {\it AR}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "1.84" a13 F)) - (bcStrings (6 "2.08" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "1.12" a23 F)) - (bcStrings (6 "-0.56" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.84" a31 F)) - (bcStrings (6 "1.12" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.08" a41 F)) - (bcStrings (6 "-0.56" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter imaginary values {\it AI}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b11 F)) - (bcStrings (6 "0.0" b12 F)) - (bcStrings (6 "1.38" b13 F)) - (bcStrings (6 "-1.56" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b21 F)) - (bcStrings (6 "0.0" b22 F)) - (bcStrings (6 "0.84" b23 F)) - (bcStrings (6 "0.42" b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-1.38" b31 F)) - (bcStrings (6 "-0.84" b32 F)) - (bcStrings (6 "0.0" b33 F)) - (bcStrings (6 "0.0" b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.56" b41 F)) - (bcStrings (6 "-0.42" b42 F)) - (bcStrings (6 "0.0" b43 F)) - (bcStrings (6 "0.0" b44 F))) - htMakeDoneButton('"Continue",'f02awfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02awfGen htPage == - n := htpProperty(htPage,'n) --- iar := htpProperty(htPage,'iar) --- iai := htpProperty(htPage,'iai) - iar := n - iai := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..iar 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..iai repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02awf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ") - prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02axf() == - htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02axf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02axf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and eigenvectors of a complex ") - (text . "Hermitian matrix {\it A} of order {\it n}.") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing real parts, ") --- (text . " {\it iar}: \newline \tab{2} ") --- (bcStrings (6 4 iar PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of array containing imaginary parts,") --- (text . " {\it iai}: \newline \tab{2} ") --- (bcStrings (6 4 iai F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} \newline ") --- (text . "First dimension of array of real parts of the eigenvectors, ") --- (text . " {\it ivr}: \newline \tab{2} ") --- (bcStrings (6 4 ivr PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} \newline ") --- (text . "First dimension of array of imaginary parts of the eigenvectors,") --- (text . " {\it ivi}: \newline \tab{2} ") --- (bcStrings (6 4 ivi 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", 'f02axfSolve) - htShowPage() - -f02axfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - iar := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) --- objValUnwrap htpLabelSpadValue(htPage, 'iar) - iai := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) --- objValUnwrap htpLabelSpadValue(htPage, 'iai) - ivr := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) --- objValUnwrap htpLabelSpadValue(htPage, 'ivr) - ivi := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) --- objValUnwrap htpLabelSpadValue(htPage, 'ivi) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02axfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail) - matList := - "append"/[f(i,n) for i in 1..iar] 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,n) for k in 1..iai] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values of {\it A}:") - bmatList := [['text,:start],:bmatList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bmatList] - page := htInitPage("F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02axfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02axfDefaultSolve (htPage,iar,iai,ivr,ivi,ifail) == - n := '4 - page := htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "1.84" a13 F)) - (bcStrings (6 "2.08" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "1.12" a23 F)) - (bcStrings (6 "-0.56" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.84" a31 F)) - (bcStrings (6 "1.12" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.08" a41 F)) - (bcStrings (6 "-0.56" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b11 F)) - (bcStrings (6 "0.0" b12 F)) - (bcStrings (6 "1.38" b13 F)) - (bcStrings (6 "-1.56" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" b21 F)) - (bcStrings (6 "0.0" b22 F)) - (bcStrings (6 "0.84" b23 F)) - (bcStrings (6 "0.42" b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-1.38" b31 F)) - (bcStrings (6 "-0.84" b32 F)) - (bcStrings (6 "0.0" b33 F)) - (bcStrings (6 "0.0" b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.56" b41 F)) - (bcStrings (6 "-0.42" b42 F)) - (bcStrings (6 "0.0" b43 F)) - (bcStrings (6 "0.0" b44 F))) - htMakeDoneButton('"Continue",'f02axfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'iar,iar) --- htpSetProperty(page,'iai,iai) --- htpSetProperty(page,'ivr,ivr) --- htpSetProperty(page,'ivi,ivi) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02axfGen htPage == - n := htpProperty(htPage,'n) --- iar := htpProperty(htPage,'iar) --- iai := htpProperty(htPage,'iai) --- ivr := htpProperty(htPage,'ivr) --- ivi := htpProperty(htPage,'ivi) - iar := n - iai := n - ivr := n - ivi := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..iar 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..iai repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02axf(",matstring,", ",STRINGIMAGE iar,", ",bstring) - prefix := STRCONC(prefix,", ",STRINGIMAGE iai,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - -f02bbf() == - htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02bbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bbf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates selected eigenvalues and eigenvectors of a real ") - (text . "symmetric matrix {\it A} of order {\it n} by reduction to ") - (text . "tridiagonal form, bisection and inverse iteration, where the ") - (text . "selected eigenvalues lie within a given interval [{\it l,u}].") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrix A, {\it n}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Max number of eigenvectors, {\it m}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) - (text . "\tab{34} ") - (bcStrings (6 3 m PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Lower end-point of interval {\it l}: ") - (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "Upper end-point of interval {\it u}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.0" alb F)) - (text . "\tab{34} ") - (bcStrings (6 "3.0" ub F)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of V, {\it v} ") --- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 iv 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", 'f02bbfSolve) - htShowPage() - -f02bbfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - alb := htpLabelInputString(htPage,'alb) - ub := htpLabelInputString(htPage,'ub) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - iv := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) --- objValUnwrap htpLabelSpadValue(htPage, 'iv) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02bbfDefaultSolve(htPage,m,alb,ub,ia,iv,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) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList] - page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02bbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'alb,alb) - htpSetProperty(page,'ub,ub) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02bbfDefaultSolve (htPage,m,alb,ub,ia,iv,ifail) == - n := '4 - page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (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 "0.5" a11 F)) - (bcStrings (6 "0.0" a12 F)) - (bcStrings (6 "2.3" a13 F)) - (bcStrings (6 "-2.6" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "0.0" a21 F)) - (bcStrings (6 "0.5" a22 F)) - (bcStrings (6 "-1.4" a23 F)) - (bcStrings (6 "-0.7" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.3" a31 F)) - (bcStrings (6 "-1.4" a32 F)) - (bcStrings (6 "0.5" a33 F)) - (bcStrings (6 "0.0" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "-2.6" a41 F)) - (bcStrings (6 "-0.7" a42 F)) - (bcStrings (6 "0.0" a43 F)) - (bcStrings (6 "0.5" a44 F))) - htMakeDoneButton('"Continue",'f02bbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'alb,alb) - htpSetProperty(page,'ub,ub) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02bbfGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - alb := htpProperty(htPage,'alb) - ub := htpProperty(htPage,'ub) - -- ia should be = n, unlike the example program - -- where ia = nmax --- ia := htpProperty(htPage,'ia) --- iv := htpProperty(htPage,'iv) - ia := n - iv := n - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - prefix := STRCONC('"f02bbf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,alb,", ",ub,", ",STRINGIMAGE m,", ",STRINGIMAGE iv) - prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") - linkGen prefix - -f02bjf() == - htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02bjf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bjf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Calculates all the eigenvalues and, if required, all the ") - (text . "eigenvectors of Ax = \lambda Bx, where A and B are real ") - (text . "symmetric matrices of order n and B using the QZ algorithm. ") - (text . "The routine does not actually produce the eigenvalues ") - (text . "\inputbitmap{\htbmdir{}/lamdaj.bitmap}, but instead returns ") - (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap} and ") - (text . "\inputbitmap{\htbmdir{}/betaj.bitmap} ") - (text . "such that \inputbitmap{\htbmdir{}/lamdaj.bitmap} = ") - (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap} / ") - (text . "\inputbitmap{\htbmdir{}/betaj.bitmap}, ") - (text . "for j = 1,2,...,n. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline Order of matrices A and B, {\it n}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 4 n PI)) --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it ia}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "\newline First dimension of B, {\it ib}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 4 ia PI)) --- (text . "\tab{34} ") --- (bcStrings (6 4 ib F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of V, {\it iv}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") - (text . "\newline Tolerance, {\it eps}: ") - (text . "\newline \tab{2} ") --- (bcStrings (6 4 iv PI)) --- (text . "\tab{34} ") - (bcStrings (6 "1.0e-4" eps F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Are eigenvectors required: ") - (radioButtons matv - ("" " true" true) - ("" " false" false)) - (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", 'f02bjfSolve) - htShowPage() - -f02bjfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - ia := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) --- objValUnwrap htpLabelSpadValue(htPage, 'ia) - ib := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) --- objValUnwrap htpLabelSpadValue(htPage, 'ib) - iv := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) --- objValUnwrap htpLabelSpadValue(htPage, 'iv) - eps := htpLabelInputString(htPage,'eps) - bool := htpButtonValue(htPage,'matv) - matv := - bool = 'true => '"true" - '"false" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => f02bjfDefaultSolve(htPage,ia,ib,iv,eps,matv,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) == - 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,n) for k in 1..ib] where h(k,n) == - bList := - "append"/[l(k,p) for p in 1..n] where l(k,p) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) - [['bcStrings,[6, "0.0", bnam, 'F]]] - prefix := ('"\newline \tab{2} ") - bList := [['text,:prefix],:bList] - 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('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02bjfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'matv,matv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -f02bjfDefaultSolve (htPage,ia,ib,iv,eps,matv,ifail) == - n := '4 - page := htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (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 "3.9" a11 F)) - (bcStrings (6 "12.5" a12 F)) - (bcStrings (6 "-34.5" a13 F)) - (bcStrings (6 "-0.5" a14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.3" a21 F)) - (bcStrings (6 "21.5" a22 F)) - (bcStrings (6 "-47.5" a23 F)) - (bcStrings (6 "7.5" a24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.3" a31 F)) - (bcStrings (6 "21.5" a32 F)) - (bcStrings (6 "-43.5" a33 F)) - (bcStrings (6 "3.5" a34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "4.4" a41 F)) - (bcStrings (6 "26.0" a42 F)) - (bcStrings (6 "-46.0" a43 F)) - (bcStrings (6 "6.0" a44 F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 b11 F)) - (bcStrings (6 2 b12 F)) - (bcStrings (6 "-3" b13 F)) - (bcStrings (6 1 b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b21 F)) - (bcStrings (6 3 b22 F)) - (bcStrings (6 "-5" b23 F)) - (bcStrings (6 4b24 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b31 F)) - (bcStrings (6 3 b32 F)) - (bcStrings (6 -4 b33 F)) - (bcStrings (6 3 b34 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 1 b41 F)) - (bcStrings (6 3 b42 F)) - (bcStrings (6 -4 b43 F)) - (bcStrings (6 4 b44 F))) - htMakeDoneButton('"Continue",'f02bjfGen) - htpSetProperty(page,'n,n) --- htpSetProperty(page,'ia,ia) --- htpSetProperty(page,'ib,ib) --- htpSetProperty(page,'iv,iv) - htpSetProperty(page,'eps,eps) - htpSetProperty(page,'matv,matv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02bjfGen htPage == - n := htpProperty(htPage,'n) --- ia := htpProperty(htPage,'ia) --- ib := htpProperty(htPage,'ib) --- iv := htpProperty(htPage,'iv) - ia := n - ib := n - iv := n - eps := htpProperty(htPage,'eps) - matv := htpProperty(htPage,'matv) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..ia 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..ib repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02bjf(",STRINGIMAGE n,", ",STRINGIMAGE ia,", ") - prefix := STRCONC(prefix,STRINGIMAGE ib,", ",eps,", ",matv,", ") - prefix := STRCONC(prefix,STRINGIMAGE iv,", ",matstring,", ",bstring,", ") - prefix := STRCONC(prefix,STRINGIMAGE ifail,")") - linkGen prefix - - -f02fjf() == - htInitPage('"F02FJF - Selected eigenvalues and eigenvectors of sparse symmetric eigenproblem",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02fjf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02fjf| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Finds the {\it m} eigenvalues of largest absolute value and the ") - (text . "corresponding eigenvectors for the eigenvalue problem ") - (text . "{\it Cx = \htbitmap{lambda}x}, where {\it C} is a real matrix ") - (text . "of order {\it n} such that {\it BC = \htbitmap{ctb}} for a ") - (text . "given positive-definite matrix {\it B}. ") - (text . "\blankline ") - (text . "\newline ") - (text . "Read the input file to see the example program. ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "\spadcommand{)read f02fjf \bound{s0}} ")) - htShowPage() - - -f02wef() == - htInitPage('"F02WEF - SVD of real matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02wef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02wef| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns all or part of the singular value decomposition of a ") - (text . "real {\it m} by {\it n} matrix {\it A}.") - (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 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) - (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of B, {\it ldb}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldb PI)) --- (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Number of columns of matrix B, {\it ncolb}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 ncolb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Is the matrix {\it Q} required, {\it wantq}:") - (radioButtons wantq - (" " " true" qtrue) - (" " " false" qfalse)) - (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of {\it Q}, {\it ldq}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of {\it PT}, {\it ldpt}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 1 ldq PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldpt PI)) --- (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Is the matrix {\it PT} required, {\it wantp}:") - (radioButtons wantp - (" " " true" ptrue) - (" " " false" pfalse)) - (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", 'f02wefSolve) - htShowPage() - -f02wefSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - ncolb := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) - objValUnwrap htpLabelSpadValue(htPage, 'ncolb) - operation := htpButtonValue(htPage,'wantq) - wantq := - operation = 'qtrue => '"true" - '"false" - ldq := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq) --- objValUnwrap htpLabelSpadValue(htPage, 'ldq) - ldpt := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldpt) --- objValUnwrap htpLabelSpadValue(htPage, 'ldpt) - elements := htpButtonValue(htPage,'wantp) - wantp := - elements = 'ptrue => '"true" - '"false" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolb = '1) => - f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[10, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == - pre := ("\newline \tab{2} ") - labelList := - "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[6, "0.0", bnam, 'F]]] - labelList := [['text,:pre],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bList] - page := htInitPage('"F02WEF - SVD of real matrix",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02wefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) --- htpSetProperty(page,'lda,lda) --- htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'wantq,wantq) --- htpSetProperty(page,'ldq,ldq) --- htpSetProperty(page,'ldpt,ldpt) - htpSetProperty(page,'wantp,wantp) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail) == - n := '3 - m := '5 - ncolb := '1 - page := htInitPage('"F02WEF - SVD of real matrix",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 "2.0" a11 F)) - (bcStrings (6 "2.5" a12 F)) - (bcStrings (6 "2.5" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a21 F)) - (bcStrings (6 "2.5" a22 F)) - (bcStrings (6 "2.5" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.6" a31 F)) - (bcStrings (6 "-0.4" a32 F)) - (bcStrings (6 "2.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "2.0" a41 F)) - (bcStrings (6 "-0.5" a42 F)) - (bcStrings (6 "0.5" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (6 "1.2" a51 F)) - (bcStrings (6 "-0.3" a52 F)) - (bcStrings (6 "-2.9" a53 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 "1.1" b11 F)) - (bcStrings (6 "0.9" b12 F)) - (bcStrings (6 "0.6" b13 F)) - (bcStrings (6 "0.0" b14 F)) - (bcStrings (6 "-0.8" b15 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f02wefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'wantq,wantq) - htpSetProperty(page,'ldq,ldq) - htpSetProperty(page,'ldpt,ldpt) - htpSetProperty(page,'wantp,wantp) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02wefGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - lda := htpProperty(htPage,'lda) - ldb := htpProperty(htPage,'ldb) - ncolb := htpProperty(htPage,'ncolb) - wantq := htpProperty(htPage,'wantq) - ldq := htpProperty(htPage,'ldq) - ldpt := htpProperty(htPage,'ldpt) - wantp := htpProperty(htPage,'wantp) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..ldb repeat - for j in 1..ncolb repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02wef(",STRINGIMAGE m,",",STRINGIMAGE n,",") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldpt,", ",matstring,", ",bstring," ,") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - -f02xef() == - htInitPage('"F02XEF - SVD of complex matrix",nil) - htMakePage '( - (domainConditions - (isDomain F (Float)) - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXf02xef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02xef| '|NagEigenPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "Returns all or part of the singular value decomposition of a ") - (text . "complex {\it m} by {\it n} matrix {\it A}.") - (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 5 m PI)) - (text . "\tab{34} ") - (bcStrings (6 3 n PI)) - (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of A, {\it lda}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of B, {\it ldb}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 lda PI)) --- (text . "\tab{34} ") --- (bcStrings (6 5 ldb PI)) --- (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Number of columns of matrix B, {\it ncolb}: ") - (text . "\newline \tab{2} ") - (bcStrings (6 1 ncolb PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Is the matrix {\it Q} required, {\it wantq}:") - (radioButtons wantq - (" " " true" qtrue) - (" " " false" qfalse)) - (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{} \tab{2} ") --- (text . "\newline First dimension of {\it Q}, {\it ldq}: ") --- (text . "\tab{32} \menuitemstyle{} \tab{34} ") --- (text . "First dimension of {\it PH}, {\it ldph}: ") --- (text . "\newline \tab{2} ") --- (bcStrings (6 5 ldq PI)) --- (text . "\tab{34} ") --- (bcStrings (6 3 ldph PI)) --- (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{} \tab{2} ") - (text . "\newline \tab{2} ") - (text . "Is the matrix {\it PH} required, {\it wantp}:") - (radioButtons wantp - (" " " true" ptrue) - (" " " false" pfalse)) - (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", 'f02xefSolve) - htShowPage() - -f02xefSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - lda := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) --- objValUnwrap htpLabelSpadValue(htPage, 'lda) - ldb := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) --- objValUnwrap htpLabelSpadValue(htPage, 'ldb) - ncolb := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) - objValUnwrap htpLabelSpadValue(htPage, 'ncolb) - operation := htpButtonValue(htPage,'wantq) - wantq := - operation = 'qtrue => '"true" - '"false" - ldq := m --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq) --- objValUnwrap htpLabelSpadValue(htPage, 'ldq) - ldph := n --- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldph) --- objValUnwrap htpLabelSpadValue(htPage, 'ldph) - elements := htpButtonValue(htPage,'wantp) - wantp := - elements = 'ptrue => '"true" - '"false" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((m = '5 and n = '3) and ncolb = '1) => - f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail) - matList := - "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == - labelList := - "append"/[ga(i,j) for j in 1..n] where ga(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[15, "0.0", anam, 'F]]] - prefix := ('"\newline \tab{2} ") - labelList := [['text,:prefix],:labelList] - bList := - "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == - pre := ("\newline \tab{2} ") - labelList := - "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == - bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) - [['bcStrings,[15, "0.0", bnam, 'F]]] - labelList := [['text,:pre],:labelList] - prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") - bList := [['text,:prefix],:bList] - equationPart := [ - '(domainConditions - (isDomain P (Polynomial $EmptyMode)) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain PI (PositiveInteger))), - :matList,:bList] - page := htInitPage('"F02XEF - SVD of complex matrix",nil) - htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " - htSay '"\newline \tab{2} " - htMakePage equationPart - htSay '"\blankline " - htMakeDoneButton('"Continue",'f02xefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'wantq,wantq) - htpSetProperty(page,'ldq,ldq) - htpSetProperty(page,'ldph,ldph) - htpSetProperty(page,'wantp,wantp) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail) == - n := '3 - m := '5 - ncolb := '1 - page := htInitPage('"F02XEF - SVD of complex matrix",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 (15 "0.5*%i" a11 F)) - (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) - (bcStrings (15 "-1 + 1*%i" a13 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4 + 0.3*%i" a21 F)) - (bcStrings (15 "0.9 + 1.3*%i" a22 F)) - (bcStrings (15 "0.2 + 1.4*%i" a23 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.4" a31 F)) - (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) - (bcStrings (15 "1.8" a33 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.3 - 0.4*%i" a41 F)) - (bcStrings (15 "0.1 + 0.7*%i" a42 F)) - (bcStrings (15 "0.0" a43 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.3*%i" a51 F)) - (bcStrings (15 "0.3 + 0.3*%i" a52 F)) - (bcStrings (15 "2.4*%i" a53 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") - (text . "\newline \tab{2} ") - (bcStrings (15 "-0.55+1.05*%i" b11 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.49+0.93*%i" b12 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.56-0.16*%i" b13 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "0.39+0.23*%i" b14 F)) - (text . "\newline \tab{2} ") - (bcStrings (15 "1.13+0.83*%i" b15 F)) - (text . "\blankline ")) - htMakeDoneButton('"Continue",'f02xefGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'lda,lda) - htpSetProperty(page,'ldb,ldb) - htpSetProperty(page,'ncolb,ncolb) - htpSetProperty(page,'wantq,wantq) - htpSetProperty(page,'ldq,ldq) - htpSetProperty(page,'ldph,ldph) - htpSetProperty(page,'wantp,wantp) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -f02xefGen htPage == - n := htpProperty(htPage,'n) - m := htpProperty(htPage,'m) - lda := htpProperty(htPage,'lda) - ldb := htpProperty(htPage,'ldb) - ncolb := htpProperty(htPage,'ncolb) - wantq := htpProperty(htPage,'wantq) - ldq := htpProperty(htPage,'ldq) - ldph := htpProperty(htPage,'ldph) - wantp := htpProperty(htPage,'wantp) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - y := REVERSE y - for i in 1..lda repeat - for j in 1..n repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - matform := [:matform,rowList] - rowList := [] - matstring := bcwords2liststring [bcwords2liststring x for x in matform] - for i in 1..ldb repeat - for j in 1..ncolb repeat - elm := STRCONC((first y).1," ") - rowList := [:rowList,elm] - y := rest y - bform := [:bform,rowList] - rowList := [] - bstring := bcwords2liststring [bcwords2liststring x for x in bform] - prefix := STRCONC('"f02xef(",STRINGIMAGE m,",",STRINGIMAGE n,",") - prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ") - prefix := STRCONC(prefix,STRINGIMAGE ldph,", ",matstring,", ",bstring," ,") - linkGen STRCONC(prefix,STRINGIMAGE ifail,")") - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-f02.lisp.pamphlet b/src/interp/nag-f02.lisp.pamphlet new file mode 100644 index 0000000..42d9a3d --- /dev/null +++ b/src/interp/nag-f02.lisp.pamphlet @@ -0,0 +1,6907 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp nag-f02.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= +(IN-PACKAGE "BOOT" ) + +;f02aaf() == +; htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02aaf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aaf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Calculates all the eigenvalues of a real symmetric matrix ") +; (text . "{\it A} of order {\it n}.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrix A, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it ia} ") +;-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 ia 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", 'f02aafSolve) +; htShowPage() + +(DEFUN |f02aaf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02AAF - All eigenvalues of real symmetric matrix (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02aaf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aaf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Calculates all the eigenvalues of a real symmetric matrix ") + (|text| . "{\\it A} of order {\\it n}.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrix A, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02aafSolve|) + (|htShowPage|))) + +;f02aafSolve 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 => f02aafDefaultSolve(htPage,ia,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) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList] +; page := htInitPage("F02AAF - All eigenvalues of real symmetric matrix (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02aafGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02aafSolve,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 |f02aafSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166070) + (SPADLET G166070 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166070) + (SEQ (EXIT (SETQ G166070 + (APPEND G166070 + (|f02aafSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02aafSolve| (|htPage|) + (PROG (|n| |ia| |error| |ifail| |matList| |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) + (|f02aafDefaultSolve| |htPage| |ia| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166087) + (SPADLET G166087 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166087) + (SEQ (EXIT + (SETQ G166087 + (APPEND G166087 + (|f02aafSolve,f| |i| |n|))))))))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + |matList|)) + (SPADLET |page| + (|htInitPage| + '|F02AAF - All eigenvalues of real symmetric matrix (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") + '|f02aafGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02aafDefaultSolve (htPage,ia,ifail) == +; n := '4 +; page := htInitPage('"F02AAF - All eigenvalues of real symmetric matrix (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 "0.5" a11 F)) +; (bcStrings (6 "0.0" a12 F)) +; (bcStrings (6 "2.3" a13 F)) +; (bcStrings (6 "-2.6" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a21 F)) +; (bcStrings (6 "0.5" a22 F)) +; (bcStrings (6 "-1.4" a23 F)) +; (bcStrings (6 "-0.7" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "2.3" a31 F)) +; (bcStrings (6 "-1.4" a32 F)) +; (bcStrings (6 "0.5" a33 F)) +; (bcStrings (6 "0.0" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.6" a41 F)) +; (bcStrings (6 "-0.7" a42 F)) +; (bcStrings (6 "0.0" a43 F)) +; (bcStrings (6 "0.5" a44 F))) +; htMakeDoneButton('"Continue",'f02aafGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02aafDefaultSolve| (|htPage| |ia| |ifail|) + (declare (ignore |ia|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02AAF - All eigenvalues of real symmetric matrix (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 "0.5" |a11| F)) + (|bcStrings| (6 "0.0" |a12| F)) + (|bcStrings| (6 "2.3" |a13| F)) + (|bcStrings| (6 "-2.6" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a21| F)) + (|bcStrings| (6 "0.5" |a22| F)) + (|bcStrings| (6 "-1.4" |a23| F)) + (|bcStrings| (6 "-0.7" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "2.3" |a31| F)) + (|bcStrings| (6 "-1.4" |a32| F)) + (|bcStrings| (6 "0.5" |a33| F)) + (|bcStrings| (6 "0.0" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.6" |a41| F)) + (|bcStrings| (6 "-0.7" |a42| F)) + (|bcStrings| (6 "0.0" |a43| F)) + (|bcStrings| (6 "0.5" |a44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02aafGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02aafGen htPage == +; n := htpProperty(htPage,'n) +; -- ia should be = n, unlike the example program +; -- where ia = nmax +;-- ia := htpProperty(htPage,'ia) +; ia := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..ia repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; matform := [:matform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f02aaf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02aafGen| (|htPage|) + (PROG (|n| |ia| |ifail| |alist| |elm| |y| |matform| |rowList| + |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|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ia|) 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))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166140) + (SPADLET G166140 NIL) + (RETURN + (DO ((G166145 |matform| + (CDR G166145)) + (|x| NIL)) + ((OR (ATOM G166145) + (PROGN + (SETQ |x| (CAR G166145)) + NIL)) + (NREVERSE0 G166140)) + (SEQ (EXIT + (SETQ G166140 + (CONS (|bcwords2liststring| |x|) + G166140))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02aaf(") + (STRINGIMAGE |ia|) '|, | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |matstring| '|, | + (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02abf() == +; htInitPage('"F02ABF - All eigenvalues and eignevectors of real symmetric matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02abf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02abf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Calculates all the eigenvalues and eigenvectors of a real ") +; (text . "symmetric matrix ") +; (text . "{\it A} of order {\it n}.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrix A, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it ia} ") +;-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "First dimension of V, {\it v} ") +;-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 ia PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 4 v 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", 'f02abfSolve) +; htShowPage() + +(DEFUN |f02abf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02ABF - All eigenvalues and eignevectors of real symmetric matrix (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02abf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02abf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Calculates all the eigenvalues and eigenvectors of a real ") + (|text| . "symmetric matrix ") + (|text| . "{\\it A} of order {\\it n}.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrix A, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02abfSolve|) + (|htShowPage|))) + +;f02abfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; iv := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'v) +;-- objValUnwrap htpLabelSpadValue(htPage, 'v) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02abfDefaultSolve(htPage,ia,iv,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) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList] +; page := htInitPage("F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02abfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'iv,iv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02abfSolve,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 |f02abfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166182) + (SPADLET G166182 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166182) + (SEQ (EXIT (SETQ G166182 + (APPEND G166182 + (|f02abfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02abfSolve| (|htPage|) + (PROG (|n| |ia| |iv| |error| |ifail| |matList| |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 |iv| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02abfDefaultSolve| |htPage| |ia| |iv| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166199) + (SPADLET G166199 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166199) + (SEQ (EXIT + (SETQ G166199 + (APPEND G166199 + (|f02abfSolve,f| |i| |n|))))))))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + |matList|)) + (SPADLET |page| + (|htInitPage| + '|F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (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") + '|f02abfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02abfDefaultSolve (htPage,ia,iv,ifail) == +; n := '4 +; page := htInitPage('"F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (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 "0.5" a11 F)) +; (bcStrings (6 "0.0" a12 F)) +; (bcStrings (6 "2.3" a13 F)) +; (bcStrings (6 "-2.6" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a21 F)) +; (bcStrings (6 "0.5" a22 F)) +; (bcStrings (6 "-1.4" a23 F)) +; (bcStrings (6 "-0.7" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "2.3" a31 F)) +; (bcStrings (6 "-1.4" a32 F)) +; (bcStrings (6 "0.5" a33 F)) +; (bcStrings (6 "0.0" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.6" a41 F)) +; (bcStrings (6 "-0.7" a42 F)) +; (bcStrings (6 "0.0" a43 F)) +; (bcStrings (6 "0.5" a44 F))) +; htMakeDoneButton('"Continue",'f02abfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'iv,iv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02abfDefaultSolve| (|htPage| |ia| |iv| |ifail|) + (declare (ignore |ia| |iv|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02ABF - All eigenvalues and eigenvectors of real symmetric matrix (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 "0.5" |a11| F)) + (|bcStrings| (6 "0.0" |a12| F)) + (|bcStrings| (6 "2.3" |a13| F)) + (|bcStrings| (6 "-2.6" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a21| F)) + (|bcStrings| (6 "0.5" |a22| F)) + (|bcStrings| (6 "-1.4" |a23| F)) + (|bcStrings| (6 "-0.7" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "2.3" |a31| F)) + (|bcStrings| (6 "-1.4" |a32| F)) + (|bcStrings| (6 "0.5" |a33| F)) + (|bcStrings| (6 "0.0" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.6" |a41| F)) + (|bcStrings| (6 "-0.7" |a42| F)) + (|bcStrings| (6 "0.0" |a43| F)) + (|bcStrings| (6 "0.5" |a44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02abfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02abfGen htPage == +; n := htpProperty(htPage,'n) +; -- ia should be = n, unlike the example program +; -- where ia = nmax +;-- ia := htpProperty(htPage,'ia) +;-- iv := htpProperty(htPage,'iv) +; ia := n +; iv := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..ia repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; matform := [:matform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f02abf(",matstring,", ",STRINGIMAGE ia,", ") +; prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ") +; linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + +(DEFUN |f02abfGen| (|htPage|) + (PROG (|n| |ia| |iv| |ifail| |alist| |elm| |y| |matform| |rowList| + |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |ia| |n|) + (SPADLET |iv| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ia|) 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))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166253) + (SPADLET G166253 NIL) + (RETURN + (DO ((G166258 |matform| + (CDR G166258)) + (|x| NIL)) + ((OR (ATOM G166258) + (PROGN + (SETQ |x| (CAR G166258)) + NIL)) + (NREVERSE0 G166253)) + (SEQ (EXIT + (SETQ G166253 + (CONS (|bcwords2liststring| |x|) + G166253))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02abf(") |matstring| '|, | + (STRINGIMAGE |ia|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |iv|) '|, |)) + (|linkGen| (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|))))))) + +;f02adf() == +; htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02adf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02adf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\blankline ") +; (text . "Calculates all the eigenvalues of Ax = \lambda Bx, where ") +; (text . "A and B are real symmetric matrices of order n and B is positive-definite ") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrices A and B, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it ia}: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "\newline First dimension of B, {\it ib}: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 ia PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 4 ib 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('"Continue", 'f02adfSolve) +; htShowPage() + +(DEFUN |f02adf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \\lambda Bx where A and B are symmetric and B is positive definite") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02adf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02adf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\blankline ") + (|text| + . "Calculates all the eigenvalues of Ax = \\lambda Bx, where ") + (|text| + . "A and B are real symmetric matrices of order n and B is positive-definite ") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrices A and B, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02adfSolve|) + (|htShowPage|))) + +;f02adfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; ib := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ib) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02adfDefaultSolve(htPage,ia,ib,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) == +; 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,n) for k in 1..ib] where h(k,n) == +; bList := +; "append"/[l(k,p) for p in 1..n] where l(k,p) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; bList := [['text,:prefix],:bList] +; 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("F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02adfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ib,ib) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02adfSolve,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 |f02adfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166296) + (SPADLET G166296 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166296) + (SEQ (EXIT (SETQ G166296 + (APPEND G166296 + (|f02adfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02adfSolve,l| (|k| |p|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |k|) + (STRINGIMAGE |p|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02adfSolve,h| (|k| |n|) + (PROG (|prefix| |bList|) + (RETURN + (SEQ (SPADLET |bList| + (PROG (G166319) + (SPADLET G166319 NIL) + (RETURN + (DO ((|p| 1 (QSADD1 |p|))) + ((QSGREATERP |p| |n|) G166319) + (SEQ (EXIT (SETQ G166319 + (APPEND G166319 + (|f02adfSolve,l| |k| |p|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|))))))) + +(DEFUN |f02adfSolve| (|htPage|) + (PROG (|n| |ia| |ib| |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 |ib| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02adfDefaultSolve| |htPage| |ia| |ib| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166336) + (SPADLET G166336 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166336) + (SEQ (EXIT + (SETQ G166336 + (APPEND G166336 + (|f02adfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G166344) + (SPADLET G166344 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |ib|) G166344) + (SEQ (EXIT + (SETQ G166344 + (APPEND G166344 + (|f02adfSolve,h| |k| |n|))))))))) + (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| + '|F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \\lambda Bx where A and B are symmetric and B is positive definite| + 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") + '|f02adfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02adfDefaultSolve (htPage,ia,ib,ifail) == +; n := '4 +; page := htInitPage('"F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",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.5" a11 F)) +; (bcStrings (6 "1.5" a12 F)) +; (bcStrings (6 "6.6" a13 F)) +; (bcStrings (6 "4.8" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.5" a21 F)) +; (bcStrings (6 "6.5" a22 F)) +; (bcStrings (6 "16.2" a23 F)) +; (bcStrings (6 "8.6" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "6.6" a31 F)) +; (bcStrings (6 "16.2" a32 F)) +; (bcStrings (6 "37.6" a33 F)) +; (bcStrings (6 "9.8" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "4.8" a41 F)) +; (bcStrings (6 "8.6" a42 F)) +; (bcStrings (6 "9.8" a43 F)) +; (bcStrings (6 "-17.1" a44 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 b11 F)) +; (bcStrings (6 3 b12 F)) +; (bcStrings (6 4 b13 F)) +; (bcStrings (6 1 b14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 3 b21 F)) +; (bcStrings (6 13 b22 F)) +; (bcStrings (6 16 b23 F)) +; (bcStrings (6 11 b24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 b31 F)) +; (bcStrings (6 16 b32 F)) +; (bcStrings (6 24 b33 F)) +; (bcStrings (6 18 b34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 b41 F)) +; (bcStrings (6 11 b42 F)) +; (bcStrings (6 18 b43 F)) +; (bcStrings (6 27 b44 F))) +; htMakeDoneButton('"Continue",'f02adfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ib,ib) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02adfDefaultSolve| (|htPage| |ia| |ib| |ifail|) + (declare (ignore |ia| |ib|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02ADF - All eigenvalues of generalized real eigenproblem of the form Ax = \\lambda Bx where A and B are symmetric and B is positive definite") + 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.5" |a11| F)) + (|bcStrings| (6 "1.5" |a12| F)) + (|bcStrings| (6 "6.6" |a13| F)) + (|bcStrings| (6 "4.8" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.5" |a21| F)) + (|bcStrings| (6 "6.5" |a22| F)) + (|bcStrings| (6 "16.2" |a23| F)) + (|bcStrings| (6 "8.6" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "6.6" |a31| F)) + (|bcStrings| (6 "16.2" |a32| F)) + (|bcStrings| (6 "37.6" |a33| F)) + (|bcStrings| (6 "9.8" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "4.8" |a41| F)) + (|bcStrings| (6 "8.6" |a42| F)) + (|bcStrings| (6 "9.8" |a43| F)) + (|bcStrings| (6 "-17.1" |a44| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it B}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |b11| F)) (|bcStrings| (6 3 |b12| F)) + (|bcStrings| (6 4 |b13| F)) (|bcStrings| (6 1 |b14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 3 |b21| F)) (|bcStrings| (6 13 |b22| F)) + (|bcStrings| (6 16 |b23| F)) (|bcStrings| (6 11 |b24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 4 |b31| F)) (|bcStrings| (6 16 |b32| F)) + (|bcStrings| (6 24 |b33| F)) (|bcStrings| (6 18 |b34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |b41| F)) (|bcStrings| (6 11 |b42| F)) + (|bcStrings| (6 18 |b43| F)) + (|bcStrings| (6 27 |b44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02adfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02adfGen htPage == +; n := htpProperty(htPage,'n) +;-- ia := htpProperty(htPage,'ia) +;-- ib := htpProperty(htPage,'ib) +; ia := n +; ib := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..ia 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..ib repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; bform := [:bform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; bstring := bcwords2liststring [bcwords2liststring x for x in bform] +; prefix := STRCONC('"f02adf(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ") +; prefix := STRCONC(prefix,STRINGIMAGE n,", ",matstring,", ",bstring,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02adfGen| (|htPage|) + (PROG (|n| |ia| |ib| |ifail| |alist| |matform| |elm| |y| |bform| + |rowList| |matstring| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |ia| |n|) + (SPADLET |ib| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ia|) 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| |ib|) 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 |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166425) + (SPADLET G166425 NIL) + (RETURN + (DO ((G166430 |matform| + (CDR G166430)) + (|x| NIL)) + ((OR (ATOM G166430) + (PROGN + (SETQ |x| (CAR G166430)) + NIL)) + (NREVERSE0 G166425)) + (SEQ (EXIT + (SETQ G166425 + (CONS (|bcwords2liststring| |x|) + G166425))))))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G166440) + (SPADLET G166440 NIL) + (RETURN + (DO ((G166445 |bform| (CDR G166445)) + (|x| NIL)) + ((OR (ATOM G166445) + (PROGN + (SETQ |x| (CAR G166445)) + NIL)) + (NREVERSE0 G166440)) + (SEQ (EXIT + (SETQ G166440 + (CONS (|bcwords2liststring| |x|) + G166440))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02adf(") + (STRINGIMAGE |ia|) '|, | + (STRINGIMAGE |ib|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|, | + |matstring| '|, | |bstring| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02aef() == +; htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02aef} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aef| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\blankline ") +; (text . "Calculates all the eigenvalues and eigenvectors of Ax = ") +; (text . "\lambda Bx, where A and B are real symmetric matrices of order ") +; (text . "n and B is positive-definite ") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrices A and B, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it ia}: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "\newline First dimension of B, {\it ib}: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 ia PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 4 ib F)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of V, {\it iv}: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 iv 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", 'f02aefSolve) +; htShowPage() + +(DEFUN |f02aef| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \\lambda Bx where A and B are symmetric and B is positive definite") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02aef} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aef| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\blankline ") + (|text| + . "Calculates all the eigenvalues and eigenvectors of Ax = ") + (|text| + . "\\lambda Bx, where A and B are real symmetric matrices of order ") + (|text| . "n and B is positive-definite ") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrices A and B, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02aefSolve|) + (|htShowPage|))) + +;f02aefSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; ib := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ib) +; iv := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iv) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02aefDefaultSolve(htPage,ia,ib,iv,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) == +; 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,n) for k in 1..ib] where h(k,n) == +; bList := +; "append"/[l(k,p) for p in 1..n] where l(k,p) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; bList := [['text,:prefix],:bList] +; 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("F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02aefGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ib,ib) +;-- htpSetProperty(page,'iv,iv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02aefSolve,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 |f02aefSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166491) + (SPADLET G166491 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166491) + (SEQ (EXIT (SETQ G166491 + (APPEND G166491 + (|f02aefSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02aefSolve,l| (|k| |p|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |k|) + (STRINGIMAGE |p|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02aefSolve,h| (|k| |n|) + (PROG (|prefix| |bList|) + (RETURN + (SEQ (SPADLET |bList| + (PROG (G166514) + (SPADLET G166514 NIL) + (RETURN + (DO ((|p| 1 (QSADD1 |p|))) + ((QSGREATERP |p| |n|) G166514) + (SEQ (EXIT (SETQ G166514 + (APPEND G166514 + (|f02aefSolve,l| |k| |p|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|))))))) + +(DEFUN |f02aefSolve| (|htPage|) + (PROG (|n| |ia| |ib| |iv| |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 |ib| |n|) + (SPADLET |iv| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02aefDefaultSolve| |htPage| |ia| |ib| |iv| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166531) + (SPADLET G166531 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166531) + (SEQ (EXIT + (SETQ G166531 + (APPEND G166531 + (|f02aefSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G166539) + (SPADLET G166539 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |ib|) G166539) + (SEQ (EXIT + (SETQ G166539 + (APPEND G166539 + (|f02aefSolve,h| |k| |n|))))))))) + (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| + '|F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \\lambda Bx where A and B are symmetric and B is positive definite| + 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") + '|f02aefGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02aefDefaultSolve (htPage,ia,ib,iv,ifail) == +; n := '4 +; page := htInitPage('"F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \lambda Bx where A and B are symmetric and B is positive definite",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.5" a11 F)) +; (bcStrings (6 "1.5" a12 F)) +; (bcStrings (6 "6.6" a13 F)) +; (bcStrings (6 "4.8" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.5" a21 F)) +; (bcStrings (6 "6.5" a22 F)) +; (bcStrings (6 "16.2" a23 F)) +; (bcStrings (6 "8.6" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "6.6" a31 F)) +; (bcStrings (6 "16.2" a32 F)) +; (bcStrings (6 "37.6" a33 F)) +; (bcStrings (6 "9.8" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "4.8" a41 F)) +; (bcStrings (6 "8.6" a42 F)) +; (bcStrings (6 "9.8" a43 F)) +; (bcStrings (6 "-17.1" a44 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 b11 F)) +; (bcStrings (6 3 b12 F)) +; (bcStrings (6 4 b13 F)) +; (bcStrings (6 1 b14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 3 b21 F)) +; (bcStrings (6 13 b22 F)) +; (bcStrings (6 16 b23 F)) +; (bcStrings (6 11 b24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 b31 F)) +; (bcStrings (6 16 b32 F)) +; (bcStrings (6 24 b33 F)) +; (bcStrings (6 18 b34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 b41 F)) +; (bcStrings (6 11 b42 F)) +; (bcStrings (6 18 b43 F)) +; (bcStrings (6 27 b44 F))) +; htMakeDoneButton('"Continue",'f02aefGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ib,ib) +;-- htpSetProperty(page,'iv,iv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02aefDefaultSolve| (|htPage| |ia| |ib| |iv| |ifail|) + (declare (ignore |ia| |ib| |iv|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02AEF - All eigenvalues and eigenvectors of generalized real eigenproblem of the form Ax = \\lambda Bx where A and B are symmetric and B is positive definite") + 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.5" |a11| F)) + (|bcStrings| (6 "1.5" |a12| F)) + (|bcStrings| (6 "6.6" |a13| F)) + (|bcStrings| (6 "4.8" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.5" |a21| F)) + (|bcStrings| (6 "6.5" |a22| F)) + (|bcStrings| (6 "16.2" |a23| F)) + (|bcStrings| (6 "8.6" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "6.6" |a31| F)) + (|bcStrings| (6 "16.2" |a32| F)) + (|bcStrings| (6 "37.6" |a33| F)) + (|bcStrings| (6 "9.8" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "4.8" |a41| F)) + (|bcStrings| (6 "8.6" |a42| F)) + (|bcStrings| (6 "9.8" |a43| F)) + (|bcStrings| (6 "-17.1" |a44| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it B}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |b11| F)) (|bcStrings| (6 3 |b12| F)) + (|bcStrings| (6 4 |b13| F)) (|bcStrings| (6 1 |b14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 3 |b21| F)) (|bcStrings| (6 13 |b22| F)) + (|bcStrings| (6 16 |b23| F)) (|bcStrings| (6 11 |b24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 4 |b31| F)) (|bcStrings| (6 16 |b32| F)) + (|bcStrings| (6 24 |b33| F)) (|bcStrings| (6 18 |b34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |b41| F)) (|bcStrings| (6 11 |b42| F)) + (|bcStrings| (6 18 |b43| F)) + (|bcStrings| (6 27 |b44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02aefGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02aefGen htPage == +; n := htpProperty(htPage,'n) +;-- ia := htpProperty(htPage,'ia) +;-- ib := htpProperty(htPage,'ib) +;-- iv := htpProperty(htPage,'iv) +; ia := n +; ib := n +; iv := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..ia 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..ib repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; bform := [:bform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; bstring := bcwords2liststring [bcwords2liststring x for x in bform] +; prefix := STRCONC('"f02aef(",STRINGIMAGE ia,", ",STRINGIMAGE ib,", ") +; prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE iv,", ") +; prefix := STRCONC(prefix,matstring,", ",bstring,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02aefGen| (|htPage|) + (PROG (|n| |ia| |ib| |iv| |ifail| |alist| |matform| |elm| |y| |bform| + |rowList| |matstring| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |ia| |n|) + (SPADLET |ib| |n|) + (SPADLET |iv| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ia|) 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| |ib|) 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 |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166621) + (SPADLET G166621 NIL) + (RETURN + (DO ((G166626 |matform| + (CDR G166626)) + (|x| NIL)) + ((OR (ATOM G166626) + (PROGN + (SETQ |x| (CAR G166626)) + NIL)) + (NREVERSE0 G166621)) + (SEQ (EXIT + (SETQ G166621 + (CONS (|bcwords2liststring| |x|) + G166621))))))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G166636) + (SPADLET G166636 NIL) + (RETURN + (DO ((G166641 |bform| (CDR G166641)) + (|x| NIL)) + ((OR (ATOM G166641) + (PROGN + (SETQ |x| (CAR G166641)) + NIL)) + (NREVERSE0 G166636)) + (SEQ (EXIT + (SETQ G166636 + (CONS (|bcwords2liststring| |x|) + G166636))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02aef(") + (STRINGIMAGE |ia|) '|, | + (STRINGIMAGE |ib|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |iv|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |matstring| '|, | |bstring| + '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02aff() == +; htInitPage('"F02AFF - All eigenvalues of real matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02aff} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aff| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Calculates all the eigenvalues of a real unsymmetric matrix ") +; (text . "{\it A} of order {\it n}.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrix A, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it ia} ") +;-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 ia 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", 'f02affSolve) +; htShowPage() + +(DEFUN |f02aff| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02AFF - All eigenvalues of real matrix (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02aff} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02aff| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Calculates all the eigenvalues of a real unsymmetric matrix ") + (|text| . "{\\it A} of order {\\it n}.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrix A, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02affSolve|) + (|htShowPage|))) + +;f02affSolve 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 => f02affDefaultSolve(htPage,ia,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) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList] +; page := htInitPage("F02AFF - All eigenvalues of real matrix (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02affGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02affSolve,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 |f02affSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166689) + (SPADLET G166689 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166689) + (SEQ (EXIT (SETQ G166689 + (APPEND G166689 + (|f02affSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02affSolve| (|htPage|) + (PROG (|n| |ia| |error| |ifail| |matList| |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) + (|f02affDefaultSolve| |htPage| |ia| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166706) + (SPADLET G166706 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166706) + (SEQ (EXIT + (SETQ G166706 + (APPEND G166706 + (|f02affSolve,f| |i| |n|))))))))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + |matList|)) + (SPADLET |page| + (|htInitPage| + '|F02AFF - All eigenvalues of real matrix (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") + '|f02affGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02affDefaultSolve (htPage,ia,ifail) == +; n := '4 +; page := htInitPage('"F02AFF - All eigenvalues of real matrix (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 "1.5" a11 F)) +; (bcStrings (6 "0.1" a12 F)) +; (bcStrings (6 "4.5" a13 F)) +; (bcStrings (6 "-1.5" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-22.5" a21 F)) +; (bcStrings (6 "3.5" a22 F)) +; (bcStrings (6 "12.5" a23 F)) +; (bcStrings (6 "-2.5" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.5" a31 F)) +; (bcStrings (6 "0.3" a32 F)) +; (bcStrings (6 "4.5" a33 F)) +; (bcStrings (6 "-2.5" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.5" a41 F)) +; (bcStrings (6 "0.1" a42 F)) +; (bcStrings (6 "4.5" a43 F)) +; (bcStrings (6 "2.5" a44 F))) +; htMakeDoneButton('"Continue",'f02affGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02affDefaultSolve| (|htPage| |ia| |ifail|) + (declare (ignore |ia|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02AFF - All eigenvalues of real matrix (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 "1.5" |a11| F)) + (|bcStrings| (6 "0.1" |a12| F)) + (|bcStrings| (6 "4.5" |a13| F)) + (|bcStrings| (6 "-1.5" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-22.5" |a21| F)) + (|bcStrings| (6 "3.5" |a22| F)) + (|bcStrings| (6 "12.5" |a23| F)) + (|bcStrings| (6 "-2.5" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.5" |a31| F)) + (|bcStrings| (6 "0.3" |a32| F)) + (|bcStrings| (6 "4.5" |a33| F)) + (|bcStrings| (6 "-2.5" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.5" |a41| F)) + (|bcStrings| (6 "0.1" |a42| F)) + (|bcStrings| (6 "4.5" |a43| F)) + (|bcStrings| (6 "2.5" |a44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02affGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02affGen htPage == +; n := htpProperty(htPage,'n) +; -- ia should be = n, unlike the example program +; -- where ia = nmax +;-- ia := htpProperty(htPage,'ia) +; ia := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..ia repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; matform := [:matform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f02aff(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02affGen| (|htPage|) + (PROG (|n| |ia| |ifail| |alist| |elm| |y| |matform| |rowList| + |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|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ia|) 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))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166759) + (SPADLET G166759 NIL) + (RETURN + (DO ((G166764 |matform| + (CDR G166764)) + (|x| NIL)) + ((OR (ATOM G166764) + (PROGN + (SETQ |x| (CAR G166764)) + NIL)) + (NREVERSE0 G166759)) + (SEQ (EXIT + (SETQ G166759 + (CONS (|bcwords2liststring| |x|) + G166759))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02aff(") + (STRINGIMAGE |ia|) '|, | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |matstring| '|, | + (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02agf() == +; htInitPage('"F02AGF - All eigenvalues and eignevectors of real matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02agf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02agf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Calculates all the eigenvalues and eigenvectors of a real ") +; (text . "unsymmetric matrix {\it A} of order {\it n}.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrix A, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it ia} ") +;-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "First dimension of VR, {\it ivr} ") +;-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 ia PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 4 ivr PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of VI, {\it ivi} ") +;-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 ivi 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", 'f02agfSolve) +; htShowPage() + +(DEFUN |f02agf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02AGF - All eigenvalues and eignevectors of real matrix (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02agf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02agf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Calculates all the eigenvalues and eigenvectors of a real ") + (|text| . "unsymmetric matrix {\\it A} of order {\\it n}.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrix A, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02agfSolve|) + (|htShowPage|))) + +;f02agfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; ivr := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ivr) +; ivi := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ivi) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02agfDefaultSolve(htPage,ia,ivr,ivi,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) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList] +; page := htInitPage("F02AGF - All eigenvalues and eigenvectors of real matrix (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02agfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ivr,ivr) +;-- htpSetProperty(page,'ivi,ivi) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02agfSolve,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 |f02agfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166801) + (SPADLET G166801 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166801) + (SEQ (EXIT (SETQ G166801 + (APPEND G166801 + (|f02agfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02agfSolve| (|htPage|) + (PROG (|n| |ia| |ivr| |ivi| |error| |ifail| |matList| |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 |ivr| |n|) + (SPADLET |ivi| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02agfDefaultSolve| |htPage| |ia| |ivr| |ivi| + |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166818) + (SPADLET G166818 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G166818) + (SEQ (EXIT + (SETQ G166818 + (APPEND G166818 + (|f02agfSolve,f| |i| |n|))))))))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + |matList|)) + (SPADLET |page| + (|htInitPage| + '|F02AGF - All eigenvalues and eigenvectors of real matrix (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") + '|f02agfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02agfDefaultSolve (htPage,ia,ivr,ivi,ifail) == +; n := '4 +; page := htInitPage('"F02AGF - All eigenvalues and eigenvectors of real matrix (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 "1.5" a11 F)) +; (bcStrings (6 "0.1" a12 F)) +; (bcStrings (6 "4.5" a13 F)) +; (bcStrings (6 "-1.5" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-22.5" a21 F)) +; (bcStrings (6 "3.5" a22 F)) +; (bcStrings (6 "12.5" a23 F)) +; (bcStrings (6 "-2.5" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.5" a31 F)) +; (bcStrings (6 "0.3" a32 F)) +; (bcStrings (6 "4.5" a33 F)) +; (bcStrings (6 "-2.5" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.5" a41 F)) +; (bcStrings (6 "0.1" a42 F)) +; (bcStrings (6 "4.5" a43 F)) +; (bcStrings (6 "2.5" a44 F))) +; htMakeDoneButton('"Continue",'f02agfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ivr,ivr) +;-- htpSetProperty(page,'ivi,ivi) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02agfDefaultSolve| (|htPage| |ia| |ivr| |ivi| |ifail|) + (declare (ignore |ia| |ivr| |ivi|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02AGF - All eigenvalues and eigenvectors of real matrix (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 "1.5" |a11| F)) + (|bcStrings| (6 "0.1" |a12| F)) + (|bcStrings| (6 "4.5" |a13| F)) + (|bcStrings| (6 "-1.5" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-22.5" |a21| F)) + (|bcStrings| (6 "3.5" |a22| F)) + (|bcStrings| (6 "12.5" |a23| F)) + (|bcStrings| (6 "-2.5" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.5" |a31| F)) + (|bcStrings| (6 "0.3" |a32| F)) + (|bcStrings| (6 "4.5" |a33| F)) + (|bcStrings| (6 "-2.5" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.5" |a41| F)) + (|bcStrings| (6 "0.1" |a42| F)) + (|bcStrings| (6 "4.5" |a43| F)) + (|bcStrings| (6 "2.5" |a44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02agfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02agfGen htPage == +; n := htpProperty(htPage,'n) +; -- ia should be = n, unlike the example program +; -- where ia = nmax +;-- ia := htpProperty(htPage,'ia) +;-- ivr := htpProperty(htPage,'ivr) +;-- ivi := htpProperty(htPage,'ivi) +; ia := n +; ivr := n +; ivi := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..ia repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; matform := [:matform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f02agf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ") +; linkGen STRCONC(prefix,matstring,", ",STRINGIMAGE ifail,")") + +(DEFUN |f02agfGen| (|htPage|) + (PROG (|n| |ia| |ivr| |ivi| |ifail| |alist| |elm| |y| |matform| + |rowList| |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |ia| |n|) + (SPADLET |ivr| |n|) + (SPADLET |ivi| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ia|) 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))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G166873) + (SPADLET G166873 NIL) + (RETURN + (DO ((G166878 |matform| + (CDR G166878)) + (|x| NIL)) + ((OR (ATOM G166878) + (PROGN + (SETQ |x| (CAR G166878)) + NIL)) + (NREVERSE0 G166873)) + (SEQ (EXIT + (SETQ G166873 + (CONS (|bcwords2liststring| |x|) + G166873))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02agf(") + (STRINGIMAGE |ia|) '|, | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ivr|) '|, | + (STRINGIMAGE |ivi|) '|, |)) + (|linkGen| + (STRCONC |prefix| |matstring| '|, | + (STRINGIMAGE |ifail|) '|)|))))))) + +;f02ajf() == +; htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02ajf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02ajf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\blankline ") +; (text . "Calculates all the eigenvalues of a complex matrix {\it A} ") +; (text . "of order {\it n}.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrix A, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of array containing real parts, ") +;-- (text . " {\it iar}: \newline \tab{2} ") +;-- (bcStrings (6 4 iar PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of array containing imaginary parts,") +;-- (text . " {\it iai}: \newline \tab{2} ") +;-- (bcStrings (6 4 iai 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('"Continue", 'f02ajfSolve) +; htShowPage() + +(DEFUN |f02ajf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02AJF - All eigenvalues of complex matrix (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02ajf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02ajf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\blankline ") + (|text| + . "Calculates all the eigenvalues of a complex matrix {\\it A} ") + (|text| . "of order {\\it n}.") (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrix A, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02ajfSolve|) + (|htShowPage|))) + +;f02ajfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; iar := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iar) +; iai := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iai) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02ajfDefaultSolve(htPage,iar,iai,ifail) +; matList := +; "append"/[f(i,n) for i in 1..iar] 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,n) for k in 1..iai] where h(k,n) == +; bList := +; "append"/[l(k,p) for p in 1..n] where l(k,p) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; bList := [['text,:prefix],:bList] +; start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:") +; bmatList := [['text,:start],:bmatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList,:bmatList] +; page := htInitPage("F02AJF - All eigenvalues of complex matrix (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02ajfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'iar,iar) +;-- htpSetProperty(page,'iai,iai) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02ajfSolve,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 |f02ajfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166917) + (SPADLET G166917 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166917) + (SEQ (EXIT (SETQ G166917 + (APPEND G166917 + (|f02ajfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02ajfSolve,l| (|k| |p|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |k|) + (STRINGIMAGE |p|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02ajfSolve,h| (|k| |n|) + (PROG (|prefix| |bList|) + (RETURN + (SEQ (SPADLET |bList| + (PROG (G166940) + (SPADLET G166940 NIL) + (RETURN + (DO ((|p| 1 (QSADD1 |p|))) + ((QSGREATERP |p| |n|) G166940) + (SEQ (EXIT (SETQ G166940 + (APPEND G166940 + (|f02ajfSolve,l| |k| |p|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|))))))) + +(DEFUN |f02ajfSolve| (|htPage|) + (PROG (|n| |iar| |iai| |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 |iar| |n|) + (SPADLET |iai| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02ajfDefaultSolve| |htPage| |iar| |iai| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G166957) + (SPADLET G166957 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |iar|) G166957) + (SEQ (EXIT + (SETQ G166957 + (APPEND G166957 + (|f02ajfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G166965) + (SPADLET G166965 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |iai|) G166965) + (SEQ (EXIT + (SETQ G166965 + (APPEND G166965 + (|f02ajfSolve,h| |k| |n|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2}Enter imag values of {\\it A}:")) + (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| + '|F02AJF - All eigenvalues of complex matrix (Black box)| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter real values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f02ajfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02ajfDefaultSolve (htPage,iar,iai,ifail) == +; n := '4 +; page := htInitPage('"F02AJF - All eigenvalues of complex matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-21.0" a11 F)) +; (bcStrings (6 "0.0" a12 F)) +; (bcStrings (6 "13.6" a13 F)) +; (bcStrings (6 "0.0" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a21 F)) +; (bcStrings (6 "26.0" a22 F)) +; (bcStrings (6 "7.5" a23 F)) +; (bcStrings (6 "2.5" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.0" a31 F)) +; (bcStrings (6 "1.68" a32 F)) +; (bcStrings (6 "4.5" a33 F)) +; (bcStrings (6 "1.5" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a41 F)) +; (bcStrings (6 "-2.6" a42 F)) +; (bcStrings (6 "-2.7" a43 F)) +; (bcStrings (6 "2.5" a44 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-5.0" b11 F)) +; (bcStrings (6 "24.6" b12 F)) +; (bcStrings (6 "10.2"b13 F)) +; (bcStrings (6 "4.0" b14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "22.5" b21 F)) +; (bcStrings (6 "-5.0" b22 F)) +; (bcStrings (6 "-10.0" b23 F)) +; (bcStrings (6 "0.0" b24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.5" b31 F)) +; (bcStrings (6 "2.24" b32 F)) +; (bcStrings (6 "-5.0" b33 F)) +; (bcStrings (6 "2.0" b34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.5" b41 F)) +; (bcStrings (6 "0.0" b42 F)) +; (bcStrings (6 "3.6" b43 F)) +; (bcStrings (6 "-5.0" b44 F))) +; htMakeDoneButton('"Continue",'f02ajfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'iar,iar) +;-- htpSetProperty(page,'iai,iai) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02ajfDefaultSolve| (|htPage| |iar| |iai| |ifail|) + (declare (ignore |iar| |iai|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02AJF - All eigenvalues of complex matrix (Black box)") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter real values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-21.0" |a11| F)) + (|bcStrings| (6 "0.0" |a12| F)) + (|bcStrings| (6 "13.6" |a13| F)) + (|bcStrings| (6 "0.0" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a21| F)) + (|bcStrings| (6 "26.0" |a22| F)) + (|bcStrings| (6 "7.5" |a23| F)) + (|bcStrings| (6 "2.5" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.0" |a31| F)) + (|bcStrings| (6 "1.68" |a32| F)) + (|bcStrings| (6 "4.5" |a33| F)) + (|bcStrings| (6 "1.5" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a41| F)) + (|bcStrings| (6 "-2.6" |a42| F)) + (|bcStrings| (6 "-2.7" |a43| F)) + (|bcStrings| (6 "2.5" |a44| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter imaginary values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-5.0" |b11| F)) + (|bcStrings| (6 "24.6" |b12| F)) + (|bcStrings| (6 "10.2" |b13| F)) + (|bcStrings| (6 "4.0" |b14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "22.5" |b21| F)) + (|bcStrings| (6 "-5.0" |b22| F)) + (|bcStrings| (6 "-10.0" |b23| F)) + (|bcStrings| (6 "0.0" |b24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.5" |b31| F)) + (|bcStrings| (6 "2.24" |b32| F)) + (|bcStrings| (6 "-5.0" |b33| F)) + (|bcStrings| (6 "2.0" |b34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.5" |b41| F)) + (|bcStrings| (6 "0.0" |b42| F)) + (|bcStrings| (6 "3.6" |b43| F)) + (|bcStrings| (6 "-5.0" |b44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02ajfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02ajfGen htPage == +; n := htpProperty(htPage,'n) +;-- iar := htpProperty(htPage,'iar) +;-- iai := htpProperty(htPage,'iai) +; iar := n +; iai := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..iar 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..iai repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; bform := [:bform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; bstring := bcwords2liststring [bcwords2liststring x for x in bform] +; prefix := STRCONC('"f02ajf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ") +; prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02ajfGen| (|htPage|) + (PROG (|n| |iar| |iai| |ifail| |alist| |matform| |elm| |y| |bform| + |rowList| |matstring| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |iar| |n|) + (SPADLET |iai| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |iar|) 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| |iai|) 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 |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167046) + (SPADLET G167046 NIL) + (RETURN + (DO ((G167051 |matform| + (CDR G167051)) + (|x| NIL)) + ((OR (ATOM G167051) + (PROGN + (SETQ |x| (CAR G167051)) + NIL)) + (NREVERSE0 G167046)) + (SEQ (EXIT + (SETQ G167046 + (CONS (|bcwords2liststring| |x|) + G167046))))))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G167061) + (SPADLET G167061 NIL) + (RETURN + (DO ((G167066 |bform| (CDR G167066)) + (|x| NIL)) + ((OR (ATOM G167066) + (PROGN + (SETQ |x| (CAR G167066)) + NIL)) + (NREVERSE0 G167061)) + (SEQ (EXIT + (SETQ G167061 + (CONS (|bcwords2liststring| |x|) + G167061))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02ajf(") (STRINGIMAGE |n|) + '|, | (STRINGIMAGE |iar|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |iai|) '|, | + |matstring| '|, | |bstring| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02akf() == +; htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02akf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02akf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Calculates all the eigenvalues and eigenvectors of a complex ") +; (text . "matrix {\it A} of order {\it n}.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrix A, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of array containing real parts, ") +;-- (text . " {\it iar}: \newline \tab{2} ") +;-- (bcStrings (6 4 iar PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of array containing imaginary parts,") +;-- (text . " {\it iai}: \newline \tab{2} ") +;-- (bcStrings (6 4 iai F)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} \newline ") +;-- (text . "First dimension of array of real parts of the eigenvectors, ") +;-- (text . " {\it ivr}: \newline \tab{2} ") +;-- (bcStrings (6 4 ivr PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} \newline ") +;-- (text . "First dimension of array of imaginary parts of the eigenvectors,") +;-- (text . " {\it ivi}: \newline \tab{2} ") +;-- (bcStrings (6 4 ivi 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", 'f02akfSolve) +; htShowPage() + +(DEFUN |f02akf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02akf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02akf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Calculates all the eigenvalues and eigenvectors of a complex ") + (|text| . "matrix {\\it A} of order {\\it n}.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrix A, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02akfSolve|) + (|htShowPage|))) + +;f02akfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; iar := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iar) +; iai := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iai) +; ivr := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ivr) +; ivi := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ivi) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02akfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail) +; matList := +; "append"/[f(i,n) for i in 1..iar] 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,n) for k in 1..iai] where h(k,n) == +; bList := +; "append"/[l(k,p) for p in 1..n] where l(k,p) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; bList := [['text,:prefix],:bList] +; start := ('"\blankline \menuitemstyle{}\tab{2}Enter imag values of {\it A}:") +; bmatList := [['text,:start],:bmatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList,:bmatList] +; page := htInitPage("F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02akfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'iar,iar) +;-- htpSetProperty(page,'iai,iai) +;-- htpSetProperty(page,'ivr,ivr) +;-- htpSetProperty(page,'ivi,ivi) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02akfSolve,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 |f02akfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167112) + (SPADLET G167112 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167112) + (SEQ (EXIT (SETQ G167112 + (APPEND G167112 + (|f02akfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02akfSolve,l| (|k| |p|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |k|) + (STRINGIMAGE |p|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02akfSolve,h| (|k| |n|) + (PROG (|prefix| |bList|) + (RETURN + (SEQ (SPADLET |bList| + (PROG (G167135) + (SPADLET G167135 NIL) + (RETURN + (DO ((|p| 1 (QSADD1 |p|))) + ((QSGREATERP |p| |n|) G167135) + (SEQ (EXIT (SETQ G167135 + (APPEND G167135 + (|f02akfSolve,l| |k| |p|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|))))))) + +(DEFUN |f02akfSolve| (|htPage|) + (PROG (|n| |iar| |iai| |ivr| |ivi| |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 |iar| |n|) + (SPADLET |iai| |n|) + (SPADLET |ivr| |n|) + (SPADLET |ivi| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02akfDefaultSolve| |htPage| |iar| |iai| |ivr| |ivi| + |ifail|)) + ('T + (SPADLET |matList| + (PROG (G167152) + (SPADLET G167152 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |iar|) G167152) + (SEQ (EXIT + (SETQ G167152 + (APPEND G167152 + (|f02akfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G167160) + (SPADLET G167160 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |iai|) G167160) + (SEQ (EXIT + (SETQ G167160 + (APPEND G167160 + (|f02akfSolve,h| |k| |n|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2}Enter imag values of {\\it A}:")) + (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| + '|F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter real values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f02akfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02akfDefaultSolve (htPage,iar,iai,ivr,ivi,ifail) == +; n := '4 +; page := htInitPage('"F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-21.0" a11 F)) +; (bcStrings (6 "0.0" a12 F)) +; (bcStrings (6 "13.6" a13 F)) +; (bcStrings (6 "0.0" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a21 F)) +; (bcStrings (6 "26.0" a22 F)) +; (bcStrings (6 "7.5" a23 F)) +; (bcStrings (6 "2.5" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.0" a31 F)) +; (bcStrings (6 "1.68" a32 F)) +; (bcStrings (6 "4.5" a33 F)) +; (bcStrings (6 "1.5" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a41 F)) +; (bcStrings (6 "-2.6" a42 F)) +; (bcStrings (6 "-2.7" a43 F)) +; (bcStrings (6 "2.5" a44 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-5.0" b11 F)) +; (bcStrings (6 "24.6" b12 F)) +; (bcStrings (6 "10.2"b13 F)) +; (bcStrings (6 "4.0" b14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "22.5" b21 F)) +; (bcStrings (6 "-5.0" b22 F)) +; (bcStrings (6 "-10.0" b23 F)) +; (bcStrings (6 "0.0" b24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.5" b31 F)) +; (bcStrings (6 "2.24" b32 F)) +; (bcStrings (6 "-5.0" b33 F)) +; (bcStrings (6 "2.0" b34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.5" b41 F)) +; (bcStrings (6 "0.0" b42 F)) +; (bcStrings (6 "3.6" b43 F)) +; (bcStrings (6 "-5.0" b44 F))) +; htMakeDoneButton('"Continue",'f02akfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'iar,iar) +;-- htpSetProperty(page,'iai,iai) +;-- htpSetProperty(page,'ivr,ivr) +;-- htpSetProperty(page,'ivi,ivi) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02akfDefaultSolve| (|htPage| |iar| |iai| |ivr| |ivi| |ifail|) + (declare (ignore |iar| |iai| |ivr| |ivi|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02AKF - All eigenvalues and eigenvectors of complex matrix (Black box)") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter real values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-21.0" |a11| F)) + (|bcStrings| (6 "0.0" |a12| F)) + (|bcStrings| (6 "13.6" |a13| F)) + (|bcStrings| (6 "0.0" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a21| F)) + (|bcStrings| (6 "26.0" |a22| F)) + (|bcStrings| (6 "7.5" |a23| F)) + (|bcStrings| (6 "2.5" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.0" |a31| F)) + (|bcStrings| (6 "1.68" |a32| F)) + (|bcStrings| (6 "4.5" |a33| F)) + (|bcStrings| (6 "1.5" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a41| F)) + (|bcStrings| (6 "-2.6" |a42| F)) + (|bcStrings| (6 "-2.7" |a43| F)) + (|bcStrings| (6 "2.5" |a44| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter imaginary values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-5.0" |b11| F)) + (|bcStrings| (6 "24.6" |b12| F)) + (|bcStrings| (6 "10.2" |b13| F)) + (|bcStrings| (6 "4.0" |b14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "22.5" |b21| F)) + (|bcStrings| (6 "-5.0" |b22| F)) + (|bcStrings| (6 "-10.0" |b23| F)) + (|bcStrings| (6 "0.0" |b24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.5" |b31| F)) + (|bcStrings| (6 "2.24" |b32| F)) + (|bcStrings| (6 "-5.0" |b33| F)) + (|bcStrings| (6 "2.0" |b34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.5" |b41| F)) + (|bcStrings| (6 "0.0" |b42| F)) + (|bcStrings| (6 "3.6" |b43| F)) + (|bcStrings| (6 "-5.0" |b44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02akfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02akfGen htPage == +; n := htpProperty(htPage,'n) +;-- iar := htpProperty(htPage,'iar) +;-- iai := htpProperty(htPage,'iai) +;-- ivr := htpProperty(htPage,'ivr) +;-- ivi := htpProperty(htPage,'ivi) +; iar := n +; iai := n +; ivr := n +; ivi := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..iar 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..iai repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; bform := [:bform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; bstring := bcwords2liststring [bcwords2liststring x for x in bform] +; prefix := STRCONC('"f02akf(",STRINGIMAGE iar,", ",STRINGIMAGE iai,", ") +; prefix := STRCONC(prefix,STRINGIMAGE n,", ",STRINGIMAGE ivr,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ivi,", ",matstring,", ",bstring,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02akfGen| (|htPage|) + (PROG (|n| |iar| |iai| |ivr| |ivi| |ifail| |alist| |matform| |elm| + |y| |bform| |rowList| |matstring| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |iar| |n|) + (SPADLET |iai| |n|) + (SPADLET |ivr| |n|) + (SPADLET |ivi| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |iar|) 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| |iai|) 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 |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167243) + (SPADLET G167243 NIL) + (RETURN + (DO ((G167248 |matform| + (CDR G167248)) + (|x| NIL)) + ((OR (ATOM G167248) + (PROGN + (SETQ |x| (CAR G167248)) + NIL)) + (NREVERSE0 G167243)) + (SEQ (EXIT + (SETQ G167243 + (CONS (|bcwords2liststring| |x|) + G167243))))))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G167258) + (SPADLET G167258 NIL) + (RETURN + (DO ((G167263 |bform| (CDR G167263)) + (|x| NIL)) + ((OR (ATOM G167263) + (PROGN + (SETQ |x| (CAR G167263)) + NIL)) + (NREVERSE0 G167258)) + (SEQ (EXIT + (SETQ G167258 + (CONS (|bcwords2liststring| |x|) + G167258))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02akf(") + (STRINGIMAGE |iar|) '|, | + (STRINGIMAGE |iai|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |ivr|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ivi|) '|, | + |matstring| '|, | |bstring| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02awf() == +; htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02awf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02awf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\blankline ") +; (text . "Calculates all the eigenvalues of a complex Hermitian matrix ") +; (text . "{\it A} of order {\it n}.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of the complex Hermitian matrix A, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of array containing real parts, ") +;-- (text . " {\it iar}: \newline \tab{2} ") +;-- (bcStrings (6 4 iar PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of array containing imaginary parts,") +;-- (text . " {\it iai}: \newline \tab{2} ") +;-- (bcStrings (6 4 iai 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('"Continue", 'f02awfSolve) +; htShowPage() + +(DEFUN |f02awf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02AWF - All eigenvalues of complex Hermitian matrix (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02awf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02awf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\blankline ") + (|text| + . "Calculates all the eigenvalues of a complex Hermitian matrix ") + (|text| . "{\\it A} of order {\\it n}.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| + . "\\newline Order of the complex Hermitian matrix A, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02awfSolve|) + (|htShowPage|))) + +;f02awfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; iar := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iar) +; iai := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iai) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02awfDefaultSolve(htPage,iar,iai,ifail) +; matList := +; "append"/[f(i,n) for i in 1..iar] 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,n) for k in 1..iai] where h(k,n) == +; bList := +; "append"/[l(k,p) for p in 1..n] where l(k,p) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; bList := [['text,:prefix],:bList] +; start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values {\it AI}:") +; bmatList := [['text,:start],:bmatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList,:bmatList] +; page := htInitPage("F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it AR}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02awfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'iar,iar) +;-- htpSetProperty(page,'iai,iai) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02awfSolve,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 |f02awfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167312) + (SPADLET G167312 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167312) + (SEQ (EXIT (SETQ G167312 + (APPEND G167312 + (|f02awfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02awfSolve,l| (|k| |p|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |k|) + (STRINGIMAGE |p|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02awfSolve,h| (|k| |n|) + (PROG (|prefix| |bList|) + (RETURN + (SEQ (SPADLET |bList| + (PROG (G167335) + (SPADLET G167335 NIL) + (RETURN + (DO ((|p| 1 (QSADD1 |p|))) + ((QSGREATERP |p| |n|) G167335) + (SEQ (EXIT (SETQ G167335 + (APPEND G167335 + (|f02awfSolve,l| |k| |p|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|))))))) + +(DEFUN |f02awfSolve| (|htPage|) + (PROG (|n| |iar| |iai| |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 |iar| |n|) + (SPADLET |iai| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02awfDefaultSolve| |htPage| |iar| |iai| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G167352) + (SPADLET G167352 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |iar|) G167352) + (SEQ (EXIT + (SETQ G167352 + (APPEND G167352 + (|f02awfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G167360) + (SPADLET G167360 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |iai|) G167360) + (SEQ (EXIT + (SETQ G167360 + (APPEND G167360 + (|f02awfSolve,h| |k| |n|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2}Enter imaginary values {\\it AI}:")) + (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| + '|F02AWF - All eigenvalues of complex Hermitian matrix (Black box)| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter real values of {\\it AR}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f02awfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02awfDefaultSolve (htPage,iar,iai,ifail) == +; n := '4 +; page := htInitPage('"F02AWF - All eigenvalues of complex Hermitian matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter real values {\it AR}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.5" a11 F)) +; (bcStrings (6 "0.0" a12 F)) +; (bcStrings (6 "1.84" a13 F)) +; (bcStrings (6 "2.08" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a21 F)) +; (bcStrings (6 "0.5" a22 F)) +; (bcStrings (6 "1.12" a23 F)) +; (bcStrings (6 "-0.56" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.84" a31 F)) +; (bcStrings (6 "1.12" a32 F)) +; (bcStrings (6 "0.5" a33 F)) +; (bcStrings (6 "0.0" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "2.08" a41 F)) +; (bcStrings (6 "-0.56" a42 F)) +; (bcStrings (6 "0.0" a43 F)) +; (bcStrings (6 "0.5" a44 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter imaginary values {\it AI}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" b11 F)) +; (bcStrings (6 "0.0" b12 F)) +; (bcStrings (6 "1.38" b13 F)) +; (bcStrings (6 "-1.56" b14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" b21 F)) +; (bcStrings (6 "0.0" b22 F)) +; (bcStrings (6 "0.84" b23 F)) +; (bcStrings (6 "0.42" b24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-1.38" b31 F)) +; (bcStrings (6 "-0.84" b32 F)) +; (bcStrings (6 "0.0" b33 F)) +; (bcStrings (6 "0.0" b34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.56" b41 F)) +; (bcStrings (6 "-0.42" b42 F)) +; (bcStrings (6 "0.0" b43 F)) +; (bcStrings (6 "0.0" b44 F))) +; htMakeDoneButton('"Continue",'f02awfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'iar,iar) +;-- htpSetProperty(page,'iai,iai) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02awfDefaultSolve| (|htPage| |iar| |iai| |ifail|) + (declare (ignore |iar| |iai|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02AWF - All eigenvalues of complex Hermitian matrix (Black box)") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter real values {\\it AR}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.5" |a11| F)) + (|bcStrings| (6 "0.0" |a12| F)) + (|bcStrings| (6 "1.84" |a13| F)) + (|bcStrings| (6 "2.08" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a21| F)) + (|bcStrings| (6 "0.5" |a22| F)) + (|bcStrings| (6 "1.12" |a23| F)) + (|bcStrings| (6 "-0.56" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.84" |a31| F)) + (|bcStrings| (6 "1.12" |a32| F)) + (|bcStrings| (6 "0.5" |a33| F)) + (|bcStrings| (6 "0.0" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "2.08" |a41| F)) + (|bcStrings| (6 "-0.56" |a42| F)) + (|bcStrings| (6 "0.0" |a43| F)) + (|bcStrings| (6 "0.5" |a44| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter imaginary values {\\it AI}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |b11| F)) + (|bcStrings| (6 "0.0" |b12| F)) + (|bcStrings| (6 "1.38" |b13| F)) + (|bcStrings| (6 "-1.56" |b14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |b21| F)) + (|bcStrings| (6 "0.0" |b22| F)) + (|bcStrings| (6 "0.84" |b23| F)) + (|bcStrings| (6 "0.42" |b24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-1.38" |b31| F)) + (|bcStrings| (6 "-0.84" |b32| F)) + (|bcStrings| (6 "0.0" |b33| F)) + (|bcStrings| (6 "0.0" |b34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.56" |b41| F)) + (|bcStrings| (6 "-0.42" |b42| F)) + (|bcStrings| (6 "0.0" |b43| F)) + (|bcStrings| (6 "0.0" |b44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02awfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02awfGen htPage == +; n := htpProperty(htPage,'n) +;-- iar := htpProperty(htPage,'iar) +;-- iai := htpProperty(htPage,'iai) +; iar := n +; iai := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..iar 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..iai repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; bform := [:bform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; bstring := bcwords2liststring [bcwords2liststring x for x in bform] +; prefix := STRCONC('"f02awf(",STRINGIMAGE n,", ",STRINGIMAGE iar,", ") +; prefix := STRCONC(prefix,STRINGIMAGE iai,", ",matstring,", ",bstring,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02awfGen| (|htPage|) + (PROG (|n| |iar| |iai| |ifail| |alist| |matform| |elm| |y| |bform| + |rowList| |matstring| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |iar| |n|) + (SPADLET |iai| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |iar|) 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| |iai|) 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 |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167441) + (SPADLET G167441 NIL) + (RETURN + (DO ((G167446 |matform| + (CDR G167446)) + (|x| NIL)) + ((OR (ATOM G167446) + (PROGN + (SETQ |x| (CAR G167446)) + NIL)) + (NREVERSE0 G167441)) + (SEQ (EXIT + (SETQ G167441 + (CONS (|bcwords2liststring| |x|) + G167441))))))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G167456) + (SPADLET G167456 NIL) + (RETURN + (DO ((G167461 |bform| (CDR G167461)) + (|x| NIL)) + ((OR (ATOM G167461) + (PROGN + (SETQ |x| (CAR G167461)) + NIL)) + (NREVERSE0 G167456)) + (SEQ (EXIT + (SETQ G167456 + (CONS (|bcwords2liststring| |x|) + G167456))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02awf(") (STRINGIMAGE |n|) + '|, | (STRINGIMAGE |iar|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |iai|) '|, | + |matstring| '|, | |bstring| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02axf() == +; htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02axf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02axf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Calculates all the eigenvalues and eigenvectors of a complex ") +; (text . "Hermitian matrix {\it A} of order {\it n}.") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrix A, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of array containing real parts, ") +;-- (text . " {\it iar}: \newline \tab{2} ") +;-- (bcStrings (6 4 iar PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of array containing imaginary parts,") +;-- (text . " {\it iai}: \newline \tab{2} ") +;-- (bcStrings (6 4 iai F)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} \newline ") +;-- (text . "First dimension of array of real parts of the eigenvectors, ") +;-- (text . " {\it ivr}: \newline \tab{2} ") +;-- (bcStrings (6 4 ivr PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} \newline ") +;-- (text . "First dimension of array of imaginary parts of the eigenvectors,") +;-- (text . " {\it ivi}: \newline \tab{2} ") +;-- (bcStrings (6 4 ivi 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", 'f02axfSolve) +; htShowPage() + +(DEFUN |f02axf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02axf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02axf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Calculates all the eigenvalues and eigenvectors of a complex ") + (|text| . "Hermitian matrix {\\it A} of order {\\it n}.") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrix A, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |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") '|f02axfSolve|) + (|htShowPage|))) + +;f02axfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; iar := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iar) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iar) +; iai := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iai) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iai) +; ivr := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivr) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ivr) +; ivi := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ivi) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ivi) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02axfDefaultSolve(htPage,iar,iai,ivr,ivi,ifail) +; matList := +; "append"/[f(i,n) for i in 1..iar] 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,n) for k in 1..iai] where h(k,n) == +; bList := +; "append"/[l(k,p) for p in 1..n] where l(k,p) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; bList := [['text,:prefix],:bList] +; start := ('"\blankline \menuitemstyle{}\tab{2}Enter imaginary values of {\it A}:") +; bmatList := [['text,:start],:bmatList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList,:bmatList] +; page := htInitPage("F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter real values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02axfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'iar,iar) +;-- htpSetProperty(page,'iai,iai) +;-- htpSetProperty(page,'ivr,ivr) +;-- htpSetProperty(page,'ivi,ivi) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02axfSolve,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 |f02axfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167507) + (SPADLET G167507 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167507) + (SEQ (EXIT (SETQ G167507 + (APPEND G167507 + (|f02axfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02axfSolve,l| (|k| |p|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |k|) + (STRINGIMAGE |p|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02axfSolve,h| (|k| |n|) + (PROG (|prefix| |bList|) + (RETURN + (SEQ (SPADLET |bList| + (PROG (G167530) + (SPADLET G167530 NIL) + (RETURN + (DO ((|p| 1 (QSADD1 |p|))) + ((QSGREATERP |p| |n|) G167530) + (SEQ (EXIT (SETQ G167530 + (APPEND G167530 + (|f02axfSolve,l| |k| |p|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|))))))) + +(DEFUN |f02axfSolve| (|htPage|) + (PROG (|n| |iar| |iai| |ivr| |ivi| |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 |iar| |n|) + (SPADLET |iai| |n|) + (SPADLET |ivr| |n|) + (SPADLET |ivi| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02axfDefaultSolve| |htPage| |iar| |iai| |ivr| |ivi| + |ifail|)) + ('T + (SPADLET |matList| + (PROG (G167547) + (SPADLET G167547 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |iar|) G167547) + (SEQ (EXIT + (SETQ G167547 + (APPEND G167547 + (|f02axfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G167555) + (SPADLET G167555 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |iai|) G167555) + (SEQ (EXIT + (SETQ G167555 + (APPEND G167555 + (|f02axfSolve,h| |k| |n|))))))))) + (SPADLET |start| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2}Enter imaginary values of {\\it A}:")) + (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| + '|F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)| + NIL)) + (|htSay| (MAKESTRING + "\\newline \\menuitemstyle{}\\tab{2} Enter real values of {\\it A}: ")) + (|htSay| (MAKESTRING "\\newline \\tab{2} ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING "\\blankline ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|f02axfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02axfDefaultSolve (htPage,iar,iai,ivr,ivi,ifail) == +; n := '4 +; page := htInitPage('"F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter real values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.5" a11 F)) +; (bcStrings (6 "0.0" a12 F)) +; (bcStrings (6 "1.84" a13 F)) +; (bcStrings (6 "2.08" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a21 F)) +; (bcStrings (6 "0.5" a22 F)) +; (bcStrings (6 "1.12" a23 F)) +; (bcStrings (6 "-0.56" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.84" a31 F)) +; (bcStrings (6 "1.12" a32 F)) +; (bcStrings (6 "0.5" a33 F)) +; (bcStrings (6 "0.0" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "2.08" a41 F)) +; (bcStrings (6 "-0.56" a42 F)) +; (bcStrings (6 "0.0" a43 F)) +; (bcStrings (6 "0.5" a44 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter imaginary values of {\it A}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" b11 F)) +; (bcStrings (6 "0.0" b12 F)) +; (bcStrings (6 "1.38" b13 F)) +; (bcStrings (6 "-1.56" b14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" b21 F)) +; (bcStrings (6 "0.0" b22 F)) +; (bcStrings (6 "0.84" b23 F)) +; (bcStrings (6 "0.42" b24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-1.38" b31 F)) +; (bcStrings (6 "-0.84" b32 F)) +; (bcStrings (6 "0.0" b33 F)) +; (bcStrings (6 "0.0" b34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.56" b41 F)) +; (bcStrings (6 "-0.42" b42 F)) +; (bcStrings (6 "0.0" b43 F)) +; (bcStrings (6 "0.0" b44 F))) +; htMakeDoneButton('"Continue",'f02axfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'iar,iar) +;-- htpSetProperty(page,'iai,iai) +;-- htpSetProperty(page,'ivr,ivr) +;-- htpSetProperty(page,'ivi,ivi) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02axfDefaultSolve| (|htPage| |iar| |iai| |ivr| |ivi| |ifail|) + (declare (ignore |iar| |iai| |ivr| |ivi|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02AXF - All eigenvalues and eigenvectors of complex Hermitian matrix (Black box)") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter real values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.5" |a11| F)) + (|bcStrings| (6 "0.0" |a12| F)) + (|bcStrings| (6 "1.84" |a13| F)) + (|bcStrings| (6 "2.08" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a21| F)) + (|bcStrings| (6 "0.5" |a22| F)) + (|bcStrings| (6 "1.12" |a23| F)) + (|bcStrings| (6 "-0.56" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.84" |a31| F)) + (|bcStrings| (6 "1.12" |a32| F)) + (|bcStrings| (6 "0.5" |a33| F)) + (|bcStrings| (6 "0.0" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "2.08" |a41| F)) + (|bcStrings| (6 "-0.56" |a42| F)) + (|bcStrings| (6 "0.0" |a43| F)) + (|bcStrings| (6 "0.5" |a44| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter imaginary values of {\\it A}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |b11| F)) + (|bcStrings| (6 "0.0" |b12| F)) + (|bcStrings| (6 "1.38" |b13| F)) + (|bcStrings| (6 "-1.56" |b14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |b21| F)) + (|bcStrings| (6 "0.0" |b22| F)) + (|bcStrings| (6 "0.84" |b23| F)) + (|bcStrings| (6 "0.42" |b24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-1.38" |b31| F)) + (|bcStrings| (6 "-0.84" |b32| F)) + (|bcStrings| (6 "0.0" |b33| F)) + (|bcStrings| (6 "0.0" |b34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.56" |b41| F)) + (|bcStrings| (6 "-0.42" |b42| F)) + (|bcStrings| (6 "0.0" |b43| F)) + (|bcStrings| (6 "0.0" |b44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02axfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02axfGen htPage == +; n := htpProperty(htPage,'n) +;-- iar := htpProperty(htPage,'iar) +;-- iai := htpProperty(htPage,'iai) +;-- ivr := htpProperty(htPage,'ivr) +;-- ivi := htpProperty(htPage,'ivi) +; iar := n +; iai := n +; ivr := n +; ivi := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..iar 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..iai repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; bform := [:bform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; bstring := bcwords2liststring [bcwords2liststring x for x in bform] +; prefix := STRCONC('"f02axf(",matstring,", ",STRINGIMAGE iar,", ",bstring) +; prefix := STRCONC(prefix,", ",STRINGIMAGE iai,", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ivr,", ",STRINGIMAGE ivi,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02axfGen| (|htPage|) + (PROG (|n| |iar| |iai| |ivr| |ivi| |ifail| |alist| |matform| |elm| + |y| |bform| |rowList| |matstring| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |iar| |n|) + (SPADLET |iai| |n|) + (SPADLET |ivr| |n|) + (SPADLET |ivi| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |iar|) 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| |iai|) 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 |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167638) + (SPADLET G167638 NIL) + (RETURN + (DO ((G167643 |matform| + (CDR G167643)) + (|x| NIL)) + ((OR (ATOM G167643) + (PROGN + (SETQ |x| (CAR G167643)) + NIL)) + (NREVERSE0 G167638)) + (SEQ (EXIT + (SETQ G167638 + (CONS (|bcwords2liststring| |x|) + G167638))))))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G167653) + (SPADLET G167653 NIL) + (RETURN + (DO ((G167658 |bform| (CDR G167658)) + (|x| NIL)) + ((OR (ATOM G167658) + (PROGN + (SETQ |x| (CAR G167658)) + NIL)) + (NREVERSE0 G167653)) + (SEQ (EXIT + (SETQ G167653 + (CONS (|bcwords2liststring| |x|) + G167653))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02axf(") |matstring| '|, | + (STRINGIMAGE |iar|) '|, | |bstring|)) + (SPADLET |prefix| + (STRCONC |prefix| '|, | (STRINGIMAGE |iai|) '|, | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ivr|) '|, | + (STRINGIMAGE |ivi|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02bbf() == +; htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02bbf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bbf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Calculates selected eigenvalues and eigenvectors of a real ") +; (text . "symmetric matrix {\it A} of order {\it n} by reduction to ") +; (text . "tridiagonal form, bisection and inverse iteration, where the ") +; (text . "selected eigenvalues lie within a given interval [{\it l,u}].") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrix A, {\it n}: ") +; (text . "\tab{32} \menuitemstyle{} \tab{34} ") +; (text . "Max number of eigenvectors, {\it m}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +; (text . "\tab{34} ") +; (bcStrings (6 3 m PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Lower end-point of interval {\it l}: ") +; (text . "\tab{32} \menuitemstyle{} \tab{34} ") +; (text . "Upper end-point of interval {\it u}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.0" alb F)) +; (text . "\tab{34} ") +; (bcStrings (6 "3.0" ub F)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it ia} ") +;-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "First dimension of V, {\it v} ") +;-- (text . "\inputbitmap{\htbmdir{}/great=.bitmap} n: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 ia PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 4 iv 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", 'f02bbfSolve) +; htShowPage() + +(DEFUN |f02bbf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02bbf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bbf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Calculates selected eigenvalues and eigenvectors of a real ") + (|text| + . "symmetric matrix {\\it A} of order {\\it n} by reduction to ") + (|text| + . "tridiagonal form, bisection and inverse iteration, where the ") + (|text| + . "selected eigenvalues lie within a given interval [{\\it l,u}].") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrix A, {\\it n}: ") + (|text| . "\\tab{32} \\menuitemstyle{} \\tab{34} ") + (|text| . "Max number of eigenvectors, {\\it m}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |n| PI)) + (|text| . "\\tab{34} ") (|bcStrings| (6 3 |m| PI)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Lower end-point of interval {\\it l}: ") + (|text| . "\\tab{32} \\menuitemstyle{} \\tab{34} ") + (|text| . "Upper end-point of interval {\\it u}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.0" |alb| F)) (|text| . "\\tab{34} ") + (|bcStrings| (6 "3.0" |ub| 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") '|f02bbfSolve|) + (|htShowPage|))) + +;f02bbfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; alb := htpLabelInputString(htPage,'alb) +; ub := htpLabelInputString(htPage,'ub) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; iv := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iv) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02bbfDefaultSolve(htPage,m,alb,ub,ia,iv,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) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList] +; page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02bbfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'alb,alb) +; htpSetProperty(page,'ub,ub) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'iv,iv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02bbfSolve,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 |f02bbfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167708) + (SPADLET G167708 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167708) + (SEQ (EXIT (SETQ G167708 + (APPEND G167708 + (|f02bbfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02bbfSolve| (|htPage|) + (PROG (|n| |m| |alb| |ub| |ia| |iv| |error| |ifail| |matList| + |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 |alb| (|htpLabelInputString| |htPage| '|alb|)) + (SPADLET |ub| (|htpLabelInputString| |htPage| '|ub|)) + (SPADLET |ia| |n|) + (SPADLET |iv| |n|) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02bbfDefaultSolve| |htPage| |m| |alb| |ub| |ia| |iv| + |ifail|)) + ('T + (SPADLET |matList| + (PROG (G167725) + (SPADLET G167725 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G167725) + (SEQ (EXIT + (SETQ G167725 + (APPEND G167725 + (|f02bbfSolve,f| |i| |n|))))))))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| P + (|Polynomial| |$EmptyMode|)) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + |matList|)) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (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") + '|f02bbfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|alb| |alb|) + (|htpSetProperty| |page| '|ub| |ub|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02bbfDefaultSolve (htPage,m,alb,ub,ia,iv,ifail) == +; n := '4 +; page := htInitPage('"F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (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 "0.5" a11 F)) +; (bcStrings (6 "0.0" a12 F)) +; (bcStrings (6 "2.3" a13 F)) +; (bcStrings (6 "-2.6" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "0.0" a21 F)) +; (bcStrings (6 "0.5" a22 F)) +; (bcStrings (6 "-1.4" a23 F)) +; (bcStrings (6 "-0.7" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "2.3" a31 F)) +; (bcStrings (6 "-1.4" a32 F)) +; (bcStrings (6 "0.5" a33 F)) +; (bcStrings (6 "0.0" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "-2.6" a41 F)) +; (bcStrings (6 "-0.7" a42 F)) +; (bcStrings (6 "0.0" a43 F)) +; (bcStrings (6 "0.5" a44 F))) +; htMakeDoneButton('"Continue",'f02bbfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'alb,alb) +; htpSetProperty(page,'ub,ub) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'iv,iv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02bbfDefaultSolve| (|htPage| |m| |alb| |ub| |ia| |iv| |ifail|) + (declare (ignore |ia| |iv|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02BBF - Selected eigenvalues and eigenvectors of real symmetric matrix (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 "0.5" |a11| F)) + (|bcStrings| (6 "0.0" |a12| F)) + (|bcStrings| (6 "2.3" |a13| F)) + (|bcStrings| (6 "-2.6" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "0.0" |a21| F)) + (|bcStrings| (6 "0.5" |a22| F)) + (|bcStrings| (6 "-1.4" |a23| F)) + (|bcStrings| (6 "-0.7" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "2.3" |a31| F)) + (|bcStrings| (6 "-1.4" |a32| F)) + (|bcStrings| (6 "0.5" |a33| F)) + (|bcStrings| (6 "0.0" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "-2.6" |a41| F)) + (|bcStrings| (6 "-0.7" |a42| F)) + (|bcStrings| (6 "0.0" |a43| F)) + (|bcStrings| (6 "0.5" |a44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02bbfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|alb| |alb|) + (|htpSetProperty| |page| '|ub| |ub|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02bbfGen htPage == +; n := htpProperty(htPage,'n) +; m := htpProperty(htPage,'m) +; alb := htpProperty(htPage,'alb) +; ub := htpProperty(htPage,'ub) +; -- ia should be = n, unlike the example program +; -- where ia = nmax +;-- ia := htpProperty(htPage,'ia) +;-- iv := htpProperty(htPage,'iv) +; ia := n +; iv := n +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..ia repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; matform := [:matform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; prefix := STRCONC('"f02bbf(",STRINGIMAGE ia,", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,alb,", ",ub,", ",STRINGIMAGE m,", ",STRINGIMAGE iv) +; prefix := STRCONC(prefix,", ",matstring,", ",STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02bbfGen| (|htPage|) + (PROG (|n| |m| |alb| |ub| |ia| |iv| |ifail| |alist| |elm| |y| + |matform| |rowList| |matstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |alb| (|htpProperty| |htPage| '|alb|)) + (SPADLET |ub| (|htpProperty| |htPage| '|ub|)) + (SPADLET |ia| |n|) + (SPADLET |iv| |n|) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ia|) 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))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167782) + (SPADLET G167782 NIL) + (RETURN + (DO ((G167787 |matform| + (CDR G167787)) + (|x| NIL)) + ((OR (ATOM G167787) + (PROGN + (SETQ |x| (CAR G167787)) + NIL)) + (NREVERSE0 G167782)) + (SEQ (EXIT + (SETQ G167782 + (CONS (|bcwords2liststring| |x|) + G167782))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02bbf(") + (STRINGIMAGE |ia|) '|, | + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |alb| '|, | |ub| '|, | + (STRINGIMAGE |m|) '|, | + (STRINGIMAGE |iv|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | |matstring| '|, | + (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02bjf() == +; htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02bjf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bjf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Calculates all the eigenvalues and, if required, all the ") +; (text . "eigenvectors of Ax = \lambda Bx, where A and B are real ") +; (text . "symmetric matrices of order n and B using the QZ algorithm. ") +; (text . "The routine does not actually produce the eigenvalues ") +; (text . "\inputbitmap{\htbmdir{}/lamdaj.bitmap}, but instead returns ") +; (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap} and ") +; (text . "\inputbitmap{\htbmdir{}/betaj.bitmap} ") +; (text . "such that \inputbitmap{\htbmdir{}/lamdaj.bitmap} = ") +; (text . "\inputbitmap{\htbmdir{}/alphaj.bitmap} / ") +; (text . "\inputbitmap{\htbmdir{}/betaj.bitmap}, ") +; (text . "for j = 1,2,...,n. ") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline Order of matrices A and B, {\it n}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 4 n PI)) +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it ia}: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "\newline First dimension of B, {\it ib}: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 ia PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 4 ib F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of V, {\it iv}: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +; (text . "\newline Tolerance, {\it eps}: ") +; (text . "\newline \tab{2} ") +;-- (bcStrings (6 4 iv PI)) +;-- (text . "\tab{34} ") +; (bcStrings (6 "1.0e-4" eps F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "Are eigenvectors required: ") +; (radioButtons matv +; ("" " true" true) +; ("" " false" false)) +; (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", 'f02bjfSolve) +; htShowPage() + +(DEFUN |f02bjf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\\it QZ} algorithm, real matrices (Black box)") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02bjf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02bjf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Calculates all the eigenvalues and, if required, all the ") + (|text| + . "eigenvectors of Ax = \\lambda Bx, where A and B are real ") + (|text| + . "symmetric matrices of order n and B using the QZ algorithm. ") + (|text| + . "The routine does not actually produce the eigenvalues ") + (|text| + . "\\inputbitmap{\\htbmdir{}/lamdaj.bitmap}, but instead returns ") + (|text| . "\\inputbitmap{\\htbmdir{}/alphaj.bitmap} and ") + (|text| . "\\inputbitmap{\\htbmdir{}/betaj.bitmap} ") + (|text| + . "such that \\inputbitmap{\\htbmdir{}/lamdaj.bitmap} = ") + (|text| . "\\inputbitmap{\\htbmdir{}/alphaj.bitmap} / ") + (|text| . "\\inputbitmap{\\htbmdir{}/betaj.bitmap}, ") + (|text| . "for j = 1,2,...,n. ") (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Order of matrices A and B, {\\it n}: ") + (|text| . "\\newline \\tab{2} ") (|bcStrings| (6 4 |n| PI)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline Tolerance, {\\it eps}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.0e-4" |eps| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Are eigenvectors required: ") + (|radioButtons| |matv| ("" " true" |true|) + ("" " false" |false|)) + (|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") '|f02bjfSolve|) + (|htShowPage|))) + +;f02bjfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; ia := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ia) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ia) +; ib := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ib) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ib) +; iv := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iv) +;-- objValUnwrap htpLabelSpadValue(htPage, 'iv) +; eps := htpLabelInputString(htPage,'eps) +; bool := htpButtonValue(htPage,'matv) +; matv := +; bool = 'true => '"true" +; '"false" +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => f02bjfDefaultSolve(htPage,ia,ib,iv,eps,matv,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) == +; 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,n) for k in 1..ib] where h(k,n) == +; bList := +; "append"/[l(k,p) for p in 1..n] where l(k,p) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE k,STRINGIMAGE p) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; bList := [['text,:prefix],:bList] +; 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('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (Black box)",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02bjfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ib,ib) +;-- htpSetProperty(page,'iv,iv) +; htpSetProperty(page,'eps,eps) +; htpSetProperty(page,'matv,matv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02bjfSolve,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 |f02bjfSolve,f| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167830) + (SPADLET G167830 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167830) + (SEQ (EXIT (SETQ G167830 + (APPEND G167830 + (|f02bjfSolve,g| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02bjfSolve,l| (|k| |p|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |k|) + (STRINGIMAGE |p|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02bjfSolve,h| (|k| |n|) + (PROG (|prefix| |bList|) + (RETURN + (SEQ (SPADLET |bList| + (PROG (G167853) + (SPADLET G167853 NIL) + (RETURN + (DO ((|p| 1 (QSADD1 |p|))) + ((QSGREATERP |p| |n|) G167853) + (SEQ (EXIT (SETQ G167853 + (APPEND G167853 + (|f02bjfSolve,l| |k| |p|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |bList| + (CONS (CONS '|text| |prefix|) |bList|))))))) + +(DEFUN |f02bjfSolve| (|htPage|) + (PROG (|n| |ia| |ib| |iv| |eps| |bool| |matv| |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 |ib| |n|) + (SPADLET |iv| |n|) + (SPADLET |eps| (|htpLabelInputString| |htPage| '|eps|)) + (SPADLET |bool| (|htpButtonValue| |htPage| '|matv|)) + (SPADLET |matv| + (COND + ((BOOT-EQUAL |bool| '|true|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|f02bjfDefaultSolve| |htPage| |ia| |ib| |iv| |eps| + |matv| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G167870) + (SPADLET G167870 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ia|) G167870) + (SEQ (EXIT + (SETQ G167870 + (APPEND G167870 + (|f02bjfSolve,f| |i| |n|))))))))) + (SPADLET |bmatList| + (PROG (G167878) + (SPADLET G167878 NIL) + (RETURN + (DO ((|k| 1 (QSADD1 |k|))) + ((QSGREATERP |k| |ib|) G167878) + (SEQ (EXIT + (SETQ G167878 + (APPEND G167878 + (|f02bjfSolve,h| |k| |n|))))))))) + (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| + (MAKESTRING + "F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\\it QZ} algorithm, real matrices (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") + '|f02bjfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|eps| |eps|) + (|htpSetProperty| |page| '|matv| |matv|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02bjfDefaultSolve (htPage,ia,ib,iv,eps,matv,ifail) == +; n := '4 +; page := htInitPage('"F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\it QZ} algorithm, real matrices (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 "3.9" a11 F)) +; (bcStrings (6 "12.5" a12 F)) +; (bcStrings (6 "-34.5" a13 F)) +; (bcStrings (6 "-0.5" a14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "4.3" a21 F)) +; (bcStrings (6 "21.5" a22 F)) +; (bcStrings (6 "-47.5" a23 F)) +; (bcStrings (6 "7.5" a24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "4.3" a31 F)) +; (bcStrings (6 "21.5" a32 F)) +; (bcStrings (6 "-43.5" a33 F)) +; (bcStrings (6 "3.5" a34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "4.4" a41 F)) +; (bcStrings (6 "26.0" a42 F)) +; (bcStrings (6 "-46.0" a43 F)) +; (bcStrings (6 "6.0" a44 F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 b11 F)) +; (bcStrings (6 2 b12 F)) +; (bcStrings (6 "-3" b13 F)) +; (bcStrings (6 1 b14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 b21 F)) +; (bcStrings (6 3 b22 F)) +; (bcStrings (6 "-5" b23 F)) +; (bcStrings (6 4b24 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 b31 F)) +; (bcStrings (6 3 b32 F)) +; (bcStrings (6 -4 b33 F)) +; (bcStrings (6 3 b34 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 b41 F)) +; (bcStrings (6 3 b42 F)) +; (bcStrings (6 -4 b43 F)) +; (bcStrings (6 4 b44 F))) +; htMakeDoneButton('"Continue",'f02bjfGen) +; htpSetProperty(page,'n,n) +;-- htpSetProperty(page,'ia,ia) +;-- htpSetProperty(page,'ib,ib) +;-- htpSetProperty(page,'iv,iv) +; htpSetProperty(page,'eps,eps) +; htpSetProperty(page,'matv,matv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02bjfDefaultSolve| (|htPage| |ia| |ib| |iv| |eps| |matv| |ifail|) + (declare (ignore |ia| |ib| |iv|)) + (PROG (|n| |page|) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02BJF - All eigenvalues and optionally eigenvectors of generalized eigenproblem by {\\it QZ} algorithm, real matrices (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 "3.9" |a11| F)) + (|bcStrings| (6 "12.5" |a12| F)) + (|bcStrings| (6 "-34.5" |a13| F)) + (|bcStrings| (6 "-0.5" |a14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "4.3" |a21| F)) + (|bcStrings| (6 "21.5" |a22| F)) + (|bcStrings| (6 "-47.5" |a23| F)) + (|bcStrings| (6 "7.5" |a24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "4.3" |a31| F)) + (|bcStrings| (6 "21.5" |a32| F)) + (|bcStrings| (6 "-43.5" |a33| F)) + (|bcStrings| (6 "3.5" |a34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "4.4" |a41| F)) + (|bcStrings| (6 "26.0" |a42| F)) + (|bcStrings| (6 "-46.0" |a43| F)) + (|bcStrings| (6 "6.0" |a44| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it B}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |b11| F)) (|bcStrings| (6 2 |b12| F)) + (|bcStrings| (6 "-3" |b13| F)) + (|bcStrings| (6 1 |b14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |b21| F)) (|bcStrings| (6 3 |b22| F)) + (|bcStrings| (6 "-5" |b23| F)) + (|bcStrings| (6 4 |b24| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |b31| F)) (|bcStrings| (6 3 |b32| F)) + (|bcStrings| (6 -4 |b33| F)) (|bcStrings| (6 3 |b34| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |b41| F)) (|bcStrings| (6 3 |b42| F)) + (|bcStrings| (6 -4 |b43| F)) (|bcStrings| (6 4 |b44| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02bjfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|eps| |eps|) + (|htpSetProperty| |page| '|matv| |matv|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02bjfGen htPage == +; n := htpProperty(htPage,'n) +;-- ia := htpProperty(htPage,'ia) +;-- ib := htpProperty(htPage,'ib) +;-- iv := htpProperty(htPage,'iv) +; ia := n +; ib := n +; iv := n +; eps := htpProperty(htPage,'eps) +; matv := htpProperty(htPage,'matv) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..ia 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..ib repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; bform := [:bform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; bstring := bcwords2liststring [bcwords2liststring x for x in bform] +; prefix := STRCONC('"f02bjf(",STRINGIMAGE n,", ",STRINGIMAGE ia,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ib,", ",eps,", ",matv,", ") +; prefix := STRCONC(prefix,STRINGIMAGE iv,", ",matstring,", ",bstring,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ifail,")") +; linkGen prefix + +(DEFUN |f02bjfGen| (|htPage|) + (PROG (|n| |ia| |ib| |iv| |eps| |matv| |ifail| |alist| |matform| + |elm| |y| |bform| |rowList| |matstring| |bstring| + |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |ia| |n|) + (SPADLET |ib| |n|) + (SPADLET |iv| |n|) + (SPADLET |eps| (|htpProperty| |htPage| '|eps|)) + (SPADLET |matv| (|htpProperty| |htPage| '|matv|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ia|) 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| |ib|) 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 |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G167963) + (SPADLET G167963 NIL) + (RETURN + (DO ((G167968 |matform| + (CDR G167968)) + (|x| NIL)) + ((OR (ATOM G167968) + (PROGN + (SETQ |x| (CAR G167968)) + NIL)) + (NREVERSE0 G167963)) + (SEQ (EXIT + (SETQ G167963 + (CONS (|bcwords2liststring| |x|) + G167963))))))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G167978) + (SPADLET G167978 NIL) + (RETURN + (DO ((G167983 |bform| (CDR G167983)) + (|x| NIL)) + ((OR (ATOM G167983) + (PROGN + (SETQ |x| (CAR G167983)) + NIL)) + (NREVERSE0 G167978)) + (SEQ (EXIT + (SETQ G167978 + (CONS (|bcwords2liststring| |x|) + G167978))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02bjf(") (STRINGIMAGE |n|) + '|, | (STRINGIMAGE |ia|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ib|) '|, | |eps| + '|, | |matv| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |iv|) '|, | + |matstring| '|, | |bstring| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| |prefix|)))))) + +;f02fjf() == +; htInitPage('"F02FJF - Selected eigenvalues and eigenvectors of sparse symmetric eigenproblem",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02fjf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02fjf| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Finds the {\it m} eigenvalues of largest absolute value and the ") +; (text . "corresponding eigenvectors for the eigenvalue problem ") +; (text . "{\it Cx = \htbitmap{lambda}x}, where {\it C} is a real matrix ") +; (text . "of order {\it n} such that {\it BC = \htbitmap{ctb}} for a ") +; (text . "given positive-definite matrix {\it B}. ") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "Read the input file to see the example program. ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "\spadcommand{)read f02fjf \bound{s0}} ")) +; htShowPage() + +(DEFUN |f02fjf| () + (PROGN + (|htInitPage| + (MAKESTRING + "F02FJF - Selected eigenvalues and eigenvectors of sparse symmetric eigenproblem") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02fjf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02fjf| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Finds the {\\it m} eigenvalues of largest absolute value and the ") + (|text| + . "corresponding eigenvectors for the eigenvalue problem ") + (|text| + . "{\\it Cx = \\htbitmap{lambda}x}, where {\\it C} is a real matrix ") + (|text| + . "of order {\\it n} such that {\\it BC = \\htbitmap{ctb}} for a ") + (|text| . "given positive-definite matrix {\\it B}. ") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "Read the input file to see the example program. ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "\\spadcommand{)read f02fjf \\bound{s0}} "))) + (|htShowPage|))) + +;f02wef() == +; htInitPage('"F02WEF - SVD of real matrix",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02wef} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02wef| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Returns all or part of the singular value decomposition of a ") +; (text . "real {\it m} by {\it n} matrix {\it A}.") +; (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 5 m PI)) +; (text . "\tab{34} ") +; (bcStrings (6 3 n PI)) +; (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it lda}: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "First dimension of B, {\it ldb}: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 5 lda PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 5 ldb PI)) +;-- (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "Number of columns of matrix B, {\it ncolb}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 ncolb PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "Is the matrix {\it Q} required, {\it wantq}:") +; (radioButtons wantq +; (" " " true" qtrue) +; (" " " false" qfalse)) +; (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of {\it Q}, {\it ldq}: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "First dimension of {\it PT}, {\it ldpt}: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 1 ldq PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 5 ldpt PI)) +;-- (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "Is the matrix {\it PT} required, {\it wantp}:") +; (radioButtons wantp +; (" " " true" ptrue) +; (" " " false" pfalse)) +; (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", 'f02wefSolve) +; htShowPage() + +(DEFUN |f02wef| () + (PROGN + (|htInitPage| (MAKESTRING "F02WEF - SVD of real matrix") NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02wef} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02wef| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Returns all or part of the singular value decomposition of a ") + (|text| . "real {\\it m} by {\\it n} matrix {\\it A}.") + (|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 5 |m| PI)) (|text| . "\\tab{34} ") + (|bcStrings| (6 3 |n| PI)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Number of columns of matrix B, {\\it ncolb}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |ncolb| PI)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Is the matrix {\\it Q} required, {\\it wantq}:") + (|radioButtons| |wantq| (" " " true" |qtrue|) + (" " " false" |qfalse|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Is the matrix {\\it PT} required, {\\it wantp}:") + (|radioButtons| |wantp| (" " " true" |ptrue|) + (" " " false" |pfalse|)) + (|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") '|f02wefSolve|) + (|htShowPage|))) + +;f02wefSolve htPage == +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; lda := m +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +;-- objValUnwrap htpLabelSpadValue(htPage, 'lda) +; ldb := m +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) +; ncolb := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) +; objValUnwrap htpLabelSpadValue(htPage, 'ncolb) +; operation := htpButtonValue(htPage,'wantq) +; wantq := +; operation = 'qtrue => '"true" +; '"false" +; ldq := m +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ldq) +; ldpt := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldpt) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ldpt) +; elements := htpButtonValue(htPage,'wantp) +; wantp := +; elements = 'ptrue => '"true" +; '"false" +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; ((m = '5 and n = '3) and ncolb = '1) => +; f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail) +; matList := +; "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == +; labelList := +; "append"/[ga(i,j) for j in 1..n] where ga(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[10, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; bList := +; "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == +; pre := ("\newline \tab{2} ") +; labelList := +; "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[6, "0.0", bnam, 'F]]] +; labelList := [['text,:pre],:labelList] +; prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") +; bList := [['text,:prefix],:bList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList,:bList] +; page := htInitPage('"F02WEF - SVD of real matrix",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02wefGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +;-- htpSetProperty(page,'lda,lda) +;-- htpSetProperty(page,'ldb,ldb) +; htpSetProperty(page,'ncolb,ncolb) +; htpSetProperty(page,'wantq,wantq) +;-- htpSetProperty(page,'ldq,ldq) +;-- htpSetProperty(page,'ldpt,ldpt) +; htpSetProperty(page,'wantp,wantp) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02wefSolve,ga| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 10 + (CONS '|0.0| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02wefSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G168041) + (SPADLET G168041 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G168041) + (SEQ (EXIT (SETQ G168041 + (APPEND G168041 + (|f02wefSolve,ga| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02wefSolve,gb| (|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 |f02wefSolve,fb| (|i| |ncolb|) + (PROG (|pre| |labelList|) + (RETURN + (SEQ (SPADLET |pre| '|\\newline \\tab{2} |) + (SPADLET |labelList| + (PROG (G168064) + (SPADLET G168064 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolb|) G168064) + (SEQ (EXIT (SETQ G168064 + (APPEND G168064 + (|f02wefSolve,gb| |i| |j|))))))))) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |pre|) |labelList|))))))) + +(DEFUN |f02wefSolve| (|htPage|) + (PROG (|m| |n| |lda| |ldb| |ncolb| |operation| |wantq| |ldq| |ldpt| + |elements| |wantp| |error| |ifail| |matList| |prefix| + |bList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |m|) + (SPADLET |ldb| |m|) + (SPADLET |ncolb| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|ncolb|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|ncolb|))))) + (SPADLET |operation| (|htpButtonValue| |htPage| '|wantq|)) + (SPADLET |wantq| + (COND + ((BOOT-EQUAL |operation| '|qtrue|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |ldq| |m|) + (SPADLET |ldpt| |n|) + (SPADLET |elements| (|htpButtonValue| |htPage| '|wantp|)) + (SPADLET |wantp| + (COND + ((BOOT-EQUAL |elements| '|ptrue|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '5) (BOOT-EQUAL |n| '3) + (BOOT-EQUAL |ncolb| '1)) + (|f02wefDefaultSolve| |htPage| |lda| |ldb| |wantq| + |ldq| |ldpt| |wantp| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G168081) + (SPADLET G168081 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G168081) + (SEQ (EXIT + (SETQ G168081 + (APPEND G168081 + (|f02wefSolve,fa| |i| |n|))))))))) + (SPADLET |bList| + (PROG (G168089) + (SPADLET G168089 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ldb|) G168089) + (SEQ (EXIT + (SETQ G168089 + (APPEND G168089 + (|f02wefSolve,fb| |i| |ncolb|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter values of {\\it 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 |matList| |bList|))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING "F02WEF - SVD of real matrix") + 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") + '|f02wefGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|ncolb| |ncolb|) + (|htpSetProperty| |page| '|wantq| |wantq|) + (|htpSetProperty| |page| '|wantp| |wantp|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02wefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldpt,wantp,ifail) == +; n := '3 +; m := '5 +; ncolb := '1 +; page := htInitPage('"F02WEF - SVD of real matrix",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 "2.0" a11 F)) +; (bcStrings (6 "2.5" a12 F)) +; (bcStrings (6 "2.5" a13 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "2.0" a21 F)) +; (bcStrings (6 "2.5" a22 F)) +; (bcStrings (6 "2.5" a23 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.6" a31 F)) +; (bcStrings (6 "-0.4" a32 F)) +; (bcStrings (6 "2.8" a33 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "2.0" a41 F)) +; (bcStrings (6 "-0.5" a42 F)) +; (bcStrings (6 "0.5" a43 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.2" a51 F)) +; (bcStrings (6 "-0.3" a52 F)) +; (bcStrings (6 "-2.9" a53 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 "1.1" b11 F)) +; (bcStrings (6 "0.9" b12 F)) +; (bcStrings (6 "0.6" b13 F)) +; (bcStrings (6 "0.0" b14 F)) +; (bcStrings (6 "-0.8" b15 F)) +; (text . "\blankline ")) +; htMakeDoneButton('"Continue",'f02wefGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'lda,lda) +; htpSetProperty(page,'ldb,ldb) +; htpSetProperty(page,'ncolb,ncolb) +; htpSetProperty(page,'wantq,wantq) +; htpSetProperty(page,'ldq,ldq) +; htpSetProperty(page,'ldpt,ldpt) +; htpSetProperty(page,'wantp,wantp) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02wefDefaultSolve| + (|htPage| |lda| |ldb| |wantq| |ldq| |ldpt| |wantp| |ifail|) + (PROG (|n| |m| |ncolb| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '5) + (SPADLET |ncolb| '1) + (SPADLET |page| + (|htInitPage| + (MAKESTRING "F02WEF - SVD of real matrix") 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 "2.0" |a11| F)) + (|bcStrings| (6 "2.5" |a12| F)) + (|bcStrings| (6 "2.5" |a13| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "2.0" |a21| F)) + (|bcStrings| (6 "2.5" |a22| F)) + (|bcStrings| (6 "2.5" |a23| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.6" |a31| F)) + (|bcStrings| (6 "-0.4" |a32| F)) + (|bcStrings| (6 "2.8" |a33| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "2.0" |a41| F)) + (|bcStrings| (6 "-0.5" |a42| F)) + (|bcStrings| (6 "0.5" |a43| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.2" |a51| F)) + (|bcStrings| (6 "-0.3" |a52| F)) + (|bcStrings| (6 "-2.9" |a53| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it B}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 "1.1" |b11| F)) + (|bcStrings| (6 "0.9" |b12| F)) + (|bcStrings| (6 "0.6" |b13| F)) + (|bcStrings| (6 "0.0" |b14| F)) + (|bcStrings| (6 "-0.8" |b15| F)) + (|text| . "\\blankline "))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02wefGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|lda| |lda|) + (|htpSetProperty| |page| '|ldb| |ldb|) + (|htpSetProperty| |page| '|ncolb| |ncolb|) + (|htpSetProperty| |page| '|wantq| |wantq|) + (|htpSetProperty| |page| '|ldq| |ldq|) + (|htpSetProperty| |page| '|ldpt| |ldpt|) + (|htpSetProperty| |page| '|wantp| |wantp|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02wefGen htPage == +; n := htpProperty(htPage,'n) +; m := htpProperty(htPage,'m) +; lda := htpProperty(htPage,'lda) +; ldb := htpProperty(htPage,'ldb) +; ncolb := htpProperty(htPage,'ncolb) +; wantq := htpProperty(htPage,'wantq) +; ldq := htpProperty(htPage,'ldq) +; ldpt := htpProperty(htPage,'ldpt) +; wantp := htpProperty(htPage,'wantp) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..lda repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; matform := [:matform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; for i in 1..ldb repeat +; for j in 1..ncolb repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; bform := [:bform,rowList] +; rowList := [] +; bstring := bcwords2liststring [bcwords2liststring x for x in bform] +; prefix := STRCONC('"f02wef(",STRINGIMAGE m,",",STRINGIMAGE n,",") +; prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ldpt,", ",matstring,", ",bstring," ,") +; linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + +(DEFUN |f02wefGen| (|htPage|) + (PROG (|n| |m| |lda| |ldb| |ncolb| |wantq| |ldq| |ldpt| |wantp| + |ifail| |alist| |matform| |matstring| |elm| |y| |bform| + |rowList| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |lda| (|htpProperty| |htPage| '|lda|)) + (SPADLET |ldb| (|htpProperty| |htPage| '|ldb|)) + (SPADLET |ncolb| (|htpProperty| |htPage| '|ncolb|)) + (SPADLET |wantq| (|htpProperty| |htPage| '|wantq|)) + (SPADLET |ldq| (|htpProperty| |htPage| '|ldq|)) + (SPADLET |ldpt| (|htpProperty| |htPage| '|ldpt|)) + (SPADLET |wantp| (|htpProperty| |htPage| '|wantp|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |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))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G168159) + (SPADLET G168159 NIL) + (RETURN + (DO ((G168164 |matform| + (CDR G168164)) + (|x| NIL)) + ((OR (ATOM G168164) + (PROGN + (SETQ |x| (CAR G168164)) + NIL)) + (NREVERSE0 G168159)) + (SEQ (EXIT + (SETQ G168159 + (CONS (|bcwords2liststring| |x|) + G168159))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ldb|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolb|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G168195) + (SPADLET G168195 NIL) + (RETURN + (DO ((G168200 |bform| (CDR G168200)) + (|x| NIL)) + ((OR (ATOM G168200) + (PROGN + (SETQ |x| (CAR G168200)) + NIL)) + (NREVERSE0 G168195)) + (SEQ (EXIT + (SETQ G168195 + (CONS (|bcwords2liststring| |x|) + G168195))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02wef(") (STRINGIMAGE |m|) + '|,| (STRINGIMAGE |n|) '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lda|) '|, | + (STRINGIMAGE |ncolb|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ldb|) '|, | + |wantq| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ldq|) '|, | + |wantp| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ldpt|) '|, | + |matstring| '|, | |bstring| '| ,|)) + (|linkGen| (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|))))))) + +;f02xef() == +; htInitPage('"F02XEF - SVD of complex matrix",nil) +; htMakePage '( +; (domainConditions +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXf02xef} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02xef| '|NagEigenPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "Returns all or part of the singular value decomposition of a ") +; (text . "complex {\it m} by {\it n} matrix {\it A}.") +; (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 5 m PI)) +; (text . "\tab{34} ") +; (bcStrings (6 3 n PI)) +; (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of A, {\it lda}: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "First dimension of B, {\it ldb}: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 5 lda PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 5 ldb PI)) +;-- (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "Number of columns of matrix B, {\it ncolb}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (6 1 ncolb PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "Is the matrix {\it Q} required, {\it wantq}:") +; (radioButtons wantq +; (" " " true" qtrue) +; (" " " false" qfalse)) +; (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{} \tab{2} ") +;-- (text . "\newline First dimension of {\it Q}, {\it ldq}: ") +;-- (text . "\tab{32} \menuitemstyle{} \tab{34} ") +;-- (text . "First dimension of {\it PH}, {\it ldph}: ") +;-- (text . "\newline \tab{2} ") +;-- (bcStrings (6 5 ldq PI)) +;-- (text . "\tab{34} ") +;-- (bcStrings (6 3 ldph PI)) +;-- (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{} \tab{2} ") +; (text . "\newline \tab{2} ") +; (text . "Is the matrix {\it PH} required, {\it wantp}:") +; (radioButtons wantp +; (" " " true" ptrue) +; (" " " false" pfalse)) +; (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", 'f02xefSolve) +; htShowPage() + +(DEFUN |f02xef| () + (PROGN + (|htInitPage| (MAKESTRING "F02XEF - SVD of complex matrix") NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| F (|Float|)) + (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXf02xef} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|f02xef| '|NagEigenPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "Returns all or part of the singular value decomposition of a ") + (|text| . "complex {\\it m} by {\\it n} matrix {\\it A}.") + (|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 5 |m| PI)) (|text| . "\\tab{34} ") + (|bcStrings| (6 3 |n| PI)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Number of columns of matrix B, {\\it ncolb}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (6 1 |ncolb| PI)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Is the matrix {\\it Q} required, {\\it wantq}:") + (|radioButtons| |wantq| (" " " true" |qtrue|) + (" " " false" |qfalse|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{} \\tab{2} ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Is the matrix {\\it PH} required, {\\it wantp}:") + (|radioButtons| |wantp| (" " " true" |ptrue|) + (" " " false" |pfalse|)) + (|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") '|f02xefSolve|) + (|htShowPage|))) + +;f02xefSolve htPage == +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; lda := m +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lda) +;-- objValUnwrap htpLabelSpadValue(htPage, 'lda) +; ldb := m +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldb) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ldb) +; ncolb := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolb) +; objValUnwrap htpLabelSpadValue(htPage, 'ncolb) +; operation := htpButtonValue(htPage,'wantq) +; wantq := +; operation = 'qtrue => '"true" +; '"false" +; ldq := m +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldq) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ldq) +; ldph := n +;-- $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ldph) +;-- objValUnwrap htpLabelSpadValue(htPage, 'ldph) +; elements := htpButtonValue(htPage,'wantp) +; wantp := +; elements = 'ptrue => '"true" +; '"false" +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; ((m = '5 and n = '3) and ncolb = '1) => +; f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail) +; matList := +; "append"/[fa(i,n) for i in 1..lda] where fa(i,n) == +; labelList := +; "append"/[ga(i,j) for j in 1..n] where ga(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[15, "0.0", anam, 'F]]] +; prefix := ('"\newline \tab{2} ") +; labelList := [['text,:prefix],:labelList] +; bList := +; "append"/[fb(i,ncolb) for i in 1..ldb] where fb(i,ncolb) == +; pre := ("\newline \tab{2} ") +; labelList := +; "append"/[gb(i,j) for j in 1..ncolb] where gb(i,j) == +; bnam := INTERN STRCONC ('"b",STRINGIMAGE i, STRINGIMAGE j) +; [['bcStrings,[15, "0.0", bnam, 'F]]] +; labelList := [['text,:pre],:labelList] +; prefix := ("\blankline \menuitemstyle{}\tab{2} Enter values of {\it B}: ") +; bList := [['text,:prefix],:bList] +; equationPart := [ +; '(domainConditions +; (isDomain P (Polynomial $EmptyMode)) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain PI (PositiveInteger))), +; :matList,:bList] +; page := htInitPage('"F02XEF - SVD of complex matrix",nil) +; htSay '"\newline \menuitemstyle{}\tab{2} Enter values of {\it A}: " +; htSay '"\newline \tab{2} " +; htMakePage equationPart +; htSay '"\blankline " +; htMakeDoneButton('"Continue",'f02xefGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'lda,lda) +; htpSetProperty(page,'ldb,ldb) +; htpSetProperty(page,'ncolb,ncolb) +; htpSetProperty(page,'wantq,wantq) +; htpSetProperty(page,'ldq,ldq) +; htpSetProperty(page,'ldph,ldph) +; htpSetProperty(page,'wantp,wantp) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02xefSolve,ga| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 15 + (CONS '|0.0| + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02xefSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G168258) + (SPADLET G168258 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G168258) + (SEQ (EXIT (SETQ G168258 + (APPEND G168258 + (|f02xefSolve,ga| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline \\tab{2} ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |f02xefSolve,gb| (|i| |j|) + (PROG (|bnam|) + (RETURN + (SEQ (SPADLET |bnam| + (INTERN (STRCONC (MAKESTRING "b") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 15 + (CONS '|0.0| + (CONS |bnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |f02xefSolve,fb| (|i| |ncolb|) + (PROG (|pre| |labelList|) + (RETURN + (SEQ (SPADLET |pre| '|\\newline \\tab{2} |) + (SPADLET |labelList| + (PROG (G168281) + (SPADLET G168281 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolb|) G168281) + (SEQ (EXIT (SETQ G168281 + (APPEND G168281 + (|f02xefSolve,gb| |i| |j|))))))))) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |pre|) |labelList|))))))) + +(DEFUN |f02xefSolve| (|htPage|) + (PROG (|m| |n| |lda| |ldb| |ncolb| |operation| |wantq| |ldq| |ldph| + |elements| |wantp| |error| |ifail| |matList| |prefix| + |bList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |lda| |m|) + (SPADLET |ldb| |m|) + (SPADLET |ncolb| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|ncolb|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|ncolb|))))) + (SPADLET |operation| (|htpButtonValue| |htPage| '|wantq|)) + (SPADLET |wantq| + (COND + ((BOOT-EQUAL |operation| '|qtrue|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |ldq| |m|) + (SPADLET |ldph| |n|) + (SPADLET |elements| (|htpButtonValue| |htPage| '|wantp|)) + (SPADLET |wantp| + (COND + ((BOOT-EQUAL |elements| '|ptrue|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '5) (BOOT-EQUAL |n| '3) + (BOOT-EQUAL |ncolb| '1)) + (|f02xefDefaultSolve| |htPage| |lda| |ldb| |wantq| + |ldq| |ldph| |wantp| |ifail|)) + ('T + (SPADLET |matList| + (PROG (G168298) + (SPADLET G168298 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lda|) G168298) + (SEQ (EXIT + (SETQ G168298 + (APPEND G168298 + (|f02xefSolve,fa| |i| |n|))))))))) + (SPADLET |bList| + (PROG (G168306) + (SPADLET G168306 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ldb|) G168306) + (SEQ (EXIT + (SETQ G168306 + (APPEND G168306 + (|f02xefSolve,fb| |i| |ncolb|))))))))) + (SPADLET |prefix| + '|\\blankline \\menuitemstyle{}\\tab{2} Enter values of {\\it 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 |matList| |bList|))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "F02XEF - SVD of complex matrix") + 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") + '|f02xefGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|lda| |lda|) + (|htpSetProperty| |page| '|ldb| |ldb|) + (|htpSetProperty| |page| '|ncolb| |ncolb|) + (|htpSetProperty| |page| '|wantq| |wantq|) + (|htpSetProperty| |page| '|ldq| |ldq|) + (|htpSetProperty| |page| '|ldph| |ldph|) + (|htpSetProperty| |page| '|wantp| |wantp|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;f02xefDefaultSolve(htPage,lda,ldb,wantq,ldq,ldph,wantp,ifail) == +; n := '3 +; m := '5 +; ncolb := '1 +; page := htInitPage('"F02XEF - SVD of complex matrix",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 (15 "0.5*%i" a11 F)) +; (bcStrings (15 "-0.5 + 1.5*%i" a12 F)) +; (bcStrings (15 "-1 + 1*%i" a13 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (15 "0.4 + 0.3*%i" a21 F)) +; (bcStrings (15 "0.9 + 1.3*%i" a22 F)) +; (bcStrings (15 "0.2 + 1.4*%i" a23 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (15 "0.4" a31 F)) +; (bcStrings (15 "-0.4 + 0.4*%i" a32 F)) +; (bcStrings (15 "1.8" a33 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (15 "0.3 - 0.4*%i" a41 F)) +; (bcStrings (15 "0.1 + 0.7*%i" a42 F)) +; (bcStrings (15 "0.0" a43 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (15 "-0.3*%i" a51 F)) +; (bcStrings (15 "0.3 + 0.3*%i" a52 F)) +; (bcStrings (15 "2.4*%i" a53 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} Enter values of {\it B}: ") +; (text . "\newline \tab{2} ") +; (bcStrings (15 "-0.55+1.05*%i" b11 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (15 "0.49+0.93*%i" b12 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (15 "0.56-0.16*%i" b13 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (15 "0.39+0.23*%i" b14 F)) +; (text . "\newline \tab{2} ") +; (bcStrings (15 "1.13+0.83*%i" b15 F)) +; (text . "\blankline ")) +; htMakeDoneButton('"Continue",'f02xefGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'lda,lda) +; htpSetProperty(page,'ldb,ldb) +; htpSetProperty(page,'ncolb,ncolb) +; htpSetProperty(page,'wantq,wantq) +; htpSetProperty(page,'ldq,ldq) +; htpSetProperty(page,'ldph,ldph) +; htpSetProperty(page,'wantp,wantp) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |f02xefDefaultSolve| + (|htPage| |lda| |ldb| |wantq| |ldq| |ldph| |wantp| |ifail|) + (PROG (|n| |m| |ncolb| |page|) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '5) + (SPADLET |ncolb| '1) + (SPADLET |page| + (|htInitPage| + (MAKESTRING "F02XEF - SVD of complex matrix") 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| (15 "0.5*%i" |a11| F)) + (|bcStrings| (15 "-0.5 + 1.5*%i" |a12| F)) + (|bcStrings| (15 "-1 + 1*%i" |a13| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (15 "0.4 + 0.3*%i" |a21| F)) + (|bcStrings| (15 "0.9 + 1.3*%i" |a22| F)) + (|bcStrings| (15 "0.2 + 1.4*%i" |a23| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (15 "0.4" |a31| F)) + (|bcStrings| (15 "-0.4 + 0.4*%i" |a32| F)) + (|bcStrings| (15 "1.8" |a33| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (15 "0.3 - 0.4*%i" |a41| F)) + (|bcStrings| (15 "0.1 + 0.7*%i" |a42| F)) + (|bcStrings| (15 "0.0" |a43| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (15 "-0.3*%i" |a51| F)) + (|bcStrings| (15 "0.3 + 0.3*%i" |a52| F)) + (|bcStrings| (15 "2.4*%i" |a53| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} Enter values of {\\it B}: ") + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (15 "-0.55+1.05*%i" |b11| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (15 "0.49+0.93*%i" |b12| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (15 "0.56-0.16*%i" |b13| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (15 "0.39+0.23*%i" |b14| F)) + (|text| . "\\newline \\tab{2} ") + (|bcStrings| (15 "1.13+0.83*%i" |b15| F)) + (|text| . "\\blankline "))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|f02xefGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|lda| |lda|) + (|htpSetProperty| |page| '|ldb| |ldb|) + (|htpSetProperty| |page| '|ncolb| |ncolb|) + (|htpSetProperty| |page| '|wantq| |wantq|) + (|htpSetProperty| |page| '|ldq| |ldq|) + (|htpSetProperty| |page| '|ldph| |ldph|) + (|htpSetProperty| |page| '|wantp| |wantp|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;f02xefGen htPage == +; n := htpProperty(htPage,'n) +; m := htpProperty(htPage,'m) +; lda := htpProperty(htPage,'lda) +; ldb := htpProperty(htPage,'ldb) +; ncolb := htpProperty(htPage,'ncolb) +; wantq := htpProperty(htPage,'wantq) +; ldq := htpProperty(htPage,'ldq) +; ldph := htpProperty(htPage,'ldph) +; wantp := htpProperty(htPage,'wantp) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; y := REVERSE y +; for i in 1..lda repeat +; for j in 1..n repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; matform := [:matform,rowList] +; rowList := [] +; matstring := bcwords2liststring [bcwords2liststring x for x in matform] +; for i in 1..ldb repeat +; for j in 1..ncolb repeat +; elm := STRCONC((first y).1," ") +; rowList := [:rowList,elm] +; y := rest y +; bform := [:bform,rowList] +; rowList := [] +; bstring := bcwords2liststring [bcwords2liststring x for x in bform] +; prefix := STRCONC('"f02xef(",STRINGIMAGE m,",",STRINGIMAGE n,",") +; prefix := STRCONC(prefix,STRINGIMAGE lda,", ",STRINGIMAGE ncolb,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ldb,", ",wantq,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ldq,", ",wantp,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ldph,", ",matstring,", ",bstring," ,") +; linkGen STRCONC(prefix,STRINGIMAGE ifail,")") + +(DEFUN |f02xefGen| (|htPage|) + (PROG (|n| |m| |lda| |ldb| |ncolb| |wantq| |ldq| |ldph| |wantp| + |ifail| |alist| |matform| |matstring| |elm| |y| |bform| + |rowList| |bstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |lda| (|htpProperty| |htPage| '|lda|)) + (SPADLET |ldb| (|htpProperty| |htPage| '|ldb|)) + (SPADLET |ncolb| (|htpProperty| |htPage| '|ncolb|)) + (SPADLET |wantq| (|htpProperty| |htPage| '|wantq|)) + (SPADLET |ldq| (|htpProperty| |htPage| '|ldq|)) + (SPADLET |ldph| (|htpProperty| |htPage| '|ldph|)) + (SPADLET |wantp| (|htpProperty| |htPage| '|wantp|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |y| (REVERSE |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |lda|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |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))))) + (SPADLET |matstring| + (|bcwords2liststring| + (PROG (G168376) + (SPADLET G168376 NIL) + (RETURN + (DO ((G168381 |matform| + (CDR G168381)) + (|x| NIL)) + ((OR (ATOM G168381) + (PROGN + (SETQ |x| (CAR G168381)) + NIL)) + (NREVERSE0 G168376)) + (SEQ (EXIT + (SETQ G168376 + (CONS (|bcwords2liststring| |x|) + G168376))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |ldb|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolb|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |elm| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (APPEND |rowList| + (CONS |elm| NIL))) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bform| + (APPEND |bform| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G168412) + (SPADLET G168412 NIL) + (RETURN + (DO ((G168417 |bform| (CDR G168417)) + (|x| NIL)) + ((OR (ATOM G168417) + (PROGN + (SETQ |x| (CAR G168417)) + NIL)) + (NREVERSE0 G168412)) + (SEQ (EXIT + (SETQ G168412 + (CONS (|bcwords2liststring| |x|) + G168412))))))))) + (SPADLET |prefix| + (STRCONC (MAKESTRING "f02xef(") (STRINGIMAGE |m|) + '|,| (STRINGIMAGE |n|) '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lda|) '|, | + (STRINGIMAGE |ncolb|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ldb|) '|, | + |wantq| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ldq|) '|, | + |wantp| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ldph|) '|, | + |matstring| '|, | |bstring| '| ,|)) + (|linkGen| (STRCONC |prefix| (STRINGIMAGE |ifail|) '|)|))))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}