diff --git a/changelog b/changelog index 80910aa..783bae7 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090831 tpd src/axiom-website/patches.html 20090831.03.tpd.patch +20090831 tpd src/interp/Makefile move nag-d02.boot to nag-d02.lisp +20090831 tpd src/interp/nag-d02.lisp added, rewritten from nag-d02.boot +20090831 tpd src/interp/nag-d02.boot removed, rewritten to nag-d02.lisp 20090831 tpd src/axiom-website/patches.html 20090831.02.tpd.patch 20090831 tpd src/interp/Makefile move nag-d01.boot to nag-d01.lisp 20090831 tpd src/interp/nag-d01.lisp added, rewritten from nag-d01.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 2a31d81..5ede1e8 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1954,5 +1954,7 @@ src/interp/nag-c05.lisp rewrite from boot to lisp
src/interp/nag-c06.lisp rewrite from boot to lisp
20090831.02.tpd.patch src/interp/nag-d01.lisp rewrite from boot to lisp
+20090831.03.tpd.patch +src/interp/nag-d02.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 4262a34..610d768 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -1468,41 +1468,32 @@ ${MID}/nag-d01.lisp: ${IN}/nag-d01.lisp.pamphlet @ -\subsection{nag-d02.boot \cite{47}} +\subsection{nag-d02.lisp} <>= ${AUTO}/nag-d02.${O}: ${OUT}/nag-d02.${O} - @ echo 166 making${AUTO}/nag-d02.${O} from ${OUT}/nag-d02.${O} + @ echo 154 making ${AUTO}/nag-d02.${O} from ${OUT}/nag-d02.${O} @ cp ${OUT}/nag-d02.${O} ${AUTO} @ <>= -${OUT}/nag-d02.${O}: ${MID}/nag-d02.clisp - @ echo 167 making ${OUT}/nag-d02.${O} from ${MID}/nag-d02.clisp - @ (cd ${MID} ; \ +${OUT}/nag-d02.${O}: ${MID}/nag-d02.lisp + @ echo 136 making ${OUT}/nag-d02.${O} from ${MID}/nag-d02.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/nag-d02.clisp"' \ + echo '(progn (compile-file "${MID}/nag-d02.lisp"' \ ':output-file "${OUT}/nag-d02.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/nag-d02.clisp"' \ + echo '(progn (compile-file "${MID}/nag-d02.lisp"' \ ':output-file "${OUT}/nag-d02.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/nag-d02.clisp: ${IN}/nag-d02.boot.pamphlet - @ echo 168 making ${MID}/nag-d02.clisp from ${IN}/nag-d02.boot.pamphlet +<>= +${MID}/nag-d02.lisp: ${IN}/nag-d02.lisp.pamphlet + @ echo 137 making ${MID}/nag-d02.lisp from ${IN}/nag-d02.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/nag-d02.boot.pamphlet >nag-d02.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-d02.boot") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-d02.boot") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ; \ - rm nag-d02.boot ) + ${TANGLE} ${IN}/nag-d02.lisp.pamphlet >nag-d02.lisp ) @ @@ -4698,7 +4689,7 @@ clean: <> <> -<> +<> <> <> diff --git a/src/interp/nag-d02.boot.pamphlet b/src/interp/nag-d02.boot.pamphlet deleted file mode 100644 index 93edfc4..0000000 --- a/src/interp/nag-d02.boot.pamphlet +++ /dev/null @@ -1,2168 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-d02.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. - -@ -<<*>>= -<> - -d02bbf() == - htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02bbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02BBF integrates a system of {\it n} ordinary differential ") - (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") - (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") - (text . "conditions using a Runge-Kutta-Merson method; the solution ") - (text . "may be output at specified points.") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Initial value of {\it x}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.0" x F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "End of integration range {\it xend}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "8.0" xend F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of differential equations {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Tolerance required {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Error control indicator {\it irelab}:") - (radioButtons irelab - ("" " 0, mixed" mix) - ("" " 1, absolute" abs) - ("" " 2, relative" rel)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'd02bbfSolve) - htShowPage() - -d02bbfSolve htPage == - x := htpLabelInputString(htPage,'x) - xend := htpLabelInputString(htPage,'xend) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - tol := htpLabelInputString(htPage,'tol) - control := htpButtonValue(htPage,'irelab) - irelab := - control = 'mix => '0 - control = 'abs => '1 - '2 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'minusOne => '-1 - '1 - n = '3 => d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") - middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline \tab{2}") - yList := - "append"/[fb(i) for i in 1..n] where fb(i) == - ynam := INTERN STRCONC ('"u",STRINGIMAGE i) - [['bcStrings,[6, 0, ynam, 'F]]] - yList := [['text,:middle],:yList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") - mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline \tab{2}") - vList := [['bcStrings,[30, "0", 'out, 'EM]]] - vList := [['text,:mid],:vList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:yList,:vList] - page := htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02bbfGen) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'irelab,irelab) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail) == - n := '3 - page := htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (44 "tan(Y[3])" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the initial values of \htbitmap{yi}:") - (text . "\newline \tab{2}") - (bcStrings (8 "0.0" y1 EM)) - (bcStrings (8 "0.5" y2 EM)) - (bcStrings (8 "\%pi*0.2" y3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Intermediate values of {\it x} at which \htbitmap{yi} is required:") - (text . "\newline \tab{2}") - (bcStrings (30 "1,2,3,4,5,6,7,8" out EM))) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'irelab,irelab) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02bbfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02bbfGen htPage == - x := htpProperty(htPage, 'x) - xend := htpProperty(htPage, 'xend) - n := htpProperty(htPage, 'n) - tol := htpProperty(htPage, 'tol) - irelab := htpProperty(htPage, 'irelab) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - outp := ((first y).1) - oList := [outp,:oList] - y := rest y - ostring := bcwords2liststring oList - -- This is distictly horrible! OUTP is a comma-seperated string so we - -- count up the commas to see how many elements it has. We return this - -- quantity plus 1 since the ASP OUTPUT is always called at least once. - numberOfPoints := - ZEROP LENGTH(outp) => 1 - 2+COUNT(CHARACTER(44),outp) - for i in 1..n repeat - ytemp := STRCONC((first y).1," ") - yList := [ytemp,:yList] - y := rest y - ystring := bcwords2liststring yList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02bbf(", xend,", ", STRINGIMAGE numberOfPoints, ", ",STRINGIMAGE n,", ",STRINGIMAGE irelab) - prefix := STRCONC(prefix,", ",x,", [", ystring,"],",tol) - prefix := STRCONC(prefix,", ",STRINGIMAGE ifail,",(") - end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",ostring) - end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") - linkGen STRCONC(prefix,end) - -d02bhf() == - htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02bhf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bhf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02BHF integrates a system of {\it n} ordinary differential ") - (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") - (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") - (text . "conditions using a Runge-Kutta-Merson method until a specified ") - (text . "function {\em g(x,y)} of the solution is zero. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Initial value of {\it x}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.0" x F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "End of integration range {\it xend}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "10.0" xend F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of differential equations {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Tolerance required {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Error control indicator {\it irelab}:") - (radioButtons irelab - ("" " 0, mixed" mix) - ("" " 1, absolute" abs) - ("" " 2, relative" rel)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Upper bound on size of the interval {\it hmax}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" hmax F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'd02bhfSolve) - htShowPage() - -d02bhfSolve htPage == - x := htpLabelInputString(htPage,'x) - xend := htpLabelInputString(htPage,'xend) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - tol := htpLabelInputString(htPage,'tol) - control := htpButtonValue(htPage,'irelab) - irelab := - control = 'mix => '0 - control = 'abs => '1 - '2 - hmax := htpLabelInputString(htPage,'hmax) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '3 => d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") - middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") - yList := - "append"/[fb(i) for i in 1..n] where fb(i) == - ynam := INTERN STRCONC ('"u",STRINGIMAGE i) - [['bcStrings,[6, 0, ynam, 'F]]] - yList := [['text,:middle],:yList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") - mid := STRCONC(mid,'"{\em g(x,y)}: \newline ") - vList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] - vList := [['text,:mid],:vList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:yList,:vList] - page := htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02bhfGen) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'irelab,irelab) - htpSetProperty(page,'hmax,hmax) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail) == - n := '3 - page := htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (44 "tan(Y[3])" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the initial values of \htbitmap{yi}:") - (text . "\newline ") - (bcStrings (8 "0.5" y1 EM)) - (bcStrings (8 "0.5" y2 EM)) - (bcStrings (8 "\%pi*0.2" y3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the function below {\em g(x,y)}: ") - (text . "\newline ") - (bcStrings (30 "Y[1]" g EM))) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'irelab,irelab) - htpSetProperty(page,'hmax,hmax) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02bhfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02bhfGen htPage == - x := htpProperty(htPage, 'x) - xend := htpProperty(htPage, 'xend) - n := htpProperty(htPage, 'n) - tol := htpProperty(htPage, 'tol) - irelab := htpProperty(htPage, 'irelab) - hmax := htpProperty(htPage, 'hmax) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - g := ((first y).1) - y := rest y - for i in 1..n repeat - ytemp := STRCONC((first y).1," ") - yList := [ytemp,:yList] - y := rest y - ystring := bcwords2liststring yList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02bhf(", xend,", ",STRINGIMAGE n,", ",STRINGIMAGE irelab) - mid := STRCONC(", ",hmax,", ",x,", [", ystring,"],") - mid := STRCONC(mid,tol,", ",STRINGIMAGE ifail,",(",g) - mid := STRCONC(mid,"::Expression Float)::ASP9('G),(") - end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN))") - linkGen STRCONC(prefix,mid,end) - - -d02cjf() == - htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02cjf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02cjf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02CJF integrates a system of {\it n} ordinary differential ") - (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") - (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") - (text . "conditions using an Adams method until a specified ") - (text . "function {\em g(x,y)} of the solution is zero; the solution may ") - (text . "be output at specified points. \blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Initial value of {\it x}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.0" x F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "End of integration range {\it xend}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "10.0" xend F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of differential equations {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Tolerance required {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Type of error test used {\it relabs}:") - (radioButtons relabs - ("" " D, default (mixed)" mix) - ("" " A, absolute" abs) - ("" " R, relative" rel)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'd02cjfSolve) - htShowPage() - -d02cjfSolve htPage == - x := htpLabelInputString(htPage,'x) - xend := htpLabelInputString(htPage,'xend) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - tol := htpLabelInputString(htPage,'tol) - control := htpButtonValue(htPage,'relabs) - relabs := - control = 'mix => '"D" - control = 'abs => '"A" - '"R" - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '3 => d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") - middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") - yList := - "append"/[fb(i) for i in 1..n] where fb(i) == - ynam := INTERN STRCONC ('"u",STRINGIMAGE i) - [['bcStrings,[6, 0, ynam, 'F]]] - yList := [['text,:middle],:yList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") - mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ") - vList := [['bcStrings,[30, "2,4", 'out, 'EM]]] - vList := [['text,:mid],:vList] - midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") - midd := STRCONC(midd,'"{\em g(x,y)}: \newline ") - uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] - uList := [['text,:midd],:uList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:yList,:vList,:uList] - page := htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02cjfGen) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'relabs,relabs) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail) == - n := '3 - page := htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (44 "tan(Y[3])" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the initial values of \htbitmap{yi}:") - (text . "\newline ") - (bcStrings (8 "0.5" y1 EM)) - (bcStrings (8 "0.5" y2 EM)) - (bcStrings (8 "\%pi*0.2" y3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Intermediate") - (text . " values of {\it x} at which \htbitmap{yi} is required:") - (text . "\newline ") - (bcStrings (30 "2,4,6,8" out EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the function below {\em g(x,y)}: ") - (text . "\newline ") - (bcStrings (30 "Y[1]" g EM))) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'relabs,relabs) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02cjfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02cjfGen htPage == - x := htpProperty(htPage, 'x) - xend := htpProperty(htPage, 'xend) - n := htpProperty(htPage, 'n) - tol := htpProperty(htPage, 'tol) - relabs := htpProperty(htPage, 'relabs) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - g := ((first y).1) - y := rest y - outp := ((first y).1) - oList := [outp,:oList] - ostring := bcwords2liststring oList - -- This is distictly horrible! OUTP is a comma-seperated string so we - -- count up the commas to see how many elements it has. We return this - -- quantity plus 1 since the ASP OUTPUT is always called at least once. - numberOfPoints := - ZEROP LENGTH(outp) => 1 - 2+COUNT(CHARACTER(44),outp) - y := rest y - for i in 1..n repeat - ytemp := STRCONC((first y).1," ") - yList := [ytemp,:yList] - y := rest y - ystring := bcwords2liststring yList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02cjf(",xend,", ",STRINGIMAGE numberOfPoints ,", ", STRINGIMAGE n,", ",tol,",_"",relabs) - mid := STRCONC("_", ",x ,", [", ystring,"],",STRINGIMAGE ifail) - mid := STRCONC(mid,",(",g,"::Expression Float)::ASP9('G),(",fstring) - end := STRCONC("::Vector Expression Float)::ASP7('FCN),(",ostring) - end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") - linkGen STRCONC(prefix,mid,end) - - - -d02ejf() == - htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02ejf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02ejf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02EJF integrates a system of {\em n} ordinary differential ") - (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for {\it i} ") - (text . "= 1,,2,...,{\it n}, over a range with given initial conditions") - (text . " using backward differentiation formulae until a specified ") - (text . "function {\em g(x,y)} of the solution is zero; the solution may ") - (text . "be output at specified points. \blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Initial value of {\it x}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.0" x F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "End of integration range {\it xend}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "10.0" xend F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of differential equations {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Tolerance required {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Type of error test used {\it relabs}:") - (radioButtons relabs - ("" " D, default (mixed)" mix) - ("" " A, absolute" abs) - ("" " R, relative" rel)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'd02ejfSolve) - htShowPage() - -d02ejfSolve htPage == - x := htpLabelInputString(htPage,'x) - xend := htpLabelInputString(htPage,'xend) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - tol := htpLabelInputString(htPage,'tol) - control := htpButtonValue(htPage,'relabs) - relabs := - control = 'mix => '"D" - control = 'abs => '"A" - '"R" - iw := (n + 12) * n + 50 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '3 => d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") - middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") - yList := - "append"/[fb(i) for i in 1..n] where fb(i) == - ynam := INTERN STRCONC ('"u",STRINGIMAGE i) - [['bcStrings,[6, 0, ynam, 'F]]] - yList := [['text,:middle],:yList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") - mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ") - vList := [['bcStrings,[30, "2,4,6,8", 'out, 'EM]]] - vList := [['text,:mid],:vList] - midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") - midd := STRCONC(midd,'"{\em g(x,y)}: \newline ") - uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] - uList := [['text,:midd],:uList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:yList,:vList,:uList] - page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htSay '"\blankline {\em Note:} PEDERV is automatically generated using the vector " - htSay '"of derivatives given above. " - htMakeDoneButton('"Continue",'d02ejfGen) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'relabs,relabs) - htpSetProperty(page,'iw,iw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail) == - n := '3 - page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (44 "-0.04*Y[1]+1.0E4*Y[2]*Y[3]" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (44 "0.04*Y[1]-1.0E4*Y[2]*Y[3]-3.0E7*Y[2]*Y[2]" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (44 "3.0E7*Y[2]*Y[2]" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the initial values of \htbitmap{yi}:") - (text . "\newline ") - (bcStrings (8 "1.0" y1 EM)) - (bcStrings (8 "0.0" y2 EM)) - (bcStrings (8 "0.0" y3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} Intermediate") - (text . " values of {\it x} at which \htbitmap{yi} is required:") - (text . "\newline ") - (bcStrings (30 "2,4,6,8" out EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the function below {\em g(x,y)}: ") - (text . "\newline ") - (bcStrings (30 "Y[1]-0.9" g EM)) - (text . "\blankline ") - (text . "{\em Note:} PEDERV is automatically generated using the vector ") - (text . "of derivatives given above. ")) - htpSetProperty(page,'x,x) - htpSetProperty(page,'xend,xend) - htpSetProperty(page,'n,n) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'relabs,relabs) - htpSetProperty(page,'iw,iw) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02ejfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02ejfGen htPage == - x := htpProperty(htPage, 'x) - xend := htpProperty(htPage, 'xend) - n := htpProperty(htPage, 'n) - tol := htpProperty(htPage, 'tol) - relabs := htpProperty(htPage, 'relabs) - iw := htpProperty(htPage, 'iw) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - g := ((first y).1) - y := rest y - outp := ((first y).1) - oList := [outp,:oList] - ostring := bcwords2liststring oList - -- This is distictly horrible! OUTP is a comma-seperated string so we - -- count up the commas to see how many elements it has. We return this - -- quantity plus 1 since the ASP OUTPUT is always called at least once. - numberOfPoints := - ZEROP LENGTH(outp) => 1 - 2+COUNT(CHARACTER(44),outp) - y := rest y - for i in 1..n repeat - ytemp := STRCONC((first y).1," ") - yList := [ytemp,:yList] - y := rest y - ystring := bcwords2liststring yList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02ejf(",xend,", ",STRINGIMAGE numberOfPoints,", ", STRINGIMAGE n,",_"",relabs,"_", ") - mid:=STRCONC(STRINGIMAGE iw,", ",x ,", [", ystring,"], ",tol,", ") - mid := STRCONC(mid,STRINGIMAGE ifail,",(",g,"::Expression Float)::ASP9(G),(") - end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",fstring) - end := STRCONC(end,"::Vector Expression Float)::ASP31('PEDERV),(",ostring) - end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") - linkGen STRCONC(prefix,mid,end) - -d02gaf() == - htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02gaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gaf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02GAF solves a two-point boundary value problem for a system ") - (text . "of n ODEs \center{\htbitmap{d02gaf},} for i = 1,2,...,n, on ") - (text . "the range [a,b] with assigned boundary conditions using a ") - (text . "deferred correction technique and a Newton iteration; ") - (text . "the solution is computed on a mesh. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of equations in the system {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Left hand boundary point {\it a}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Right hand boundary {\it b}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" a F)) - (text . "\tab{34} ") - (bcStrings (10 "10.0" b F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Max number of mesh points {\it mnp}:") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Number of points {\it np} ({\it np} = 0 or {\it np} ") - (text . "\htbitmap{great=} 4): ") - (text . "\newline\tab{2} ") - (bcStrings (10 64 mnp PI)) - (text . "\tab{34} ") - (bcStrings (10 26 np PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Accuracy required {\it tol}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-3" tol F)) - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'd02gafSolve) - htShowPage() - -d02gafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - mnp := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) - objValUnwrap htpLabelSpadValue(htPage, 'mnp) - np := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) - objValUnwrap htpLabelSpadValue(htPage, 'np) - lw := mnp * (3*n*n + 6*n + 2) + 4*n*n + 4*n - liw := mnp * (2*n + 1) + n*n + 4*n + 2 - tol := htpLabelInputString(htPage,'tol) - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - n = '3 => d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter known or estimated ") - middle := STRCONC(middle,'"values of \htbitmap{yi} at a and b, ") - middle := STRCONC(middle,"{\it U(n,2)}. [\htbitmap{yi}(a) in the first ") - middle := STRCONC(middle,"column, \htbitmap{yi}(b) in the second.] ") - middle := STRCONC(middle,"\newline ") - uList := - "append"/[fb(i) for i in 1..n] where fb(i) == - labelList := - "append"/[fc(i,j) for j in 1..2] where fc(i,j) == - unam := INTERN STRCONC ('"u",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, unam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - uList := [['text,:middle],:uList] - mid := ('"\blankline \menuitemstyle{} \tab{2} Enter {\it V(n,2)}. ") - mid := STRCONC(mid,'"If U(i,j) is known V(i,j) ") - mid := STRCONC(mid,'"= 0.0, else V(i,j) = 1.0. \newline ") - vList := - "append"/[fd(i) for i in 1..n] where fd(i) == - labelList := - "append"/[fe(i,j) for j in 1..2] where fe(i,j) == - vnam := INTERN STRCONC ('"v",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, vnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - vList := [['text,:mid],:vList] - xList := - "append"/[ff(i) for i in 1..mnp] where ff(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, "0.0", xnam, 'F]]] - end := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial mesh ") - end := STRCONC(end,'"{\it X(mnp)}: \newline ") - xList := [['text,:end],:xList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:uList,:vList,:xList] - page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions (i.e. the derivatives) below as functions of " - htSay '"Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02gafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) == - n := '3 - page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions (i.e. the derivatives) below ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (42 "Y[2]" f1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (42 "Y[3]" f2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (42 "-Y[1]*Y[3]-0.2*(1-Y[2]*Y[2])" f3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter known or estimated values of \htbitmap{yi} at a and b,") - (text . " {\it U(n,2)}. ") - (text . " [\htbitmap{yi}(a) in the first column, \htbitmap{yi}(b) ") - (text . "in the second.] \newline ") - (bcStrings (6 "0" u11 F)) - (bcStrings (6 "10" u21 F)) - (text . "\newline ") - (bcStrings (6 "0" u12 F)) - (bcStrings (6 "1" u22 F)) - (text . "\newline ") - (bcStrings (6 "0" u13 F)) - (bcStrings (6 "0" u23 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter {\it V(n,2)}. ") - (text . "If U(i,j) is known V(i,j) = 0.0, else V(i,j) = 1.0: \newline") - (bcStrings (6 "0.0" v11 F)) - (bcStrings (6 "1.0" v21 F)) - (text . "\newline ") - (bcStrings (6 "0.0" v12 F)) - (bcStrings (6 "0.0" v22 F)) - (text . "\newline ") - (bcStrings (6 "1.0" v13 F)) - (bcStrings (6 "1.0" v23 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the initial mesh {\it X(mnp)}: ") - (text . "\newline ") - (bcStrings (8 "0.0" x1 F)) - (bcStrings (8 "0.4" x2 F)) - (bcStrings (8 "0.8" x3 F)) - (bcStrings (8 "1.2" x4 F)) - (bcStrings (8 "1.6" x5 F)) - (bcStrings (8 "2.0" x6 F)) - (bcStrings (8 "2.4" x7 F)) - (bcStrings (8 "2.8" x8 F)) - (bcStrings (8 "3.2" x9 F)) - (bcStrings (8 "3.6" x10 F)) - (bcStrings (8 "4.0" x11 F)) - (bcStrings (8 "4.4" x12 F)) - (bcStrings (8 "4.8" x13 F)) - (bcStrings (8 "5.2" x14 F)) - (bcStrings (8 "5.6" x15 F)) - (bcStrings (8 "6.0" x16 F)) - (bcStrings (8 "6.4" x17 F)) - (bcStrings (8 "6.8" x18 F)) - (bcStrings (8 "7.2" x19 F)) - (bcStrings (8 "7.6" x20 F)) - (bcStrings (8 "8.0" x21 F)) - (bcStrings (8 "8.4" x22 F)) - (bcStrings (8 "8.8" x23 F)) - (bcStrings (8 "9.2" x24 F)) - (bcStrings (8 "9.6" x25 F)) - (bcStrings (8 "10.0" x26 F)) - (bcStrings (8 "0.0" x27 F)) - (bcStrings (8 "0.0" x28 F)) - (bcStrings (8 "0.0" x29 F)) - (bcStrings (8 "0.0" x30 F)) - (bcStrings (8 "0.0" x31 F)) - (bcStrings (8 "0.0" x32 F)) - (bcStrings (8 "0.0" x33 F)) - (bcStrings (8 "0.0" x34 F)) - (bcStrings (8 "0.0" x35 F)) - (bcStrings (8 "0.0" x36 F)) - (bcStrings (8 "0.0" x37 F)) - (bcStrings (8 "0.0" x38 F)) - (bcStrings (8 "0.0" x39 F)) - (bcStrings (8 "0.0" x40 F)) - (bcStrings (8 "0.0" x41 F)) - (bcStrings (8 "0.0" x42 F)) - (bcStrings (8 "0.0" x43 F)) - (bcStrings (8 "0.0" x44 F)) - (bcStrings (8 "0.0" x45 F)) - (bcStrings (8 "0.0" x46 F)) - (bcStrings (8 "0.0" x47 F)) - (bcStrings (8 "0.0" x48 F)) - (bcStrings (8 "0.0" x49 F)) - (bcStrings (8 "0.0" x50 F)) - (bcStrings (8 "0.0" x51 F)) - (bcStrings (8 "0.0" x52 F)) - (bcStrings (8 "0.0" x53 F)) - (bcStrings (8 "0.0" x54 F)) - (bcStrings (8 "0.0" x55 F)) - (bcStrings (8 "0.0" x56 F)) - (bcStrings (8 "0.0" x57 F)) - (bcStrings (8 "0.0" x58 F)) - (bcStrings (8 "0.0" x59 F)) - (bcStrings (8 "0.0" x60 F)) - (bcStrings (8 "0.0" x61 F)) - (bcStrings (8 "0.0" x62 F)) - (bcStrings (8 "0.0" x63 F)) - (bcStrings (8 "0.0" x64 F))) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02gafGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02gafGen htPage == - n := htpProperty(htPage, 'n) - a := htpProperty(htPage, 'a) - b := htpProperty(htPage, 'b) - mnp := htpProperty(htPage, 'mnp) - np := htpProperty(htPage, 'np) - lw := htpProperty(htPage, 'lw) - liw := htpProperty(htPage, 'liw) - ifail := htpProperty(htPage,'ifail) - tol := htpProperty(htPage,'tol) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..mnp repeat - x := STRCONC((first y).1," ") - xList := [x,:xList] - y := rest y - xstring := bcwords2liststring xList - for i in 1..n repeat - for j in 1..2 repeat - v := STRCONC((first y).1," ") - rowList := [v,:rowList] - y := rest y - vList := [:vList,rowList] - rowList := [] - for i in 1..n repeat - for j in 1..2 repeat - u := STRCONC((first y).1," ") - rowList := [u,:rowList] - y := rest y - uList := [:uList,rowList] - rowList := [] - vList := reverse vList - uList := reverse uList - vstring := bcwords2liststring [bcwords2liststring x for x in vList] - ustring := bcwords2liststring [bcwords2liststring x for x in uList] - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - Y:='Y - prefix := STRCONC("d02gaf(",ustring,", ",vstring,", ",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,a,", ",b,", ",tol,", ") - prefix := STRCONC(prefix,STRINGIMAGE mnp,", ",STRINGIMAGE lw,", ") - prefix := STRCONC(prefix,STRINGIMAGE liw,", [",xstring,"], ",STRINGIMAGE np) - end:=STRCONC (",",STRINGIMAGE ifail,",(",fstring,"::Vector Expression Float") - linkGen STRCONC (prefix,end,")::ASP7('FCN))") - -d02gbf() == - htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02gbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02GBF solves a general linear two-point boundary value problem ") - (text . "for a system of n ODEs {\it y' = F(x)y + g(x)} on the range ") - (text . "[a,b] with boundary conditions {\it Cy(a) + Dy(b) = \gamma} ") - (text . "using a deferred correction technique.") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of equations in the system {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 2 n PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Left hand boundary point {\it a}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Right hand boundary {\it b}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0" a F)) - (text . "\tab{34} ") - (bcStrings (10 "1.0" b F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Max number of mesh points {\it mnp}:") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Number of points {\it np}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 70 mnp PI)) - (text . "\tab{34} ") - (bcStrings (10 0 np PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Accuracy required {\it tol}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-3" tol F)) - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'd02gbfSolve) - htShowPage() - -d02gbfSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - a := htpLabelInputString(htPage,'a) - b := htpLabelInputString(htPage,'b) - mnp := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) - objValUnwrap htpLabelSpadValue(htPage, 'mnp) - np := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) - objValUnwrap htpLabelSpadValue(htPage, 'np) - lw := mnp * (3*n*n + 5*n + 2) + 3*n*n + 5*n - liw := mnp * (2*n + 1) + n - tol := htpLabelInputString(htPage,'tol) - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - n = '2 => d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) - cList := - "append"/[fa(i,n) for i in 1..n] where fa(i,n) == - labelList := - "append"/[fb(i,j) for j in 1..n] where fb(i,j) == - cnam := INTERN STRCONC ('"c",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, cnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix {\it D}: ") - middle := STRCONC(middle,"\newline ") - dList := - "append"/[fc(i,n) for i in 1..n] where fc(i,n) == - labelList := - "append"/[fd(i,j) for j in 1..n] where fd(i,j) == - dnam := INTERN STRCONC ('"d",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, dnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - dList := [['text,:middle],:dList] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector \gamma: ") - middle := STRCONC(middle,"\newline ") - gamList := - "append"/[fe(i) for i in 1..n] where fe(i) == - gamnam := INTERN STRCONC ('"gam",STRINGIMAGE i) - [['bcStrings,[6, 0, gamnam, 'F]]] - prefix := ('"\newline ") - gamList := [['text,:middle],:gamList] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ") - middle := STRCONC(middle,"{\it F(x)} from the equation {\it y' =} ") - middle := STRCONC(middle,"{\it F(x)y + g(x)}: \newline ") - fList := - "append"/[ff(i,n) for i in 1..n] where ff(i,n) == - labelList := - "append"/[fg(i,j) for j in 1..n] where fg(i,j) == - fnam := INTERN STRCONC ('"f",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, 0, fnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - fList := [['text,:middle],:fList] - mid := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector {\it g(x)}: ") - mid := STRCONC(mid,'"\newline ") - gList := - "append"/[fh(i) for i in 1..n] where fh(i) == - gnam := INTERN STRCONC ('"g",STRINGIMAGE i) - [['bcStrings,[6, 0, gnam, 'F]]] - prefix := ('"\newline ") - gList := [['text,:middle],:gList] - xList := - "append"/[fi(i) for i in 1..mnp] where fi(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, "0.0", xnam, 'F]]] - end := ('"\blankline \menuitemstyle{} \tab{2} The initial mesh {\it X(mnp)}") - end := STRCONC(end,'", (all entries = 0 if np < 4): \newline ") - xList := [['text,:end],:xList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :cList,:dList,:gamList,:fList,:gList,:xList] - page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the matrix {\it C} form the equation {\it Cy(a) + Dy(b)} " - htSay '"= \gamma \newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02gbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) == - n := '2 - page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it C} from the equation {\it Cy(a) + Dy(b)} = \gamma:") - (text . "\newline ") - (bcStrings (6 "1" c11 F)) - (bcStrings (6 "0" c12 F)) - (text . "\newline ") - (bcStrings (6 "0" c21 F)) - (bcStrings (6 "0" c22 F)) - (text . "\blankline \menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it D}: \newline ") - (bcStrings (6 "0" d11 F)) - (bcStrings (6 "0" d12 F)) - (text . "\newline ") - (bcStrings (6 "1" d21 F)) - (bcStrings (6 "0" d22 F)) - (text . "\blankline \menuitemstyle{}\tab{2}") - (text . "Enter the vector \gamma: \newline ") - (bcStrings (6 "0" gam1 F)) - (bcStrings (6 "1" gam2 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the matrix {\it F(x)} from the equation {\it y' = F(x)y + g(x)} : ") - (text . "\newline ") - (bcStrings (6 "0" f11 F)) - (bcStrings (6 "1" f12 F)) - (text . "\newline ") - (bcStrings (6 "0" f21 F)) - (bcStrings (6 "-10" f22 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the vector {\it g(x)}: ") - (text . "\newline ") - (bcStrings (6 "0" g1 F)) - (bcStrings (6 "0" g2 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} The initial mesh {\it X(mnp)}, ") - (text . "(all entries = 0 if np < 4): \newline ") - (bcStrings (8 "0.0" x1 F)) - (bcStrings (8 "0.0" x2 F)) - (bcStrings (8 "0.0" x3 F)) - (bcStrings (8 "0.0" x4 F)) - (bcStrings (8 "0.0" x5 F)) - (bcStrings (8 "0.0" x6 F)) - (bcStrings (8 "0.0" x7 F)) - (bcStrings (8 "0.0" x8 F)) - (bcStrings (8 "0.0" x9 F)) - (bcStrings (8 "0.0" x10 F)) - (bcStrings (8 "0.0" x11 F)) - (bcStrings (8 "0.0" x12 F)) - (bcStrings (8 "0.0" x13 F)) - (bcStrings (8 "0.0" x14 F)) - (bcStrings (8 "0.0" x15 F)) - (bcStrings (8 "0.0" x16 F)) - (bcStrings (8 "0.0" x17 F)) - (bcStrings (8 "0.0" x18 F)) - (bcStrings (8 "0.0" x19 F)) - (bcStrings (8 "0.0" x20 F)) - (bcStrings (8 "0.0" x21 F)) - (bcStrings (8 "0.0" x22 F)) - (bcStrings (8 "0.0" x23 F)) - (bcStrings (8 "0.0" x24 F)) - (bcStrings (8 "0.0" x25 F)) - (bcStrings (8 "0.0" x26 F)) - (bcStrings (8 "0.0" x27 F)) - (bcStrings (8 "0.0" x28 F)) - (bcStrings (8 "0.0" x29 F)) - (bcStrings (8 "0.0" x30 F)) - (bcStrings (8 "0.0" x31 F)) - (bcStrings (8 "0.0" x32 F)) - (bcStrings (8 "0.0" x33 F)) - (bcStrings (8 "0.0" x34 F)) - (bcStrings (8 "0.0" x35 F)) - (bcStrings (8 "0.0" x36 F)) - (bcStrings (8 "0.0" x37 F)) - (bcStrings (8 "0.0" x38 F)) - (bcStrings (8 "0.0" x39 F)) - (bcStrings (8 "0.0" x40 F)) - (bcStrings (8 "0.0" x41 F)) - (bcStrings (8 "0.0" x42 F)) - (bcStrings (8 "0.0" x43 F)) - (bcStrings (8 "0.0" x44 F)) - (bcStrings (8 "0.0" x45 F)) - (bcStrings (8 "0.0" x46 F)) - (bcStrings (8 "0.0" x47 F)) - (bcStrings (8 "0.0" x48 F)) - (bcStrings (8 "0.0" x49 F)) - (bcStrings (8 "0.0" x50 F)) - (bcStrings (8 "0.0" x51 F)) - (bcStrings (8 "0.0" x52 F)) - (bcStrings (8 "0.0" x53 F)) - (bcStrings (8 "0.0" x54 F)) - (bcStrings (8 "0.0" x55 F)) - (bcStrings (8 "0.0" x56 F)) - (bcStrings (8 "0.0" x57 F)) - (bcStrings (8 "0.0" x58 F)) - (bcStrings (8 "0.0" x59 F)) - (bcStrings (8 "0.0" x60 F)) - (bcStrings (8 "0.0" x61 F)) - (bcStrings (8 "0.0" x62 F)) - (bcStrings (8 "0.0" x63 F)) - (bcStrings (8 "0.0" x64 F)) - (bcStrings (8 "0.0" x65 F)) - (bcStrings (8 "0.0" x66 F)) - (bcStrings (8 "0.0" x67 F)) - (bcStrings (8 "0.0" x68 F)) - (bcStrings (8 "0.0" x69 F)) - (bcStrings (8 "0.0" x70 F))) - htpSetProperty(page,'n,n) - htpSetProperty(page,'a,a) - htpSetProperty(page,'b,b) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02gbfGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02gbfGen htPage == - n := htpProperty(htPage, 'n) - a := htpProperty(htPage, 'a) - b := htpProperty(htPage, 'b) - mnp := htpProperty(htPage, 'mnp) - np := htpProperty(htPage, 'np) - lw := htpProperty(htPage, 'lw) - liw := htpProperty(htPage, 'liw) - ifail := htpProperty(htPage,'ifail) - tol := htpProperty(htPage,'tol) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..mnp repeat -- matrix - x := STRCONC((first y).1," ") - xList := [x,:xList] - y := rest y - xstring := bcwords2liststring xList - for i in 1..n repeat -- vector g - g := STRCONC((first y).1," ") - gList := [g,:gList] - y := rest y - gstring := bcwords2liststring gList - for i in 1..n repeat -- matrix F - for j in 1..n repeat - f := STRCONC((first y).1," ") - flist := [f,:flist] - y := rest y - fmatlist := [:fmatlist,flist] - flist := [] - fmatlist := reverse fmatlist - fmatstr := bcwords2liststring [bcwords2liststring x for x in fmatlist] - for i in 1..n repeat -- vector gamma - gam := STRCONC((first y).1," ") - gamList := [gam,:gamList] - y := rest y - gamstr := bcwords2liststring gamList - for i in 1..n repeat -- matrix D - for j in 1..n repeat - d := STRCONC((first y).1," ") - dlist := [d,:dlist] - y := rest y - dmatlist := [:dmatlist,dlist] - dlist := [] - dmatlist := reverse dmatlist - dmatstr := bcwords2liststring [bcwords2liststring x for x in dmatlist] - for i in 1..n repeat -- matrix C - for j in 1..n repeat - c := STRCONC((first y).1," ") - clist := [c,:clist] - y := rest y - cmatlist := [:cmatlist,clist] - clist := [] - cmatlist := reverse cmatlist - cmatstr := bcwords2liststring [bcwords2liststring x for x in cmatlist] - prefix := STRCONC("d02gbf(",STRINGIMAGE a,", ",STRINGIMAGE b,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,", ",tol,", ",STRINGIMAGE mnp,", ") - prefix := STRCONC(prefix,STRINGIMAGE lw,", ",STRINGIMAGE liw,", ") - prefix := STRCONC(prefix,cmatstr,"::Matrix DoubleFloat,",dmatstr,"::Matrix DoubleFloat,[",gamstr,"]::Matrix DoubleFloat,[",xstring,"]::Matrix DoubleFloat, ") - mid := STRCONC(STRINGIMAGE np,", ",STRINGIMAGE ifail,", ") - end := STRCONC("(",fmatstr,"::Matrix(Expression(Float)))::ASP77(FCNF),(",gstring) - linkGen STRCONC(prefix,mid,end,"::Vector(Expression(Float)))::ASP78(FCNG))") - -d02kef() == - htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02kef} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02kef| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02KEF finds a specified eigenvalue \htbitmap{lamdab} of a ") - (text . "regular or second-order Sturm-Liouville system ") - (text . "{\it(p(x)y')' + q(x; \lambda)y = 0} on a finite or infinite ") - (text . "range [a,b]; a Pruefer transformation and shooting method ") - (text . "are used; discontinuities in coefficient functions or their ") - (text . "derivatives are permitted. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of points in XPOINT {\it m}:") - (text . "\newline\tab{2} ") - (bcStrings (6 5 m PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Index of the `break-point' {\it match}:") - (text . "\newline\tab{2} ") - (bcStrings (6 0 match PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Index of the required eigenvalue {\it k}:") - (text . "\newline\tab{2} ") - (bcStrings (6 11 k PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Accuracy required {\it tol}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "0.0001" tol F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Eigenvalue estimate {\it elam}: ") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Scale of the problem {\it delam}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "14" elam F)) - (text . "\tab{34} ") - (bcStrings (10 "1" delam F)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} \newline ") - (text . "Max iterations {\it maxit}:") - (text . "\tab{32} \menuitemstyle{}\tab{34} ") - (text . "Max COEFFN calls {\it maxfun}:") - (text . "\newline\tab{2} ") - (bcStrings (10 0 maxit PI)) - (text . "\tab{34} ") - (bcStrings (10 0 maxfun PI)) - (text . "\blankline ") - (text . "\tab{2} \newline {\it Note:} no bound is assumed ") - (text . "if maxit = 0 \blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'd02kefSolve) - htShowPage() - -d02kefSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - match := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'match) - objValUnwrap htpLabelSpadValue(htPage, 'match) - k := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k) - objValUnwrap htpLabelSpadValue(htPage, 'k) - tol := htpLabelInputString(htPage,'tol) - elam := htpLabelInputString(htPage,'elam) - delam := htpLabelInputString(htPage,'delam) - maxit := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit) - objValUnwrap htpLabelSpadValue(htPage, 'maxit) - maxfun := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxfun) - objValUnwrap htpLabelSpadValue(htPage, 'maxfun) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'minusOne => '-1 - '1 - m = '5 =>d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail) - xpList := - "append"/[fa(i) for i in 1..m] where fa(i) == - xpnam := INTERN STRCONC ('"xp",STRINGIMAGE i) - [['bcStrings,[10, "0.0", xpnam, 'EM]]] - middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it p} for COEFFN:") - middle := STRCONC(middle,"\newline ") - cList := [['text,:middle],['bcStrings,[42, "0.0", 'c1, 'EM]]] - middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it q} for COEFFN:") - middle := STRCONC(middle,"\newline ") - c1List := [['text,:middle],['bcStrings,[42, "0.0", 'c2, 'EM]]] - cList := [:cList,:c1List] - middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it dqdl}") - middle := STRCONC(middle," for COEFFN: \newline ") - c2List := [['text,:middle],['bcStrings,[42, "0.0", 'c3, 'EM]]] - cList := [:cList,:c2List] - middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YL(1) & YL(2) ") - middle := STRCONC(middle,"for BDYVAL: \newline ") - ylList := - "append"/[fb(i) for i in 1..2] where fb(i) == - ylnam := INTERN STRCONC ('"yl",STRINGIMAGE i) - [['bcStrings,[42, "0.0", ylnam, 'EM]]] - ylList := [['text,:middle],:ylList] - middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YR(1) & YR(2) ") - middle := STRCONC(middle,"for BDYVAL: \newline ") - yrList := - "append"/[fc(i) for i in 1..2] where fc(i) == - yrnam := INTERN STRCONC ('"yr",STRINGIMAGE i) - [['bcStrings,[42, "0.0", yrnam, 'EM]]] - yrList := [['text,:middle],:yrList] - middle:=('"\blankline \menuitemstyle{} \tab{2} Maximum step size ") - middle := STRCONC(middle,"{\it hmax(2,m)}: \newline ") - hList := - "append"/[fd(i,m) for i in 1..2] where fd(i,m) == - labelList := - "append"/[fe(i,j) for j in 1..m] where fe(i,j) == - hnam := INTERN STRCONC ('"h",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[6, "0.0", hnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - hList := [['text,:middle],:hList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :xpList,:cList,:ylList,:yrList,:hList] - page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) - htSay '"\menuitemstyle{}\tab{2} Enter points where boundary " - htSay '"conditions are to be imposed {\it xpoint}: \newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02kefGen) - htpSetProperty(page,'m,m) - htpSetProperty(page,'match,match) - htpSetProperty(page,'k,k) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'elam,elam) - htpSetProperty(page,'delam,delam) - htpSetProperty(page,'maxit,maxit) - htpSetProperty(page,'maxfun,maxfun) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail) == - m := '5 - page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter points where boundary conditions are to be imposed ") - (text . "{\it xpoint}: \newline ") - (bcStrings (10 "0.0" xp1 F)) - (bcStrings (10 "0.1" xp2 F)) - (bcStrings (10 "4**(1/3)" xp3 F)) - (bcStrings (10 "30.0" xp4 F)) - (bcStrings (10 "30.0" xp5 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Value of {\it p} for COEFFN: \newline ") - (bcStrings (42 "1.0" c1 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Value of {\it q} for COEFFN: \newline ") - (bcStrings (42 "ELAM-X-2.0/(X*X)" c2 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Value of {\it dqdl} for COEFFN: \newline ") - (bcStrings (42 "1.0" c3 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Values of YL(1) & YL(2) for BDYVAL: \newline ") - (bcStrings (42 "XL" yl1 EM)) - (bcStrings (42 "2.0" yl2 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Values of YR(1) & YR(2) for BDYVAL: \newline ") - (bcStrings (42 "1.0" yr1 EM)) - (bcStrings (42 "-sqrt(XR-ELAM)" yr2 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Maximum step size {\it hmax(2,m)}: \newline ") - (bcStrings (6 "0.0" h11 F)) - (bcStrings (6 "0.0" h12 F)) - (bcStrings (6 "0.0" h13 F)) - (bcStrings (6 "0.0" h14 F)) - (bcStrings (6 "0.0" h15 F)) - (text . "\newline ") - (bcStrings (6 "0.0" h21 F)) - (bcStrings (6 "0.0" h22 F)) - (bcStrings (6 "0.0" h23 F)) - (bcStrings (6 "0.0" h24 F)) - (bcStrings (6 "0.0" h25 F))) - htpSetProperty(page,'m,m) - htpSetProperty(page,'match,match) - htpSetProperty(page,'k,k) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'elam,elam) - htpSetProperty(page,'delam,delam) - htpSetProperty(page,'maxit,maxit) - htpSetProperty(page,'maxfun,maxfun) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02kefGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02kefGen htPage == - m := htpProperty(htPage, 'm) - match := htpProperty(htPage, 'match) - k := htpProperty(htPage, 'k) - tol := htpProperty(htPage, 'tol) - elam := htpProperty(htPage, 'elam) - delam := htpProperty(htPage, 'delam) - maxit := htpProperty(htPage, 'maxit) - maxfun := htpProperty(htPage, 'maxfun) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..m repeat - for j in 1..2 repeat - h := STRCONC((first y).1," ") - rowList := [h,:rowList] - y := rest y - hList := [:hList,rowList] - rowList := [] - hList := reverse hList - hstring := bcwords2liststring [bcwords2liststring x for x in hList] - for i in 1..2 repeat - for j in 1..2 repeat - b := STRCONC((first y).1," ") - rowList := [b,:rowList] - y := rest y - bList := [:bList,rowList] - rowList := [] - bList := reverse bList - bstring := bcwords2liststring [bcwords2liststring x for x in bList] - for i in 1..3 repeat - c := STRCONC((first y).1," ") - cList := [c,:cList] - y := rest y - cstring := bcwords2liststring cList - while y repeat - x := STRCONC((first y).1," ") - xList := [x,:xList] - y := rest y - xstring := bcwords2liststring xList - prefix := STRCONC("d02kef([",xstring,"]::Matrix DoubleFloat, ",STRINGIMAGE m) - prefix := STRCONC(prefix,", ",STRINGIMAGE k,", ",tol,", ",STRINGIMAGE maxfun) - prefix := STRCONC(prefix,", ",STRINGIMAGE match,", ",STRINGIMAGE elam,", ") - prefix:=STRCONC(prefix,STRINGIMAGE delam,", ",hstring,", ",STRINGIMAGE maxit) - end := STRCONC(", ",STRINGIMAGE ifail,",(",cstring,"::Vector(Expression Float))::ASP10(COEFFN)") - end := STRCONC(end,", (",bstring,"::Matrix Expression Float)::ASP80('BDYVAL))") - linkGen STRCONC (prefix,end) - -d02raf() == - htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXd02raf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02raf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "D02RAF solves a two-point boundary value problem for a system ") - (text . "of {\it n} first-order ordinary differential equations ") - (text . "{\it \htbitmap{yi}'= \htbitmap{fi}(x,y)}, for {\it i} = 1,2,...,") - (text . "{\it n}, on the range [a,b] with {\it n} nonlinear boundary ") - (text . "conditions \htbitmap{gi}{\it (y(a),y(b)) = 0} for {\it i} = 1,2,") - (text . "...,{\it n} using a deferred correction technique and a Newton ") - (text . "iteration; the solution is computed on a mesh. A continuation ") - (text . "facility is provided for which a family of problems is solved ") - (text . "posed as {\it y' = f(x,y,\epsilon)} subject to the boundary ") - (text . "conditions {\it g(y(a),y(b),\epsilon) = 0}, where \epsilon ") - (text . "is the continuation parameter. The choice \epsilon = 0 should ") - (text . "define an easy problem to solve and \epsilon = 1 the problem ") - (text . "whose solution is required; a sequence of problems is solved ") - (text . "with 0 = \htbitmap{ep1} < \htbitmap{ep2} < ... \htbitmap{epp} ") - (text . "= 1 where {\it p} and the \htbitmap{epi} are chosen by D02RAF. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the number of differential equations {\it n}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "The maximum number of points in the mesh {\it mnp}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 40 mnp PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of points in the initial mesh {\it np}:") - (text . "\newline\tab{2} ") - (bcStrings (5 17 np PI)) - (text . "\blankline ") - (text . "\newline \menuitemstyle{}\tab{2} ") - (text . "\newline Number of boundary conditions involving y(a) only ") - (text . "{\it numbeg}: \newline\tab{2} ") - (bcStrings (5 2 numbeg PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "\newline Boundary conditions involving both y(a) and ") - (text . "y(b) {\it nummix}: \newline\tab{2} ") - (text . "\newline\tab{2} ") - (bcStrings (5 0 nummix PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Absolute error tolerance {\it tol}: ") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e-4" tol F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Do you wish to use an intial mesh or default values,{\it init} ") - (radioButtons init - ("" " default values" init_zero) - ("" " initial mesh" init_nonZero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "First dimension of y, {\it iy}: ") - (text . "\newline\tab{2} ") - (bcStrings (5 3 iy PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Are JACOBF & JACOBG routines being supplied, {\it ijac}:") - (radioButtons ijac - ("" " yes" ijac_nonZero) - ("" " no" ijac_zero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Continuation facility {\it deleps}:") - (text . "\newline\tab{2} ") - (bcStrings (5 "0.1" deleps F)) - (text . "\newline\tab{2} ") - (text . "Note: For 0.0 \htbitmap{great=} deleps > 1.0, continuation ") - (text . "is not used. ") - (text . "\blankline ") - (text . "\newline \tab{2} ") - (text . "Ifail is input in three components: ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it a} ") - (radioButtons afail - ("" " 0, hard failure" azero) - ("" " 1, soft failure" aone)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it b} ") - (radioButtons bfail - ("" " 1, print error messages" bone) - ("" " 0, suppress error messages" bzero)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it c} ") - (radioButtons cfail - ("" " 1, print warning messages" cone) - ("" " 0, suppress warning messages" czero))) - htMakeDoneButton('"Continue", 'd02rafSolve) - htShowPage() - -d02rafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - mnp := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) - objValUnwrap htpLabelSpadValue(htPage, 'mnp) - np := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) - objValUnwrap htpLabelSpadValue(htPage, 'np) - numbeg := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'numbeg) - objValUnwrap htpLabelSpadValue(htPage, 'numbeg) - nummix := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nummix) - objValUnwrap htpLabelSpadValue(htPage, 'nummix) - tol := htpLabelInputString(htPage,'tol) - mesh := htpButtonValue(htPage,'init) - init := - mesh = 'init_zero => '0 - '1 - iy := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iy) - objValUnwrap htpLabelSpadValue(htPage, 'iy) - jacob := htpButtonValue(htPage,'ijac) - ijac := - jacob = 'ijac_zero => '0 - '1 - deleps := htpLabelInputString(htPage,'deleps) - lwork := mnp*(3*n*n + 6*n +2) +4*n*n + 3*n - liwork := - ijac = 0 => mnp*(2*n +1) + n*n + 4*n +2 - mnp*(2*n +1) + n - aerror := htpButtonValue(htPage,'afail) - afail := - aerror = 'azero => '0 - '1 - berror := htpButtonValue(htPage,'bfail) - bfail := - berror = 'bone => '1 - '0 - cerror := htpButtonValue(htPage,'cfail) - cfail := - cerror = 'cone => '1 - '0 - ifail := 100*cfail + 10*bfail + afail - (n = '3 and init = '0 and iy = '3 and nummix = '0 and numbeg = '2 and np = '17 and mnp = '40) => d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail) - init = '1 => d02rafCopOut() - funcList := - "append"/[fa(i) for i in 1..n] where fa(i) == - prefix := ('"\newline {\em Function f") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") - fnam := INTERN STRCONC ('"f",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, fnam, 'EM]]] - middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the functions ") - middle := STRCONC(middle,'"\htbitmap{gi} below ") - middle := STRCONC(middle,'"as functions of YA[i] and YB[i]: \newline ") - gList := - "append"/[fb(i) for i in 1..n] where fb(i) == - prefix := ('"\newline {\em Function g") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - fnc := STRCONC ('"YA[",STRINGIMAGE i ,"]") - gnam := INTERN STRCONC ('"g",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, fnc, gnam, 'EM]]] - gList := [['text,:middle],:gList] - mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the array ") - mid := STRCONC(mid,'"{\it x(mnp)}: \newline ") - xList := - "append"/[fc(i) for i in 1..mnp] where fc(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[4, 0, xnam, 'F]]] - xList := [['text,:mid],:xList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain S (String)) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:gList,:xList] - page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions \htbitmap{fi} (i.e. the derivatives) below " - htSay '"as functions of Y[1]...Y[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'d02rafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'numbeg,numbeg) - htpSetProperty(page,'nummix,nummix) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'init,init) - htpSetProperty(page,'iy,iy) - htpSetProperty(page,'ijac,ijac) - htpSetProperty(page,'deleps,deleps) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail) == - n := '3 - page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions \htbitmap{fi} (i.e. the derivatives) below ") - (text . "as functions of Y[1]...Y[n]: ") - (text . "\newline {\em Function f1:} \space{1}") - (bcStrings (44 "Y[2]" f1 EM)) - (text . "\newline {\em Function f2:} \space{1}") - (bcStrings (44 "Y[3]" f2 EM)) - (text . "\newline {\em Function f3:} \space{1}") - (bcStrings (44 "-Y[1]*Y[3] - 2*EPS*(1-Y[2]*Y[2])" f3 EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions \htbitmap{gi} below ") - (text . "as functions of YA[i] and YB[i]: ") - (text . "\newline {\em Function g1:} \space{1}") - (bcStrings (44 "YA[1]" g1 EM)) - (text . "\newline {\em Function g2:} \space{1}") - (bcStrings (44 "YA[2]" g2 EM)) - (text . "\newline {\em Function g3:} \space{1}") - (bcStrings (44 "YB[2] -1" g3 EM)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the array {\it x(mnp)}: \newline ") - (bcStrings (4 "0.0" x1 F)) - (bcStrings (4 "0.0" x2 F)) - (bcStrings (4 "0.0" x3 F)) - (bcStrings (4 "0.0" x4 F)) - (bcStrings (4 "0.0" x5 F)) - (bcStrings (4 "0.0" x6 F)) - (bcStrings (4 "0.0" x7 F)) - (bcStrings (4 "0.0" x8 F)) - (bcStrings (4 "0.0" x9 F)) - (bcStrings (4 "0.0" x10 F)) - (bcStrings (4 "0.0" x11 F)) - (bcStrings (4 "0.0" x12 F)) - (bcStrings (4 "0.0" x13 F)) - (bcStrings (4 "0.0" x14 F)) - (bcStrings (4 "0.0" x15 F)) - (bcStrings (4 "0.0" x16 F)) - (bcStrings (4 "10.0" x17 F)) - (bcStrings (4 "0.0" x18 F)) - (bcStrings (4 "0.0" x19 F)) - (bcStrings (4 "0.0" x20 F)) - (bcStrings (4 "0.0" x21 F)) - (bcStrings (4 "0.0" x22 F)) - (bcStrings (4 "0.0" x23 F)) - (bcStrings (4 "0.0" x24 F)) - (bcStrings (4 "0.0" x25 F)) - (bcStrings (4 "0.0" x26 F)) - (bcStrings (4 "0.0" x27 F)) - (bcStrings (4 "0.0" x28 F)) - (bcStrings (4 "0.0" x29 F)) - (bcStrings (4 "0.0" x30 F)) - (bcStrings (4 "0.0" x31 F)) - (bcStrings (4 "0.0" x32 F)) - (bcStrings (4 "0.0" x33 F)) - (bcStrings (4 "0.0" x34 F)) - (bcStrings (4 "0.0" x35 F)) - (bcStrings (4 "0.0" x36 F)) - (bcStrings (4 "0.0" x37 F)) - (bcStrings (4 "0.0" x38 F)) - (bcStrings (4 "0.0" x39 F)) - (bcStrings (4 "0.0" x40 F))) - htpSetProperty(page,'n,n) - htpSetProperty(page,'mnp,mnp) - htpSetProperty(page,'np,np) - htpSetProperty(page,'numbeg,numbeg) - htpSetProperty(page,'nummix,nummix) - htpSetProperty(page,'tol,tol) - htpSetProperty(page,'init,init) - htpSetProperty(page,'iy,iy) - htpSetProperty(page,'ijac,ijac) - htpSetProperty(page,'deleps,deleps) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'ifail,ifail) - htMakeDoneButton('"Continue",'d02rafGen) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -d02rafGen htPage == - n := htpProperty(htPage, 'n) - mnp := htpProperty(htPage, 'mnp) - np := htpProperty(htPage, 'np) - numbeg := htpProperty(htPage, 'numbeg) - nummix := htpProperty(htPage, 'nummix) - tol := htpProperty(htPage, 'tol) - init := htpProperty(htPage, 'init) - iy := htpProperty(htPage, 'iy) - ijac := htpProperty(htPage, 'ijac) - deleps := htpProperty(htPage, 'deleps) - lwork := htpProperty(htPage, 'lwork) - liwork := htpProperty(htPage, 'liwork) - ifail := htpProperty(htPage, 'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..mnp repeat - xtemp := STRCONC((first y).1," ") - xList := [xtemp,:xList] - y := rest y - xstring := bcwords2liststring xList - for i in 1..n repeat - gtemp := STRCONC((first y).1," ") - gList := [gtemp,:gList] - y := rest y - gstring := bcwords2liststring gList - while y repeat - f := STRCONC((first y).1," ") - fList := [f,:fList] - y := rest y - fstring := bcwords2liststring fList - prefix := STRCONC("d02raf(",STRINGIMAGE n,", ",STRINGIMAGE mnp,", ") - prefix := STRCONC(prefix,STRINGIMAGE numbeg,", ",STRINGIMAGE nummix,", ") - prefix := STRCONC(prefix,tol,", ",STRINGIMAGE init,", ",STRINGIMAGE iy,", ") - middle:= STRCONC(STRINGIMAGE ijac,", ",STRINGIMAGE lwork,", ") - middle := STRCONC(middle,STRINGIMAGE liwork,", ",STRINGIMAGE np,", [") - middle := STRCONC(middle,xstring,"],[[0.0 for i in 1..", STRINGIMAGE mnp) - middle := STRCONC(middle,"] for j in 1..",STRINGIMAGE iy,"]") - middle := STRCONC(middle,":: Matrix DoubleFloat,",STRINGIMAGE deleps,", ") - middle := STRCONC(middle,STRINGIMAGE ifail,", (",fstring,"::Vector ") - middle := STRCONC(middle,"Expression Float)::ASP41('FCN,'JACOBF,'JACEPS),(") - middle := STRCONC(middle,gstring,"::Vector Expression Float)::ASP42('G,'JACOBG,") - middle := STRCONC(middle,"'JACGEP))") - linkGen STRCONC(prefix,middle) - - -d02rafCopOut() == - htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\blankline ") - (text . "{\center{\em Hyperdoc interface not available for initial mesh}}") - (text . "\newline ") - (text . "{\center{\em Please use the command line.}}")) - htMakeDoneButton('"Continue",'d02raf) - htShowPage() -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-d02.lisp.pamphlet b/src/interp/nag-d02.lisp.pamphlet new file mode 100644 index 0000000..0644ef6 --- /dev/null +++ b/src/interp/nag-d02.lisp.pamphlet @@ -0,0 +1,5820 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp nag-d02.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= + +(IN-PACKAGE "BOOT" ) + +;d02bbf() == +; htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXd02bbf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "D02BBF integrates a system of {\it n} ordinary differential ") +; (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") +; (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") +; (text . "conditions using a Runge-Kutta-Merson method; the solution ") +; (text . "may be output at specified points.") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Initial value of {\it x}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 "0.0" x F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "End of integration range {\it xend}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 "8.0" xend F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of differential equations {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 3 n PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Tolerance required {\it tol}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "0.0001" tol F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Error control indicator {\it irelab}:") +; (radioButtons irelab +; ("" " 0, mixed" mix) +; ("" " 1, absolute" abs) +; ("" " 2, relative" rel)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'd02bbfSolve) +; htShowPage() + +(DEFUN |d02bbf| () + (PROGN + (|htInitPage| + (MAKESTRING + "D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXd02bbf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "D02BBF integrates a system of {\\it n} ordinary differential ") + (|text| + . "equations, {\\htbitmap{yi}}' = {\\htbitmap{fi}}(x,y), for ") + (|text| + . "{\\it i} = 1,2,...,{\\it n}, over a range with given initial ") + (|text| + . "conditions using a Runge-Kutta-Merson method; the solution ") + (|text| . "may be output at specified points.") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Initial value of {\\it x}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 "0.0" |x| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "End of integration range {\\it xend}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 "8.0" |xend| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of differential equations {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 3 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "\\newline Tolerance required {\\it tol}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "0.0001" |tol| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Error control indicator {\\it irelab}:") + (|radioButtons| |irelab| ("" " 0, mixed" |mix|) + ("" " 1, absolute" |abs|) ("" " 2, relative" |rel|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02bbfSolve|) + (|htShowPage|))) + +;d02bbfSolve htPage == +; x := htpLabelInputString(htPage,'x) +; xend := htpLabelInputString(htPage,'xend) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; tol := htpLabelInputString(htPage,'tol) +; control := htpButtonValue(htPage,'irelab) +; irelab := +; control = 'mix => '0 +; control = 'abs => '1 +; '2 +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'minusOne => '-1 +; '1 +; n = '3 => d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail) +; funcList := +; "append"/[fa(i) for i in 1..n] where fa(i) == +; prefix := ('"\newline {\em Function ") +; prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") +; funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") +; nam := INTERN STRCONC ('"n",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] +; middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") +; middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline \tab{2}") +; yList := +; "append"/[fb(i) for i in 1..n] where fb(i) == +; ynam := INTERN STRCONC ('"u",STRINGIMAGE i) +; [['bcStrings,[6, 0, ynam, 'F]]] +; yList := [['text,:middle],:yList] +; mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") +; mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline \tab{2}") +; vList := [['bcStrings,[30, "0", 'out, 'EM]]] +; vList := [['text,:mid],:vList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList,:yList,:vList] +; page := htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the functions (i.e. the derivatives) below " +; htSay '"as functions of Y[1]...Y[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'d02bbfGen) +; htpSetProperty(page,'x,x) +; htpSetProperty(page,'xend,xend) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'irelab,irelab) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02bbfSolve,fa| (|i|) + (PROG (|prefix| |funct| |nam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline {\\em Function ")) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |i|) + (MAKESTRING ":} \\space{1}"))) + (SPADLET |funct| + (STRCONC (MAKESTRING "Y[") (STRINGIMAGE |i|) '])) + (SPADLET |nam| + (INTERN (STRCONC (MAKESTRING "n") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS |funct| + (CONS |nam| (CONS 'EM NIL)))) + NIL)) + NIL))))))) + +(DEFUN |d02bbfSolve,fb| (|i|) + (PROG (|ynam|) + (RETURN + (SEQ (SPADLET |ynam| + (INTERN (STRCONC (MAKESTRING "u") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |ynam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02bbfSolve| (|htPage|) + (PROG (|x| |xend| |n| |tol| |control| |irelab| |error| |ifail| + |funcList| |middle| |yList| |mid| |vList| |equationPart| + |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |x| (|htpLabelInputString| |htPage| '|x|)) + (SPADLET |xend| (|htpLabelInputString| |htPage| '|xend|)) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |tol| (|htpLabelInputString| |htPage| '|tol|)) + (SPADLET |control| (|htpButtonValue| |htPage| '|irelab|)) + (SPADLET |irelab| + (COND + ((BOOT-EQUAL |control| '|mix|) '0) + ((BOOT-EQUAL |control| '|abs|) '1) + ('T '2))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND + ((BOOT-EQUAL |error| '|minusOne|) '-1) + ('T '1))) + (COND + ((BOOT-EQUAL |n| '3) + (|d02bbfDefaultSolve| |htPage| |x| |xend| |tol| + |irelab| |ifail|)) + ('T + (SPADLET |funcList| + (PROG (G166080) + (SPADLET G166080 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166080) + (SEQ (EXIT + (SETQ G166080 + (APPEND G166080 + (|d02bbfSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the initial ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "values of \\htbitmap{yi}: \\newline \\tab{2}"))) + (SPADLET |yList| + (PROG (G166088) + (SPADLET G166088 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166088) + (SEQ (EXIT + (SETQ G166088 + (APPEND G166088 + (|d02bbfSolve,fb| |i|))))))))) + (SPADLET |yList| + (CONS (CONS '|text| |middle|) |yList|)) + (SPADLET |mid| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Intermediate values of {\\it x}")) + (SPADLET |mid| + (STRCONC |mid| + (MAKESTRING + " at which \\htbitmap{yi} is required: \\newline \\tab{2}"))) + (SPADLET |vList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 30 + (CONS '|0| + (CONS '|out| (CONS 'EM NIL)))) + NIL)) + NIL)) + (SPADLET |vList| (CONS (CONS '|text| |mid|) |vList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |funcList| + (APPEND |yList| |vList|)))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the functions (i.e. the derivatives) below ")) + (|htSay| (MAKESTRING "as functions of Y[1]...Y[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|d02bbfGen|) + (|htpSetProperty| |page| '|x| |x|) + (|htpSetProperty| |page| '|xend| |xend|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|irelab| |irelab|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;d02bbfDefaultSolve(htPage,x,xend,tol,irelab,ifail) == +; n := '3 +; page := htInitPage('"D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the functions (i.e. the derivatives) below ") +; (text . "as functions of Y[1]...Y[n]: ") +; (text . "\newline ") +; (text . "\newline {\em Function 1:} \space{1}") +; (bcStrings (44 "tan(Y[3])" f1 EM)) +; (text . "\newline {\em Function 2:} \space{1}") +; (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) +; (text . "\newline {\em Function 3:} \space{1}") +; (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the initial values of \htbitmap{yi}:") +; (text . "\newline \tab{2}") +; (bcStrings (8 "0.0" y1 EM)) +; (bcStrings (8 "0.5" y2 EM)) +; (bcStrings (8 "\%pi*0.2" y3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Intermediate values of {\it x} at which \htbitmap{yi} is required:") +; (text . "\newline \tab{2}") +; (bcStrings (30 "1,2,3,4,5,6,7,8" out EM))) +; htpSetProperty(page,'x,x) +; htpSetProperty(page,'xend,xend) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'irelab,irelab) +; htpSetProperty(page,'ifail,ifail) +; htMakeDoneButton('"Continue",'d02bbfGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02bbfDefaultSolve| + (|htPage| |x| |xend| |tol| |irelab| |ifail|) + (PROG (|n| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02BBF - ODEs, IVP, Runge-Kutta-Merson method, over a range, intermediate output") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the functions (i.e. the derivatives) below ") + (|text| . "as functions of Y[1]...Y[n]: ") + (|text| . "\\newline ") + (|text| . "\\newline {\\em Function 1:} \\space{1}") + (|bcStrings| (44 "tan(Y[3])" |f1| EM)) + (|text| . "\\newline {\\em Function 2:} \\space{1}") + (|bcStrings| + (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" |f2| + EM)) + (|text| . "\\newline {\\em Function 3:} \\space{1}") + (|bcStrings| (44 "-0.032/(Y[2]**2)" |f3| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the initial values of \\htbitmap{yi}:") + (|text| . "\\newline \\tab{2}") + (|bcStrings| (8 "0.0" |y1| EM)) + (|bcStrings| (8 "0.5" |y2| EM)) + (|bcStrings| (8 "\\%pi*0.2" |y3| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Intermediate values of {\\it x} at which \\htbitmap{yi} is required:") + (|text| . "\\newline \\tab{2}") + (|bcStrings| (30 "1,2,3,4,5,6,7,8" |out| EM)))) + (|htpSetProperty| |page| '|x| |x|) + (|htpSetProperty| |page| '|xend| |xend|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|irelab| |irelab|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02bbfGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;d02bbfGen htPage == +; x := htpProperty(htPage, 'x) +; xend := htpProperty(htPage, 'xend) +; n := htpProperty(htPage, 'n) +; tol := htpProperty(htPage, 'tol) +; irelab := htpProperty(htPage, 'irelab) +; ifail := htpProperty(htPage, 'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; outp := ((first y).1) +; oList := [outp,:oList] +; y := rest y +; ostring := bcwords2liststring oList +; -- This is distictly horrible! OUTP is a comma-seperated string so we +; -- count up the commas to see how many elements it has. We return this +; -- quantity plus 1 since the ASP OUTPUT is always called at least once. +; numberOfPoints := +; ZEROP LENGTH(outp) => 1 +; 2+COUNT(CHARACTER(44),outp) +; for i in 1..n repeat +; ytemp := STRCONC((first y).1," ") +; yList := [ytemp,:yList] +; y := rest y +; ystring := bcwords2liststring yList +; while y repeat +; f := STRCONC((first y).1," ") +; fList := [f,:fList] +; y := rest y +; fstring := bcwords2liststring fList +; prefix := STRCONC("d02bbf(", xend,", ", STRINGIMAGE numberOfPoints, ", ",STRINGIMAGE n,", ",STRINGIMAGE irelab) +; prefix := STRCONC(prefix,", ",x,", [", ystring,"],",tol) +; prefix := STRCONC(prefix,", ",STRINGIMAGE ifail,",(") +; end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",ostring) +; end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") +; linkGen STRCONC(prefix,end) + +(DEFUN |d02bbfGen| (|htPage|) + (PROG (|x| |xend| |n| |tol| |irelab| |ifail| |alist| |outp| |oList| + |ostring| |numberOfPoints| |ytemp| |yList| |ystring| |f| + |fList| |y| |fstring| |prefix| |end|) + (RETURN + (SEQ (PROGN + (SPADLET |x| (|htpProperty| |htPage| '|x|)) + (SPADLET |xend| (|htpProperty| |htPage| '|xend|)) + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |tol| (|htpProperty| |htPage| '|tol|)) + (SPADLET |irelab| (|htpProperty| |htPage| '|irelab|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |outp| (ELT (CAR |y|) 1)) + (SPADLET |oList| (CONS |outp| |oList|)) + (SPADLET |y| (CDR |y|)) + (SPADLET |ostring| (|bcwords2liststring| |oList|)) + (SPADLET |numberOfPoints| + (COND + ((ZEROP (LENGTH |outp|)) 1) + ('T (PLUS 2 (COUNT (CHARACTER 44) |outp|))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |ytemp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |yList| (CONS |ytemp| |yList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |ystring| (|bcwords2liststring| |yList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |f| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |fList| (CONS |f| |fList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |fstring| (|bcwords2liststring| |fList|)) + (SPADLET |prefix| + (STRCONC '|d02bbf(| |xend| '|, | + (STRINGIMAGE |numberOfPoints|) '|, | + (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |irelab|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | |x| '|, [| |ystring| + '|],| |tol|)) + (SPADLET |prefix| + (STRCONC |prefix| '|, | (STRINGIMAGE |ifail|) + '|,(|)) + (SPADLET |end| + (STRCONC |fstring| + '|::Vector Expression Float)::ASP7('FCN),(| + |ostring|)) + (SPADLET |end| + (STRCONC |end| + '|::Vector MachineFloat)::ASP8('OUTPUT))|)) + (|linkGen| (STRCONC |prefix| |end|))))))) + +;d02bhf() == +; htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXd02bhf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bhf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "D02BHF integrates a system of {\it n} ordinary differential ") +; (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") +; (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") +; (text . "conditions using a Runge-Kutta-Merson method until a specified ") +; (text . "function {\em g(x,y)} of the solution is zero. ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Initial value of {\it x}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 "0.0" x F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "End of integration range {\it xend}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 "10.0" xend F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of differential equations {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 3 n PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Tolerance required {\it tol}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "0.0001" tol F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Error control indicator {\it irelab}:") +; (radioButtons irelab +; ("" " 0, mixed" mix) +; ("" " 1, absolute" abs) +; ("" " 2, relative" rel)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Upper bound on size of the interval {\it hmax}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "0.0" hmax F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'd02bhfSolve) +; htShowPage() + +(DEFUN |d02bhf| () + (PROGN + (|htInitPage| + (MAKESTRING + "D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXd02bhf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02bhf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "D02BHF integrates a system of {\\it n} ordinary differential ") + (|text| + . "equations, {\\htbitmap{yi}}' = {\\htbitmap{fi}}(x,y), for ") + (|text| + . "{\\it i} = 1,2,...,{\\it n}, over a range with given initial ") + (|text| + . "conditions using a Runge-Kutta-Merson method until a specified ") + (|text| . "function {\\em g(x,y)} of the solution is zero. ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Initial value of {\\it x}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 "0.0" |x| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "End of integration range {\\it xend}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 "10.0" |xend| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of differential equations {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 3 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "\\newline Tolerance required {\\it tol}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "0.0001" |tol| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Error control indicator {\\it irelab}:") + (|radioButtons| |irelab| ("" " 0, mixed" |mix|) + ("" " 1, absolute" |abs|) ("" " 2, relative" |rel|)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| + . "\\newline Upper bound on size of the interval {\\it hmax}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "0.0" |hmax| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02bhfSolve|) + (|htShowPage|))) + +;d02bhfSolve htPage == +; x := htpLabelInputString(htPage,'x) +; xend := htpLabelInputString(htPage,'xend) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; tol := htpLabelInputString(htPage,'tol) +; control := htpButtonValue(htPage,'irelab) +; irelab := +; control = 'mix => '0 +; control = 'abs => '1 +; '2 +; hmax := htpLabelInputString(htPage,'hmax) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '3 => d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail) +; funcList := +; "append"/[fa(i) for i in 1..n] where fa(i) == +; prefix := ('"\newline {\em Function ") +; prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") +; funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") +; nam := INTERN STRCONC ('"n",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] +; middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") +; middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") +; yList := +; "append"/[fb(i) for i in 1..n] where fb(i) == +; ynam := INTERN STRCONC ('"u",STRINGIMAGE i) +; [['bcStrings,[6, 0, ynam, 'F]]] +; yList := [['text,:middle],:yList] +; mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") +; mid := STRCONC(mid,'"{\em g(x,y)}: \newline ") +; vList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] +; vList := [['text,:mid],:vList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList,:yList,:vList] +; page := htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " +; htSay '"as functions of Y[1]...Y[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'d02bhfGen) +; htpSetProperty(page,'x,x) +; htpSetProperty(page,'xend,xend) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'irelab,irelab) +; htpSetProperty(page,'hmax,hmax) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02bhfSolve,fa| (|i|) + (PROG (|prefix| |funct| |nam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline {\\em Function ")) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |i|) + (MAKESTRING ":} \\space{1}"))) + (SPADLET |funct| + (STRCONC (MAKESTRING "Y[") (STRINGIMAGE |i|) '])) + (SPADLET |nam| + (INTERN (STRCONC (MAKESTRING "n") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS |funct| + (CONS |nam| (CONS 'EM NIL)))) + NIL)) + NIL))))))) + +(DEFUN |d02bhfSolve,fb| (|i|) + (PROG (|ynam|) + (RETURN + (SEQ (SPADLET |ynam| + (INTERN (STRCONC (MAKESTRING "u") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |ynam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02bhfSolve| (|htPage|) + (PROG (|x| |xend| |n| |tol| |control| |irelab| |hmax| |error| |ifail| + |funcList| |middle| |yList| |mid| |vList| |equationPart| + |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |x| (|htpLabelInputString| |htPage| '|x|)) + (SPADLET |xend| (|htpLabelInputString| |htPage| '|xend|)) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |tol| (|htpLabelInputString| |htPage| '|tol|)) + (SPADLET |control| (|htpButtonValue| |htPage| '|irelab|)) + (SPADLET |irelab| + (COND + ((BOOT-EQUAL |control| '|mix|) '0) + ((BOOT-EQUAL |control| '|abs|) '1) + ('T '2))) + (SPADLET |hmax| (|htpLabelInputString| |htPage| '|hmax|)) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '3) + (|d02bhfDefaultSolve| |htPage| |x| |xend| |tol| + |irelab| |hmax| |ifail|)) + ('T + (SPADLET |funcList| + (PROG (G166200) + (SPADLET G166200 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166200) + (SEQ (EXIT + (SETQ G166200 + (APPEND G166200 + (|d02bhfSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the initial ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "values of \\htbitmap{yi}: \\newline "))) + (SPADLET |yList| + (PROG (G166208) + (SPADLET G166208 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166208) + (SEQ (EXIT + (SETQ G166208 + (APPEND G166208 + (|d02bhfSolve,fb| |i|))))))))) + (SPADLET |yList| + (CONS (CONS '|text| |middle|) |yList|)) + (SPADLET |mid| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the function below ")) + (SPADLET |mid| + (STRCONC |mid| + (MAKESTRING + "{\\em g(x,y)}: \\newline "))) + (SPADLET |vList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 30 + (CONS (MAKESTRING "Y[1]") + (CONS '|g| (CONS 'EM NIL)))) + NIL)) + NIL)) + (SPADLET |vList| (CONS (CONS '|text| |mid|) |vList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |funcList| + (APPEND |yList| |vList|)))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the functions (i.e. the derivatives) below \\htbitmap{fi} ")) + (|htSay| (MAKESTRING "as functions of Y[1]...Y[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|d02bhfGen|) + (|htpSetProperty| |page| '|x| |x|) + (|htpSetProperty| |page| '|xend| |xend|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|irelab| |irelab|) + (|htpSetProperty| |page| '|hmax| |hmax|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;d02bhfDefaultSolve(htPage,x,xend,tol,irelab,hmax,ifail) == +; n := '3 +; page := htInitPage('"D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") +; (text . "as functions of Y[1]...Y[n]: ") +; (text . "\newline {\em Function 1:} \space{1}") +; (bcStrings (44 "tan(Y[3])" f1 EM)) +; (text . "\newline {\em Function 2:} \space{1}") +; (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) +; (text . "\newline {\em Function 3:} \space{1}") +; (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the initial values of \htbitmap{yi}:") +; (text . "\newline ") +; (bcStrings (8 "0.5" y1 EM)) +; (bcStrings (8 "0.5" y2 EM)) +; (bcStrings (8 "\%pi*0.2" y3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the function below {\em g(x,y)}: ") +; (text . "\newline ") +; (bcStrings (30 "Y[1]" g EM))) +; htpSetProperty(page,'x,x) +; htpSetProperty(page,'xend,xend) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'irelab,irelab) +; htpSetProperty(page,'hmax,hmax) +; htpSetProperty(page,'ifail,ifail) +; htMakeDoneButton('"Continue",'d02bhfGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02bhfDefaultSolve| + (|htPage| |x| |xend| |tol| |irelab| |hmax| |ifail|) + (PROG (|n| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02BHF - ODEs, IVP, Runge-Kutta-Merson method, until function of solution is zero") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the functions (i.e. the derivatives) below \\htbitmap{fi} ") + (|text| . "as functions of Y[1]...Y[n]: ") + (|text| . "\\newline {\\em Function 1:} \\space{1}") + (|bcStrings| (44 "tan(Y[3])" |f1| EM)) + (|text| . "\\newline {\\em Function 2:} \\space{1}") + (|bcStrings| + (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" |f2| + EM)) + (|text| . "\\newline {\\em Function 3:} \\space{1}") + (|bcStrings| (44 "-0.032/(Y[2]**2)" |f3| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the initial values of \\htbitmap{yi}:") + (|text| . "\\newline ") (|bcStrings| (8 "0.5" |y1| EM)) + (|bcStrings| (8 "0.5" |y2| EM)) + (|bcStrings| (8 "\\%pi*0.2" |y3| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the function below {\\em g(x,y)}: ") + (|text| . "\\newline ") (|bcStrings| (30 "Y[1]" |g| EM)))) + (|htpSetProperty| |page| '|x| |x|) + (|htpSetProperty| |page| '|xend| |xend|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|irelab| |irelab|) + (|htpSetProperty| |page| '|hmax| |hmax|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02bhfGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;d02bhfGen htPage == +; x := htpProperty(htPage, 'x) +; xend := htpProperty(htPage, 'xend) +; n := htpProperty(htPage, 'n) +; tol := htpProperty(htPage, 'tol) +; irelab := htpProperty(htPage, 'irelab) +; hmax := htpProperty(htPage, 'hmax) +; ifail := htpProperty(htPage, 'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; g := ((first y).1) +; y := rest y +; for i in 1..n repeat +; ytemp := STRCONC((first y).1," ") +; yList := [ytemp,:yList] +; y := rest y +; ystring := bcwords2liststring yList +; while y repeat +; f := STRCONC((first y).1," ") +; fList := [f,:fList] +; y := rest y +; fstring := bcwords2liststring fList +; prefix := STRCONC("d02bhf(", xend,", ",STRINGIMAGE n,", ",STRINGIMAGE irelab) +; mid := STRCONC(", ",hmax,", ",x,", [", ystring,"],") +; mid := STRCONC(mid,tol,", ",STRINGIMAGE ifail,",(",g) +; mid := STRCONC(mid,"::Expression Float)::ASP9('G),(") +; end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN))") +; linkGen STRCONC(prefix,mid,end) + +(DEFUN |d02bhfGen| (|htPage|) + (PROG (|x| |xend| |n| |tol| |irelab| |hmax| |ifail| |alist| |g| + |ytemp| |yList| |ystring| |f| |fList| |y| |fstring| + |prefix| |mid| |end|) + (RETURN + (SEQ (PROGN + (SPADLET |x| (|htpProperty| |htPage| '|x|)) + (SPADLET |xend| (|htpProperty| |htPage| '|xend|)) + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |tol| (|htpProperty| |htPage| '|tol|)) + (SPADLET |irelab| (|htpProperty| |htPage| '|irelab|)) + (SPADLET |hmax| (|htpProperty| |htPage| '|hmax|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |g| (ELT (CAR |y|) 1)) + (SPADLET |y| (CDR |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |ytemp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |yList| (CONS |ytemp| |yList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |ystring| (|bcwords2liststring| |yList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |f| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |fList| (CONS |f| |fList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |fstring| (|bcwords2liststring| |fList|)) + (SPADLET |prefix| + (STRCONC '|d02bhf(| |xend| '|, | + (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |irelab|))) + (SPADLET |mid| + (STRCONC '|, | |hmax| '|, | |x| '|, [| |ystring| + '|],|)) + (SPADLET |mid| + (STRCONC |mid| |tol| '|, | (STRINGIMAGE |ifail|) + '|,(| |g|)) + (SPADLET |mid| + (STRCONC |mid| + '|::Expression Float)::ASP9('G),(|)) + (SPADLET |end| + (STRCONC |fstring| + '|::Vector Expression Float)::ASP7('FCN))|)) + (|linkGen| (STRCONC |prefix| |mid| |end|))))))) + +; +;d02cjf() == +; htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXd02cjf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02cjf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "D02CJF integrates a system of {\it n} ordinary differential ") +; (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for ") +; (text . "{\it i} = 1,2,...,{\it n}, over a range with given initial ") +; (text . "conditions using an Adams method until a specified ") +; (text . "function {\em g(x,y)} of the solution is zero; the solution may ") +; (text . "be output at specified points. \blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Initial value of {\it x}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 "0.0" x F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "End of integration range {\it xend}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 "10.0" xend F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of differential equations {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 3 n PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Tolerance required {\it tol}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "0.0001" tol F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Type of error test used {\it relabs}:") +; (radioButtons relabs +; ("" " D, default (mixed)" mix) +; ("" " A, absolute" abs) +; ("" " R, relative" rel)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'd02cjfSolve) +; htShowPage() + +(DEFUN |d02cjf| () + (PROGN + (|htInitPage| + (MAKESTRING + "D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXd02cjf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02cjf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "D02CJF integrates a system of {\\it n} ordinary differential ") + (|text| + . "equations, {\\htbitmap{yi}}' = {\\htbitmap{fi}}(x,y), for ") + (|text| + . "{\\it i} = 1,2,...,{\\it n}, over a range with given initial ") + (|text| + . "conditions using an Adams method until a specified ") + (|text| + . "function {\\em g(x,y)} of the solution is zero; the solution may ") + (|text| . "be output at specified points. \\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Initial value of {\\it x}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 "0.0" |x| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "End of integration range {\\it xend}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 "10.0" |xend| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of differential equations {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 3 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "\\newline Tolerance required {\\it tol}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "0.0001" |tol| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Type of error test used {\\it relabs}:") + (|radioButtons| |relabs| ("" " D, default (mixed)" |mix|) + ("" " A, absolute" |abs|) ("" " R, relative" |rel|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02cjfSolve|) + (|htShowPage|))) + +;d02cjfSolve htPage == +; x := htpLabelInputString(htPage,'x) +; xend := htpLabelInputString(htPage,'xend) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; tol := htpLabelInputString(htPage,'tol) +; control := htpButtonValue(htPage,'relabs) +; relabs := +; control = 'mix => '"D" +; control = 'abs => '"A" +; '"R" +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '3 => d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail) +; funcList := +; "append"/[fa(i) for i in 1..n] where fa(i) == +; prefix := ('"\newline {\em Function ") +; prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") +; funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") +; nam := INTERN STRCONC ('"n",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] +; middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") +; middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") +; yList := +; "append"/[fb(i) for i in 1..n] where fb(i) == +; ynam := INTERN STRCONC ('"u",STRINGIMAGE i) +; [['bcStrings,[6, 0, ynam, 'F]]] +; yList := [['text,:middle],:yList] +; mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") +; mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ") +; vList := [['bcStrings,[30, "2,4", 'out, 'EM]]] +; vList := [['text,:mid],:vList] +; midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") +; midd := STRCONC(midd,'"{\em g(x,y)}: \newline ") +; uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] +; uList := [['text,:midd],:uList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList,:yList,:vList,:uList] +; page := htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " +; htSay '"as functions of Y[1]...Y[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'d02cjfGen) +; htpSetProperty(page,'x,x) +; htpSetProperty(page,'xend,xend) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'relabs,relabs) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02cjfSolve,fa| (|i|) + (PROG (|prefix| |funct| |nam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline {\\em Function ")) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |i|) + (MAKESTRING ":} \\space{1}"))) + (SPADLET |funct| + (STRCONC (MAKESTRING "Y[") (STRINGIMAGE |i|) '])) + (SPADLET |nam| + (INTERN (STRCONC (MAKESTRING "n") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS |funct| + (CONS |nam| (CONS 'EM NIL)))) + NIL)) + NIL))))))) + +(DEFUN |d02cjfSolve,fb| (|i|) + (PROG (|ynam|) + (RETURN + (SEQ (SPADLET |ynam| + (INTERN (STRCONC (MAKESTRING "u") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |ynam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02cjfSolve| (|htPage|) + (PROG (|x| |xend| |n| |tol| |control| |relabs| |error| |ifail| + |funcList| |middle| |yList| |mid| |vList| |midd| |uList| + |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |x| (|htpLabelInputString| |htPage| '|x|)) + (SPADLET |xend| (|htpLabelInputString| |htPage| '|xend|)) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |tol| (|htpLabelInputString| |htPage| '|tol|)) + (SPADLET |control| (|htpButtonValue| |htPage| '|relabs|)) + (SPADLET |relabs| + (COND + ((BOOT-EQUAL |control| '|mix|) + (MAKESTRING "D")) + ((BOOT-EQUAL |control| '|abs|) + (MAKESTRING "A")) + ('T (MAKESTRING "R")))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '3) + (|d02cjfDefaultSolve| |htPage| |x| |xend| |tol| + |relabs| |ifail|)) + ('T + (SPADLET |funcList| + (PROG (G166318) + (SPADLET G166318 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166318) + (SEQ (EXIT + (SETQ G166318 + (APPEND G166318 + (|d02cjfSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the initial ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "values of \\htbitmap{yi}: \\newline "))) + (SPADLET |yList| + (PROG (G166326) + (SPADLET G166326 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166326) + (SEQ (EXIT + (SETQ G166326 + (APPEND G166326 + (|d02cjfSolve,fb| |i|))))))))) + (SPADLET |yList| + (CONS (CONS '|text| |middle|) |yList|)) + (SPADLET |mid| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Intermediate values of {\\it x}")) + (SPADLET |mid| + (STRCONC |mid| + (MAKESTRING + " at which \\htbitmap{yi} is required: \\newline "))) + (SPADLET |vList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 30 + (CONS '|2,4| + (CONS '|out| (CONS 'EM NIL)))) + NIL)) + NIL)) + (SPADLET |vList| (CONS (CONS '|text| |mid|) |vList|)) + (SPADLET |midd| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the function below ")) + (SPADLET |midd| + (STRCONC |midd| + (MAKESTRING + "{\\em g(x,y)}: \\newline "))) + (SPADLET |uList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 30 + (CONS (MAKESTRING "Y[1]") + (CONS '|g| (CONS 'EM NIL)))) + NIL)) + NIL)) + (SPADLET |uList| (CONS (CONS '|text| |midd|) |uList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |funcList| + (APPEND |yList| + (APPEND |vList| |uList|))))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the functions (i.e. the derivatives) below \\htbitmap{fi} ")) + (|htSay| (MAKESTRING "as functions of Y[1]...Y[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|d02cjfGen|) + (|htpSetProperty| |page| '|x| |x|) + (|htpSetProperty| |page| '|xend| |xend|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|relabs| |relabs|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;d02cjfDefaultSolve(htPage,x,xend,tol,relabs,ifail) == +; n := '3 +; page := htInitPage('"D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") +; (text . "as functions of Y[1]...Y[n]: ") +; (text . "\newline {\em Function 1:} \space{1}") +; (bcStrings (44 "tan(Y[3])" f1 EM)) +; (text . "\newline {\em Function 2:} \space{1}") +; (bcStrings (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" f2 EM)) +; (text . "\newline {\em Function 3:} \space{1}") +; (bcStrings (44 "-0.032/(Y[2]**2)" f3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the initial values of \htbitmap{yi}:") +; (text . "\newline ") +; (bcStrings (8 "0.5" y1 EM)) +; (bcStrings (8 "0.5" y2 EM)) +; (bcStrings (8 "\%pi*0.2" y3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} Intermediate") +; (text . " values of {\it x} at which \htbitmap{yi} is required:") +; (text . "\newline ") +; (bcStrings (30 "2,4,6,8" out EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the function below {\em g(x,y)}: ") +; (text . "\newline ") +; (bcStrings (30 "Y[1]" g EM))) +; htpSetProperty(page,'x,x) +; htpSetProperty(page,'xend,xend) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'relabs,relabs) +; htpSetProperty(page,'ifail,ifail) +; htMakeDoneButton('"Continue",'d02cjfGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02cjfDefaultSolve| + (|htPage| |x| |xend| |tol| |relabs| |ifail|) + (PROG (|n| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02CJF - ODEs, IVP, Adams method, until function of solution is zero, intermediate output") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the functions (i.e. the derivatives) below \\htbitmap{fi} ") + (|text| . "as functions of Y[1]...Y[n]: ") + (|text| . "\\newline {\\em Function 1:} \\space{1}") + (|bcStrings| (44 "tan(Y[3])" |f1| EM)) + (|text| . "\\newline {\\em Function 2:} \\space{1}") + (|bcStrings| + (44 "-0.032*tan(Y[3])/Y[2] -0.02*Y[2]/cos(Y[3])" |f2| + EM)) + (|text| . "\\newline {\\em Function 3:} \\space{1}") + (|bcStrings| (44 "-0.032/(Y[2]**2)" |f3| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the initial values of \\htbitmap{yi}:") + (|text| . "\\newline ") (|bcStrings| (8 "0.5" |y1| EM)) + (|bcStrings| (8 "0.5" |y2| EM)) + (|bcStrings| (8 "\\%pi*0.2" |y3| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2} Intermediate") + (|text| + . " values of {\\it x} at which \\htbitmap{yi} is required:") + (|text| . "\\newline ") + (|bcStrings| (30 "2,4,6,8" |out| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the function below {\\em g(x,y)}: ") + (|text| . "\\newline ") (|bcStrings| (30 "Y[1]" |g| EM)))) + (|htpSetProperty| |page| '|x| |x|) + (|htpSetProperty| |page| '|xend| |xend|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|relabs| |relabs|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02cjfGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;d02cjfGen htPage == +; x := htpProperty(htPage, 'x) +; xend := htpProperty(htPage, 'xend) +; n := htpProperty(htPage, 'n) +; tol := htpProperty(htPage, 'tol) +; relabs := htpProperty(htPage, 'relabs) +; ifail := htpProperty(htPage, 'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; g := ((first y).1) +; y := rest y +; outp := ((first y).1) +; oList := [outp,:oList] +; ostring := bcwords2liststring oList +; -- This is distictly horrible! OUTP is a comma-seperated string so we +; -- count up the commas to see how many elements it has. We return this +; -- quantity plus 1 since the ASP OUTPUT is always called at least once. +; numberOfPoints := +; ZEROP LENGTH(outp) => 1 +; 2+COUNT(CHARACTER(44),outp) +; y := rest y +; for i in 1..n repeat +; ytemp := STRCONC((first y).1," ") +; yList := [ytemp,:yList] +; y := rest y +; ystring := bcwords2liststring yList +; while y repeat +; f := STRCONC((first y).1," ") +; fList := [f,:fList] +; y := rest y +; fstring := bcwords2liststring fList +; prefix := STRCONC("d02cjf(",xend,", ",STRINGIMAGE numberOfPoints ,", ", STRINGIMAGE n,", ",tol,",_"",relabs) +; mid := STRCONC("_", ",x ,", [", ystring,"],",STRINGIMAGE ifail) +; mid := STRCONC(mid,",(",g,"::Expression Float)::ASP9('G),(",fstring) +; end := STRCONC("::Vector Expression Float)::ASP7('FCN),(",ostring) +; end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") +; linkGen STRCONC(prefix,mid,end) + +(DEFUN |d02cjfGen| (|htPage|) + (PROG (|x| |xend| |n| |tol| |relabs| |ifail| |alist| |g| |outp| + |oList| |ostring| |numberOfPoints| |ytemp| |yList| + |ystring| |f| |fList| |y| |fstring| |prefix| |mid| |end|) + (RETURN + (SEQ (PROGN + (SPADLET |x| (|htpProperty| |htPage| '|x|)) + (SPADLET |xend| (|htpProperty| |htPage| '|xend|)) + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |tol| (|htpProperty| |htPage| '|tol|)) + (SPADLET |relabs| (|htpProperty| |htPage| '|relabs|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |g| (ELT (CAR |y|) 1)) + (SPADLET |y| (CDR |y|)) + (SPADLET |outp| (ELT (CAR |y|) 1)) + (SPADLET |oList| (CONS |outp| |oList|)) + (SPADLET |ostring| (|bcwords2liststring| |oList|)) + (SPADLET |numberOfPoints| + (COND + ((ZEROP (LENGTH |outp|)) 1) + ('T (PLUS 2 (COUNT (CHARACTER 44) |outp|))))) + (SPADLET |y| (CDR |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |ytemp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |yList| (CONS |ytemp| |yList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |ystring| (|bcwords2liststring| |yList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |f| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |fList| (CONS |f| |fList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |fstring| (|bcwords2liststring| |fList|)) + (SPADLET |prefix| + (STRCONC '|d02cjf(| |xend| '|, | + (STRINGIMAGE |numberOfPoints|) '|, | + (STRINGIMAGE |n|) '|, | |tol| '|,"| + |relabs|)) + (SPADLET |mid| + (STRCONC '|", | |x| '|, [| |ystring| '|],| + (STRINGIMAGE |ifail|))) + (SPADLET |mid| + (STRCONC |mid| '|,(| |g| + '|::Expression Float)::ASP9('G),(| + |fstring|)) + (SPADLET |end| + (STRCONC '|::Vector Expression Float)::ASP7('FCN),(| + |ostring|)) + (SPADLET |end| + (STRCONC |end| + '|::Vector MachineFloat)::ASP8('OUTPUT))|)) + (|linkGen| (STRCONC |prefix| |mid| |end|))))))) + +; +;d02ejf() == +; htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXd02ejf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02ejf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "D02EJF integrates a system of {\em n} ordinary differential ") +; (text . "equations, {\htbitmap{yi}}' = {\htbitmap{fi}}(x,y), for {\it i} ") +; (text . "= 1,,2,...,{\it n}, over a range with given initial conditions") +; (text . " using backward differentiation formulae until a specified ") +; (text . "function {\em g(x,y)} of the solution is zero; the solution may ") +; (text . "be output at specified points. \blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Initial value of {\it x}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 "0.0" x F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "End of integration range {\it xend}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 "10.0" xend F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of differential equations {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 3 n PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Tolerance required {\it tol}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "0.0001" tol F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Type of error test used {\it relabs}:") +; (radioButtons relabs +; ("" " D, default (mixed)" mix) +; ("" " A, absolute" abs) +; ("" " R, relative" rel)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'd02ejfSolve) +; htShowPage() + +(DEFUN |d02ejf| () + (PROGN + (|htInitPage| + (MAKESTRING + "D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXd02ejf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02ejf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "D02EJF integrates a system of {\\em n} ordinary differential ") + (|text| + . "equations, {\\htbitmap{yi}}' = {\\htbitmap{fi}}(x,y), for {\\it i} ") + (|text| + . "= 1,,2,...,{\\it n}, over a range with given initial conditions") + (|text| + . " using backward differentiation formulae until a specified ") + (|text| + . "function {\\em g(x,y)} of the solution is zero; the solution may ") + (|text| . "be output at specified points. \\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Initial value of {\\it x}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 "0.0" |x| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "End of integration range {\\it xend}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 "10.0" |xend| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of differential equations {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 3 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "\\newline Tolerance required {\\it tol}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "0.0001" |tol| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Type of error test used {\\it relabs}:") + (|radioButtons| |relabs| ("" " D, default (mixed)" |mix|) + ("" " A, absolute" |abs|) ("" " R, relative" |rel|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02ejfSolve|) + (|htShowPage|))) + +;d02ejfSolve htPage == +; x := htpLabelInputString(htPage,'x) +; xend := htpLabelInputString(htPage,'xend) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; tol := htpLabelInputString(htPage,'tol) +; control := htpButtonValue(htPage,'relabs) +; relabs := +; control = 'mix => '"D" +; control = 'abs => '"A" +; '"R" +; iw := (n + 12) * n + 50 +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '3 => d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail) +; funcList := +; "append"/[fa(i) for i in 1..n] where fa(i) == +; prefix := ('"\newline {\em Function ") +; prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") +; funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") +; nam := INTERN STRCONC ('"n",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] +; middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial ") +; middle := STRCONC(middle,'"values of \htbitmap{yi}: \newline ") +; yList := +; "append"/[fb(i) for i in 1..n] where fb(i) == +; ynam := INTERN STRCONC ('"u",STRINGIMAGE i) +; [['bcStrings,[6, 0, ynam, 'F]]] +; yList := [['text,:middle],:yList] +; mid:= ('"\blankline \menuitemstyle{} \tab{2} Intermediate values of {\it x}") +; mid := STRCONC(mid,'" at which \htbitmap{yi} is required: \newline ") +; vList := [['bcStrings,[30, "2,4,6,8", 'out, 'EM]]] +; vList := [['text,:mid],:vList] +; midd := ('"\blankline \menuitemstyle{} \tab{2} Enter the function below ") +; midd := STRCONC(midd,'"{\em g(x,y)}: \newline ") +; uList := [['bcStrings,[30, '"Y[1]", 'g, 'EM]]] +; uList := [['text,:midd],:uList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList,:yList,:vList,:uList] +; page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the functions (i.e. the derivatives) below \htbitmap{fi} " +; htSay '"as functions of Y[1]...Y[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htSay '"\blankline {\em Note:} PEDERV is automatically generated using the vector " +; htSay '"of derivatives given above. " +; htMakeDoneButton('"Continue",'d02ejfGen) +; htpSetProperty(page,'x,x) +; htpSetProperty(page,'xend,xend) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'relabs,relabs) +; htpSetProperty(page,'iw,iw) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02ejfSolve,fa| (|i|) + (PROG (|prefix| |funct| |nam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline {\\em Function ")) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |i|) + (MAKESTRING ":} \\space{1}"))) + (SPADLET |funct| + (STRCONC (MAKESTRING "Y[") (STRINGIMAGE |i|) '])) + (SPADLET |nam| + (INTERN (STRCONC (MAKESTRING "n") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS |funct| + (CONS |nam| (CONS 'EM NIL)))) + NIL)) + NIL))))))) + +(DEFUN |d02ejfSolve,fb| (|i|) + (PROG (|ynam|) + (RETURN + (SEQ (SPADLET |ynam| + (INTERN (STRCONC (MAKESTRING "u") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |ynam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02ejfSolve| (|htPage|) + (PROG (|x| |xend| |n| |tol| |control| |relabs| |iw| |error| |ifail| + |funcList| |middle| |yList| |mid| |vList| |midd| |uList| + |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |x| (|htpLabelInputString| |htPage| '|x|)) + (SPADLET |xend| (|htpLabelInputString| |htPage| '|xend|)) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |tol| (|htpLabelInputString| |htPage| '|tol|)) + (SPADLET |control| (|htpButtonValue| |htPage| '|relabs|)) + (SPADLET |relabs| + (COND + ((BOOT-EQUAL |control| '|mix|) + (MAKESTRING "D")) + ((BOOT-EQUAL |control| '|abs|) + (MAKESTRING "A")) + ('T (MAKESTRING "R")))) + (SPADLET |iw| (PLUS (TIMES (PLUS |n| 12) |n|) 50)) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '3) + (|d02ejfDefaultSolve| |htPage| |x| |xend| |tol| + |relabs| |iw| |ifail|)) + ('T + (SPADLET |funcList| + (PROG (G166444) + (SPADLET G166444 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166444) + (SEQ (EXIT + (SETQ G166444 + (APPEND G166444 + (|d02ejfSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the initial ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "values of \\htbitmap{yi}: \\newline "))) + (SPADLET |yList| + (PROG (G166452) + (SPADLET G166452 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166452) + (SEQ (EXIT + (SETQ G166452 + (APPEND G166452 + (|d02ejfSolve,fb| |i|))))))))) + (SPADLET |yList| + (CONS (CONS '|text| |middle|) |yList|)) + (SPADLET |mid| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Intermediate values of {\\it x}")) + (SPADLET |mid| + (STRCONC |mid| + (MAKESTRING + " at which \\htbitmap{yi} is required: \\newline "))) + (SPADLET |vList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 30 + (CONS '|2,4,6,8| + (CONS '|out| (CONS 'EM NIL)))) + NIL)) + NIL)) + (SPADLET |vList| (CONS (CONS '|text| |mid|) |vList|)) + (SPADLET |midd| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the function below ")) + (SPADLET |midd| + (STRCONC |midd| + (MAKESTRING + "{\\em g(x,y)}: \\newline "))) + (SPADLET |uList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 30 + (CONS (MAKESTRING "Y[1]") + (CONS '|g| (CONS 'EM NIL)))) + NIL)) + NIL)) + (SPADLET |uList| (CONS (CONS '|text| |midd|) |uList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |funcList| + (APPEND |yList| + (APPEND |vList| |uList|))))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the functions (i.e. the derivatives) below \\htbitmap{fi} ")) + (|htSay| (MAKESTRING "as functions of Y[1]...Y[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htSay| (MAKESTRING + "\\blankline {\\em Note:} PEDERV is automatically generated using the vector ")) + (|htSay| (MAKESTRING "of derivatives given above. ")) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|d02ejfGen|) + (|htpSetProperty| |page| '|x| |x|) + (|htpSetProperty| |page| '|xend| |xend|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|relabs| |relabs|) + (|htpSetProperty| |page| '|iw| |iw|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;d02ejfDefaultSolve(htPage,x,xend,tol,relabs,iw,ifail) == +; n := '3 +; page := htInitPage('"D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the functions (i.e. the derivatives) below \htbitmap{fi} ") +; (text . "as functions of Y[1]...Y[n]: ") +; (text . "\newline {\em Function 1:} \space{1}") +; (bcStrings (44 "-0.04*Y[1]+1.0E4*Y[2]*Y[3]" f1 EM)) +; (text . "\newline {\em Function 2:} \space{1}") +; (bcStrings (44 "0.04*Y[1]-1.0E4*Y[2]*Y[3]-3.0E7*Y[2]*Y[2]" f2 EM)) +; (text . "\newline {\em Function 3:} \space{1}") +; (bcStrings (44 "3.0E7*Y[2]*Y[2]" f3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the initial values of \htbitmap{yi}:") +; (text . "\newline ") +; (bcStrings (8 "1.0" y1 EM)) +; (bcStrings (8 "0.0" y2 EM)) +; (bcStrings (8 "0.0" y3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} Intermediate") +; (text . " values of {\it x} at which \htbitmap{yi} is required:") +; (text . "\newline ") +; (bcStrings (30 "2,4,6,8" out EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the function below {\em g(x,y)}: ") +; (text . "\newline ") +; (bcStrings (30 "Y[1]-0.9" g EM)) +; (text . "\blankline ") +; (text . "{\em Note:} PEDERV is automatically generated using the vector ") +; (text . "of derivatives given above. ")) +; htpSetProperty(page,'x,x) +; htpSetProperty(page,'xend,xend) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'relabs,relabs) +; htpSetProperty(page,'iw,iw) +; htpSetProperty(page,'ifail,ifail) +; htMakeDoneButton('"Continue",'d02ejfGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02ejfDefaultSolve| + (|htPage| |x| |xend| |tol| |relabs| |iw| |ifail|) + (PROG (|n| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02EJF - ODEs, stiff IVP, BDF method, until function of solution is zero, intermediate output") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the functions (i.e. the derivatives) below \\htbitmap{fi} ") + (|text| . "as functions of Y[1]...Y[n]: ") + (|text| . "\\newline {\\em Function 1:} \\space{1}") + (|bcStrings| (44 "-0.04*Y[1]+1.0E4*Y[2]*Y[3]" |f1| EM)) + (|text| . "\\newline {\\em Function 2:} \\space{1}") + (|bcStrings| + (44 "0.04*Y[1]-1.0E4*Y[2]*Y[3]-3.0E7*Y[2]*Y[2]" |f2| + EM)) + (|text| . "\\newline {\\em Function 3:} \\space{1}") + (|bcStrings| (44 "3.0E7*Y[2]*Y[2]" |f3| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the initial values of \\htbitmap{yi}:") + (|text| . "\\newline ") (|bcStrings| (8 "1.0" |y1| EM)) + (|bcStrings| (8 "0.0" |y2| EM)) + (|bcStrings| (8 "0.0" |y3| EM)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2} Intermediate") + (|text| + . " values of {\\it x} at which \\htbitmap{yi} is required:") + (|text| . "\\newline ") + (|bcStrings| (30 "2,4,6,8" |out| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the function below {\\em g(x,y)}: ") + (|text| . "\\newline ") + (|bcStrings| (30 "Y[1]-0.9" |g| EM)) + (|text| . "\\blankline ") + (|text| + . "{\\em Note:} PEDERV is automatically generated using the vector ") + (|text| . "of derivatives given above. "))) + (|htpSetProperty| |page| '|x| |x|) + (|htpSetProperty| |page| '|xend| |xend|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|relabs| |relabs|) + (|htpSetProperty| |page| '|iw| |iw|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02ejfGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;d02ejfGen htPage == +; x := htpProperty(htPage, 'x) +; xend := htpProperty(htPage, 'xend) +; n := htpProperty(htPage, 'n) +; tol := htpProperty(htPage, 'tol) +; relabs := htpProperty(htPage, 'relabs) +; iw := htpProperty(htPage, 'iw) +; ifail := htpProperty(htPage, 'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; g := ((first y).1) +; y := rest y +; outp := ((first y).1) +; oList := [outp,:oList] +; ostring := bcwords2liststring oList +; -- This is distictly horrible! OUTP is a comma-seperated string so we +; -- count up the commas to see how many elements it has. We return this +; -- quantity plus 1 since the ASP OUTPUT is always called at least once. +; numberOfPoints := +; ZEROP LENGTH(outp) => 1 +; 2+COUNT(CHARACTER(44),outp) +; y := rest y +; for i in 1..n repeat +; ytemp := STRCONC((first y).1," ") +; yList := [ytemp,:yList] +; y := rest y +; ystring := bcwords2liststring yList +; while y repeat +; f := STRCONC((first y).1," ") +; fList := [f,:fList] +; y := rest y +; fstring := bcwords2liststring fList +; prefix := STRCONC("d02ejf(",xend,", ",STRINGIMAGE numberOfPoints,", ", STRINGIMAGE n,",_"",relabs,"_", ") +; mid:=STRCONC(STRINGIMAGE iw,", ",x ,", [", ystring,"], ",tol,", ") +; mid := STRCONC(mid,STRINGIMAGE ifail,",(",g,"::Expression Float)::ASP9(G),(") +; end := STRCONC(fstring,"::Vector Expression Float)::ASP7('FCN),(",fstring) +; end := STRCONC(end,"::Vector Expression Float)::ASP31('PEDERV),(",ostring) +; end := STRCONC(end,"::Vector MachineFloat)::ASP8('OUTPUT))") +; linkGen STRCONC(prefix,mid,end) + +(DEFUN |d02ejfGen| (|htPage|) + (PROG (|x| |xend| |n| |tol| |relabs| |iw| |ifail| |alist| |g| |outp| + |oList| |ostring| |numberOfPoints| |ytemp| |yList| + |ystring| |f| |fList| |y| |fstring| |prefix| |mid| |end|) + (RETURN + (SEQ (PROGN + (SPADLET |x| (|htpProperty| |htPage| '|x|)) + (SPADLET |xend| (|htpProperty| |htPage| '|xend|)) + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |tol| (|htpProperty| |htPage| '|tol|)) + (SPADLET |relabs| (|htpProperty| |htPage| '|relabs|)) + (SPADLET |iw| (|htpProperty| |htPage| '|iw|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (SPADLET |g| (ELT (CAR |y|) 1)) + (SPADLET |y| (CDR |y|)) + (SPADLET |outp| (ELT (CAR |y|) 1)) + (SPADLET |oList| (CONS |outp| |oList|)) + (SPADLET |ostring| (|bcwords2liststring| |oList|)) + (SPADLET |numberOfPoints| + (COND + ((ZEROP (LENGTH |outp|)) 1) + ('T (PLUS 2 (COUNT (CHARACTER 44) |outp|))))) + (SPADLET |y| (CDR |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |ytemp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |yList| (CONS |ytemp| |yList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |ystring| (|bcwords2liststring| |yList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |f| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |fList| (CONS |f| |fList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |fstring| (|bcwords2liststring| |fList|)) + (SPADLET |prefix| + (STRCONC '|d02ejf(| |xend| '|, | + (STRINGIMAGE |numberOfPoints|) '|, | + (STRINGIMAGE |n|) '|,"| |relabs| '|", |)) + (SPADLET |mid| + (STRCONC (STRINGIMAGE |iw|) '|, | |x| '|, [| + |ystring| '|], | |tol| '|, |)) + (SPADLET |mid| + (STRCONC |mid| (STRINGIMAGE |ifail|) '|,(| |g| + '|::Expression Float)::ASP9(G),(|)) + (SPADLET |end| + (STRCONC |fstring| + '|::Vector Expression Float)::ASP7('FCN),(| + |fstring|)) + (SPADLET |end| + (STRCONC |end| + '|::Vector Expression Float)::ASP31('PEDERV),(| + |ostring|)) + (SPADLET |end| + (STRCONC |end| + '|::Vector MachineFloat)::ASP8('OUTPUT))|)) + (|linkGen| (STRCONC |prefix| |mid| |end|))))))) + +;d02gaf() == +; htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXd02gaf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gaf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "D02GAF solves a two-point boundary value problem for a system ") +; (text . "of n ODEs \center{\htbitmap{d02gaf},} for i = 1,2,...,n, on ") +; (text . "the range [a,b] with assigned boundary conditions using a ") +; (text . "deferred correction technique and a Newton iteration; ") +; (text . "the solution is computed on a mesh. ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the number of equations in the system {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 3 n PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Left hand boundary point {\it a}: ") +; (text . "\tab{32} \menuitemstyle{}\tab{34} ") +; (text . "Right hand boundary {\it b}:") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "0.0" a F)) +; (text . "\tab{34} ") +; (bcStrings (10 "10.0" b F)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Max number of mesh points {\it mnp}:") +; (text . "\tab{32} \menuitemstyle{}\tab{34} ") +; (text . "Number of points {\it np} ({\it np} = 0 or {\it np} ") +; (text . "\htbitmap{great=} 4): ") +; (text . "\newline\tab{2} ") +; (bcStrings (10 64 mnp PI)) +; (text . "\tab{34} ") +; (bcStrings (10 26 np PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Accuracy required {\it tol}:") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "1.0e-3" tol F)) +; (text . "\blankline ") +; (text . "\newline \tab{2} ") +; (text . "Ifail is input in three components: ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it a} ") +; (radioButtons afail +; ("" " 0, hard failure" azero) +; ("" " 1, soft failure" aone)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it b} ") +; (radioButtons bfail +; ("" " 1, print error messages" bone) +; ("" " 0, suppress error messages" bzero)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it c} ") +; (radioButtons cfail +; ("" " 1, print warning messages" cone) +; ("" " 0, suppress warning messages" czero))) +; htMakeDoneButton('"Continue", 'd02gafSolve) +; htShowPage() + +(DEFUN |d02gaf| () + (PROGN + (|htInitPage| + (MAKESTRING + "D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXd02gaf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gaf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "D02GAF solves a two-point boundary value problem for a system ") + (|text| + . "of n ODEs \\center{\\htbitmap{d02gaf},} for i = 1,2,...,n, on ") + (|text| + . "the range [a,b] with assigned boundary conditions using a ") + (|text| + . "deferred correction technique and a Newton iteration; ") + (|text| . "the solution is computed on a mesh. ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the number of equations in the system {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 3 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "\\newline Left hand boundary point {\\it a}: ") + (|text| . "\\tab{32} \\menuitemstyle{}\\tab{34} ") + (|text| . "Right hand boundary {\\it b}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "0.0" |a| F)) (|text| . "\\tab{34} ") + (|bcStrings| (10 "10.0" |b| F)) (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "\\newline Max number of mesh points {\\it mnp}:") + (|text| . "\\tab{32} \\menuitemstyle{}\\tab{34} ") + (|text| + . "Number of points {\\it np} ({\\it np} = 0 or {\\it np} ") + (|text| . "\\htbitmap{great=} 4): ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 64 |mnp| PI)) (|text| . "\\tab{34} ") + (|bcStrings| (10 26 |np| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Accuracy required {\\it tol}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "1.0e-3" |tol| F)) (|text| . "\\blankline ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Ifail is input in three components: ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") (|text| . "{\\it a} ") + (|radioButtons| |afail| ("" " 0, hard failure" |azero|) + ("" " 1, soft failure" |aone|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") (|text| . "{\\it b} ") + (|radioButtons| |bfail| + ("" " 1, print error messages" |bone|) + ("" " 0, suppress error messages" |bzero|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") (|text| . "{\\it c} ") + (|radioButtons| |cfail| + ("" " 1, print warning messages" |cone|) + ("" " 0, suppress warning messages" |czero|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02gafSolve|) + (|htShowPage|))) + +;d02gafSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; a := htpLabelInputString(htPage,'a) +; b := htpLabelInputString(htPage,'b) +; mnp := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) +; objValUnwrap htpLabelSpadValue(htPage, 'mnp) +; np := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) +; objValUnwrap htpLabelSpadValue(htPage, 'np) +; lw := mnp * (3*n*n + 6*n + 2) + 4*n*n + 4*n +; liw := mnp * (2*n + 1) + n*n + 4*n + 2 +; tol := htpLabelInputString(htPage,'tol) +; aerror := htpButtonValue(htPage,'afail) +; afail := +; aerror = 'azero => '0 +; '1 +; berror := htpButtonValue(htPage,'bfail) +; bfail := +; berror = 'bone => '1 +; '0 +; cerror := htpButtonValue(htPage,'cfail) +; cfail := +; cerror = 'cone => '1 +; '0 +; ifail := 100*cfail + 10*bfail + afail +; n = '3 => d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) +; funcList := +; "append"/[fa(i) for i in 1..n] where fa(i) == +; prefix := ('"\newline {\em Function ") +; prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") +; funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") +; nam := INTERN STRCONC ('"n",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] +; middle := ('"\blankline \menuitemstyle{} \tab{2} Enter known or estimated ") +; middle := STRCONC(middle,'"values of \htbitmap{yi} at a and b, ") +; middle := STRCONC(middle,"{\it U(n,2)}. [\htbitmap{yi}(a) in the first ") +; middle := STRCONC(middle,"column, \htbitmap{yi}(b) in the second.] ") +; middle := STRCONC(middle,"\newline ") +; uList := +; "append"/[fb(i) for i in 1..n] where fb(i) == +; labelList := +; "append"/[fc(i,j) for j in 1..2] where fc(i,j) == +; unam := INTERN STRCONC ('"u",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[6, 0, unam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; uList := [['text,:middle],:uList] +; mid := ('"\blankline \menuitemstyle{} \tab{2} Enter {\it V(n,2)}. ") +; mid := STRCONC(mid,'"If U(i,j) is known V(i,j) ") +; mid := STRCONC(mid,'"= 0.0, else V(i,j) = 1.0. \newline ") +; vList := +; "append"/[fd(i) for i in 1..n] where fd(i) == +; labelList := +; "append"/[fe(i,j) for j in 1..2] where fe(i,j) == +; vnam := INTERN STRCONC ('"v",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[6, 0, vnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; vList := [['text,:mid],:vList] +; xList := +; "append"/[ff(i) for i in 1..mnp] where ff(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; [['bcStrings,[8, "0.0", xnam, 'F]]] +; end := ('"\blankline \menuitemstyle{} \tab{2} Enter the initial mesh ") +; end := STRCONC(end,'"{\it X(mnp)}: \newline ") +; xList := [['text,:end],:xList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList,:uList,:vList,:xList] +; page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the functions (i.e. the derivatives) below as functions of " +; htSay '"Y[1]...Y[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'d02gafGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'a,a) +; htpSetProperty(page,'b,b) +; htpSetProperty(page,'mnp,mnp) +; htpSetProperty(page,'np,np) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02gafSolve,fa| (|i|) + (PROG (|prefix| |funct| |nam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline {\\em Function ")) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |i|) + (MAKESTRING ":} \\space{1}"))) + (SPADLET |funct| + (STRCONC (MAKESTRING "Y[") (STRINGIMAGE |i|) '])) + (SPADLET |nam| + (INTERN (STRCONC (MAKESTRING "n") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS |funct| + (CONS |nam| (CONS 'EM NIL)))) + NIL)) + NIL))))))) + +(DEFUN |d02gafSolve,fc| (|i| |j|) + (PROG (|unam|) + (RETURN + (SEQ (SPADLET |unam| + (INTERN (STRCONC (MAKESTRING "u") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |unam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02gafSolve,fb| (|i|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166576) + (SPADLET G166576 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| 2) G166576) + (SEQ (EXIT (SETQ G166576 + (APPEND G166576 + (|d02gafSolve,fc| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |d02gafSolve,fe| (|i| |j|) + (PROG (|vnam|) + (RETURN + (SEQ (SPADLET |vnam| + (INTERN (STRCONC (MAKESTRING "v") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |vnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02gafSolve,fd| (|i|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166599) + (SPADLET G166599 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| 2) G166599) + (SEQ (EXIT (SETQ G166599 + (APPEND G166599 + (|d02gafSolve,fe| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |d02gafSolve,ff| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS '|0.0| + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02gafSolve| (|htPage|) + (PROG (|n| |a| |b| |mnp| |np| |lw| |liw| |tol| |aerror| |afail| + |berror| |bfail| |cerror| |cfail| |ifail| |funcList| + |middle| |uList| |mid| |vList| |end| |xList| + |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |a| (|htpLabelInputString| |htPage| '|a|)) + (SPADLET |b| (|htpLabelInputString| |htPage| '|b|)) + (SPADLET |mnp| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|mnp|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|mnp|))))) + (SPADLET |np| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|np|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|np|))))) + (SPADLET |lw| + (PLUS (PLUS (TIMES |mnp| + (PLUS + (PLUS + (TIMES (TIMES 3 |n|) |n|) + (TIMES 6 |n|)) + 2)) + (TIMES (TIMES 4 |n|) |n|)) + (TIMES 4 |n|))) + (SPADLET |liw| + (PLUS (PLUS (PLUS (TIMES |mnp| + (PLUS (TIMES 2 |n|) 1)) + (TIMES |n| |n|)) + (TIMES 4 |n|)) + 2)) + (SPADLET |tol| (|htpLabelInputString| |htPage| '|tol|)) + (SPADLET |aerror| (|htpButtonValue| |htPage| '|afail|)) + (SPADLET |afail| + (COND + ((BOOT-EQUAL |aerror| '|azero|) '0) + ('T '1))) + (SPADLET |berror| (|htpButtonValue| |htPage| '|bfail|)) + (SPADLET |bfail| + (COND + ((BOOT-EQUAL |berror| '|bone|) '1) + ('T '0))) + (SPADLET |cerror| (|htpButtonValue| |htPage| '|cfail|)) + (SPADLET |cfail| + (COND + ((BOOT-EQUAL |cerror| '|cone|) '1) + ('T '0))) + (SPADLET |ifail| + (PLUS (PLUS (TIMES 100 |cfail|) + (TIMES 10 |bfail|)) + |afail|)) + (COND + ((BOOT-EQUAL |n| '3) + (|d02gafDefaultSolve| |htPage| |a| |b| |mnp| |np| |lw| + |liw| |tol| |ifail|)) + ('T + (SPADLET |funcList| + (PROG (G166622) + (SPADLET G166622 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166622) + (SEQ (EXIT + (SETQ G166622 + (APPEND G166622 + (|d02gafSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter known or estimated ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "values of \\htbitmap{yi} at a and b, "))) + (SPADLET |middle| + (STRCONC |middle| + '|{\\it U(n,2)}. [\\htbitmap{yi}(a) in the first |)) + (SPADLET |middle| + (STRCONC |middle| + '|column, \\htbitmap{yi}(b) in the second.] |)) + (SPADLET |middle| (STRCONC |middle| '|\\newline |)) + (SPADLET |uList| + (PROG (G166630) + (SPADLET G166630 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166630) + (SEQ (EXIT + (SETQ G166630 + (APPEND G166630 + (|d02gafSolve,fb| |i|))))))))) + (SPADLET |uList| + (CONS (CONS '|text| |middle|) |uList|)) + (SPADLET |mid| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter {\\it V(n,2)}. ")) + (SPADLET |mid| + (STRCONC |mid| + (MAKESTRING + "If U(i,j) is known V(i,j) "))) + (SPADLET |mid| + (STRCONC |mid| + (MAKESTRING + "= 0.0, else V(i,j) = 1.0. \\newline "))) + (SPADLET |vList| + (PROG (G166638) + (SPADLET G166638 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166638) + (SEQ (EXIT + (SETQ G166638 + (APPEND G166638 + (|d02gafSolve,fd| |i|))))))))) + (SPADLET |vList| (CONS (CONS '|text| |mid|) |vList|)) + (SPADLET |xList| + (PROG (G166646) + (SPADLET G166646 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |mnp|) G166646) + (SEQ (EXIT + (SETQ G166646 + (APPEND G166646 + (|d02gafSolve,ff| |i|))))))))) + (SPADLET |end| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the initial mesh ")) + (SPADLET |end| + (STRCONC |end| + (MAKESTRING + "{\\it X(mnp)}: \\newline "))) + (SPADLET |xList| (CONS (CONS '|text| |end|) |xList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |funcList| + (APPEND |uList| + (APPEND |vList| |xList|))))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the functions (i.e. the derivatives) below as functions of ")) + (|htSay| (MAKESTRING "Y[1]...Y[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|d02gafGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|a| |a|) + (|htpSetProperty| |page| '|b| |b|) + (|htpSetProperty| |page| '|mnp| |mnp|) + (|htpSetProperty| |page| '|np| |np|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;d02gafDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) == +; n := '3 +; page := htInitPage('"D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem", nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the functions (i.e. the derivatives) below ") +; (text . "as functions of Y[1]...Y[n]: ") +; (text . "\newline ") +; (text . "\newline {\em Function 1:} \space{1}") +; (bcStrings (42 "Y[2]" f1 EM)) +; (text . "\newline {\em Function 2:} \space{1}") +; (bcStrings (42 "Y[3]" f2 EM)) +; (text . "\newline {\em Function 3:} \space{1}") +; (bcStrings (42 "-Y[1]*Y[3]-0.2*(1-Y[2]*Y[2])" f3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter known or estimated values of \htbitmap{yi} at a and b,") +; (text . " {\it U(n,2)}. ") +; (text . " [\htbitmap{yi}(a) in the first column, \htbitmap{yi}(b) ") +; (text . "in the second.] \newline ") +; (bcStrings (6 "0" u11 F)) +; (bcStrings (6 "10" u21 F)) +; (text . "\newline ") +; (bcStrings (6 "0" u12 F)) +; (bcStrings (6 "1" u22 F)) +; (text . "\newline ") +; (bcStrings (6 "0" u13 F)) +; (bcStrings (6 "0" u23 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter {\it V(n,2)}. ") +; (text . "If U(i,j) is known V(i,j) = 0.0, else V(i,j) = 1.0: \newline") +; (bcStrings (6 "0.0" v11 F)) +; (bcStrings (6 "1.0" v21 F)) +; (text . "\newline ") +; (bcStrings (6 "0.0" v12 F)) +; (bcStrings (6 "0.0" v22 F)) +; (text . "\newline ") +; (bcStrings (6 "1.0" v13 F)) +; (bcStrings (6 "1.0" v23 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the initial mesh {\it X(mnp)}: ") +; (text . "\newline ") +; (bcStrings (8 "0.0" x1 F)) +; (bcStrings (8 "0.4" x2 F)) +; (bcStrings (8 "0.8" x3 F)) +; (bcStrings (8 "1.2" x4 F)) +; (bcStrings (8 "1.6" x5 F)) +; (bcStrings (8 "2.0" x6 F)) +; (bcStrings (8 "2.4" x7 F)) +; (bcStrings (8 "2.8" x8 F)) +; (bcStrings (8 "3.2" x9 F)) +; (bcStrings (8 "3.6" x10 F)) +; (bcStrings (8 "4.0" x11 F)) +; (bcStrings (8 "4.4" x12 F)) +; (bcStrings (8 "4.8" x13 F)) +; (bcStrings (8 "5.2" x14 F)) +; (bcStrings (8 "5.6" x15 F)) +; (bcStrings (8 "6.0" x16 F)) +; (bcStrings (8 "6.4" x17 F)) +; (bcStrings (8 "6.8" x18 F)) +; (bcStrings (8 "7.2" x19 F)) +; (bcStrings (8 "7.6" x20 F)) +; (bcStrings (8 "8.0" x21 F)) +; (bcStrings (8 "8.4" x22 F)) +; (bcStrings (8 "8.8" x23 F)) +; (bcStrings (8 "9.2" x24 F)) +; (bcStrings (8 "9.6" x25 F)) +; (bcStrings (8 "10.0" x26 F)) +; (bcStrings (8 "0.0" x27 F)) +; (bcStrings (8 "0.0" x28 F)) +; (bcStrings (8 "0.0" x29 F)) +; (bcStrings (8 "0.0" x30 F)) +; (bcStrings (8 "0.0" x31 F)) +; (bcStrings (8 "0.0" x32 F)) +; (bcStrings (8 "0.0" x33 F)) +; (bcStrings (8 "0.0" x34 F)) +; (bcStrings (8 "0.0" x35 F)) +; (bcStrings (8 "0.0" x36 F)) +; (bcStrings (8 "0.0" x37 F)) +; (bcStrings (8 "0.0" x38 F)) +; (bcStrings (8 "0.0" x39 F)) +; (bcStrings (8 "0.0" x40 F)) +; (bcStrings (8 "0.0" x41 F)) +; (bcStrings (8 "0.0" x42 F)) +; (bcStrings (8 "0.0" x43 F)) +; (bcStrings (8 "0.0" x44 F)) +; (bcStrings (8 "0.0" x45 F)) +; (bcStrings (8 "0.0" x46 F)) +; (bcStrings (8 "0.0" x47 F)) +; (bcStrings (8 "0.0" x48 F)) +; (bcStrings (8 "0.0" x49 F)) +; (bcStrings (8 "0.0" x50 F)) +; (bcStrings (8 "0.0" x51 F)) +; (bcStrings (8 "0.0" x52 F)) +; (bcStrings (8 "0.0" x53 F)) +; (bcStrings (8 "0.0" x54 F)) +; (bcStrings (8 "0.0" x55 F)) +; (bcStrings (8 "0.0" x56 F)) +; (bcStrings (8 "0.0" x57 F)) +; (bcStrings (8 "0.0" x58 F)) +; (bcStrings (8 "0.0" x59 F)) +; (bcStrings (8 "0.0" x60 F)) +; (bcStrings (8 "0.0" x61 F)) +; (bcStrings (8 "0.0" x62 F)) +; (bcStrings (8 "0.0" x63 F)) +; (bcStrings (8 "0.0" x64 F))) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'a,a) +; htpSetProperty(page,'b,b) +; htpSetProperty(page,'mnp,mnp) +; htpSetProperty(page,'np,np) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'ifail,ifail) +; htMakeDoneButton('"Continue",'d02gafGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02gafDefaultSolve| + (|htPage| |a| |b| |mnp| |np| |lw| |liw| |tol| |ifail|) + (PROG (|n| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02GAF - ODEs, boundary value problem, finite difference technique with deferred correction, simple nonlinear problem") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the functions (i.e. the derivatives) below ") + (|text| . "as functions of Y[1]...Y[n]: ") + (|text| . "\\newline ") + (|text| . "\\newline {\\em Function 1:} \\space{1}") + (|bcStrings| (42 "Y[2]" |f1| EM)) + (|text| . "\\newline {\\em Function 2:} \\space{1}") + (|bcStrings| (42 "Y[3]" |f2| EM)) + (|text| . "\\newline {\\em Function 3:} \\space{1}") + (|bcStrings| (42 "-Y[1]*Y[3]-0.2*(1-Y[2]*Y[2])" |f3| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter known or estimated values of \\htbitmap{yi} at a and b,") + (|text| . " {\\it U(n,2)}. ") + (|text| + . " [\\htbitmap{yi}(a) in the first column, \\htbitmap{yi}(b) ") + (|text| . "in the second.] \\newline ") + (|bcStrings| (6 "0" |u11| F)) + (|bcStrings| (6 "10" |u21| F)) (|text| . "\\newline ") + (|bcStrings| (6 "0" |u12| F)) + (|bcStrings| (6 "1" |u22| F)) (|text| . "\\newline ") + (|bcStrings| (6 "0" |u13| F)) + (|bcStrings| (6 "0" |u23| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter {\\it V(n,2)}. ") + (|text| + . "If U(i,j) is known V(i,j) = 0.0, else V(i,j) = 1.0: \\newline") + (|bcStrings| (6 "0.0" |v11| F)) + (|bcStrings| (6 "1.0" |v21| F)) (|text| . "\\newline ") + (|bcStrings| (6 "0.0" |v12| F)) + (|bcStrings| (6 "0.0" |v22| F)) (|text| . "\\newline ") + (|bcStrings| (6 "1.0" |v13| F)) + (|bcStrings| (6 "1.0" |v23| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Enter the initial mesh {\\it X(mnp)}: ") + (|text| . "\\newline ") (|bcStrings| (8 "0.0" |x1| F)) + (|bcStrings| (8 "0.4" |x2| F)) + (|bcStrings| (8 "0.8" |x3| F)) + (|bcStrings| (8 "1.2" |x4| F)) + (|bcStrings| (8 "1.6" |x5| F)) + (|bcStrings| (8 "2.0" |x6| F)) + (|bcStrings| (8 "2.4" |x7| F)) + (|bcStrings| (8 "2.8" |x8| F)) + (|bcStrings| (8 "3.2" |x9| F)) + (|bcStrings| (8 "3.6" |x10| F)) + (|bcStrings| (8 "4.0" |x11| F)) + (|bcStrings| (8 "4.4" |x12| F)) + (|bcStrings| (8 "4.8" |x13| F)) + (|bcStrings| (8 "5.2" |x14| F)) + (|bcStrings| (8 "5.6" |x15| F)) + (|bcStrings| (8 "6.0" |x16| F)) + (|bcStrings| (8 "6.4" |x17| F)) + (|bcStrings| (8 "6.8" |x18| F)) + (|bcStrings| (8 "7.2" |x19| F)) + (|bcStrings| (8 "7.6" |x20| F)) + (|bcStrings| (8 "8.0" |x21| F)) + (|bcStrings| (8 "8.4" |x22| F)) + (|bcStrings| (8 "8.8" |x23| F)) + (|bcStrings| (8 "9.2" |x24| F)) + (|bcStrings| (8 "9.6" |x25| F)) + (|bcStrings| (8 "10.0" |x26| F)) + (|bcStrings| (8 "0.0" |x27| F)) + (|bcStrings| (8 "0.0" |x28| F)) + (|bcStrings| (8 "0.0" |x29| F)) + (|bcStrings| (8 "0.0" |x30| F)) + (|bcStrings| (8 "0.0" |x31| F)) + (|bcStrings| (8 "0.0" |x32| F)) + (|bcStrings| (8 "0.0" |x33| F)) + (|bcStrings| (8 "0.0" |x34| F)) + (|bcStrings| (8 "0.0" |x35| F)) + (|bcStrings| (8 "0.0" |x36| F)) + (|bcStrings| (8 "0.0" |x37| F)) + (|bcStrings| (8 "0.0" |x38| F)) + (|bcStrings| (8 "0.0" |x39| F)) + (|bcStrings| (8 "0.0" |x40| F)) + (|bcStrings| (8 "0.0" |x41| F)) + (|bcStrings| (8 "0.0" |x42| F)) + (|bcStrings| (8 "0.0" |x43| F)) + (|bcStrings| (8 "0.0" |x44| F)) + (|bcStrings| (8 "0.0" |x45| F)) + (|bcStrings| (8 "0.0" |x46| F)) + (|bcStrings| (8 "0.0" |x47| F)) + (|bcStrings| (8 "0.0" |x48| F)) + (|bcStrings| (8 "0.0" |x49| F)) + (|bcStrings| (8 "0.0" |x50| F)) + (|bcStrings| (8 "0.0" |x51| F)) + (|bcStrings| (8 "0.0" |x52| F)) + (|bcStrings| (8 "0.0" |x53| F)) + (|bcStrings| (8 "0.0" |x54| F)) + (|bcStrings| (8 "0.0" |x55| F)) + (|bcStrings| (8 "0.0" |x56| F)) + (|bcStrings| (8 "0.0" |x57| F)) + (|bcStrings| (8 "0.0" |x58| F)) + (|bcStrings| (8 "0.0" |x59| F)) + (|bcStrings| (8 "0.0" |x60| F)) + (|bcStrings| (8 "0.0" |x61| F)) + (|bcStrings| (8 "0.0" |x62| F)) + (|bcStrings| (8 "0.0" |x63| F)) + (|bcStrings| (8 "0.0" |x64| F)))) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|a| |a|) + (|htpSetProperty| |page| '|b| |b|) + (|htpSetProperty| |page| '|mnp| |mnp|) + (|htpSetProperty| |page| '|np| |np|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02gafGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;d02gafGen htPage == +; n := htpProperty(htPage, 'n) +; a := htpProperty(htPage, 'a) +; b := htpProperty(htPage, 'b) +; mnp := htpProperty(htPage, 'mnp) +; np := htpProperty(htPage, 'np) +; lw := htpProperty(htPage, 'lw) +; liw := htpProperty(htPage, 'liw) +; ifail := htpProperty(htPage,'ifail) +; tol := htpProperty(htPage,'tol) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..mnp repeat +; x := STRCONC((first y).1," ") +; xList := [x,:xList] +; y := rest y +; xstring := bcwords2liststring xList +; for i in 1..n repeat +; for j in 1..2 repeat +; v := STRCONC((first y).1," ") +; rowList := [v,:rowList] +; y := rest y +; vList := [:vList,rowList] +; rowList := [] +; for i in 1..n repeat +; for j in 1..2 repeat +; u := STRCONC((first y).1," ") +; rowList := [u,:rowList] +; y := rest y +; uList := [:uList,rowList] +; rowList := [] +; vList := reverse vList +; uList := reverse uList +; vstring := bcwords2liststring [bcwords2liststring x for x in vList] +; ustring := bcwords2liststring [bcwords2liststring x for x in uList] +; while y repeat +; f := STRCONC((first y).1," ") +; fList := [f,:fList] +; y := rest y +; fstring := bcwords2liststring fList +; Y:='Y +; prefix := STRCONC("d02gaf(",ustring,", ",vstring,", ",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,a,", ",b,", ",tol,", ") +; prefix := STRCONC(prefix,STRINGIMAGE mnp,", ",STRINGIMAGE lw,", ") +; prefix := STRCONC(prefix,STRINGIMAGE liw,", [",xstring,"], ",STRINGIMAGE np) +; end:=STRCONC (",",STRINGIMAGE ifail,",(",fstring,"::Vector Expression Float") +; linkGen STRCONC (prefix,end,")::ASP7('FCN))") + +(DEFUN |d02gafGen| (|htPage|) + (PROG (|n| |a| |b| |mnp| |np| |lw| |liw| |ifail| |tol| |alist| |x| + |xList| |xstring| |v| |u| |rowList| |vList| |uList| + |vstring| |ustring| |f| |fList| |y| |fstring| Y |prefix| + |end|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |a| (|htpProperty| |htPage| '|a|)) + (SPADLET |b| (|htpProperty| |htPage| '|b|)) + (SPADLET |mnp| (|htpProperty| |htPage| '|mnp|)) + (SPADLET |np| (|htpProperty| |htPage| '|np|)) + (SPADLET |lw| (|htpProperty| |htPage| '|lw|)) + (SPADLET |liw| (|htpProperty| |htPage| '|liw|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |tol| (|htpProperty| |htPage| '|tol|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |mnp|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |x| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |xList| (CONS |x| |xList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xList|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| 2) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |v| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |v| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |vList| + (APPEND |vList| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| 2) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |u| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |u| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |uList| + (APPEND |uList| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |vList| (REVERSE |vList|)) + (SPADLET |uList| (REVERSE |uList|)) + (SPADLET |vstring| + (|bcwords2liststring| + (PROG (G166763) + (SPADLET G166763 NIL) + (RETURN + (DO ((G166768 |vList| (CDR G166768)) + (|x| NIL)) + ((OR (ATOM G166768) + (PROGN + (SETQ |x| (CAR G166768)) + NIL)) + (NREVERSE0 G166763)) + (SEQ (EXIT + (SETQ G166763 + (CONS (|bcwords2liststring| |x|) + G166763))))))))) + (SPADLET |ustring| + (|bcwords2liststring| + (PROG (G166778) + (SPADLET G166778 NIL) + (RETURN + (DO ((G166783 |uList| (CDR G166783)) + (|x| NIL)) + ((OR (ATOM G166783) + (PROGN + (SETQ |x| (CAR G166783)) + NIL)) + (NREVERSE0 G166778)) + (SEQ (EXIT + (SETQ G166778 + (CONS (|bcwords2liststring| |x|) + G166778))))))))) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |f| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |fList| (CONS |f| |fList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |fstring| (|bcwords2liststring| |fList|)) + (SPADLET Y 'Y) + (SPADLET |prefix| + (STRCONC '|d02gaf(| |ustring| '|, | |vstring| + '|, | (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |a| '|, | |b| '|, | |tol| + '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |mnp|) '|, | + (STRINGIMAGE |lw|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |liw|) '|, [| + |xstring| '|], | (STRINGIMAGE |np|))) + (SPADLET |end| + (STRCONC '|,| (STRINGIMAGE |ifail|) '|,(| + |fstring| '|::Vector Expression Float|)) + (|linkGen| (STRCONC |prefix| |end| '|)::ASP7('FCN))|))))))) + +;d02gbf() == +; htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXd02gbf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "D02GBF solves a general linear two-point boundary value problem ") +; (text . "for a system of n ODEs {\it y' = F(x)y + g(x)} on the range ") +; (text . "[a,b] with boundary conditions {\it Cy(a) + Dy(b) = \gamma} ") +; (text . "using a deferred correction technique.") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the number of equations in the system {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 2 n PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Left hand boundary point {\it a}: ") +; (text . "\tab{32} \menuitemstyle{}\tab{34} ") +; (text . "Right hand boundary {\it b}:") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "0.0" a F)) +; (text . "\tab{34} ") +; (bcStrings (10 "1.0" b F)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Max number of mesh points {\it mnp}:") +; (text . "\tab{32} \menuitemstyle{}\tab{34} ") +; (text . "Number of points {\it np}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (10 70 mnp PI)) +; (text . "\tab{34} ") +; (bcStrings (10 0 np PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Accuracy required {\it tol}:") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "1.0e-3" tol F)) +; (text . "\blankline ") +; (text . "\newline \tab{2} ") +; (text . "Ifail is input in three components: ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it a} ") +; (radioButtons afail +; ("" " 0, hard failure" azero) +; ("" " 1, soft failure" aone)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it b} ") +; (radioButtons bfail +; ("" " 1, print error messages" bone) +; ("" " 0, suppress error messages" bzero)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it c} ") +; (radioButtons cfail +; ("" " 1, print warning messages" cone) +; ("" " 0, suppress warning messages" czero))) +; htMakeDoneButton('"Continue", 'd02gbfSolve) +; htShowPage() + +(DEFUN |d02gbf| () + (PROGN + (|htInitPage| + (MAKESTRING + "D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXd02gbf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02gbf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "D02GBF solves a general linear two-point boundary value problem ") + (|text| + . "for a system of n ODEs {\\it y' = F(x)y + g(x)} on the range ") + (|text| + . "[a,b] with boundary conditions {\\it Cy(a) + Dy(b) = \\gamma} ") + (|text| . "using a deferred correction technique.") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the number of equations in the system {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 2 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "\\newline Left hand boundary point {\\it a}: ") + (|text| . "\\tab{32} \\menuitemstyle{}\\tab{34} ") + (|text| . "Right hand boundary {\\it b}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "0.0" |a| F)) (|text| . "\\tab{34} ") + (|bcStrings| (10 "1.0" |b| F)) (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| . "\\newline Max number of mesh points {\\it mnp}:") + (|text| . "\\tab{32} \\menuitemstyle{}\\tab{34} ") + (|text| . "Number of points {\\it np}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 70 |mnp| PI)) (|text| . "\\tab{34} ") + (|bcStrings| (10 0 |np| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Accuracy required {\\it tol}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "1.0e-3" |tol| F)) (|text| . "\\blankline ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Ifail is input in three components: ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") (|text| . "{\\it a} ") + (|radioButtons| |afail| ("" " 0, hard failure" |azero|) + ("" " 1, soft failure" |aone|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") (|text| . "{\\it b} ") + (|radioButtons| |bfail| + ("" " 1, print error messages" |bone|) + ("" " 0, suppress error messages" |bzero|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") (|text| . "{\\it c} ") + (|radioButtons| |cfail| + ("" " 1, print warning messages" |cone|) + ("" " 0, suppress warning messages" |czero|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02gbfSolve|) + (|htShowPage|))) + +;d02gbfSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; a := htpLabelInputString(htPage,'a) +; b := htpLabelInputString(htPage,'b) +; mnp := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) +; objValUnwrap htpLabelSpadValue(htPage, 'mnp) +; np := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) +; objValUnwrap htpLabelSpadValue(htPage, 'np) +; lw := mnp * (3*n*n + 5*n + 2) + 3*n*n + 5*n +; liw := mnp * (2*n + 1) + n +; tol := htpLabelInputString(htPage,'tol) +; aerror := htpButtonValue(htPage,'afail) +; afail := +; aerror = 'azero => '0 +; '1 +; berror := htpButtonValue(htPage,'bfail) +; bfail := +; berror = 'bone => '1 +; '0 +; cerror := htpButtonValue(htPage,'cfail) +; cfail := +; cerror = 'cone => '1 +; '0 +; ifail := 100*cfail + 10*bfail + afail +; n = '2 => d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) +; cList := +; "append"/[fa(i,n) for i in 1..n] where fa(i,n) == +; labelList := +; "append"/[fb(i,j) for j in 1..n] where fb(i,j) == +; cnam := INTERN STRCONC ('"c",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[6, 0, cnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix {\it D}: ") +; middle := STRCONC(middle,"\newline ") +; dList := +; "append"/[fc(i,n) for i in 1..n] where fc(i,n) == +; labelList := +; "append"/[fd(i,j) for j in 1..n] where fd(i,j) == +; dnam := INTERN STRCONC ('"d",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[6, 0, dnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; dList := [['text,:middle],:dList] +; middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector \gamma: ") +; middle := STRCONC(middle,"\newline ") +; gamList := +; "append"/[fe(i) for i in 1..n] where fe(i) == +; gamnam := INTERN STRCONC ('"gam",STRINGIMAGE i) +; [['bcStrings,[6, 0, gamnam, 'F]]] +; prefix := ('"\newline ") +; gamList := [['text,:middle],:gamList] +; middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the matrix ") +; middle := STRCONC(middle,"{\it F(x)} from the equation {\it y' =} ") +; middle := STRCONC(middle,"{\it F(x)y + g(x)}: \newline ") +; fList := +; "append"/[ff(i,n) for i in 1..n] where ff(i,n) == +; labelList := +; "append"/[fg(i,j) for j in 1..n] where fg(i,j) == +; fnam := INTERN STRCONC ('"f",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[6, 0, fnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; fList := [['text,:middle],:fList] +; mid := ('"\blankline \menuitemstyle{} \tab{2} Enter the vector {\it g(x)}: ") +; mid := STRCONC(mid,'"\newline ") +; gList := +; "append"/[fh(i) for i in 1..n] where fh(i) == +; gnam := INTERN STRCONC ('"g",STRINGIMAGE i) +; [['bcStrings,[6, 0, gnam, 'F]]] +; prefix := ('"\newline ") +; gList := [['text,:middle],:gList] +; xList := +; "append"/[fi(i) for i in 1..mnp] where fi(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; [['bcStrings,[8, "0.0", xnam, 'F]]] +; end := ('"\blankline \menuitemstyle{} \tab{2} The initial mesh {\it X(mnp)}") +; end := STRCONC(end,'", (all entries = 0 if np < 4): \newline ") +; xList := [['text,:end],:xList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :cList,:dList,:gamList,:fList,:gList,:xList] +; page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the matrix {\it C} form the equation {\it Cy(a) + Dy(b)} " +; htSay '"= \gamma \newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'d02gbfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'a,a) +; htpSetProperty(page,'b,b) +; htpSetProperty(page,'mnp,mnp) +; htpSetProperty(page,'np,np) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02gbfSolve,fb| (|i| |j|) + (PROG (|cnam|) + (RETURN + (SEQ (SPADLET |cnam| + (INTERN (STRCONC (MAKESTRING "c") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |cnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02gbfSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166859) + (SPADLET G166859 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166859) + (SEQ (EXIT (SETQ G166859 + (APPEND G166859 + (|d02gbfSolve,fb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |d02gbfSolve,fd| (|i| |j|) + (PROG (|dnam|) + (RETURN + (SEQ (SPADLET |dnam| + (INTERN (STRCONC (MAKESTRING "d") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |dnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02gbfSolve,fc| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166882) + (SPADLET G166882 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166882) + (SEQ (EXIT (SETQ G166882 + (APPEND G166882 + (|d02gbfSolve,fd| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |d02gbfSolve,fe| (|i|) + (PROG (|gamnam|) + (RETURN + (SEQ (SPADLET |gamnam| + (INTERN (STRCONC (MAKESTRING "gam") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |gamnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02gbfSolve,fg| (|i| |j|) + (PROG (|fnam|) + (RETURN + (SEQ (SPADLET |fnam| + (INTERN (STRCONC (MAKESTRING "f") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |fnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02gbfSolve,ff| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166911) + (SPADLET G166911 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166911) + (SEQ (EXIT (SETQ G166911 + (APPEND G166911 + (|d02gbfSolve,fg| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |d02gbfSolve,fh| (|i|) + (PROG (|gnam|) + (RETURN + (SEQ (SPADLET |gnam| + (INTERN (STRCONC (MAKESTRING "g") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS 0 + (CONS |gnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02gbfSolve,fi| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS '|0.0| + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02gbfSolve| (|htPage|) + (PROG (|n| |a| |b| |mnp| |np| |lw| |liw| |tol| |aerror| |afail| + |berror| |bfail| |cerror| |cfail| |ifail| |cList| |dList| + |gamList| |middle| |fList| |mid| |prefix| |gList| |end| + |xList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |a| (|htpLabelInputString| |htPage| '|a|)) + (SPADLET |b| (|htpLabelInputString| |htPage| '|b|)) + (SPADLET |mnp| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|mnp|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|mnp|))))) + (SPADLET |np| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|np|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|np|))))) + (SPADLET |lw| + (PLUS (PLUS (TIMES |mnp| + (PLUS + (PLUS + (TIMES (TIMES 3 |n|) |n|) + (TIMES 5 |n|)) + 2)) + (TIMES (TIMES 3 |n|) |n|)) + (TIMES 5 |n|))) + (SPADLET |liw| + (PLUS (TIMES |mnp| (PLUS (TIMES 2 |n|) 1)) |n|)) + (SPADLET |tol| (|htpLabelInputString| |htPage| '|tol|)) + (SPADLET |aerror| (|htpButtonValue| |htPage| '|afail|)) + (SPADLET |afail| + (COND + ((BOOT-EQUAL |aerror| '|azero|) '0) + ('T '1))) + (SPADLET |berror| (|htpButtonValue| |htPage| '|bfail|)) + (SPADLET |bfail| + (COND + ((BOOT-EQUAL |berror| '|bone|) '1) + ('T '0))) + (SPADLET |cerror| (|htpButtonValue| |htPage| '|cfail|)) + (SPADLET |cfail| + (COND + ((BOOT-EQUAL |cerror| '|cone|) '1) + ('T '0))) + (SPADLET |ifail| + (PLUS (PLUS (TIMES 100 |cfail|) + (TIMES 10 |bfail|)) + |afail|)) + (COND + ((BOOT-EQUAL |n| '2) + (|d02gbfDefaultSolve| |htPage| |a| |b| |mnp| |np| |lw| + |liw| |tol| |ifail|)) + ('T + (SPADLET |cList| + (PROG (G166940) + (SPADLET G166940 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166940) + (SEQ (EXIT + (SETQ G166940 + (APPEND G166940 + (|d02gbfSolve,fa| |i| |n|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the matrix {\\it D}: ")) + (SPADLET |middle| (STRCONC |middle| '|\\newline |)) + (SPADLET |dList| + (PROG (G166948) + (SPADLET G166948 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166948) + (SEQ (EXIT + (SETQ G166948 + (APPEND G166948 + (|d02gbfSolve,fc| |i| |n|))))))))) + (SPADLET |dList| + (CONS (CONS '|text| |middle|) |dList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the vector \\gamma: ")) + (SPADLET |middle| (STRCONC |middle| '|\\newline |)) + (SPADLET |gamList| + (PROG (G166956) + (SPADLET G166956 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166956) + (SEQ (EXIT + (SETQ G166956 + (APPEND G166956 + (|d02gbfSolve,fe| |i|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (SPADLET |gamList| + (CONS (CONS '|text| |middle|) |gamList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the matrix ")) + (SPADLET |middle| + (STRCONC |middle| + '|{\\it F(x)} from the equation {\\it y' =} |)) + (SPADLET |middle| + (STRCONC |middle| + '|{\\it F(x)y + g(x)}: \\newline |)) + (SPADLET |fList| + (PROG (G166964) + (SPADLET G166964 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166964) + (SEQ (EXIT + (SETQ G166964 + (APPEND G166964 + (|d02gbfSolve,ff| |i| |n|))))))))) + (SPADLET |fList| + (CONS (CONS '|text| |middle|) |fList|)) + (SPADLET |mid| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the vector {\\it g(x)}: ")) + (SPADLET |mid| + (STRCONC |mid| (MAKESTRING "\\newline "))) + (SPADLET |gList| + (PROG (G166972) + (SPADLET G166972 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166972) + (SEQ (EXIT + (SETQ G166972 + (APPEND G166972 + (|d02gbfSolve,fh| |i|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (SPADLET |gList| + (CONS (CONS '|text| |middle|) |gList|)) + (SPADLET |xList| + (PROG (G166980) + (SPADLET G166980 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |mnp|) G166980) + (SEQ (EXIT + (SETQ G166980 + (APPEND G166980 + (|d02gbfSolve,fi| |i|))))))))) + (SPADLET |end| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} The initial mesh {\\it X(mnp)}")) + (SPADLET |end| + (STRCONC |end| + (MAKESTRING + ", (all entries = 0 if np < 4): \\newline "))) + (SPADLET |xList| (CONS (CONS '|text| |end|) |xList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |cList| + (APPEND |dList| + (APPEND |gamList| + (APPEND |fList| + (APPEND |gList| |xList|))))))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the matrix {\\it C} form the equation {\\it Cy(a) + Dy(b)} ")) + (|htSay| (MAKESTRING "= \\gamma \\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|d02gbfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|a| |a|) + (|htpSetProperty| |page| '|b| |b|) + (|htpSetProperty| |page| '|mnp| |mnp|) + (|htpSetProperty| |page| '|np| |np|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;d02gbfDefaultSolve(htPage,a,b,mnp,np,lw,liw,tol,ifail) == +; n := '2 +; page := htInitPage('"D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem", nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the matrix {\it C} from the equation {\it Cy(a) + Dy(b)} = \gamma:") +; (text . "\newline ") +; (bcStrings (6 "1" c11 F)) +; (bcStrings (6 "0" c12 F)) +; (text . "\newline ") +; (bcStrings (6 "0" c21 F)) +; (bcStrings (6 "0" c22 F)) +; (text . "\blankline \menuitemstyle{}\tab{2}") +; (text . "Enter the matrix {\it D}: \newline ") +; (bcStrings (6 "0" d11 F)) +; (bcStrings (6 "0" d12 F)) +; (text . "\newline ") +; (bcStrings (6 "1" d21 F)) +; (bcStrings (6 "0" d22 F)) +; (text . "\blankline \menuitemstyle{}\tab{2}") +; (text . "Enter the vector \gamma: \newline ") +; (bcStrings (6 "0" gam1 F)) +; (bcStrings (6 "1" gam2 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the matrix {\it F(x)} from the equation {\it y' = F(x)y + g(x)} : ") +; (text . "\newline ") +; (bcStrings (6 "0" f11 F)) +; (bcStrings (6 "1" f12 F)) +; (text . "\newline ") +; (bcStrings (6 "0" f21 F)) +; (bcStrings (6 "-10" f22 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the vector {\it g(x)}: ") +; (text . "\newline ") +; (bcStrings (6 "0" g1 F)) +; (bcStrings (6 "0" g2 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} The initial mesh {\it X(mnp)}, ") +; (text . "(all entries = 0 if np < 4): \newline ") +; (bcStrings (8 "0.0" x1 F)) +; (bcStrings (8 "0.0" x2 F)) +; (bcStrings (8 "0.0" x3 F)) +; (bcStrings (8 "0.0" x4 F)) +; (bcStrings (8 "0.0" x5 F)) +; (bcStrings (8 "0.0" x6 F)) +; (bcStrings (8 "0.0" x7 F)) +; (bcStrings (8 "0.0" x8 F)) +; (bcStrings (8 "0.0" x9 F)) +; (bcStrings (8 "0.0" x10 F)) +; (bcStrings (8 "0.0" x11 F)) +; (bcStrings (8 "0.0" x12 F)) +; (bcStrings (8 "0.0" x13 F)) +; (bcStrings (8 "0.0" x14 F)) +; (bcStrings (8 "0.0" x15 F)) +; (bcStrings (8 "0.0" x16 F)) +; (bcStrings (8 "0.0" x17 F)) +; (bcStrings (8 "0.0" x18 F)) +; (bcStrings (8 "0.0" x19 F)) +; (bcStrings (8 "0.0" x20 F)) +; (bcStrings (8 "0.0" x21 F)) +; (bcStrings (8 "0.0" x22 F)) +; (bcStrings (8 "0.0" x23 F)) +; (bcStrings (8 "0.0" x24 F)) +; (bcStrings (8 "0.0" x25 F)) +; (bcStrings (8 "0.0" x26 F)) +; (bcStrings (8 "0.0" x27 F)) +; (bcStrings (8 "0.0" x28 F)) +; (bcStrings (8 "0.0" x29 F)) +; (bcStrings (8 "0.0" x30 F)) +; (bcStrings (8 "0.0" x31 F)) +; (bcStrings (8 "0.0" x32 F)) +; (bcStrings (8 "0.0" x33 F)) +; (bcStrings (8 "0.0" x34 F)) +; (bcStrings (8 "0.0" x35 F)) +; (bcStrings (8 "0.0" x36 F)) +; (bcStrings (8 "0.0" x37 F)) +; (bcStrings (8 "0.0" x38 F)) +; (bcStrings (8 "0.0" x39 F)) +; (bcStrings (8 "0.0" x40 F)) +; (bcStrings (8 "0.0" x41 F)) +; (bcStrings (8 "0.0" x42 F)) +; (bcStrings (8 "0.0" x43 F)) +; (bcStrings (8 "0.0" x44 F)) +; (bcStrings (8 "0.0" x45 F)) +; (bcStrings (8 "0.0" x46 F)) +; (bcStrings (8 "0.0" x47 F)) +; (bcStrings (8 "0.0" x48 F)) +; (bcStrings (8 "0.0" x49 F)) +; (bcStrings (8 "0.0" x50 F)) +; (bcStrings (8 "0.0" x51 F)) +; (bcStrings (8 "0.0" x52 F)) +; (bcStrings (8 "0.0" x53 F)) +; (bcStrings (8 "0.0" x54 F)) +; (bcStrings (8 "0.0" x55 F)) +; (bcStrings (8 "0.0" x56 F)) +; (bcStrings (8 "0.0" x57 F)) +; (bcStrings (8 "0.0" x58 F)) +; (bcStrings (8 "0.0" x59 F)) +; (bcStrings (8 "0.0" x60 F)) +; (bcStrings (8 "0.0" x61 F)) +; (bcStrings (8 "0.0" x62 F)) +; (bcStrings (8 "0.0" x63 F)) +; (bcStrings (8 "0.0" x64 F)) +; (bcStrings (8 "0.0" x65 F)) +; (bcStrings (8 "0.0" x66 F)) +; (bcStrings (8 "0.0" x67 F)) +; (bcStrings (8 "0.0" x68 F)) +; (bcStrings (8 "0.0" x69 F)) +; (bcStrings (8 "0.0" x70 F))) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'a,a) +; htpSetProperty(page,'b,b) +; htpSetProperty(page,'mnp,mnp) +; htpSetProperty(page,'np,np) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'ifail,ifail) +; htMakeDoneButton('"Continue",'d02gbfGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02gbfDefaultSolve| + (|htPage| |a| |b| |mnp| |np| |lw| |liw| |tol| |ifail|) + (PROG (|n| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '2) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02GBF - ODEs, boundary value problem, finite difference technique with deferred correction, general nonlinear problem") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the matrix {\\it C} from the equation {\\it Cy(a) + Dy(b)} = \\gamma:") + (|text| . "\\newline ") (|bcStrings| (6 "1" |c11| F)) + (|bcStrings| (6 "0" |c12| F)) (|text| . "\\newline ") + (|bcStrings| (6 "0" |c21| F)) + (|bcStrings| (6 "0" |c22| F)) + (|text| . "\\blankline \\menuitemstyle{}\\tab{2}") + (|text| . "Enter the matrix {\\it D}: \\newline ") + (|bcStrings| (6 "0" |d11| F)) + (|bcStrings| (6 "0" |d12| F)) (|text| . "\\newline ") + (|bcStrings| (6 "1" |d21| F)) + (|bcStrings| (6 "0" |d22| F)) + (|text| . "\\blankline \\menuitemstyle{}\\tab{2}") + (|text| . "Enter the vector \\gamma: \\newline ") + (|bcStrings| (6 "0" |gam1| F)) + (|bcStrings| (6 "1" |gam2| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the matrix {\\it F(x)} from the equation {\\it y' = F(x)y + g(x)} : ") + (|text| . "\\newline ") (|bcStrings| (6 "0" |f11| F)) + (|bcStrings| (6 "1" |f12| F)) (|text| . "\\newline ") + (|bcStrings| (6 "0" |f21| F)) + (|bcStrings| (6 "-10" |f22| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the vector {\\it g(x)}: ") + (|text| . "\\newline ") (|bcStrings| (6 "0" |g1| F)) + (|bcStrings| (6 "0" |g2| F)) (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} The initial mesh {\\it X(mnp)}, ") + (|text| . "(all entries = 0 if np < 4): \\newline ") + (|bcStrings| (8 "0.0" |x1| F)) + (|bcStrings| (8 "0.0" |x2| F)) + (|bcStrings| (8 "0.0" |x3| F)) + (|bcStrings| (8 "0.0" |x4| F)) + (|bcStrings| (8 "0.0" |x5| F)) + (|bcStrings| (8 "0.0" |x6| F)) + (|bcStrings| (8 "0.0" |x7| F)) + (|bcStrings| (8 "0.0" |x8| F)) + (|bcStrings| (8 "0.0" |x9| F)) + (|bcStrings| (8 "0.0" |x10| F)) + (|bcStrings| (8 "0.0" |x11| F)) + (|bcStrings| (8 "0.0" |x12| F)) + (|bcStrings| (8 "0.0" |x13| F)) + (|bcStrings| (8 "0.0" |x14| F)) + (|bcStrings| (8 "0.0" |x15| F)) + (|bcStrings| (8 "0.0" |x16| F)) + (|bcStrings| (8 "0.0" |x17| F)) + (|bcStrings| (8 "0.0" |x18| F)) + (|bcStrings| (8 "0.0" |x19| F)) + (|bcStrings| (8 "0.0" |x20| F)) + (|bcStrings| (8 "0.0" |x21| F)) + (|bcStrings| (8 "0.0" |x22| F)) + (|bcStrings| (8 "0.0" |x23| F)) + (|bcStrings| (8 "0.0" |x24| F)) + (|bcStrings| (8 "0.0" |x25| F)) + (|bcStrings| (8 "0.0" |x26| F)) + (|bcStrings| (8 "0.0" |x27| F)) + (|bcStrings| (8 "0.0" |x28| F)) + (|bcStrings| (8 "0.0" |x29| F)) + (|bcStrings| (8 "0.0" |x30| F)) + (|bcStrings| (8 "0.0" |x31| F)) + (|bcStrings| (8 "0.0" |x32| F)) + (|bcStrings| (8 "0.0" |x33| F)) + (|bcStrings| (8 "0.0" |x34| F)) + (|bcStrings| (8 "0.0" |x35| F)) + (|bcStrings| (8 "0.0" |x36| F)) + (|bcStrings| (8 "0.0" |x37| F)) + (|bcStrings| (8 "0.0" |x38| F)) + (|bcStrings| (8 "0.0" |x39| F)) + (|bcStrings| (8 "0.0" |x40| F)) + (|bcStrings| (8 "0.0" |x41| F)) + (|bcStrings| (8 "0.0" |x42| F)) + (|bcStrings| (8 "0.0" |x43| F)) + (|bcStrings| (8 "0.0" |x44| F)) + (|bcStrings| (8 "0.0" |x45| F)) + (|bcStrings| (8 "0.0" |x46| F)) + (|bcStrings| (8 "0.0" |x47| F)) + (|bcStrings| (8 "0.0" |x48| F)) + (|bcStrings| (8 "0.0" |x49| F)) + (|bcStrings| (8 "0.0" |x50| F)) + (|bcStrings| (8 "0.0" |x51| F)) + (|bcStrings| (8 "0.0" |x52| F)) + (|bcStrings| (8 "0.0" |x53| F)) + (|bcStrings| (8 "0.0" |x54| F)) + (|bcStrings| (8 "0.0" |x55| F)) + (|bcStrings| (8 "0.0" |x56| F)) + (|bcStrings| (8 "0.0" |x57| F)) + (|bcStrings| (8 "0.0" |x58| F)) + (|bcStrings| (8 "0.0" |x59| F)) + (|bcStrings| (8 "0.0" |x60| F)) + (|bcStrings| (8 "0.0" |x61| F)) + (|bcStrings| (8 "0.0" |x62| F)) + (|bcStrings| (8 "0.0" |x63| F)) + (|bcStrings| (8 "0.0" |x64| F)) + (|bcStrings| (8 "0.0" |x65| F)) + (|bcStrings| (8 "0.0" |x66| F)) + (|bcStrings| (8 "0.0" |x67| F)) + (|bcStrings| (8 "0.0" |x68| F)) + (|bcStrings| (8 "0.0" |x69| F)) + (|bcStrings| (8 "0.0" |x70| F)))) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|a| |a|) + (|htpSetProperty| |page| '|b| |b|) + (|htpSetProperty| |page| '|mnp| |mnp|) + (|htpSetProperty| |page| '|np| |np|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02gbfGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;d02gbfGen htPage == +; n := htpProperty(htPage, 'n) +; a := htpProperty(htPage, 'a) +; b := htpProperty(htPage, 'b) +; mnp := htpProperty(htPage, 'mnp) +; np := htpProperty(htPage, 'np) +; lw := htpProperty(htPage, 'lw) +; liw := htpProperty(htPage, 'liw) +; ifail := htpProperty(htPage,'ifail) +; tol := htpProperty(htPage,'tol) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..mnp repeat -- matrix +; x := STRCONC((first y).1," ") +; xList := [x,:xList] +; y := rest y +; xstring := bcwords2liststring xList +; for i in 1..n repeat -- vector g +; g := STRCONC((first y).1," ") +; gList := [g,:gList] +; y := rest y +; gstring := bcwords2liststring gList +; for i in 1..n repeat -- matrix F +; for j in 1..n repeat +; f := STRCONC((first y).1," ") +; flist := [f,:flist] +; y := rest y +; fmatlist := [:fmatlist,flist] +; flist := [] +; fmatlist := reverse fmatlist +; fmatstr := bcwords2liststring [bcwords2liststring x for x in fmatlist] +; for i in 1..n repeat -- vector gamma +; gam := STRCONC((first y).1," ") +; gamList := [gam,:gamList] +; y := rest y +; gamstr := bcwords2liststring gamList +; for i in 1..n repeat -- matrix D +; for j in 1..n repeat +; d := STRCONC((first y).1," ") +; dlist := [d,:dlist] +; y := rest y +; dmatlist := [:dmatlist,dlist] +; dlist := [] +; dmatlist := reverse dmatlist +; dmatstr := bcwords2liststring [bcwords2liststring x for x in dmatlist] +; for i in 1..n repeat -- matrix C +; for j in 1..n repeat +; c := STRCONC((first y).1," ") +; clist := [c,:clist] +; y := rest y +; cmatlist := [:cmatlist,clist] +; clist := [] +; cmatlist := reverse cmatlist +; cmatstr := bcwords2liststring [bcwords2liststring x for x in cmatlist] +; prefix := STRCONC("d02gbf(",STRINGIMAGE a,", ",STRINGIMAGE b,", ") +; prefix := STRCONC(prefix,STRINGIMAGE n,", ",tol,", ",STRINGIMAGE mnp,", ") +; prefix := STRCONC(prefix,STRINGIMAGE lw,", ",STRINGIMAGE liw,", ") +; prefix := STRCONC(prefix,cmatstr,"::Matrix DoubleFloat,",dmatstr,"::Matrix DoubleFloat,[",gamstr,"]::Matrix DoubleFloat,[",xstring,"]::Matrix DoubleFloat, ") +; mid := STRCONC(STRINGIMAGE np,", ",STRINGIMAGE ifail,", ") +; end := STRCONC("(",fmatstr,"::Matrix(Expression(Float)))::ASP77(FCNF),(",gstring) +; linkGen STRCONC(prefix,mid,end,"::Vector(Expression(Float)))::ASP78(FCNG))") + +(DEFUN |d02gbfGen| (|htPage|) + (PROG (|n| |a| |b| |mnp| |np| |lw| |liw| |ifail| |tol| |alist| |x| + |xList| |xstring| |g| |gList| |gstring| |f| |flist| + |fmatlist| |fmatstr| |gam| |gamList| |gamstr| |d| |dlist| + |dmatlist| |dmatstr| |c| |y| |clist| |cmatlist| |cmatstr| + |prefix| |mid| |end|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |a| (|htpProperty| |htPage| '|a|)) + (SPADLET |b| (|htpProperty| |htPage| '|b|)) + (SPADLET |mnp| (|htpProperty| |htPage| '|mnp|)) + (SPADLET |np| (|htpProperty| |htPage| '|np|)) + (SPADLET |lw| (|htpProperty| |htPage| '|lw|)) + (SPADLET |liw| (|htpProperty| |htPage| '|liw|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |tol| (|htpProperty| |htPage| '|tol|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |mnp|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |x| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |xList| (CONS |x| |xList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xList|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |g| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |gList| (CONS |g| |gList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |gstring| (|bcwords2liststring| |gList|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |f| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |flist| + (CONS |f| |flist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |fmatlist| + (APPEND |fmatlist| + (CONS |flist| NIL))) + (SPADLET |flist| NIL))))) + (SPADLET |fmatlist| (REVERSE |fmatlist|)) + (SPADLET |fmatstr| + (|bcwords2liststring| + (PROG (G167097) + (SPADLET G167097 NIL) + (RETURN + (DO ((G167102 |fmatlist| + (CDR G167102)) + (|x| NIL)) + ((OR (ATOM G167102) + (PROGN + (SETQ |x| (CAR G167102)) + NIL)) + (NREVERSE0 G167097)) + (SEQ (EXIT + (SETQ G167097 + (CONS (|bcwords2liststring| |x|) + G167097))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |gam| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |gamList| (CONS |gam| |gamList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |gamstr| (|bcwords2liststring| |gamList|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |d| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |dlist| + (CONS |d| |dlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |dmatlist| + (APPEND |dmatlist| + (CONS |dlist| NIL))) + (SPADLET |dlist| NIL))))) + (SPADLET |dmatlist| (REVERSE |dmatlist|)) + (SPADLET |dmatstr| + (|bcwords2liststring| + (PROG (G167142) + (SPADLET G167142 NIL) + (RETURN + (DO ((G167147 |dmatlist| + (CDR G167147)) + (|x| NIL)) + ((OR (ATOM G167147) + (PROGN + (SETQ |x| (CAR G167147)) + NIL)) + (NREVERSE0 G167142)) + (SEQ (EXIT + (SETQ G167142 + (CONS (|bcwords2liststring| |x|) + G167142))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |c| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |clist| + (CONS |c| |clist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |cmatlist| + (APPEND |cmatlist| + (CONS |clist| NIL))) + (SPADLET |clist| NIL))))) + (SPADLET |cmatlist| (REVERSE |cmatlist|)) + (SPADLET |cmatstr| + (|bcwords2liststring| + (PROG (G167178) + (SPADLET G167178 NIL) + (RETURN + (DO ((G167183 |cmatlist| + (CDR G167183)) + (|x| NIL)) + ((OR (ATOM G167183) + (PROGN + (SETQ |x| (CAR G167183)) + NIL)) + (NREVERSE0 G167178)) + (SEQ (EXIT + (SETQ G167178 + (CONS (|bcwords2liststring| |x|) + G167178))))))))) + (SPADLET |prefix| + (STRCONC '|d02gbf(| (STRINGIMAGE |a|) '|, | + (STRINGIMAGE |b|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|, | |tol| + '|, | (STRINGIMAGE |mnp|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |lw|) '|, | + (STRINGIMAGE |liw|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |cmatstr| + '|::Matrix DoubleFloat,| |dmatstr| + '|::Matrix DoubleFloat,[| |gamstr| + '|]::Matrix DoubleFloat,[| |xstring| + '|]::Matrix DoubleFloat, |)) + (SPADLET |mid| + (STRCONC (STRINGIMAGE |np|) '|, | + (STRINGIMAGE |ifail|) '|, |)) + (SPADLET |end| + (STRCONC '|(| |fmatstr| + '|::Matrix(Expression(Float)))::ASP77(FCNF),(| + |gstring|)) + (|linkGen| + (STRCONC |prefix| |mid| |end| + '|::Vector(Expression(Float)))::ASP78(FCNG))|))))))) + +;d02kef() == +; htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXd02kef} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02kef| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "D02KEF finds a specified eigenvalue \htbitmap{lamdab} of a ") +; (text . "regular or second-order Sturm-Liouville system ") +; (text . "{\it(p(x)y')' + q(x; \lambda)y = 0} on a finite or infinite ") +; (text . "range [a,b]; a Pruefer transformation and shooting method ") +; (text . "are used; discontinuities in coefficient functions or their ") +; (text . "derivatives are permitted. ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of points in XPOINT {\it m}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 5 m PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Index of the `break-point' {\it match}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 0 match PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Index of the required eigenvalue {\it k}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 11 k PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Accuracy required {\it tol}:") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "0.0001" tol F)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} \newline ") +; (text . "Eigenvalue estimate {\it elam}: ") +; (text . "\tab{32} \menuitemstyle{}\tab{34} ") +; (text . "Scale of the problem {\it delam}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "14" elam F)) +; (text . "\tab{34} ") +; (bcStrings (10 "1" delam F)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} \newline ") +; (text . "Max iterations {\it maxit}:") +; (text . "\tab{32} \menuitemstyle{}\tab{34} ") +; (text . "Max COEFFN calls {\it maxfun}:") +; (text . "\newline\tab{2} ") +; (bcStrings (10 0 maxit PI)) +; (text . "\tab{34} ") +; (bcStrings (10 0 maxfun PI)) +; (text . "\blankline ") +; (text . "\tab{2} \newline {\it Note:} no bound is assumed ") +; (text . "if maxit = 0 \blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'd02kefSolve) +; htShowPage() + +(DEFUN |d02kef| () + (PROGN + (|htInitPage| + (MAKESTRING + "D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXd02kef} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02kef| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "D02KEF finds a specified eigenvalue \\htbitmap{lamdab} of a ") + (|text| . "regular or second-order Sturm-Liouville system ") + (|text| + . "{\\it(p(x)y')' + q(x; \\lambda)y = 0} on a finite or infinite ") + (|text| + . "range [a,b]; a Pruefer transformation and shooting method ") + (|text| + . "are used; discontinuities in coefficient functions or their ") + (|text| . "derivatives are permitted. ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of points in XPOINT {\\it m}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (6 5 |m| PI)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| + . "\\newline Index of the `break-point' {\\it match}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (6 0 |match| PI)) (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| + . "\\newline Index of the required eigenvalue {\\it k}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (6 11 |k| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Accuracy required {\\it tol}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "0.0001" |tol| F)) (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} \\newline ") + (|text| . "Eigenvalue estimate {\\it elam}: ") + (|text| . "\\tab{32} \\menuitemstyle{}\\tab{34} ") + (|text| . "Scale of the problem {\\it delam}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "14" |elam| F)) (|text| . "\\tab{34} ") + (|bcStrings| (10 "1" |delam| F)) (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} \\newline ") + (|text| . "Max iterations {\\it maxit}:") + (|text| . "\\tab{32} \\menuitemstyle{}\\tab{34} ") + (|text| . "Max COEFFN calls {\\it maxfun}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 0 |maxit| PI)) (|text| . "\\tab{34} ") + (|bcStrings| (10 0 |maxfun| PI)) (|text| . "\\blankline ") + (|text| + . "\\tab{2} \\newline {\\it Note:} no bound is assumed ") + (|text| . "if maxit = 0 \\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02kefSolve|) + (|htShowPage|))) + +;d02kefSolve htPage == +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; match := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'match) +; objValUnwrap htpLabelSpadValue(htPage, 'match) +; k := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'k) +; objValUnwrap htpLabelSpadValue(htPage, 'k) +; tol := htpLabelInputString(htPage,'tol) +; elam := htpLabelInputString(htPage,'elam) +; delam := htpLabelInputString(htPage,'delam) +; maxit := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxit) +; objValUnwrap htpLabelSpadValue(htPage, 'maxit) +; maxfun := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'maxfun) +; objValUnwrap htpLabelSpadValue(htPage, 'maxfun) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'minusOne => '-1 +; '1 +; m = '5 =>d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail) +; xpList := +; "append"/[fa(i) for i in 1..m] where fa(i) == +; xpnam := INTERN STRCONC ('"xp",STRINGIMAGE i) +; [['bcStrings,[10, "0.0", xpnam, 'EM]]] +; middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it p} for COEFFN:") +; middle := STRCONC(middle,"\newline ") +; cList := [['text,:middle],['bcStrings,[42, "0.0", 'c1, 'EM]]] +; middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it q} for COEFFN:") +; middle := STRCONC(middle,"\newline ") +; c1List := [['text,:middle],['bcStrings,[42, "0.0", 'c2, 'EM]]] +; cList := [:cList,:c1List] +; middle:=('"\blankline \menuitemstyle{} \tab{2} Value of {\it dqdl}") +; middle := STRCONC(middle," for COEFFN: \newline ") +; c2List := [['text,:middle],['bcStrings,[42, "0.0", 'c3, 'EM]]] +; cList := [:cList,:c2List] +; middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YL(1) & YL(2) ") +; middle := STRCONC(middle,"for BDYVAL: \newline ") +; ylList := +; "append"/[fb(i) for i in 1..2] where fb(i) == +; ylnam := INTERN STRCONC ('"yl",STRINGIMAGE i) +; [['bcStrings,[42, "0.0", ylnam, 'EM]]] +; ylList := [['text,:middle],:ylList] +; middle:=('"\blankline \menuitemstyle{} \tab{2} Values of YR(1) & YR(2) ") +; middle := STRCONC(middle,"for BDYVAL: \newline ") +; yrList := +; "append"/[fc(i) for i in 1..2] where fc(i) == +; yrnam := INTERN STRCONC ('"yr",STRINGIMAGE i) +; [['bcStrings,[42, "0.0", yrnam, 'EM]]] +; yrList := [['text,:middle],:yrList] +; middle:=('"\blankline \menuitemstyle{} \tab{2} Maximum step size ") +; middle := STRCONC(middle,"{\it hmax(2,m)}: \newline ") +; hList := +; "append"/[fd(i,m) for i in 1..2] where fd(i,m) == +; labelList := +; "append"/[fe(i,j) for j in 1..m] where fe(i,j) == +; hnam := INTERN STRCONC ('"h",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[6, "0.0", hnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; hList := [['text,:middle],:hList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :xpList,:cList,:ylList,:yrList,:hList] +; page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) +; htSay '"\menuitemstyle{}\tab{2} Enter points where boundary " +; htSay '"conditions are to be imposed {\it xpoint}: \newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'d02kefGen) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'match,match) +; htpSetProperty(page,'k,k) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'elam,elam) +; htpSetProperty(page,'delam,delam) +; htpSetProperty(page,'maxit,maxit) +; htpSetProperty(page,'maxfun,maxfun) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02kefSolve,fa| (|i|) + (PROG (|xpnam|) + (RETURN + (SEQ (SPADLET |xpnam| + (INTERN (STRCONC (MAKESTRING "xp") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 10 + (CONS '|0.0| + (CONS |xpnam| (CONS 'EM NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02kefSolve,fb| (|i|) + (PROG (|ylnam|) + (RETURN + (SEQ (SPADLET |ylnam| + (INTERN (STRCONC (MAKESTRING "yl") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 42 + (CONS '|0.0| + (CONS |ylnam| (CONS 'EM NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02kefSolve,fc| (|i|) + (PROG (|yrnam|) + (RETURN + (SEQ (SPADLET |yrnam| + (INTERN (STRCONC (MAKESTRING "yr") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 42 + (CONS '|0.0| + (CONS |yrnam| (CONS 'EM NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02kefSolve,fe| (|i| |j|) + (PROG (|hnam|) + (RETURN + (SEQ (SPADLET |hnam| + (INTERN (STRCONC (MAKESTRING "h") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 6 + (CONS '|0.0| + (CONS |hnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02kefSolve,fd| (|i| |m|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167280) + (SPADLET G167280 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |m|) G167280) + (SEQ (EXIT (SETQ G167280 + (APPEND G167280 + (|d02kefSolve,fe| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |d02kefSolve| (|htPage|) + (PROG (|m| |match| |k| |tol| |elam| |delam| |maxit| |maxfun| |error| + |ifail| |xpList| |c1List| |c2List| |cList| |ylList| + |yrList| |middle| |hList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |match| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|match|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|match|))))) + (SPADLET |k| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|k|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|k|))))) + (SPADLET |tol| (|htpLabelInputString| |htPage| '|tol|)) + (SPADLET |elam| (|htpLabelInputString| |htPage| '|elam|)) + (SPADLET |delam| + (|htpLabelInputString| |htPage| '|delam|)) + (SPADLET |maxit| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|maxit|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|maxit|))))) + (SPADLET |maxfun| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|maxfun|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|maxfun|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND + ((BOOT-EQUAL |error| '|minusOne|) '-1) + ('T '1))) + (COND + ((BOOT-EQUAL |m| '5) + (|d02kefDefaultSolve| |htPage| |match| |k| |tol| |elam| + |delam| |maxit| |maxfun| |ifail|)) + ('T + (SPADLET |xpList| + (PROG (G167297) + (SPADLET G167297 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |m|) G167297) + (SEQ (EXIT + (SETQ G167297 + (APPEND G167297 + (|d02kefSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Value of {\\it p} for COEFFN:")) + (SPADLET |middle| (STRCONC |middle| '|\\newline |)) + (SPADLET |cList| + (CONS (CONS '|text| |middle|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS '|0.0| + (CONS '|c1| (CONS 'EM NIL)))) + NIL)) + NIL))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Value of {\\it q} for COEFFN:")) + (SPADLET |middle| (STRCONC |middle| '|\\newline |)) + (SPADLET |c1List| + (CONS (CONS '|text| |middle|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS '|0.0| + (CONS '|c2| (CONS 'EM NIL)))) + NIL)) + NIL))) + (SPADLET |cList| (APPEND |cList| |c1List|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Value of {\\it dqdl}")) + (SPADLET |middle| + (STRCONC |middle| '| for COEFFN: \\newline |)) + (SPADLET |c2List| + (CONS (CONS '|text| |middle|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS '|0.0| + (CONS '|c3| (CONS 'EM NIL)))) + NIL)) + NIL))) + (SPADLET |cList| (APPEND |cList| |c2List|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Values of YL(1) & YL(2) ")) + (SPADLET |middle| + (STRCONC |middle| '|for BDYVAL: \\newline |)) + (SPADLET |ylList| + (PROG (G167305) + (SPADLET G167305 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| 2) G167305) + (SEQ (EXIT + (SETQ G167305 + (APPEND G167305 + (|d02kefSolve,fb| |i|))))))))) + (SPADLET |ylList| + (CONS (CONS '|text| |middle|) |ylList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Values of YR(1) & YR(2) ")) + (SPADLET |middle| + (STRCONC |middle| '|for BDYVAL: \\newline |)) + (SPADLET |yrList| + (PROG (G167313) + (SPADLET G167313 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| 2) G167313) + (SEQ (EXIT + (SETQ G167313 + (APPEND G167313 + (|d02kefSolve,fc| |i|))))))))) + (SPADLET |yrList| + (CONS (CONS '|text| |middle|) |yrList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Maximum step size ")) + (SPADLET |middle| + (STRCONC |middle| + '|{\\it hmax(2,m)}: \\newline |)) + (SPADLET |hList| + (PROG (G167321) + (SPADLET G167321 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| 2) G167321) + (SEQ (EXIT + (SETQ G167321 + (APPEND G167321 + (|d02kefSolve,fd| |i| |m|))))))))) + (SPADLET |hList| + (CONS (CONS '|text| |middle|) |hList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |xpList| + (APPEND |cList| + (APPEND |ylList| + (APPEND |yrList| |hList|)))))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points") + NIL)) + (|htSay| (MAKESTRING + "\\menuitemstyle{}\\tab{2} Enter points where boundary ")) + (|htSay| (MAKESTRING + "conditions are to be imposed {\\it xpoint}: \\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|d02kefGen|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|match| |match|) + (|htpSetProperty| |page| '|k| |k|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|elam| |elam|) + (|htpSetProperty| |page| '|delam| |delam|) + (|htpSetProperty| |page| '|maxit| |maxit|) + (|htpSetProperty| |page| '|maxfun| |maxfun|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;d02kefDefaultSolve(htPage,match,k,tol,elam,delam,maxit,maxfun,ifail) == +; m := '5 +; page := htInitPage('"D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points", nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter points where boundary conditions are to be imposed ") +; (text . "{\it xpoint}: \newline ") +; (bcStrings (10 "0.0" xp1 F)) +; (bcStrings (10 "0.1" xp2 F)) +; (bcStrings (10 "4**(1/3)" xp3 F)) +; (bcStrings (10 "30.0" xp4 F)) +; (bcStrings (10 "30.0" xp5 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Value of {\it p} for COEFFN: \newline ") +; (bcStrings (42 "1.0" c1 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Value of {\it q} for COEFFN: \newline ") +; (bcStrings (42 "ELAM-X-2.0/(X*X)" c2 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Value of {\it dqdl} for COEFFN: \newline ") +; (bcStrings (42 "1.0" c3 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Values of YL(1) & YL(2) for BDYVAL: \newline ") +; (bcStrings (42 "XL" yl1 EM)) +; (bcStrings (42 "2.0" yl2 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Values of YR(1) & YR(2) for BDYVAL: \newline ") +; (bcStrings (42 "1.0" yr1 EM)) +; (bcStrings (42 "-sqrt(XR-ELAM)" yr2 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Maximum step size {\it hmax(2,m)}: \newline ") +; (bcStrings (6 "0.0" h11 F)) +; (bcStrings (6 "0.0" h12 F)) +; (bcStrings (6 "0.0" h13 F)) +; (bcStrings (6 "0.0" h14 F)) +; (bcStrings (6 "0.0" h15 F)) +; (text . "\newline ") +; (bcStrings (6 "0.0" h21 F)) +; (bcStrings (6 "0.0" h22 F)) +; (bcStrings (6 "0.0" h23 F)) +; (bcStrings (6 "0.0" h24 F)) +; (bcStrings (6 "0.0" h25 F))) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'match,match) +; htpSetProperty(page,'k,k) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'elam,elam) +; htpSetProperty(page,'delam,delam) +; htpSetProperty(page,'maxit,maxit) +; htpSetProperty(page,'maxfun,maxfun) +; htpSetProperty(page,'ifail,ifail) +; htMakeDoneButton('"Continue",'d02kefGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02kefDefaultSolve| + (|htPage| |match| |k| |tol| |elam| |delam| |maxit| |maxfun| + |ifail|) + (PROG (|m| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |m| '5) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02KEF - 2nd order Sturm-Liouville problem, regular/singular system, finite/infinite range, eigenvalue and eigenfunction, user-specified break-points") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter points where boundary conditions are to be imposed ") + (|text| . "{\\it xpoint}: \\newline ") + (|bcStrings| (10 "0.0" |xp1| F)) + (|bcStrings| (10 "0.1" |xp2| F)) + (|bcStrings| (10 "4**(1/3)" |xp3| F)) + (|bcStrings| (10 "30.0" |xp4| F)) + (|bcStrings| (10 "30.0" |xp5| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Value of {\\it p} for COEFFN: \\newline ") + (|bcStrings| (42 "1.0" |c1| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Value of {\\it q} for COEFFN: \\newline ") + (|bcStrings| (42 "ELAM-X-2.0/(X*X)" |c2| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Value of {\\it dqdl} for COEFFN: \\newline ") + (|bcStrings| (42 "1.0" |c3| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Values of YL(1) & YL(2) for BDYVAL: \\newline ") + (|bcStrings| (42 "XL" |yl1| EM)) + (|bcStrings| (42 "2.0" |yl2| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Values of YR(1) & YR(2) for BDYVAL: \\newline ") + (|bcStrings| (42 "1.0" |yr1| EM)) + (|bcStrings| (42 "-sqrt(XR-ELAM)" |yr2| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Maximum step size {\\it hmax(2,m)}: \\newline ") + (|bcStrings| (6 "0.0" |h11| F)) + (|bcStrings| (6 "0.0" |h12| F)) + (|bcStrings| (6 "0.0" |h13| F)) + (|bcStrings| (6 "0.0" |h14| F)) + (|bcStrings| (6 "0.0" |h15| F)) (|text| . "\\newline ") + (|bcStrings| (6 "0.0" |h21| F)) + (|bcStrings| (6 "0.0" |h22| F)) + (|bcStrings| (6 "0.0" |h23| F)) + (|bcStrings| (6 "0.0" |h24| F)) + (|bcStrings| (6 "0.0" |h25| F)))) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|match| |match|) + (|htpSetProperty| |page| '|k| |k|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|elam| |elam|) + (|htpSetProperty| |page| '|delam| |delam|) + (|htpSetProperty| |page| '|maxit| |maxit|) + (|htpSetProperty| |page| '|maxfun| |maxfun|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02kefGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;d02kefGen htPage == +; m := htpProperty(htPage, 'm) +; match := htpProperty(htPage, 'match) +; k := htpProperty(htPage, 'k) +; tol := htpProperty(htPage, 'tol) +; elam := htpProperty(htPage, 'elam) +; delam := htpProperty(htPage, 'delam) +; maxit := htpProperty(htPage, 'maxit) +; maxfun := htpProperty(htPage, 'maxfun) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..m repeat +; for j in 1..2 repeat +; h := STRCONC((first y).1," ") +; rowList := [h,:rowList] +; y := rest y +; hList := [:hList,rowList] +; rowList := [] +; hList := reverse hList +; hstring := bcwords2liststring [bcwords2liststring x for x in hList] +; for i in 1..2 repeat +; for j in 1..2 repeat +; b := STRCONC((first y).1," ") +; rowList := [b,:rowList] +; y := rest y +; bList := [:bList,rowList] +; rowList := [] +; bList := reverse bList +; bstring := bcwords2liststring [bcwords2liststring x for x in bList] +; for i in 1..3 repeat +; c := STRCONC((first y).1," ") +; cList := [c,:cList] +; y := rest y +; cstring := bcwords2liststring cList +; while y repeat +; x := STRCONC((first y).1," ") +; xList := [x,:xList] +; y := rest y +; xstring := bcwords2liststring xList +; prefix := STRCONC("d02kef([",xstring,"]::Matrix DoubleFloat, ",STRINGIMAGE m) +; prefix := STRCONC(prefix,", ",STRINGIMAGE k,", ",tol,", ",STRINGIMAGE maxfun) +; prefix := STRCONC(prefix,", ",STRINGIMAGE match,", ",STRINGIMAGE elam,", ") +; prefix:=STRCONC(prefix,STRINGIMAGE delam,", ",hstring,", ",STRINGIMAGE maxit) +; end := STRCONC(", ",STRINGIMAGE ifail,",(",cstring,"::Vector(Expression Float))::ASP10(COEFFN)") +; end := STRCONC(end,", (",bstring,"::Matrix Expression Float)::ASP80('BDYVAL))") +; linkGen STRCONC (prefix,end) + +(DEFUN |d02kefGen| (|htPage|) + (PROG (|m| |match| |k| |tol| |elam| |delam| |maxit| |maxfun| |ifail| + |alist| |h| |hList| |hstring| |b| |rowList| |bList| + |bstring| |c| |cList| |cstring| |x| |xList| |y| |xstring| + |prefix| |end|) + (RETURN + (SEQ (PROGN + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |match| (|htpProperty| |htPage| '|match|)) + (SPADLET |k| (|htpProperty| |htPage| '|k|)) + (SPADLET |tol| (|htpProperty| |htPage| '|tol|)) + (SPADLET |elam| (|htpProperty| |htPage| '|elam|)) + (SPADLET |delam| (|htpProperty| |htPage| '|delam|)) + (SPADLET |maxit| (|htpProperty| |htPage| '|maxit|)) + (SPADLET |maxfun| (|htpProperty| |htPage| '|maxfun|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |m|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| 2) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |h| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |h| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |hList| + (APPEND |hList| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |hList| (REVERSE |hList|)) + (SPADLET |hstring| + (|bcwords2liststring| + (PROG (G167410) + (SPADLET G167410 NIL) + (RETURN + (DO ((G167415 |hList| (CDR G167415)) + (|x| NIL)) + ((OR (ATOM G167415) + (PROGN + (SETQ |x| (CAR G167415)) + NIL)) + (NREVERSE0 G167410)) + (SEQ (EXIT + (SETQ G167410 + (CONS (|bcwords2liststring| |x|) + G167410))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| 2) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| 2) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |b| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |rowList| + (CONS |b| |rowList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bList| + (APPEND |bList| + (CONS |rowList| NIL))) + (SPADLET |rowList| NIL))))) + (SPADLET |bList| (REVERSE |bList|)) + (SPADLET |bstring| + (|bcwords2liststring| + (PROG (G167446) + (SPADLET G167446 NIL) + (RETURN + (DO ((G167451 |bList| (CDR G167451)) + (|x| NIL)) + ((OR (ATOM G167451) + (PROGN + (SETQ |x| (CAR G167451)) + NIL)) + (NREVERSE0 G167446)) + (SEQ (EXIT + (SETQ G167446 + (CONS (|bcwords2liststring| |x|) + G167446))))))))) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| 3) NIL) + (SEQ (EXIT (PROGN + (SPADLET |c| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |cList| (CONS |c| |cList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |cstring| (|bcwords2liststring| |cList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |x| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |xList| (CONS |x| |xList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xList|)) + (SPADLET |prefix| + (STRCONC '|d02kef([| |xstring| + '|]::Matrix DoubleFloat, | + (STRINGIMAGE |m|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | (STRINGIMAGE |k|) '|, | + |tol| '|, | (STRINGIMAGE |maxfun|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | (STRINGIMAGE |match|) + '|, | (STRINGIMAGE |elam|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |delam|) '|, | + |hstring| '|, | (STRINGIMAGE |maxit|))) + (SPADLET |end| + (STRCONC '|, | (STRINGIMAGE |ifail|) '|,(| + |cstring| + '|::Vector(Expression Float))::ASP10(COEFFN)|)) + (SPADLET |end| + (STRCONC |end| '|, (| |bstring| + '|::Matrix Expression Float)::ASP80('BDYVAL))|)) + (|linkGen| (STRCONC |prefix| |end|))))))) + +;d02raf() == +; htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXd02raf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02raf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "D02RAF solves a two-point boundary value problem for a system ") +; (text . "of {\it n} first-order ordinary differential equations ") +; (text . "{\it \htbitmap{yi}'= \htbitmap{fi}(x,y)}, for {\it i} = 1,2,...,") +; (text . "{\it n}, on the range [a,b] with {\it n} nonlinear boundary ") +; (text . "conditions \htbitmap{gi}{\it (y(a),y(b)) = 0} for {\it i} = 1,2,") +; (text . "...,{\it n} using a deferred correction technique and a Newton ") +; (text . "iteration; the solution is computed on a mesh. A continuation ") +; (text . "facility is provided for which a family of problems is solved ") +; (text . "posed as {\it y' = f(x,y,\epsilon)} subject to the boundary ") +; (text . "conditions {\it g(y(a),y(b),\epsilon) = 0}, where \epsilon ") +; (text . "is the continuation parameter. The choice \epsilon = 0 should ") +; (text . "define an easy problem to solve and \epsilon = 1 the problem ") +; (text . "whose solution is required; a sequence of problems is solved ") +; (text . "with 0 = \htbitmap{ep1} < \htbitmap{ep2} < ... \htbitmap{epp} ") +; (text . "= 1 where {\it p} and the \htbitmap{epi} are chosen by D02RAF. ") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the number of differential equations {\it n}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (5 3 n PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "The maximum number of points in the mesh {\it mnp}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (5 40 mnp PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of points in the initial mesh {\it np}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 17 np PI)) +; (text . "\blankline ") +; (text . "\newline \menuitemstyle{}\tab{2} ") +; (text . "\newline Number of boundary conditions involving y(a) only ") +; (text . "{\it numbeg}: \newline\tab{2} ") +; (bcStrings (5 2 numbeg PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "\newline Boundary conditions involving both y(a) and ") +; (text . "y(b) {\it nummix}: \newline\tab{2} ") +; (text . "\newline\tab{2} ") +; (bcStrings (5 0 nummix PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Absolute error tolerance {\it tol}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "1.0e-4" tol F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Do you wish to use an intial mesh or default values,{\it init} ") +; (radioButtons init +; ("" " default values" init_zero) +; ("" " initial mesh" init_nonZero)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "First dimension of y, {\it iy}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (5 3 iy PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Are JACOBF & JACOBG routines being supplied, {\it ijac}:") +; (radioButtons ijac +; ("" " yes" ijac_nonZero) +; ("" " no" ijac_zero)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Continuation facility {\it deleps}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 "0.1" deleps F)) +; (text . "\newline\tab{2} ") +; (text . "Note: For 0.0 \htbitmap{great=} deleps > 1.0, continuation ") +; (text . "is not used. ") +; (text . "\blankline ") +; (text . "\newline \tab{2} ") +; (text . "Ifail is input in three components: ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it a} ") +; (radioButtons afail +; ("" " 0, hard failure" azero) +; ("" " 1, soft failure" aone)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it b} ") +; (radioButtons bfail +; ("" " 1, print error messages" bone) +; ("" " 0, suppress error messages" bzero)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it c} ") +; (radioButtons cfail +; ("" " 1, print warning messages" cone) +; ("" " 0, suppress warning messages" czero))) +; htMakeDoneButton('"Continue", 'd02rafSolve) +; htShowPage() + +(DEFUN |d02raf| () + (PROGN + (|htInitPage| + (MAKESTRING + "D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXd02raf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|d02raf| '|NagOrdinaryDifferentialEquationsPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "D02RAF solves a two-point boundary value problem for a system ") + (|text| + . "of {\\it n} first-order ordinary differential equations ") + (|text| + . "{\\it \\htbitmap{yi}'= \\htbitmap{fi}(x,y)}, for {\\it i} = 1,2,...,") + (|text| + . "{\\it n}, on the range [a,b] with {\\it n} nonlinear boundary ") + (|text| + . "conditions \\htbitmap{gi}{\\it (y(a),y(b)) = 0} for {\\it i} = 1,2,") + (|text| + . "...,{\\it n} using a deferred correction technique and a Newton ") + (|text| + . "iteration; the solution is computed on a mesh. A continuation ") + (|text| + . "facility is provided for which a family of problems is solved ") + (|text| + . "posed as {\\it y' = f(x,y,\\epsilon)} subject to the boundary ") + (|text| + . "conditions {\\it g(y(a),y(b),\\epsilon) = 0}, where \\epsilon ") + (|text| + . "is the continuation parameter. The choice \\epsilon = 0 should ") + (|text| + . "define an easy problem to solve and \\epsilon = 1 the problem ") + (|text| + . "whose solution is required; a sequence of problems is solved ") + (|text| + . "with 0 = \\htbitmap{ep1} < \\htbitmap{ep2} < ... \\htbitmap{epp} ") + (|text| + . "= 1 where {\\it p} and the \\htbitmap{epi} are chosen by D02RAF. ") + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the number of differential equations {\\it n}: ") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 3 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "The maximum number of points in the mesh {\\it mnp}: ") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 40 |mnp| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of points in the initial mesh {\\it np}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 17 |np| PI)) + (|text| . "\\blankline ") + (|text| . "\\newline \\menuitemstyle{}\\tab{2} ") + (|text| + . "\\newline Number of boundary conditions involving y(a) only ") + (|text| . "{\\it numbeg}: \\newline\\tab{2} ") + (|bcStrings| (5 2 |numbeg| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "\\newline Boundary conditions involving both y(a) and ") + (|text| . "y(b) {\\it nummix}: \\newline\\tab{2} ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 0 |nummix| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Absolute error tolerance {\\it tol}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "1.0e-4" |tol| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Do you wish to use an intial mesh or default values,{\\it init} ") + (|radioButtons| |init| ("" " default values" |initzero|) + ("" " initial mesh" |initnonZero|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "First dimension of y, {\\it iy}: ") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 3 |iy| PI)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Are JACOBF & JACOBG routines being supplied, {\\it ijac}:") + (|radioButtons| |ijac| ("" " yes" |ijacnonZero|) + ("" " no" |ijaczero|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Continuation facility {\\it deleps}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 "0.1" |deleps| F)) + (|text| . "\\newline\\tab{2} ") + (|text| + . "Note: For 0.0 \\htbitmap{great=} deleps > 1.0, continuation ") + (|text| . "is not used. ") (|text| . "\\blankline ") + (|text| . "\\newline \\tab{2} ") + (|text| . "Ifail is input in three components: ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") (|text| . "{\\it a} ") + (|radioButtons| |afail| ("" " 0, hard failure" |azero|) + ("" " 1, soft failure" |aone|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") (|text| . "{\\it b} ") + (|radioButtons| |bfail| + ("" " 1, print error messages" |bone|) + ("" " 0, suppress error messages" |bzero|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") (|text| . "{\\it c} ") + (|radioButtons| |cfail| + ("" " 1, print warning messages" |cone|) + ("" " 0, suppress warning messages" |czero|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02rafSolve|) + (|htShowPage|))) + +;d02rafSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; mnp := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'mnp) +; objValUnwrap htpLabelSpadValue(htPage, 'mnp) +; np := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'np) +; objValUnwrap htpLabelSpadValue(htPage, 'np) +; numbeg := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'numbeg) +; objValUnwrap htpLabelSpadValue(htPage, 'numbeg) +; nummix := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nummix) +; objValUnwrap htpLabelSpadValue(htPage, 'nummix) +; tol := htpLabelInputString(htPage,'tol) +; mesh := htpButtonValue(htPage,'init) +; init := +; mesh = 'init_zero => '0 +; '1 +; iy := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'iy) +; objValUnwrap htpLabelSpadValue(htPage, 'iy) +; jacob := htpButtonValue(htPage,'ijac) +; ijac := +; jacob = 'ijac_zero => '0 +; '1 +; deleps := htpLabelInputString(htPage,'deleps) +; lwork := mnp*(3*n*n + 6*n +2) +4*n*n + 3*n +; liwork := +; ijac = 0 => mnp*(2*n +1) + n*n + 4*n +2 +; mnp*(2*n +1) + n +; aerror := htpButtonValue(htPage,'afail) +; afail := +; aerror = 'azero => '0 +; '1 +; berror := htpButtonValue(htPage,'bfail) +; bfail := +; berror = 'bone => '1 +; '0 +; cerror := htpButtonValue(htPage,'cfail) +; cfail := +; cerror = 'cone => '1 +; '0 +; ifail := 100*cfail + 10*bfail + afail +; (n = '3 and init = '0 and iy = '3 and nummix = '0 and numbeg = '2 and np = '17 and mnp = '40) => d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail) +; init = '1 => d02rafCopOut() +; funcList := +; "append"/[fa(i) for i in 1..n] where fa(i) == +; prefix := ('"\newline {\em Function f") +; prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") +; funct := STRCONC ('"Y[",STRINGIMAGE i ,"]") +; fnam := INTERN STRCONC ('"f",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[42, funct, fnam, 'EM]]] +; middle := ('"\blankline \menuitemstyle{} \tab{2} Enter the functions ") +; middle := STRCONC(middle,'"\htbitmap{gi} below ") +; middle := STRCONC(middle,'"as functions of YA[i] and YB[i]: \newline ") +; gList := +; "append"/[fb(i) for i in 1..n] where fb(i) == +; prefix := ('"\newline {\em Function g") +; prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") +; fnc := STRCONC ('"YA[",STRINGIMAGE i ,"]") +; gnam := INTERN STRCONC ('"g",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[42, fnc, gnam, 'EM]]] +; gList := [['text,:middle],:gList] +; mid:= ('"\blankline \menuitemstyle{} \tab{2} Enter the array ") +; mid := STRCONC(mid,'"{\it x(mnp)}: \newline ") +; xList := +; "append"/[fc(i) for i in 1..mnp] where fc(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; [['bcStrings,[4, 0, xnam, 'F]]] +; xList := [['text,:mid],:xList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain S (String)) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList,:gList,:xList] +; page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the functions \htbitmap{fi} (i.e. the derivatives) below " +; htSay '"as functions of Y[1]...Y[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'d02rafGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'mnp,mnp) +; htpSetProperty(page,'np,np) +; htpSetProperty(page,'numbeg,numbeg) +; htpSetProperty(page,'nummix,nummix) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'init,init) +; htpSetProperty(page,'iy,iy) +; htpSetProperty(page,'ijac,ijac) +; htpSetProperty(page,'deleps,deleps) +; htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'liwork,liwork) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02rafSolve,fa| (|i|) + (PROG (|prefix| |funct| |fnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline {\\em Function f")) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |i|) + (MAKESTRING ":} \\space{1}"))) + (SPADLET |funct| + (STRCONC (MAKESTRING "Y[") (STRINGIMAGE |i|) '])) + (SPADLET |fnam| + (INTERN (STRCONC (MAKESTRING "f") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS |funct| + (CONS |fnam| (CONS 'EM NIL)))) + NIL)) + NIL))))))) + +(DEFUN |d02rafSolve,fb| (|i|) + (PROG (|prefix| |fnc| |gnam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline {\\em Function g")) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |i|) + (MAKESTRING ":} \\space{1}"))) + (SPADLET |fnc| + (STRCONC (MAKESTRING "YA[") (STRINGIMAGE |i|) '])) + (SPADLET |gnam| + (INTERN (STRCONC (MAKESTRING "g") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS |fnc| + (CONS |gnam| (CONS 'EM NIL)))) + NIL)) + NIL))))))) + +(DEFUN |d02rafSolve,fc| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 4 + (CONS 0 + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |d02rafSolve| (|htPage|) + (PROG (|n| |mnp| |np| |numbeg| |nummix| |tol| |mesh| |init| |iy| + |jacob| |ijac| |deleps| |lwork| |liwork| |aerror| |afail| + |berror| |bfail| |cerror| |cfail| |ifail| |funcList| + |middle| |gList| |mid| |xList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |mnp| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|mnp|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|mnp|))))) + (SPADLET |np| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|np|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|np|))))) + (SPADLET |numbeg| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|numbeg|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|numbeg|))))) + (SPADLET |nummix| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nummix|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nummix|))))) + (SPADLET |tol| (|htpLabelInputString| |htPage| '|tol|)) + (SPADLET |mesh| (|htpButtonValue| |htPage| '|init|)) + (SPADLET |init| + (COND + ((BOOT-EQUAL |mesh| '|initzero|) '0) + ('T '1))) + (SPADLET |iy| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|iy|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|iy|))))) + (SPADLET |jacob| (|htpButtonValue| |htPage| '|ijac|)) + (SPADLET |ijac| + (COND + ((BOOT-EQUAL |jacob| '|ijaczero|) '0) + ('T '1))) + (SPADLET |deleps| + (|htpLabelInputString| |htPage| '|deleps|)) + (SPADLET |lwork| + (PLUS (PLUS (TIMES |mnp| + (PLUS + (PLUS + (TIMES (TIMES 3 |n|) |n|) + (TIMES 6 |n|)) + 2)) + (TIMES (TIMES 4 |n|) |n|)) + (TIMES 3 |n|))) + (SPADLET |liwork| + (COND + ((EQL |ijac| 0) + (PLUS (PLUS (PLUS + (TIMES |mnp| + (PLUS (TIMES 2 |n|) 1)) + (TIMES |n| |n|)) + (TIMES 4 |n|)) + 2)) + ('T + (PLUS (TIMES |mnp| (PLUS (TIMES 2 |n|) 1)) + |n|)))) + (SPADLET |aerror| (|htpButtonValue| |htPage| '|afail|)) + (SPADLET |afail| + (COND + ((BOOT-EQUAL |aerror| '|azero|) '0) + ('T '1))) + (SPADLET |berror| (|htpButtonValue| |htPage| '|bfail|)) + (SPADLET |bfail| + (COND + ((BOOT-EQUAL |berror| '|bone|) '1) + ('T '0))) + (SPADLET |cerror| (|htpButtonValue| |htPage| '|cfail|)) + (SPADLET |cfail| + (COND + ((BOOT-EQUAL |cerror| '|cone|) '1) + ('T '0))) + (SPADLET |ifail| + (PLUS (PLUS (TIMES 100 |cfail|) + (TIMES 10 |bfail|)) + |afail|)) + (COND + ((AND (BOOT-EQUAL |n| '3) (BOOT-EQUAL |init| '0) + (BOOT-EQUAL |iy| '3) (BOOT-EQUAL |nummix| '0) + (BOOT-EQUAL |numbeg| '2) (BOOT-EQUAL |np| '17) + (BOOT-EQUAL |mnp| '40)) + (|d02rafDefaultSolve| |htPage| |mnp| |np| |numbeg| + |nummix| |tol| |init| |iy| |ijac| |deleps| |lwork| + |liwork| |ifail|)) + ((BOOT-EQUAL |init| '1) (|d02rafCopOut|)) + ('T + (SPADLET |funcList| + (PROG (G167560) + (SPADLET G167560 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G167560) + (SEQ (EXIT + (SETQ G167560 + (APPEND G167560 + (|d02rafSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the functions ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING "\\htbitmap{gi} below "))) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "as functions of YA[i] and YB[i]: \\newline "))) + (SPADLET |gList| + (PROG (G167568) + (SPADLET G167568 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G167568) + (SEQ (EXIT + (SETQ G167568 + (APPEND G167568 + (|d02rafSolve,fb| |i|))))))))) + (SPADLET |gList| + (CONS (CONS '|text| |middle|) |gList|)) + (SPADLET |mid| + (MAKESTRING + "\\blankline \\menuitemstyle{} \\tab{2} Enter the array ")) + (SPADLET |mid| + (STRCONC |mid| + (MAKESTRING + "{\\it x(mnp)}: \\newline "))) + (SPADLET |xList| + (PROG (G167576) + (SPADLET G167576 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |mnp|) G167576) + (SEQ (EXIT + (SETQ G167576 + (APPEND G167576 + (|d02rafSolve,fc| |i|))))))))) + (SPADLET |xList| (CONS (CONS '|text| |mid|) |xList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| S (|String|)) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |funcList| + (APPEND |gList| |xList|)))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the functions \\htbitmap{fi} (i.e. the derivatives) below ")) + (|htSay| (MAKESTRING "as functions of Y[1]...Y[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|d02rafGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|mnp| |mnp|) + (|htpSetProperty| |page| '|np| |np|) + (|htpSetProperty| |page| '|numbeg| |numbeg|) + (|htpSetProperty| |page| '|nummix| |nummix|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|init| |init|) + (|htpSetProperty| |page| '|iy| |iy|) + (|htpSetProperty| |page| '|ijac| |ijac|) + (|htpSetProperty| |page| '|deleps| |deleps|) + (|htpSetProperty| |page| '|lwork| |lwork|) + (|htpSetProperty| |page| '|liwork| |liwork|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;d02rafDefaultSolve(htPage,mnp,np,numbeg,nummix,tol,init,iy,ijac,deleps,lwork,liwork,ifail) == +; n := '3 +; page := htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the functions \htbitmap{fi} (i.e. the derivatives) below ") +; (text . "as functions of Y[1]...Y[n]: ") +; (text . "\newline {\em Function f1:} \space{1}") +; (bcStrings (44 "Y[2]" f1 EM)) +; (text . "\newline {\em Function f2:} \space{1}") +; (bcStrings (44 "Y[3]" f2 EM)) +; (text . "\newline {\em Function f3:} \space{1}") +; (bcStrings (44 "-Y[1]*Y[3] - 2*EPS*(1-Y[2]*Y[2])" f3 EM)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the functions \htbitmap{gi} below ") +; (text . "as functions of YA[i] and YB[i]: ") +; (text . "\newline {\em Function g1:} \space{1}") +; (bcStrings (44 "YA[1]" g1 EM)) +; (text . "\newline {\em Function g2:} \space{1}") +; (bcStrings (44 "YA[2]" g2 EM)) +; (text . "\newline {\em Function g3:} \space{1}") +; (bcStrings (44 "YB[2] -1" g3 EM)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the array {\it x(mnp)}: \newline ") +; (bcStrings (4 "0.0" x1 F)) +; (bcStrings (4 "0.0" x2 F)) +; (bcStrings (4 "0.0" x3 F)) +; (bcStrings (4 "0.0" x4 F)) +; (bcStrings (4 "0.0" x5 F)) +; (bcStrings (4 "0.0" x6 F)) +; (bcStrings (4 "0.0" x7 F)) +; (bcStrings (4 "0.0" x8 F)) +; (bcStrings (4 "0.0" x9 F)) +; (bcStrings (4 "0.0" x10 F)) +; (bcStrings (4 "0.0" x11 F)) +; (bcStrings (4 "0.0" x12 F)) +; (bcStrings (4 "0.0" x13 F)) +; (bcStrings (4 "0.0" x14 F)) +; (bcStrings (4 "0.0" x15 F)) +; (bcStrings (4 "0.0" x16 F)) +; (bcStrings (4 "10.0" x17 F)) +; (bcStrings (4 "0.0" x18 F)) +; (bcStrings (4 "0.0" x19 F)) +; (bcStrings (4 "0.0" x20 F)) +; (bcStrings (4 "0.0" x21 F)) +; (bcStrings (4 "0.0" x22 F)) +; (bcStrings (4 "0.0" x23 F)) +; (bcStrings (4 "0.0" x24 F)) +; (bcStrings (4 "0.0" x25 F)) +; (bcStrings (4 "0.0" x26 F)) +; (bcStrings (4 "0.0" x27 F)) +; (bcStrings (4 "0.0" x28 F)) +; (bcStrings (4 "0.0" x29 F)) +; (bcStrings (4 "0.0" x30 F)) +; (bcStrings (4 "0.0" x31 F)) +; (bcStrings (4 "0.0" x32 F)) +; (bcStrings (4 "0.0" x33 F)) +; (bcStrings (4 "0.0" x34 F)) +; (bcStrings (4 "0.0" x35 F)) +; (bcStrings (4 "0.0" x36 F)) +; (bcStrings (4 "0.0" x37 F)) +; (bcStrings (4 "0.0" x38 F)) +; (bcStrings (4 "0.0" x39 F)) +; (bcStrings (4 "0.0" x40 F))) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'mnp,mnp) +; htpSetProperty(page,'np,np) +; htpSetProperty(page,'numbeg,numbeg) +; htpSetProperty(page,'nummix,nummix) +; htpSetProperty(page,'tol,tol) +; htpSetProperty(page,'init,init) +; htpSetProperty(page,'iy,iy) +; htpSetProperty(page,'ijac,ijac) +; htpSetProperty(page,'deleps,deleps) +; htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'liwork,liwork) +; htpSetProperty(page,'ifail,ifail) +; htMakeDoneButton('"Continue",'d02rafGen) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |d02rafDefaultSolve| + (|htPage| |mnp| |np| |numbeg| |nummix| |tol| |init| |iy| |ijac| + |deleps| |lwork| |liwork| |ifail|) + (PROG (|n| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the functions \\htbitmap{fi} (i.e. the derivatives) below ") + (|text| . "as functions of Y[1]...Y[n]: ") + (|text| . "\\newline {\\em Function f1:} \\space{1}") + (|bcStrings| (44 "Y[2]" |f1| EM)) + (|text| . "\\newline {\\em Function f2:} \\space{1}") + (|bcStrings| (44 "Y[3]" |f2| EM)) + (|text| . "\\newline {\\em Function f3:} \\space{1}") + (|bcStrings| + (44 "-Y[1]*Y[3] - 2*EPS*(1-Y[2]*Y[2])" |f3| EM)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the functions \\htbitmap{gi} below ") + (|text| . "as functions of YA[i] and YB[i]: ") + (|text| . "\\newline {\\em Function g1:} \\space{1}") + (|bcStrings| (44 "YA[1]" |g1| EM)) + (|text| . "\\newline {\\em Function g2:} \\space{1}") + (|bcStrings| (44 "YA[2]" |g2| EM)) + (|text| . "\\newline {\\em Function g3:} \\space{1}") + (|bcStrings| (44 "YB[2] -1" |g3| EM)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the array {\\it x(mnp)}: \\newline ") + (|bcStrings| (4 "0.0" |x1| F)) + (|bcStrings| (4 "0.0" |x2| F)) + (|bcStrings| (4 "0.0" |x3| F)) + (|bcStrings| (4 "0.0" |x4| F)) + (|bcStrings| (4 "0.0" |x5| F)) + (|bcStrings| (4 "0.0" |x6| F)) + (|bcStrings| (4 "0.0" |x7| F)) + (|bcStrings| (4 "0.0" |x8| F)) + (|bcStrings| (4 "0.0" |x9| F)) + (|bcStrings| (4 "0.0" |x10| F)) + (|bcStrings| (4 "0.0" |x11| F)) + (|bcStrings| (4 "0.0" |x12| F)) + (|bcStrings| (4 "0.0" |x13| F)) + (|bcStrings| (4 "0.0" |x14| F)) + (|bcStrings| (4 "0.0" |x15| F)) + (|bcStrings| (4 "0.0" |x16| F)) + (|bcStrings| (4 "10.0" |x17| F)) + (|bcStrings| (4 "0.0" |x18| F)) + (|bcStrings| (4 "0.0" |x19| F)) + (|bcStrings| (4 "0.0" |x20| F)) + (|bcStrings| (4 "0.0" |x21| F)) + (|bcStrings| (4 "0.0" |x22| F)) + (|bcStrings| (4 "0.0" |x23| F)) + (|bcStrings| (4 "0.0" |x24| F)) + (|bcStrings| (4 "0.0" |x25| F)) + (|bcStrings| (4 "0.0" |x26| F)) + (|bcStrings| (4 "0.0" |x27| F)) + (|bcStrings| (4 "0.0" |x28| F)) + (|bcStrings| (4 "0.0" |x29| F)) + (|bcStrings| (4 "0.0" |x30| F)) + (|bcStrings| (4 "0.0" |x31| F)) + (|bcStrings| (4 "0.0" |x32| F)) + (|bcStrings| (4 "0.0" |x33| F)) + (|bcStrings| (4 "0.0" |x34| F)) + (|bcStrings| (4 "0.0" |x35| F)) + (|bcStrings| (4 "0.0" |x36| F)) + (|bcStrings| (4 "0.0" |x37| F)) + (|bcStrings| (4 "0.0" |x38| F)) + (|bcStrings| (4 "0.0" |x39| F)) + (|bcStrings| (4 "0.0" |x40| F)))) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|mnp| |mnp|) + (|htpSetProperty| |page| '|np| |np|) + (|htpSetProperty| |page| '|numbeg| |numbeg|) + (|htpSetProperty| |page| '|nummix| |nummix|) + (|htpSetProperty| |page| '|tol| |tol|) + (|htpSetProperty| |page| '|init| |init|) + (|htpSetProperty| |page| '|iy| |iy|) + (|htpSetProperty| |page| '|ijac| |ijac|) + (|htpSetProperty| |page| '|deleps| |deleps|) + (|htpSetProperty| |page| '|lwork| |lwork|) + (|htpSetProperty| |page| '|liwork| |liwork|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02rafGen|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;d02rafGen htPage == +; n := htpProperty(htPage, 'n) +; mnp := htpProperty(htPage, 'mnp) +; np := htpProperty(htPage, 'np) +; numbeg := htpProperty(htPage, 'numbeg) +; nummix := htpProperty(htPage, 'nummix) +; tol := htpProperty(htPage, 'tol) +; init := htpProperty(htPage, 'init) +; iy := htpProperty(htPage, 'iy) +; ijac := htpProperty(htPage, 'ijac) +; deleps := htpProperty(htPage, 'deleps) +; lwork := htpProperty(htPage, 'lwork) +; liwork := htpProperty(htPage, 'liwork) +; ifail := htpProperty(htPage, 'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..mnp repeat +; xtemp := STRCONC((first y).1," ") +; xList := [xtemp,:xList] +; y := rest y +; xstring := bcwords2liststring xList +; for i in 1..n repeat +; gtemp := STRCONC((first y).1," ") +; gList := [gtemp,:gList] +; y := rest y +; gstring := bcwords2liststring gList +; while y repeat +; f := STRCONC((first y).1," ") +; fList := [f,:fList] +; y := rest y +; fstring := bcwords2liststring fList +; prefix := STRCONC("d02raf(",STRINGIMAGE n,", ",STRINGIMAGE mnp,", ") +; prefix := STRCONC(prefix,STRINGIMAGE numbeg,", ",STRINGIMAGE nummix,", ") +; prefix := STRCONC(prefix,tol,", ",STRINGIMAGE init,", ",STRINGIMAGE iy,", ") +; middle:= STRCONC(STRINGIMAGE ijac,", ",STRINGIMAGE lwork,", ") +; middle := STRCONC(middle,STRINGIMAGE liwork,", ",STRINGIMAGE np,", [") +; middle := STRCONC(middle,xstring,"],[[0.0 for i in 1..", STRINGIMAGE mnp) +; middle := STRCONC(middle,"] for j in 1..",STRINGIMAGE iy,"]") +; middle := STRCONC(middle,":: Matrix DoubleFloat,",STRINGIMAGE deleps,", ") +; middle := STRCONC(middle,STRINGIMAGE ifail,", (",fstring,"::Vector ") +; middle := STRCONC(middle,"Expression Float)::ASP41('FCN,'JACOBF,'JACEPS),(") +; middle := STRCONC(middle,gstring,"::Vector Expression Float)::ASP42('G,'JACOBG,") +; middle := STRCONC(middle,"'JACGEP))") +; linkGen STRCONC(prefix,middle) + +(DEFUN |d02rafGen| (|htPage|) + (PROG (|n| |mnp| |np| |numbeg| |nummix| |tol| |init| |iy| |ijac| + |deleps| |lwork| |liwork| |ifail| |alist| |xtemp| |xList| + |xstring| |gtemp| |gList| |gstring| |f| |fList| |y| + |fstring| |prefix| |middle|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |mnp| (|htpProperty| |htPage| '|mnp|)) + (SPADLET |np| (|htpProperty| |htPage| '|np|)) + (SPADLET |numbeg| (|htpProperty| |htPage| '|numbeg|)) + (SPADLET |nummix| (|htpProperty| |htPage| '|nummix|)) + (SPADLET |tol| (|htpProperty| |htPage| '|tol|)) + (SPADLET |init| (|htpProperty| |htPage| '|init|)) + (SPADLET |iy| (|htpProperty| |htPage| '|iy|)) + (SPADLET |ijac| (|htpProperty| |htPage| '|ijac|)) + (SPADLET |deleps| (|htpProperty| |htPage| '|deleps|)) + (SPADLET |lwork| (|htpProperty| |htPage| '|lwork|)) + (SPADLET |liwork| (|htpProperty| |htPage| '|liwork|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |mnp|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |xtemp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |xList| (CONS |xtemp| |xList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xList|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |gtemp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |gList| (CONS |gtemp| |gList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |gstring| (|bcwords2liststring| |gList|)) + (DO () ((NULL |y|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |f| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |fList| (CONS |f| |fList|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |fstring| (|bcwords2liststring| |fList|)) + (SPADLET |prefix| + (STRCONC '|d02raf(| (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |mnp|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |numbeg|) '|, | + (STRINGIMAGE |nummix|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |tol| '|, | + (STRINGIMAGE |init|) '|, | + (STRINGIMAGE |iy|) '|, |)) + (SPADLET |middle| + (STRCONC (STRINGIMAGE |ijac|) '|, | + (STRINGIMAGE |lwork|) '|, |)) + (SPADLET |middle| + (STRCONC |middle| (STRINGIMAGE |liwork|) '|, | + (STRINGIMAGE |np|) '|, [|)) + (SPADLET |middle| + (STRCONC |middle| |xstring| + '|],[[0.0 for i in 1..| + (STRINGIMAGE |mnp|))) + (SPADLET |middle| + (STRCONC |middle| '|] for j in 1..| + (STRINGIMAGE |iy|) '])) + (SPADLET |middle| + (STRCONC |middle| '|:: Matrix DoubleFloat,| + (STRINGIMAGE |deleps|) '|, |)) + (SPADLET |middle| + (STRCONC |middle| (STRINGIMAGE |ifail|) '|, (| + |fstring| '|::Vector |)) + (SPADLET |middle| + (STRCONC |middle| + '|Expression Float)::ASP41('FCN,'JACOBF,'JACEPS),(|)) + (SPADLET |middle| + (STRCONC |middle| |gstring| + '|::Vector Expression Float)::ASP42('G,'JACOBG,|)) + (SPADLET |middle| (STRCONC |middle| '|'JACGEP))|)) + (|linkGen| (STRCONC |prefix| |middle|))))))) + +; +;d02rafCopOut() == +; htInitPage('"D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\blankline ") +; (text . "{\center{\em Hyperdoc interface not available for initial mesh}}") +; (text . "\newline ") +; (text . "{\center{\em Please use the command line.}}")) +; htMakeDoneButton('"Continue",'d02raf) +; htShowPage() + +(DEFUN |d02rafCopOut| () + (PROGN + (|htInitPage| + (MAKESTRING + "D02RAF - ODEs, general nonlinear boundary value problem, finite difference technique with deferred correction, continuation facility") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| . "\\blankline ") + (|text| + . "{\\center{\\em Hyperdoc interface not available for initial mesh}}") + (|text| . "\\newline ") + (|text| . "{\\center{\\em Please use the command line.}}"))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|d02raf|) + (|htShowPage|))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}