C      ALGORITHM 810, COLLECTED ALGORITHMS FROM ACM.
C      THIS WORK PUBLISHED IN TRANSACTIONS ON MATHEMATICAL SOFTWARE,
C      VOL. 27,NO. 2,      June, 2001, P.  143--192.
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	Doc/
#	Doc/README.first
#	Doc/autoinput.txt
#	Doc/help.tex
#	Doc/intro.tex
#	Doc/readme.txt
#	Doc/xamples.tex
#	Fortran/
#	Fortran/Sp/
#	Fortran/Sp/Drivers/
#	Fortran/Sp/Drivers/data2
#	Fortran/Sp/Drivers/driver1.f
#	Fortran/Sp/Drivers/driver2.f
#	Fortran/Sp/Drivers/driver3.f
#	Fortran/Sp/Drivers/makepqw.f
#	Fortran/Sp/Drivers/res1
#	Fortran/Sp/Drivers/res2
#	Fortran/Sp/Drivers/res3
#	Fortran/Sp/Drivers/xamples.f
#	Fortran/Sp/Src/
#	Fortran/Sp/Src/src.f
# This archive created: Tue Nov 13 09:51:12 2001
export PATH; PATH=/bin:$PATH
if test ! -d 'Doc'
then
	mkdir 'Doc'
fi
cd 'Doc'
if test -f 'README.first'
then
	echo shar: will not over-write existing file "'README.first'"
else
cat << "SHAR_EOF" > 'README.first'
In order to make this code compatible with the other CALGO codes
there has been a renaming of filenames. This hasn't gone through to
the documentation; the mappings are

coupdr -> driver1
drive  -> driver2
sepdr  -> driver3
sleign2.f -> src.f

data2 needs to be renamed auto.in before running driver2 in
automatic mode.
SHAR_EOF
fi # end of overwriting check
if test -f 'autoinput.txt'
then
	echo shar: will not over-write existing file "'autoinput.txt'"
else
cat << "SHAR_EOF" > 'autoinput.txt'
		SLEIGN2: THE AUTOINPUT.TXT FILE

01 March 2001: P.B. BAILEY, W.N. EVERITT AND A. ZETTL

     The experienced user of SLEIGN2 who would like to avoid the
"question & answer" format in favor of a more direct (and faster) system
can do so by simply creating a very brief text file containing the
parameters of his particular problem. The file must be called
   
                   auto.in

and must reside in the same directory as the executable SLEIGN2 file
(possibly xamples.x or bloggs.x) .  Once such a file has been created,
the user simply types

        xamples.x  <ENTER>

as usual (or bloggs.x <ENTER>), whereupon the prompt 

   WOULD YOU LIKE AN OVERVIEW OF HELP ? (Y/N) (h?)

appears -- as usual.  But instead of replying to the question
with y, or n, or h, one simply types in the response

           a  <ENTER>

The "a" here stands for "automatic" operation of SLEIGN2;
at this point the computation of the requested eigenvalue(s) 
proceeds without further action by the user.
     The construction of the file "auto.in" consists of simply
defining a number of "KEYWORDS", each on a separate line, which
together constitute a complete set of input parameters defining
the eigenvalue problem to be solved. (The differential equation
coefficients have, presumably, been already defined in either
xamples.f, or bloggs.f, or.. .)   
          -------------------------------------------
     The KEYWORDS, all of which end in a colon and must be
followed by at least one space, are:

   a:  -- The left end-point of the interval (a,b); 
          Value is any real number;
          Default value is -infinity.
   b:  -- The right end-point of the interval (a,b);
          Value is any real number;
          Default value is +infinity.
   classa:  -- The end-point classification of a;
               Value is one of { r, wr, lcno, lco, lp, d }.
   classb:  -- The end-point classification of b:
               Value is one of { r, wr, lcno, lco, lp, d }.
   bca: -- boundary condition for the end-point a;
           Value is either d (for Dirichlet),
                           n (for Neuman),
                        or two real numbers A1, A2 . 
   bcb: -- boundary condition for the end-point b;
           Value is either d (for Dirichlet),
                           n (for Neuman),
                        or two real numbers B1, B2 . 
   bcc:  -- coupled boundary condition;
            Value is either p (for periodic),
                            s (for semi-periodic),
                        or five real numbers
                           alpha, k11, k12, k21, k22 .
   numeig:  -- Index (or range of indices) of desired eigenvalue;
               Value is an integer N1, or pair of integers N1,N2 .
   param:  -- Parameter(s) appropriate for the problem;
              Value is one or two real numbers, param1, param2.
   np:  --  Problem number;
            (Appropriate only if one of the differential equations
              in xamples.f is being used.);
            Value is an integer from 1 to 32.
   output:  -- Name of output file;
               Value is a character string, the name of the output
                 file where the results of the computation are to
                 be written;
               Default value is "auto.out" .
   end:  -- Last line of file "auto.in" ; no value set.
            
   again:  --  Terminates the input for one eigenvalue problem and
                 begins the input for another ; no value set.

Although the KEYWORDS used to define any one problem can be defined
in any order, there are a few rules to be observed:  Namely,

  Only those KEYWORDS whose values are necessary need be mentioned.
  Any KEYWORD definition remains in effect until redefined;
  To erase a previous definition of a KEYWORD, redefine it to 
     have the value "null".  
          -----------------------------------------------
     
     Perhaps a simple example would help to make clear what such
a file would look like.  One such could be:

output: bessel.rep
np: 2
param: 0.75
a: 0.0
b: 1.0
classa: lcno
classb: r
bca: 1.0,0.0
bcb: d
numeig: 2,5
end:

     This file (which must be called "auto.in", of course), would
be suitable for running Bessel's equation in xamples.f.   
Evidently the problem selected is #2 of xamples.f (Bessel's equation),
with the parameter nu = 0.75, on the interval (0.0,1.0) .  The
end-point a is asserted to be LCNO; end-point b is R; the boundary
condition at a is defined by A1 = 1.0 & A2 = 0.0; boundary condition
at b is Dirichlet; and the eigenvalues lambda(2), lambda(3), lambda(4),
lambda(5) are to be computed.
 
     If the user wishes to run several problems, one after another, 
things can become a little complicated, but can be done.  Here is
a more complicated example of a file auto.in :
 
output: Legendre 
np: 1
a: -1.0
classa: lcno
bca: 1.0,0.0
b: 1.0
classb: lcno
bcb: 1.0,0.0
numeig: 0,5
 
again:
np: 6
output: Sears-Titchmarsh
a: 1.0
classa: r
classb: lco
bcb: 1.0,0.0
numeig: -1,2 
bca: d
b: null
 
again:
numeig: 1,5
np: 12 
a: 0.0 
output: Mathieu.rep
classa: r
classb: r
b: pi
bcc: p 
param: 5.0
 
again:
np: 16
output: Jacobi.rep
a: -1.0 
b:  1.0
param: 0.5,-1.2
classa: lp
classb: lcno
bcb:  1.0,0.0
numeig: 0,2
 
again:
param: 1.2,-0.5
classa: wr
classb: lp
bca: d
bcb: null
 
end:
      ---------------------------------------------------
 
     The user must be  aware, however, that this "automatic" system
for running SLEIGN2 has no built in safety features.  
Whereas the "question & answer" format can and does catch many kinds
of simple errors on the part of the user, there are no safety
devices of any kind in place when SLEIGN2 is run in automatic mode.
If the program runs, and if an output file has been written, then
the user has at least a record of the parameters of the problem which
were used for the run.  However if the auto.in file is constructed with
any errors in it, almost anything can happen. 
   
Department of Mathematical Sciences, Northern Illinois University,
DeKalb, IL 60115-2888, USA.


SHAR_EOF
fi # end of overwriting check
if test -f 'help.tex'
then
	echo shar: will not over-write existing file "'help.tex'"
else
cat << "SHAR_EOF" > 'help.tex'
%% This document created by Scientific Word (R) Version 3.5

\documentclass[12pt]{amsart}%
\usepackage{graphicx}
\usepackage{amscd}
\usepackage{amsmath}%
\usepackage{amsfonts}%
\usepackage{amssymb}
%TCIDATA{OutputFilter=latex2.dll}
%TCIDATA{CSTFile=amsartci.cst}
%TCIDATA{Created=Tue Sep 07 11:15:04 1999}
%TCIDATA{LastRevised=Sunday, April 01, 2001 11:19:55}
%TCIDATA{<META NAME="GraphicsSave" CONTENT="32">}
%TCIDATA{<META NAME="DocumentShell" CONTENT="Journal Articles\amsnumb">}
%TCIDATA{Language=British English}
\newtheorem{theorem}{Theorem}
\theoremstyle{plain}
\newtheorem{acknowledgement}{Acknowledgement}
\newtheorem{algorithm}{Algorithm}[section]
\newtheorem{axiom}{Axiom}[section]
\newtheorem{case}{Case}[section]
\newtheorem{claim}{Claim}[section]
\newtheorem{conclusion}{Conclusion}[section]
\newtheorem{condition}{Condition}[section]
\newtheorem{conjecture}{Conjecture}[section]
\newtheorem{corollary}{Corollary}[section]
\newtheorem{criterion}{Criterion}[section]
\newtheorem{definition}{Definition}[section]
\newtheorem{example}{Example}[section]
\newtheorem{exercise}{Exercise}[section]
\newtheorem{lemma}{Lemma}[section]
\newtheorem{notation}{Notation}[section]
\newtheorem{problem}{Problem}[section]
\newtheorem{proposition}{Proposition}[section]
\newtheorem{remark}{Remark}[section]
\newtheorem{solution}{Solution}[section]
\newtheorem{summary}{Summary}[section]
\numberwithin{equation}{section}
\numberwithin{theorem}{section}
\newcommand{\thmref}[1]{Theorem~\ref{#1}}
\newcommand{\secref}[1]{\S\ref{#1}}
\newcommand{\lemref}[1]{Lemma~\ref{#1}}
\setlength{\oddsidemargin}{0.0in}
\setlength{\evensidemargin}{0.0in}
\setlength{\textwidth}{6.5in}
\setlength{\textheight}{8.5in}
\setlength{\headsep}{0.25in}
\setlength{\headheight}{0.0in}


\begin{document}
\title[HELP file]{Sleign2: the HELP file}
\author{P.B. Bailey}
\author{W.N. Everitt}
\author{A. Zettl}
\address{Department of Mathematical Sciences, Northern Illinois University, DeKalb, IL
60115-2888, USA}
\date{01 March 2001 (File: help.tex)}
\maketitle


This copy of the HELP data has been written in AMS-LaTeX in view of the
considerable amount of mathematical formulae involved in the text. The user
should note that when HELP is accessed in MAKEPQW and/or DRIVE the
corresponding data is given in Fortran notation. The best use of this HELP
data can be made by printing out a copy of this AMS-LaTeX file to have
available when the code files are in use.

HELP may be called at any point where the program halts and displays (h?), by
pressing ``h
%TCIMACRO{\TEXTsymbol{<}}%
%BeginExpansion
$<$%
%EndExpansion
ENTER%
%TCIMACRO{\TEXTsymbol{>}}%
%BeginExpansion
$>$%
%EndExpansion
''. To RETURN from HELP, press ``r
%TCIMACRO{\TEXTsymbol{<}}%
%BeginExpansion
$<$%
%EndExpansion
ENTER%
%TCIMACRO{\TEXTsymbol{>}}%
%BeginExpansion
$>$%
%EndExpansion
''. To QUIT at any program halt, press ``q
%TCIMACRO{\TEXTsymbol{<}}%
%BeginExpansion
$<$%
%EndExpansion
ENTER%
%TCIMACRO{\TEXTsymbol{>}}%
%BeginExpansion
$>$%
%EndExpansion
''.

This AMS-LaTeX file is supplied as a separate text file within the SLEIGN2
package; it can be accessed on-line in both the MAKEPQW (if used) and DRIVE files.

HELP contains information to aid the user in entering data: on the coefficient
functions $p,q,w;$ on the self-adjoint, separated and coupled, regular and
singular, boundary conditions; on the limit-circle boundary condition
functions $u,v$ at the endpoint $a$ and $U,V$ at the endpoint $b$ of the
interval $(a,b)$; on the endpoint classifications of the differential
equation; on DEFAULT entry; on eigenvalue indexes; on IFLAG information; and
on the general use of the program SLEIGN2.

\medskip

The 17 sections of HELP are:

H1: Overview of HELP. H2: File name entry. H3: The differential equation. H4:
endpoint classification. H5: DEFAULT entry. H6: Self-adjoint limit-circle
boundary conditions. H7: General self-adjoint boundary conditions. H8:
Recording the results. H9: Type and choice of interval. H10: Entry of
endpoints. H11: endpoint values of $p,q,w$. H12: Initial value problems. H13:
Indexing of eigenvalues. H14: Entry of eigenvalue index, initial guess, and
tolerance. H15: IFLAG information. H16: Plotting. H17: Indexing of eigenvalues.

HELP can be accessed at each point in MAKEPQW and DRIVE where the user is
asked for input, by pressing ``h
%TCIMACRO{\TEXTsymbol{<}}%
%BeginExpansion
$<$%
%EndExpansion
ENTER%
%TCIMACRO{\TEXTsymbol{>}}%
%BeginExpansion
$>$%
%EndExpansion
''; this places the user at the appropriate HELP section. Once in HELP, the
user can scroll the further HELP sections by repeatedly pressing ``h
%TCIMACRO{\TEXTsymbol{<}}%
%BeginExpansion
$<$%
%EndExpansion
ENTER%
%TCIMACRO{\TEXTsymbol{>}}%
%BeginExpansion
$>$%
%EndExpansion
'', or jump to a specific HELP section Hn (n =1,2,...17) by typing ``hn
%TCIMACRO{\TEXTsymbol{<}}%
%BeginExpansion
$<$%
%EndExpansion
ENTER%
%TCIMACRO{\TEXTsymbol{>}}%
%BeginExpansion
$>$%
%EndExpansion
''; to return to the place in the program from which HELP is called, press
``r
%TCIMACRO{\TEXTsymbol{<}}%
%BeginExpansion
$<$%
%EndExpansion
ENTER%
%TCIMACRO{\TEXTsymbol{>}}%
%BeginExpansion
$>$%
%EndExpansion
''.

\medskip

H2: File name entry.

MAKEPQW is used to create a Fortran file containing the coefficients $p,q,w$
defining the differential equation, and the boundary condition functions $u,v$
and $U,V$ if required. The file must be given a NEW filename which is
acceptable to your Fortran compiler. For example, it might be called bessel.f
or bessel.for depending upon your compiler.

The same naming considerations apply if the Fortran file is prepared other
than with the use of MAKEPQW.

\medskip

H3: The differential equation.

The prompt ``Input $p$ (or $q$ or $w$) ='' requests you to type in a Fortran
expression defining the function $p$, which is one of the three coefficient
functions defining the Sturm-Liouville differential equation%
\begin{equation}
-(py^{\prime})^{\prime}+qy=\lambda wy \tag{*}%
\end{equation}
to be considered on some interval $(a,b)$ of the real line. The actual
interval used in a particular problem can be chosen later, and may be either
the whole interval $(a,b)$ where the coefficient functions $p,q,w$ are
defined, or on any sub-interval $(a^{\prime},b^{\prime})$ of $(a,b)$;
$a=\infty$ and/or $b=+\infty$ are allowable choices for the endpoints.

The coefficient functions $p,q,w$ of the differential equation may be chosen
arbitrarily but must satisfy the following conditions:

(1) $p,q,w$ are real-valued throughout $(a,b)$.

(2) $p,q,w$ are piece-wise continuous and defined throughout the interior of
the interval $(a,b)$.

(3) $p$ and $w$ are strictly positive in $(a,b)$.

\noindent For better error analysis in the numerical procedures, condition (2)
above is often replaced with

(2$^{\prime}$) $p,q,w$ are four times continuously differentiable on $(a,b)$.

\noindent The behaviour of $p,q,w$ near the endpoints $a$ and $b$ is critical
to the classification of the differential equation (see H4 and H11).

\medskip

H4: endpoint classification.

The correct classification of the endpoints $a$ and $b$ is essential to the
working of the SLEIGN2 program. To classify the endpoints, it is convenient to
choose a point $c$ in $(a,b)$; \textit{i.e.} $a<c<b$. \quad\quad$\quad
\;\;$Subject to the general conditions on the coefficient functions $p,q,w$
(see H3):

(1) a is REGULAR (say R) if $-\infty<a,$ $p,q,w$ are piece-wise continuous on
$[a,c]$, and $p(a)>0,w(a)>0.$

(2) $a$ is WEAKLY REGULAR (say WR) if $-\infty<a,$ $a$ is not R and%
\[
\int_{a}^{c}\left\{  p^{-1}+\left|  q\right|  +w\right\}  <+\infty.
\]

If endpoint $a$ is neither R nor WR, then $a$ is SINGULAR; that is, either
$-\infty=a,$ or $-\infty<a$ and%
\[
\int_{a}^{c}\left\{  p^{-1}+\left|  q\right|  +w\right\}  =+\infty.
\]

(3) The SINGULAR endpoint $a$ is LIMIT-CIRCLE NON-OSCILLATORY (say LCNO) if
for some real value of the spectral parameter $\lambda$ ALL real-valued
solutions $y$ of the differential equation%
\[
-(py^{\prime})^{\prime}+qy=\lambda wy\;\text{on}\;(a,c]
\]

satisfy the conditions:%
\[
\int_{a}^{c}w\left|  y\right|  ^{2}<+\infty
\]

\noindent and $y$ has at most a finite number of zeros in $(a,c].$

(4) The SINGULAR endpoint a is LIMIT-CIRCLE OSCILLATORY (say LCO) if for some
real $\lambda$ ALL real-valued solutions of the differential equation (*)
satisfy the conditions:%
\[
\int_{a}^{c}w\left|  y\right|  ^{2}<+\infty
\]

\noindent and $y$ has an infinite number of zeros in $(a,c].$

(5) The SINGULAR endpoint a is LIMIT POINT (say LP) if for some real $\lambda$
at least one solution of the differential equation $(\ast)$ satisfies the
condition:%
\[
\int_{a}^{c}w\left|  y\right|  ^{2}=+\infty.
\]

There is a similar classification of the endpoint $b$ into one of the five
distinct cases R, WR, LCNO, LCO, LP.

Although the classification of singular endpoints invokes a real value of the
parameter $\lambda$, this classification is invariant in $\lambda$; all real
choices of $\lambda$ lead to the same classification.

In determining the classification of singular endpoints for the differential
equation $(\ast)$, it is often convenient to start with the choice $\lambda=0$
in attempting to find solutions (particularly when $q=0$ on $(a,b)$); however,
see example 7 below.

See H6 on the use of maximal domain functions to determine the classification
at singular endpoints.

EXAMPLES:

1. $-y^{\prime\prime}=\lambda y$ is R at both endpoints of $(a,b)$ when $a$
and $b$ are finite.

2. $-y^{\prime\prime}=\lambda y$ on $(-\infty,+\infty)$ is LP at both endpoints.

3. $-\left(  x^{1/2}y^{\prime}(x)\right)  ^{\prime}=\lambda x^{-1/2}y(x)$ for
all$\;x\in(0,+\infty)$ is WR at $0$ and LP at $+\infty$ (take $\lambda=0$ in
$(\ast)$). See the file xamples.f, \#10 (Weakly Regular).

4. $-((1-x^{2})y^{\prime}(x))^{\prime}=\lambda y(x)\;$for all$\;x\in(-1,+1)$
is LCNO at both ends (take $\lambda=0$ in $(\ast)$). See xamples.f, \#1 (Legendre).

5. $-y^{\prime\prime}(x)+Cx^{-2}y(x)=\lambda y(x)\;$for all$\;x\in(0,+\infty)$
is LP at $+\infty;$ however at $0$ the equation illustrates a number of
different classifications(take $\lambda=0$ in $(\ast)$) as follows:

LP $C\geq3/4$ ; LCNO for $-1/4\leq C<3/4$ (but $C\neq0$); LCO for $C<-1/4.$

6. $-(xy^{\prime}(x))^{\prime}-x^{-1}y(x)=\lambda y(x)\;$for all$\;x\in
(0,\infty)$ is LCO at $0$ and LP $+\infty$ (take $\lambda=0$ in $(\ast)$ with
solutions $\cos(\ln(x))$ and $\sin(\ln(x))$. See xamples.f, \#7 (BEZ).

7. $-(xy^{\prime}(x))^{\prime}-xy(x)=\lambda x^{-1}y(x)\;$for all$\;x\in
(0,+\infty)$ is LP at $0$ and LCO at $+\infty$ (take $\lambda=-1/4$ in
$(\ast)$ with solutions $x^{-1/2}\cos(x)$ and $x^{-1/2}\sin(x)$). See
xamples.f, \#6 (Sears-Titchmarsh).

8. $-y^{\prime\prime}(x)+x\sin(x)y(x)=\lambda y(x)$ on $(0,+\infty)$ is R at
$0$ and LP at $+\infty.$ See xamples.f \#30 (Littlewood-McLeod).

\medskip

H5: DEFAULT entry.

The complete range of problems for which SLEIGN2 is applicable can only be
reached by appropriate entries under endpoint classification and boundary
conditions. However, there is a DEFAULT application which requires no detailed
entry of endpoint classification or boundary conditions, subject to:

1) The DEFAULT application CANNOT be used at a LCO endpoint.

2) If an endpoint $a$ is R, then the Dirichlet boundary condition $y(a)=0$ is
automatically used.

3) If an endpoint $a$ is WR, then the following boundary condition is
automatically applied:

(i) if $p(a)=0$, and both $q$ and $w$ are bounded near $a$, then the Dirichlet
boundary condition $y(a)=0$ is used

(ii) if $p(a)>0$, and $q$ and/or $w$ are not bounded near $a$, then the
Neumann boundary condition $y^{\prime}(a)=0$ is used.

If $p(a)=0$, and $q$ and/or $w$ are not bounded near $a$, then no reliable
information, in general, can be given on the DEFAULT boundary condition.

4) If an endpoint is LCNO, then in most cases the principal or Friedrichs
boundary condition is applied (see H6).

5) If an endpoint is LP, then the normal LP procedure is applied (see H7(1.)).

If you choose the DEFAULT condition, then no entry is required for the $u,v$
and $U,V$ boundary condition functions.

\medskip

H6: Limit-circle (LC) boundary conditions.

At an endpoint $a$, the LC type separated boundary condition is of the form
(similar remarks throughout apply to the endpoint $b$ with $U,V$ being
boundary condition functions at $b$)%
\begin{equation}
A1[y,u](a)+A2[y,v](a)=0 \tag{**}%
\end{equation}

\noindent where $y$ is a solution of the differential equation%
\begin{equation}
-(py^{\prime})^{\prime}+qy=\lambda wy\;\text{on}\;(a,b) \tag{*}%
\end{equation}

Here $A1,A2$ are real numbers, not both zero; $u$ and $v$ are boundary
condition functions at $a$; and for real-valued $y$ and $u$ the form
$[y,u](\cdot)$ is defined by%
\[
\lbrack y,u](x)=y(x)(pu^{\prime})(x)-(py^{\prime})(x)u(x)\;\text{for
all}\;x\in(a,b).
\]

If neither endpoint is LP then there are also self-adjoint coupled boundary
conditions. These have a canonical form given by%
\[
Y(b)=\exp(i\alpha)\mathbf{K}Y(a)
\]

\noindent where

(i) $\mathbf{K}$ is a real $2\times2$ matrix with $\det(\mathbf{K})=1$

(ii) the parameter $\alpha$ is restricted to $\alpha\in(-\pi,\pi]$

(iii) $Y$ is the solution column vector $Y(a)=[y(a),(py^{\prime})(a)]^{T}$ at
a regular R endpoint $a$, and $Y$ is the ``singular solution vector''
$Y(a)=[[y,u](a),[y,v](a)]^{T}$ at a singular LC endpoint $a$. Similarly at the
right endpoint $b$ with $U,V.$

The object of this section is to provide help in choosing appropriate
functions $u$ and $v$ in $(\ast\ast)$ (or in choosing $U,V$) given the
differential equation $(\ast)$. Full details of the boundary conditions for
$(\ast)$ are discussed in H7; here it is sufficient to say that the
limit-circle type boundary condition $(\ast\ast)$ must be applied at any
endpoint in the LCNO, LCO classification, but can also be used in the R, WR
classification subject to the appropriate choice of $u$ and $v,$ and $U$ and $V.$

Let $(\ast)$ be R, WR, LCNO, or LCO at endpoint $a$ and choose $c$ in
$(a,b).$. Then \textit{either} $u$ and $v$ are a pair of linearly independent
real solutions of $(\ast)$ on $(a,c]$ for any chosen real value of $\lambda$,
\textit{or }$u$ and $v$ are a pair of real-valued maximal domain functions
defined on $(a,c]$ satisfying $[u,v](a)\neq0.$

The maximal domain $D(a,b)$ is defined by%
\[%
\begin{array}
[c]{lll}%
D(a,b)= & \{f:(a,b)\rightarrow\mathbb{C}: & (i)\;f\text{ and }pf^{\prime}\in
AC_{\text{loc}}(a,b)\\
&  & (ii)\;f\text{ and }w^{-1}(-(pf^{\prime})^{\prime}+qf)\in L^{2}%
((a,b);w)\}.
\end{array}
\]
The domains $D(a,c]$ and $D[c,b)$ are the restrictions of the functions
$D(a,b)$ to the sub-intervals. It is known that for all $f,g\in D(a,c]$ the
limit%
\[
\lbrack f,g](a)=\lim_{x\rightarrow a}[f,g](x)
\]

\noindent exists and is finite. If $(\ast)$ is LCNO or LCO at $a$, then all
solutions of (*) belong to $D(a,c]$ for all values of $\lambda.$ The boundary
condition $(\ast\ast)$ is essential in the LCNO and LCO cases but can also be
used with advantage in some R and WR cases.

In the R, WR, and LCNO cases, but not in the LCO case, the boundary condition
functions can always be chosen so that%
\[
\lim_{x\rightarrow a}\frac{u(x)}{v(x)}=0
\]
and it is recommended that this normalisation be effected, but this is not
essential; this normalization has been entered in the examples given below. In
this case, the boundary condition $[y,u](a)=0$ (\textit{i.e. }$A1=1,A2=0$ in
$(\ast\ast)$) is called the principal or Friedrichs boundary condition at $a$.

In the case when endpoints $a$ and $b$ are, independently, in the R, WR, LCNO,
or LCO classification, it may be that symmetry or other reasons permit one set
of boundary condition functions to be used at both end-points (see xamples.f,
\#1 (Legendre)). In other cases, different pairs must be chosen for each
endpoint (see xamples.f: \#16 (Jacobi), \#18 (Dunsch), and \#19 (Donsch)).

Note that a solution pair $u,v$ is always a maximal domain pair, but not
necessarily vice versa. EXAMPLES:

1. $-y^{\prime\prime}=\lambda y$ on $[0,\pi]$ is R at $0$ and R at $\pi.$ At
$0$, with $\lambda=0$, a solution pair is
\[
u(x)=x,v(x)=1\;\text{for all}\;x\in\lbrack0,\pi].
\]
At $\pi,$with $\lambda=1$, a solution pair is%
\[
U(x)=\sin(x),V(x)=\cos(x)\;\text{for all}\;x\in\lbrack0,\pi].
\]

2. $-(x^{1/2}y^{\prime}(x))^{\prime}=\lambda x^{-1/2}y(x)$ on $(0,1]$ is WR at
$0$ and R at $1.$ (The general solutions of this equation are $u(x)=\cos
(2x^{1/2}\sqrt{\lambda})$ and $v(x)=\sin(2x^{1/2}\sqrt{\lambda})$.)

At $0$, $\lambda=0$, a solution pair is%
\[
u(x)=2x^{1/2},v(x)=1.
\]
At $1$, with $\lambda=\pi^{2}/4$, a solution pair is%
\[
U(x)=\sin(\pi x^{1/2}),V(x)=\cos(\pi x^{1/2}).
\]
Also at 1, with $\lambda=0$, a solution pair is%
\[
U(x)=2(1-x^{1/2}),V(x)=1.
\]

See also xamples.f, \#10 (Weakly Regular).

3. $-((1-x^{2})y^{\prime}(x))^{\prime}=\lambda y(x)$ on $(-1,+1)$ is LCNO at
both endpoints.

At both $\pm1$, $\lambda=0$, a solution pair is%
\[
u(x)=1,v(x)=\ln((1+x)/(1-x))/2
\]

At $+1$, a maximal domain pair is $U(x)=1,V(x)=\ln(1-x)$. At $-1$, a maximal
domain pair is $u(x)=1,v(x)=\ln(1+x).$

See also xamples.f, \#1 (Legendre).

4. $-y^{\prime\prime}(x)-(4x^{2})^{-1}y(x)=\lambda y(x)$ on $(0,+\infty)$ is
LCNO at $0$ and LP at $+\infty$.

At $0$, a maximal domain pair is%
\[
u(x)=x^{1/2},v(x)=x^{1/2}\ln(x).
\]

See also xamples.f, \#2 (Bessel).

5. $-y^{\prime\prime}(x)-5(4x^{2})^{-1}y(x)=\lambda y(x)$ on $(0,+\infty)$ LCO
at $0$ and LP at $+\infty.$

At $0$, $\lambda=0$, a solution pair is%
\[
u(x)=x^{1/2}\cos(\ln(x)),v(x)=\sin(\ln(x)).
\]

See also xamples.f, \#20 (Krall).

6. $-y^{\prime\prime}(x)=\lambda y(x)$ on $(0,+\infty)$ is LCNO at 0 and LP at +infinity.

At $0$, a maximal domain pair is%
\[
u(x)=x,v(x)=1-x\ln(x).
\]

See also xamples.f, \#4(Boyd).

7. $-(x^{-1}y^{\prime}(x))^{\prime}+(kx^{-2}+k^{2}x^{-1})y(x)=\lambda y(x)$ on
$(0,1]$ with $k$ real and $k\neq0$, is LCNO at 0 and R at 1.

At $0$, a maximal domain pair is%
\[
u(x)=x^{2},v(x)=x-k^{-1}%
\]

See also xamples.f, \#8 (Laplace Tidal Wave).

\medskip

H7: General self-adjoint boundary conditions.

Boundary conditions for Sturm-Liouville boundary value problems%
\begin{equation}
-(py^{\prime})^{\prime}+qy=\lambda wy\;\text{on}\;(a,b) \tag{*}%
\end{equation}

\noindent are \textit{either }SEPARATED, with at most one condition at
endpoint $a$ and at most one condition at endpoint $b$,

\noindent\textit{or }COUPLED, when both $a$ and $b$ are, independently, in one
of the end-point classifications R, WR, LCNO, LCO, in which case two
independent boundary conditions are required which link the solution values
near $a$ to those near $b$. The SLEIGN2 program allows for all self-adjoint
boundary conditions; separated self-adjoint conditions and all cases of
coupled self-adjoint conditions.

Separated Conditions: the boundary conditions to be selected depend upon the
classification of the differential equation at the endpoint, say, $a$:

1. If the endpoint a is LP, then no boundary condition is required or allowed.

2. If the endpoint $a$ is R or WR, then a separated self-adjoint boundary
condition is of the form%
\[
A1y(a)+A2(py^{\prime})(a)=0
\]

\noindent where $A1,A2$ are real constants the user must choose, not both zero.

3. If the endpoint a is LCNO or LCO, then a separated boundary condition is of
the form%
\[
A1[y,u](a)+A2[y,v](a)=0
\]

\noindent where $A1,A2$ are real constants the user must choose, not both
zero; here $u,v$ are the pair of boundary condition functions the user has
previously selected when the input Fortran file was being prepared with makepqw.f.

4. If the endpoint a is LCNO and the boundary condition pair $u,v$ has been
chosen so that%
\[
\lim_{x\rightarrow a}\frac{u(x)}{v(x)}=0
\]

\noindent(which is always possible), then $A1=1,A2=0$ (\textit{i.e.
}$[y,u](a)=0$) gives the principal (Friedrichs) boundary condition at $a.$

5. If $a$ is R or WR and boundary condition functions $u,v$ have been entered
in the Fortran input file, then 3 and 4 above apply to entering separated
boundary conditions at such an endpoint; the boundary conditions in this form
are equivalent to the point-wise conditions in 2 (subject to care in choosing
$A1,A2$). This singular form of a regular boundary condition may be
particularly effective in the WR case if the boundary condition form in 2
leads to numerical difficulties. Conditions 2,3,4,5 apply similarly at
endpoint $b$ (with $U,V$ as the boundary condition functions at $b$).

6. If $a$ is R, WR, LCNO, or LCO and $b$ is LP, then only a separated
condition at $a$ is required and allowed (or instead at $b$ if $a$ and $b$ are interchanged).

7. If both endpoints $a$ and $b$ are LP, then no boundary conditions are
required or allowed.

The indexing of eigenvalues for boundary value problems with separated
conditions is discussed in H13.

Coupled Conditions:

8. Coupled regular self-adjoint boundary conditions on $(a,b)$ apply only when
both endpoints $a$ and $b$ are R or WR.

\medskip

H8: Recording the results.

If you choose to have a record kept of the results, then the following
information is stored in a file with the name you select:

1. The file name.

2. The header line prompted for (up to 32 characters of your choice).

3. The interval $(a,b)$ selected by the user.

For SEPARATED boundary conditions:

4. The endpoint classification.

5. A summary of coefficient information at WR, LCNO, LCO endpoints.

6. The boundary condition constants $(A1,A2),(B1,B2)$ if entered.

7. (NUMEIG,EIG,TOL) or (NUMEIG1,NUMEIG2,TOL), as entered.

For COUPLED boundary conditions:

8. The boundary condition parameter $\alpha$ and the coupling matrix
$\mathbf{K}$, see H6.

For ALL self-adjoint boundary conditions:

9. The computed eigenvalue, EIG, and its estimated accuracy, TOL.

10. IFLAG reported (see H15).

\medskip

H9: Type and choice of interval.

You may enter any interval $(a,b)$ for which the coefficients $p,q,w$ are well
defined by your Fortran statements in the input file, provided that $(a,b)$
contains no interior singularities.

\medskip

H10: Entry of endpoints.

Endpoints a and b should generally be entered as real numbers to an
appropriate number of decimal places.

\medskip

H11: endpoint values of $p,q,w.$

The program SLEIGN2 needs to know whether the coefficient functions $p,q,w$ as
defined by the Fortran expressions entered in the input file, can be evaluated
numerically without running into difficulty. If, for example, either $q$ or
$w$ is unbounded at $a$, or $p(a)=0$, then SLEIGN2 needs to know this
information so that $a$ is not chosen for functional evaluation.

\medskip

H12: Initial value problems.

The initial value problem facility for Sturm-Liouville problems%
\begin{equation}
-(py^{\prime})^{\prime}+qy=\lambda wy\;\text{on}\;(a,b) \tag{*}%
\end{equation}

\noindent allows for the computation of a solution of $(\ast)$ with a
user-chosen value $\lambda$ and any one of the following initial conditions:

1. From endpoint $a$ of any classification except LP towards endpoint $b$ of
any classification

2. From endpoint $b$ of any classification except LP back towards endpoint $a$
of any classification

3. From endpoints $a$ and $b$ of any classifications except LP towards an
interior point of $(a,b)$ selected by the program.

Initial values at $a$ are of the form $y(a)=\alpha1,(py^{\prime})(a)=\alpha2$
when $a$ is R or WR; and $[y,u](a)=\alpha1,[y,v](a)=\alpha2$ when $a$ is LCNO
or LCO.

Initial values at $b$ are of the form $y(b)=\beta1,(py^{\prime})(b)=\beta2$
when $b$ is R or WR; and $[y,u](b)=\beta1,[y,v](b)=\beta2$ when $b$ is LCNO or LCO.

In $(\ast)$, $\lambda$ is a user-chosen real number; while in the above
initial values, $(\alpha1,\alpha2)$ and $(\beta1,\beta2)$ are user-chosen
pairs of real numbers not both zero.

In the initial value case 3 above when the interval $(a,b)$ is finite, the
interior point selected by the program is generally near the midpoint of
$(a,b)$; when $(a,b)$ is infinite, no general rule can be given. Also if,
given $(\alpha1,\alpha2)$ and $(\beta1,\beta2)$, the $\lambda$ chosen is an
eigenvalue of the associated boundary value problem, the computed solution may
not be the corresponding eigenfunction -- the signs of the computed solutions
on either side of the interior point may be opposite.

The output for a solution of an initial value problem is in the form of stored
numerical data which can be plotted on the screen (see H16), or printed out in
graphical form if graphics software is available.

\medskip

H13: Indexing of eigenvalues.

The indexing of eigenvalues is an automatic facility in SLEIGN2. The following
general results hold for the separated boundary condition problem (see H7):

1. If neither endpoint $a$ or $b$ is LP or LCO, then the spectrum of the
eigenvalue problem is discrete (eigenvalues only), simple (eigenvalues all of
multiplicity 1), and bounded below with a single cluster point at $+\infty.$
The eigenvalues are indexed as $\{\lambda_{n}:n=0,1,2,...\}$, where
$\lambda_{n}<\lambda_{n+1}$ $(n=0,1,2,..)$, $\lim_{n\rightarrow+\infty}%
\lambda_{n}=+\infty$; and if $\{\psi_{n}:n=0,1,2,...\}$ are the corresponding
eigenfunctions, then $\psi_{n}$ has exactly $n$ zeros in the open interval $(a,b).$

2. If neither endpoint $a$ or $b$ is LP but at least one endpoint is LCO, then
the spectrum is discrete and simple as for 1, but with cluster points at both
$\pm\infty.$ The eigenvalues are indexed as $\{\lambda_{n}:n=0,\pm
1,\pm2,...\}$, where $\lambda_{n}<\lambda_{n+1}$ $($for $n<n+1$ and
$n=0,\pm1,\pm2,..),$ with $\lambda_{0}$ the smallest non-negative eigenvalue;
$\lim_{n\rightarrow-\infty}\lambda_{n}=-\infty$ and $\lim_{n\rightarrow
+\infty}\lambda_{n}=+\infty$; and if $\{\psi_{n}:n=0,\pm1,\pm2,...\}$ are the
corresponding eigenfunctions, then every $\psi_{n}$ has infinitely many zeros
in $(a,b).$

3. If one or both endpoints is LP, then there can be one or more intervals of
continuous spectrum for the boundary value problem in addition to some
(necessarily simple) eigenvalues. For these essentially more difficult
problems, SLEIGN2 can be used as an investigative tool to give qualitative and
possibly quantitative information on the spectrum.

For example, if a problem has continuous spectrum starting at a real number
$L$, then there may be no eigenvalues below $L$, any finite number of
eigenvalues below $L$, or an infinite (but countable) number of eigenvalues
below $L.$ SLEIGN2 can be used to compute $L$ (see the paper BEWZ on the
SLEIGN2 home page for an algorithm to compute $L$), and to determine the
number of these eigenvalues and compute them. In this respect, see xamples.f:
\#13 (Hydrogen Atom), \#17 (Morse Oscillator), \#21 (Fourier), and \#27
(J\"{o}rgens) as examples of success; and \#2 (Mathieu), \#14 (Marletta), and
\#28 (Behnke-Goerisch) as examples of failure.

The problem need not have a continuous spectrum, in which case if its discrete
spectrum is bounded below, then the eigenvalues are indexed and the
eigenfunctions have zero counts as in 1. If, on the other hand, the discrete
spectrum is unbounded below, then all the eigenfunctions have infinitely many
zeros in the open interval $(a,b)$. SLEIGN2 can, in principle, compute these
eigenvalues if neither endpoint is LP although this is a computationally
difficult problem. Note however, that SLEIGN2 has no algorithm when the
spectrum is discrete, unbounded above and below and one endpoint is LP, as in
xamples.f \#30.

In respect to the five classes of endpoints, the following identified examples
from xamples.f illustrate the spectral property of these boundary value problems:

1. Neither endpoint is LP or LCO:

\#1 (Legendre), \#2 (Bessel) with $-1/4<C<3/4,$ \#4 (Boyd), \#5 (Latzko).

2. Neither endpoint is LP, but at least one is LCO:

\#6 (Sears-Titchmarsh), \#7 (BEZ), \#19 (Donsch)

3. At least one endpoint is LP:

\#13 (Hydrogen Atom), \#14 (Marletta), \#20 (Krall), \#21 (Fourier) on [0,infinity).

\medskip

H14: Entry of eigenvalue index, initial guess, and tolerance.

For all self-adjoint boundary condition problems (see H7), SLEIGN2 calls for
input information options to compute \textit{either}

1. a single eigenvalue, \textit{or}

2. a series of eigenvalues.

\noindent In each case indexing of eigenvalues is called for (see H13).

1 above asks for data triples NUMEIG, EIG, TOL separated by commas. Here
NUMEIG is the integer index of the desired eigenvalue; NUMEIG can be negative
only when the problem is LCO at one or both endpoints. EIG allows for the
entry of an initial guess for the requested eigenvalue (if an especially good
one is available), or can be set to 0 in which case an initial guess is
generated by SLEIGN2 itself. TOL is the desired accuracy of the computed
eigenvalue. It is an absolute accuracy if the magnitude of the eigenvalue is 1
or less, and is a relative accuracy otherwise. Typical values for TOL might be
0.001 for moderate accuracy and 0.0000001 for high accuracy in single
precision. If TOL is set to 0, the maximum achievable accuracy is requested.

If the input data list is truncated with a ``\thinspace/\thinspace'' after
NUMEIG or EIG, then the remaining elements default to 0.

2 above asks for data triples NUMEIG1, NUMEIG2, TOL separated by commas. Here
NUMEIG1 and NUMEIG2 are the first and last integer indices of the sequence of
desired eigenvalues, with NUMEIG1
%TCIMACRO{\TEXTsymbol{<}}%
%BeginExpansion
$<$%
%EndExpansion
NUMEIG2; they can be negative only when the problem is LCO at one or both
endpoints. TOL is the desired accuracy of the computed eigenvalues. It is an
absolute accuracy if the magnitude of an eigenvalue is 1 or less, and is a
relative accuracy otherwise. Typical values for TOL might be 0.001 for
moderate accuracy and 0.0000001 for high accuracy in single precision. If TOL
is set to 0, the maximum achievable accuracy is requested.

If the input data list is truncated with a ``\thinspace/\thinspace'' after
NUMEIG2, then TOL defaults to 0.

For COUPLED self-adjoint boundary condition problems (see H7 and H17), SLEIGN2
also reports which eigenvalues are double. Double eigenvalues can occur only
for coupled boundary conditions with the parameter $\alpha=0$ or $\pi.$

\medskip

H15: IFLAG information.

All results are reported by SLEIGN2 with a flag identification. There are four
values of IFLAG:

1. The computed eigenvalue has an estimated accuracy within the

tolerance requested.

2. The computed eigenvalue does not have an estimated accuracy within the
tolerance requested, but is the best the program could obtain.

3. There seems to be no eigenvalue of index equal to NUMEIG.

4. The program has been unable to compute the requested eigenvalue.

\medskip

H16: Plotting.

After computing a single eigenvalue (see H14(1.)), but not a sequence of
eigenvalues (see H14(2.)), the eigenfunction can be plotted for separated
conditions and for coupled ones with $\alpha=0,\pi.$ If this data is desired,
respond $y$ when asked and SLEIGN2 will then compute eigenfunction data and
store them for subsequent use.

The user can ask that the eigenfunction data be in the form of either points
$(x,y)$ for $x\in(a,b)$, or points $(t,y)$ for $t$ in the standardized
interval $(-1,+1)$ mapped onto from $(a,b)$; the $t$-choice can be especially
helpful when the original interval is infinite. Additionally, the user can ask
for a plot of the so-called Pr\"{u}fer angle, in the $x$- or $t$-variables.

In both forms, once the choice has been made of the function to be plotted, a
crude plot is displayed on the monitor screen and the user is asked whether or
not to save the computed plot points in a file.

\medskip

H17: Indexing of eigenvalues for coupled self-adjoint problems.

The indexing of eigenvalues is an automatic facility in SLEIGN2. The following
general result holds for coupled boundary condition problems (see H7):

The spectrum of the eigenvalue problem is discrete (eigenvalues only). In
general the spectrum is not simple, but no eigenvalue exceeds multiplicity
$2$. The eigenvalues are indexed as $\{\lambda_{n}:n=0,1,2,...\}$ where
$\lambda_{n}<\lambda_{n+1}$ for $n=0,1,2,...,$and $\lim_{n\rightarrow+\infty
}\lambda_{n}=+\infty$ if neither endpoint is LCO. If one or both endpoints are
LCO the eigenvalues cluster at both $-\infty$ and at $+\infty,$ and all
eigenfunctions have infinitely many zeros.

If neither endpoint is LCO and $\alpha=0,\pi$, then the $n$-th eigenfunction
has $n-1,n,n+1$ zeros in the half open interval $[a,b)$ (also in $(a,b]$). All
three possibilities occur. Recall that in the case of double eigenvalues,
although the $n$-th eigenvalue is well defined there is an ambiguity about
which solution is declared as the $n$-th eigenfunction. If $\alpha\neq0,\pi$,
then the eigenfunction is non-real and has no zero in $(a,b)$, but each of the
real and imaginary parts of the $n$-th eigenfunction have the same zero
properties as mentioned above when $\alpha=0,\pi.$

The following identified examples from xamples.f are of special interest:

\#11 (Plum) on $[0,\pi],$ \#21 (Fourier) on $[0,\pi],$ \#25 (Meissner) on $[-1/2,+1/2].$
\end{document}
SHAR_EOF
fi # end of overwriting check
if test -f 'intro.tex'
then
	echo shar: will not over-write existing file "'intro.tex'"
else
cat << "SHAR_EOF" > 'intro.tex'
%% This document created by Scientific Word (R) Version 3.5

\documentclass[12pt]{amsart}%
\usepackage{graphicx}
\usepackage{amscd}
\usepackage{amsmath}%
\usepackage{amsfonts}%
\usepackage{amssymb}
%TCIDATA{OutputFilter=latex2.dll}
%TCIDATA{CSTFile=amsartci.cst}
%TCIDATA{Created=Mon Sep 06 21:20:17 1999}
%TCIDATA{LastRevised=Sunday, April 01, 2001 11:12:39}
%TCIDATA{<META NAME="GraphicsSave" CONTENT="32">}
%TCIDATA{<META NAME="DocumentShell" CONTENT="Journal Articles\amsnumb">}
%TCIDATA{Language=British English}
\newtheorem{theorem}{Theorem}
\theoremstyle{plain}
\newtheorem{acknowledgement}{Acknowledgement}
\newtheorem{algorithm}{Algorithm}[section]
\newtheorem{axiom}{Axiom}[section]
\newtheorem{case}{Case}[section]
\newtheorem{claim}{Claim}[section]
\newtheorem{conclusion}{Conclusion}[section]
\newtheorem{condition}{Condition}[section]
\newtheorem{conjecture}{Conjecture}[section]
\newtheorem{corollary}{Corollary}[section]
\newtheorem{criterion}{Criterion}[section]
\newtheorem{definition}{Definition}[section]
\newtheorem{example}{Example}[section]
\newtheorem{exercise}{Exercise}[section]
\newtheorem{lemma}{Lemma}[section]
\newtheorem{notation}{Notation}[section]
\newtheorem{problem}{Problem}[section]
\newtheorem{proposition}{Proposition}[section]
\newtheorem{remark}{Remark}[section]
\newtheorem{solution}{Solution}[section]
\newtheorem{summary}{Summary}[section]
\numberwithin{equation}{section}
\numberwithin{theorem}{section}
\newcommand{\thmref}[1]{Theorem~\ref{#1}}
\newcommand{\secref}[1]{\S\ref{#1}}
\newcommand{\lemref}[1]{Lemma~\ref{#1}}
\setlength{\oddsidemargin}{0.0in}
\setlength{\evensidemargin}{0.0in}
\setlength{\textwidth}{6.5in}
\setlength{\textheight}{9.0in}
\setlength{\headsep}{0.25in}
\setlength{\headheight}{0.0in}


\begin{document}
\title[Introduction to SLEIGN2]{Introduction to SLEIGN2}
\author{P.B. Bailey}
\author{W.N. Everitt}
\author{A. Zettl}
\address{Department of Mathematical Sciences, Northern Illinois University, DeKalb, IL
60115-2888, USA}
\date{01 March 2001 (File: intro.tex).}
\maketitle


The main purpose of this code is to compute eigenvalues and eigenfunctions of
regular and singular self-adjoint Sturm-Liouville problems (SLP) and to
approximate the continuous spectrum in the singular case. For a general
description of the analytical and numerical properties of the SLEIGN2 code see
\cite{BEZ} and \cite{BEZ3}.

These problems consist of a second order linear differential equation
\[
-(py^{\prime})^{\prime}+qy=\lambda wy\;\text{on}\;(a,b)
\]
together with boundary conditions (BC). The nature of the BC depends on the
regular or singular classification of the end points a and b. For both cases
the BC fall into two major classes: separated and coupled. The former are two
separate conditions, one at each endpoint; the latter are two coupled
conditions linking the values of the solution near the two endpoints, e.g.
periodic and semi-periodic boundary conditions. SLEIGN2 seems to be the only
general purpose code available for arbitrary self-adjoint BC, separated or
coupled, and for both regular and singular problems.

A number $\lambda$ for which there is a nontrivial solution satisfying the BC
is called an eigenvalue and such a solution is a (corresponding)
eigenfunction. If one or both endpoints are LP (see below or section 4 of HELP
for a definition) there may be points $\lambda$ in the spectrum in addition to
eigenvalues i.e. there may be continuous spectrum.

In the theory of SLP the coefficients $1/p$ and $q$ and the weight function
$w$ are assumed to be real-valued and locally Lebesgue integrable on $(a,b).$

To meet the needs of numerical computing techniques we make the stronger assumptions:

(i) The interval $(a,b)$ of R may be bounded or unbounded

(ii) $p,q$ and $w$ are real-valued functions on $(a,b)$

(iii) $p,q$ and $w$ are piecewise continuous on $(a,b)$

(iv) $p$ and $w$ are strictly positive on $(a,b)$.

For better error analysis in the numerical procedures, condition (iii) above
is replaced with

(iii)$^{\prime}$ $p,q$ and $w$ are four times continuously differentiable on
$(a,b)$.

To study a SLP using operator theory one associates a self-adjoint operator in
the weighted Hilbert space of square-integrable functions, with respect to the
weight $w$, on $(a,b)$, with each SLP in such a way that the spectrum of the
problem is the spectrum of the operator. In the case of a regular problem the
spectrum consists entirely of eigenvalues and these are bounded below (when
$p>0$ and $w>0$). This is still so for the case when each endpoint is either
regular (R) or singular limit-circle nonoscillatory (LCNO). In case one
endpoint is limit-circle oscillatory (LCO) and the other is not limit-point
(LP) then there are still only eigenvalues in the spectrum but these are not
bounded below. (The spectrum is never bounded above.)

If one or both endpoints is LP the spectrum may be extremely complicated.
There may be no eigenvalues, finitely many, or infinitely many. Some may be
embedded in the continuous spectrum. For $p=1,w=1,q(x)=\sin(x)$ on
$(-\infty,+\infty)$ there are no eigenvalues and the continuous spectrum
consists of the union of an infinite number of disjoint compact intervals.
(SLEIGN2 can be used to approximate this spectrum - see example 12 in the file
xamples.tex and the references quoted there.)

See the HELP file help.tex for a definition of the terms regular (R),
limit-circle (LC), limit-circle non-oscillatory (LCNO), limit-circle
oscillatory (LCO), limit-point (LP).

SLP problems are classified into various classes based on the classification
of the endpoints and on whether the boundary conditions are separated (S) or
coupled (C). We have the following categories:

1. R/R, S

2. R/R, C

3. R/LCNO or LCNO/R, S

4. R/LCNO or LCNO/R, C

5. R/LCO or LCO/R , S

6. R/LCO or LCO/R , C

7. LCNO/LCO or LCO/LCNO or LCO/LCO, S

8. LCNO/LCO or LCO/LCNO or LCO/LCO, C

9. LP/R or LP/LCNO or LP/LCO or R/LP or LCNO/LP or LCO/LP

10. LP/LP

For 9 there is only a separated condition at the non-LP endpoint and for 10
there are no boundary conditions at either end.

There are only two other major general purpose codes for computing eigenvalues
and eigenfunctions of Sturm-Liouville problems : SLEDGE (Fulton and Pruess)
and the earlier code SLEIGN (Bailey \textit{et al).} (There was another code,
written by Pryce and Marletta, available from the NAG library but the current
NAG library no longer includes such a code.)

SLEDGE uses a method based on piecewise constant approximations of the
coefficients of the differential equation; SLEIGN and SLEIGN2 both use the
Pr\"{u}fer transformation.

Both SLEIGN and SLEDGE are designed for separated regular boundary conditions
and both have a mechanism to automatically handle endpoints which are either
regular or singular but non-oscillatory. In the latter case if an endpoint is
LCNO the Friedrichs condition is usually, but not always, the one chosen by
the code. SLEDGE can also determine the LP/LC classification but only in a
restricted number of cases (the method requires that the coefficients $p,q$
and $w$ are analytic on $(a,b)$ and depends on the Frobenius method for series
solutions at regular singular endpoints); SLEIGN and SLEIGN2 do not have such
a facility but, for the sake of generality, rely on the user input of this information.

SLEIGN2 is the only general purpose code in existence which can, in principle,
handle arbitrary self-adjoint, separated or coupled, regular or singular,
boundary conditions, see the HELP file help.tex and \cite{BEZ3}. Problems with
coupled boundary conditions, see\cite{BEZ2}, at singular endpoints are
difficult to handle numerically, especially if one or both of the endpoints is LCO.

In addition to the above mentioned capabilities to compute eigenvalues and
eigenfunctions SLEIGN2 also computes the solution of an initial value problem
with the users choice of $\lambda$ and either a regular or singular initial condition.

When combined with the algorithm established in \cite{BEWZ}, SLEIGN2 can be
used to approximate the continuous spectrum.

An important feature of the SLEIGN2 program is its user friendly interface
contained in makepqw.f and drive.f. Users who want to bypass this interface
and use their own driver may wish to look at a sample driver; two such drivers
are provided, see (7) and (8) below.

The whole package consists of the following files:

1. A brief ``readme'' file readme.txt with basic information on how to run the code.

2. This introduction file intro.tex.

3. makepqw.f - This is an interactive Fortran file to input the coefficient
functions $p,q,w$ and, if necessary, the functions $u,v$ which define the
singular boundary conditions

4. drive.f - This is an interactive Fortran file containing the driver, a HELP
file help.tex, and a ``user friendly'' interface.

5. sleign2.f - The main code for the computation of eigenvalues and eigenfunctions.

6. xamples.f - A Fortran file with 32 examples ready to run. These examples
were chosen to illustrate various features of the code.

7. sepdr.f - A sample driver for separated regular or singular boundary conditions.

8. coupdr.f - A sample driver for coupled regular or singular boundary conditions.

9. xamples.tex - A LaTeX file containing information about the 32 examples.

10. help.tex - A LaTeX file with information about endpoint classifications,
boundary conditions etc. It is a separate text file and it can also be
accessed from both makepqw.f and drive.f.

11. autoinput.txt- A file describing an ``automatic'' method for using SLEIGN2
which avoids the user friendly ``question and answer'' format; this is
recommended for experienced users only.

When an eigenfunction has been computed it is stored. If it is real-valued, it
can be examined:

(i) by printing out the numerical data

(ii) by using the discrete graph plotter in the program

(iii) by using a local graph plotter.

Full details are given in HELP; see the file help.tex.

All six of the Fortran files in the SLEIGN2 package are in single precision.

\begin{thebibliography}{9}                                                                                                %

\bibitem {BEZ}P.B. Bailey, W.N. Everitt and A. Zettl, \emph{Computing
eigenvalues of singular Sturm-Liouville problems}, Results in Mathematics,
\textbf{20 }(1991), 391-423.

\bibitem {BEZ2}P.B. Bailey, W.N. Everitt and A. Zettl, \emph{Regular and
singular Sturm-Liouville problems with coupled boundary conditions}, Proc.
Royal Soc. Edinburgh (A) \textbf{126} (1996), 505-514.

\bibitem {BEZ3}P.B. Bailey, W.N. Everitt and A. Zettl, \emph{The SLEIGN2
Sturm-Liouville code.} (To appear in ACM Trans. Math. Software).

\bibitem {BEWZ}P.B. Bailey, W.N. Everitt, J. Weidmann and A. Zettl,
\emph{Regular approximation of singular Sturm-Liouville problems}. Results in
Mathematics \textbf{23} (1993), 3-22.
\end{thebibliography}
\end{document}
SHAR_EOF
fi # end of overwriting check
if test -f 'readme.txt'
then
	echo shar: will not over-write existing file "'readme.txt'"
else
cat << "SHAR_EOF" > 'readme.txt'

 
                   SLEIGN2: THE README.TXT FILE
  
   01 March 2001; P.B. BAILEY, W.N. EVERITT AND A. ZETTL
  
  PLEASE read carefully this readme.txt file and the intro.tex file before 
 using the SLEIGN2 package for the first time.
  
 	There are eleven files in the SLEIGN2 package as follows:
 
 	Two ASCII files:
 	autoinput.txt  readme.txt
 
 	Six FORTRAN files:
 	coupdr.f  drive.f  makepqw.f  sepdr.f  sleign2.f  xamples.f
 
 	Three AMS-LaTeX files (these files can be compiled in the UNIX latex
 compiler, and then printed out in hard copy):
 	help.tex  intro.tex  xamples.tex   
  
   To run one of the examples in the xamples.f file in an UNIX environment 
 with a Fortran77 (or Fortran77) compiler, enter the following command:
  
 f77 xamples.f  drive.f  sleign2.f  -o  xamples.x
 (Replace f77 by f90 if you want to use the Fortran90 compiler.)
  
   This will create the executable file xamples.x and object files drive.o
 and sleign2.o. Now run xamples.x whenever you want to work an example from 
 the list of examples in the xamples.f file. The hard printed copy of the
 file xamples.tex provides detailed information on each one of the 32
 chosen examples in the file xamples.x.
  
   To run your own problem proceed as follows:
  Step 1: Enter the command 
        f77  makepqw.f  -o  makepqw.x
  Step 2: Run
        makepqw.x  
   (This interactive program will ask you for a file name - this must end 
 in .f - for example, if your chosen problem has the name bloggs then enter 
 bloggs.f). This file, after makepqw.x has been run, will contain the 
 subroutines for p,q,w and, if necessary, the functions u, v and U, V which 
 are used to define singular limit-circle boundary conditions at one or both 
 endpoints.
  Step 3: Enter the command
        f77  bloggs.f  drive.f  sleign2.f  -o  bloggs.x
   (drive.f and sleign2.f can be replaced with drive.o and sleign2.o 
 if these .o files are available to speed up the compilation; these -o 
 files are created by the first compilation.)
  Step 4: Run
        bloggs.x  
   (The user is asked to provide information for the code to run
 bloggs.x, for example: boundary conditions, eigenvalue indexes, 
 numerical tolerances, name for report file if desired. See the autoinput.txt 
 file for instructions on how to automate the input of the required 
 information).
  
  The file sepdr.f is a sample driver for separated regular and singular
 boundary conditions; coupdr.f is a sample driver program for coupled regular
 and singular boundary conditions. Experienced users who want to bypass the 
 extensive user friendly interface provided in drive.f and makepqw.f, and
 use their own driver may wish to look at these two sample drivers.

  Note that the above procedures may have to be modified for non UNIX 
 environments, e.g. DOS or APPLE.
 
  Note also that in running xamples.x or bloggs.x the user has access to
 the interactive help device; at any point where the program halts  
 type h <ENTER> for access; to return to the point in the program where
 help was accessed, type r <ENTER>. Additional information on the help 
 device can be found in the intro.tex file. The whole of the help data
 can be printed out separately from the file help.tex and the user is
 advised to have a copy available for consultation when working with the
 code files for the first time.
 
  See the autoinput.txt file for instructions on how to bypass these 
 program halts in xamples.x and bloggs.x
  
  All six of the FORTRAN .f files are supplied in single precision; 
 to convert these files to double precision replace the string `  REAL' by 
 the string `  DOUBLE PRECISION' throughout. (Note the two spaces in front of 
 REAL and in front of DOUBLE PRECISION - these spaces are important.)  
 In UNIX this can be effected within the vi editor as follows:
  
 :1,$ s/  REAL/  DOUBLE PRECISION
  
  It is recommended that the user try the program in single precision and 
 switch to double precision as required.
  
  Additional information on the SLEIGN2 package can be found in the intro.tex
 and help.tex files. See also a hard printed copy of the file bailey.tex,
 available in the Zettl/Sleign2 directory detailed below, which contains
 an account of the analytical and numerical properties of the SLEIGN2
 code, together with an extensive list of references.
  
  All of the eleven files in the SLEIGN2 package can be obtained by anonymous
 ftp from the computer
        ftp.math.niu.edu
 and the directory
        /pub/papers/Zettl/Sleign2
  
  A sample session using the traditional UNIX or DOS ftp client is as 
 follows:
  
  Step 1. At the UNIX or DOS prompt type
              fop  ftp.math.niu.edu
  
  Step 2. In response to the request for user id type
              fop
  
  Step 3. In response to the request for username type your e-mail address;
             for example:
             w.n.everitt@bham.ac.uk
  
  Step 4. At the ftp> prompt enter:
             cd  pub/papers/Zettl/Sleign2
             get  readme.txt
             quit
  
  This will transfer the readme.txt file to your current directory and close 
 the connection.
  
  At the ftp> prompt you can also enter 'ls' to see the listing of other 
 files available in the Sleign2 directory.
  
  Users who prefer World Wide Web software such as Netscape 
 or lynx can specify the URL
            ftp://ftp.math.niu.edu/pub/papers/Zettl/Sleign2
 to access the Sleign2 directory; this software will then show the list 
 of files available in it.
 
  Replacing the directory "Sleign2" with the directory "Pub papers" and
 repeating the above procedures will make available a number of recent papers
 which are related to the SLEIGN2 package. For example, the paper "BEWZ" 
 (Bailey, Everitt, Weidmann and Zettl) contains some results which can be 
 combined with SLEIGN2 to approximate the continuous (essiential) spectrum 
 of singular limit-point Sturm-Liouville problems.
  
  All eleven files of the SLEIGN2 package and a number of recent publications
 related to it, can also be accessed through the web page:
           http://www.math.niu.edu/~zettl/SL2/
  
  All suggestions, comments and criticisms are welcome; please send all 
 comments to Tony Zettl at
          zettl@math.niu.edu
  
     Paul Bailey, Norrie Everitt and Tony Zettl 
 (with the assistance of Burt Garbow.)
  
  Acknowledgement. The authors are grateful to their colleagues Eric Behr, 
 Qingkai Kong and Hongyou Wu for help and advice at a number of stages 
 in the development of this program. Some of the theoretical underpinnings 
 of the algorithm for coupled boundary conditions were obtained jointly 
 with Michael Eastham, Qingkai Kong and Hongyou Wu.

  A special thanks to Eric Behr for his help throughout the development of
 the code, for setting up the public access through the Internet and the
 world wide web, and for informed advice.

 Department of Mathematical Sciences, Northern Illinois University 
 DeKalb, IL 60115-2888, USA



SHAR_EOF
fi # end of overwriting check
if test -f 'xamples.tex'
then
	echo shar: will not over-write existing file "'xamples.tex'"
else
cat << "SHAR_EOF" > 'xamples.tex'
%% This document created by Scientific Word (R) Version 3.5

\documentclass[12pt]{amsart}%
\usepackage{graphicx}
\usepackage{amscd}
\usepackage{amsmath}%
\usepackage{amsfonts}%
\usepackage{amssymb}
%TCIDATA{OutputFilter=latex2.dll}
%TCIDATA{CSTFile=amsartci.cst}
%TCIDATA{Created=Tue Mar 09 09:05:39 1999}
%TCIDATA{LastRevised=Wednesday, April 04, 2001 12:27:55}
%TCIDATA{<META NAME="GraphicsSave" CONTENT="32">}
%TCIDATA{<META NAME="DocumentShell" CONTENT="Journal Articles\amslatex">}
%TCIDATA{Language=British English}
\newtheorem{theorem}{Theorem}
\theoremstyle{plain}
\newtheorem{acknowledgement}{Acknowledgement}
\newtheorem{algorithm}{Algorithm}
\newtheorem{axiom}{Axiom}
\newtheorem{case}{Case}
\newtheorem{claim}{Claim}
\newtheorem{conclusion}{Conclusion}
\newtheorem{condition}{Condition}
\newtheorem{conjecture}{Conjecture}
\newtheorem{corollary}{Corollary}
\newtheorem{criterion}{Criterion}
\newtheorem{definition}{Definition}
\newtheorem{example}{Example}
\newtheorem{exercise}{Exercise}
\newtheorem{lemma}{Lemma}
\newtheorem{notation}{Notation}
\newtheorem{problem}{Problem}
\newtheorem{proposition}{Proposition}
\newtheorem{remark}{Remark}
\newtheorem{solution}{Solution}
\newtheorem{summary}{Summary}
\numberwithin{equation}{section}
\newcommand{\thmref}[1]{Theorem~\ref{#1}}
\newcommand{\secref}[1]{\S\ref{#1}}
\newcommand{\lemref}[1]{Lemma~\ref{#1}}
\setlength{\oddsidemargin}{0.0in}
\setlength{\evensidemargin}{0.0in}
\setlength{\textwidth}{6.5in}
\setlength{\textheight}{8.5in}
\setlength{\headsep}{0.25in}
\setlength{\headheight}{0.0in}


\begin{document}
\title[SLEIGN2]{SLEIGN2\\Commentary on the individual examples in xamples.f}
\author{P.B. Bailey}
\address{P.B. Bailey, c/o Department of Mathematical Sciences, Northern Illinois
University, DeKalb, IL 60155-2888, USA}
\email{70621.3674@compuserve.com}
\author{W.N. Everitt}
\address{W.N. Everitt, School of Mathematics and Statistics, University of Birmingham,
Edgbaston, Birmingham B15 2TT, England, UK}
\email{w.n.everitt@bham.ac.uk}
\author{A. Zettl}
\address{A. Zettl, Department of Mathematical Sciences, Northern Illinois University,
DeKalb, IL 60155-2888, USA}
\email{zettl@math.niu.edu}
\date{01 March 2001 (File: xamples.tex)\quad\AmS  -\LaTeX  {}; prepared in
\textsl{Scientific Word\/}{}}
\maketitle


\section{Introduction}

The examples in this commentary have been chosen to illustrate the
capabilities and limitations of the program SLEIGN2. Many of the examples have
been chosen from special cases of the well known and well studied ``special
functions'' of mathematical analysis. All possible cases of endpoint
classification are represented; all types of self-adjoint boundary conditions
are included, \textit{i.e.} regular or singular, and separated or coupled. In
the limit-circle case examples are given for which the endpoints may be
oscillatory or non-oscillatory.

For a general account of both the analytical and numerical properties of the
SLEIGN2 code see the paper by Bailey, Everitt and Zettl \cite{BEZ3}.

For all 32 examples in this commentary the following data have been entered:

(i) the Sturm-Liouville differential equation and associated interval on the
real line $\mathbb{R}$

(ii) the range of any parameters in the differential equation; this serves to
remind the reader that numerical values for these parameters have to be
entered in some of the examples given in xamples.x, for any such example to run

(iii) the endpoint classification of the differential equation, in the
relevant Hilbert function space $L^{2}((a,b);w)$

(iv) the boundary condition functions $u,v$ required for any LCNO or LCO endpoint

(v) comments on any particular features of the numbered example.

The data in items (i) to (iv) above can also be found in the file xamples.f,
but this search requires scrolling through the file as the data items, for any
particular example, are located in different sections.

For some of these examples it is possible to give explicit information on the
spectrum of associated boundary value problems; this can take the form of
providing explicit formulas for eigenvalues against which the program
calculated results can be compared.

In all cases of limit-circle endpoints, boundary condition functions $u$ and
$v$ have been entered as part of the example data. In the case of limit-circle
non-oscillatory endpoints we use the convention that the boundary condition
function $u$ determines the principal or Friedrichs boundary condition.

On selecting a numbered example in the file xamples.x, the differential
equation is displayed in Fortran, and details of the endpoint classification
given. If information on the form of the boundary condition functions $u$ and
$v$ is required then the user should scroll separately through the file
xamples.f to the appropriate numbered part of the $u,v$ section or refer to
the information in this commentary.

Some regular and weakly regular problems can be more successfully run using
the limit-circle non-oscillatory (LCNO) algorithm; details are given below for
some of the examples.

It should be noted that for limit-circle oscillatory problems it is sometimes
difficult to compute numerically more than a few of the eigenvalues. This is
due, at least in part, to the rapid growth of the eigenvalues in both the
positive and the negative directions; but particularly in the negative direction.

The Laguerre problem, Example 22, has a discrete spectrum and for one
particular boundary condition the eigenvalues are known explicitly, leading to
the classical Laguerre orthogonal polynomials. In this case numerical values
to confirm the details of the spectrum can also be obtained by use of the
Liouville transformation; this leads to the Laguerre/Liouville Example 23, for
which the program is successful over a wide range of boundary conditions.

The Liouville transformation has also been applied to the Jacobi equation,
Example 16, to yield the Jacobi/Liouville Example 24.

The Liouville transformation is sometimes useful in other cases to put a
Sturm-Liouville differential equation into a form more suitable for numerical
computation; see in particular the Bessel Example 2.

\textbf{Parameters.} The reader is reminded that many of the examples involve
the choice of one or more parameters; the range of these parameters is given
when the numbered differential equation is displayed in xamples.x; if a choice
of parameter is made outside of the stated range the program may abort.

\section{Remarks on the individual examples.}

\begin{enumerate}
\item \textbf{Classical Legendre equation} (see \cite[Chapter IV]{T})
\[
-\left(  \left(  1-x^{2}\right)  y^{\prime}(x)\right)  ^{\prime}+\tfrac{1}%
{4}y(x)=\lambda y(x)\;\text{for all}\;x\in(-1,+1).
\]

Endpoint classification in $L^{2}(-1,+1)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-1$ & LCNO\\
$+1$ & LCNO\\\hline
\end{tabular}
\]
$\quad$

For both endpoints the boundary condition functions $u,v$ are given by (note
that $u$ and $v$ are solutions of the Legendre equation for $\lambda=1/4$)%
\[
u(x)=1\quad\quad v(x)=\frac{1}{2}\ln\left(  \frac{1+x}{1-x}\right)
\;\text{for all}\;x\in(-1,+1).
\]

\begin{itemize}
\item[(i)] The Legendre polynomials are obtained by taking the principal
(Friedrichs) boundary condition at both endpoints $\pm1:$ enter
$A1=1,A2=0,\;B1=1,B2=0;$ \textit{i.e.} take the boundary condition function
$u$ at $\pm1$; eigenvalues: $\lambda_{n}=(n+1/2)^{2}\ ;$ $n=0,1,2,\cdots;$
eigenfunctions: Legendre polynomials $P_{n}(x)$.

\item[(ii)] Enter $A1=0,\;A2=1,\;B1=0,\;B2=1,$ \textit{i.e.} use the boundary
condition function $v$ at $\pm1$; eigenvalues: $\mu_{n};$ $n=0,1,2,\cdots$ but
no explicit formula is available; eigenfunctions are logarithmically unbounded
at $\pm1$.

\item[(iii)] Observe that $\mu_{n}<\lambda_{n}<\mu_{n+1};$ $n=0,1,2\cdots$.
\end{itemize}

\item \textbf{The Bessel equation }(see \cite[Chapter IV]{T})
\[
-y^{\prime\prime}(x)+\left(  \nu^{2}-1/4\right)  x^{-2}y(x)=\lambda
y(x)\;\text{for all}\;x\in(0,+\infty)
\]
with the parameter $\nu\in\lbrack0,+\infty).$ This is the Liouville form of
the classical Bessel equation.

Endpoint classification in $L^{2}(0,+\infty)$:%
\[%
\begin{tabular}
[c]{ccc}\hline
Endpoint & Parameter $\nu$ & Classification\\\hline
$0$ & For $\nu=1/2$ & R\\
$0$ & For all $\nu\in\lbrack0,1)$ but $\nu\neq1/2$ & LCNO\\
$0$ & For all $\nu\in\lbrack1,\infty)$ & LP\\\hline
$+\infty$ & For all $\nu\in\lbrack0,\infty)$ & LP\\\hline
\end{tabular}
\]

For endpoint $0$ and $\nu\in(0,1)$ but $\nu\neq1/2,$ the LCNO boundary
condition functions $u,v$ are determined by, for all$\;x\in(0,+\infty),$
\[%
\begin{tabular}
[c]{ccc}\hline
Parameter & $u$ & $v$\\\hline
$\nu\in(0,1)$ but $\nu\neq1/2$ & $x^{\nu+1/2}$ & $x^{-\nu+1/2}$\\
$\nu=0$ & $x^{1/2}$ & $x^{1/2}\ln(x)$\\\hline
\end{tabular}
\
\]

(a) Problems on $(0,1]$ with $y(1)=0$:

\noindent For $0\leq\nu<1,\nu\neq\frac{1}{2}:$ the Friedrichs case:
$A1=1,A2=0$ yields the classical Fourier-Bessel series; here $\lambda
_{n}=j_{\nu,n}^{2}$ where $\{j_{\nu,n}:n=0,1,2,\ldots\}$ are the zeros
(positive) of the Bessel function $J_{\nu}(\cdot).$

\noindent For $\nu\geq1;$ LP at $0$ so that there is a unique boundary value
problem with $\lambda_{n}=j_{\nu,n}^{2}$ as before.

(b) Problems on $[1,\infty)$ all have continuous spectrum on $[0,\infty)$:

\noindent For Dirichlet and Neumann boundary conditions there are no eigenvalues.

\noindent For $A1=A2=1$ at $1$ there is one isolated negative eigenvalue.

(c) Problems on $(0,\infty)$ all have continuous spectrum on $[0,\infty)$:

\noindent For $\nu\geq1$ there are no eigenvalues.

\noindent For $0\leq\nu<1$ the Friedrichs case is given by $A1=1,A2=0;$ there
are no eigenvalues.

\noindent For $\nu=0.45$ and $A1=10,A2=-1$ there is one isolated eigenvalue
near to the value $-175.57.$\noindent

\item \textbf{The Halvorsen equation}%
\[
-y^{\prime\prime}(x)=\lambda x^{-4}\exp(-2/x)y(x)\;\text{for all }%
x\in(0,+\infty)
\]

The endpoint classification in the weighted space $L^{2}((0,+\infty;x^{-4}%
\exp(-2/x))$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & WR\\
$+\infty$ & LCNO
\end{tabular}
\]

For the endpoints $0$ and $+\infty$ in the WR and LCNO classification the
boundary condition functions $u,v$ are determined by%
\[%
\begin{tabular}
[c]{ccc}\hline
Endpoint & $u$ & $v$\\\hline
$0$ & $x$ & $1$\\
$+\infty$ & $1$ & $x$\\\hline
\end{tabular}
\]

Since this equation is WR at $0$ and LCNO at $+\infty$ the spectrum is
discrete and bounded below for all boundary conditions. However, this example
illustrates that even a R or WR endpoint can cause difficulties for
computation. The program fails on R at $0$; is successful for WR at $0$; is
successful for LCNO at $0.$

At $0$, the principal boundary condition entry is $A1=1,\ A2=0$; at $\infty$
with $u(x)=1,\ v(x)=x$ the principal boundary condition entry is also
$A1=1,\;A2=0,$ but note the interchange of the definitions of $u$ and $v$ at
these two endpoints.

\item \textbf{The Boyd equation}%
\[
-y^{\prime\prime}(x)-x^{-1}y(x)=\lambda y(x)\;\text{for all}\;x\in
(-\infty,0)\cup(0,+\infty).
\]

Endpoint classification in $L^{2}(-\infty,0)\cup$ $L^{2}(0,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$0-$ & LCNO\\
$0+$ & LCNO\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

For both endpoints $0-$ and $0+$%
\[
u(x)=x\quad\quad v(x)=x\ln(\left|  x\right|  )\;\text{for all}\;x\in
(-\infty,0)\cup(0,+\infty).
\]

This equation arises in a model studying eddies in the atmosphere; see
\cite{B}. There is no explicit formula for the eigenvalues of any particular
boundary condition; eigenfunctions can be given in terms of Whittaker
functions; see \cite[Example 3]{BEZ}.

\item \textbf{The regularized Boyd equation}%
\[
-(p(x)y^{\prime}(x))^{\prime}+q(x)y(x)=\lambda w(x)y(x)\;\text{for all}%
\;x\in(-\infty,0)\cup(0,+\infty)
\]
where%
\[
p(x)=r(x)^{2}\quad q(x)=-r(x)^{2}\left(  \ln(\left|  x\right|  \right)
^{2}\quad w(x)=r(x)^{2}%
\]
with%
\[
r(x)=\exp\left(  -(x\ln(\left|  x\right|  )-x)\right)  \;\text{for all}%
\;x\in(-\infty,0)\cup(0,+\infty).
\]

Endpoint classification in $L^{2}(-\infty,0)\cup$ $L^{2}(0,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$0-$ & WR\\
$0+$ & WR\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

This is a WR form of Example 4; the singularity at zero has been regularized
using quasi-derivatives. There is a close relationship between the examples 4
and 5; in particular they have the same eigenvalues - see \cite{AEZ}. For a
general discussion of regularization using non-principal solutions see
\cite{NZ}. For numerical results see \cite[Example 3]{BEZ}.

\item \textbf{The Sears-Titchmarsh equation}%
\[
-(xy^{\prime}(x))^{\prime}-xy(x)=\lambda x^{-1}y(x)\;\text{for all}%
\;x\in(0,+\infty).
\]

Endpoint classification in $L^{2}(0,\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & LP\\
$+\infty$ & LCO\\\hline
\end{tabular}
\]

For the endpoint $+\infty$%
\[
u(x)=x^{-1/2}\left(  \cos(x)+\sin(x)\right)  \quad v(x)=x^{-1/2}\left(
\cos(x)-\sin(x)\right)  \;\text{for all}\;x\in(0,+\infty).
\]

This differential equation has one LP and one LCO endpoint. For details of
boundary value problems on $[1,\infty)$ see \cite[Example 4]{BEZ}. The
equation was studied originally in \cite[Chapter IV]{T}; but see \cite{ST}.

For problems on $[1,\infty)$ the spectrum is simple and discrete but unbounded
both above and below.

Numerical results are given in \cite[Example 4]{BEZ}.

\item \textbf{The BEZ equation}%
\[
-(xy^{\prime}(x))^{\prime}-x^{-1}y(x)=\lambda y(x)\;\text{for all}%
\;x\in(-\infty,0)\cup(0,+\infty).
\]

Endpoint classification in $L^{2}(-\infty,0)\cup$ $L^{2}(0,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$0-$ & LCO\\
$0+$ & LCO\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

For both endpoints $0-$ and $0+$:%
\[
u(x)=\cos\left(  \ln(\left|  x\right|  )\right)  \quad\quad v(x)=\sin\left(
\ln(\left|  x\right|  )\right)  \;\text{for all}\;x\in(-\infty,0)\cup
(0,+\infty).
\]

This example is similar to the differential equation of Example 6. On the
interval $(0,1]$ there is a singularity at $0$ in LCO; the equation is R at 1.

For numerical results see \cite[Example 5]{BEZ}.

\item \textbf{The Laplace tidal wave equation}%
\[
-(x^{-1}y^{\prime}(x))^{\prime}+\left(  kx^{-2}+k^{2}x^{-1}\right)
y(x)=\lambda y(x)\;\text{for all}\;x\in(0,+\infty)
\]
where the parameter $k\in(-\infty,0)\cup(0,+\infty)$

Endpoint classification in $L^{2}(0,\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & LCNO\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

For the endpoint $0$:%
\[
u(x)=x^{2}\quad\quad v(x)=x-k^{-1}\;\text{for all}\;(0,+\infty).
\]

This equation is a particular case of the more general equation with this
name; for details and references see \cite{H}.

There are no representations for solutions of this differential equation in
terms of the well-known special functions. Thus to determine boundary
conditions at the LCNO endpoint $0$ use has to be made of maximal domain
functions; see the $u,\ v$ functions given above. Numerical results for some
boundary value problems and certain values of the parameter $k,$ are given in
\cite[Example 8]{BEZ}.

\item \textbf{The Latzko equation}%
\[
-((1-x^{7})y^{\prime}(x))^{\prime}=\lambda x^{7}y(x)\;\text{for all}%
\;x\in(0,1].
\]

Endpoint classification in $L^{2}(0,1]$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & WR\\
$1$ & LCNO\\\hline
\end{tabular}
\]

For the endpoint $1$:%
\[
u(x)=1\quad\quad v(x)=-\ln(1-x)\;\text{for all}\;(0,1).
\]

This differential equation has a long and celebrated history; see \cite[Pages
43 to 45]{F}. There is a LCNO singularity at the endpoint $1$ which requires
the use of maximal domain functions; see the $u,\ v$ functions given above.
The endpoint $0$ is WR due to the fact that $w(0)=0$.

This example is similar in some respects to the Legendre equation of Example 1 above.

For numerical results see \cite[Example 7]{BEZ}.

\item \textbf{A weakly regular equation}%
\[
-(x^{1/2}y^{\prime}(x))^{\prime}=\lambda x^{-1/2}y(x)\;\text{for all}%
\;x\in(0,+\infty).
\]

Endpoint classification in $L^{2}(0,1]$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & WR\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

This is a devised example to illustrate the computational difficulties of
weakly regular problems.

The differential equation gives $p(0)=0$ and $w(0)=\infty$ but nevertheless
$0$ is a regular endpoint in the Lebesgue integral sense; however $0$ has to
be classified as weakly regular in the computational sense.

The Liouville normal form of this equation is the Fourier equation, see
Example 21 below; thus numerical results for this WR problem can be checked
against numerical results from (i) a R problem, (ii) the roots of
trigonometrical equations, and (iii) a LCNO problem (see below).

There are explicit solutions of this equation given by%
\[
\cos(2x^{1/2}\surd\lambda)\ \ ;\ \sin(2x^{1/2}\surd\lambda)/\surd\lambda.
\]

If $0$ is treated as a LCNO endpoint then $u,\ v$ boundary condition functions
are%
\[
u(x)=2x^{1/2}\quad\quad\ v(x)=1.
\]

The regular Dirichlet condition$\;y(0)=0$ is equivalent to the singular
condition $[y,u](0)=0$. Similarly the regular Neumann condition $(py^{\prime
})(0)=0$ is equivalent to the singular condition $[y,\ v](0)=0$.

The following indicated boundary value problems have the given explicit
formulae for the eigenvalues:
\begin{align*}
y(0)  &  =0\text{{ or }}[y,\ u](0)=0,\text{{ and }}y(1)=0\text{ gives}\\
\;\;\lambda_{n}  &  =((n+1)\pi)^{2}/4\ (n=0,1,...)
\end{align*}%
\begin{align*}
(py^{\prime})(0)  &  =0\text{{ or }}[y,v](0)=0,\text{{ and }}(py^{\prime
})(1)=0\text{ gives}\\
\;\;\lambda_{n}  &  =\left(  (n+\tfrac{1}{2})\pi\right)  ^{2}/4\ (n=0,1,...).
\end{align*}

\item \textbf{The Plum equation}%
\[
-(y^{\prime}(x))^{\prime}+100\cos^{2}(x)y(x)=\lambda y(x)\;\text{for
all}\;x\in(-\infty,+\infty).
\]

Endpoint classification in $L^{2}(-\infty,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

Plum \cite{P} computed the first seven eigenvalues for periodic eigenvalues on
the interval $[0,\pi],$\textit{i.e.}%
\[
y(0)=y(\pi)\quad\quad\quad y^{\prime}(0)=y^{\prime}(\pi),
\]
using a numerical homotopy method together with interval arithmetic, and
obtained rigorous bounds for these seven computed eigenvalues. In double
precision the SLEIGN2 computed eigenvalues are in good agreement with these
guaranteed bounds.

\item \textbf{The Mathieu equation}%
\[
-y^{\prime\prime}(x)+2k\cos(2x)y(x)=\lambda y(x)\;\text{for all}\;x\in
(-\infty,+\infty)
\]
where that parameter $k\in(-\infty,0)\cup(0,+\infty).$

Endpoint classification in $L^{2}(-\infty,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

The classical Mathieu equation has a celebrated history and voluminous
literature. There are no eigenvalues for this problem on $(-\infty,+\infty)$.
There may be one negative eigenvalue of the problem on $[0,\infty)$ depending
on the boundary condition at the endpoint $0$. The continuous (essential)
spectrum is the same for the whole line or half-line problems and consists of
an infinite number of disjoint closed intervals. The endpoints of these - and
thus the spectrum of the problem - can be characterized in terms of periodic
and semi-periodic eigenvalues of Sturm-Liouville problems on the compact
interval $[0,2\pi]$; these can be computed with SLEIGN2.

The above remarks also apply to the general Sturm-Liouville equation with
periodic coefficients of the same period; the so-called Hill's equation.

Of special interest is the starting point of the continuous spectrum - this is
also the oscillation number of the equation. For the Mathieu equation
($p=1,q=\cos(x),w=1$) on both the whole line and the half line it is
approximately -0.378; this result may be obtained by computing the first
eigenvalue $\lambda_{0}$ of the periodic problem on the interval $[0,2\pi]$.

\item \textbf{The hydrogen atom equation}

It is convenient to take this equation in two forms:%
\begin{equation}
-y^{\prime\prime}(x)+(kx^{-1}+hx^{-2})y(x)=\lambda y(x)\;\text{for all}%
\;x\in(0,+\infty) \tag{1}%
\end{equation}
where the two independent parameters $h\in\lbrack-1/4,+\infty)$ and
$k\in\mathbb{R},$ and%
\begin{equation}
-y^{\prime\prime}(x)+(kx^{-1}+hx^{-2}+1)y(x)=\lambda y(x)\;\text{for
all}\;x\in(0,+\infty) \tag{2}%
\end{equation}
where the two independent parameters $h\in(-\infty,-1/4)$ and $k\in\mathbb{R}.$

Note that form (2) is introduced as a device to aid the numerical computations
in the difficult LCO case; it forces the boundary value problem to have a
non-negative eigenvalue.

Endpoint classification, for both forms (1) and (2), in $L^{2}(0,+\infty)$:%
\[%
\begin{tabular}
[c]{cccc}\hline
Endpoint & Form & Parameters & Classification\\\hline
$0$ & 1 & $h=k=0$ & R\\
$0$ & 1 & $h=0,k\in\mathbb{R}\,\backslash\,\{0\}$ & LCNO\\
$0$ & 1 & $-1/4\leq h<3/4,h\neq0,k\in\mathbb{R}$ & LCNO\\
$0$ & 1 & $h\geq3/4,k\in\mathbb{R}$ & LP\\
$0$ & 2 & $h<-1/4,k\in\mathbb{R}$ & LCO\\\hline
$+\infty$ & 1 and 2 & $h,k\in\mathbb{R}$ & LP\\\hline
\end{tabular}
\]

This is the two parameter version of the classical one-dimensional equation
for quantum modelling of the hydrogen atom; see \cite[Section 10]{J}.

For form (1) and all $h,k$ there are no positive eigenvalues; form (2) is best
considered in the single LCO case when some eigenvalues are positive; in form
(1) there is a continuous spectrum on $[0,\infty)$; in form (2) there is a
continuous spectrum on $[1,\infty).$

If $k=0$ the equation reduces to Bessel, see Example 2 above with $h=\nu
^{2}-1/4$.

\noindent\textbf{Results for form (1)}

In all cases below $\rho$ is defined by
\[
\rho:=(h+1/4)^{1/2}\text{ for }h\geq-1/4.
\]

\begin{enumerate}
\item For $h\geq3/4$ and $k\geq0$ no boundary conditions are required; there
is at most one negative eigenvalue and $\lambda=0$ may be an eigenvalue; for
$h\geq3/4$ and $k<0$ there are infinitely many negative eigenvalues given by
\[
\lambda_{n}=\frac{-k^{2}}{(2n+2\rho+1)^{2}},\ \rho=(h+1/4)^{1/2}%
>0,\ n=0,1,2,3,\ldots
\]
and $\lambda=0$ is not an eigenvalue.

\item For $h=0$ and $k\in\mathbb{R}\,\backslash\,\{0\}$ a boundary condition
is required at $0$ for which
\[
u(x)=x\quad\quad\ v(x)=1+k\,x\ln(x).
\]
For some computed eigenvalues see \cite{BEZ} and \cite[Section 10]{J}.

\item For $-1/4<h<3/4,$ \textit{i.e.} $0<\rho<1,$ and $h\neq0,$ \textit{i.e.}
$\rho\not =1/2$, then a boundary condition is required at $0$ for which, for
all $x\in(0,+\infty),$%
\[
u(x)=x^{\frac{1}{2}+\rho}\quad\quad v(x)=x^{\frac{1}{2}-\rho}+\frac{k}%
{1-2\rho}x^{\frac{3}{2}-\rho};
\]

the following results hold for the non-Friedrichs boundary condition
$[y,v](0)=0$, \textit{i.e.} $A1=0,A2=1$:

\begin{itemize}
\item[(i)] $k>0,\ 0<\rho<1/2$ there are no negative eigenvalues

\item[(ii)] $k>0,\ 1/2<\rho<1$ there is exactly one negative eigenvalue given
by
\[
\lambda_{0}=\frac{-k^{2}}{(2\rho-1)^{2}}%
\]

\item[(iii)] if $k<0,\ 0<\rho<1/2$ there are infinitely many negative
eigenvalues given by
\[
\lambda_{n}=\frac{-k^{2}}{(2n-2\rho+1)^{2}},\ n=0,1,2,3,\ldots
\]

\item[(iv)] if $k<0,\ 1/2<\rho<1$ there are infinitely many negative
eigenvalues given by
\[
\lambda_{n}=\frac{-k^{2}}{(2n-2\rho+3)^{2}}\,,\ n=0,1,2,3,\ldots
\]

\item[(v)] for $k=0$ and $(A1)(A2)<0$ there is exactly one negative eigenvalue
given by:
\[
\lambda_{0}=\frac{4\left(  A1\right)  \Gamma(1+\rho)}{\left(  A2\right)
\Gamma(1-\rho)^{1/\rho}}.
\]
\end{itemize}

\item For $h=-1/4,\ k\in R$ , the LCNO classification at $0$ prevails and a
boundary condition is required for which, for all $x\in(0,+\infty),$%
\[
u(x)=x^{1/2}+kx^{3/2}\quad\quad v(x)=2x^{1/2}+\left(  x^{1/2}+kx^{3/2}\right)
\ln(x).
\]
\noindent For $k=0$ and $(A1)(A2)<0$ there is exactly one negative eigenvalue
given by:
\[
\lambda_{0}=-c\exp(2(A1)/A2),\quad c=4\exp(4-2\gamma)
\]
where $\gamma$ is Euler's constant: $\gamma=0.5772156649\ldots$.

\noindent\noindent\textbf{Results for form (2)}

\item For $h<-1/4,\ k\in R$, the equation is LCO at $0$ (recall that we added
$1$ to the coefficient $q(\cdot)$ for this case, thus moving the start of the
continuous spectrum from $0$ to $1$) for which, defining%
\[
\sigma:=(-h-1/4)^{1/2},
\]
then, for all $x\in(0,+\infty),$%
\begin{align*}
u(x)  &  =x^{1/2}\left[  (1-(4h)^{-1}kx)\cos(\sigma\ln(x))+k\sigma
x\sin(\sigma\ln(x))/2\right] \\
v(x)  &  =x^{1/2}\left[  (1-(4h)^{-1}kx)\sin(\sigma\ln(x))+k\sigma
x\cos(\sigma\ln(x))/2\right]  ;
\end{align*}

\begin{itemize}
\item[(i)] when $k=0$ this equation reduces to the Krall equation Example 20
below (but note that the notation is different).

\item[(ii)] When $k\not =0$ explicit formulas for the eigenvalues are not
available; however we report here on the qualitative properties of the
spectrum for any boundary condition at $0$:

$(\alpha)$ for all $k\in R$ there are infinitely many negative eigenvalues
tending exponentially to $-\infty$

$(\beta)$ for $k>0$ there are only a finite number of eigenvalues in any
bounded interval, in particular they do not accumulate at $1$

$(\gamma)$ for $k\leq0$ the eigenvalues accumulate also at $1$.

$(\delta)$ for $k=0$ and $(A1)(A2)<0$ there is exactly one negative eigenvalue
given by:
\[
\lambda_{0}=\frac{4\left(  A1\right)  \Gamma(1+\rho)}{\left(  A2\right)
\Gamma(1-\rho)^{1/\rho}}.
\]
\end{itemize}

Most of these results are due to J\"{o}rgens, see \cite[Section 10]{J}; a few
new results were established by the authors.
\end{enumerate}

\item \textbf{The Marletta equation}%
\[
-y^{\prime\prime}(x)+\frac{3(x-31)}{4(x+1)(x+4)^{2}}y(x)=\lambda
y(x)\;\text{for all}\;x\in\lbrack0,+\infty).
\]

Endpoint classification in $L^{2}(0,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & R\\
$+\infty$ & LP\\\hline
\end{tabular}
\]
Since $q(x)\rightarrow0$ as $x\rightarrow\infty$ the continuous spectrum
consists of $[0,\infty)$ and every negative number is an eigenvalue for some
boundary condition at $0.$

For the boundary condition $A1=5,A2=8$ there is a negative eigenvalue
$\lambda_{0}$ near $-1.185.$ However the equation with $\lambda=0$ has a
solution
\[
y(x)=\frac{1-x^{2}}{(1+x/4)^{5/2}}\text{ for all }x\in\lbrack0,\infty)
\]
that satisfies this boundary condition which is NOT in $L^{2}(0,\infty)$ but
is ``nearly'' in this space. This solution deceives SLEIGN and SLEIGN2 in
single precision, and SLEDGE in double precision, into reporting $\lambda=0$
as a second eigenvalue; in double precision SLEIGN and SLEIGN2 correctly
report that $\lambda_{0}$ is the only eigenvalue, and SLEIGN2 reports the
start of the continuous spectrum at $0.$

Additional details of this example are to be found in the Marletta
certification report on SLEIGN (not SLEIGN2) \cite{M}.

\item \textbf{The harmonic oscillator equation}%
\[
-y^{\prime\prime}(x)+x^{2}y(x)=\lambda y(x)\;\text{for all}\;x\in
(-\infty,+\infty).
\]

Endpoint classification in $L^{2}(-\infty,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\
\]

This is another classical equation; it is also the Liouville normal form of
the differential equation for the Hermite orthogonal polynomials. On the whole
real line the boundary value problem requires no boundary conditions at the
endpoints of $\pm\infty$. Thus there is a unique self-adjoint extension with
discrete spectrum given by :
\[
\{\lambda_{n}=2n+1;\;n=0,1,2,...\}.
\]
For a classical treatment see \cite[Chapter IV, Section 2]{T}.

\item \textbf{The Jacobi equation}%
\[
-\left(  (1-x)^{\alpha+1}(1+x)^{\beta+1}y^{\prime}(x)\right)  ^{\prime
}=\lambda(1-x)^{\alpha}(1+x)^{\beta}y(x)\;\text{for all}\;x\in(-1,+1)
\]
where the parameters $\alpha,\beta\in(-\infty,+\infty).$

Endpoint classification in the weighted space $L^{2}((-1,+1);(1-x)^{\alpha
}(1+x)^{\beta}))$:%
\[%
\begin{tabular}
[c]{ccc}\hline
Endpoint & Parameter & Classification\\\hline
$-1$ & $\beta\leq-1$ & LP\\
$-1$ & $-1<\beta<0$ & WR\\
$-1$ & $0\leq\beta<1$ & LCNO\\
$-1$ & $1\leq\beta$ & LP\\\hline
\end{tabular}
\quad\quad%
\begin{tabular}
[c]{ccc}\hline
Endpoint & Parameter & Classification\\\hline
$+1$ & $\alpha\leq-1$ & LP\\
$+1$ & $-1<\alpha<0$ & WR\\
$+1$ & $0\leq\alpha<1$ & LCNO\\
$+1$ & $1\leq\alpha$ & LP\\\hline
\end{tabular}
\]

For the endpoint $-1$ and for the WR and LCNO cases the boundary condition
functions $u,v$ are determined by%
\[%
\begin{tabular}
[c]{ccc}\hline
Parameter & $u$ & $v$\\\hline
$-1<\beta<0$ & $(1+x)^{-\beta}$ & $1$\\
$\beta=0$ & $1$ & $\ln\left(  \dfrac{1+x}{1-x}\right)  $\\
$0<\beta<1$ & $1$ & $(1+x)^{-\beta}$\\\hline
\end{tabular}
.
\]

For the endpoint $+1$ and for the WR and LCNO cases the boundary condition
functions $u,v$ are determined by%
\[%
\begin{tabular}
[c]{ccc}\hline
Parameter & $u$ & $v$\\\hline
$-1<\alpha<0$ & $(1-x)^{-\alpha}$ & $1$\\
$\alpha=0$ & $1$ & $\ln\left(  \dfrac{1+x}{1-x}\right)  $\\
$0<\alpha<1$ & $1$ & $(1-x)^{-\alpha}$\\\hline
\end{tabular}
.
\]

To obtain the classical Jacobi orthogonal polynomials it is necessary to take
$-1<\alpha,\,\beta$; then note the required boundary conditions:

Endpoint $-1$:%
\[%
\begin{tabular}
[c]{cc}\hline
Parameter & Boundary condition\\\hline
$-1<\beta<0$ & $(py^{\prime})(-1)=0\;$or$\;[y,v](-1)=0$\\
$0\leq\beta<1$ & $[y,u](-1)=0$\\\hline
\end{tabular}
\]

Endpoint $+1$:%
\[%
\begin{tabular}
[c]{cc}\hline
Parameter & Boundary condition\\\hline
$-1<\alpha<0$ & $(py^{\prime})(+1)=0\;$or$\;[y,v](+1)=0$\\
$0\leq\alpha<1$ & $[y,u](+1)=0$\\\hline
\end{tabular}
\]
\newline For the classical Jacobi orthogonal polynomials the eigenvalues are
given by:
\[
\lambda_{n}=n(n+\alpha+\beta+1)\;\text{for}\;n=0,1,2,\ldots
\]
and this explicit formula can be used to give an independent check on the
accuracy of the results from the SLEIGN2 code.

It is interesting to note that the required boundary condition for these
Jacobi polynomials is the Friedrichs condition in the LCNO case but not in the
WR case.

\item \textbf{The rotation Morse oscillator equation}%
\[
-y^{\prime\prime}(x)+(2x^{-2}-2000(2e(x)-e(x)^{2}))y(x)=\lambda
y(x)\;\text{for all}\;x\in(0,+\infty)
\]
where%
\[
e(x)=\exp(-1.7(x-1.3))\;\text{for all}\;x\in(0,+\infty).
\]

Endpoint classification in the space $L^{2}(0,+\infty)$%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\
\]

This classical problem has continuous spectrum on $[0,\infty)$ and exactly 26
negative eigenvalues. Enter NUMEIG1 = 0, NUMEIG2 = 28 and observe the 26
eigenvalues and the start of the continuous spectrum at 0.

\item \textbf{The Dunsch equation}%
\[
-\left(  (1-x^{2})y^{\prime}(x)\right)  ^{\prime}+\left(  \frac{2\alpha^{2}%
}{(1+x)}+\frac{2\beta^{2}}{(1-x)}\right)  y(x)=\lambda y(x)\;\text{for
all}\;x\in(-1,+1)
\]
where the independent parameters $\alpha,\beta\in\lbrack0,+\infty).$

Boundary value problems for this differential equation are discussed in
\cite[Chapter VIII, Pages 1515-20]{DS}.

Endpoint classification in the space $L^{2}(-1,+1)$ for $-1$:%
\[%
\begin{tabular}
[c]{cc}\hline
Parameter & Classification\\\hline
$0\leq\alpha<1/2$ & LCNO\\
$1/2\leq\alpha$ & LP\\\hline
\end{tabular}
\]

Endpoint classification in the space $L^{2}(-1,+1)$ for $+1$:%
\[%
\begin{tabular}
[c]{cc}\hline
Parameter & Classification\\\hline
$0\leq\beta<1/2$ & LCNO\\
$1/2\leq\beta$ & LP\\\hline
\end{tabular}
\]

For the LCNO cases the boundary condition functions $u,v$ are given by%
\[%
\begin{tabular}
[c]{cccc}\hline
Endpoint & Parameter & $u$ & $v$\\\hline
$-1$ & $\alpha=0$ & $1.0$ & $\dfrac{1}{2}\ln\left(  \dfrac{1+x}{1-x}\right)
$\\
$-1$ & $0<\alpha<1/2$ & $(1+x)^{\alpha}$ & $(1+x)^{-\alpha}$\\
$+1$ & $\beta=0$ & $1.0$ & $\dfrac{1}{2}\ln\left(  \dfrac{1+x}{1-x}\right)
$\\
$+1$ & $0<\beta<1/2$ & $(1-x)^{\beta}$ & $(1-x)^{-\beta}$\\\hline
\end{tabular}
\]

Note that these $u$ and $v$ are not solutions of the differential equation but
maximal domain functions. In \cite[Page 1519]{DS} it is stated that the
boundary value problem determined by the boundary conditions
\[
\lbrack y,u](-1)=0=[y,u](1)
\]
has eigenvalues given by the explicit formula
\[
\lambda_{n}=(n+\alpha+\beta+1)(n+\alpha+\beta)\;\text{for}\;n=0,1,2,\ldots
\]

\item \textbf{The Donsch equation}%
\[
-\left(  (1-x^{2})y^{\prime}(x)\right)  ^{\prime}+\left(  \frac{-2\gamma^{2}%
}{(1+x)}+\frac{2\beta^{2}}{(1-x)}\right)  y(x)=\lambda y(x)\;\text{for
all}\;x\in(-1,+1)
\]
where the independent parameters $\gamma,\beta\in\lbrack0,+\infty).$

Endpoint classification in the space $L^{2}(-1,+1)$ for $-1$:%
\[%
\begin{tabular}
[c]{cc}\hline
Parameter & Classification\\\hline
$\gamma=0$ & LCNO\\
$0<\gamma$ & LCO\\\hline
\end{tabular}
\]

Endpoint classification in the space $L^{2}(-1,+1)$ for $+1$:%
\[%
\begin{tabular}
[c]{cc}\hline
Parameter & Classification\\\hline
$0\leq\beta<1/2$ & LCNO\\
$1/2\leq\beta$ & LP\\\hline
\end{tabular}
\]

For these LCNO/LCO cases the boundary condition functions $u,v$ are given by%
\[%
\begin{tabular}
[c]{cccc}\hline
Endpoint & Parameter & $u$ & $v$\\\hline
$-1$ & $\gamma=0$ & $1$ & $\dfrac{1}{2}\ln\left(  \dfrac{1+x}{1-x}\right)  $\\
$-1$ & $0<\gamma$ & $\cos(\gamma\ln(1+x))$ & $\sin(\gamma\ln(1+x))$\\
$+1$ & $\beta=0$ & $1$ & $\dfrac{1}{2}\ln\left(  \dfrac{1+x}{1-x}\right)  $\\
$+1$ & $0<\beta<1/2$ & $(1-x)^{\beta}$ & $(1-x)^{-\beta}$\\\hline
\end{tabular}
\
\]

This is a modification of Example 18 above which illustrates an LCNO/LCO mix
obtained by replacing $\alpha$ with $i\gamma$; this changes the singularity at
$-1$ from LCNO to LCO.

Again these $u$ and $v$ are not solutions of the differential equation but
maximal domain functions.

\item \textbf{The Krall equation}%
\[
-y^{\prime\prime}(x)+(1-(k^{2}+1/4)x^{-2})y(x)=\lambda y(x)\;\text{for
all}\;x\in(0,+\infty)
\]
where the parameter $k\in(0,+\infty).$

Endpoint classification in the space $L^{2}(0,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & LCO\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

This example should be seen as a special case of the Bessel Example 2 above;
solutions can be obtained in terms of the modified Bessel functions.

To help with the computations for this example the spectrum is translated by a
term $+1$; this simple device is used for numerical convenience.

For problems with separated boundary conditions at endpoints $0$ and $\infty$
there is a continuous spectrum on $[1,\infty)$ with a discrete (and simple)
spectrum on $(-\infty,1)$. This discrete spectrum has cluster points at both
$-\infty$ and $1$.

For the LCO endpoint at $0$ the boundary condition functions are given by%
\[
u(x)=x^{1/2}\cos(k\ln(x))\quad\quad v(x)=x^{1/2}\sin(k\ln(x)).
\]

For the boundary value problem with boundary condition $[y,u](0)=0$ the
eigenvalues are given explicitly by:

(i) suppose $\Gamma(1+i)=\alpha+i\beta$ and $\mu>0$ satisfies $\tan\left(
\ln(\frac{1}{2}\mu)\right)  =-\alpha/\beta$

(ii) $\theta=\operatorname{Im}(\log(\Gamma(1+i)))$

(iii) $\ln(\frac{1}{2}\mu)=\tfrac{1}{2}\pi+\theta+s\pi\;$for$\;\;s=0,\pm1,\pm2,...$

(iv) $\mu_{s}^{2}=\left(  2\exp(\theta+\frac{1}{2}\pi)\right)  ^{2}\exp
(2s\pi)\;\,s=0,\pm1,\pm2,...$

\noindent then the eigenvalues are $\lambda_{n}=-\mu_{-(n+1)}^{2}%
+1\ (n=0,\pm1,\pm2,...)$.

SLEIGN2 can compute only six of these eigenvalues in a normal UNIX server,
even in double precision, $\lambda_{-3}$ to $\lambda_{2}$; other eigenvalues
are, numerically, too close to 1 or too close to $-\infty$. Here we list these
SLEIGN2 computed eigenvalues in double precision in a normal UNIX server and
compare them with the same eigenvalues computed from the transcendental
equation; for the problem on $(0,\infty)$ with $k=1$ and $A1=1.0,\ A2=0.0$.
\[%
\begin{array}
[c]{cccc}%
\text{NUMEIG} & \text{eig from SLEIGN2} & \text{eig from trans. equ.} &
\text{iflag}\\
-3 & -276,562.5 & -14,519,130 & 4\\
-2 & -27,114.48 & -27,114.67 & 2\\
-1 & -49.62697 & -49.63318 & 2\\
0 & 0.9054452 & 0.9054454 & 1\\
1 & 0.9998234 & 0.9998234 & 1\\
2 & 0.9999997 & 0.9999997 & 3
\end{array}
.
\]

\item \textbf{The Fourier equation}%
\[
-y^{\prime\prime}(x)=\lambda y(x)\;\text{for all}\;x\in(-\infty,+\infty)
\]

Endpoint classification in $L^{2}(-\infty,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

This is a simple constant coefficient equation whose eigenvalues, for any
self-adjoint boundary condition, can be characterized in terms of a
transcendental equation involving only trigonometric functions.

\item \textbf{The Laguerre equation}%
\[
-(x^{\alpha+1}\exp(-x)y^{\prime}(x))^{\prime}=\lambda x^{\alpha}%
\exp(-x)y(x)\;\text{for all}\;x\in(0,+\infty)
\]
where the parameter $\alpha\in(-\infty,+\infty).$

Endpoint classification in the weighted space $L^{2}((0,+\infty);x^{\alpha
}\exp(-x))$:%
\[%
\begin{tabular}
[c]{ccc}\hline
Endpoint & Parameter & Classification\\\hline
$0$ & $\alpha\leq-1$ & LP\\
$0$ & $-1<\alpha<0$ & WR\\
$0$ & $0\leq\alpha<1$ & LCNO\\
$0$ & $1\leq\alpha$ & LP\\
$+\infty$ & $\alpha\in(-\infty,+\infty)$ & LP\\\hline
\end{tabular}
\]

For these WR/LCNO cases the boundary condition functions $u,v$ are given by:%
\[%
\begin{tabular}
[c]{cccc}\hline
Endpoint & Parameter & $u$ & $v$\\\hline
$0$ & $-1<\alpha<0$ & $x^{-\alpha}$ & $1$\\
$0$ & $\alpha=0$ & $1$ & $\ln(x)$\\
$0$ & $0<\alpha<1$ & $1$ & $x^{-\alpha}$\\\hline
\end{tabular}
\]

This is the classical form of the differential equation which for parameter
$\alpha>-1$ produces the classical Laguerre polynomials as eigenfunctions; for
the boundary condition $[y,1](0)=0$ at $0$, when required, the eigenvalues are
then (remarkably!) independent of $\alpha$ and given by $\lambda
_{n}=n\;(n=0,1,2,...)$; see \cite[Chapter 22, Section 22.6]{AB}.

SLEIGN2 does not compute eigenvalues well with this differential equation on
$(0,\infty)$, with the code in a UNIX server; this appears to be due to
numerical problems resulting from the exponentially small coefficients;
however, see Example 23 below.

\item \textbf{The Laguerre/Liouville equation}%
\[
-y^{\prime\prime}(x)+\left(  \frac{\alpha^{2}-1/4}{x^{2}}-\frac{\alpha+1}%
{2}+\frac{x^{2}}{16}\right)  y(x)=\lambda y(x)\;\text{for all}\;x\in
(0,+\infty)
\]
where the parameter $\alpha\in(-\infty,+\infty).$

Endpoint classification in the space $L^{2}(0,+\infty)$:%
\[%
\begin{tabular}
[c]{ccc}\hline
Endpoint & Parameter & Classification\\\hline
$0$ & $\alpha\leq-1$ & LP\\
$0$ & $-1<\alpha<1,$ but $\alpha^{2}\neq1/4$ & LCNO\\
$0$ & $\alpha^{2}=1/4$ & R\\
$0$ & $1\leq\alpha$ & LP\\
$+\infty$ & $\alpha\in(-\infty,+\infty)$ & LP\\\hline
\end{tabular}
\]

For these WR/LCNO cases the boundary condition functions $u,v$ are given by:%
\[%
\begin{tabular}
[c]{cccc}\hline
Endpoint & Parameter & $u$ & $v$\\\hline
$0$ & $-1<\alpha<0$ but $\alpha\neq-1/2$ & $x^{\frac{1}{2}-\alpha}$ &
$x^{\frac{1}{2}+\alpha}$\\
$0$ & $\alpha=-1/2$ & $x$ & $1$\\
$0$ & $\alpha=0$ & $x^{1/2}$ & $x^{1/2}\ln(x)$\\
$0$ & $0<\alpha<1$ but $\alpha\neq1/2$ & $x^{\frac{1}{2}+\alpha}$ &
$x^{\frac{1}{2}-\alpha}$\\
$0$ & $\alpha=1/2$ & $x$ & $1$\\\hline
\end{tabular}
\]

This is the Liouville normal form of the Laguerre equation; the two forms are
unitarily equivalent so that the spectrum and the eigenfunctions of equivalent
boundary value problems are identical. This Liouville form is more suitable
for eigenvalue computations in contrast to the previous example.

The Laguerre polynomials are produced as eigenfunctions only when $\alpha>-1$.
For $\alpha\geq1$ the LP condition holds at $0$. For $0\leq\alpha<1$ the
appropriate boundary condition is the Friedrichs condition: $[y,u](0)=0;$ for
$-1<\alpha<0$ use the non-Friedrichs condition: $[y,\ v](0)=0$. In all these
cases $\lambda_{n}=n$ for $n=0,1,2,...$.

\item \textbf{The Jacobi/Liouville equation}%
\[
-y^{\prime\prime}(x)+q(x)y(x)=\lambda y(x)\;\text{for all}\;x\in(-\pi
/2,+\pi/2)
\]
where the coefficient $q$ is given by, for all$\;x\in(-\pi/2,+\pi/2),$%
\[
q(x)=\frac{\beta^{2}-1/4}{4\tan^{2}((x+\pi)/2)}+\frac{\alpha^{2}-1/4}%
{4\tan^{2}((x-\pi)/2)}-\frac{4\alpha\beta+4\beta+4\alpha+3}{8}.
\]
Here the parameters $\alpha,\beta\in(-\infty+,\infty).$

Endpoint classification in the space $L^{2}(-\pi/2,+\pi/2)$:%
\[%
\begin{tabular}
[c]{ccc}\hline
Endpoint & Parameter & Classification\\\hline
$-\pi/2$ & $\beta\leq-1$ & LP\\
$-\pi/2$ & $-1<\beta<1$ but $\beta^{2}\neq1/4$ & LCNO\\
$-\pi/2$ & $\beta^{2}=1/4$ & R\\
$-\pi/2$ & $1\leq\beta$ & LP\\\hline
\end{tabular}
\]%
\[%
\begin{tabular}
[c]{ccc}\hline
Endpoint & Parameter & Classification\\\hline
$+\pi/2$ & $\alpha\leq-1$ & LP\\
$+\pi/2$ & $-1<\alpha<1$ but $\alpha^{2}\neq1/4$ & LCNO\\
$+\pi/2$ & $\alpha^{2}=1/4$ & R\\
$+\pi/2$ & $1\leq\alpha$ & LP\\\hline
\end{tabular}
\]

For the endpoint $-\pi/2$ and for LCNO cases the boundary condition functions
$u,v$ are determined by, here $b(x)=2\tan^{-1}(1)+x$ for all $x\in(-\pi
/2,+\pi/2),$%
\[%
\begin{tabular}
[c]{ccc}\hline
Parameter & $u$ & $v$\\\hline
$-1<\beta<0$ & $b(x)^{\frac{1}{2}-\beta}$ & $b(x)^{\frac{1}{2}+\beta}$\\
$\beta=0$ & $\sqrt{b(x)}$ & $\sqrt{b(x)}\ln(b(x))$\\
$0<\beta<1$ & $b(x)^{\frac{1}{2}+\beta}$ & $b(x)^{\frac{1}{2}-\beta}$\\\hline
\end{tabular}
\]

For the endpoint $+\pi/2$ and for LCNO cases the boundary condition functions
$u,v$ are determined by, here $a(x)=2\tan^{-1}(1)-x$ for all $x\in(-\pi
/2,+\pi/2),$%
\[%
\begin{tabular}
[c]{ccc}\hline
Parameter & $u$ & $v$\\\hline
$-1<\alpha<0$ & $a(x)^{\frac{1}{2}-\alpha}$ & $a(x)^{\frac{1}{2}+\alpha}$\\
$\alpha=0$ & $\sqrt{a(x)}$ & $\sqrt{a(x)}\ln(a(x))$\\
$0<\alpha<1$ & $a(x)^{\frac{1}{2}+\alpha}$ & $a(x)^{\frac{1}{2}-\alpha}%
$\\\hline
\end{tabular}
\]

This is the Liouville normal form of the Jacobi equation of Example 16.

The classical Jacobi orthogonal polynomials are produced only when both
$\alpha,\beta>-1.$ For $\alpha,\beta>+1$ the LP condition holds and no
boundary condition is required to give the polynomials. If $-1<\alpha,\beta<1$
then the LCNO condition holds and boundary conditions are required to produce
the Jacobi polynomials; these conditions are as follows:

Endpoint $-\pi/2$%
\[%
\begin{tabular}
[c]{cc}\hline
Parameter & Boundary condition\\\hline
$-1<\beta<0$ & $[y,v](-\pi/2)=0$\\
$0\leq\beta<1$ & $[y,u](-\pi/2)=0$\\\hline
\end{tabular}
\]

Endpoint $+\pi/2$%
\[%
\begin{tabular}
[c]{cc}\hline
Parameter & Boundary condition\\\hline
$-1<\alpha<0$ & $[y,v](+\pi/2)=0$\\
$0\leq\alpha<1$ & $[y,u](+\pi/2)=0$\\\hline
\end{tabular}
\]

Recall from Example 16 for the classical orthogonal Jacobi polynomials the
eigenvalues are given explicitly by:%
\[
\lambda_{n}=n(n+\alpha+\beta+1)\;\text{for}\;n=0,1,2,\ldots
\]

\item \textbf{The Meissner equation}%
\[
-y^{\prime\prime}(x)=\lambda w(x)y(x)\;\text{for all}\;x\in(-\infty,+\infty)
\]
where the weight coefficient $w$ is defined by%
\begin{align*}
w(x)  &  =1\;\text{for all}\;x\in(-\infty,0]\\
&  =9\;\text{for all}\;x\in(0,+\infty).
\end{align*}

Endpoint classification in the space $L^{2}(-\infty,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

This equation arose in a model of a one dimensional crystal. For this constant
coefficient equation with a weight function which has a jump discontinuity the
eigenvalues can be characterized as roots of a transcendental equation
involving only trigonometrical and inverse trigonometrical functions. There
are infinitely many simple eigenvalues and infinitely many double ones for the
periodic case; they are given by:

\textbf{Periodic boundary conditions on} $(-1/2,+1/2)$\textbf{, }\textit{i.e.}%
\[
y(-1/2)=y(+1/2)\quad\quad y^{\prime}(-1/2)=y^{\prime}(+1/2).
\]

We have $\lambda_{0}=0$ and for $n=0,1,2,\ldots$
\[
\lambda_{4n+1}=(2m\pi+\alpha)^{2};\ \ \lambda_{4n+2}=(2(n+1)\pi-\alpha))^{2};
\]%
\[
\ \lambda_{4n+3}\ =\ \ \lambda_{4n+4}=(2(n+1)\pi))^{2}.
\]
where $\alpha\,=\,\cos^{-1}(-7/8)$

\textbf{Semi-periodic boundary conditions on }$($\textbf{ }$-1/2,+1/2)$%
\textbf{, }\textit{i.e.}%
\[
y(-1/2)=-y(+1/2)\quad\quad y^{\prime}(-1/2)=-y^{\prime}(+1/2).
\]

With $\beta=\cos^{-1}((1+\sqrt{(}33))/16)$ and $\gamma=\cos^{-1}((1-\sqrt
{(}33))/16)$ these are all simple and given by, for $n=0,1,2,\ldots$
\[
\lambda_{4n}\,=\,(2n\pi\,+\,\beta)^{2};\ \lambda_{4n+1}\,=\,(2n\pi
\,+\,\gamma)^{2};\ \
\]%
\[
\lambda_{4n+2}\,=\,(2(n+1)\pi\,-\,\gamma)^{2};\text{ }\lambda_{4n+3}%
\,=\,(2(n+1)\pi\,-\,\beta)^{2}.
\]
See \cite{E} and \cite{Hoc}.

\item \textbf{The Lohner equation}%
\[
-y^{\prime\prime}(x)-1000xy(x)=\lambda y(x)\;\text{for all}\;x\in
(-\infty,+\infty)
\]

Endpoint classification in the space $L^{2}(-\infty,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

In \cite{L} Lohner computed the Dirichlet eigenvalues of index (in SLEIGN2
notation) 0, 9, 49 and 99 using interval arithmetic and obtained rigorous
bounds. In double precision SLEIGN2 computed eigenvalues are in good agreement
with these guaranteed bounds.

\item \textbf{The J\"{o}rgens equation}%
\[
-y^{\prime\prime}(x)+(\exp(2x)/4-k\exp(x))y(x)=\lambda y(x)\;\text{for
all}\;x\in(-\infty,+\infty)
\]
where the parameter $k\in(-\infty,+\infty).$

Endpoint classification in the space $L^{2}(-\infty,+\infty),$ for all
$k\in(-\infty,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

This is a remarkable example from J\"{o}rgens and SLEIGN2 obtains excellent
results. Details of this problem are given in \cite[Part II, Section 10]{J}.
For all $k\in(-\infty,+\infty)$ the boundary value problem on the interval
$(-\infty,+\infty)$ has a continuous spectrum on $[0,+\infty)$; for $k\leq1/2$
there are no eigenvalues; for $h=0,1,2,3,\ldots$ and then $k$ chosen by
$h<k-1/2\leq h+1,$ there are exactly $h+1$ eigenvalues and these are all below
the continuous spectrum; these eigenvalues are given explicitly by
\[
\lambda_{n}=-(k-1/2-n)^{2},\quad n=0,1,2,3,\ldots,h.
\]

\item \textbf{The Behnke-Goerisch equation}%
\[
-y^{\prime\prime}(x)+k\cos^{2}(x)y(x)=\lambda y(x)\;\text{for all}%
\;x\in(-\infty,+\infty)
\]
where the parameter $k\in(-\infty,+\infty),$

Endpoint classification in the space $L^{2}(-\infty,+\infty),$ for all
$k\in(-\infty,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

This is a form of the Mathieu equation. In \cite{BG} these authors computed a
number of Neumann eigenvalues of this problem using interval arithmetic with
rigorous bounds. In double precision SLEIGN2 computed eigenvalues are in good
agreement with these guaranteed bounds.

\item \textbf{The Whittaker equation}%
\[
-y^{\prime\prime}(x)+\left(  \frac{1}{4}+\frac{k^{2}-1}{x^{2}}\right)
y(x)=\lambda\frac{1}{x}y(x)\;\text{for all}\;x\in(0,+\infty)
\]
where the parameter $k\in\lbrack1,+\infty).$

Endpoint classification in the space $L^{2}(0,+\infty),$ for all $k\in
\lbrack1,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

This equation is studied in \cite[Part II, Section 10]{J}. There it is shown
that the LP case holds at $+\infty$ and also at $0$ for $k\geq1$. The spectrum
is discrete and is given explicitly by:
\[
\lambda_{n}=n+(k+1)/2,\quad n=0,1,2,3,\ldots.
\]

\item \textbf{The Littlewood-McLeod equation}%
\[
-y^{\prime\prime}(x)+x\sin(x)y(x)=\lambda y(x)\;\text{for all}\;x\in
\lbrack0,+\infty).
\]

Endpoint classification in the space $L^{2}(0,+\infty)$:%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$0$ & R\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

The spectral analysis of this differential equation is considered in
\cite{JEL} and \cite{JBM}; the equation is R at $0$ and LP at $\pm\infty.$ All
self-adjoint operators in $L^{2}[0,\infty)$ have a simple, discrete spectrum
$\{\lambda_{n}:n=0,\pm1,\pm2,\ldots\}$ that is unbounded both above and below,
\textit{i.e.}%
\[
\lim_{n\rightarrow-\infty}\lambda_{n}=-\infty\quad\quad\quad\lim
_{n\rightarrow+\infty}\lambda_{n}=+\infty.
\]
Every eigenfunction has infinitely many zeros in $(0,\infty).$

SLEIGN2, and other codes, fail to compute the eigenvalues for this type of LP
oscillatory problem. However there is qualitative information to be obtained
by considering regular problems on $[0,X]$ with, say, Dirichlet boundary
conditions $y(0)=Y(X)=0.$

\item \textbf{The Morse equation}%
\[
-y^{\prime\prime}(x)+(9\exp(-2x)-18\exp(-x))y(x)=\lambda y(x)\;\text{for
all}\;x\in(-\infty,+\infty)
\]

Endpoint classification in the space $L^{2}(-\infty,+\infty)$%
\[%
\begin{tabular}
[c]{cc}\hline
Endpoint & Classification\\\hline
$-\infty$ & LP\\
$+\infty$ & LP\\\hline
\end{tabular}
\]

This differential equation is studied in \cite[Example 6]{PBB1}; the spectrum
has exactly three negative, simple eigenvalues, and a continuous spectrum on
$[0,\infty);$ the eigenvalues are given explicitly by%
\[
\lambda_{n}=-(n-2.5)^{2}\;\text{for}\;n=0,1,2.
\]

\item \textbf{The Heun equation}%
\[
-(py^{\prime})^{\prime}+qy=\lambda wy\;\text{on}\;(0,1)
\]
where the coefficients $p,q,w$ are given explicitly by, for all $x\in(0,1),$%
\[%
\begin{array}
[c]{l}%
p(x)=x^{c}(1-x)^{d}(x+s)^{e}\\
q(x)=abx^{c}(1-x)^{d-1}(x+s)^{e-1}\\
w(x)=x^{c-1}(1-x)^{d-1}(x+s)^{e-1}.
\end{array}
\]
The parameters $a,b,c,d,e$ and $s$ are all real numbers and satisfy the
following two conditions%
\[
(i)\;s>0\;\text{and}\;c\geq1,d\geq1,a\geq b
\]
and%
\[
(ii)\;a+b+1-c-d-e=0.
\]
From these conditions it follows that%
\[
a\geq1,b\geq1,e\geq1\;\text{and}\;a+b-d\geq1.
\]

The differential equation above is a special case of the general Heun equation%
\[
\frac{d^{2}w(z)}{dz^{2}}+\left(  \frac{\gamma}{z}+\frac{\delta}{z-1}%
+\frac{\varepsilon}{z-a}\right)  \frac{dw(z)}{dz}+\frac{\alpha\beta
z-q}{z(z-1)(z-a)}w(z)=0
\]
with the general parameters $\alpha,\beta,\gamma,\delta,\varepsilon$ replaced
by the real numbers $a,b,c,d,e,$ $a$ replaced by $-s,$ and $q$ replaced by the
spectral parameter $\lambda.$ For general information concerning the Heun
equation see the compendium \cite{AR1}; for the special form of the Heun
equation considered here, and for the connection with confluence of
singularities and applications, see the recent paper \cite{LS1}.

We note that the coefficients of the Sturm-Liouville differential equation
above satisfy the conditions

\begin{itemize}
\item[$(i)$] $q,w\in C[0,1]$ and $w(x)>0$ for all $x\in(0,1)$

\item[$(ii)$] $p^{-1}\in L_{\text{loc}}^{1}(0,1),p(x)>0$ for all $x\in(0,1)$

\item[$(iii)$] $p^{-1}\notin L^{1}(0,1/2]$ and $p^{-1}\notin L^{1}[1/2,1).$
\end{itemize}

Thus both endpoints $0$ and $1$ are singular for the differential equation.
Analysis shows that the endpoint classification for this equation is%
\[%
\begin{tabular}
[c]{ccc}\hline
Endpoint & Parameter & Classification\\\hline
$0$ & $c\in\lbrack1,2)$ & LCNO\\
$0$ & $c\in\lbrack2,+\infty)$ & LP\\
$1$ & $d\in\lbrack1,2)$ & LCNO\\
$1$ & $d\in\lbrack2,+\infty)$ & LP\\\hline
\end{tabular}
\ \
\]

For the endpoint $0$ and for LCNO cases the boundary condition functions $u,v$
are determined by:%
\[%
\begin{tabular}
[c]{ccc}\hline
Parameter & $u$ & $v$\\\hline
$c=1$ & $1$ & $\ln(x)$\\
$1<c<2$ & $1$ & $x^{1-c}$\\\hline
\end{tabular}
\]

For the endpoint $1$ and for LCNO cases the boundary condition functions $u,v$
are determined by:%
\[%
\begin{tabular}
[c]{ccc}\hline
Parameter & $u$ & $v$\\\hline
$d=1$ & $1$ & $\ln(1-x)$\\
$1<d<2$ & $1$ & $(1-x)^{1-d}$\\\hline
\end{tabular}
\]

Further it may be shown that the spectrum of any self-adjoint problem on
$(0,1),$ with the parameters $a,b,c,d,e$ and $s$ satisfying the above
conditions, and considered in the space $L^{2}((0,1);w)$ with either separated
or coupled boundary conditions, is bounded below and discrete. For the
analytic properties, and proofs of the spectral properties of this Heun
differential equation, see the paper \cite{BEHZ}.

In xamples.f, under Example 32, the user can enter a choice for the parameters
$a,b,c,d,e$ and $s,$ subject to the conditions above being satisfied, and
obtain numerical results for the eigenvalues.
\end{enumerate}

\begin{thebibliography}{9}                                                                                                %

\bibitem {AB}M. Abramowitz and I.A. Stegun, \emph{Handbook of mathematical
functions}, Dover Publications, Inc., New York, 1972.

\bibitem {AEZ}F.V. Atkinson, W.N. Everitt and A. Zettl, \emph{Regularization
of a Sturm-Liouville problem with an interior singularity using
quasi-derivatives} Diff. and Int. Equations 1 (1988), 213-222.

\bibitem {PBB1}P.B. Bailey, \emph{SLEIGN}:\emph{ An eigenvalue-eigenfunction
code for Sturm-Liouville problems.} Report Sand77-2044, Sandia National
Laboratory, New Mexico, USA: 1978.

\bibitem {BEHZ}P.B. Bailey, W.N. Everitt, D.B. Hinton and A. Zettl, \emph{Some
spectral properties of the Heun differential equation.} (Submitted for
publication: 2001.)

\bibitem {BEZ}P.B. Bailey, W.N. Everitt and A. Zettl, \emph{Computing
eigenvalues of singular Sturm-Liouville problems}, Results in Mathematics,
\textbf{20 }(1991), 391-423.

\bibitem {BEZ2}P.B. Bailey, W.N. Everitt and A. Zettl, \emph{Regular and
singular Sturm-Liouville problems with coupled boundary conditions}, Proc.
Royal Soc. Edinburgh (A) \textbf{126} (1996), 505-514.

\bibitem {BEZ3}P.B. Bailey, W.N. Everitt and A. Zettl, \emph{The SLEIGN2
Sturm-Liouville code,} ACM Trans. Math. Software. (To appear.)

\bibitem {BEWS}P.B. Bailey, W.N. Everitt, J. Weidmann and A. Zettl,
\emph{Regular approximation of singular Sturm-Liouville problems}. Results in
Mathematics \textbf{23} (1993), 3-22.

\bibitem {BG}H. Behnke and F. Goerisch, \emph{Inclusions for eigenvalues of
self-adjoint problems}, J. Herzberger (Hrsg.): Topics in Validated
Computation, North Holland Elsevier, Amsterdam, (1994).

\bibitem {B}J.P. Boyd, \emph{Sturm-Liouville eigenvalue problems with an
interior pole}, J. Math. Physics, \textbf{22 }(1981), 1575-1590.

\bibitem {DS}N. Dunford and J.T. Schwartz, \emph{Linear Operators, part II},
Interscience Publishers, New York, 1963.

\bibitem {E}M.S.P. Eastham, \emph{The spectral theory of periodic differential
equations}, Scottish Academic Press, Edinburgh and London, 1973.

\bibitem {EGZ}W.N. Everitt, J. Gunson and A. Zettl, \emph{Some comments on
Sturm-Liouville eigenvalue problems with interior singularities}, J. Appl.
Math. Phys. (ZAMP) \textbf{38} (1987), 813-838.

\bibitem {F}G. Fichera, \emph{Numerical and quantitative analysis}, Pitman
Press, London, 1978.

\bibitem {FP1}C.T. Fulton and S. Pruess. `Mathematical software for
Sturm-Liouville problems.' \emph{NSF Final Report for Grants DMS88 and
DMS88-00839; }1993.

\bibitem {H}M.S. Homer, \emph{Boundary value problems for the Laplace tidal
wave equation}, Proc. Roy. Soc. of London (A) \textbf{428} (1990), 157-180.

\bibitem {Hoc}H. Hochstadt, \emph{A special Hill's equation with discontinuous
coefficients}, Amer. Math. Monthly, \textbf{70 }(1963), 18-26.

\bibitem {J}K. J\"{o}rgens, \emph{Spectral theory of second-order ordinary
differential operators}, Lecture Notes: Series no.2, Matematisk Institut,
Aarhus Universitet, 1962/63.

\bibitem {K}A.M. Krall, \emph{Boundary value problems for an eigenvalue
problem with a singular potential}, J. Diff. Equations, \textbf{45} (1982), 128-138.

\bibitem {LS1}W. Lay and S. Yu. Slavyanov, \emph{Heun's equation with nearby
singularities.} Proc. R. Soc. Lond. A \textbf{455} (1999), 4374-4261.

\bibitem {JEL}J.E. Littlewood, \emph{On linear differential equations of the
second order with a strongly oscillating coefficient of }$y$, J. London Math.
Soc. \textbf{41} (1966), 627-638.

\bibitem {L}R.J. Lohner, \emph{Verified solution of eigenvalue problems in
ordinary differential equations}. (Personal communication, 1995.)

\bibitem {M}M. Marletta, \emph{Numerical tests of the SLEIGN software for
Sturm-Liouville problems}, ACM TOMS, \textbf{17 }(1991), 501-503.

\bibitem {JBM}J.B. McLeod, \emph{Some examples of wildly oscillating
potentials}, J. London Math. Soc. \textbf{43} (1968), 647-654.

\bibitem {PMM}P.M. Morse, \emph{Diatomic molecules according to the wave
mechanics}; II: \emph{Vibration levels. }Phys. Rev. \textbf{34} (1929), 57-61.

\bibitem {NZ}H.-D. Niessen and A. Zettl, \emph{Singular Sturm-Liouville
problems; the Friedrichs extension and comparison of eigenvalues}, Proc.
London Math. Soc. \textbf{64} (1992), 545-578.

\bibitem {JDP}J.D. Pryce. \emph{A test package for Sturm-Liouville solvers.}
ACM Trans. Math. Software \textbf{25} (1999), 21-57.

\bibitem {P}M. Plum, \emph{Eigenvalue inclusions for second-order ordinary
differential operators by a numerical homotopy method}, ZAMP, \textbf{41
}(1990), 205-226.

\bibitem {AR1}A. Ronveaux, \emph{Heun differential equations.} (Oxford
University Press; 1995.)

\bibitem {ST}D.B. Sears and E.C. Titchmarsh, \emph{Some eigenfunction
formulae}, Quart. J. Math. Oxford (2) \textbf{1} (1950), 165-175.

\bibitem {T}E.C. Titchmarsh, \emph{Eigenfunction expansions associated with
second- order differential equations}: \textbf{I}. Clarendon Press, Oxford; 1962.

\bibitem {W}G.N. Watson, \emph{A treatise on the theory of Bessel functions},
Cambridge University Press, Cambridge, England, 1958.

\bibitem {Z}A. Zettl, \emph{Computing continuous spectrum}, Proc.
International Symposium, Trends and Developments in Ordinary Differential
Equations, Y. Alavi and P. Hsieh editors, World Scientific, (1994), 393-406.
\end{thebibliography}
\end{document}
SHAR_EOF
fi # end of overwriting check
cd ..
if test ! -d 'Fortran'
then
	mkdir 'Fortran'
fi
cd 'Fortran'
if test ! -d 'Sp'
then
	mkdir 'Sp'
fi
cd 'Sp'
if test ! -d 'Drivers'
then
	mkdir 'Drivers'
fi
cd 'Drivers'
if test -f 'data2'
then
	echo shar: will not over-write existing file "'data2'"
else
cat << "SHAR_EOF" > 'data2'
(output: again: )
(np: param: a: b: classa: classb: bca: bcb: bcc: numeig: end:)
(bca: d n a1,a2)
(bcc:  p s alfa k11,k12,k21,k22)
 
output: results.txt
np: 1 
a: -1.0 
classa:  lcno 
b: 1.0 
classb: lcno 
bca: 1,0  
bcb: 1,0
numeig: 0,2 

again:
a: 0.0
classa: r
bca: d
bcb: 0,1
 
again:

 
np: 2 
param: 0.75
a: 0.0 
classa:  lcno 
b: 1.0 
classb: r 
bca: 1,0  
bcb: d 
numeig: 0,2 

again:
bca: 0,1
 
again:
b: null
bcb: null
classb: lp

again:

np: 3 
param: null
a: 0.0 
classa:  wr 
b: null
classb: lcno 
bca: d  
bcb: 1,0 
numeig: 0,2 

again:

 
np: 4 
a: 0.0 
b: 1.0
classa:  lcno 
classb: r 
bca: 1,0  
bcb: d 
numeig: 0,4 

again:
bca: 0,1
 
again:

 
np: 5 
a: 0.0 
b: 1.0
classa:  wr 
classb: r 
bca: d  
bcb: d 
numeig: 0,4 

again:
bca: 1,1
 
again:
np: 6 
param: null
a: 1.0 
classa:  r 
b: null
classb: lco 
bca: d  
bcb: 1,0 
numeig: -2,2 

again:
bcb: 0,1
 
again:

 
np: 7 
a: 0.0 
b: 1.0
classa: lco 
classb: r 
bca: 1,0  
bcb: d 
numeig: -2,3 

again:
bca: 0,1
numeig: -1,5
 
again:
bca: null
bcb: null
bcc: p
numeig: -1,2

again:
 
bcc: null
param: 1.0
np: 8 
a: 0.0 
b: 1.0
classa:  lcno 
classb: r 
bca: 1,0  
bcb: d 
numeig: 0,1 

again:
bca: 0,1
numeig: 0,2 

again:
param: -0.5
bca: 1,0
numeig: 0,1
 
again:
bca: 0,1
numeig: 0,2

again:

 
param: null
np: 9 
a: 0.0 
b: 1.0
classa: wr
classb: lcno 
bca: d  
bcb: 1,0 
numeig: 0,4 

again:
bcb: 0,1
numeig: 0,4 

again:

 
np: 10 
a: 0.0 
b: 1.0
classa: wr
classb: r 
bca: d  
bcb: d 
numeig: 0,2 

 
again:
np: 11 
a: 0.0 
bca: null
b: pi 
bcb: null
classa: r
classb: r 
bcc: p 
numeig: 0,2 

again:

 
param: 5.0
np: 12 
a: 0.0 
b: pi 
classa: r
classb: r 
bcc: p 
numeig: 0,6 

again:

 
param: -1.0,2.0 
np: 13 
a: 0.0 
classa: lp 
b: null
classb: lp 
bcc: null
numeig: 0,2 

again:

 
param: null
np: 14 
a: 0.0 
classa: r
bca: 5.0,8.0 
classb: lp 
numeig: 0,2 

again:

 
np: 15 
a: null
classa: lp 
bca: null
classb: lp 
numeig: 0,2 

 
again:

np: 16 
param: -0.5,-1.2
a: -1.0
b: 1.0
classa: lp 
classb: wr 
bcb: d
numeig: 0,2 

again:
param: 0.5,-1.2
classb: lcno
bcb: 1,0

again:
param: 1.2,-1.2
classb: lp
bcb: null

again:
param: .5,-.5
classa: wr
classb: lcno
bca: d
bcb: 1,0
 
again:
param: 1.2,-0.5
classb: lp
bcb: null
 
again:
param: 1.2,0.5
classa: lcno
bca: 1,0
 
again:

 
param: null
np: 17 
a: 0.0
classa: lp 
b: null
classb: lp 
bca: null
bcb: null
numeig: 0,3 

again:

 
np: 18 
param: 0.2,0.6
a: -1.0
b: 1.0 
classa: lcno 
classb: lp 
bca: 1,0
numeig: 0,2 

again:

 
np: 19 
param: 0.5,0.2
a: -1.0
b: 1.0 
classa: lco 
classb: lcno 
bca: 1,0
bcb: 1,0
numeig: -1,2 

again:
param: 0.5,0.6
classb: lp
bcb: null
numeig: 0,3

again:

np: 20 
param: 1.0
a: 0.0
classa: lco 
b: null
classb: lp 
bca: 1,0
bcb: null
numeig: -2,1 

 
again:
param: null
np: 21 
a: -pi 
b: pi 
classa: r 
classb: r 
bca: d
bcb: d 
numeig: 0,4
 
again:
bca: null
bcb: null
bcc: p
numeig: 0,4 

again:
bcc: 0.7853982,2.0000000,1.0000000,1.0000000,1.0000000

again:
 
np: 22 
param: 0.0
a: 0.0
classa: lcno 
b: null
classb: lp 
bca: 1,0 
bcb: null
bcc: null
numeig: 0,2
 
again:
bca: 0,1
numeig: 0,2 

again:
param: -1.2
classa: lp
bca: null
 
again:
param: -0.6
classa: wr
bca: d
 
again:
param: 0.5
classa: lcno
bca: 1,0
 
again:
bca: 0,1

again:
param: 1.2
classa: lp
bca: null
 
again:

 
np: 23 
param: 0.0 
a: 0.0
classa: lcno 
b: null
classb: lp 
bca: 1,0 
bcb: null
numeig: 1,2
 
again:
param: -1.2
classa: lp
bca: null
numeig: 0,2 

again:
param: 0.6 
classa: lcno 
bca: 1,0
 
again:
param: 0.5
classa: r
bca: d
 
again:
param: 1.2
classa: lp
bca: null

again:

 
np: 24 
param: -0.6,-1.2
a: -pi/2
b:  pi/2 
classa: lp 
bca: null
classb: lcno 
bcb: 1,0 
numeig: 0,2
 
again:
param: 0.5,-1.2
classb: r 
bcb: d
numeig: 0,2 

again:
param: 1.2,-1.2 
classb: lp 
bcb: null

again:
param: 0.5,-0.6
classa: lcno 
classb: r
bca: 1,0
bcb: d 
 
again:
param: 1.2,-0.6
classb: lp
bca: 1,0
bcb: null

again:
param: 1.2,0.5
classa: r
bca: d

again:

 
param: null
np: 25 
a: -0.5 
b:  0.5 
classa: r 
classb: r 
bca: null
bcb: null
bcc: p
numeig: 0,6

 
again:
param: null
np: 26 
a: 0.0 
b:  1.0 
classa: r 
classb: r 
bca: d
bcb: d
bcc: null
numeig: 0,4

again:
 
np: 27
param: 2.0
a: null
b: null
classa: lp
classb: lp
numeig: 0,2

again:

np: 28 
param: 2.0
a: 0.0
b: pi
classa: r 
classb: r 
bca: n
bcb: n
numeig: 0,6

again:

 
np: 29 
param: 1.0
a: 0.0
classa: lp 
b: null
classb: lp 
bca: null
bcb: null
numeig: 0,2

again:

param: null
np: 30 
a: 0.0
classa: r
b: 10.0 
classb: r 
bca: d 
bcb: d 
numeig: 0,9
 
again:

b: 20.0

again:
b: 30.0

again:
b: 40.0

again:
param: null
np: 31
a: null
b: null
classa: lp
classb: lp
bca: null
bcb: null
numeig: 0,4

again:
np: 32
param: 1.0,4.0,2.0,1.5,4.5
a: 0.0
classa: lcno
bca: 1.0,0.0
b: 1.0
classb: lp
numeig: 0,2

again:
numeig: 18

end:
 


SHAR_EOF
fi # end of overwriting check
if test -f 'driver1.f'
then
	echo shar: will not over-write existing file "'driver1.f'"
else
cat << "SHAR_EOF" > 'driver1.f'
C  PROGRAM COUPDR

C     **********
C     MARCH 1, 2001; P.B. BAILEY, W.N. EVERITT AND A. ZETTL
C     VERSION 1.2
C     **********

      PROGRAM COUPDR

C     This program is for the purpose of indicating how SLCOUP
C     can be called for the purpose of obtaining eigenvalues
C     of Sturm-Liouville problems with regular and singular
C     coupled boundary conditions.
C
C     The call is of the form:
C
C     CALL SLCOUP(A, B, INTAB, P0ATA, QFATA, P0ATB, QFATB,
C    1    A1, A2, B1, B2, NUMEIG, EIG, TOL, IFLAG,
C    2    CPFUN, NCA, NCB, ALFA, K11, K12, K21, K22)
C
C     DECLARE THE NEEDED VARIABLES:

C
C     DECLARE THE NEEDED EXTERNALS:

C
C     SET THE PARAMETERS DEFINING THE INTERVAL OF
C       DEFINITION OF THE DIFFERENTIAL EQUATION:
C       (BESSEL'S EQUATION WITH NU = 0.75)
C
C     .. Scalars in Common ..
      REAL A1S,A2S,AA,ASAV,B1S,B2S,BB,BSAV,DTHDAA,DTHDBB,
     +                 EIGSAV,EPSMIN,FA,FB,GQA,GQB,
     +                 GWA,GWB,HPI,LPQA,
     +                 LPQB,LPWA,LPWB,P0ATAS,P0ATBS,PI,QFATAS,QFATBS,
     +                 TMID,TSAVEL,TSAVER,TWOPI,Z
      INTEGER IND,INTSAV,ISAVE,MDTHZ,MFS,MLS,MMWD,T21
      LOGICAL ADDD,PR
C     ..
C     .. Arrays in Common ..
      REAL TEE(100),TT(7,2),YS(200),YY(7,3,2),ZEE(100)
      INTEGER JAY(100),MMW(100),NT(2)
C     ..
C     .. Local Scalars ..
      REAL A,A1,A2,ALFA,B,B1,B2,EIG,K11,K12,K21,K22,P0ATA,
     +                 P0ATB,QFATA,QFATB,TOL
      INTEGER I,ICPFUN,IFLAG,INTAB,NCA,NCB,NP,NUMEIG
C     ..
C     .. Local Arrays ..
      REAL CPFUN(100),X(100)
C     ..
C     .. External Subroutines ..
      EXTERNAL SLCOUP
C     ..
C     .. Common blocks ..
C     COMMON /ALBE/LPWA,LPQA,LPWB,LPQB
      COMMON /ALBE/LPWA,LPQA,FA,GWA,GQA,LPWB,LPQB,FB,GWB,GQB
      COMMON /BCDATA/A1S,A2S,P0ATAS,QFATAS,B1S,B2S,P0ATBS,QFATBS
      COMMON /DATADT/ASAV,BSAV,INTSAV
      COMMON /DATAF/EIGSAV,IND
      COMMON /LP/MFS,MLS
      COMMON /PASS/YS,MMW,MMWD
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
      COMMON /TDATA/AA,TMID,BB,DTHDAA,DTHDBB,MDTHZ,ADDD
      COMMON /TEEZ/TEE
      COMMON /TEMP/TT,YY,NT
      COMMON /TSAVE/TSAVEL,TSAVER,ISAVE
      COMMON /Z1/Z
      COMMON /ZEEZ/JAY,ZEE
C     ..
      T21 = 21
      OPEN (T21,FILE='test.out')
      PR = .true.
      A = 0.0D0
      B = 1.0D0

C  ----------------------------------------------------------------C
C     SET THE PARAMETERS DEFINING THE COUPLED BOUNDARY CONDITIONS:
C  ----------------------------------------------------------------C

      A1 = 1.0D0
      A2 = 0.0D0
      B1 = 1.0D0
      B2 = 0.0D0

C     SET THE REMAINING PARAMETERS NEEDED BY SLCOUP:

      P0ATA = -1.0D0
      QFATA = -1.0D0
      P0ATB = -1.0D0
      QFATB = 1.0D0
      INTAB = 1
      NUMEIG = 3
      EIG = 0.0D0
      TOL = 1.D-5
      NCA = 3
      NCB = 1
      ICPFUN = 0

C  ----------------------------------------------------------------C
C     SET THE COUPLED BOUNDARY CONDITION PARAMETERS:
C     (THESE ARE THE "PERIODIC" CONDITIONS.)
C  ----------------------------------------------------------------C
      ALFA = 0.0D0
      K11 = 1.0D0
      K12 = 0.0D0
      K21 = 0.0D0
      K22 = 1.0D0

C ---------------------------------------------------------C
C  If eigenfunction values are wanted, then:

      NP = 42
      DO 10 I = 2,NP - 1
          X(I-1) = A + (I-1)* (B-A)/ (NP-1)
   10 CONTINUE
      ICPFUN = NP - 2

      DO 15 I = 1,ICPFUN
          CPFUN(I) = X(I)
   15 CONTINUE
C  ----------------------------------------------------------------C
C     CALL SLCOUP:
C  ----------------------------------------------------------------C

      CALL SLCOUP(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,NUMEIG,
     +            EIG,TOL,IFLAG,ICPFUN,CPFUN,NCA,NCB,ALFA,K11,K12,K21,
     +            K22)

C     WRITE OUT THE RETURNED EIGENVALUE, IT'S ESTIMATED ACCURACY,
C     AND THE IFLAG STATUS:

      WRITE (*,FMT=*) ' NUMEIG, EIG, TOL, IFLAG = ',NUMEIG,EIG,TOL,IFLAG

C
      IF (ICPFUN.GT.0) THEN
          WRITE (*,FMT=*) ' EIGENFUNCTION '
          DO 30 I = 1,ICPFUN
              WRITE (*,FMT=*) X(I),CPFUN(I)
   30     CONTINUE
      END IF
C
      CLOSE (T21)
      STOP
      END
C
      REAL FUNCTION P(X)

C     .. Scalar Arguments ..
      REAL X
C     ..
      P = 1.0D0
      RETURN
      END
C
      REAL FUNCTION Q(X)

C     .. Scalar Arguments ..
      REAL X
C     ..
C     .. Local Scalars ..
      REAL NU
C     ..
      NU = 0.75D0
      Q = (NU*NU-0.25D0)/X**2
      RETURN
      END
C
      REAL FUNCTION W(X)

C     .. Scalar Arguments ..
      REAL X
C     ..
      W = 1.0D0
      RETURN
      END
C
      SUBROUTINE UV(X,U,PUP,V,PVP,HU,HV)

C     .. Scalar Arguments ..
      REAL HU,HV,PUP,PVP,U,V,X
C     ..
C     .. Local Scalars ..
      REAL NU
C     ..
      NU = 0.75D0
      U = X** (NU+0.5D0)
      PUP = (NU+0.5D0)*X** (NU-0.5D0)
      V = X** (-NU+0.5D0)
      PVP = (-NU+0.5D0)*X** (-NU-0.5D0)
      HU = 0.0D0
      HV = 0.0D0
      RETURN
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver2.f'
then
	echo shar: will not over-write existing file "'driver2.f'"
else
cat << "SHAR_EOF" > 'driver2.f'
C  PROGRAM DRIVE

C     **********
C     MARCH 1, 2001; P.B. BAILEY, W.N. EVERITT AND A. ZETTL
C     VERSION 1.2
C     **********

      PROGRAM DRIVE
C
C     THIS PROGRAM IS AN "INTERACTIVE" DRIVER FOR THE USE OF
C     SLEIGN2. IT CAN BE COMPILED WITH SLEIGN2.F AND XAMPLES.F,
C     FOR EXAMPLE, WHICH MAKES IT EASY TO RUN PROBLEMS WITH ANY
C     ONE OF 32 DIFFERENT DIFFERENTIAL EQUATIONS.  OR, IN PLACE
C     OF XAMPLES.F, ANY OTHER STURM-LIOUVILLE DIFFERENTIAL
C     EQUATION CAN BE EMPLOYED.  THE EASIEST WAY TO CREATE A FILE
C     CONTAINING AN ARBITRARY DIFFERENTIAL EQUATION, IN PLACE OF
C     THE FILE XAMPLES.F, IS BY USING THE INTERACTIVE PROGRAM
C     MAKEPQW.F.
C          IN EITHER CASE, AS SOON AS THE "EXECUTABLE" IS ACTIVATED,
C     THIS PROGRAM DISPLAYS PROMPTS ON THE SCREEN WHICH INVITE THE
C     USER TO SUPPLY, VIA THE KEYBOARD, THE DATA WHICH DEFINE THE
C     PARTICULAR EIGENVALUE PROBLEM WANTED.  DATA SUCH AS
C        THE INTERVAL (a,b),
C        WHETHER THE ENDPOINTS ARE REGULAR, LIMIT CIRCLE, LIMIT
C          POINT, ETC,
C        WHAT KIND OF BOUNDARY CONDITIONS ARE WANTED AT EACH END,
C        WHICH EIGENVALUES ARE WANTED,
C        AND WHETHER OR NOT A PLOT OF AN EIGENFUNCTION IS WANTED.
C        ETC.
C
C     THERE IS ALSO ANOTHER WAY OF USING THIS DRIVER, WHICH AVOIDS
C     THE "QUESTION & ANSWER" FORMAT, IF A USER WOULD PREFER.  IT
C     REQUIRES PUTTING THE PROBLEM DATA (SUCH AS a, b, Regular,
C     Limit Circle, Limit Point, Boundary Conditions, etc.) IN A
C     VERY BRIEF TEXT FILE, CALLED auto.in .  FOR MORE DETAILS
C     ABOUT THIS METHOD, SEE THE COMMENTS AT THE BEGINNING OF THE
C     SUBROUTINE AUTO() WHICH IS IN THE SAME FILE AS THE ONE
C     CONTAINING THIS DRIVER.  THIS "AUTOMATIC" MODE IS, OF COURSE,
C     MUCH FASTER, BUT PROBABLY SHOULD BE USED ONLY BY SOMEONE WHO
C     IS ALREADY FAMILIAR WITH USING THE MORE USUAL "QUESTION &
C     ANSWER" MODE.
C
C     .. Scalars in Common ..
      REAL A,A1,A1S,A2,A2S,AA,ALF,ALFA1,ALFA2,ALPH0,
     +     ASAV,B,B1,B1S,B2,
     +     B2S,BB,BETA0,BETA1,BETA2,BSAV,DTHDAA,DTHDBB,EIG,EIGSAV,
     +     EPSMIN,FA,FB,GAMM0,GQA,GQB,GWA,GWB,H0,HPI,K0,K11,K12,K21,K22,
     +     L0,LPQA,LPQB,LPWA,LPWB,NU0,P0ATA,P0ATAS,P0ATB,P0ATBS,P10,P20,
     +     P30,P40,P50,P60,PI,QFATA,QFATAS,QFATB,QFATBS,SLF9,TMID,TOL,
     +     TOLL,TSAVEL,TSAVER,TWOPI,Z
      INTEGER ILAST,IND,INTAB,INTSAV,ISAVE,ISLFN,JFLAG,MDTHZ,MFS,MLS,
     +        MMWD,NCA,NCB,NEIG1,NEIG2,NEND,NF,NIVP,NLAST,NUMB0,NUMEIG,
     +        NV,T21,T22,T23,T24,T25
      LOGICAL ADDD,LCA,LCB,PEIGF,PR,REGA,REGB,RITE
      CHARACTER*9 INFM,INFP
      CHARACTER*19 FILLA,FILLB,FILLC
      CHARACTER*32 CH1,CH2,CH3,CH4,CH5,CH6
C     ..
C     .. Arrays in Common ..
      REAL EES(50),SLFUN(9),TEE(100),TT(7,2),TTS(50),
     +     YS(200),YY(7,3,2),
     +     ZEE(100)
      INTEGER IIS(50),JAY(100),MMW(100),NT(2)
      CHARACTER*39 BLNK(2),STAR(2),STR(2)
      CHARACTER*55 XC(8)
C     ..
C     .. Local Scalars ..
      REAL ONE
      INTEGER I,IFLAG,NEIGS,NTMP,NUMB,RESP
      LOGICAL EIGV,PERIOD,SKIPB
      CHARACTER*32 TAPE23
C     ..
C     .. Local Arrays ..
      REAL PLOTF(1000,6),XT(1000,2)
C     ..
C     .. External Subroutines ..
      EXTERNAL AUTO,DRAW,DSPLAY,EXAMP,PERIO,QPLOT,SLEIGN,STAGE
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ATAN,MIN
C     ..
C     .. Common blocks ..
      COMMON /ALBE/LPWA,LPQA,FA,GWA,GQA,LPWB,LPQB,FB,GWB,GQB
      COMMON /BCDATA/A1S,A2S,P0ATAS,QFATAS,B1S,B2S,P0ATBS,QFATBS
      COMMON /BCONDS/A1,A2,B1,B2,ALFA1,ALFA2,BETA1,BETA2,NUMEIG,EIG,TOL,
     +       TOLL,NEIG1,NEIG2,ALF,K11,K12,K21,K22
      COMMON /DATADT/ASAV,BSAV,INTSAV
      COMMON /DATAF/EIGSAV,IND
      COMMON /EIGS/EES,TTS,IIS,ILAST,NLAST,JFLAG,SLF9,NIVP,NEND,PEIGF,
     +       SLFUN,RITE,ISLFN,NF,NV
      COMMON /FLAG/NUMB0
      COMMON /LP/MFS,MLS
      COMMON /PAR/NU0,H0,K0,L0,ALPH0,BETA0,GAMM0,P10,P20,P30,P40,P50,P60
      COMMON /PARAM/INTAB,A,NCA,P0ATA,QFATA,B,NCB,P0ATB,QFATB,REGA,LCA,
     +       REGB,LCB
      COMMON /PASS/YS,MMW,MMWD
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
      COMMON /SHAR/INFM,INFP,CH1,CH2,CH3,CH4,CH5,CH6,STAR,BLNK,STR,
     +       FILLA,FILLB,FILLC,XC
      COMMON /TAPES/T22,T23,T24,T25
      COMMON /TDATA/AA,TMID,BB,DTHDAA,DTHDBB,MDTHZ,ADDD
      COMMON /TEEZ/TEE
      COMMON /TEMP/TT,YY,NT
      COMMON /TSAVE/TSAVEL,TSAVER,ISAVE
      COMMON /Z1/Z
      COMMON /ZEEZ/JAY,ZEE
C     ..
      ONE = 1.0D0
      HPI = 2.0D0*ATAN(ONE)
      PI = 2.0D0*HPI
      TWOPI = 2.0D0*PI
C
      T21 = 21
      T22 = 22
      T23 = 23
      T24 = 24
      T25 = 25
C
C         DEFINITIONS OF SOME STRINGS.
C      (TO BE USED IN SUBROUTINE DSPLAY.)
C
      INFP = '+INFINITY'
      INFM = '-INFINITY'
      CH1 = 'REGULAR                       * '
      CH2 = 'WEAKLY REGULAR                * '
      CH3 = 'LIMIT CIRCLE, NON-OSCILLATORY * '
      CH4 = 'LIMIT CIRCLE, OSCILLATORY     * '
      CH5 = 'LIMIT POINT                   * '
      CH6 = 'UNSPEC.(NOT LCO), DEFAULT B.C.* '
      STAR(1) = ' **************************************'
      STAR(2) = '***************************************'
      BLNK(1) = ' *                                     '
      BLNK(2) = '                                      *'
      FILLA = '*******************'
      FILLB = '                  *'
      FILLC = '------------------ '
C
      XC(1) = ' * (1) THE SOLUTION Y                               * '
      XC(2) = ' * (2) THE QUASI-DERIVATIVE p*Y''                    *'
      XC(3) = ' * (3) THE BOUNDARY CONDITION FUNCTION Y OR [Y,U]   * '
      XC(4) = ' * (4) THE BOUNDARY CONDITION FUNCTION p*Y'' OR [Y,V]*'
      XC(5) = ' * (5) THE PRUFER ANGLE, THETA                      * '
      XC(6) = ' * (6) THE PRUFER MODULUS, RHO                      * '
      XC(7) = ' * (1) x IN THE INTERVAL (a,b)                      * '
      XC(8) = ' * (2) t IN THE INTERVAL (-1,1)                     * '
C
C
      OPEN (T21,FILE='test.out')
C
C     INTRODUCTION :-
      CALL DSPLAY(1,RESP)
      IF (RESP.EQ.0) CALL AUTO

      CALL EXAMP

C     IS MORE INFORMATION REQUIRED? :-
      CALL DSPLAY(2,RESP)

C     SHOULD THE RESULTS BE RECORDED IN A FILE? :=
      CALL DSPLAY(3,RESP)
C     IF SO, GET THE NAME OF THE FILE :-
      IF (RESP.EQ.1) CALL DSPLAY(4,RESP)

  100 CONTINUE
      SKIPB = .FALSE.
      P0ATA = -1.0D0
      QFATA = 1.0D0
      P0ATB = -1.0D0
      QFATB = 1.0D0
C     WHAT KIND OF INTERVAL IS THE PROBLEM ON? :-
      CALL DSPLAY(5,RESP)

  120 CONTINUE
C     GET ENDPOINT A, IF FINITE :-
      IF (INTAB.EQ.1 .OR. INTAB.EQ.2) CALL DSPLAY(6,RESP)

C     CLASSIFICATION OF A :-
      CALL DSPLAY(7,RESP)

C       (IS P0 AT A, OR QF AT A? :- )
      IF (.NOT.REGA .AND. INTAB.LE.2) CALL DSPLAY(8,RESP)

      IF (SKIPB) GO TO 150
  140 CONTINUE
C     (GET ENDPOINT B, IF FINITE :- )
      IF (INTAB.EQ.1 .OR. INTAB.EQ.3) CALL DSPLAY(9,RESP)

C     (CLASSIFICATION OF B :- )
      CALL DSPLAY(10,RESP)

C       (IS P0 AT B, OR QF AT B :- )
      IF (.NOT.REGB .AND. (INTAB.EQ.1.OR.INTAB.EQ.3)) CALL DSPLAY(11,
     +    RESP)

  150 CONTINUE
C     BRIEF SUMMARY OF PROBLEM PARAMETERS :-
C     (IS THIS CORRECT SO FAR?  :- )
      CALL DSPLAY(12,RESP)

C     (IF THIS IS NOT THE RIGHT PROBLEM, DO IT OVER :- )
      IF (RESP.NE.1) THEN
          CALL DSPLAY(13,RESP)
          IF (RESP.EQ.1) THEN
              SKIPB = .TRUE.
              GO TO 120
          ELSE IF (RESP.EQ.2) THEN
              GO TO 140
          ELSE IF (RESP.EQ.3) THEN
              GO TO 100
          END IF
      END IF

C ----------------------------------------------------C
C
C     AT THIS POINT THE DIFFERENTIAL EQUATION AND THE INTERVAL OF
C       INTEREST HAVE BEEN DEFINED AND CHARACTERIZED.
C

C     SHOULD WE COMPUTE AN EIVENVALUE? OR THE SOLUTION
C       TO AN INITIAL VALUE PROBLEM? :-
      CALL DSPLAY(14,RESP)
      EIGV = (RESP.EQ.1)
      IF (EIGV) THEN
          NIVP = 0
          NEND = 0
          PERIOD = .FALSE.
      END IF

  200 CONTINUE
      IF (EIGV .AND. NCA.LE.4 .AND. NCB.LE.4) THEN
C        (ARE THE BC'S SEPARATED?, OR COUPLED?)
          CALL DSPLAY(15,RESP)
          IF (RESP.EQ.1) THEN
C           (THIS MEANS THE BC'S ARE COUPLED)
              PERIOD = .TRUE.
          ELSE
              PERIOD = .FALSE.
          END IF
      END IF
C

  300 CONTINUE
C       SET BOUNDARY CONDITIONS, OR INITIAL CONDITIONS
      IF (EIGV) THEN
          IF (PERIOD) THEN
C           (SET COUPLED BC'S :- )
              CALL DSPLAY(18,RESP)

          ELSE
C           (SET SEPARATED BC'S AT A :- )
              CALL DSPLAY(16,RESP)

C           (SET SEPARATED BC'S AT B :- )
              CALL DSPLAY(17,RESP)
          END IF
      ELSE
C        (SET INITIAL CONDITIONS FOR IVP :- )
          PERIOD = .FALSE.
          CALL DSPLAY(19,RESP)
      END IF
C ----------------------------------------------------C
C
C     PRESUMABLY WE NOW HAVE ASSEMBLED ALL THE DATA
C     NEEDED FOR DEFINING
C          THE EIGENVALUE PROBLEM,
C                     OR
C          THE INITIAL VALUE PROBLEM,
C     WHICHEVER IS WANTED.

  400 CONTINUE
C          COMPUTE A SINGLE EIGENVALUE?, OR SERIES? :-
      NEIGS = 0
      IF (EIGV .AND. .NOT.PERIOD) THEN
          CALL DSPLAY(20,RESP)
          IF (RESP.EQ.1) THEN
              CALL DSPLAY(21,RESP)
              NEIGS = 1
          ELSE
              CALL DSPLAY(23,RESP)
              NEIGS = NEIG2 - NEIG1 + 1
          END IF
      ELSE IF (EIGV) THEN
          CALL DSPLAY(24,RESP)
          IF (RESP.EQ.1) THEN
              CALL DSPLAY(25,RESP)
              NEIGS = 1
          ELSE
              CALL DSPLAY(27,RESP)
              NEIGS = NEIG2 - NEIG1 + 1
              EIG = 0.0D0
          END IF
      END IF
C
      IF (EIGV) THEN
C        (COMPUTE REQUESTED EIGENVALUES)

          IF (NEIGS.EQ.1) THEN
              NEIG1 = NUMEIG
              NEIG2 = NUMEIG
              NLAST = NUMEIG
          END IF
          ILAST = NEIG2 - NEIG1 + 1

          IF (.NOT.PERIOD) THEN
              DO 410 I = 1,ILAST
                  NUMB = NEIG1 + I - 1
                  TOL = TOLL
                  NTMP = NUMB
                  IF (NEIGS.GT.1) EIG = 0.0D0
                  PEIGF = .FALSE.

                  CALL SLEIGN(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,
     +                        B1,B2,NTMP,EIG,TOL,IFLAG,0,SLFUN,NCA,NCB)

                  IF (IFLAG.EQ.0 .OR. IFLAG.GE.15) THEN
                      IF (IFLAG.EQ.0) THEN
                          WRITE (*,FMT=*) ' IMPROPER INPUT PARAMETERS '
                          IF (RITE) THEN
                              WRITE (T22,FMT=*)
     +                          ' IMPROPER INPUT PARAMETERS '
                              WRITE (T22,FMT=*)
     +                        '----------------------------------------'
                          END IF
                      ELSE IF (IFLAG.EQ.15) THEN
                          WRITE (*,FMT=*)
     +                      ' WE CANNOT HANDLE THIS KIND OF ENDPOINT '
                          IF (RITE) THEN
                              WRITE (T22,FMT=*)
     +                        ' WE CANNOT HANDLE THIS KIND OF ENDPOINT '
                              WRITE (T22,FMT=*)
     +                        '----------------------------------------'
                          END IF
                      ELSE IF (IFLAG.EQ.16) THEN
                          WRITE (*,FMT=*) ' COULD NOT GET STARTED '
                          IF (RITE) THEN
                              WRITE (T22,FMT=*)
     +                          ' COULD NOT GET STARTED '
                              WRITE (T22,FMT=*)
     +                        '----------------------------------------'
                          END IF
                      ELSE IF (IFLAG.EQ.17) THEN
                          WRITE (*,FMT=*) ' FAILED TO GET A BRACKET '
                          IF (RITE) THEN
                              WRITE (T22,FMT=*)
     +                          ' FAILED TO GET A BRACKET '
                              WRITE (T22,FMT=*)
     +                        '----------------------------------------'
                          END IF
                      ELSE IF (IFLAG.EQ.18) THEN
                          WRITE (*,FMT=*) ' ESTIMATOR FAILED '
                          IF (RITE) THEN
                              WRITE (T22,FMT=*) ' ESTIMATOR FAILED '
                              WRITE (T22,FMT=*)
     +                        '----------------------------------------'
                          END IF
                      END IF
                      GO TO 700
                  END IF

                  IFLAG = MIN(IFLAG,4)
                  JFLAG = 0

C   JFLAG = 1 OR 2 MEANS ONE OF THE END-POINTS IS LP .
C   JFLAG = 1 MEANS THERE IS NO CONTINUOUS SPECTRUM .
C         = 2 MEANS THERE IS A CONTINUOUS SPECTRUM .

                  SLF9 = SLFUN(9)
                  IF (SLF9.GT.-10000.0D0) JFLAG = 1
                  IF (SLF9.LT.10000.0D0 .AND. JFLAG.EQ.1) JFLAG = 2

                  EES(I) = EIG
                  TTS(I) = TOL
                  IIS(I) = IFLAG

                  IF (IFLAG.EQ.3) THEN
C  (THIS MEANS THAT THERE IS NO EIGENVALUE )
C  (  WITH THIS INDEX                      )
                      ILAST = I
                      NLAST = NTMP
                      GO TO 420
                  END IF
  410         CONTINUE
  420         CONTINUE
              CALL DSPLAY(28,RESP)

          ELSE

              DO 430 I = 1,ILAST
                  NUMEIG = NEIG1 + I - 1
                  TOL = TOLL
                  EIG = 0.0D0
                  CALL PERIO(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,
     +                       B2,NUMEIG,EIG,TOL,IFLAG,SLFUN,NCA,NCB,ALF,
     +                       K11,K12,K21,K22)
                  EES(I) = EIG
                  TTS(I) = TOL
                  IIS(I) = IFLAG
C      (IFLAG = 2 MEANS THAT THE EIGENVALUE IS A DOUBLE)
  430         CONTINUE
              CALL DSPLAY(29,RESP)

          END IF
      END IF
C                                                              C
C -------------------------------------------------------------C
  500 CONTINUE
C
C  WE SHOULD NOW HAVE THE EIGENVALUES COMPUTED, OR HAVE        C
C  THE INITIAL VALUE PROBLEM DEFINED, AS THE CASE MAY BE.      C
C  IF ONLY ONE EIGENVALUE HAS BEEN COMPUTED, THE CORRESPONDING C
C  EIGENFUNCTION CAN NOW BE PLOTTED.  OR IF AN INITIAL VALUE   C
C  PROBLEM HAS BEEN DEFINED, IT MAY BE PLOTTED NOW.            C
C
      IF (.NOT.EIGV) THEN
          CALL DSPLAY(32,RESP)
          CALL STAGE(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,EIG,
     +               IFLAG,SLFUN,NCA,NCB,NIVP,NEND)
      ELSE IF (NEIGS.EQ.1 .AND. (IFLAG.EQ.1.OR.IFLAG.EQ.2)) THEN
          IF (.NOT.PERIOD) THEN
              CALL DSPLAY(22,RESP)
          ELSE
              CALL DSPLAY(26,RESP)
          END IF
      ELSE IF (IFLAG.EQ.0) THEN
          PEIGF = .FALSE.
      END IF

      IF (PEIGF) THEN
          CALL DRAW(A1,A2,B1,B2,NUMEIG,EIG,SLFUN,NIVP,NEND,EIGV,NCA,NCB,
     +              ISLFN,XT,PLOTF,K11,K12,K21,K22,PERIOD)
  600     CONTINUE
C         PLOT WHICH FUNCTION ?
          CALL DSPLAY(33,RESP)
          IF (RESP.EQ.1) CALL QPLOT(ISLFN,XT,NV,PLOTF,NF)
C         SAVE THE PLOT FILE ?
          CALL DSPLAY(34,RESP)
          IF (RESP.EQ.1) THEN
              WRITE (*,FMT=*) ' SPECIFY NAME OF FILE FOR PLOTTING '
              READ (*,FMT='(A)') TAPE23
              OPEN (T23,FILE=TAPE23,STATUS='NEW')
              DO 610 I = 1,ISLFN
                  WRITE (T23,FMT=*) XT(9+I,NV),PLOTF(9+I,NF)
  610         CONTINUE
              CLOSE (T23)
              WRITE (*,FMT=*) ' THE PLOT FILE HAS BEEN WRITTEN TO ',
     +          TAPE23
              IF (RITE) WRITE (T22,FMT=*)
     +            ' THE PLOT FILE HAS BEEN WRITTEN TO ',TAPE23
          END IF
C         PLOT ANOTHER FUNCTION ?
          CALL DSPLAY(35,RESP)
          IF (RESP.EQ.1) GO TO 600
      END IF

  700 CONTINUE
C  ARE WE FINISHED?, OR DO WE HAVE MORE PROBLEMS TO DO?         C
C
      IF (EIGV) THEN
          CALL DSPLAY(30,RESP)
          IF (RESP.EQ.1) GO TO 400
          IF (RESP.EQ.2) GO TO 200
          IF (RESP.EQ.3) GO TO 100
          EIGV = .FALSE.
          IF (RESP.EQ.4) GO TO 300
      ELSE
          CALL DSPLAY(31,RESP)
          IF (RESP.EQ.1) GO TO 500
          IF (RESP.EQ.2) GO TO 300
          IF (RESP.EQ.3) GO TO 100
          EIGV = .TRUE.
          IF (RESP.EQ.4) GO TO 200
      END IF
C
      CLOSE (T22)
      CLOSE (T21)
      STOP
      END
C
      SUBROUTINE DSPLAY(DIS,RESP)
C     .. Scalars in Common ..
      REAL A,A1,A2,ALF,ALFA1,ALFA2,B,B1,B2,BETA1,BETA2,
     +     EIG,HPI,K11,K12,
     +     K21,K22,P0ATA,P0ATB,PI,QFATA,QFATB,SLF9,TOL,TOLL,TWOPI
      INTEGER ILAST,INTAB,ISLFN,JFLAG,NCA,NCB,NEIG1,NEIG2,NEND,NF,NIVP,
     +        NLAST,NUMEIG,NV,T22,T23,T24,T25
      LOGICAL LCA,LCB,PEIGF,REGA,REGB,RITE
      CHARACTER*9 INFM,INFP
      CHARACTER*19 FILLA,FILLB,FILLC
      CHARACTER*32 CH1,CH2,CH3,CH4,CH5,CH6
C     ..
C     .. Local Scalars ..
      REAL CC,DETK,R1,R2,RHO,THA,THB,TMP
      INTEGER I,I1,I2,IFLAG,NANS
      LOGICAL DUBBLE,YEH
      CHARACTER ANSCH,HQ,YN
      CHARACTER*32 CHA,CHANS,CHB,FMAT,TAPE22
      CHARACTER*70 CHTXT
C     ..
C     .. Local Arrays ..
      INTEGER ICOL(2)
      CHARACTER*2 COL(32)
C     ..
C     .. External Subroutines ..
      EXTERNAL HELP,LST,LSTDIR
C     ..
C     .. External Functions ..
      CHARACTER*32 FMT2
      EXTERNAL FMT2
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN2,COS,SIN,SQRT
C     ..

C
C     .. Scalar Arguments ..
      INTEGER DIS,RESP
C     ..
C     .. Arrays in Common ..
      REAL EES(50),SLFUN(9),TTS(50)
      INTEGER IIS(50)
      CHARACTER*39 BLNK(2),STAR(2),STR(2)
      CHARACTER*55 XC(8)
C     ..
C     .. Common blocks ..
      COMMON /BCONDS/A1,A2,B1,B2,ALFA1,ALFA2,BETA1,BETA2,NUMEIG,EIG,TOL,
     +       TOLL,NEIG1,NEIG2,ALF,K11,K12,K21,K22
      COMMON /EIGS/EES,TTS,IIS,ILAST,NLAST,JFLAG,SLF9,NIVP,NEND,PEIGF,
     +       SLFUN,RITE,ISLFN,NF,NV
      COMMON /PARAM/INTAB,A,NCA,P0ATA,QFATA,B,NCB,P0ATB,QFATB,REGA,LCA,
     +       REGB,LCB
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /SHAR/INFM,INFP,CH1,CH2,CH3,CH4,CH5,CH6,STAR,BLNK,STR,
     +       FILLA,FILLB,FILLC,XC
      COMMON /TAPES/T22,T23,T24,T25
C     ..
C     .. Data statements ..
      DATA COL/'01','02','03','04','05','06','07','08','09','10','11',
     +     '12','13','14','15','16','17','18','19','20','21','22','23',
     +     '24','25','26','27','28','29','30','31','32'/
C     ..
      RESP = 1
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
     +       23,24,25,26,27,28,29,30,31,32,33,34,35) DIS
C
    1 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' This program solves the boundary value problem '
      WRITE (*,FMT=*) '   defined by the differential equation '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) '   -(py'')'' + q*y = lambda*w*y  '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' together with appropriate boundary conditions. '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' HELP may be called at any point where the program   '
      WRITE (*,FMT=*)
     +  '    halts and displays (h?) by pressing "h <ENTER>". '
      WRITE (*,FMT=*)
     +  '    To RETURN from HELP, press "r <ENTER>".          '
      WRITE (*,FMT=*)
     +  '    To QUIT at any program halt, press "q <ENTER>".  '
      WRITE (*,FMT=*)
     +  ' WOULD YOU LIKE AN OVERVIEW OF HELP ? (Y/N) (h?) '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H' .OR. HQ.EQ.'y' .OR.
     +    HQ.EQ.'Y') CALL HELP(1)
      WRITE (*,FMT=*)
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N' .OR. HQ .EQ. 'a' .OR. HQ .EQ. 'A'
      IF (.NOT.YEH) GO TO 1
      IF (HQ.EQ.'a' .OR. HQ.EQ.'A') RESP = 0
      RETURN
C
    2 CONTINUE
      WRITE (*,FMT=*) ' DO YOU REQUIRE INFORMATION ON THE RANGE OF '
      WRITE (*,FMT=*) '    BOUNDARY CONDITIONS AVAILABLE ? (Y/N) (h?) '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H' .OR. HQ.EQ.'y' .OR.
     +    HQ.EQ.'Y') CALL HELP(7)
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N' .OR. HQ .EQ. 'h' .OR. HQ .EQ. 'H'
      IF (.NOT.YEH) GO TO 2
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') CALL HELP(7)
      RETURN
C
    3 CONTINUE
  105 CONTINUE
      WRITE (*,FMT=*) ' DO YOU WANT A RECORD KEPT OF THE PROBLEMS '
      WRITE (*,FMT=*) '    AND RESULTS ? (Y/N) (h?) '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N' .OR. HQ .EQ. 'h' .OR. HQ .EQ. 'H'
      IF (.NOT.YEH) GO TO 105
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(8)
          GO TO 105
      END IF
      RITE = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'yes' .OR.
     +       HQ .EQ. 'YES'
      IF (.NOT.RITE) RESP = 0
      RETURN
C
    4 CONTINUE
  205 CONTINUE
      WRITE (*,FMT=*) '  SPECIFY NAME OF THE OUTPUT RECORD FILE: (h?) '
      READ (*,FMT=9010) CHANS
      IF (CHANS.EQ.'q' .OR. CHANS.EQ.'Q') THEN
          STOP
      ELSE IF (CHANS.EQ.'h' .OR. CHANS.EQ.'H') THEN
          CALL HELP(8)
          GO TO 205
      ELSE
          TAPE22 = CHANS
          WRITE (*,FMT=*) '  YOU MAY ENTER SOME HEADER LINE FOR THE '
          WRITE (*,FMT=*) '  OUTPUT RECORD FILE (<=70 CHARACTERS)   '
          WRITE (*,FMT=*) '  IF YOU WISH; OTHERWISE JUST HIT "RETURN".'
          WRITE (*,FMT=*)
          READ (*,FMT=9030) CHTXT
      END IF

C
      OPEN (T22,FILE=TAPE22,STATUS='NEW')
C
      WRITE (T22,FMT=*) '                         ',TAPE22
      WRITE (T22,FMT=*)
      WRITE (T22,FMT=*) CHTXT
      WRITE (T22,FMT=*)
C
      RETURN
C
    5 CONTINUE
  405 CONTINUE
      WRITE (*,FMT=*)
     +  ' ************************************************** '
      WRITE (*,FMT=*)
     +  ' * INDICATE THE KIND OF PROBLEM INTERVAL (a,b):   * '
      WRITE (*,FMT=*)
     +  ' *                                                * '
      WRITE (*,FMT=*)
     +  ' *  (CHECK THAT THE COEFFICIENTS p,q,w ARE WELL   * '
      WRITE (*,FMT=*)
     +  ' *  DEFINED THROUGHOUT THE INTERVAL open(a,b).)   * '
      WRITE (*,FMT=*)
     +  ' *                                                * '
      WRITE (*,FMT=*)
     +  ' *    (1) FINITE, (a,b)                           * '
      WRITE (*,FMT=*)
     +  ' *                                                * '
      WRITE (*,FMT=*)
     +  ' *    (2) SEMI-INFINITE, (a,+INFINITY)            * '
      WRITE (*,FMT=*)
     +  ' *                                                * '
      WRITE (*,FMT=*)
     +  ' *    (3) SEMI-INFINITE, (-INFINITY,b)            * '
      WRITE (*,FMT=*)
     +  ' *                                                * '
      WRITE (*,FMT=*)
     +  ' *    (4) DOUBLY INFINITE, (-INFINITY,+INFINITY)  * '
      WRITE (*,FMT=*)
     +  ' *                                                * '
      WRITE (*,FMT=*)
     +  ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)          * '
      WRITE (*,FMT=*)
     +  ' ************************************************** '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(9)
          GO TO 405
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3' .OR.
     +      HQ .EQ. '4'
      IF (.NOT.YEH) GO TO 405
      READ (CHANS,FMT='(I32)') INTAB
      IF (RITE) THEN
          IF (INTAB.EQ.1) WRITE (T22,FMT=*) ' The interval is (a,b) .'
          IF (INTAB.EQ.2) WRITE (T22,FMT=*) ' The interval is (a,+inf).'
          IF (INTAB.EQ.3) WRITE (T22,FMT=*
     +        ) ' The interval is (-inf,b). '
          IF (INTAB.EQ.4) WRITE (T22,FMT=*
     +        ) ' The interval is (-inf,+inf).'
      END IF
      RESP = INTAB
      RETURN
C
    6 CONTINUE
   60 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * INPUT a: (h?)                             * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' a = '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(10)
          GO TO 60
      END IF
      CALL LST(CHANS,A)
      IF (RITE) WRITE (T22,FMT=*) ' a = ',A
      IF (INTAB.EQ.2) B = A + 1.0D0

      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      RETURN
C
    7 CONTINUE
   70 CONTINUE
      STR(1) = ' * IS THIS PROBLEM:                    '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STAR
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (1) REGULAR AT a ?                '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *       (I.E., THE FUNCTIONS p, q, & w'
      STR(2) = ' ARE BOUNDED CONTINUOUS NEAR a;       *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *        p & w ARE POSITIVE AT a.)    '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (2) WEAKLY REGULAR AT a ?         '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *       (I.E., THE FUNCTIONS 1/p, q, &'
      STR(2) = ' w ALL ARE FINITELY INTEGRABLE ON     *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *        SOME INTERVAL [a,a+e] FOR e >'
      STR(2) = ' 0; p & w ARE POSITIVE NEAR a.)       *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (3) LIMIT CIRCLE, NON-OSCILLATORY '
      STR(2) = 'AT a ?                                *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (4) LIMIT CIRCLE, OSCILLATORY AT a'
      STR(2) = ' ?                                    *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (5) LIMIT POINT AT a ?            '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (6) NOT SPECIFIED (BUT NOT LIMIT C'
      STR(2) = 'IRCLE OSCILLATORY) WITH DEFAULT       *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *       BOUNDARY CONDITION AT a ?     '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' * ENTER THE NUMBER OF YOUR CHOICE: (h)'
      STR(2) = '?                                     *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) STAR
      WRITE (*,FMT=*)
C
C     SPECIFY TYPE OF BOUNDARY CONDITION AT a.
C
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(4)
          GO TO 70
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3' .OR.
     +      HQ .EQ. '4' .OR. HQ .EQ. '5' .OR. HQ .EQ. '6'
      IF (.NOT.YEH) GO TO 70
      READ (CHANS,FMT='(I32)') NANS
C
C     SET CHARACTER STRING CHA ACCORDING TO BOUNDARY CONDITION AT a.
C
      IF (NANS.EQ.1) THEN
          REGA = .TRUE.
          NCA = 1
          P0ATA = -1.0D0
          QFATA = 1.0D0
          CHA = CH1
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint a is Regular. '
      ELSE IF (NANS.EQ.2) THEN
          NCA = 2
          CHA = CH2
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint a is Weakly Regular. '
      ELSE IF (NANS.EQ.3) THEN
          LCA = .TRUE.
          CHA = CH3
          NCA = 3
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint a is Limit Circle,',
     +        ' Non-Oscillatory. '
      ELSE IF (NANS.EQ.4) THEN
          LCA = .TRUE.
          CHA = CH4
          NCA = 4
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint a is Limit Circle,',
     +        ' Oscillatory. '
      ELSE IF (NANS.EQ.5) THEN
          CHA = CH5
          NCA = 5
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint a is Limit Point. '
      ELSE
          CHA = CH6
          NCA = 6
          IF (RITE) WRITE (T22,FMT=*)
     +        ' Endpoint a is Singular, unspecified. '
      END IF
      RESP = NANS
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      RETURN
C
    8 CONTINUE
   80 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * IS p = 0. AT a ? (Y/N) (h?)               * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(11)
          GO TO 80
      END IF
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N'
      IF (.NOT.YEH) GO TO 80
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y'
      P0ATA = -1.0D0
      IF (YEH) P0ATA = 1.0D0
      IF (RITE) THEN
          IF (YEH) THEN
              WRITE (T22,FMT=*) ' p is zero at a. '
          ELSE
              WRITE (T22,FMT=*) ' p is not zero at a. '
          END IF
      END IF

   90 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * IS EITHER OF THE COEFFICIENT FUNCTIONS    * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' *  q OR w UNBOUNDED NEAR a ? (Y/N) (h?)     * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(11)
          GO TO 90
      END IF
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N'
      IF (.NOT.YEH) GO TO 90
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y'
      QFATA = 1.0D0
      IF (YEH) QFATA = -1.0D0
      IF (RITE) THEN
          IF (YEH) THEN
              WRITE (T22,FMT=*) ' either q or w is unbounded near a. '
          ELSE
              WRITE (T22,FMT=*) ' both q and w are bounded near a.  '
          END IF
      END IF
      IF (.NOT.YEH) RESP = 0
      RETURN
C
    9 CONTINUE
  110 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * INPUT b: (h?)                             * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' b = '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(10)
          GO TO 110
      END IF
      CALL LST(CHANS,B)
      IF (RITE) WRITE (T22,FMT=*) ' b = ',B
      IF (INTAB.EQ.3) A = B - 1.0D0
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      RETURN
C
   10 CONTINUE
  120 CONTINUE
      STR(1) = ' * IS THIS PROBLEM:                    '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STAR
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (1) REGULAR AT b ?                '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *       (I.E., THE FUNCTIONS p, q, & w'
      STR(2) = ' ARE BOUNDED CONTINUOUS NEAR b;       *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *        p & w ARE POSITIVE AT b.)    '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (2) WEAKLY REGULAR AT b ?         '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *       (I.E., THE FUNCTIONS 1/p, q, &'
      STR(2) = ' w ALL ARE FINITELY INTEGRABLE ON     *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *        SOME INTERVAL [b-e,b] FOR e >'
      STR(2) = ' 0; p & w ARE POSITIVE NEAR b.)       *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (3) LIMIT CIRCLE, NON-OSCILLATORY '
      STR(2) = 'AT b ?                                *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (4) LIMIT CIRCLE, OSCILLATORY AT b'
      STR(2) = ' ?                                    *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (5) LIMIT POINT AT b ?            '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' *   (6) NOT SPECIFIED (BUT NOT LIMIT C'
      STR(2) = 'IRCLE OSCILLATORY) WITH DEFAULT       *'
      WRITE (*,FMT=9110) STR
      STR(1) = ' *       BOUNDARY CONDITION AT b ?     '
      STR(2) = '                                      *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) BLNK
      STR(1) = ' * ENTER THE NUMBER OF YOUR CHOICE: (h?'
      STR(2) = ')                                     *'
      WRITE (*,FMT=9110) STR
      WRITE (*,FMT=9110) STAR
      WRITE (*,FMT=*)
C
C     SPECIFY TYPE OF BOUNDARY CONDITION AT b.
C
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(4)
          GO TO 120
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3' .OR.
     +      HQ .EQ. '4' .OR. HQ .EQ. '5' .OR. HQ .EQ. '6'
      IF (.NOT.YEH) GO TO 120
      READ (CHANS,FMT='(I32)') NANS
C
C     SET CHARACTER STRING CHB ACCORDING TO BOUNDARY CONDITION AT b.
C
      WRITE (*,FMT=*)
      IF (NANS.EQ.1) THEN
          REGB = .TRUE.
          CHB = CH1
          NCB = 1
          P0ATB = -1.0D0
          QFATB = 1.0D0
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint b is Regular. '
      ELSE IF (NANS.EQ.2) THEN
          CHB = CH2
          NCB = 2
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint b is Weakly Regular. '
      ELSE IF (NANS.EQ.3) THEN
          LCB = .true.
          CHB = CH3
          NCB = 3
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint b is Limit Circle,',
     +        ' Non-Oscillatory. '
      ELSE IF (NANS.EQ.4) THEN
          LCB = .true.
          CHB = CH4
          NCB = 4
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint b is Limit Circle,',
     +        ' Oscillatory. '
      ELSE IF (NANS.EQ.5) THEN
          CHB = CH5
          NCB = 5
          IF (RITE) WRITE (T22,FMT=*) ' Endpoint b is Limit Point. '
      ELSE
          CHB = CH6
          NCB = 6
          IF (RITE) WRITE (T22,FMT=*)
     +        ' Endpoint b is Singular, unspecified. '
      END IF
      RESP = NANS
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      RETURN
C
   11 CONTINUE
  130 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * IS p = 0. AT b ? (Y/N) (h?)               * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(11)
          GO TO 130
      END IF
      READ (CHANS,FMT=9020) YN
      YEH = YN .EQ. 'y' .OR. YN .EQ. 'Y'
      IF (.NOT. (YEH.OR.YN.EQ.'n'.OR.YN.EQ.'N')) GO TO 130
      P0ATB = -1.0D0
      IF (YEH) P0ATB = 1.0D0
      IF (RITE) THEN
          IF (YEH) THEN
              WRITE (T22,FMT=*) ' p is zero at b. '
          ELSE
              WRITE (T22,FMT=*) ' p is not zero at b. '
          END IF
      END IF

  140 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * IS EITHER OF THE COEFFICIENT FUNCTIONS    * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' *  q OR w UNBOUNDED NEAR b ? (Y/N) (h?)     * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(11)
          GO TO 140
      END IF
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N'
      IF (.NOT.YEH) GO TO 140
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y'
      QFATB = 1.0D0
      IF (YEH) QFATB = -1.0D0
      IF (RITE) THEN
          IF (YEH) THEN
              WRITE (T22,FMT=*) ' either q or w is unbounded near b. '
          ELSE
              WRITE (T22,FMT=*) ' both q and w are bounded near b. '
          END IF
      END IF
      IF (.NOT.YEH) RESP = 0
      RETURN
C
   12 CONTINUE
  150 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' ************************************************ '
      WRITE (*,FMT=*)
     +  ' * THIS PROBLEM IS ON THE INTERVAL              * '
      WRITE (*,FMT=*)
     +  ' *                                              * '
      IF (INTAB.EQ.1) THEN
          WRITE (*,FMT=9070) A,B
          WRITE (*,FMT=*) ' *                            ',FILLB
          WRITE (*,FMT=*) ' * ENDPOINT a IS  ',CHA
          WRITE (*,FMT=*) ' *                            ',FILLB
          IF (P0ATA.GT.0.0D0) THEN
              WRITE (*,FMT=*) ' * p IS ZERO AT a             ',FILLB
              WRITE (*,FMT=*) ' *                            ',FILLB
          END IF
          IF (QFATA.LT.0.0D0) THEN
              WRITE (*,FMT=*) ' * q OR w IS NOT BOUNDED AT a ',FILLB
              WRITE (*,FMT=*) ' *                            ',FILLB
          END IF
          WRITE (*,FMT=*) ' * ENDPOINT b IS  ',CHB
          WRITE (*,FMT=*) ' *                            ',FILLB
          IF (P0ATB.GT.0.0D0) THEN
              WRITE (*,FMT=*) ' * p IS ZERO AT b             ',FILLB
              WRITE (*,FMT=*) ' *                            ',FILLB
          END IF
          IF (QFATB.LT.0.0D0) THEN
              WRITE (*,FMT=*) ' * q OR w IS NOT BOUNDED AT b ',FILLB
              WRITE (*,FMT=*) ' *                            ',FILLB
          END IF
      ELSE IF (INTAB.EQ.2) THEN
          WRITE (*,FMT=9080) A,INFP
          WRITE (*,FMT=*) ' *                            ',FILLB
          WRITE (*,FMT=*) ' * ENDPOINT a IS  ',CHA
          WRITE (*,FMT=*) ' *                            ',FILLB
          IF (P0ATA.GT.0.0D0) THEN
              WRITE (*,FMT=*) ' * p IS ZERO AT a             ',FILLB
              WRITE (*,FMT=*) ' *                            ',FILLB
          END IF
          IF (QFATA.LT.0.0D0) THEN
              WRITE (*,FMT=*) ' * q OR w IS NOT BOUNDED AT a ',FILLB
              WRITE (*,FMT=*) ' *                            ',FILLB
          END IF
          WRITE (*,FMT=*) ' * ENDPT +INF IS  ',CHB
          WRITE (*,FMT=*) ' *                            ',FILLB
      ELSE IF (INTAB.EQ.3) THEN
          WRITE (*,FMT=9090) INFM,B
          WRITE (*,FMT=*) ' *                            ',FILLB
          WRITE (*,FMT=*) ' * ENDPT -INF IS  ',CHA
          WRITE (*,FMT=*) ' *                            ',FILLB
          WRITE (*,FMT=*) ' * ENDPOINT b IS  ',CHB
          WRITE (*,FMT=*) ' *                            ',FILLB
          IF (P0ATB.GT.0.0D0) THEN
              WRITE (*,FMT=*) ' * p IS ZERO AT b             ',FILLB
              WRITE (*,FMT=*) ' *                            ',FILLB
          END IF
          IF (QFATB.LT.0.0D0) THEN
              WRITE (*,FMT=*) ' * q OR w IS NOT BOUNDED AT b ',FILLB
              WRITE (*,FMT=*) ' *                            ',FILLB
          END IF
      ELSE
          WRITE (*,FMT=9100) INFM,INFP
          WRITE (*,FMT=*) ' *                            ',FILLB
          WRITE (*,FMT=*) ' * ENDPT -INF IS  ',CHA
          WRITE (*,FMT=*) ' *                            ',FILLB
          WRITE (*,FMT=*) ' * ENDPT +INF IS  ',CHB
          WRITE (*,FMT=*) ' *                            ',FILLB
      END IF
      WRITE (*,FMT=*)
     +  ' * IS THIS THE PROBLEM YOU WANT ? (Y/N) (h?)    * '
      WRITE (*,FMT=*)
     +  ' ************************************************ '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(3)
          GO TO 150
      END IF
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N'
      IF (.NOT.YEH) GO TO 150
      IF (HQ.NE.'y' .AND. HQ.NE.'Y') RESP = 0
      RETURN
C
   13 CONTINUE
  160 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * DO YOU WANT TO RE-DO                      * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' *    (1)  ENDPOINT a                        * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' *    (2)  ENDPOINT b                        * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' *    (3)  BOTH ENDPOINTS a AND b ?          * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)     * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(3)
          GO TO 160
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3'
      IF (.NOT.YEH) GO TO 160
      READ (CHANS,FMT='(I32)') NANS
      RESP = NANS
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      RETURN
C
   14 CONTINUE
  170 CONTINUE
      IF (RITE) WRITE (T22,FMT=*)
     +    '----------------------------------------'
      IF (RITE) WRITE (T22,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' *************************************************'
      WRITE (*,FMT=*)
     +  ' * DO YOU WANT TO COMPUTE                        *'
      WRITE (*,FMT=*)
     +  ' *                                               *'
      WRITE (*,FMT=*)
     +  ' *   (1) AN EIGENVALUE, OR SERIES OF EIGENVALUES *'
      WRITE (*,FMT=*)
     +  ' *                                               *'
      WRITE (*,FMT=*)
     +  ' *   (2) SOLUTION TO AN INITIAL VALUE PROBLEM ?  *'
      WRITE (*,FMT=*)
     +  ' *                                               *'
      WRITE (*,FMT=*)
     +  ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)         *'
      WRITE (*,FMT=*)
     +  ' *************************************************'
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(12)
          GO TO 170
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2'
      IF (.NOT.YEH) GO TO 170
      READ (CHANS,FMT='(I32)') NANS
      RESP = NANS
      RETURN
C
   15 CONTINUE
  200 CONTINUE
      WRITE (*,FMT=*) ' ******************************************** '
      WRITE (*,FMT=*) ' * IS THE BOUNDARY CONDITION PERIODIC ?     * '
      WRITE (*,FMT=*) ' *   OR COUPLED ?                           * '
      WRITE (*,FMT=*) ' *                                          * '
      WRITE (*,FMT=*) ' *   (I.E., y(b) = c*y(a)                   * '
      WRITE (*,FMT=*) ' *    &   p(b)*y''(b) = (1/c)*p(a)*y''(a)     *'
      WRITE (*,FMT=*) ' *                                          * '
      WRITE (*,FMT=*) ' *   OR SOME OTHER COUPLED CONDITION)       * '
      WRITE (*,FMT=*) ' *                                          * '
      WRITE (*,FMT=*) ' * ANSWER (Y/N): (h?)                       * '
      WRITE (*,FMT=*) ' ******************************************** '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(7)
          GO TO 200
      END IF
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N'
      IF (.NOT.YEH) GO TO 200
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y'
      IF (.NOT.YEH) RESP = 0
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      RETURN
C
   16 CONTINUE
      IF (NCA.LE.2 .OR. CHA.EQ.CH6) THEN
  190     CONTINUE
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*) ' * IS THE BOUNDARY CONDITION AT a         * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *    (1) THE DIRICHLET CONDITION         * '
          WRITE (*,FMT=*) ' *        (I.E., y(a) = 0.0)              * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *    (2) THE NEUMANN CONDITION           * '
          WRITE (*,FMT=*) ' *        (I.E., y''(a) = 0.0)             *'
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *    (3) A MORE GENERAL LINEAR           * '
          WRITE (*,FMT=*) ' *        BOUNDARY CONDITION              * '
          WRITE (*,FMT=*) ' *        A1*y(a) + A2*(py'')(a) = 0 ?   *'
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)  * '
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*)
          READ (*,FMT=9010) CHANS
          READ (CHANS,FMT=9020) HQ
          IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
          IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
              CALL HELP(7)
              GO TO 190
          END IF
          YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3'
          IF (.NOT.YEH) GO TO 190
          READ (CHANS,FMT='(I32)') NANS
          IF (NANS.EQ.1) THEN
              A1 = 1.0D0
              A2 = 0.0D0
              IF (RITE) WRITE (T22,FMT=*) ' Dirichlet B.C. at a. '
          ELSE IF (NANS.EQ.2) THEN
              A1 = 0.0D0
              A2 = 1.0D0
              IF (RITE) WRITE (T22,FMT=*) ' Neumann B.C. at a. '
          ELSE
  207         CONTINUE
              WRITE (*,FMT=*)
     +          ' *************************************** '
              WRITE (*,FMT=*)
     +          ' * CHOOSE A1,A2: (h?)                  * '
              WRITE (*,FMT=*)
     +          ' *************************************** '
              WRITE (*,FMT=*)
              WRITE (*,FMT=*) ' A1,A2 = '
              READ (*,FMT=9010) CHANS
              READ (CHANS,FMT=9020) HQ
              IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
              IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
                  CALL HELP(7)
                  GO TO 207
              END IF
              CALL LSTDIR(CHANS,I,ICOL)
              I1 = ICOL(1) - 1
              FMAT = FMT2(I1)
              READ (CHANS,FMT=FMAT) A1,A2
              IF (RITE) WRITE (T22,FMT=*) ' A1,A2 = ',A1,A2
          END IF
      ELSE IF (LCA) THEN
  210     CONTINUE
          IF (RITE) THEN
              WRITE (T22,FMT=*) ' The B.C. at a is '
              WRITE (T22,FMT=*) ' A1*[y,u](a) + A2*[y,v](a) = 0. '
          END IF
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*) ' * THE BOUNDARY CONDITION AT a IS         * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *    A1*[y,u](a) + A2*[y,v](a) = 0,      * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *  WHERE THE CONSTANTS A1 AND A2         * '
          WRITE (*,FMT=*) ' *    MAY BE CHOSEN ARBITRARILY.          * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' * CHOOSE A1,A2: (h?)                     * '
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*)
          WRITE (*,FMT=*) ' A1,A2 = '
          READ (*,FMT=9010) CHANS
          READ (CHANS,FMT=9020) HQ
          IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
          IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
              CALL HELP(7)
              GO TO 210
          END IF
          CALL LSTDIR(CHANS,I,ICOL)
          I1 = ICOL(1) - 1
          FMAT = FMT2(I1)
          READ (CHANS,FMT=FMAT) A1,A2
          IF (RITE) WRITE (T22,FMT=*) ' A1,A2 = ',A1,A2
      END IF
      RETURN
C
   17 CONTINUE
      IF (NCB.LE.2 .OR. CHB.EQ.CH6) THEN
  220     CONTINUE
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*) ' * IS THE BOUNDARY CONDITION AT b         * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *    (1) THE DIRICHLET CONDITION         * '
          WRITE (*,FMT=*) ' *        (I.E., y(b) = 0.0)              * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *    (2) THE NEUMANN CONDITION           * '
          WRITE (*,FMT=*) ' *        (I.E., y''(b) = 0.0)             *'
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *    (3) A MORE GENERAL LINEAR           * '
          WRITE (*,FMT=*) ' *        BOUNDARY CONDITION              * '
          WRITE (*,FMT=*) ' *        B1*y(b) + B2*(py'')(b) = 0 ?   *'
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)  * '
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*)
          READ (*,FMT=9010) CHANS
          READ (CHANS,FMT=9020) HQ
          IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
          IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
              CALL HELP(7)
              GO TO 220
          END IF
          YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3'
          IF (.NOT.YEH) GO TO 220
          READ (CHANS,FMT='(I32)') NANS
          IF (NANS.EQ.1) THEN
              B1 = 1.0D0
              B2 = 0.0D0
              IF (RITE) WRITE (T22,FMT=*) ' Dirichlet B.C. at b. '
          ELSE IF (NANS.EQ.2) THEN
              B1 = 0.0D0
              B2 = 1.0D0
              IF (RITE) WRITE (T22,FMT=*) ' Neumann B.C. at b. '
          ELSE
  230         CONTINUE
              WRITE (*,FMT=*)
     +          ' *************************************** '
              WRITE (*,FMT=*)
     +          ' * CHOOSE B1,B2: (h?)                  * '
              WRITE (*,FMT=*)
     +          ' *************************************** '
              WRITE (*,FMT=*)
              WRITE (*,FMT=*) ' B1,B2 = '
              READ (*,FMT=9010) CHANS
              READ (CHANS,FMT=9020) HQ
              IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
              IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
                  CALL HELP(7)
                  GO TO 230
              END IF
              CALL LSTDIR(CHANS,I,ICOL)
              I1 = ICOL(1) - 1
              FMAT = FMT2(I1)
              READ (CHANS,FMT=FMAT) B1,B2
              IF (RITE) WRITE (T22,FMT=*) ' B1,B2 = ',B1,B2
          END IF
      ELSE IF (LCB) THEN
  240     CONTINUE
          IF (RITE) THEN
              WRITE (T22,FMT=*) ' The B.C. at b is '
              WRITE (T22,FMT=*) ' B1*[y,u](b) + B2*[y,v](b) = 0. '
          END IF
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*) ' * THE BOUNDARY CONDITION AT b IS         * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *    B1*[y,u](b) + B2*[y,v](b) = 0,      * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' *  WHERE THE CONSTANTS B1 AND B2         * '
          WRITE (*,FMT=*) ' *    MAY BE CHOSEN ARBITRARILY.          * '
          WRITE (*,FMT=*) ' *                                        * '
          WRITE (*,FMT=*) ' * CHOOSE B1,B2: (h?)                     * '
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*)
          WRITE (*,FMT=*) ' B1,B2 = '
          READ (*,FMT=9010) CHANS
          READ (CHANS,FMT=9020) HQ
          IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
          IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
              CALL HELP(7)
              GO TO 240
          END IF
          CALL LSTDIR(CHANS,I,ICOL)
          I1 = ICOL(1) - 1
          FMAT = FMT2(I1)
          READ (CHANS,FMT=FMAT) B1,B2
          IF (RITE) WRITE (T22,FMT=*) ' B1,B2 = ',B1,B2
      END IF
      RETURN
C
   18 CONTINUE
  310 CONTINUE
      WRITE (*,FMT=*) ' ******************************************** '
      WRITE (*,FMT=*) ' * IS THIS PROBLEM:                         * '
      WRITE (*,FMT=*) ' *                                          * '
      WRITE (*,FMT=*) ' *   (1) PERIODIC ?                         * '
      WRITE (*,FMT=*) ' *         (I.E., y(b) = y(a)               * '
      WRITE (*,FMT=*) ' *          &   p(b)*y''(b) = p(a)*y''(a) )   *'
      WRITE (*,FMT=*) ' *                                          * '
      WRITE (*,FMT=*) ' *   (2) SEMI-PERIODIC ?                    * '
      WRITE (*,FMT=*) ' *         (I.E., y(b) = -y(a)              * '
      WRITE (*,FMT=*) ' *          &   p(b)*y''(b) = -p(a)*y''(a) )  *'
      WRITE (*,FMT=*) ' *                                          * '
      WRITE (*,FMT=*) ' *   (3) GENERAL PERIODIC TYPE ?            * '
      WRITE (*,FMT=*) ' *         (I.E., y(b) = c*y(a)             * '
      WRITE (*,FMT=*) ' *          &   p(b)*y''(b) = p(a)*y''(a)/c   *'
      WRITE (*,FMT=*) ' *            for some number c .NE. 0. )   * '
      WRITE (*,FMT=*) ' *                                          * '
      WRITE (*,FMT=*) ' *   (4) MORE GENERAL COUPLED TYPE ?        * '
      WRITE (*,FMT=*) ' *                                          * '
      WRITE (*,FMT=*) ' * ENTER THE NUMBER OF YOUR CHOICE: (h)?    * '
      WRITE (*,FMT=*) ' ******************************************** '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(7)
          GO TO 310
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3' .OR.
     +      HQ .EQ. '4'
      IF (.NOT.YEH) GO TO 310
      READ (CHANS,FMT='(I32)') NANS
      IF (NANS.EQ.1) THEN
          CC = 1.0D0
          ALF = 0.0D0
          K11 = 1.0D0
          K12 = 0.0D0
          K21 = 0.0D0
          K22 = 1.0D0
          IF (RITE) WRITE (T22,FMT=*) ' The B.C. is Periodic. '
      ELSE IF (NANS.EQ.2) THEN
          CC = -1.0D0
          ALF = 0.0D0
          K11 = -1.0D0
          K12 = 0.0D0
          K21 = 0.0D0
          K22 = -1.0D0
          IF (RITE) WRITE (T22,FMT=*) ' The B.C. is Semi-Periodic. '
      ELSE IF (NANS.EQ.3) THEN
  320     CONTINUE
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*) ' * INPUT c: (h?)                          * '
          WRITE (*,FMT=*) ' ****************************************** '
          WRITE (*,FMT=*) ' c = '
          READ (*,FMT=9010) CHANS
          READ (CHANS,FMT=9020) HQ
          IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
          IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
              CALL HELP(7)
              GO TO 320
          END IF
          READ (CHANS,FMT='(F32.0)') CC
          ALF = 0.0D0
          K11 = CC
          K12 = 0.0D0
          K21 = 0.0D0
          K22 = 1.0D0/CC
          IF (RITE) WRITE (T22,FMT=*)
     +        ' The B.C. is General Periodic type. '
          IF (RITE) WRITE (T22,FMT=*) ' Parameter c = ',CC
      ELSE
  322     CONTINUE
          WRITE (*,FMT=*)
     +      ' ************************************************** '
          WRITE (*,FMT=*)
     +      ' * FOR THIS PROBLEM, THE GENERAL COUPLED          * '
          WRITE (*,FMT=*)
     +      ' *   BOUNDARY CONDITIONS ARE:                     * '
          WRITE (*,FMT=*)
     +      ' *                                                * '
          IF (NCA.LE.2 .AND. NCB.LE.2) THEN
              WRITE (*,FMT=*)
     +          ' * y( b)  =  EX*{k11*y(a) + k12*py''(a)}           *'
              WRITE (*,FMT=*)
     +          ' * py''(b) = EX*{k21*y(a) + k22*py''(a)}            *'
          ELSE IF (NCA.GE.3 .AND. NCB.LE.2) THEN
              WRITE (*,FMT=*)
     +          ' * y(b) = EX*{k11*n*[y,u](a)+k12[y,v](a)}/d       *'
              WRITE (*,FMT=*)
     +          ' * py''(b) = EX*{k21*n*[y,u](a) + k22*[y,v](a)}/d  *'
              WRITE (*,FMT=*)
     +          ' *                                                * '
              WRITE (*,FMT=*)
     +          ' * WHERE d = sqrt(abs([u,v](a)))                  * '
              WRITE (*,FMT=*)
     +          ' *       n = +1 or -1                             * '
          ELSE IF (NCA.LE.2 .AND. NCB.GE.3) THEN
              WRITE (*,FMT=*)
     +          ' * [y,U](b)*N/D = EX*{k11*y(a) + k12*py''(a)}      *'
              WRITE (*,FMT=*)
     +          ' * [y,V](b)/D = EX*{k21*y(a) + k22*py''(a)}        *'
              WRITE (*,FMT=*)
     +          ' *                                                * '
              WRITE (*,FMT=*)
     +          ' * WHERE D = sqrt(abs([U,V](b)))                  * '
              WRITE (*,FMT=*)
     +          ' *       N = +1 OR -1                             * '
          ELSE
              WRITE (*,FMT=*)
     +          ' * [y,U](b)*N/D=EX*{k11*n*[y,u](a)+k12*[y,v](a)}/d*'
              WRITE (*,FMT=*)
     +          ' * [y,V](b)/D=EX*{k21*n*[y,u](a)+k22*[y,v](a)}/d  *'
              WRITE (*,FMT=*)
     +          ' *                                                * '
              WRITE (*,FMT=*)
     +          ' *       D = sqrt(abs([U,V](b)))                  * '
              WRITE (*,FMT=*)
     +          ' *       N = +1 OR -1                             * '
              WRITE (*,FMT=*)
     +          ' *       D = SQRT(ABS([U,V](A)))                  * '
              WRITE (*,FMT=*)
     +          ' *       N = +1 OR -1                             * '
          END IF
          WRITE (*,FMT=*)
     +      ' *                                                * '
          WRITE (*,FMT=*)
     +      ' * WHERE EX = EXP(I*ALFA)                         * '
          WRITE (*,FMT=*)
     +      ' * AND WHERE     ALFA                             * '
          WRITE (*,FMT=*)
     +      ' * AND THE       K11,K12                          * '
          WRITE (*,FMT=*)
     +      ' *               K21,K22                          * '
          WRITE (*,FMT=*)
     +      ' *                                                * '
          WRITE (*,FMT=*)
     +      ' * NEED TO BE CHOSEN. IT IS NECESSARY THAT        * '
          WRITE (*,FMT=*)
     +      ' *                                                * '
          WRITE (*,FMT=*)
     +      ' *      0.0 .LE. ALFA .LT. PI                     * '
          WRITE (*,FMT=*)
     +      ' *                                                * '
          WRITE (*,FMT=*)
     +      ' * INPUT ALFA : (H?)                              * '
          WRITE (*,FMT=*)
     +      ' ************************************************** '
          WRITE (*,FMT=*) ' ALFA = '
          READ (*,FMT=9010) CHANS
          READ (CHANS,FMT=9020) HQ
          IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
          IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
              CALL HELP(7)
              GO TO 322
          END IF
          READ (CHANS,FMT='(1F32.0)') ALF
          WRITE (*,FMT=*)
     +      ' ********************************************* '
          WRITE (*,FMT=*)
     +      ' * FOR SELF ADJOINTNESS IT IS NECESSARY      * '
          WRITE (*,FMT=*)
     +      ' * THAT                                      * '
          WRITE (*,FMT=*)
     +      ' *                                           * '
          WRITE (*,FMT=*)
     +      ' *      K11*K22 - K12*K21 =  1               * '
          WRITE (*,FMT=*)
     +      ' *                                           * '
          WRITE (*,FMT=*)
     +      ' * INPUT K11,K12 :                           * '
          WRITE (*,FMT=*)
     +      ' ********************************************* '
          WRITE (*,FMT=*) ' K11,K12 = '
          READ (*,FMT=9010) CHANS
          READ (CHANS,FMT=9020) HQ
          IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
          IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
              CALL HELP(7)
              GO TO 322
          END IF
          CALL LSTDIR(CHANS,I,ICOL)
          I1 = ICOL(1) - 1
          FMAT = FMT2(I1)
          READ (CHANS,FMT=FMAT) K11,K12
          WRITE (*,FMT=*)
     +      ' ********************************************* '
          WRITE (*,FMT=*)
     +      ' * INPUT K21,K22 :                           * '
          WRITE (*,FMT=*)
     +      ' ********************************************* '
          WRITE (*,FMT=*) ' K21,K22 = '
          READ (*,FMT=9010) CHANS
          READ (CHANS,FMT=9020) HQ
          IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
          IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
              CALL HELP(7)
              GO TO 322
          END IF
          CALL LSTDIR(CHANS,I,ICOL)
          I1 = ICOL(1) - 1
          FMAT = FMT2(I1)
          READ (CHANS,FMT=FMAT) K21,K22
          WRITE (*,FMT=*)
          WRITE (*,FMT=*)
          WRITE (*,FMT=*)
          WRITE (*,FMT=*) ' ALFA = ',ALF
          WRITE (*,FMT=*) ' K11,K12 = ',K11,K12
          WRITE (*,FMT=*) ' K21,K22 = ',K21,K22
      END IF
      DETK = K11*K22 - K21*K12
      TMP = ABS(DETK-1.0D0)
      IF (TMP.GT.0.01D0) THEN
          WRITE (*,FMT=*) ' WARNING: K11*K22-K12*K21 IS NOT = 1 '
      END IF
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      IF (RITE) THEN
          WRITE (T22,FMT=*)
          WRITE (T22,FMT=*) '   ALFA = ',ALF
          WRITE (T22,FMT=*)
          WRITE (T22,FMT=*) ' K11,K12 = ',K11,K12
          WRITE (T22,FMT=*) ' K21,K22 = ',K21,K22
          WRITE (T22,FMT=*) '   DET(K) = ',DETK
          IF (TMP.GT.0.01D0) THEN
              WRITE (T22,FMT=*) ' WARNING: K11*K22-K12*K21 IS NOT = 1 '
          END IF
      END IF
      IF (RITE) WRITE (T22,FMT=*) ' -------------------------------'//
     +    FILLC
      RETURN
C
   19 CONTINUE
  350 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' *********************************************** '
      WRITE (*,FMT=*)
     +  ' * DO YOU WANT TO COMPUTE THE SOLUTION TO:     * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (1) AN INITIAL VALUE PROBLEM FROM ONE    * '
      WRITE (*,FMT=*)
     +  ' *        END OF THE INTERVAL TO THE OTHER     * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (2) INITIAL VALUE PROBLEMS FROM BOTH     * '
      WRITE (*,FMT=*)
     +  ' *        ENDS TO A MIDPOINT ?                 * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)       * '
      WRITE (*,FMT=*)
     +  ' *********************************************** '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(12)
          GO TO 350
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2'
      IF (.NOT.YEH) GO TO 350
      READ (CHANS,FMT='(I32)') NIVP
      IF (NIVP.EQ.1) THEN
          WRITE (*,FMT=*)
          WRITE (*,FMT=*)
          WRITE (*,FMT=*)
          WRITE (*,FMT=*)
  360     CONTINUE
          WRITE (*,FMT=*)
          WRITE (*,FMT=*)
     +      ' ********************************************* '
          WRITE (*,FMT=*)
     +      ' * WHICH IS THE INITIAL POINT: a OR b ? (h?) * '
          WRITE (*,FMT=*)
     +      ' ********************************************* '
          WRITE (*,FMT=*)
          WRITE (*,FMT=*) ' INITIAL POINT IS '
          READ (*,FMT=9010) CHANS
          READ (CHANS,FMT=9020) HQ
          IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
          IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
              CALL HELP(12)
              GO TO 360
          END IF
          READ (CHANS,FMT=9020) ANSCH
          IF (ANSCH.EQ.'a' .OR. ANSCH.EQ.'A') THEN
              NEND = 1
              IF (RITE) WRITE (T22,FMT=*) ' The Initial Point for this',
     +            ' Initial Value Problem is a. '
              IF (NCA.LE.4 .OR. NCA.EQ.6) THEN
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*)
  370             CONTINUE
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*)
     +              ' ************************************ '
                  WRITE (*,FMT=*)
     +              ' * THE INITIAL CONDITIONS AT a ARE  * '
                  WRITE (*,FMT=*)
     +              ' *                                  * '
                  IF (NCA.LE.2 .OR. NCA.EQ.6) THEN
                      WRITE (*,FMT=*)
     +                  ' *    y(a)=alfa1, py''(a)=alfa2      *'
                  ELSE
                      WRITE (*,FMT=*)
     +                  ' *  [y,u](a)=alfa1, [y,v](a)=alfa2  * '
                  END IF
                  WRITE (*,FMT=*)
     +              ' *                                  * '
                  WRITE (*,FMT=*)
     +              ' * WHERE THE CONSTANTS alfa1, alfa2 * '
                  WRITE (*,FMT=*)
     +              ' *    MAY BE CHOSEN ARBITRARILY.    * '
                  WRITE (*,FMT=*)
     +              ' *                                  * '
                  WRITE (*,FMT=*)
     +              ' * CHOOSE alfa1,alfa2: (h?)         * '
                  WRITE (*,FMT=*)
     +              ' ************************************ '
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*) ' alfa1,alfa2 = '
                  READ (*,FMT=9010) CHANS
                  READ (CHANS,FMT=9020) HQ
                  IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
                  IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
                      CALL HELP(12)
                      GO TO 370
                  END IF
                  CALL LSTDIR(CHANS,I,ICOL)
                  I1 = ICOL(1) - 1
                  FMAT = FMT2(I1)
                  READ (CHANS,FMT=FMAT) ALFA1,ALFA2
                  IF (RITE) WRITE (T22,FMT=*) ' alfa1,alfa2 = ',ALFA1,
     +                ALFA2
                  A1 = ALFA2
                  A2 = -ALFA1
              END IF
          ELSE IF (ANSCH.EQ.'b' .OR. ANSCH.EQ.'B') THEN
              NEND = 2
              IF (RITE) WRITE (T22,FMT=*) ' The Initial Point for this',
     +            ' Initial Value Problem is b. '
              IF (NCB.LE.4 .OR. NCB.EQ.6) THEN
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*)
  380             CONTINUE
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*)
     +              ' ************************************ '
                  WRITE (*,FMT=*)
     +              ' * THE INITIAL CONDITIONS AT b ARE  * '
                  WRITE (*,FMT=*)
     +              ' *                                  * '
                  IF (NCB.LE.2 .OR. NCB.EQ.6) THEN
                      WRITE (*,FMT=*)
     +                  ' *    y(b)=beta1, py''(b)=beta2      *'
                  ELSE
                      WRITE (*,FMT=*)
     +                  ' *  [y,u](b)=beta1, [y,v](b)=beta2  * '
                  END IF
                  WRITE (*,FMT=*)
     +              ' *                                  * '
                  WRITE (*,FMT=*)
     +              ' * WHERE THE CONSTANTS beta1, beta2 * '
                  WRITE (*,FMT=*)
     +              ' *    MAY BE CHOSEN ARBITRARILY.    * '
                  WRITE (*,FMT=*)
     +              ' *                                  * '
                  WRITE (*,FMT=*)
     +              ' * CHOOSE beta1,beta2: (h?)         * '
                  WRITE (*,FMT=*)
     +              ' ************************************ '
                  WRITE (*,FMT=*)
                  WRITE (*,FMT=*) ' beta1,beta2 = '
                  READ (*,FMT=9010) CHANS
                  READ (CHANS,FMT=9020) HQ
                  IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
                  IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
                      CALL HELP(12)
                      GO TO 380
                  END IF
                  CALL LSTDIR(CHANS,I,ICOL)
                  I1 = ICOL(1) - 1
                  FMAT = FMT2(I1)
                  READ (CHANS,FMT=FMAT) BETA1,BETA2
                  IF (RITE) WRITE (T22,FMT=*) ' beta1,beta2 = ',BETA1,
     +                BETA2
                  B1 = BETA2
                  B2 = -BETA1
              END IF
          END IF
      ELSE IF (NIVP.EQ.2) THEN
          NEND = 3
          IF (NCA.LE.4 .OR. NCA.EQ.6) THEN
              WRITE (*,FMT=*)
              WRITE (*,FMT=*)
              WRITE (*,FMT=*)
              WRITE (*,FMT=*)
  390         CONTINUE
              WRITE (*,FMT=*)
              WRITE (*,FMT=*) ' ************************************ '
              WRITE (*,FMT=*) ' * THE INITIAL CONDITIONS AT a ARE  * '
              WRITE (*,FMT=*) ' *                                  * '
              IF (NCA.LE.2 .OR. NCA.EQ.6) THEN
                  WRITE (*,FMT=*)
     +              ' *    y(a)=alfa1, py''(a)=alfa2      *'
              ELSE
                  WRITE (*,FMT=*)
     +              ' *  [y,u](a)=alfa1, [y,v](a)=alfa2  * '
              END IF
              WRITE (*,FMT=*) ' *                                  * '
              WRITE (*,FMT=*) ' * WHERE THE CONSTANTS alfa1, alfa2 * '
              WRITE (*,FMT=*) ' *    MAY BE CHOSEN ARBITRARILY.    * '
              WRITE (*,FMT=*) ' *                                  * '
              WRITE (*,FMT=*) ' * CHOOSE alfa1,alfa2: (h?)         * '
              WRITE (*,FMT=*) ' ************************************ '
              WRITE (*,FMT=*)
              WRITE (*,FMT=*) ' alfa1,alfa2 = '
              READ (*,FMT=9010) CHANS
              READ (CHANS,FMT=9020) HQ
              IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
              IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
                  CALL HELP(12)
                  GO TO 390
              END IF
              CALL LSTDIR(CHANS,I,ICOL)
              I1 = ICOL(1) - 1
              FMAT = FMT2(I1)
              READ (CHANS,FMT=FMAT) ALFA1,ALFA2
              A1 = ALFA2
              A2 = -ALFA1
          END IF
          IF (NCB.LE.4 .OR. NCB.EQ.6) THEN
              WRITE (*,FMT=*)
              WRITE (*,FMT=*)
              WRITE (*,FMT=*)
              WRITE (*,FMT=*)
  400         CONTINUE
              WRITE (*,FMT=*)
              WRITE (*,FMT=*) ' ************************************ '
              WRITE (*,FMT=*) ' * THE INITIAL CONDITIONS AT b ARE  * '
              WRITE (*,FMT=*) ' *                                  * '
              IF (NCB.LE.2 .OR. NCB.EQ.6) THEN
                  WRITE (*,FMT=*)
     +              ' *    y(b)=beta1, py''(b)=beta2      *'
              ELSE
                  WRITE (*,FMT=*)
     +              ' *  [y,u](b)=beta1, [y,v](b)=beta2  * '
              END IF
              WRITE (*,FMT=*) ' *                                  * '
              WRITE (*,FMT=*) ' * WHERE THE CONSTANTS beta1, beta2 * '
              WRITE (*,FMT=*) ' *    MAY BE CHOSEN ARBITRARILY.    * '
              WRITE (*,FMT=*) ' *                                  * '
              WRITE (*,FMT=*) ' * CHOOSE beta1,beta2: (h?)         * '
              WRITE (*,FMT=*) ' ************************************ '
              WRITE (*,FMT=*)
              WRITE (*,FMT=*) ' beta1,beta2 = '
              READ (*,FMT=9010) CHANS
              READ (CHANS,FMT=9020) HQ
              IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
              IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
                  CALL HELP(12)
                  GO TO 400
              END IF
              CALL LSTDIR(CHANS,I,ICOL)
              I1 = ICOL(1) - 1
              FMAT = FMT2(I1)
              READ (CHANS,FMT=FMAT) BETA1,BETA2
              B1 = BETA2
              B2 = -BETA1
          END IF
      END IF
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      RETURN
C
   20 CONTINUE
  250 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * DO YOU WANT TO COMPUTE                    * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' *    (1) A SINGLE EIGENVALUE                * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' *    (2) A SERIES OF EIGENVALUES ?          * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)     * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(13)
          GO TO 250
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2'
      IF (.NOT.YEH) GO TO 250
      READ (CHANS,FMT='(I32)') NANS
      RESP = NANS
      RETURN
   21 CONTINUE
  260 CONTINUE
      WRITE (*,FMT=*) ' ****************************************** '
      WRITE (*,FMT=*) ' * INPUT NUMEIG, EIG, TOL: (h?)           * '
      WRITE (*,FMT=*) ' ****************************************** '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' NUMEIG,EIG,TOL = '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(14)
          GO TO 260
      END IF
      EIG = 0.0D0
      TOL = 0.0D0
      CALL LSTDIR(CHANS,I,ICOL)
      I1 = ICOL(1) - 1
      IF (I.EQ.3) THEN
          I2 = ICOL(2) - ICOL(1) - 1
          FMAT = '(I'//COL(I1)//',1X,F'//COL(I2)//'.0,1X,F'//
     +           COL(30-I1-I2)//'.0)'
          READ (CHANS,FMT=FMAT) NUMEIG,EIG,TOL
      ELSE IF (I.EQ.2) THEN
          FMAT = '(I'//COL(I1)//',1X,F'//COL(31-I1)//'.0)'
          READ (CHANS,FMT=FMAT) NUMEIG,EIG
      ELSE
          FMAT = '(I'//COL(I1)//')'
          READ (CHANS,FMT=FMAT) NUMEIG
      END IF
      IF (RITE) WRITE (T22,FMT=*) ' NUMEIG,EIG,TOL = ',NUMEIG,EIG,TOL
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      RETURN
C
   22 CONTINUE
  270 CONTINUE
      WRITE (*,FMT=*) ' *******************************'//FILLA
      WRITE (*,FMT=*) ' *                              '//FILLB
      WRITE (*,FMT=*) ' * PLOT EIGENFUNCTION ? (Y/N) (h?)'//
     +  '                *'
      WRITE (*,FMT=*) ' *******************************'//FILLA
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(16)
          GO TO 270
      END IF
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N'
      IF (.NOT.YEH) GO TO 270
      PEIGF = (HQ.EQ.'y' .OR. HQ.EQ.'Y')
      IF (.NOT.PEIGF) RESP = 0
      RETURN
C
   23 CONTINUE
  280 CONTINUE
      WRITE (*,FMT=*) ' ****************************************** '
      WRITE (*,FMT=*) ' * INPUT numeig1, numeig2, TOL (h?)       * '
      WRITE (*,FMT=*) ' ****************************************** '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' numeig1,numeig2,TOL = '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(14)
          GO TO 280
      END IF
      TOLL = 0.0D0
c           TOLL = 1.E-5
      CALL LSTDIR(CHANS,I,ICOL)
      I1 = ICOL(1) - 1
      IF (I.EQ.3) THEN
          I2 = ICOL(2) - ICOL(1) - 1
          FMAT = '(I'//COL(I1)//',1X,I'//COL(I2)//',1X,F'//
     +           COL(30-I1-I2)//'.0)'
          READ (CHANS,FMT=FMAT) NEIG1,NEIG2,TOLL
      ELSE
          FMAT = '(I'//COL(I1)//',1X,I'//COL(31-I1)//')'
          READ (CHANS,FMT=FMAT) NEIG1,NEIG2
      END IF
      IF (NEIG1.NE.NEIG2) PEIGF = .FALSE.
      IF (RITE) WRITE (T22,FMT=*) ' numeig1,numeig2,TOL = ',NEIG1,NEIG2,
     +    TOLL
      RETURN
C
   24 CONTINUE
  253 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * DO YOU WANT TO COMPUTE                    * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' *    (1) A SINGLE EIGENVALUE                * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' *    (2) A SERIES OF EIGENVALUES ?          * '
      WRITE (*,FMT=*) ' *                                           * '
      WRITE (*,FMT=*) ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)     * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(13)
          GO TO 253
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2'
      IF (.NOT.YEH) GO TO 253
      READ (CHANS,FMT='(I32)') NANS
      RESP = NANS
      RETURN
C
   25 CONTINUE
  330 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*) ' * INPUT NUMEIG,TOL: (h?)                    * '
      WRITE (*,FMT=*) ' ********************************************* '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' NUMEIG,TOL = '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(17)
          GO TO 330
      END IF
      TOL = 0.0D0
      CALL LSTDIR(CHANS,I,ICOL)
      I1 = ICOL(1) - 1
      IF (I.EQ.2) THEN
          FMAT = '(I'//COL(I1)//',1X,F'//COL(31-I1)//'.0)'
          READ (CHANS,FMT=FMAT) NUMEIG,TOL
      ELSE
          FMAT = '(I'//COL(I1)//')'
          READ (CHANS,FMT=FMAT) NUMEIG
      END IF
      IF (RITE) WRITE (T22,FMT=*) ' NUMEIG,TOL = ',NUMEIG,TOL
      IF (NUMEIG.LT.0 .AND. (NCA.NE.4.AND.NCB.NE.4)) THEN
          WRITE (*,FMT=*) ' NUMEIG MUST BE .GE. 0 '
          GO TO 330
      END IF
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      RETURN
C
   26 CONTINUE
  340 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' *************************************************'
      WRITE (*,FMT=*)
     +  ' * PLOT EIGENFUNCTION ? (Y/N) (h?)               *'
      WRITE (*,FMT=*)
     +  ' *************************************************'
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(16)
          GO TO 340
      END IF
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N'
      IF (.NOT.YEH) GO TO 340
      PEIGF = HQ .EQ. 'y' .OR. HQ .EQ. 'Y'
      IF (.NOT.PEIGF) RESP = 0
      IF (PEIGF) THEN
          THA = ATAN2(A2,-A1)
          IF (THA.LT.0.0D0) THA = THA + PI
          THB = ATAN2(B2,-B1)
          IF (THB.LE.0.0D0) THB = THB + PI
          A1 = COS(THA)
          A2 = -SIN(THA)
          B1 = COS(THB)
          B2 = -SIN(THB)
          R1 = K11*SIN(THA) + K12*COS(THA)
          R2 = K21*SIN(THA) + K22*COS(THA)
          RHO = SQRT(R1**2+R2**2)
          B1 = RHO*B1
          B2 = RHO*B2
          NIVP = 2
          NEND = 3
          SLFUN(1) = 0.0D0
          SLFUN(2) = -1.0D0
          SLFUN(3) = THA
          SLFUN(5) = 1.0D0
          SLFUN(6) = THB + NUMEIG*PI
          SLFUN(8) = 0.00001D0
          SLFUN(9) = 1.0D0
      END IF
      RETURN
C
   27 CONTINUE
  283 CONTINUE
      WRITE (*,FMT=*) ' ****************************************** '
      WRITE (*,FMT=*) ' * INPUT numeig1, numeig2, TOL (h?)       * '
      WRITE (*,FMT=*) ' ****************************************** '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' numeig1,numeig2,TOL = '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(14)
          GO TO 283
      END IF
      CALL LSTDIR(CHANS,I,ICOL)
      I1 = ICOL(1) - 1
      IF (I.EQ.3) THEN
          I2 = ICOL(2) - ICOL(1) - 1
          FMAT = '(I'//COL(I1)//',1X,I'//COL(I2)//',1X,F'//
     +           COL(30-I1-I2)//'.0)'
          READ (CHANS,FMT=FMAT) NEIG1,NEIG2,TOLL
      ELSE
          FMAT = '(I'//COL(I1)//',1X,I'//COL(31-I1)//')'
          READ (CHANS,FMT=FMAT) NEIG1,NEIG2
      END IF
      IF (NEIG1.NE.NEIG2) PEIGF = .FALSE.
      IF (RITE) WRITE (T22,FMT=*) ' numeig1,numeig2,TOL = ',NEIG1,NEIG2,
     +    TOLL
      RETURN
C
   28 CONTINUE
      WRITE (*,FMT=*)
     +  ' **************************************************'
      DO 285 I = 1,ILAST
          NUMEIG = NEIG1 + (I-1)
          EIG = EES(I)
          TOL = TTS(I)
          IFLAG = IIS(I)
          IF (IFLAG.LE.2) THEN
              WRITE (*,FMT=9055) NUMEIG,EIG
              WRITE (*,FMT=9050) TOL,IFLAG

              IF (RITE) THEN
                  WRITE (T22,FMT=9055) NUMEIG,EIG
                  WRITE (T22,FMT=9050) TOL,IFLAG
              END IF

          ELSE IF (IFLAG.EQ.4) THEN
              WRITE (*,FMT=9045) NUMEIG
              IF (RITE) WRITE (T22,FMT=9045) NUMEIG
          ELSE
              WRITE (*,FMT=9040) NUMEIG,IFLAG
              IF (RITE) WRITE (T22,FMT=9040) NUMEIG,IFLAG
              IF (IFLAG.EQ.3) THEN
                IF(NLAST.GE.0) THEN
                  WRITE (*,FMT=9230) NLAST
                  IF (RITE) WRITE (T22,FMT=9230) NLAST
                ELSE IF(.NOT.(NCA.EQ.4 .OR. NCB.EQ.4)) THEN
                  WRITE (*,FMT=9235) 
                  IF (RITE) WRITE (T22,FMT=9235)
                ELSE
                  WRITE (*,FMT=9240)
                  IF (RITE) WRITE (T22,FMT=9240)
                ENDIF
              END IF
          END IF

  285 CONTINUE
      WRITE (*,FMT=*)
     +  ' **************************************************'

      WRITE (*,FMT=*)
      IF (RITE) WRITE (T22,FMT=*)
      IF (JFLAG.EQ.1) WRITE (*,FMT=9260)
      IF (JFLAG.EQ.1 .AND. RITE) WRITE (T22,FMT=9260)
      IF (JFLAG.EQ.2) WRITE (*,FMT=9250) SLF9
      IF (JFLAG.EQ.2 .AND. RITE) WRITE (T22,FMT=9250) SLF9
      IF (RITE) WRITE (T22,FMT=*) ' *******************************'//
     +    FILLA
      WRITE (*,FMT=*)
      RETURN
C
   29 CONTINUE
      WRITE (*,FMT=*)
     +  ' **************************************************'
      DO 303 I = 1,ILAST
          NUMEIG = NEIG1 + I - 1
          EIG = EES(I)
          TOL = TTS(I)
          IFLAG = IIS(I)
          DUBBLE = .FALSE.
          IF (IFLAG.EQ.2) THEN
              DUBBLE = .TRUE.
              IFLAG = 1
          END IF
          WRITE (*,FMT=9055) NUMEIG,EIG
          WRITE (*,FMT=9050) TOL,IFLAG
          IF (DUBBLE) THEN
              WRITE (*,FMT=*)
     +          ' * This eigenvalue appears to be double.          *'
          END IF
          IF (RITE) THEN
              WRITE (T22,FMT=9055) NUMEIG,EIG
              WRITE (T22,FMT=9050) TOL,IFLAG
              IF (DUBBLE) WRITE (T22,FMT=*
     +            ) ' * This eigenvalue appears to be double. * '
          END IF
          WRITE (*,FMT=*)
  303 CONTINUE
      WRITE (*,FMT=*)
     +  ' **************************************************'
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
C
      IF (RITE) WRITE (T22,FMT=*) ' *******************************'//
     +    FILLA
      RETURN
C
   30 CONTINUE
      WRITE (*,FMT=*) ' Press any key to continue. '
      READ (*,FMT=9010) CHANS
      WRITE (*,FMT=*)
     +  ' *********************************************** '
      WRITE (*,FMT=*)
     +  ' * WHAT WOULD YOU LIKE TO DO NOW ?             * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (1)  SAME EIGENVALUE PROBLEM, DIFFERENT  * '
      WRITE (*,FMT=*)
     +  ' *           NUMEIG, EIG, OR TOL               * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (2)  SAME EIGENVALUE PROBLEM, SAME (a,b) * '
      WRITE (*,FMT=*)
     +  ' *           AND p,q,w,u,v BUT DIFFERENT       * '
      WRITE (*,FMT=*)
     +  ' *           BOUNDARY CONDITIONS A1,A2,B1,B2   * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (3)  INTERVAL CHANGE, PROBLEM RESTART    * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (4)  AN INITIAL VALUE PROBLEM            * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (5)  QUIT                                * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)       * '
      WRITE (*,FMT=*)
     +  ' *********************************************** '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(3)
          GO TO 30
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3' .OR.
     +      HQ .EQ. '4' .OR. HQ .EQ. '5'
      IF (.NOT.YEH) GO TO 30
      READ (CHANS,FMT='(I32)') NANS
      RESP = NANS
      RETURN
C
   31 CONTINUE
      WRITE (*,FMT=*) ' Press any key to continue. '
      READ (*,FMT=9010) CHANS
      WRITE (*,FMT=*)
     +  ' *********************************************** '
      WRITE (*,FMT=*)
     +  ' *    (1)  SAME INITIAL VALUE PROBLEM,         * '
      WRITE (*,FMT=*)
     +  ' *           DIFFERENT LAMBDA                  * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (2)  NEW INITIAL VALUE PROBLEM           * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (3)  INTERVAL CHANGE, PROBLEM RESTART    * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (4)  AN EIGENVALUE PROBLEM               * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' *    (5)  QUIT                                * '
      WRITE (*,FMT=*)
     +  ' *                                             * '
      WRITE (*,FMT=*)
     +  ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)       * '
      WRITE (*,FMT=*)
     +  ' *********************************************** '
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(3)
          GO TO 31
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3' .OR.
     +      HQ .EQ. '4' .OR. HQ .EQ. '5'
      IF (.NOT.YEH) GO TO 31
      READ (CHANS,FMT='(I32)') NANS
      RESP = NANS
      RETURN
C
   32 CONTINUE
  410 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' ************************************************ '
      WRITE (*,FMT=*)
     +  ' * WHAT VALUE SHOULD BE USED FOR THE            * '
      WRITE (*,FMT=*)
     +  ' *   EIGENPARAMETER, EIG ?                      * '
      WRITE (*,FMT=*)
     +  ' *                                              * '
      WRITE (*,FMT=*)
     +  ' * INPUT EIG = (h?)                             * '
      WRITE (*,FMT=*)
     +  ' ************************************************ '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' EIG = '
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(12)
          GO TO 410
      END IF
      READ (CHANS,FMT='(F32.0)') EIG
      PEIGF = .TRUE.
      RETURN
C
   33 CONTINUE
  450 CONTINUE
      WRITE (*,FMT=*)
     +  ' ****************************************************'
      WRITE (*,FMT=*)
     +  ' * WHICH FUNCTION DO YOU WANT TO PLOT ?             *'
      WRITE (*,FMT=*)
     +  ' *                                                  *'
      WRITE (*,FMT=*) XC(1)
      WRITE (*,FMT=*) XC(2)
      WRITE (*,FMT=*) XC(3)
      WRITE (*,FMT=*) XC(4)
      WRITE (*,FMT=*) XC(5)
      WRITE (*,FMT=*) XC(6)
      WRITE (*,FMT=*)
     +  ' *                                                  *'
      WRITE (*,FMT=*)
     +  ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)            *'
      WRITE (*,FMT=*)
     +  ' ****************************************************'
      WRITE (*,FMT=*)
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') RESP = 0
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(16)
          GO TO 450
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2' .OR. HQ .EQ. '3' .OR.
     +      HQ .EQ. '4' .OR. HQ .EQ. '5' .OR. HQ .EQ. '6'
      IF (.NOT.YEH) GO TO 450
      READ (CHANS,FMT='(I32)') NF
  470 CONTINUE
      WRITE (*,FMT=*)
     +  ' ****************************************************'
      WRITE (*,FMT=*)
     +  ' * WHICH DO YOU WANT AS THE INDEPENDENT VARIABLE ?  *'
      WRITE (*,FMT=*)
     +  ' *                                                  *'
      WRITE (*,FMT=*) XC(7)
      WRITE (*,FMT=*) XC(8)
      WRITE (*,FMT=*)
     +  ' *                                                  *'
      WRITE (*,FMT=*)
     +  ' * ENTER THE NUMBER OF YOUR CHOICE: (h?)            *'
      WRITE (*,FMT=*)
     +  ' ****************************************************'
      WRITE (*,FMT=*)
C
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') RESP = 0
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(16)
          GO TO 470
      END IF
      YEH = HQ .EQ. '1' .OR. HQ .EQ. '2'
      IF (.NOT.YEH) GO TO 470
      READ (CHANS,FMT='(I32)') NV
      RETURN
C
   34 CONTINUE
  480 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' DO YOU WANT TO SAVE THE PLOT FILE ? (Y/N) (h?)'
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(16)
          GO TO 480
      END IF
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N'
      IF (.NOT.YEH) GO TO 480
      RESP = 0
      IF (HQ.EQ.'y' .OR. HQ.EQ.'Y') RESP = 1
      RETURN
C
   35 CONTINUE
  490 CONTINUE
      WRITE (*,FMT=*) ' PLOT ANOTHER FUNCTION ? (Y/N) (h?)'
      READ (*,FMT=9010) CHANS
      READ (CHANS,FMT=9020) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') STOP
      IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
          CALL HELP(16)
          GO TO 490
      END IF
      YEH = HQ .EQ. 'y' .OR. HQ .EQ. 'Y' .OR. HQ .EQ. 'n' .OR.
     +      HQ .EQ. 'N'
      IF (.NOT.YEH) GO TO 490
      RESP = 0
      IF (HQ.EQ.'y' .OR. HQ.EQ.'Y') RESP = 1
      RETURN
C
 9010 FORMAT (A32)
 9020 FORMAT (A1)
 9030 FORMAT (A70)
 9040 FORMAT (1X,'   NUMEIG = ',I5,'   IFLAG = ',I3)
 9045 FORMAT (1X,'   NUMEIG = ',I5,' : COMPUTATION FAILED ')
 9050 FORMAT (1X,' * TOL = ',D14.5,2X,' IFLAG = ',I3,'             *')
 9055 FORMAT (1X,' * NUMEIG = ',I5,' EIG = ',D18.9,'        *')
 9070 FORMAT (1X,1X,'*   (',F12.7,',',F12.7,')','                *')
 9080 FORMAT (1X,1X,'*   (',F12.7,',',A12,')','                *')
 9090 FORMAT (1X,1X,'*   (',A12,',',F12.7,')','                *')
 9100 FORMAT (1X,1X,'*   (',A12,',',A12,')','                *')
 9110 FORMAT (1X,2A39)
 9230 FORMAT (1X,' * THERE SEEMS TO BE NO EIGENVALUE OF INDEX       *',
     +       /,1X,' * GREATER THAN',I5,'                              *'
     +       )
 9235 FORMAT (1X,' * THERE SEEM TO BE NO EIGENVALUES               *')
 9240 FORMAT (1X,' * THERE SEEMS TO BE NO EIGENVALUE OF THIS INDEX *')
 9250 FORMAT (1X,'* THERE SEEMS TO BE CONTINUOUS SPECTRUM BEGINNING*',/,
     +       1X,'* AT ABOUT',1P,D8.1,'                               *')
 9260 FORMAT (1X,'* THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *')
      END
C
      SUBROUTINE STAGE(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,
     +                 EIG,IFLAG,SLFUN,NCA,NCB,NIVP,NEND)

C
C     THE FOLLOWING CALL SETS THE STAGE IN sleign -- I.E., SAMPLES
C     THE COEFFICIENTS AND SETS THE INITIAL INTERVAL.
C
C     .. Scalar Arguments ..
      REAL A,A1,A2,B,B1,B2,EIG,P0ATA,P0ATB,QFATA,QFATB
      INTEGER IFLAG,INTAB,NCA,NCB,NEND,NIVP
C     ..
C     .. Array Arguments ..
      REAL SLFUN(9)
C     ..
C     .. Scalars in Common ..
      REAL AA,BB,DTHDAA,DTHDBB,HPI,PI,TMID,TWOPI
      INTEGER MDTHZ
      LOGICAL ADDD
C     ..
C     .. Local Scalars ..
      REAL ALFA,BETA,TOL
      INTEGER NUMEIG
C     ..
C     .. External Subroutines ..
      EXTERNAL SLEIGN
C     ..
C     .. Common blocks ..
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /TDATA/AA,TMID,BB,DTHDAA,DTHDBB,MDTHZ,ADDD
C     ..
      NUMEIG = 0
      TOL = .001D0
      CALL SLEIGN(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,NUMEIG,
     +            EIG,TOL,IFLAG,-1,SLFUN,NCA,NCB)
      IF (NIVP.EQ.1 .AND. NEND.EQ.1) TMID = BB
      IF (NIVP.EQ.1 .AND. NEND.EQ.2) TMID = AA
C
C     ACTUALLY, WE MAY HAVE TO AVOID AA OR BB IN SOME CASES,
C     WHICH WILL BE TAKEN CARE OF LATER.
C
      ALFA = 0.0D0
      IF ((NIVP.EQ.1.AND.NEND.EQ.1.AND.NCA.LE.2) .OR.
     +    NIVP.EQ.2) ALFA = SLFUN(3)
      BETA = PI
      IF ((NIVP.EQ.1.AND.NEND.EQ.2.AND.NCB.LE.2) .OR.
     +    NIVP.EQ.2) BETA = SLFUN(6)
      SLFUN(3) = ALFA
      SLFUN(6) = BETA
      SLFUN(4) = 0.0D0
      SLFUN(7) = 0.0D0
      SLFUN(8) = .01D0
      RETURN
      END
C
      SUBROUTINE LSTDIR(CHANS,I,ICOL)
C     .. Local Scalars ..
      INTEGER J
C     ..
C     .. Scalar Arguments ..
      INTEGER I
      CHARACTER*32 CHANS
C     ..
C     .. Array Arguments ..
      INTEGER ICOL(2)
C     ..
      I = 1
      DO 10 J = 1,32
          IF (CHANS(J:J).EQ.',' .OR. CHANS(J:J).EQ.'/') THEN
              ICOL(I) = J
              IF (CHANS(J:J).EQ.'/') THEN
                  CHANS(J:J) = ' '
                  RETURN
              END IF
              I = I + 1
          END IF
   10 CONTINUE
      RETURN
      END
      CHARACTER*32 FUNCTION FMT2(I1)
C     .. Local Arrays ..
      CHARACTER*2 COL(32)
C     ..
C
C     .. Scalar Arguments ..
      INTEGER I1
C     ..
C     .. Data statements ..
      DATA COL/'01','02','03','04','05','06','07','08','09','10','11',
     +     '12','13','14','15','16','17','18','19','20','21','22','23',
     +     '24','25','26','27','28','29','30','31','32'/
C     ..
      FMT2 = '(F'//COL(I1)//'.0,1X,F'//COL(31-I1)//'.0)'
      RETURN
      END
C
      SUBROUTINE CONVT(CHIN,CHINN)
C   THIS PROGRAM CONVERTS AN 8 CHARACTER STRING WITHOUT A ':'
C     TO A BLANK STRING.  BUT IF IT HAS A ':', THEN IT KEEPS THE
C     STRING UP TO AND INCLUDING THE ':' .
C   THE INPUT IS STRING CHIN, AND THE OUTPUT IS CHINN.

C     .. Scalar Arguments ..
      CHARACTER*8 CHIN,CHINN
C     ..
C     .. Local Scalars ..
      INTEGER I,J,K
C     ..
      CHINN = ' '
      J = 0
      K = 0
      DO 10 I = 1,8
          IF (CHIN(I:I).EQ.' ' .AND. J.EQ.0) K = I
          IF (CHIN(I:I).EQ.':') J = I
   10 CONTINUE
      IF (J.GE.1 .AND. J.LE.8) THEN
          DO 20 I = 1,J - K
              CHINN(I:I) = CHIN(I+K:I+K)
   20     CONTINUE
      ELSE
          CHINN = ' '
      END IF
      RETURN
      END
C
      SUBROUTINE AUTO
C  THIS SUBROUTINE IS, IN EFFECT, A VERY SPECIAL KIND OF DRIVER
C    FOR SLEIGN2. IT ENABLES ONE TO BYPASS THE QUESTION
C    AND ANSWER FORMAT IN DRIVE (FOR EXPERIENCED USERS ONLY!).
C    INSTEAD OF ENTERING THE NEEDED INPUT FOR DRIVE FROM THE
C    KEYBOARD, A USER CAN INSTEAD CREATE A VERY BRIEF FILE,
C    CALLED auto.in, IN THE SAME DIRECTORY, WHICH CONTAINS ALL
C    THE DATA THAT WOULD OTHERWISE BE ENTERED FROM THE
C    KEYBOARD.
C
C    ONCE SUCH A FILE HAS BEEN CREATED, THE USER BEGINS AS USUAL,
C    TYPING THE NAME OF THE EXECUTABLE, AS IN

C       XAMPLES.X  <ENTER>

C    FOR EXAMPLE.  THIS WOULD CAUSE THE PROMPT

C        WOULD YOU LIKE AN OVERVIEW OF HELP?(Y/N)(h?)

C    TO APPEAR, AS USUAL.  BUT INSTEAD OF REPLYING TO THE
C    QUESTION WITH y, OR n, OR h, ONE SIMPLY TYPES IN THE
C    RESPONSE
C       a  <ENTER>
C    (The "a" here stands for "automatic" operation of SLEIGN2.);
C    and at this point the computation of the requested
C    eigenvalues(s) proceeds without further action by the user,
C    taking the needed data from the auto.in file instead.
C         The construction of the file "auto.in" consists of simply
C    defining a number of "KEYWORDS", each on a separate line, which
C    together constitute a complete set of input parameters defining
C    the eigenvalue problem to be solved. (The Differential Equation
C    coefficients have, presumably, been already defined in either
C    XAMPLES.F, or BLOGGS.F, or.. .)  The order in which the
C    needed keywords are defined is of no importance.
C         -------------------------------------------
C    The KEYWORDS, all of which end in a colon and must be
C    followed by at least one space, are:

C    a:  -- The left endpoint of the interval (a,b);
C         Value is any real number;
C         Default value is -infinity.
C    b:  -- The right endpoint of the interval (a,b);
C         Value is any real number;
C         Default value is +infinity.
C    classa:  -- The endpoint classification of a;
C              Value is one of { r, wr, lcno, lco, lp, d }.
C    classb:  -- The endpoint classification of b:
C              Value is one of { r, wr, lcno, lco, lp, d }.
C    bca: -- Boundary Condition for the endpoint a;
C          Value is either d (for Dirichlet),
C                          n (for Neuman),
C                       or two real numbers A1, A2 .
C    bcb: -- Boundary Condition for the endpoint b;
C          Value is either d (for Dirichlet),
C                          n (for Neuman),
C                       or two real numbers B1, B2 .
C    bcc:  -- Coupled Boundary Condition;
C           Value is either p (for Periodic),
C                           s (for Semi-Periodic),
C                       or five real numbers
C                          alpha, k11, k12, k21, k22 .
C    numeig:  -- Index (or range of Indices) of desired Eigenvalue;
C              Value is an integer N1, or pair of integers N1,N2 .
C    param:  -- Parameter(s) appropriate for the problem;
C             Value is one or two real numbers, param1, param2 .
C    np:  --  Problem Number;
C           (Appropriate only if one of the Differential Equations
C             in XAMPLES.F is being used.);
C           Value is an integer from 1 to 32 .
C    output:  -- Name of output file;
C              Value is a character string, the name of the output
C                file where the results of the computation are to
C                be written;
C              Default value is "auto.out" .
C    end:  -- Last line of file "auto.in" ; no value set.

C    again:  --  Terminates the input for one eigenvalue problem and
C                begins the input for another ; no value set.

C Although the KEYWORDS used to define any one problem can be defined
C in any order, there are a few rules to be observed:  Namely,
C Only those KEYWORDS whose values are necessary need be mentioned.
C Any KEYWORD definition remains in effect until redefined;
C To erase a previous definition of a KEYWORD, redefine it to
C have the value "null". (For instance, if one problem has
C the endpoint a defined as in "a: 0.0" , and a following
C problem needs to have a undefined (so that a = -Infinity),
C then it would be necessary to set "a: null" .)

C  An example of such a file is exhibited in the box below.

C   ________________________
C  |                        |
C  |output: Bessel.rep      |
C  |np: 2                   |
C  |param: 0.75             |
C  |a: 0.0                  |
C  |b: 1.0                  |
C  |classa: lcno            |
C  |classb: r               |
C  |bca: 1.0,0.0            |
C  |bcb: d                  |
C  |numeig: 2,5             |
C  |end:                    |
C  |________________________|

C     This file (which must be called "auto.in", of course), would
C be suitable for running Bessel's equation in XAMPLES.F .
C Evidently the problem selected is #2 of XAMPLES.F (Bessel's
C equation), with the parameter nu = 0.75, on the interval (0.0,1.0).
C The endpoint a is asserted to be LCNO; endpoint b is R; the
C Boundary Condition at a is defined by A1 = 1.0 & A2 = 0.0;
C Boundary Condition at b is Dirichlet; and the eigenvalues
C lambda(2), lambda(3), lambda(4), lambda(5) are to be computed.

C  --------------------------------------------------------------- C
C     .. Scalars in Common ..
      REAL A,ALPHA,B,BETA,GAMMA,H,KK,L,NU,P1,P2,P3,P4,P5,P6
      INTEGER INTAB,NUMBER,T21,T22,T23,T24,T25
      LOGICAL PR
C     ..
C     .. Local Scalars ..
      REAL A1,A2,ALF,AS,B1,B2,BS,DET,EIG,
     +     K11,K12,K21,K22,ONE,P0ATA,
     +     P0ATB,PARAM1,PARAM2,QFATA,QFATB,TOL,ZER
      INTEGER I,I1,IFLAG,II,INTABS,J,JFLAG,K,LAST,LASTI,M,NCA,NCB,NEIG1,
     +        NEIG2,NP,NUMEIG
      CHARACTER*8 CH8,CHH8
      CHARACTER*32 FMAT
      CHARACTER*62 BCC,BLANK,CH1,CHANS,CHEND,CHIN,CHT,CLASSA,CLASSB,
     +             TAPE25
C     ..
C     .. Local Arrays ..
      REAL PP(5),SLFUN(9)
      INTEGER ICOL(2),VAL(60)
      CHARACTER*2 COL(62)
      CHARACTER*62 CH(60)
C     ..
C     .. External Functions ..
      CHARACTER*32 FMT2
      EXTERNAL FMT2
C     ..
C     .. External Subroutines ..
      EXTERNAL CHAR,CONVT,LST,LSTDIR,PERIO,PQ,SLEIGN,STR2R
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC MIN
C     ..
C     .. Common blocks ..
      COMMON /DATADT/A,B,INTAB
      COMMON /FLAG/NUMBER
      COMMON /PAR/NU,H,KK,L,ALPHA,BETA,GAMMA,P1,P2,P3,P4,P5,P6
      COMMON /PRIN/PR,T21
      COMMON /TAPES/T22,T23,T24,T25
C     ..
C     .. Data statements ..
c

      DATA COL/'01','02','03','04','05','06','07','08','09','10','11',
     +     '12','13','14','15','16','17','18','19','20','21','22','23',
     +     '24','25','26','27','28','29','30','31','32','33','34','35',
     +     '36','37','38','39','40','41','42','43','44','45','46','47',
     +     '48','49','50','51','52','53','54','55','56','57','58','59',
     +     '60','61','62'/
C     ..
c
      OPEN (T21,FILE='test.out')
      OPEN (T24,FILE='auto.in')
c  Set the name of the Output File to 'auto.out' as default.
      TAPE25 = 'auto.out'
c
      ONE = 1.0D0
      ZER = 0.0D0
      ALF = 0.0D0
      CHEND = 'end:'
      BLANK = '                                '
C
C  READ THE auto.in FILE (ASSUMED LESS THAN 50 LINES
C       FOR ANY ONE PROBLEM):

      READ (T24,FMT=9010,END=75) (CH(I),I=1,50)
   75 CONTINUE
C
C  THE VALUES OF THE FUNCTION VAL(*) BELOW INDICATE WHETHER
C    OR NOT CERTAIN KEYWORDS ARE PRESENT IN THE FILE auto.in.
C  WHEN I = 1, VAL(I) REFERS TO THE PROBLEM # IN XAMPLES.F;
C           2, REFERS TO THE POSSIBLE PARAMETERS ;
C              (THERE MAY BE UP TO 2 INPUT PARAMETERS IN
C               THE PARTICULAR DIFFERENTIAL EQUATION.)
C           3, REFERS TO THE ENDPOINT a;
C           4, REFERS TO THE ENDPOINT b;
C           5, REFERS TO THE CLASSIFICATION OF ENDPOINT a;
C           6, REFERS TO THE CLASSIFICATION OF ENDPOINT b;
C           7, REFERS TO A SEPARATED BOUNDARY CONDITION AT a;
C           8, REFERS TO A SEPARATED BOUNDARY CONDITION AT b;
C           9, REFERS TO COUPLED BOUNDARY CONDITIONS;
C          10, REFERS TO THE INDEX(ES) OF THE EIGENVALUES WANTED;
C          11, REFERS TO THE OUTPUT FILE FOR THE RESULTS.
C          12, REFERS TO WHETHER OR NOT THERE IS ANOTHER
C                PROBLEM TO BE RUN.

      DO 15 I = 1,50
          VAL(I) = 0
   15 CONTINUE
      LAST = 0
C
  300 CONTINUE
      A1 = ONE
      A2 = ZER
      B1 = ONE
      B2 = ZER
      DO 60 I = 1,50
          IF (CH(I).NE.BLANK) THEN
              READ (CH(I),FMT=9010) CH1
              READ (CH1,FMT='(A8)') CH8
          ELSE
              CH1 = ' '
              CH8 = ' '
          END IF
          CALL CONVT(CH8,CHH8)
          IF (CHH8.EQ.'np:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              READ (CHANS,FMT='(I7)') NP
              VAL(1) = 1
          ELSE IF (CHH8.EQ.'param:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              IF (CHANS.EQ.'null') THEN
                  VAL(2) = 0
              ELSE IF (M.EQ.0) THEN
                  READ (CHANS,FMT='(F32.0)') PARAM1
                  VAL(2) = 1
              ELSE IF (M.EQ.1) THEN
                  CALL LSTDIR(CHANS,II,ICOL)
                  I1 = ICOL(1) - 1
                  FMAT = FMT2(I1)
                  READ (CHANS,FMT=FMAT) PARAM1,PARAM2
                  VAL(2) = 2
              ELSE IF (M.EQ.4) THEN
                  CHIN = CHANS
                  IF (CHIN.NE.' ') THEN
                      DO 400 J = 1,5
                          IF (CHIN.NE.' ') CALL STR2R(CHIN,PP(J))
  400                 CONTINUE
                  END IF
                  P1 = PP(1)
                  P2 = PP(2)
                  P3 = PP(3)
                  P4 = PP(4)
                  P5 = PP(5)
                  P6 = P2 + P3 + 1.0D0 - P4 - P5
C  THESE NUMBERS ARE THE PARAMETERS s,a,b,c,d,e in the Heun eqn.
C    WITH e = a+b+1-c-d
                  VAL(2) = 5
              END IF
          ELSE IF (CHH8.EQ.'a:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              IF (CHANS.EQ.'null') THEN
                  VAL(3) = 0
              ELSE
                  CALL LST(CHANS,A)
                  VAL(3) = 1
              END IF
          ELSE IF (CHH8.EQ.'b:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              IF (CHANS.EQ.'null') THEN
                  VAL(4) = 0
              ELSE
                  CALL LST(CHANS,B)
                  VAL(4) = 1
              END IF
          ELSE IF (CHH8.EQ.'classa:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              READ (CHANS,FMT='(A32)') CLASSA
              VAL(5) = 1
          ELSE IF (CHH8.EQ.'classb:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              READ (CHANS,FMT='(A32)') CLASSB
              VAL(6) = 1
          ELSE IF (CHH8.EQ.'bca:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              VAL(7) = 2
              IF (CHANS.EQ.'null') THEN
                  VAL(7) = 0
              ELSE IF (M.EQ.0) THEN
                  IF (CHANS.EQ.'d') THEN
                      A1 = ONE
                      A2 = ZER
                  ELSE IF (CHANS.EQ.'n') THEN
                      A1 = ZER
                      A2 = ONE
                  END IF
              ELSE
                  CALL LSTDIR(CHANS,II,ICOL)
                  I1 = ICOL(1) - 1
                  FMAT = FMT2(I1)
                  READ (CHANS,FMT=FMAT) A1,A2
              END IF
          ELSE IF (CHH8.EQ.'bcb:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              VAL(8) = 2
              IF (CHANS.EQ.'null') THEN
                  VAL(8) = 0
              ELSE IF (M.EQ.0) THEN
                  IF (CHANS.EQ.'d') THEN
                      B1 = ONE
                      B2 = ZER
                  ELSE IF (CHANS.EQ.'n') THEN
                      B1 = ZER
                      B2 = ONE
                  END IF
              ELSE
                  CALL LSTDIR(CHANS,II,ICOL)
                  I1 = ICOL(1) - 1
                  FMAT = FMT2(I1)
                  READ (CHANS,FMT=FMAT) B1,B2
              END IF
          ELSE IF (CHH8.EQ.'bcc:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              IF (CHANS.EQ.'null') THEN
                  VAL(9) = 0
              ELSE IF (M.EQ.0) THEN
                  VAL(9) = 1
                  READ (CHANS,FMT='(A32)') BCC
                  IF (BCC.EQ.'p') THEN
                      K11 = ONE
                      K12 = ZER
                      K21 = ZER
                      K22 = ONE
                  ELSE IF (BCC.EQ.'s') THEN
                      K11 = -ONE
                      K12 = ZER
                      K21 = ZER
                      K22 = -ONE
                  END IF
              ELSE
                  CHIN = CHANS
                  DO 405 J = 1,5
                     CALL STR2R(CHIN,PP(J))
 405              CONTINUE
                  ALF = PP(1)
                  K11 = PP(2)
                  K12 = PP(3)
                  K21 = PP(4)
                  K22 = PP(5)
                  VAL(9) = 5
              END IF
          ELSE IF (CHH8.EQ.'numeig:') THEN
              CALL CHAR(CH(I),K,M,CHANS)
              IF (M.EQ.0) THEN
                  READ (CHANS,FMT='(I32)') NUMEIG
                  NEIG1 = NUMEIG
                  NEIG2 = NEIG1
                  VAL(10) = 1
              ELSE
                  CALL LSTDIR(CHANS,II,ICOL)
                  I1 = ICOL(1) - 1
                  FMAT = '(I'//COL(I1)//',1X,I'//COL(61-I1)//')'
                  READ (CHANS,FMT=FMAT) NEIG1,NEIG2
                  VAL(10) = 2
              END IF
          ELSE IF (CHH8.EQ.'output:') THEN
              CLOSE (T25)
              CALL CHAR(CH(I),K,M,CHANS)
              READ (CHANS,FMT='(A32)') TAPE25
              OPEN (T25,FILE=TAPE25)
              VAL(11) = 1
          ELSE IF (CHH8.EQ.'again:') THEN
              LASTI = I
              VAL(12) = VAL(12) + 1
              GO TO 70
          ELSE IF (CHH8.EQ.CHEND) THEN
              GO TO 70
          END IF
   60 CONTINUE
   70 CONTINUE
c
C  WHEN AN ENDPOINT IS LP, NO BOUNDARY CONDITION CAN BE GIVEN;
C    AND COUPLED BOUNDARY CONDITIONS ARE NOT PERMISSIBLE,
C    SO VAL(9) = 0.
      IF (CLASSA.EQ.'lp') THEN
          VAL(7) = 0
          VAL(9) = 0
          NCA = 5
      END IF
      IF (CLASSB.EQ.'lp') THEN
          VAL(8) = 0
          VAL(9) = 0
          NCB = 5
      END IF
      IF ((CLASSA.EQ.'n') .OR. (CLASSA.EQ.'d')) THEN
          VAL(9) = 0
      END IF
      IF ((CLASSB.EQ.'n') .OR. (CLASSB.EQ.'d')) THEN
          VAL(9) = 0
      END IF
c
C  IF ENDPOINT a = -INF, THEN a WAS OMITTED, SO VAL(3) = 0)
C  IF ENDPOINT b = +INF, THEN b WAS OMITTED, SO VAL(4) = 0)
      IF (VAL(3).NE.0 .AND. VAL(4).NE.0) THEN
          INTAB = 1
      ELSE IF (VAL(3).EQ.0 .AND. VAL(4).NE.0) THEN
          INTAB = 3
      ELSE IF (VAL(3).NE.0 .AND. VAL(4).EQ.0) THEN
          INTAB = 2
      ELSE
          INTAB = 4
      END IF
      P0ATA = -1.0D0
      QFATA = 1.0D0
      P0ATB = -1.0D0
      QFATB = 1.0D0
      NCA = 1
      NCB = 1
      NUMBER = NP

C  N.B. FOR classa, or classb, THE VALUE 'd' MEANS DEFAULT.
C    (NOT DIRICHLET)

      IF (VAL(5).NE.0) THEN
          IF (CLASSA.EQ.'r') THEN
              NCA = 1
          ELSE IF (CLASSA.EQ.'wr') THEN
              NCA = 2
          ELSE IF (CLASSA.EQ.'lcno') THEN
              NCA = 3
          ELSE IF (CLASSA.EQ.'lco') THEN
              NCA = 4
          ELSE IF (CLASSA.EQ.'lp') THEN
              NCA = 5
          ELSE IF (CLASSA.EQ.'d') THEN
              NCA = 6
          END IF
      END IF
      IF (VAL(6).NE.0) THEN
          IF (CLASSB.EQ.'r') THEN
              NCB = 1
          ELSE IF (CLASSB.EQ.'wr') THEN
              NCB = 2
          ELSE IF (CLASSB.EQ.'lcno') THEN
              NCB = 3
          ELSE IF (CLASSB.EQ.'lco') THEN
              NCB = 4
          ELSE IF (CLASSB.EQ.'lp') THEN
              NCB = 5
          ELSE IF (CLASSB.EQ.'d') THEN
              NCB = 6
          END IF
      END IF
C
C   WRITE THE RESULTS TO THE OUTPUT FILE:
C
      IF (VAL(11).EQ.0) OPEN (T25,FILE=TAPE25)
C
      IF (VAL(1).NE.0) THEN
          WRITE (T25,FMT=*) ' np = ',NP
      END IF
      IF (VAL(2).EQ.1) THEN
          WRITE (T25,FMT=*) ' param = ',PARAM1
          NU = PARAM1
          KK = PARAM1
          ALPHA = PARAM1
          GAMMA = PARAM1
      ELSE IF (VAL(2).EQ.2) THEN
          WRITE (T25,FMT=*) ' param = ',PARAM1,PARAM2
          NU = PARAM1
          KK = PARAM1
          ALPHA = PARAM1
          GAMMA = PARAM1
          H = PARAM2
          BETA = PARAM2
      ELSE IF (VAL(2).EQ.5) THEN
          WRITE (T25,FMT=*) ' param = ',P1,P2,P3
          WRITE (T25,FMT=*) '         ',P4,P5,P6
      END IF
      IF (VAL(3).NE.0) THEN
          WRITE (T25,FMT=*) ' a = ',A
          IF (CLASSA.NE.'r') THEN
              CALL PQ(-ONE,P0ATA,QFATA)
              WRITE (T25,FMT=*) '   P0ATA,QFATA = ',P0ATA,QFATA
          END IF
      ELSE
          WRITE (T25,FMT=*) ' A = ',' -INF'
      END IF
      IF (VAL(5).NE.0) WRITE (T25,FMT=*) '   CLASSA = ',CLASSA
      IF (VAL(7).EQ.2) WRITE (T25,FMT=*) '   A1,A2 = ',A1,A2
      IF (VAL(4).NE.0) THEN
          WRITE (T25,FMT=*) ' b = ',B
          IF (CLASSB.NE.'r') THEN
              CALL PQ(ONE,P0ATB,QFATB)
              WRITE (T25,FMT=*) '   P0ATB,QFATB = ',P0ATB,QFATB
          END IF
      ELSE
          WRITE (T25,FMT=*) ' B = ','+INF'
      END IF
      IF (VAL(6).NE.0) WRITE (T25,FMT=*) '   CLASSB = ',CLASSB
      IF (VAL(8).EQ.2) WRITE (T25,FMT=*) '   B1,B2 = ',B1,B2
      IF (VAL(9).NE.0) THEN
          IF (VAL(9).EQ.5) WRITE (T25,FMT=*) ' BCC = G '
          WRITE (T25,FMT=*) '    ALFA = ',ALF
          WRITE (T25,FMT=*) ' K11,K12 = ',K11,K12
          WRITE (T25,FMT=*) ' K21,K22 = ',K21,K22
          DET = K11*K22 - K12*K21
          WRITE (T25,FMT=*) ' DET = ',DET
      END IF
      IF (VAL(10).EQ.1) THEN
          WRITE (T25,FMT=*) ' NUMEIG = ',NEIG1
      ELSE IF (VAL(10).EQ.2) THEN
          WRITE (T25,FMT=*) ' NUMEIG1,NUMEIG2 = ',NEIG1,NEIG2
      END IF
C
      WRITE (T25,FMT=*)

C  HERE, VAL(9) = 0 MEANS THE BOUNDARY CONDITIONS ARE SEPARATED.

      IF (VAL(9).EQ.0) THEN
          DO 10 I = NEIG1,NEIG2
              NUMEIG = I
              EIG = 0.0D0
              TOL = ZER
              IFLAG = 1
              AS = A
              BS = B
              INTABS = INTAB
c             CALL SLEIGN(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,
              CALL SLEIGN(AS,BS,INTABS,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,
     +                    B2,NUMEIG,EIG,TOL,IFLAG,0,SLFUN,NCA,NCB)
c    +                    NUMEIG,EIG,TOL,IFLAG,0,SLFUN,NCA,NCB)
              IF (IFLAG.EQ.15) THEN
                  WRITE (T25,FMT=*)
     +              ' WE CANNOT HANDLE THIS KIND OF ENDPOINT. '
                  WRITE (*,FMT=*)
                  GO TO 12
              END IF
              IFLAG = MIN(IFLAG,4)
              JFLAG = 0
              IF (SLFUN(9).GT.-10000.0D0) JFLAG = 1
              IF (SLFUN(9).LT.10000.0D0 .AND. JFLAG.EQ.1) JFLAG = 2
              IF (IFLAG.EQ.4) WRITE (*,FMT=9045) NUMEIG
              IF (IFLAG.EQ.4) WRITE (T25,FMT=9045) NUMEIG
              IF (IFLAG.LE.3) WRITE (*,FMT=*) ' IFLAG = ',IFLAG
              IF (IFLAG.LE.3) WRITE (T25,FMT=*) ' IFLAG = ',IFLAG
              IF (IFLAG.EQ.3) THEN
                IF (NUMEIG.GE.0) THEN
                  WRITE (T25,FMT=9230) NUMEIG
                ELSE IF( .NOT.(NCA.EQ.4 .OR. NCB.EQ.4)) THEN
                  WRITE (T25,FMT=9235)
                ELSE
                  WRITE (T25,FMT=9240)
                ENDIF
              ELSE IF (IFLAG.LE.2) THEN
                  WRITE (*,FMT=*) ' NUMEIG,EIG,TOL = ',NUMEIG,EIG,TOL
                  WRITE (T25,FMT=*) ' NUMEIG,EIG,TOL = ',NUMEIG,EIG,TOL
              END IF
   10     CONTINUE
   12     CONTINUE
          WRITE (*,FMT=*)
          WRITE (T25,FMT=*)
          IF (JFLAG.EQ.1) WRITE (*,FMT=9260)
          IF (JFLAG.EQ.2) WRITE (*,FMT=9250) SLFUN(9)
          IF (JFLAG.EQ.1) WRITE (T25,FMT=9260)
          IF (JFLAG.EQ.2) WRITE (T25,FMT=9250) SLFUN(9)
      ELSE
          DO 20 I = NEIG1,NEIG2
              NUMEIG = I
              EIG = 0.0D0
              TOL = ZER
              AS = A
              BS = B
              INTABS = INTAB
              IFLAG = 1
              CALL PERIO(AS,BS,INTABS,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,
     +                   B2,NUMEIG,EIG,TOL,IFLAG,SLFUN,NCA,NCB,ALF,K11,
     +                   K12,K21,K22)
              IFLAG = MIN(IFLAG,4)
              IF (IFLAG.EQ.0) IFLAG = 4
              IF (IFLAG.EQ.4) WRITE (*,FMT=9045) NUMEIG
              IF (IFLAG.EQ.4) WRITE (T25,FMT=9045) NUMEIG
              IF (IFLAG.LE.2) THEN
                  WRITE (*,FMT=*) ' IFLAG = ',IFLAG
                  WRITE (T25,FMT=*) ' IFLAG = ',IFLAG
                  WRITE (*,FMT=*) ' NUMEIG,EIG,TOL = ',NUMEIG,EIG,TOL
                  WRITE (T25,FMT=*) ' NUMEIG,EIG,TOL = ',NUMEIG,EIG,TOL
              END IF
              IF (IFLAG.EQ.2) WRITE (T25,FMT=*
     +            ) ' THIS EIGENVALUE APPEARS TO BE DOUBLE. '
   20     CONTINUE
      END IF
      WRITE (T25,FMT=*) '______________________________________________'
C
C  HERE, VAL(12) .NE. 0 MEANS THAT ANOTHER PROBLEM IS TO BE RUN.
C  SO ANY CHANGES IN THE ENDPOINTS, OR BOUNDARY CONDITIONS, OR
C  ETC., MUST BE READ IN.  ANY PARAMETERS THAT ARE NOT CHANGED
C  ARE KEPT AS BEFORE.

      IF (VAL(12).NE.0) THEN
          REWIND T24
          DO 80 I = 1,50
              CH(I) = BLANK
   80     CONTINUE
          LAST = LAST + LASTI
          READ (T24,FMT=9010) (CHT,I=1,LAST)
          READ (T24,FMT=9010,END=85) (CH(I),I=1,50)
   85     CONTINUE
          VAL(12) = 0
          GO TO 300
      END IF
C
      CLOSE (T21)
      CLOSE (T24)
      WRITE (T25,FMT=*) 'end ',TAPE25
      CLOSE (T25)
C
      STOP
 9010 FORMAT (A62)
 9045 FORMAT (1X,'   NUMEIG = ',I5,' : COMPUTATION FAILED ')
 9230 FORMAT (1X,' * THERE SEEMS TO BE NO EIGENVALUE OF INDEX       *',
     +       /,1X,' * GREATER THAN',I5,'                              *'
     +       )
 9235 FORMAT (1X,' * THERE SEEM TO BE NO EIGENVALUES                *')
 9240 FORMAT (1X,' * THERE SEEMS TO BE NO EIGENVALUE OF THIS INDEX  *')
 9250 FORMAT (1X,' * THERE SEEMS TO BE CONTINUOUS SPECTRUM BEGINNING*',
     +       /,1X,' * AT ABOUT',1P,D8.1,
     +       '                               *')
 9260 FORMAT (1X,' * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *')
      END
c
      SUBROUTINE STR2R(CHIN,P)
C  THIS PROGRAM EXPECTS A CHARACTER STRING, CHIN, CONTAINING
C    DIGITS AND, POSSIBLY, COMMAS.  IT CONVERTS THE FIRST SUBSTRING
C    TO BE THE CORRESPONDING REAL NUMBER P.
C    THUS THE STRING
C        4.0,2.0,1.5,2.5
C    WOULD CAUSE P TO BE SET EQUAL TO THE REAL NUMBER 4.0,
C    AND CHIN ON OUTPUT WOULD BE THE STRING
C        2.0,1.5,2.5
C     .. Scalar Arguments ..
      REAL P
      CHARACTER*62 CHIN
C     ..
C     .. Local Scalars ..
      INTEGER I,J,K
      CHARACTER CH1
      CHARACTER*62 CHINN,CHOUT
C     ..
      CH1 = ','
      CHINN = '                               '
      CHOUT = '                               '
      DO 10 I = 1,60
          IF ((CHIN(I:I).EQ.CH1) .OR. (I.GT.1.AND.CHIN(I:I).EQ.' '))
     +        THEN
              J = I - 1
              GO TO 20
          END IF
   10 CONTINUE
   20 CONTINUE
      DO 30 I = 1,J
          CHINN(I:I) = CHIN(I:I)
   30 CONTINUE
      READ (CHINN,FMT=9020) P
      DO 40 I = J + 2,62
          K = I - J - 1
          CHOUT(K:K) = CHIN(I:I)
   40 CONTINUE
      CHIN = CHOUT
 9020 FORMAT (5F12.7)
      RETURN
      END
c
      SUBROUTINE CHAR(CHIN,K,M,CHOUT)
C
C  THIS PROGRAM IS INTENDED TO READ A LINE LIKE
C     '  abcd:  0.532,12.34,-57.000,0.7693 '
C  AND RETURN WITH
C    K = 9     (the number of characters up to the first non-blank
C                one after the : )
C    M = 3     (the number of commas after the : )
C  AND WITH
C    CHOUT = '0.532,12.34,-57.000,0.7693'
C  THUS READING THE LINE
C    'param:  1.23,-0.43,22.7,0.0037,-11.21'
C  THE RESULT WOULD BE 
C     K = 8
C     M = 4
C     CHOUT = 1.23,-0.43,22.7,0.0037,-11.21
C
C     .. Scalar Arguments ..
      INTEGER K,M
      CHARACTER*62 CHIN,CHOUT
C     ..
C     .. Local Scalars ..
      INTEGER I,J,L
      CHARACTER*16 CH2
C     ..
C     .. Local Arrays ..
      CHARACTER CH(62)
C     ..
      M = 0
      DO 10 I = 1,8
          READ (CHIN,FMT=100) (CH(J),J=1,I)
          IF (CH(I).EQ.':') GO TO 20
          M = I
   10 CONTINUE
   20 CONTINUE
      M = 0
      J = 0
      K = 0
      DO 30 I = 1,12
          READ (CHIN,FMT=100) (CH(L),L=1,I)
          IF (J.NE.0 .AND. K.EQ.0 .AND. CH(I).NE.' ') K = I
          IF (M.NE.0 .AND. K.EQ.0 .AND. CH(I).EQ.' ') J = I
          IF (CH(I).EQ.':') M = I
   30 CONTINUE
      M = 0
      DO 45 I = 1,62
          READ (CHIN,FMT=100) (CH(L),L=1,I)
          IF (CH(I).EQ.',') M = M + 1
   45 CONTINUE
      K = J
      IF (K.EQ.1) THEN
          READ (CHIN,FMT=101) CH2,CHOUT
      ELSE IF (K.EQ.2) THEN
          READ (CHIN,FMT=102) CH2,CHOUT
      ELSE IF (K.EQ.3) THEN
          READ (CHIN,FMT=103) CH2,CHOUT
      ELSE IF (K.EQ.4) THEN
          READ (CHIN,FMT=104) CH2,CHOUT
      ELSE IF (K.EQ.5) THEN
          READ (CHIN,FMT=105) CH2,CHOUT
      ELSE IF (K.EQ.6) THEN
          READ (CHIN,FMT=106) CH2,CHOUT
      ELSE IF (K.EQ.7) THEN
          READ (CHIN,FMT=107) CH2,CHOUT
      ELSE IF (K.EQ.8) THEN
          READ (CHIN,FMT=108) CH2,CHOUT
      ELSE IF (K.EQ.9) THEN
          READ (CHIN,FMT=109) CH2,CHOUT
      ELSE IF (K.EQ.10) THEN
          READ (CHIN,FMT=110) CH2,CHOUT
      ELSE IF (K.EQ.11) THEN
          READ (CHIN,FMT=111) CH2,CHOUT
      ELSE IF (K.EQ.12) THEN
          READ (CHIN,FMT=112) CH2,CHOUT
      END IF
      RETURN
  100 FORMAT (62A1)
  101 FORMAT (A1,A61)
  102 FORMAT (A2,A60)
  103 FORMAT (A3,A59)
  104 FORMAT (A4,A58)
  105 FORMAT (A5,A57)
  106 FORMAT (A6,A56)
  107 FORMAT (A7,A55)
  108 FORMAT (A8,A54)
  109 FORMAT (A9,A53)
  110 FORMAT (A10,A52)
  111 FORMAT (A11,A51)
  112 FORMAT (A12,A50)
      END
C
      SUBROUTINE LST(CHANS,A)
C  THIS PROGRAM CONVERTS A CHARACTER STRING CHANS TO A REAL
C    NUMBER A.  IT JUST ALLOWS THE NUMBERS PI, PI/2, PI/4,
C    2PI TO BE READ IN AS CHARACTERS INSTEAD OF HAVING TO
C    ENTER THEM AS DECIMAL DIGITS.
C
C     .. Scalar Arguments ..
      REAL A
      CHARACTER*32 CHANS
C     ..
C     .. Local Scalars ..
      REAL ONE,PI,PI4
      INTEGER I
C     ..
C     .. Local Arrays ..
      REAL Y(48)
      CHARACTER*8 X(48)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ATAN
C     ..
      ONE = 1.0D0
      PI4 = ATAN(ONE)
      PI = 4.0D0*PI4
c
      X(1) = '-PI'
      Y(1) = -PI
      X(2) = '-2.0*PI'
      Y(2) = -2.0D0*PI
      X(3) = '-2.*PI'
      Y(3) = -2.0D0*PI
      X(4) = '-.5*PI'
      Y(4) = -0.5D0*PI
      X(5) = '-0.5*PI'
      Y(5) = -0.5D0*PI
      X(6) = '-.25*PI'
      Y(6) = -0.25D0*PI
      X(7) = '-0.25*PI'
      Y(7) = -0.25D0*PI
      X(8) = '-PI/2'
      Y(8) = -0.5D0*PI
      X(9) = '-PI/4'
      Y(9) = -0.25D0*PI
c
      X(10) = '-pi'
      Y(10) = -PI
      X(11) = '-2.0*pi'
      Y(11) = -2.0D0*PI
      X(12) = '-2.*pi'
      Y(12) = -2.0D0*PI
      X(13) = '-.5*pi'
      Y(13) = -0.5D0*PI
      X(14) = '-0.5*pi'
      Y(14) = -0.5D0*PI
      X(15) = '-.25*pi'
      Y(15) = -0.25D0*PI
      X(16) = '-0.25*pi'
      Y(16) = -0.25D0*PI
      X(17) = '-pi/2'
      Y(17) = -0.5D0*PI
      X(18) = '-pi/4'
      Y(18) = -0.25D0*PI
c
      X(19) = 'PI'
      Y(19) = PI
      X(20) = '2.0*PI'
      Y(20) = 2.0D0*PI
      X(21) = '2.*PI'
      Y(21) = 2.0D0*PI
      X(22) = '.5*PI'
      Y(22) = 0.5D0*PI
      X(23) = '.25*PI'
      Y(23) = 0.25D0*PI
      X(24) = 'PI/2'
      Y(24) = 0.5D0*PI
      X(25) = 'PI/4'
      Y(25) = 0.25D0*PI
c
      X(26) = 'pi'
      Y(26) = PI
      X(27) = '2.0*pi'
      Y(27) = 2.0D0*PI
      X(28) = '2.*pi'
      Y(28) = 2.0D0*PI
      X(29) = '.5*pi'
      Y(29) = 0.5D0*PI
      X(30) = '.25*pi'
      Y(30) = 0.25D0*PI
      X(31) = 'pi/2'
      Y(31) = 0.5D0*PI
      X(32) = 'pi/4'
      Y(32) = 0.25D0*PI
c
      X(33) = '0.5*PI'
      Y(33) = 0.5D0*PI
      X(34) = '0.5*pi'
      Y(34) = 0.5D0*PI
      X(35) = '-0.5*PI'
      Y(35) = -0.5D0*PI
      X(36) = '-0.5*pi'
      Y(36) = -0.5D0*PI
      X(37) = 'PI/2.0'
      Y(37) = PI/2.0D0
      X(38) = 'pi/2.0'
      Y(38) = PI/2.0D0
      X(39) = '-PI/2.0'
      Y(39) = -PI/2.0D0
      X(40) = '-pi/2.0'
      Y(40) = -PI/2.0D0
      X(41) = 'PI/4.0'
      Y(41) = PI/4.0D0
      X(42) = 'pi/4.0'
      Y(42) = PI/4.0D0
      X(43) = '-PI/4.0'
      Y(43) = -PI/4.0D0
      X(44) = '-pi/4.0'
      Y(44) = -PI/4.0D0
      X(45) = '-0.25*PI'
      Y(45) = -0.25D0*PI
      X(46) = '-0.25*pi'
      Y(46) = -0.25D0*PI
      X(47) = '0.25*PI'
      Y(47) = 0.25D0*PI
      X(48) = '0.25*pi'
      Y(48) = 0.25D0*PI
C
      DO 10 I = 1,48
          IF (CHANS.EQ.X(I)) THEN
              A = Y(I)
              RETURN
          END IF
   10 CONTINUE
      READ (CHANS,FMT='(F32.0)') A
C
      RETURN
      END
C
      SUBROUTINE HELP(NH)
C
C     .. Scalar Arguments ..
      INTEGER NH
C     ..
C     .. Local Scalars ..
      INTEGER I,N
      CHARACTER ANS
C     ..
C     .. Local Arrays ..
      CHARACTER*36 X(23),Y(23)
C     ..
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) NH
c
    1 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) 'H1:  Overview of HELP.'
      X(1) = '  This ASCII text file is supplied a'
      Y(1) = 's a separate file with the sleign2  '
      X(2) = 'package; it can be accessed on-line '
      Y(2) = 'in both MAKEPQW (if used) and DRIVE.'
      X(3) = '  HELP contains information to aid t'
      Y(3) = 'he user in entering data on the co- '
      X(4) = 'efficient functions p,q,w; on the se'
      Y(4) = 'lf-adjoint, separated and coupled,  '
      X(5) = 'regular and singular, boundary condi'
      Y(5) = 'tions; on the limit circle boundary '
      X(6) = 'condition functions u,v at a and U,V'
      Y(6) = ' at b; on the end-point classifica- '
      X(7) = 'tions of the differential equation; '
      Y(7) = 'on DEFAULT entry; on eigenvalue in- '
      X(8) = 'dexes; on IFLAG information; and on '
      Y(8) = 'the general use of the program      '
      X(9) = 'sleign2.                            '
      Y(9) = ' '
      X(10) = '  The 17 sections of HELP are:      '
      Y(10) = ' '
      X(11) = ' '
      Y(11) = ' '
      X(12) = '    H1: Overview of HELP.           '
      Y(12) = ' '
      X(13) = '    H2: File name entry.            '
      Y(13) = ' '
      X(14) = '    H3: The differential equation.  '
      Y(14) = ' '
      X(15) = '    H4: End-point classification.   '
      Y(15) = ' '
      X(16) = '    H5: DEFAULT entry.              '
      Y(16) = ' '
      X(17) = '    H6: Self-adjoint limit-circle bo'
      Y(17) = 'undary conditions.                  '
      DO 101 I = 1,17
          WRITE (*,FMT=*) X(I),Y(I)
  101 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = '    H7: General self-adjoint boundar'
      Y(1) = 'y conditions. '
      X(2) = '    H8: Recording the results.      '
      Y(2) = ' '
      X(3) = '    H9: Type and choice of interval.'
      Y(3) = ' '
      X(4) = '   H10: Entry of end-points.        '
      Y(4) = ' '
      X(5) = '   H11: End-point values of p,q,w.  '
      Y(5) = ' '
      X(6) = '   H12: Initial value problems.     '
      Y(6) = ' '
      X(7) = '   H13: Indexing of eigenvalues for '
      Y(7) = 'separated boundary conditions.      '
      X(8) = '   H14: Entry of eigenvalue index, i'
      Y(8) = 'nitial guess, and tolerance.     '
      X(9) = '   H15: IFLAG information.          '
      Y(9) = ' '
      X(10) = '   H16: Plotting.                  '
      Y(10) = ' '
      X(11) = '   H17: Indexing of eigenvalues for'
      Y(11) = 'coupled boundary conditions.       '
      X(12) = ' '
      Y(12) = ' '
      X(13) = '  HELP can be accessed at each point'
      Y(13) = ' in MAKEPQW and DRIVE where the user'
      X(14) = 'is asked for input, by pressing "h <'
      Y(14) = 'ENTER>"; this places the user at the'
      X(15) = 'appropriate HELP section.  Once in H'
      Y(15) = 'ELP, the user can scroll the further'
      X(16) = 'HELP sections by repeatedly pressing'
      Y(16) = ' "h <ENTER>", or jump to a specific '
      X(17) = 'HELP section Hn (n=1,2,...17) by typ'
      Y(17) = 'ing "Hn <ENTER>"; to return to the  '
      X(18) = 'place in the program from which HELP'
      Y(18) = ' is called, press "r <ENTER>".      '
      DO 102 I = 1,18
          WRITE (*,FMT=*) X(I),Y(I)
  102 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
    2 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) 'H2:  File name entry.'
      X(1) = '  MAKEPQW is used to create a FORTRA'
      Y(1) = 'N file containing the coefficients  '
      X(2) = 'p(x),q(x),w(x), defining the differe'
      Y(2) = 'ntial equation, and the boundary    '
      X(3) = 'condition functions u(x),v(x) and U('
      Y(3) = 'x),V(x) if required.  The file must '
      X(4) = 'be given a NEW filename which is acc'
      Y(4) = 'eptable to your FORTRAN compiler.   '
      X(5) = 'For example, it might be called bess'
      Y(5) = 'el.f or bessel.for, depending upon  '
      X(6) = 'your compiler.                      '
      Y(6) = ' '
      X(7) = '  The same naming considerations app'
      Y(7) = 'ly if the FORTRAN file is prepared  '
      X(8) = 'other than with the use of MAKEPQW. '
      Y(8) = ' '
      DO 201 I = 1,8
          WRITE (*,FMT=*) X(I),Y(I)
  201 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
    3 CONTINUE
      WRITE (*,FMT=*) 'H3:  The differential equation.'
      X(1) = '  The prompt "Input p (or q or w) ="'
      Y(1) = ' requests you to type in a FORTRAN  '
      X(2) = 'expression defining the function p(x'
      Y(2) = '), which is one of the three coeffi-'
      X(3) = 'cient functions defining the Sturm-L'
      Y(3) = 'iouville differential equation      '
      X(4) = ' '
      Y(4) = ' '
      X(5) = '                   -(p*y'')'' + q*y = '
      Y(5) = ' lambda*w*y              (*)        '
      X(6) = ' '
      Y(6) = ' '
      X(7) = 'to be considered on some interval (a'
      Y(7) = ',b) of the real line.  The actual   '
      X(8) = 'interval used in a particular proble'
      Y(8) = 'm can be chosen later, and may be   '
      X(9) = 'either the whole interval (a,b) wher'
      Y(9) = 'e the coefficient functions p,q,w,  '
      X(10) = 'etc. are defined or any sub-interval'
      Y(10) = ' (a'',b'') of (a,b); a = -infinity  '
      X(11) = 'and/or b = +infinity are allowable c'
      Y(11) = 'hoices for the end-points.          '
      X(12) = '  The coefficient functions p,q,w of'
      Y(12) = ' the differential equation may be   '
      X(13) = 'chosen arbitrarily but must satisfy '
      Y(13) = 'the following conditions:           '
      X(14) = '  1. p,q,w are real-valued throughou'
      Y(14) = 't (a,b).                            '
      X(15) = '  2. p,q,w are piece-wise continuous'
      Y(15) = ' and defined throughout the         '
      X(16) = '     interior of the interval (a,b).'
      Y(16) = '                                    '
      X(17) = '  3. p and w are strictly positive i'
      Y(17) = 'n (a,b).                            '
      X(18) = '     For better error analysis in th'
      Y(18) = 'e numerical procedures, condition 2.'
      X(19) = '     above is often replaced with   '
      Y(19) = ' '
      X(20) = '  2''. p,q,w are four times continuou'
      Y(20) = 'sly differentiable on (a,b).        '
      X(21) = '  The behavior of p,q,w near the end'
      Y(21) = '-points a and b is critical to the  '
      X(22) = 'classification of the differential e'
      Y(22) = 'quation (see H4 and H11).           '
      DO 301 I = 1,22
          WRITE (*,FMT=*) X(I),Y(I)
  301 CONTINUE
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
    4 CONTINUE
      WRITE (*,FMT=*) 'H4:  End-point classification.'
      X(1) = '  The correct classification of the '
      Y(1) = 'end-points a and b is essential to  '
      X(2) = 'the working of the sleign2 program. '
      Y(2) = ' To classify the end-points, it is  '
      X(3) = 'convenient to choose a point c in (a'
      Y(3) = ',b); i.e.,  a < c < b.  Subject to  '
      X(4) = 'the general conditions on the coeffi'
      Y(4) = 'cient functions p,q,w (see H3):     '
      X(5) = '  1. a is REGULAR (say R) if -infini'
      Y(5) = 'ty < a, p,q,w are piece-wise        '
      X(6) = '     continuous on [a,c], and p(a) >'
      Y(6) = ' 0 and w(a) > 0.                    '
      X(7) = '  2. a is WEAKLY REGULAR (say WR) if'
      Y(7) = ' -infinity < a, a is not R, and     '
      X(8) = '                     |c             '
      Y(8) = ' '
      X(9) = '            integral | {1/p+|q|+w} <'
      Y(9) = ' +infinity.                         '
      X(10) = '                     |a             '
      Y(10) = ' '
      X(11) = '     If end-point a is neither R nor'
      Y(11) = ' WR, then a is SINGULAR; that is,   '
      X(12) = '     either -infinity = a, or -infin'
      Y(12) = 'ity < a and                         '
      X(13) = '                     |c             '
      Y(13) = ' '
      X(14) = '            integral | {1/p+|q|+w} ='
      Y(14) = ' +infinity.                         '
      X(15) = '                     |a             '
      Y(15) = ' '
      X(16) = '  3. The SINGULAR end-point a is LIM'
      Y(16) = 'IT-CIRCLE NON-OSCILLATORY (say      '
      X(17) = '     LCNO) if for some real lambda A'
      Y(17) = 'LL real-valued solutions y of the   '
      X(18) = '     differential equation          '
      Y(18) = ' '
      X(19) = ' '
      Y(19) = ' '
      X(20) = '                   -(p*y'')'' + q*y = '
      Y(20) = 'lambda*w*y on (a,c]     (*)         '
      X(21) = ' '
      Y(21) = ' '
      X(22) = '     satisfy the conditions:        '
      Y(22) = ' '
      DO 401 I = 1,22
          WRITE (*,FMT=*) X(I),Y(I)
  401 CONTINUE
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = '                     |c             '
      Y(1) = ' '
      X(2) = '            integral | { w*y*y } < +'
      Y(2) = 'infinity, and                       '
      X(3) = '                     |a             '
      Y(3) = ' '
      X(4) = '     y has at most a finite number o'
      Y(4) = 'f zeros in (a,c].                   '
      X(5) = '  4. The SINGULAR end-point a is LIM'
      Y(5) = 'IT-CIRCLE OSCILLATORY (say LCO) if  '
      X(6) = '     for some real lambda ALL real-v'
      Y(6) = ' alued solutions of the differential'
      X(7) = '     equation (*) satisfy the condit'
      Y(7) = 'ions:                               '
      X(8) = '                     |c             '
      Y(8) = ' '
      X(9) = '            integral | { w*y*y } < +'
      Y(9) = 'infinity, and                       '
      X(10) = '                     |a             '
      Y(10) = ' '
      X(11) = '     y has an infinite number of zer'
      Y(11) = 'os in (a,c].                        '
      X(12) = '  5. The SINGULAR end-point a is LIM'
      Y(12) = 'IT POINT (say LP) if for some real  '
      X(13) = '     lambda at least one solution of'
      Y(13) = ' the differential equation (*) sat- '
      X(14) = '     isfies the condition:          '
      Y(14) = ' '
      X(15) = '                     |c             '
      Y(15) = ' '
      X(16) = '            integral | {w*y*y} = +in'
      Y(16) = 'finity.                             '
      X(17) = '                     |a             '
      Y(17) = ' '
      X(18) = '  There is a similar classification '
      Y(18) = 'of the end-point b into one of the  '
      X(19) = 'five distinct cases R, WR, LCNO, LCO'
      Y(19) = ', LP.                               '
      DO 402 I = 1,19
          WRITE (*,FMT=*) X(I),Y(I)
  402 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = '  Although the classification of sin'
      Y(1) = 'gular end-points invokes a real     '
      X(2) = 'value of the parameter lambda, this '
      Y(2) = 'classification is invariant in      '
      X(3) = 'lambda; all real choices of lambda l'
      Y(3) = 'ead to the same classification.     '
      X(4) = '  In determining the classification '
      Y(4) = 'of singular end-points for the      '
      X(5) = 'differential equation (*), it is oft'
      Y(5) = 'en convenient to start with the     '
      X(6) = 'choice lambda = 0 in attempting to f'
      Y(6) = 'ind solutions (particularly when    '
      X(7) = 'q = 0 on (a,b)); however, see exampl'
      Y(7) = 'e 7 below.                          '
      X(8) = '  See H6 on the use of maximal domai'
      Y(8) = 'n functions to determine the        '
      X(9) = 'classification at singular end-point'
      Y(9) = 's.                                  '
      DO 403 I = 1,9
          WRITE (*,FMT=*) X(I),Y(I)
  403 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      WRITE (*,FMT=*) ' EXAMPLES: '
      X(1) = '  1. -y'''' = lambda*y is R at both en'
      Y(1) = 'd-points of (a,b) when a and b are  '
      X(2) = '     finite.                        '
      Y(2) = ' '
      X(3) = '  2. -y'''' = lambda*y on (-infinity,i'
      Y(3) = 'nfinity) is LP at both end-points.  '
      X(4) = '  3. -(sqrt(x)*y''(x))'' = lambda*(1./'
      Y(4) = 'sqrt(x))*y(x) on (0,infinity) is    '
      X(5) = '     WR at 0 and LP at +infinity (ta'
      Y(5) = 'ke lambda = 0 in (*)).  See         '
      X(6) = '     examples.f, #10 (Weakly Regular'
      Y(6) = ').                                  '
      X(7) = '  4. -((1-x*x)*y''(x))'' = lambda*y(x)'
      Y(7) = ' on (-1,1) is LCNO at both ends     '
      X(8) = '     (take lambda = 0 in (*)).  See '
      Y(8) = 'xamples.f, #1 (Legendre).           '
      X(9) = '  5. -y''''(x) + C*(1/(x*x))*y(x) = la'
      Y(9) = 'mbda*y(x) on (0,infinity) is LP at  '
      X(10) = '     infinity and at 0 is (take lamb'
      Y(10) = 'da = 0 in (*)):                     '
      X(11) = '       LP for C .ge. 3/4 ;          '
      Y(11) = ' '
      X(12) = '       LCNO for -1/4 .le. C .lt. 3/4'
      Y(12) = ' (but C .ne. 0);                    '
      X(13) = '       LCO for C .lt. -1/4.         '
      Y(13) = ' '
      X(14) = '  6. -(x*y''(x))'' - (1/x)*y(x) = lamb'
      Y(14) = 'da*y(x) on (0,infinity) is LCO at 0 '
      X(15) = '     and LP at +infinity (take lambd'
      Y(15) = 'a = 0 in (*) with solutions         '
      X(16) = '     cos(ln(x)) and sin(ln(x))).  Se'
      Y(16) = 'e xamples.f, #7 (BEZ).              '
      X(17) = '  7. -(x*y''(x))'' - x*y(x) = lambda*('
      Y(17) = '1/x)*y(x) on (0,infinity) is LP at 0'
      X(18) = '     and LCO at infinity (take lambd'
      Y(18) = 'a = -1/4 in (*) with solutions      '
      X(19) = '     cos(x)/sqrt(x) and sin(x)/sqrt('
      Y(19) = 'x)).  See xamples.f,                '
      X(20) = '     #6 (Sears-Titchmarsh).         '
      Y(20) = ' '
      X(21) = '  8. -y''''(x) + x*sin(x)*y(x) = lambd'
      Y(21) = 'a*y(x) on (0,infinity) is R at 0 and'
      X(22) = '     LP at infinity.  See examples.f'
      Y(22) = ' #30 (Littlewood-McLeod).           '
      DO 404 I = 1,22
          WRITE (*,FMT=*) X(I),Y(I)
  404 CONTINUE
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
    5 CONTINUE
      WRITE (*,FMT=*) 'H5:  DEFAULT entry.'
      X(1) = '  The complete range of problems for'
      Y(1) = ' which sleign2 is applicable can    '
      X(2) = 'only be reached by appropriate entri'
      Y(2) = 'es under end-point classification   '
      X(3) = 'and boundary conditions.  However, t'
      Y(3) = 'here is a DEFAULT application which '
      X(4) = 'requires no detailed entry of end-po'
      Y(4) = 'int classification or boundary      '
      X(5) = 'conditions, subject to:             '
      Y(5) = ' '
      X(6) = '  1. The DEFAULT application CANNOT '
      Y(6) = 'be used at a LCO end-point.         '
      X(7) = '  2. If an end-point a is R, then th'
      Y(7) = 'e Dirichlet boundary condition      '
      X(8) = '     y(a) = 0 is automatically used.'
      Y(8) = ' '
      X(9) = '  3. If an end-point a is WR, then t'
      Y(9) = 'he following boundary condition     '
      X(10) = '     is automatically applied:      '
      Y(10) = ' '
      X(11) = '       if p(a) = 0, and both q(a),w('
      Y(11) = 'a) are bounded, then the Neumann    '
      X(12) = '       boundary condition (py'')(a) '
      Y(12) = '= 0 is used, or                     '
      X(13) = '       if p(a) > 0, and q(a) and/or '
      Y(13) = 'w(a)) are not bounded, then the     '
      X(14) = '       Dirichlet boundary condition '
      Y(14) = 'y(a) = 0 is used.                   '
      X(15) = '       If p(a) = 0, and q(a) and/or '
      Y(15) = 'w(a) are not bounded, then no simple'
      X(16) = '       information, in general, can '
      Y(16) = ' be given on the DEFAULT boundary   '
      X(17) = '       condition.                   '
      Y(17) = ' '
      X(18) = '  4. If an end-point is LCNO, then i'
      Y(18) = 'n most cases the principal or       '
      X(19) = '     Friedrichs boundary condition i'
      Y(19) = 's applied (see H6).                 '
      X(20) = '  5. If an end-point is LP, then the'
      Y(20) = ' normal LP procedure is applied     '
      X(21) = '     (see H7(1.)).                  '
      Y(21) = ' '
      X(22) = 'If the DEFAULT condition is chosen, '
      Y(22) = 'then no entry is required for the   '
      X(23) = 'u,v and U,V boundary condition funct'
      Y(23) = 'ions. '
      DO 501 I = 1,23
          WRITE (*,FMT=*) X(I),Y(I)
  501 CONTINUE
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
    6 CONTINUE
      WRITE (*,FMT=*) 'H6:  Limit-circle boundary conditions.'
      X(1) = '  At an end-point a, the limit-circl'
      Y(1) = 'e type separated boundary condition '
      X(2) = 'is of the form (similar remarks thro'
      Y(2) = 'ughout apply to the end-point b with'
      X(3) = ' U,V being boundary condition functi'
      Y(3) = 'ons at b)                           '
      X(4) = ' '
      Y(4) = ' '
      X(5) = '       A1*[y,u](a) + A2*[y,v](a) = 0'
      Y(5) = ',                          (**)     '
      X(6) = ' '
      Y(6) = ' '
      X(7) = 'where y is a solution of the differe'
      Y(7) = 'ntial equation                      '
      X(8) = ' '
      Y(8) = ' '
      X(9) = '     -(p*y'')'' + q*y = lambda*w*y  on'
      Y(9) = ' (a,b).                     (*)     '
      X(10) = ' '
      Y(10) = ' '
      X(11) = 'Here A1, A2 are real numbers; u and '
      Y(11) = 'v are boundary condition functions  '
      X(12) = 'at a; and for real-valued y and u th'
      Y(12) = 'e form [y,u] is defined by          '
      X(13) = '                                    '
      Y(13) = '                                    '
      X(14) = '   [y,u](x) = y(x)*(pu'')(x) - u(x)*'
      Y(14) = '(py'')(x)   for x in (a,b).         '
      X(15) = '                                    '
      Y(15) = '                                    '
      X(16) = '  If neither end-point is LP then th'
      Y(16) = 'ere are also self-adjoint coupled   '
      X(17) = 'boundary conditions.  These have a c'
      Y(17) = 'anonical form given by              '
      X(18) = '                                    '
      Y(18) = '                                    '
      X(19) = '    Y(b) = exp(i*alpha)*K*Y(a),     '
      Y(19) = ' '
      X(20) = '                                    '
      Y(20) = '                                    '
      X(21) = 'where K is a real 2 by 2 matrix with'
      Y(21) = ' determinant 1, alpha is restricted '
      X(22) = 'to the interval (-pi,pi], and Y is  '
      Y(22) = '  '
      DO 551 I = 1,22
          WRITE (*,FMT=*) X(I),Y(I)
  551 CONTINUE
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = ' (i) the solution vector Y = transpo'
      Y(1) = 'se [y(a), (py'')(a)] at a regular   '
      X(2) = '     end-point a, or                '
      Y(2) = ' '
      X(3) = ' (ii) the "singular solution vector"'
      Y(3) = ' Y(a) = transpose [[y,u](a),        '
      X(4) = '      [y,v](a)] at a singular LC end'
      Y(4) = ' -point a.  Similarly at the right  '
      X(5) = '      end-point b with U,V.         '
      Y(5) = ' '
      X(6) = '  The object of this section is to p'
      Y(6) = 'rovide help in choosing appropriate '
      X(7) = 'functions u and v in (**) (or U,V), '
      Y(7) = 'given the differential equation (*).'
      X(8) = 'Full details of the boundary conditi'
      Y(8) = 'ons for (*) are discussed in H7;    '
      X(9) = 'here it is sufficient to say that th'
      Y(9) = 'e limit-circle type boundary condi- '
      X(10) = 'tion (**) can be applied at any end-'
      Y(10) = 'point in the LCNO, LCO classifica-  '
      X(11) = 'tion, but also in the R, WR classifi'
      Y(11) = 'cation subject to the appropriate   '
      X(12) = 'choice of u,v or U,V.               '
      Y(12) = ' '
      X(13) = '  Let (*) be R, WR, LCNO, or LCO at '
      Y(13) = 'end-point a and choose c in (a,b).  '
      X(14) = 'Then either                         '
      Y(14) = ' '
      X(15) = '  u and v are a pair of linearly ind'
      Y(15) = 'ependent solutions of (*) on (a,c]  '
      X(16) = '  for any chosen real values of lamb'
      Y(16) = 'da, or                              '
      X(17) = '  u and v are a pair of real-valued '
      Y(17) = ' maximal domain functions defined on'
      X(18) = '  (a,c] satisfying [u,v](a) .ne. 0. '
      Y(18) = ' The maximal domain D(a,c] is de-   '
      X(19) = '  defined by                        '
      Y(19) = ' '
      X(20) = ' '
      Y(20) = ' '
      X(21) = '       D(a,c] = {f:(a,c]->R:: f,pf'' '
      Y(21) = 'in AC(a,c];                         '
      X(22) = '                   f, ((-pf'')''+qf)/w'
      Y(22) = ' in L2((a,c;w)}  .                  '
      X(23) = ' '
      Y(23) = ' '
      DO 601 I = 1,23
          WRITE (*,FMT=*) X(I),Y(I)
  601 CONTINUE
      READ (*,FMT=999) ANS,N
      WRITE (*,FMT=*)
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = '  It is known that for all f,g in D('
      Y(1) = 'a,c] the limit                      '
      X(2) = ' '
      Y(2) = ' '
      X(3) = '       [f,g](a) = lim[f,g](x) as x->'
      Y(3) = 'a                                   '
      X(4) = ' '
      Y(4) = ' '
      X(5) = 'exists and is finite.  If (*) is LCN'
      Y(5) = 'O or LCO at a, then all solutions of'
      X(6) = 'of (*) belong to D(a,c] for all valu'
      Y(6) = 'es of lambda.                       '
      X(7) = '  The boundary condition (**) is ess'
      Y(7) = 'ential in the LCNO and LCO cases but'
      X(8) = 'can also be used with advantage in s'
      Y(8) = 'ome R and WR cases.  In the R, WR, '
      X(9) = 'and LCNO cases, but not in the LCO c'
      Y(9) = 'ase, the boundary condition         '
      X(10) = 'functions can always be chosen so th'
      Y(10) = 'at                                  '
      X(11) = '        lim u(x)/v(x) = 0 as x->a,  '
      Y(11) = ' '
      X(12) = 'and it is recommended that this norm'
      Y(12) = 'alisation be effected, but this is  '
      X(13) = 'not essential; this normalisation ha'
      Y(13) = 's been entered in the examples given'
      X(14) = 'below.  In this case, the boundary c'
      Y(14) = 'ondition [y,u](a) = 0 (i.e., A1 = 1,'
      X(15) = 'A2 = 0 in (**) is called the princip'
      Y(15) = 'al or Friedrichs boundary condition '
      X(16) = 'at a.                              '
      Y(16) = ' '
      X(17) = '  In the case when end-points a and '
      Y(17) = 'b are, independently, in R, WR,     '
      X(18) = 'LCNO, or LCO classification, it may '
      Y(18) = 'be that symmetry or other reasons   '
      X(19) = 'permit one set of boundary condition'
      Y(19) = ' functions to be used at both end-  '
      X(20) = 'points (see xamples.f, #1 (Legendre)'
      Y(20) = ').  In other cases, different pairs '
      X(21) = 'must be chosen for each end-point (s'
      Y(21) = 'ee xamples.f: #16 (Jacobi),         '
      X(22) = '#18 (Dunsch), and #19 (Donsch)).    '
      Y(22) = ' '
      DO 602 I = 1,22
          WRITE (*,FMT=*) X(I),Y(I)
  602 CONTINUE
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = ' '
      Y(1) = ' '
      X(2) = '  Note that a solution pair u,v is a'
      Y(2) = 'lways a maximal domain pair, but not'
      X(3) = 'necessarily vice versa.             '
      Y(3) = ' '
      X(4) = ' '
      Y(4) = ' '
      X(5) = 'EXAMPLES:                           '
      Y(5) = ' '
      X(6) = '1. -y''''(x) = lambda*y(x) on [0,pi] i'
      Y(6) = 's R at 0 and R at pi.               '
      X(7) = '   At 0, with lambda = 0, a solution'
      Y(7) = ' pair is u(x) = x, v(x) = 1.        '
      X(8) = '   At pi, with lambda = 1, a solutio'
      Y(8) = 'n pair is                           '
      X(9) = '     u(x) = sin(x), v(x) = cos(x).  '
      Y(9) = ' '
      X(10) = '2. -(sqrt(x)*y''(x))'' = lambda*y(x)/s'
      Y(10) = 'qrt(x) on (0,1] is                  '
      X(11) = '     WR at 0 and R at 1.            '
      Y(11) = ' '
      X(12) = '   (The general solutions of this eq'
      Y(12) = 'uation are                          '
      X(13) = '     u(x) = cos(2*sqrt(x*lambda)), v'
      Y(13) = '(x) = sin(2*sqrt(x*lambda)).)       '
      X(14) = '   At 0, with lambda = 0, a solution'
      Y(14) = ' pair is                            '
      X(15) = '     u(x) = 2*sqrt(x), v(x) = 1.    '
      Y(15) = ' '
      X(16) = '   At 1, with lambda = pi*pi/4, a so'
      Y(16) = 'lution pair is                      '
      X(17) = '     u(x) = sin(pi*sqrt(x)), v(x) = '
      Y(17) = 'cos(pi*sqrt(x)).                    '
      X(18) = '   At 1, with lambda = 0, a solution'
      Y(18) = ' pair is                            '
      X(19) = '     u(x) = 2*(1-sqrt(x)), v(x) = 1.'
      Y(19) = ' '
      X(20) = '   See also xamples.f, #10 (Weakly R'
      Y(20) = 'egular).                            '
      X(21) = '3. -((1-x*x)*y''(x))'' = lambda*y(x) o'
      Y(21) = 'n (-1,1) is LCNO at both ends.      '
      X(22) = '   At +-1, with lambda = 0, a soluti'
      Y(22) = 'on pair is                          '
      X(23) = '     u(x) = 1, v(x) = 0.5*log((1+x)/'
      Y(23) = '(1-x)).                             '
      DO 603 I = 1,23
          WRITE (*,FMT=*) X(I),Y(I)
  603 CONTINUE
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = '   At 1, a maximal domain pair is u('
      Y(1) = 'x) = 1, v(x) = log(1-x)             '
      X(2) = '   At -1, a maximal domain pair is u'
      Y(2) = '(x) = 1, v(x) = log(1+x).           '
      X(3) = '   See also xamples.f, #1 (Legendre)'
      Y(3) = '.                                   '
      X(4) = '4. -y''''(x) - (1/(4x*x))*y(x) = lambd'
      Y(4) = 'a*y(x) on (0,infinity) is           '
      X(5) = '     LCNO at 0 and LP at +infinity. '
      Y(5) = ' '
      X(6) = '   At 0, a maximal domain pair is   '
      Y(6) = ' '
      X(7) = '     u(x) = sqrt(x), v(x) = sqrt(x)*'
      Y(7) = 'log(x).                             '
      X(8) = '   See also xamples.f, #2 (Bessel). '
      Y(8) = ' '
      X(9) = '5. -y''''(x) - 5*(1/(4*x*x))*y(x) = la'
      Y(9) = 'mbda*y(x) on (0,infinity) is        '
      X(10) = '     LCO at 0 and LP at +infinity.  '
      Y(10) = ' '
      X(11) = '   At 0, with lambda = 0, a solution'
      Y(11) = ' pair is                            '
      X(12) = '     u(x) = sqrt(x)*cos(log(x)), v(x'
      Y(12) = ') = sqrt(x)*sin(log(x))             '
      X(13) = '   See also xamples.f, #20 (Krall). '
      Y(13) = ' '
      X(14) = '6. -y''''(x) - (1/x)*y(x) = lambda*y(x'
      Y(14) = ') on (0,infinity) is               '
      X(15) = '     LCNO at 0 and LP at +infinity.'
      Y(15) = ' '
      X(16) = '   At 0, a maximal domain pair is   '
      Y(16) = ' '
      X(17) = '     u(x) = x, v(x) = 1 -x*log(x).  '
      Y(17) = ' '
      X(18) = '   See also xamples.f, #4(Boyd).    '
      Y(18) = ' '
      X(19) = '7. -((1/x)*y''(x))'' + (k/(x*x) + k*k/'
      Y(19) = 'x)*y(x) = lambda*y(x) on (0,1],     '
      X(20) = '     with k real and .ne. 0, is LCNO'
      Y(20) = ' at 0 and R at 1.                   '
      X(21) = '   At 0, a maximal domain pair is   '
      Y(21) = ' '
      X(22) = '     u(x) = x*x, v(x) = x - 1/k.    '
      Y(22) = ' '
      X(23) = '   See also xamples.f, #8 (Laplace T'
      Y(23) = 'idal Wave).                         '
      DO 604 I = 1,23
          WRITE (*,FMT=*) X(I),Y(I)
  604 CONTINUE
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
    7 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) 'H7:  General self-adjoint boundary conditions.'
      X(1) = '  Boundary conditions for Sturm-Liou'
      Y(1) = 'ville boundary value problems       '
      X(2) = ' '
      Y(2) = ' '
      X(3) = '                   -(p*y'')'' + q*y = '
      Y(3) = 'lambda*w*y              (*)         '
      X(4) = ' '
      Y(4) = ' '
      X(5) = 'on an interval (a,b) are either     '
      Y(5) = ' '
      X(6) = '  SEPARATED, with at most one condit'
      Y(6) = 'ion at end-point a and at most one  '
      X(7) = '    condition at end-point b, or    '
      Y(7) = ' '
      X(8) = '  COUPLED, when both a and b are, in'
      Y(8) = 'dependently, in one of the end-point'
      X(9) = '    classifications R, WR, LCNO, LCO'
      Y(9) = ', in which case two independent     '
      X(10) = '    boundary conditions are required'
      Y(10) = ' which link the solution values near'
      X(11) = '    a to those near b.              '
      Y(11) = ' '
      X(12) = '  The sleign2 program allows for all'
      Y(12) = ' self-adjoint boundary conditions:  '
      X(13) = 'separated self-adjoint conditions an'
      Y(13) = 'd all cases of coupled self-adjoint '
      X(14) = 'conditions.                         '
      Y(14) = ' '
      DO 701 I = 1,14
          WRITE (*,FMT=*) X(I),Y(I)
  701 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      WRITE (*,FMT=*) '    Separated Conditions:      '
      WRITE (*,FMT=*) '    ---------------------      '
      X(1) = '  The boundary conditions to be sele'
      Y(1) = 'cted depend upon the classification '
      X(2) = 'of the differential equation at the '
      Y(2) = 'end-point, say, a:                  '
      X(3) = '  1. If the end-point a is LP, then '
      Y(3) = 'no boundary condition is required or'
      X(4) = '     allowed.                       '
      Y(4) = ' '
      X(5) = '  2. If the end-point a is R or WR, '
      Y(5) = 'then a separated boundary condition '
      X(6) = '     is of the form                 '
      Y(6) = ' '
      X(7) = '         A1*y(a) + A2*(py'')(a) = 0,'
      Y(7) = ' '
      X(8) = '     where A1, A2 are real constants'
      Y(8) = ' the user must choose, not both zero.  '
      X(9) = '  3. If the end-point a is LCNO or'
      Y(9) = ' LCO, then a separated boundary     '
      X(10) = '  condition is of the form          '
      Y(10) = ' '
      X(11) = '         A1*[y,u](a) + A2*[y,v](a) ='
      Y(11) = ' 0,                                 '
      X(12) = '  where A1, A2 are real constants th'
      Y(12) = 'e user must choose, not both zero;  '
      X(13) = '  here, u,v are the pair of boundary'
      Y(13) = ' condition functions you have       '
      X(14) = '  previously selected when the input'
      Y(14) = ' FORTRAN file was being prepared    '
      X(15) = '  with makepqw.f.                   '
      Y(15) = ' '
      X(16) = '  4. If the end-point a is LCNO an'
      Y(16) = 'd the boundary condition pair       '
      X(17) = '  u,v has been chosen so that       '
      Y(17) = ' '
      X(18) = '         lim u(x)/v(x) = 0  as x->a '
      Y(18) = ' '
      X(19) = '  (which is always possible), then A'
      Y(19) = '1 = 1, A2 = 0 (i.e., [y,u](a) = 0)  '
      X(20) = '  gives the principal (Friedrichs) b'
      Y(20) = 'oundary condition at a.             '
      DO 702 I = 1,20
          WRITE (*,FMT=*) X(I),Y(I)
  702 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = '  5. If a is R or WR and boundary '
      Y(1) = 'condition functions u,v have been   '
      X(2) = '  entered in the FORTRAN input file,'
      Y(2) = ' then (3.,4.) above apply to        '
      X(3) = '  entering separated boundary condit'
      Y(3) = 'ions at such an end-point; the      '
      X(4) = '  boundary conditions in this form a'
      Y(4) = 're equivalent to the point-wise     '
      X(5) = '  conditions in (2.) (subject to car'
      Y(5) = 'e in choosing A1, A2).  This        '
      X(6) = '  singular form of a regular boundar'
      Y(6) = 'y condition may be particularly     '
      X(7) = '  effective in the WR case if the bo'
      Y(7) = 'undary condition form in (2.) leads '
      X(8) = '  to numerical difficulties.        '
      Y(8) = ' '
      X(9) = '  Conditions (2.,3.,4.,5.) apply sim'
      Y(9) = 'ilarly at end-point b (with U,V as  '
      X(10) = 'the boundary condition functions at '
      Y(10) = 'b.                                  '
      X(11) = '    6. If a is R, WR, LCNO, or LCO a'
      Y(11) = 'nd b is LP, then only a separated   '
      X(12) = '  condition at a is required and all'
      Y(12) = 'owed (or instead at b if a and b    '
      X(13) = '  are interchanged).                '
      Y(13) = ' '
      X(14) = '    7. If both end-points a and b ar'
      Y(14) = 'e LP, then no boundary conditions   '
      X(15) = '  are required or allowed.          '
      Y(15) = ' '
      X(16) = '  The indexing of eigenvalues for bo'
      Y(16) = 'undary value problems with separated'
      X(17) = '  conditions is discussed in H13.   '
      Y(17) = ' '
      X(18) = '    Coupled Conditions:             '
      Y(18) = ' '
      X(19) = '    -------------------             '
      Y(19) = ' '
      X(20) = '    8. Coupled regular self-adjoint '
      Y(20) = 'boundary conditions on (a,b) apply  '
      X(21) = 'only when both end-points a and b ar'
      Y(21) = 'e R or WR.                          '
      X(22) = ' '
      Y(22) = ' '
      DO 704 I = 1,22
          WRITE (*,FMT=*) X(I),Y(I)
  704 CONTINUE
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
    8 CONTINUE
      WRITE (*,FMT=*) 'H8:  Recording the results.'
      X(1) = '  If you choose to have a record kep'
      Y(1) = 't of the results, then the following'
      X(2) = 'information is stored in a file with'
      Y(2) = ' the name you select:               '
      X(3) = ' '
      Y(3) = ' '
      X(4) = '  1. The file name.                 '
      Y(4) = ' '
      X(5) = '  2. The header line prompted for (u'
      Y(5) = 'p to 32 characters of your choice). '
      X(6) = '  3. The interval (a,b) which was us'
      Y(6) = 'ed.                                 '
      X(7) = ' '
      Y(7) = ' '
      X(8) = '  For SEPARATED boundary conditions:'
      Y(8) = ' '
      X(9) = '  4. The end-point classification.  '
      Y(9) = ' '
      X(10) = '  5. A summary of coefficient inform'
      Y(10) = 'ation at WR, LCNO, LCO end-points.  '
      X(11) = '  6. The boundary condition constant'
      Y(11) = 's (A1,A2), (B1,B2) if entered.      '
      X(12) = '  7. (NUMEIG,EIG,TOL) or (NUMEIG1,NU'
      Y(12) = 'MEIG2,TOL), as entered.             '
      X(13) = ' '
      Y(13) = ' '
      X(14) = '  For COUPLED boundary conditions:  '
      Y(14) = ' '
      X(15) = '  8. The boundary condition paramete'
      Y(15) = 'r alpha and the coupling matrix K;  '
      X(16) = '     see H6.                        '
      Y(16) = ' '
      X(17) = '  For ALL self-adjoint boundary cond'
      Y(17) = 'itions: '
      X(18) = '  9. The computed eigenvalue, EIG, a'
      Y(18) = 'nd its estimated accuracy, TOL.     '
      X(19) = ' 10. IFLAG reported (see H15).      '
      Y(19) = ' '
      DO 801 I = 1,19
          WRITE (*,FMT=*) X(I),Y(I)
  801 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
    9 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) 'H9:  Type and choice of interval.'
      X(1) = '  You may enter any interval (a,b) f'
      Y(1) = 'or which the coefficients p,q,w are '
      X(2) = 'well-defined by your FORTRAN stateme'
      Y(2) = 'nts in the input file, provided that'
      X(3) = '(a,b) contains no interior singulari'
      Y(3) = 'ties.                               '
      DO 901 I = 1,3
          WRITE (*,FMT=*) X(I),Y(I)
  901 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
   10 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) 'H10:  Entry of end-points.'
      X(1) = '  End-points a and b should generall'
      Y(1) = 'y be entered as real numbers to an  '
      X(2) = 'appropriate number of decimal places'
      Y(2) = '. '
      DO 1001 I = 1,2
          WRITE (*,FMT=*) X(I),Y(I)
 1001 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
   11 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) 'H11:  End-point values of p,q,w.'
      X(1) = '  The program sleign2 needs to know '
      Y(1) = 'whether the coefficient functions   '
      X(2) = 'p(x),q(x),w(x) defined by the FORTRA'
      Y(2) = 'N expressions entered in the input  '
      X(3) = 'file can be evaluated numerically wi'
      Y(3) = 'thout running into difficulty.  If, '
      X(4) = 'for example, either q or w is unboun'
      Y(4) = 'ded at a, or p(a) is 0, then sleign2'
      X(5) = 'needs to know this so that a is not '
      Y(5) = 'chosen for functional evaluation.   '
      DO 1101 I = 1,5
          WRITE (*,FMT=*) X(I),Y(I)
 1101 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
   12 CONTINUE
      WRITE (*,FMT=*) 'H12:  Initial value problems.'
      X(1) = '  The initial value problem facility'
      Y(1) = ' for Sturm-Liouville problems       '
      X(2) = ' '
      Y(2) = ' '
      X(3) = '                   -(p*y'')'' + q*y = '
      Y(3) = ' lambda*w*y              (*)        '
      X(4) = ' '
      Y(4) = ' '
      X(5) = 'allows for the computation of a solu'
      Y(5) = 'tion of (*) with a user-chosen      '
      X(6) = 'value lambda and any one of the foll'
      Y(6) = 'owing initial conditions:           '
      X(7) = '  1. From end-point a of any classif'
      Y(7) = 'ication except LP towards           '
      X(8) = 'end-point b of any classification,  '
      Y(8) = ' '
      X(9) = '  2. From end-point b of any classif'
      Y(9) = 'ication except LP back towards      '
      X(10) = 'end-point a of any classification,  '
      Y(10) = ' '
      X(11) = '  3. From end-points a and b of any '
      Y(11) = 'classifications except LP towards an'
      X(12) = 'interior point of (a,b) selected by '
      Y(12) = 'the program.                        '
      X(13) = ' '
      Y(13) = ' '
      X(14) = '  Initial values at a are of the for'
      Y(14) = 'm y(a) = alpha1, (p*y'')(a) =alpha2,'
      X(15) = 'when a is R or WR; and [y,u](a) = al'
      Y(15) = 'pha1, [y,v](a) = alpha2, when a is  '
      X(16) = 'LCNO or LCO.                        '
      Y(16) = ' '
      X(17) = '  Initial values at b are of the for'
      Y(17) = 'm y(b) = beta1, (p*y'')(b) = beta2, '
      X(18) = 'when b is R or WR; and [y,u](b) = be'
      Y(18) = 'ta1, [y,v](b) = beta2, when b is    '
      X(19) = 'LCNO or LCO.                        '
      Y(19) = ' '
      X(20) = '  In (*), lambda is a user-chosen re'
      Y(20) = 'al number; while in the above ini-  '
      X(21) = 'tial values, (alpha1,alpha2) and (be'
      Y(21) = 'ta1,beta2) are user-chosen pairs of '
      X(22) = 'real numbers not both zero.         '
      Y(22) = ' '
      DO 1201 I = 1,22
          WRITE (*,FMT=*) X(I),Y(I)
 1201 CONTINUE
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      X(1) = '  In the initial value case (3.) abo'
      Y(1) = 've when the interval (a,b) is       '
      X(2) = 'finite, the interior point selected '
      Y(2) = 'by the program is generally near the'
      X(3) = 'midpoint of (a,b); when (a,b) is inf'
      Y(3) = 'inite, no general rule can be given.'
      X(4) = 'Also if, given (alpha1,alpha2) and ('
      Y(4) = 'beta1,beta2), the lambda chosen is  '
      X(5) = 'an eigenvalue of the associated boun'
      Y(5) = 'dary value problem, the computed    '
      X(6) = 'solution may not be the correspondin'
      Y(6) = 'g eigenfunction -- the signs of the '
      X(7) = 'computed solutions on either side of'
      Y(7) = ' the interior point may be opposite.'
      X(8) = '  The output for a solution of an in'
      Y(8) = 'itial value problem is in the form  '
      X(9) = 'of stored numerical data which can b'
      Y(9) = 'e plotted on the screen (see H16),  '
      X(10) = 'or printed out in graphical form if '
      Y(10) = 'graphics software is available.     '
      DO 1202 I = 1,10
          WRITE (*,FMT=*) X(I),Y(I)
 1202 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
   13 CONTINUE
      WRITE (*,FMT=*) 'H13:  Indexing of eigenvalues.'
      X(1) = '  The indexing of eigenvalues is an '
      Y(1) = 'automatic facility in sleign2.  The '
      X(2) = 'following general results hold for t'
      Y(2) = 'he separated boundary condition     '
      X(3) = 'problem (see H7):                   '
      Y(3) = ' '
      X(4) = '  1. If neither end-point a or b is '
      Y(4) = 'LP or LCO, then the spectrum of the '
      X(5) = 'eigenvalue problem is discrete (eige'
      Y(5) = 'nvalues only), simple (eigenvalues  '
      X(6) = 'all of multiplicity 1), and bounded '
      Y(6) = 'below with a single cluster point at'
      X(7) = '+infinity.  The eigenvalues are inde'
      Y(7) = 'xed as {lambda(n): n=0,1,2,...},    '
      X(8) = 'where lambda(n) < lambda(n+1) (n=0,1'
      Y(8) = ',2,...), lim lambda(n) -> +infinity;'
      X(9) = 'and if {psi(n): n=0,1,2,...} are the'
      Y(9) = ' corresponding eigenfunctions, then '
      X(10) = 'psi(n) has exactly n zeros in the op'
      Y(10) = 'en interval (a,b).                  '
      X(11) = '  2. If neither end-point a or b is '
      Y(11) = 'LP but at least one end-point is    '
      X(12) = 'LCO, then the spectrum is discrete a'
      Y(12) = 'nd simple as for (1.), but with     '
      X(13) = 'cluster points at both +infinity and'
      Y(13) = ' -infinity.  The eigenvalues are in-'
      X(14) = 'dexed as {lambda(n): n=0,1,-1,2,-2,.'
      Y(14) = '..}, where                          '
      X(15) = 'lambda(n) < lambda(n+1) (n=...-2,-1,'
      Y(15) = '0,1,2,...) with lambda(0) the small-'
      X(16) = 'est non-negative eigenvalue and lim '
      Y(16) = 'lambda(n) -> +infinity or -> -infi- '
      X(17) = 'nity with n; and if {psi(n): n=0,1,-'
      Y(17) = '1,2,-2,...} are the corresponding   '
      X(18) = 'eigenfunctions, then every psi(n) ha'
      Y(18) = 's infinitely many zeros in (a,b).   '
      DO 1301 I = 1,18
          WRITE (*,FMT=*) X(I),Y(I)
 1301 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = '  3. If one or both end-points is LP'
      Y(1) = ', then there can be one or more in- '
      X(2) = 'tervals of continuous spectrum for t'
      Y(2) = 'he boundary value problem in addi-  '
      X(3) = 'tion to some (necessarily simple) ei'
      Y(3) = 'genvalues.  For these essentially   '
      X(4) = 'more difficult problems, sleign2 can'
      Y(4) = ' be used as an investigative tool to'
      X(5) = 'give qualitative and possibly quanti'
      Y(5) = 'tative information on the spectrum. '
      X(6) = '     For example, if a problem has a'
      Y(6) = ' continuous spectrum starting at L, '
      X(7) = 'then there may be no eigenvalue belo'
      Y(7) = 'w L, any finite number of eigenval- '
      X(8) = 'ues below L, or an infinite (but cou'
      Y(8) = 'ntable) number of eigenvalues below '
      X(9) = 'L. sleign2 can be used to compute L '
      Y(9) = '(see the paper bewz on the sleign2  '
      X(10) = 'home page for an algorithm to comput'
      Y(10) = 'e L), and determine the number of   '
      X(11) = 'these eigenvalues and compute them. '
      Y(11) = ' In this respect, see xamples.f: #13'
      X(12) = '(Hydrogen Atom), #17 (Morse Oscillat'
      Y(12) = 'or), #21 (Fourier), #27 (Joergens)  '
      X(13) = 'as examples of success; and #12 (Mat'
      Y(13) = 'hieu), #14 (Marletta), and #28      '
      X(14) = '(Behnke-Goerisch) as examples of fai'
      Y(14) = 'lure.                               '
      X(15) = '     The problem need not have a con'
      Y(15) = 'tinuous spectrum, in which case if  '
      X(16) = 'its discrete spectrum is bounded bel'
      Y(16) = 'ow, then the eigenvalues are indexed'
      X(17) = 'and the eigenfunctions have zero cou'
      Y(17) = 'nts as in (1.).  If, on the other   '
      X(18) = 'hand, the discrete spectrum is unbou'
      Y(18) = 'nded below, then all the eigenfunc- '
      X(19) = 'tions have infinitely many zeros in '
      Y(19) = 'the open interval (a,b).  sleign2   '
      X(20) = 'can, in principle, compute these eig'
      Y(20) = 'envalues if neither end-point is LP,'
      X(21) = 'although this is a computationally d'
      Y(21) = 'ifficult problem.  Note, however,   '
      X(22) = 'that sleign2 has no algorithm when t'
      Y(22) = 'he spectrum is discrete, unbounded  '
      X(23) = 'above and below, and one end-point i'
      Y(23) = 's LP, as in xamples.f #30.          '
      DO 1302 I = 1,23
          WRITE (*,FMT=*) X(I),Y(I)
 1302 CONTINUE
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = '  In respect to the three different '
      Y(1) = 'types of indexing discussed above,  '
      X(2) = 'the following identified examples fr'
      Y(2) = 'om xamples.f illustrate the spectral'
      X(3) = 'property of these boundary problems:'
      Y(3) = '                                    '
      X(4) = '  1. Neither end-point is LP or LCO.'
      Y(4) = ' '
      X(5) = '       #1 (Legendre)                '
      Y(5) = ' '
      X(6) = '       #2 (Bessel) with -1/4 < c < 3'
      Y(6) = '/4                                  '
      X(7) = '       #4 (Boyd)                    '
      Y(7) = ' '
      X(8) = '       #5 (Latzko)                  '
      Y(8) = ' '
      X(9) = '  2. Neither end-point is LP, but at'
      Y(9) = ' least one is LCO.                  '
      X(10) = '       #6 (Sears-Titchmarsh)        '
      Y(10) = ' '
      X(11) = '       #7 (BEZ)                     '
      Y(11) = ' '
      X(12) = '      #19 (Donsch)                  '
      Y(12) = ' '
      X(13) = '  3. At least one end-point is LP.  '
      Y(13) = ' '
      X(14) = '      #13 (Hydrogen Atom)           '
      Y(14) = ' '
      X(15) = '      #14 (Marletta)                '
      Y(15) = ' '
      X(16) = '      #20 (Krall)                   '
      Y(16) = ' '
      X(17) = '      #21 (Fourier) on [0,infinity) '
      Y(17) = ' '
      DO 1303 I = 1,17
          WRITE (*,FMT=*) X(I),Y(I)
 1303 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
   14 CONTINUE
      WRITE (*,FMT=*) 'H14:  Entry of eigenvalue index, initial guess,'
     +  //' and tolerance.'
      X(1) = '  For all self-adjoint boundary cond'
      Y(1) = 'ition problems (see H7), sleign2    '
      X(2) = 'calls for input information options '
      Y(2) = 'to compute either                   '
      X(3) = '  1. a single eigenvalue, or        '
      Y(3) = ' '
      X(4) = '  2. a series of eigenvalues.       '
      Y(4) = ' '
      X(5) = 'In each case indexing of eigenvalues'
      Y(5) = ' is called for (see H13).           '
      X(6) = '  (1.) above asks for data triples N'
      Y(6) = 'UMEIG, EIG, TOL separated by commas.'
      X(7) = 'Here NUMEIG is the integer index of '
      Y(7) = 'the desired eigenvalue; NUMEIG can  '
      X(8) = 'be negative only when the problem is'
      Y(8) = ' LCO at one or both end-points.     '
      X(9) = 'EIG allows for the entry of an initi'
      Y(9) = 'al guess for the requested          '
      X(10) = 'eigenvalue (if an especially good on'
      Y(10) = 'e is available), or can be set to 0 '
      X(11) = 'in which case an initial guess is ge'
      Y(11) = 'nerated by sleign2 itself.          '
      X(12) = 'TOL is the desired accuracy of the c'
      Y(12) = 'omputed eigenvalue.  It is an       '
      X(13) = 'absolute accuracy if the magnitude o'
      Y(13) = 'f the eigenvalue is 1 or less, and  '
      X(14) = 'is a relative accuracy otherwise.  T'
      Y(14) = 'ypical values might be .001 for     '
      X(15) = 'moderate accuracy and .0000001 for h'
      Y(15) = 'igh accuracy in single precision.   '
      X(16) = 'If TOL is set to 0, the maximum achi'
      Y(16) = 'evable accuracy is requested.       '
      X(17) = '  If the input data list is truncate'
      Y(17) = 'd with a "/" after NUMEIG or EIG,   '
      X(18) = 'then the remaining elements default '
      Y(18) = 'to 0.                               '
      DO 1401 I = 1,18
          WRITE (*,FMT=*) X(I),Y(I)
 1401 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      X(1) = '  (2.) above asks for data triples N'
      Y(1) = 'UMEIG1, neig2, TOL separated by   '
      X(2) = 'commas.  Here numeig1 and numeig2 ar'
      Y(2) = 'e the first and last integer indices'
      X(3) = 'of the sequence of desired eigenvalu'
      Y(3) = 'es, numeig1 < numeig2; they can be  '
      X(4) = 'negative only when the problem is LC'
      Y(4) = 'O at one or both end-points.        '
      X(5) = 'TOL is the desired accuracy of the c'
      Y(5) = 'omputed eigenvalues.  It is an      '
      X(6) = 'absolute accuracy if the magnitude o'
      Y(6) = 'f an eigenvalue is 1 or less, and   '
      X(7) = 'is a relative accuracy otherwise.  T'
      Y(7) = 'ypical values might be .001 for     '
      X(8) = 'moderate accuracy and .0000001 for h'
      Y(8) = 'igh accuracy in single precision.   '
      X(9) = 'If TOL is set to 0, the maximum achi'
      Y(9) = 'evable accuracy is requested.       '
      X(10) = '  If the input data list is truncate'
      Y(10) = 'd with a "/" after neig2, then TOL'
      X(11) = 'defaults to 0.                      '
      Y(11) = ' '
      X(12) = '  For COUPLED self-adjoint boundary '
      Y(12) = 'condition problems (see H7 and H17),'
      X(13) = 'sleign2 also reports which eigenvalu'
      Y(13) = 'es are double.  Double eigenvalues  '
      X(14) = 'can occur only for coupled boundary '
      Y(14) = 'conditions with alpha = 0 or pi.    '
      DO 1402 I = 1,14
          WRITE (*,FMT=*) X(I),Y(I)
 1402 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
   15 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) 'H15:  IFLAG information.'
      X(1) = '  All results are reported by sleign2'
      Y(1) = '2 with a flag identification.  There'
      X(2) = 'are four values of IFLAG:           '
      Y(2) = ' '
      X(3) = ' '
      Y(3) = ' '
      X(4) = '  1 - The computed eigenvalue has an'
      Y(4) = ' estimated accuracy within the      '
      X(5) = '      tolerance requested.          '
      Y(5) = ' '
      X(6) = ' '
      Y(6) = ' '
      X(7) = '  2 - The computed eigenvalue does n'
      Y(7) = 'ot have an estimated accuracy within'
      X(8) = '      the tolerance requested, but i'
      Y(8) = 's the best the program could obtain.'
      X(9) = ' '
      Y(9) = ' '
      X(10) = '  3 - There seems to be no eigenvalu'
      Y(10) = 'e of index equal to NUMEIG.         '
      X(11) = ' '
      Y(11) = ' '
      X(12) = '  4 - The program has been unable to'
      Y(12) = ' compute the requested eigenvalue.  '
      DO 1501 I = 1,12
          WRITE (*,FMT=*) X(I),Y(I)
 1501 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
   16 CONTINUE
      WRITE (*,FMT=*) 'H16:  Plotting.'
      X(1) = '  After computing a single eigenvalu'
      Y(1) = 'e (see H14(1.)), but not a sequence '
      X(2) = 'of eigenvalues (see H14(2.)), the ei'
      Y(2) = 'genfunction can be plotted for sepa-'
      X(3) = 'rated conditions and for coupled one'
      Y(3) = 's with alpha = 0 or pi.  When alpha '
      X(4) = 'is not zero or pi the eigenfunctions'
      Y(4) = ' are not real-valued and so no plot '
      X(5) = 'is provided.  If this is desired, re'
      Y(5) = 'spond "y" when asked so that sleign2'
      X(6) = 'will compute some eigenfunction data'
      Y(6) = ' and store them.                    '
      X(7) = '  One can ask that the eigenfunction'
      Y(7) = ' data be in the form of either      '
      X(8) = 'points (x,y) for x in (a,b), or poin'
      Y(8) = 'ts (t,y) for t in the standardized  '
      X(9) = 'interval (-1,1) mapped onto from (a,'
      Y(9) = 'b); the t- choice can be especially '
      X(10) = 'helpful when the original interval i'
      Y(10) = 's infinite.  Additionally, one can  '
      X(11) = 'ask for a plot of the so-called Prue'
      Y(11) = 'fer angle, in x- or t- variables.   '
      X(12) = '  In both forms, once the choice has'
      Y(12) = ' been made of the function to be    '
      X(13) = 'plotted, a crude plot is displayed o'
      Y(13) = 'n the monitor screen and you are    '
      X(14) = 'asked whether you wish to save the c'
      Y(14) = 'omputed plot points in a file.      '
      DO 1601 I = 1,14
          WRITE (*,FMT=*) X(I),Y(I)
 1601 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' '
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
   17 CONTINUE
      WRITE (*,FMT=*) 'H17:  Indexing of eigenvalues for'//
     +  ' coupled self-adjoint problems.'
      X(1) = '  The indexing of eigenvalues is an '
      Y(1) = 'automatic facility in sleign2.  The '
      X(2) = 'following general result holds for c'
      Y(2) = 'oupled boundary condition problems  '
      X(3) = '(see H7):                           '
      Y(3) = ' '
      X(4) = '  The spectrum of the eigenvalue pro'
      Y(4) = 'blem is discrete (eigenvalues only).'
      X(5) = 'In general the spectrum is not simpl'
      Y(5) = 'e, but no eigenvalue exceeds multi- '
      X(6) = 'plicity 2.The eigenvalues are indexe'
      Y(6) = 'd as {lambda(n): n=0,1,2,...}, where'
      X(7) = 'lambda(n) .le. lambda(n+1) (n=0,1,2,'
      Y(7) = '...), lim lambda(n) -> +infinity if '
      X(8) = 'neither end-point is LCO.  If one or'
      Y(8) = ' both end-points are LCO the eigen- '
      X(9) = 'values cluster at both +infinity and'
      Y(9) = ' at -infinity, and all eigenfunc-   '
      X(10) = 'tions have infinitely many zeros.   '
      Y(10) = '                                    '
      X(11) = '  If neither end-point is LCO and al'
      Y(11) = 'pha = 0 or pi, then the n-th eigen- '
      X(12) = 'function has n-1, n, or n+1 zeros in'
      Y(12) = ' the half-open interval [a,b) (also '
      X(13) = 'in (a,b]).  All three possibilities '
      Y(13) = 'occur.  Recall that in the case of  '
      X(14) = 'double eigenvalues, although the n-t'
      Y(14) = 'h eigenvalue is well-defined, there '
      X(15) = 'is an ambiguity about which solution'
      Y(15) = ' is declared the n-th eigenfunction.'
      X(16) = '  If alpha is not 0 or pi, then the '
      Y(16) = 'eigenfunction is non-real and has no'
      X(17) = 'zero in (a,b); but each of the real '
      Y(17) = 'and imaginary parts of the n-th ei- '
      X(18) = 'genfunction have the same zero prope'
      Y(18) = 'rties as mentioned above when alpha '
      X(19) = '= 0 or pi.                          '
      Y(19) = ' '
      DO 1651 I = 1,19
          WRITE (*,FMT=*) X(I),Y(I)
 1651 CONTINUE
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      X(1) = '  The following identified examples '
      Y(1) = 'from xamples.f are of special inter-'
      X(2) = 'est:                                '
      Y(2) = ' '
      X(3) = '    #11 (Plum) on [0,pi]           '
      Y(3) = ' '
      X(4) = '    #21 (Fourier) on [0,pi]        '
      Y(4) = ' '
      X(5) = '    #25 (Meissner) on [-0.5,0.5]   '
      Y(5) = ' '
      DO 1701 I = 1,5
          WRITE (*,FMT=*) X(I),Y(I)
 1701 CONTINUE
      WRITE (*,FMT=*) ' '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
      READ (*,FMT=999) ANS,N
      IF (ANS.EQ.'r' .OR. ANS.EQ.'R') RETURN
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17) N
      GO TO 1
  999 FORMAT (A1,I2)
      END
C
      SUBROUTINE PQ(END,P0,QF)
C  THIS PROGRAM IS INTENDED TO DETERMINE NUMERICALLY WHETHER OR
C    NOT THE FUNCTION P(X) IS ZERO AT A NON-REGULAR ENDPOINT,
C    AND WHETHER OR NOT THE FUNCTION Q(X)/W(X) IS INFINITE THERE.
C    IF P IS ZERO, P0 IS SET TO +1.0; ELSE TO -1.0.
C    IF Q AND/OR W IS FINITE, QF IS SET TO +1.0; ELSE TO -1.0.
C     .. Scalar Arguments ..
      REAL END,P0,QF
C     ..
C     .. Local Scalars ..
      REAL DT,HALF,ONE,PV,QV,QVP,QVSAV,T,TMP,TSAV,X,ZER
      INTEGER I
C     ..
C     .. External Functions ..
      REAL P,Q,W
      EXTERNAL P,Q,W
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS
C     ..
      ONE = 1.0D0
      HALF = 0.5D0
      ZER = 0.0D0
c
      P0 = -1.0D0
      QF = 1.0D0
      DT = 0.1D0
      PV = 1.0D0
      IF (END.LT.0.0D0) DT = -DT
      DO 10 I = 1,25
          DT = HALF*DT
          T = END - DT
          IF (T.EQ.-1.0D0) THEN
              IF (PV.LT.0.0001D0) THEN
                  P0 = 1.0D0
                  GO TO 15
              ELSE
                  GO TO 15
              END IF
          END IF
          CALL DXDT(T,TMP,X)
          PV = ABS(P(X))
          IF (PV.GT. (1.D+5)) THEN
              GO TO 15
          ELSE IF (PV.LT. (.0001D0) .AND. I.GT.15) THEN
              P0 = 1.0D0
              GO TO 15
          END IF
   10 CONTINUE
   15 CONTINUE
c
      DT = 0.1D0
      IF (END.LT.0.0D0) DT = -DT
      QVP = ONE
      QVSAV = ZER
      TSAV = END
      QV = 1.0D0
      DO 20 I = 1,17
          DT = HALF*DT
          T = END - DT
          IF (T.EQ.1.0D0 .AND. (QV.GT. (1.D+5))) THEN
              QF = -1.0D0
              GO TO 25
          END IF
          CALL DXDT(T,TMP,X)
          QV = ABS(Q(X)) + ABS(W(X))
          QVP = ABS((QV-QVSAV)/ (T-TSAV))
          QVSAV = QV
          IF (QVP.GT. (1.D+5)) THEN
              QF = -1.0D0
              GO TO 25
          END IF
   20 CONTINUE
   25 CONTINUE
c
      RETURN
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'driver3.f'
then
	echo shar: will not over-write existing file "'driver3.f'"
else
cat << "SHAR_EOF" > 'driver3.f'
C  PROGRAM SEPDR

C     **********
C     MARCH 1, 2001; P.B. BAILEY, W.N. EVERITT AND A. ZETTL
C     VERSION 1.2
C     **********

      PROGRAM SEPDR

C     This program is for the purpose of indicating how SLEIGN2
C     can be called for the purpose of obtaining eigenvalues
C     of Sturm-Liouville problems with regular and singular
C     separated boundary conditions.
C
C     The call is of the form:
C
C     CALL SLEIGN(A, B, INTAB, P0ATA, QFATA, P0ATB, QFATB,
C    1    A1, A2, B1, B2, NUMEIG, EIG, TOL, IFLAG,
C    2    ISLFUN, SLFUN, NCA, NCB)
C
C     SET THE PARAMETERS DEFINING THE INTERVAL OF
C       DEFINITION OF THE DIFFERENTIAL EQUATION:
C       (BESSEL'S EQUATION WITH NU = 0.75)
C
C     .. Scalars in Common ..
      INTEGER T21
      LOGICAL PR
C     ..
C     .. Local Scalars ..
      REAL A,A1,A2,B,B1,B2,EIG,P0ATA,P0ATB,QFATA,QFATB,TOL
      INTEGER I,IFLAG,INTAB,ISLFUN,NCA,NCB,NP,NUMEIG
C     ..
C     .. Local Arrays ..
      REAL SLFUN(100),X(100)
C     ..
C     .. External Subroutines ..
      EXTERNAL SLEIGN
C     ..
C     .. Common blocks ..
      COMMON /PRIN/PR,T21
C     ..
      T21 = 21
      OPEN (T21,FILE='test.out')
      PR = .TRUE.
C
      A = 0.0D0
      B = 1.0D0

C ------------------------------------------------------------------
C     SET THE PARAMETERS DEFINING THE SEPARATED BOUNDARY CONDITIONS:
C ------------------------------------------------------------------

      A1 = 1.0D0
      A2 = 0.0D0
      B1 = 1.0D0
      B2 = 0.0D0

C     SET THE REMAINING PARAMETERS NEEDED BY SLEIGN2:

      P0ATA = -1.0D0
      QFATA = -1.0D0
      P0ATB = -1.0D0
      QFATB = 1.0D0
      INTAB = 1
      NUMEIG = 2
      EIG = 0.0D0
      TOL = 1.D-5
      ISLFUN = 0
      NCA = 3
      NCB = 1

C ---------------------------------------------------------
C  If eigenfunction values are wanted, then:

      NP = 22
      DO 10 I = 2,NP - 1
          X(I-1) = A + (I-1)* (B-A)/ (NP-1)
   10 CONTINUE
      ISLFUN = NP - 2

      DO 15 I = 1,ISLFUN
          SLFUN(9+I) = X(I)
   15 CONTINUE
C ---------------------------------------------------------

C     NOW CALL SLEIGN2:

      CALL SLEIGN(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,NUMEIG,
     +            EIG,TOL,IFLAG,ISLFUN,SLFUN,NCA,NCB)

C     WRITE OUT THE RETURNED EIGENVALUE, IT'S ESTIMATED ACCURACY,
C     AND THE IFLAG STATUS:

      WRITE (*,FMT=*) ' NUMEIG, EIG, TOL, IFLAG = ',NUMEIG,EIG,TOL,IFLAG

C ---------------------------------------------------------
      IF (ISLFUN.GT.0) THEN
C     IN THIS CASE, THE EIGENFUNCTION WAS COMPUTED :
C
          WRITE (*,FMT=*) ' EIGENFUNCTION = '
          DO 25 I = 1,ISLFUN
              WRITE (*,FMT=*) X(I),SLFUN(9+I)
   25     CONTINUE
      END IF

C ---------------------------------------------------------
C
      CLOSE (T21)
      STOP
      END
C
      REAL FUNCTION P(X)

C     .. Scalar Arguments ..
      REAL X
C     ..
      P = 1.0D0
      RETURN
      END
C
      REAL FUNCTION Q(X)

C     .. Scalar Arguments ..
      REAL X
C     ..
C     .. Local Scalars ..
      REAL NU
C     ..
      NU = 0.75D0
      Q = (NU*NU-0.25D0)/X**2
      RETURN
      END
C
      REAL FUNCTION W(X)

C     .. Scalar Arguments ..
      REAL X
C     ..
      W = 1.0D0
      RETURN
      END
C
      SUBROUTINE UV(X,U,PUP,V,PVP,HU,HV)

C     .. Scalar Arguments ..
      REAL HU,HV,PUP,PVP,U,V,X
C     ..
C     .. Local Scalars ..
      REAL NU
C     ..
      NU = 0.75D0
      U = X** (NU+0.5D0)
      PUP = (NU+0.5D0)*X** (NU-0.5D0)
      V = X** (-NU+0.5D0)
      PVP = (-NU+0.5D0)*X** (-NU-0.5D0)
      HU = 0.0D0
      HV = 0.0D0
      RETURN
      END
SHAR_EOF
fi # end of overwriting check
if test -f 'makepqw.f'
then
	echo shar: will not over-write existing file "'makepqw.f'"
else
cat << "SHAR_EOF" > 'makepqw.f'
C  PROGRAM MAKEPQW 
 
C     **********
C     MARCH 1, 2001; P.B. BAILEY, W.N. EVERITT AND A. ZETTL
C     VERSION 1.2
C     **********

      PROGRAM MAKEPQW
C
C     THIS PROGRAM GENERATES THE FORTRAN COEFFICIENT FUNCTIONS
C     P(X), Q(X), W(X), AND THE SUBROUTINE UV WHICH DEFINES THE
C     BOUNDARY CONDITION FUNCTIONS u(X), v(X) AND/OR U(X), V(X)
C     FOR SLEIGN2.
C
C     THE DIFFERENTIAL EQUATION IS OF THE FORM
C
C           -(p*y')' + q*y = lambda*w*y
C
C     .. Local Scalars ..
      CHARACTER*1 HQ
      CHARACTER*16 CHANS,TAPE1
      CHARACTER*62 STR
      REAL C
C     ..
C     .. External Subroutines ..
      EXTERNAL LC
C     ..
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*) ' HELP may be called at any point where the program   '
      WRITE(*,*) '    halts and displays (h?) by pressing "h <ENTER>". '
      WRITE(*,*) '    To RETURN from HELP, press "r <ENTER>".          '
      WRITE(*,*) '    To QUIT at any program halt, press "q <ENTER>".  '
      WRITE(*,*) ' WOULD YOU LIKE AN OVERVIEW OF HELP ? (Y/N) (h?)     '
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      WRITE(*,*)
      READ(*,1) HQ
      IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
            STOP
         ELSE IF (HQ.EQ.'y' .OR. HQ.EQ.'Y' .OR.
     1            HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
            CALL HELP(1)
            END IF
C
  100 CONTINUE
         WRITE(*,*) ' SPECIFY OUTPUT FILE NAME (h?)  '
         READ(*,16) CHANS
         IF (CHANS.EQ.'q' .OR. CHANS.EQ.'Q') THEN
            STOP
         ELSE IF (CHANS.EQ.'h' .OR. CHANS.EQ.'H') THEN
            CALL HELP(2)
            GO TO 100
         ELSE
            TAPE1 = CHANS
            END IF
         OPEN(1,FILE=TAPE1,STATUS='NEW')
         WRITE(1,'(A)') 'C'
         WRITE(1,'(A)') 'C               ' // TAPE1
C
      WRITE(*,*) ' THE DIFFERENTIAL EQUATION IS OF THE FORM: '
      WRITE(*,*) '        -(p*y'')'' + q*y = lambda*w*y      '
      WRITE(*,*)
C
  200 CONTINUE
         WRITE(*,*) ' INPUT (h?) p = '
         READ(*,62) STR
         HQ = STR
         IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
            STOP
         ELSE IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
            CALL HELP(3)
            GO TO 200
         ELSE
            WRITE(1,'(A)') 'C'
            WRITE(1,'(A)') '      FUNCTION P(X)'
            WRITE(1,'(A)') '      REAL P,X'
            WRITE(1,'(A)') '      P = ' // STR
            WRITE(1,'(A)') '      RETURN'
            WRITE(1,'(A)') '      END'
         END IF
C
  300 CONTINUE
         WRITE(*,*) ' INPUT (h?) q = '
         READ(*,62) STR
         HQ = STR
         IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
            STOP
         ELSE IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
            CALL HELP(3)
            GO TO 300
         ELSE
            WRITE(1,'(A)') 'C'
            WRITE(1,'(A)') '      FUNCTION Q(X)'
            WRITE(1,'(A)') '      REAL Q,X'
            WRITE(1,'(A)') '      Q = ' // STR
            WRITE(1,'(A)') '      RETURN'
            WRITE(1,'(A)') '      END'
            END IF
C
  400 CONTINUE
         WRITE(*,*) ' INPUT (h?) w = '
         READ(*,62) STR
         HQ = STR
         IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
            STOP
         ELSE IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
            CALL HELP(3)
            GO TO 400
         ELSE
            WRITE(1,'(A)') 'C'
            WRITE(1,'(A)') '      FUNCTION W(X)'
            WRITE(1,'(A)') '      REAL W,X'
            WRITE(1,'(A)') '      W = ' // STR
            WRITE(1,'(A)') '      RETURN'
            WRITE(1,'(A)') '      END'
            END IF
C
  500 CONTINUE
         WRITE(*,*) ' DO YOU REQUIRE INFORMATION ON END-POINT '
         WRITE(*,*) '    CLASSIFICATION ? (Y/N) (h?)  '
         READ(*,1) HQ
         IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
            STOP
         ELSE IF (HQ.EQ.'y' .OR. HQ.EQ.'Y' .OR.
     1            HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
            CALL HELP(4)
            GO TO 500
         ELSE IF (HQ.EQ.'n' .OR. HQ.EQ.'N') THEN
            GO TO 800
         ELSE
            END IF
C
  600 CONTINUE
         WRITE(*,*) ' DO YOU REQUIRE INFORMATION ON DEFAULT CLASSIFI-'
         WRITE(*,*) '    CATION AND BOUNDARY CONDITIONS ? (Y/N) (h?)  '
         READ(*,1) HQ
         IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
            STOP
         ELSE IF (HQ.EQ.'y' .OR. HQ.EQ.'Y' .OR.
     1            HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
            CALL HELP(5)
            GO TO 600
         ELSE
            END IF
C
  700 CONTINUE
         WRITE(*,*) ' DO YOU REQUIRE INFORMATION ON LIMIT CIRCLE '
         WRITE(*,*) '    BOUNDARY CONDITIONS ? (Y/N) (h?)  '
         READ(*,1) HQ
         IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
            STOP
         ELSE IF (HQ.EQ.'y' .OR. HQ.EQ.'Y' .OR.
     1            HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
            CALL HELP(6)
            GO TO 700
         ELSE
            END IF
C
  800 CONTINUE
         WRITE(*,*) ' DO YOU WANT TO USE A LIMIT CIRCLE  '
         WRITE(*,*) '    BOUNDARY CONDITION ? (Y/N) (h?)  '
         READ(*,1) HQ
         IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
            STOP
         ELSE IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
            CALL HELP(6)
            GO TO 800
         ELSE IF (HQ.EQ.'y' .OR. HQ.EQ.'Y') THEN
            WRITE(1,'(A)') 'C'
            WRITE(1,'(A)') '      SUBROUTINE UV(X,U,PUP,V,PVP,HU,HV)'
            WRITE(1,'(A)') '      REAL X,U,PUP,V,PVP,HU,HV'
  900       CONTINUE
               WRITE(*,*) ' DO YOU WANT TO USE TWO DIFFERENT PAIRS OF '
               WRITE(*,*) '    FUNCTIONS U(X),V(X) ? (Y/N) (h?) '
               READ(*,1) HQ
               IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
                  STOP
               ELSE IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
                  CALL HELP(6)
                  GO TO 900
               ELSE IF (HQ.EQ.'y' .OR. HQ.EQ.'Y') THEN
 1000             CONTINUE
                     WRITE(*,*) ' ASSUMING THAT ONE PAIR OF FUNCTIONS  '
                     WRITE(*,*) '    U(X),V(X) IS FOR a < X < c, AND   '
                     WRITE(*,*) '    THE OTHER PAIR IS FOR c <= X < b, '
                     WRITE(*,*) '    WHAT IS THE VALUE OF c ? (h?)     '
                     WRITE(*,*)
                     WRITE(*,*) ' c = '
                     READ(*,16) CHANS
                     HQ = CHANS
                     IF (HQ.EQ.'q' .OR. HQ.EQ.'Q') THEN
                        STOP
                     ELSE IF (HQ.EQ.'h' .OR. HQ.EQ.'H') THEN
                        CALL HELP(6)
                        GO TO 1000
                     ELSE
                        READ(CHANS,'(F16.0)') C
                        END IF
                  WRITE(*,*)
                  WRITE(*,*) ' FOR a < X < c :'
                  WRITE(*,*)
                  WRITE(1,'(A,1PE12.5,A)') '      IF (X.LT.',C,') THEN'
                  CALL LC(9,1)
                  WRITE(*,*)
                  WRITE(*,*) ' FOR c <= X < b :'
                  WRITE(*,*)
                  WRITE(1,'(A)') '      ELSE'
                  CALL LC(9,2)
                  WRITE(1,'(A)') '      END IF'
               ELSE
                  WRITE(*,*)
                  CALL LC(6,1)
                  END IF
         ELSE
            WRITE(1,'(A)') 'C'
            WRITE(1,'(A)') '      SUBROUTINE UV'
            END IF
      WRITE(1,'(A)') '      RETURN'
      WRITE(1,'(A)') '      END'
C
      WRITE(1,'(A)') 'C'
      WRITE(1,'(A)') '      SUBROUTINE EXAMP'
      WRITE(1,'(A)') '      RETURN'
      WRITE(1,'(A)') '      END'
      CLOSE(1)
      STOP
    1 FORMAT(A1)
   16 FORMAT(A16)
   62 FORMAT(A62)
      END
C
      SUBROUTINE LC(INDENT,N)
      INTEGER INDENT,N
C     .. Local Scalars ..
      CHARACTER*57 STR
C     ..
      IF (INDENT.EQ.6) THEN
         WRITE(*,*) ' INPUT u = '
         READ(*,57) STR
         WRITE(1,'(A)') '      u = ' // STR
         WRITE(*,*) ' INPUT v = '
         READ(*,57) STR
         WRITE(1,'(A)') '      v = ' // STR
         WRITE(*,*) ' INPUT pu'' = '
         READ(*,57) STR
         WRITE(1,'(A)') '      pup = ' // STR
         WRITE(*,*) ' INPUT pv'' = '
         READ(*,57) STR
         WRITE(1,'(A)') '      pvp = ' // STR
         WRITE(*,*) ' INPUT -(pu'')'' + q*u = '
         READ(*,57) STR
         WRITE(1,'(A)') '      hu = ' // STR
         WRITE(*,*) ' INPUT -(pv'')'' + q*v = '
         READ(*,57) STR
         WRITE(1,'(A)') '      hv = ' // STR
      ELSE IF(N.EQ.1) THEN
         WRITE(*,*) ' INPUT u = '
         READ(*,57) STR
         WRITE(1,'(A)') '         u = ' // STR
         WRITE(*,*) ' INPUT v = '
         READ(*,57) STR
         WRITE(1,'(A)') '         v = ' // STR
         WRITE(*,*) ' INPUT pu'' = '
         READ(*,57) STR
         WRITE(1,'(A)') '         pup = ' // STR
         WRITE(*,*) ' INPUT pv'' = '
         READ(*,57) STR
         WRITE(1,'(A)') '         pvp = ' // STR
         WRITE(*,*) ' INPUT -(pu'')'' + q*u = '
         READ(*,57) STR
         WRITE(1,'(A)') '         hu = ' // STR
         WRITE(*,*) ' INPUT -(pv'')'' + q*v = '
         READ(*,57) STR
         WRITE(1,'(A)') '         hv = ' // STR
      ELSE
         WRITE(*,*) ' INPUT U = '
         READ(*,57) STR
         WRITE(1,'(A)') '         U = ' // STR
         WRITE(*,*) ' INPUT V = '
         READ(*,57) STR
         WRITE(1,'(A)') '         V = ' // STR
         WRITE(*,*) ' INPUT PU'' = '
         READ(*,57) STR
         WRITE(1,'(A)') '         PUP = ' // STR
         WRITE(*,*) ' INPUT PV'' = '
         READ(*,57) STR
         WRITE(1,'(A)') '         PVP = ' // STR
         WRITE(*,*) ' INPUT -(PU'')'' + Q*U = '
         READ(*,57) STR
         WRITE(1,'(A)') '         HU = ' // STR
         WRITE(*,*) ' INPUT -(PV'')'' + Q*V = '
         READ(*,57) STR
         WRITE(1,'(A)') '         HV = ' // STR
         END IF
      RETURN
   57 FORMAT(A57)
      END
c
      subroutine help(nh)
      integer i,n,nh
      character*36 x(23),y(23)
      character*1 ans
c
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),NH
c
    1 CONTINUE
      write(*,*)
      write(*,*) 'H1:  Overview of HELP.'
      x(1)='  This ASCII text file is supplied a'
      y(1)='s a separate file with the SLEIGN2  '
      x(2)='package; it can be accessed on-line '
      y(2)='in both MAKEPQW (if used) and DRIVE.'
      x(3)='  HELP contains information to aid t'
      y(3)='he user in entering data on the co- '
      x(4)='efficient functions p,q,w; on the se'
      y(4)='lf-adjoint, separated and coupled,  '
      x(5)='regular and singular, boundary condi'
      y(5)='tions; on the limit circle boundary '
      x(6)='condition functions u,v at a and U,V'
      y(6)=' at b; on the end-point classifica- '
      x(7)='tions of the differential equation; '
      y(7)='on DEFAULT entry; on eigenvalue in- '
      x(8)='dexes; on IFLAG information; and on '
      y(8)='the general use of the program      '
      x(9)='SLEIGN2.                            '
      y(9)=' '
      x(10)='  The 17 sections of HELP are:      '
      y(10)=' '
      x(11)=' '
      y(11)=' '
      x(12)='    H1: Overview of HELP.           '
      y(12)=' '
      x(13)='    H2: File name entry.            '
      y(13)=' '
      x(14)='    H3: The differential equation.  '
      y(14)=' '
      x(15)='    H4: End-point classification.   '
      y(15)=' '
      x(16)='    H5: DEFAULT entry.              '
      y(16)=' '
      x(17)='    H6: Self-adjoint limit-circle bo' 
      y(17)='undary conditions.                  '
      do 101 i = 1,17
        write(*,*) x(i),y(i)
  101   continue
      write(*,*)
      write(*,*)
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)='    H7: General self-adjoint boundar'
      y(1)='y conditions. '
      x(2)='    H8: Recording the results.      '
      y(2)=' '
      x(3)='    H9: Type and choice of interval.'
      y(3)=' '
      x(4)='   H10: Entry of end-points.        '
      y(4)=' '
      x(5)='   H11: End-point values of p,q,w.  '
      y(5)=' '
      x(6)='   H12: Initial value problems.     '
      y(6)=' '
      x(7)='   H13: Indexing of eigenvalues for '
      y(7)='separated boundary conditions.      '
      x(8)='   H14: Entry of eigenvalue index, i'
      y(8)='nitial guess, and tolerance.     '
      x(9)='   H15: IFLAG information.          '
      y(9)=' '
      x(10)='   H16: Plotting.                  '
      y(10)=' '
      x(11)='   H17: Indexing of eigenvalues for'
      y(11)='coupled boundary conditions.       '
      x(12)=' '
      y(12)=' '
      x(13)='  HELP can be accessed at each point'
      y(13)=' in MAKEPQW and DRIVE where the user'
      x(14)='is asked for input, by pressing "h <'
      y(14)='ENTER>"; this places the user at the'
      x(15)='appropriate HELP section.  Once in H'
      y(15)='ELP, the user can scroll the further'
      x(16)='HELP sections by repeatedly pressing'
      y(16)=' "h <ENTER>", or jump to a specific '
      x(17)='HELP section Hn (n=1,2,...17) by typ'
      y(17)='ing "Hn <ENTER>"; to return to the  '
      x(18)='place in the program from which HELP'
      y(18)=' is called, press "r <ENTER>".      '
      do 102 i = 1,18
        write(*,*) x(i),y(i)
  102   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) 
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
    2 CONTINUE
      write(*,*)
      write(*,*) 'H2:  File name entry.'
      x(1)='  MAKEPQW is used to create a FORTRA'
      y(1)='N file containing the coefficients  '
      x(2)='p(x),q(x),w(x), defining the differe'
      y(2)='ntial equation, and the boundary    '
      x(3)='condition functions u(x),v(x) and U('
      y(3)='x),V(x) if required.  The file must '
      x(4)='be given a NEW filename which is acc'
      y(4)='eptable to your FORTRAN compiler.   '
      x(5)='For example, it might be called bess'
      y(5)='el.f or bessel.for, depending upon  '
      x(6)='your compiler.                      '
      y(6)=' '
      x(7)='  The same naming considerations app'
      y(7)='ly if the FORTRAN file is prepared  '
      x(8)='other than with the use of MAKEPQW. ' 
      y(8)=' '
      do 201 i = 1,8
        write(*,*) x(i),y(i)
  201   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
    3 CONTINUE
      write(*,*) 'H3:  The differential equation.'
      x(1)='  The prompt "Input p (or q or w) ="'
      y(1)=' requests you to type in a FORTRAN  '
      x(2)='expression defining the function p(x'
      y(2)='), which is one of the three coeffi-'
      x(3)='cient functions defining the Sturm-L'
      y(3)='iouville differential equation      '
      x(4)=' '
      y(4)=' '
      x(5)='                   -(p*y'')'' + q*y = '
      y(5)=' lambda*w*y              (*)        '
      x(6)=' '
      y(6)=' '
      x(7)='to be considered on some interval (a'
      y(7)=',b) of the real line.  The actual   '
      x(8)='interval used in a particular proble'
      y(8)='m can be chosen later, and may be   '
      x(9)='either the whole interval (a,b) wher'
      y(9)='e the coefficient functions p,q,w,  '
      x(10)='etc. are defined or any sub-interval'
      y(10)=' (a'',b'') of (a,b); a = -infinity  '
      x(11)='and/or b = +infinity are allowable c'
      y(11)='hoices for the end-points.          '
      x(12)='  The coefficient functions p,q,w of'
      y(12)=' the differential equation may be   '
      x(13)='chosen arbitrarily but must satisfy '
      y(13)='the following conditions:           '
      x(14)='  1. p,q,w are real-valued throughou'
      y(14)='t (a,b).                            '
      x(15)='  2. p,q,w are piece-wise continuous'
      y(15)=' and defined throughout the         '
      x(16)='     interior of the interval (a,b).'
      y(16)='                                    '
      x(17)='  3. p and w are strictly positive i'
      y(17)='n (a,b).                            '
      x(18)='     For better error analysis in th'
      y(18)='e numerical procedures, condition 2.'
      x(19)='     above is often replaced with   '
      y(19)=' '
      x(20)='  2''. p,q,w are four times continuou'
      y(20)='sly differentiable on (a,b).        '
      x(21)='  The behavior of p,q,w near the end'
      y(21)='-points a and b is critical to the  '
      x(22)='classification of the differential e'
      y(22)='quation (see H4 and H11).           '
      do 301 i = 1,22
        write(*,*) x(i),y(i)
  301   continue
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
    4 CONTINUE
      write(*,*) 'H4:  End-point classification.'
      x(1)='  The correct classification of the '
      y(1)='end-points a and b is essential to  '
      x(2)='the working of the SLEIGN2 program. '
      y(2)=' To classify the end-points, it is  '
      x(3)='convenient to choose a point c in (a'
      y(3)=',b); i.e.,  a < c < b.  Subject to  '
      x(4)='the general conditions on the coeffi'
      y(4)='cient functions p,q,w (see H3):     '
      x(5)='  1. a is REGULAR (say R) if -infini'
      y(5)='ty < a, p,q,w are piece-wise        '
      x(6)='     continuous on [a,c], and p(a) >'
      y(6)=' 0 and w(a) > 0.                    '
      x(7)='  2. a is WEAKLY REGULAR (say WR) if'
      y(7)=' -infinity < a, a is not R, and     '
      x(8)='                     |c             '
      y(8)=' '
      x(9)='            integral | {1/p+|q|+w} <'
      y(9)=' +infinity.                         '
      x(10)='                     |a             '
      y(10)=' '
      x(11)='     If end-point a is neither R nor'
      y(11)=' WR, then a is SINGULAR; that is,   '
      x(12)='     either -infinity = a, or -infin'
      y(12)='ity < a and                         '
      x(13)='                     |c             '
      y(13)=' '
      x(14)='            integral | {1/p+|q|+w} ='
      y(14)=' +infinity.                         '
      x(15)='                     |a             '
      y(15)=' '
      x(16)='  3. The SINGULAR end-point a is LIM'
      y(16)='IT-CIRCLE NON-OSCILLATORY (say      '
      x(17)='     LCNO) if for some real lambda A'
      y(17)='LL real-valued solutions y of the   '
      x(18)='     differential equation          '
      y(18)=' '
      x(19)=' '
      y(19)=' '
      x(20)='                   -(p*y'')'' + q*y = '
      y(20)='lambda*w*y on (a,c]     (*)         '
      x(21)=' '
      y(21)=' '
      x(22)='     satisfy the conditions:        '
      y(22)=' '
      do 401 i = 1,22
        write(*,*) x(i),y(i)
  401   continue
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)='                     |c             '
      y(1)=' '
      x(2)='            integral | { w*y*y } < +'
      y(2)='infinity, and                       '
      x(3)='                     |a             '
      y(3)=' '
      x(4)='     y has at most a finite number o'
      y(4)='f zeros in (a,c].                   '
      x(5)='  4. The SINGULAR end-point a is LIM'
      y(5)='IT-CIRCLE OSCILLATORY (say LCO) if  '
      x(6)='     for some real lambda ALL real-v'
      y(6)=' alued solutions of the differential'
      x(7)='     equation (*) satisfy the condit'
      y(7)='ions:                               '
      x(8)='                     |c             '
      y(8)=' '
      x(9)='            integral | { w*y*y } < +'
      y(9)='infinity, and                       '
      x(10)='                     |a             '
      y(10)=' '
      x(11)='     y has an infinite number of zer'
      y(11)='os in (a,c].                        '
      x(12)='  5. The SINGULAR end-point a is LIM'
      y(12)='IT POINT (say LP) if for some real  '
      x(13)='     lambda at least one solution of'
      y(13)=' the differential equation (*) sat- '
      x(14)='     isfies the condition:          '
      y(14)=' '
      x(15)='                     |c             '
      y(15)=' '
      x(16)='            integral | {w*y*y} = +in'
      y(16)='finity.                             '
      x(17)='                     |a             '
      y(17)=' '
      x(18)='  There is a similar classification '
      y(18)='of the end-point b into one of the  '
      x(19)='five distinct cases R, WR, LCNO, LCO'
      y(19)=', LP.                               '
      do 402 i = 1,19
        write(*,*) x(i),y(i)
  402   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)='  Although the classification of sin'
      y(1)='gular end-points invokes a real     '
      x(2)='value of the parameter lambda, this '
      y(2)='classification is invariant in      '
      x(3)='lambda; all real choices of lambda l'
      y(3)='ead to the same classification.     '
      x(4)='  In determining the classification '
      y(4)='of singular end-points for the      '
      x(5)='differential equation (*), it is oft'
      y(5)='en convenient to start with the     '
      x(6)='choice lambda = 0 in attempting to f'
      y(6)='ind solutions (particularly when    '
      x(7)='q = 0 on (a,b)); however, see exampl'
      y(7)='e 7 below.                          '
      x(8)='  See H6 on the use of maximal domai'
      y(8)='n functions to determine the        '
      x(9)='classification at singular end-point'
      y(9)='s.                                  '
      do 403 i = 1,9
        write(*,*) x(i),y(i)
  403   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      write(*,*) ' EXAMPLES: '
      x(1)='  1. -y'''' = lambda*y is R at both en'
      y(1)='d-points of (a,b) when a and b are  '
      x(2)='     finite.                        '
      y(2)=' '
      x(3)='  2. -y'''' = lambda*y on (-infinity,i'
      y(3)='nfinity) is LP at both end-points.  '
      x(4)='  3. -(sqrt(x)*y''(x))'' = lambda*(1./'
      y(4)='sqrt(x))*y(x) on (0,infinity) is    '
      x(5)='     WR at 0 and LP at +infinity (ta'
      y(5)='ke lambda = 0 in (*)).  See         '
      x(6)='     examples.f, #10 (Weakly Regular'
      y(6)=').                                  '
      x(7)='  4. -((1-x*x)*y''(x))'' = lambda*y(x)'
      y(7)=' on (-1,1) is LCNO at both ends     '
      x(8)='     (take lambda = 0 in (*)).  See '
      y(8)='xamples.f, #1 (Legendre).           '
      x(9)='  5. -y''''(x) + C*(1/(x*x))*y(x) = la'
      y(9)='mbda*y(x) on (0,infinity) is LP at  '
      x(10)='     infinity and at 0 is (take lamb'
      y(10)='da = 0 in (*)):                     '
      x(11)='       LP for C .ge. 3/4 ;          '
      y(11)=' '
      x(12)='       LCNO for -1/4 .le. C .lt. 3/4'
      y(12)=' (but C .ne. 0);                    '
      x(13)='       LCO for C .lt. -1/4.         '
      y(13)=' '
      x(14)='  6. -(x*y''(x))'' - (1/x)*y(x) = lamb'
      y(14)='da*y(x) on (0,infinity) is LCO at 0 '
      x(15)='     and LP at +infinity (take lambd'
      y(15)='a = 0 in (*) with solutions         '
      x(16)='     cos(ln(x)) and sin(ln(x))).  Se'
      y(16)='e xamples.f, #7 (BEZ).              '
      x(17)='  7. -(x*y''(x))'' - x*y(x) = lambda*('
      y(17)='1/x)*y(x) on (0,infinity) is LP at 0'
      x(18)='     and LCO at infinity (take lambd'
      y(18)='a = -1/4 in (*) with solutions      '
      x(19)='     cos(x)/sqrt(x) and sin(x)/sqrt('
      y(19)='x)).  See xamples.f,                '
      x(20)='     #6 (Sears-Titchmarsh).         '
      y(20)=' '
      x(21)='  8. -y''''(x) + x*sin(x)*y(x) = lambd'
      y(21)='a*y(x) on (0,infinity) is R at 0 and'
      x(22)='     LP at infinity.  See examples.f'
      y(22)=' #30 (Littlewood-McLeod).           '
      do 404 i = 1,22
        write(*,*) x(i),y(i)
  404   continue
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
    5 CONTINUE
      write(*,*) 'H5:  DEFAULT entry.'
      x(1)='  The complete range of problems for'
      y(1)=' which SLEIGN2 is applicable can    '
      x(2)='only be reached by appropriate entri'
      y(2)='es under end-point classification   '
      x(3)='and boundary conditions.  However, t'
      y(3)='here is a DEFAULT application which '
      x(4)='requires no detailed entry of end-po'
      y(4)='int classification or boundary      '
      x(5)='conditions, subject to:             '
      y(5)=' '
      x(6)='  1. The DEFAULT application CANNOT '
      y(6)='be used at a LCO end-point.         '
      x(7)='  2. If an end-point a is R, then th'
      y(7)='e Dirichlet boundary condition      '
      x(8)='     y(a) = 0 is automatically used.'
      y(8)=' '
      x(9)='  3. If an end-point a is WR, then t'
      y(9)='he following boundary condition     '
      x(10)='     is automatically applied:      '
      y(10)=' '
      x(11)='       if p(a) = 0, and both q(a),w('
      y(11)='a) are bounded, then the Neumann    '
      x(12)='       boundary condition (py'')(a) '
      y(12)='= 0 is used, or                     '
      x(13)='       if p(a) > 0, and q(a) and/or '
      y(13)='w(a)) are not bounded, then the     '
      x(14)='       Dirichlet boundary condition '
      y(14)='y(a) = 0 is used.                   '
      x(15)='       If p(a) = 0, and q(a) and/or '
      y(15)='w(a) are not bounded, then no simple'
      x(16)='       information, in general, can '
      y(16)=' be given on the DEFAULT boundary   '
      x(17)='       condition.                   '
      y(17)=' '
      x(18)='  4. If an end-point is LCNO, then i'
      y(18)='n most cases the principal or       '
      x(19)='     Friedrichs boundary condition i'
      y(19)='s applied (see H6).                 '
      x(20)='  5. If an end-point is LP, then the'
      y(20)=' normal LP procedure is applied     '
      x(21)='     (see H7(1.)).                  '
      y(21)=' '
      x(22)='If the DEFAULT condition is chosen, '
      y(22)='then no entry is required for the   '
      x(23)='u,v and U,V boundary condition funct'
      y(23)='ions. '
      do 501 i = 1,23
        write(*,*) x(i),y(i)
  501   continue
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
    6 CONTINUE
      write(*,*) 'H6:  Limit-circle boundary conditions.'
      x(1)='  At an end-point a, the limit-circl'
      y(1)='e type separated boundary condition '
      x(2)='is of the form (similar remarks thro'
      y(2)='ughout apply to the end-point b with'
      x(3)=' U,V being boundary condition functi'
      y(3)='ons at b)                           '
      x(4)=' '
      y(4)=' '
      x(5)='       A1*[y,u](a) + A2*[y,v](a) = 0'
      y(5)=',                          (**)     '
      x(6)=' '
      y(6)=' '
      x(7)='where y is a solution of the differe'
      y(7)='ntial equation                      '
      x(8)=' '
      y(8)=' '
      x(9)='     -(p*y'')'' + q*y = lambda*w*y  on'
      y(9)=' (a,b).                     (*)     '
      x(10)=' '
      y(10)=' '
      x(11)='Here A1, A2 are real numbers; u and '
      y(11)='v are boundary condition functions  '
      x(12)='at a; and for real-valued y and u th'
      y(12)='e form [y,u] is defined by          '
      x(13)='                                    '
      y(13)='                                    '
      x(14)='   [y,u](x) = y(x)*(pu'')(x) - u(x)*'
      y(14)='(py'')(x)   for x in (a,b).         '
      x(15)='                                    '
      y(15)='                                    '
      x(16)='  If neither end-point is LP then th'
      y(16)='ere are also self-adjoint coupled   '
      x(17)='boundary conditions.  These have a c'
      y(17)='anonical form given by              '
      x(18)='                                    '
      y(18)='                                    '
      x(19)='    Y(b) = exp(i*alpha)*K*Y(a),     '
      y(19)=' '
      x(20)='                                    '
      y(20)='                                    '
      x(21)='where K is a real 2 by 2 matrix with'
      y(21)=' determinant 1, alpha is restricted '
      x(22)='to the interval (-pi,pi], and Y is  '
      y(22)='  '
      do 551 i = 1,22
        write(*,*) x(i),y(i)
  551   continue
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)=' (i) the solution vector Y = transpo'
      y(1)='se [y(a), (py'')(a)] at a regular   '
      x(2)='     end-point a, or                ' 
      y(2)=' '
      x(3)=' (ii) the "singular solution vector"'
      y(3)=' Y(a) = transpose [[y,u](a),        '
      x(4)='      [y,v](a)] at a singular LC end'
      y(4)=' -point a.  Similarly at the right  '
      x(5)='      end-point b with U,V.         '
      y(5)=' '
      x(6)='  The object of this section is to p'
      y(6)='rovide help in choosing appropriate '
      x(7)='functions u and v in (**) (or U,V), '
      y(7)='given the differential equation (*).'
      x(8)='Full details of the boundary conditi'
      y(8)='ons for (*) are discussed in H7;    '
      x(9)='here it is sufficient to say that th'
      y(9)='e limit-circle type boundary condi- '
      x(10)='tion (**) can be applied at any end-'
      y(10)='point in the LCNO, LCO classifica-  '
      x(11)='tion, but also in the R, WR classifi'
      y(11)='cation subject to the appropriate   '
      x(12)='choice of u,v or U,V.               '
      y(12)=' '
      x(13)='  Let (*) be R, WR, LCNO, or LCO at '
      y(13)='end-point a and choose c in (a,b).  '
      x(14)='Then either                         '
      y(14)=' '
      x(15)='  u and v are a pair of linearly ind'
      y(15)='ependent solutions of (*) on (a,c]  '
      x(16)='  for any chosen real values of lamb'
      y(16)='da, or                              '
      x(17)='  u and v are a pair of real-valued '
      y(17)=' maximal domain functions defined on'
      x(18)='  (a,c] satisfying [u,v](a) .ne. 0. '
      y(18)=' The maximal domain D(a,c] is de-   '
      x(19)='  defined by                        '
      y(19)=' '
      x(20)=' '
      y(20)=' '
      x(21)='       D(a,c] = {f:(a,c]->R:: f,pf'' '
      y(21)='in AC(a,c];                         '
      x(22)='                   f, ((-pf'')''+qf)/w'
      y(22)=' in L2((a,c;w)}  .                  '
      x(23)=' '
      y(23)=' '
      do 601 i = 1,23
        write(*,*) x(i),y(i)
  601   continue
      read(*,999) ans,n
      write(*,*)
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)='  It is known that for all f,g in D('
      y(1)='a,c] the limit                      '
      x(2)=' '
      y(2)=' '
      x(3)='       [f,g](a) = lim[f,g](x) as x->'
      y(3)='a                                   '
      x(4)=' '
      y(4)=' '
      x(5)='exists and is finite.  If (*) is LCN'
      y(5)='O or LCO at a, then all solutions of'
      x(6)='of (*) belong to D(a,c] for all valu'
      y(6)='es of lambda.                       '
      x(7)='  The boundary condition (**) is ess'
      y(7)='ential in the LCNO and LCO cases but'
      x(8)='can also be used with advantage in s'
      y(8)='ome R and WR cases.  In the R, WR, '
      x(9)='and LCNO cases, but not in the LCO c'
      y(9)='ase, the boundary condition         '
      x(10)='functions can always be chosen so th'
      y(10)='at                                  '
      x(11)='        lim u(x)/v(x) = 0 as x->a,  '
      y(11)=' '
      x(12)='and it is recommended that this norm'
      y(12)='alisation be effected, but this is  '
      x(13)='not essential; this normalisation ha'
      y(13)='s been entered in the examples given'
      x(14)='below.  In this case, the boundary c'
      y(14)='ondition [y,u](a) = 0 (i.e., A1 = 1,'
      x(15)='A2 = 0 in (**) is called the princip'
      y(15)='al or Friedrichs boundary condition '
      x(16)='at a.                              '
      y(16)=' '
      x(17)='  In the case when end-points a and '
      y(17)='b are, independently, in R, WR,     '
      x(18)='LCNO, or LCO classification, it may '
      y(18)='be that symmetry or other reasons   '
      x(19)='permit one set of boundary condition'
      y(19)=' functions to be used at both end-  '
      x(20)='points (see xamples.f, #1 (Legendre)'
      y(20)=').  In other cases, different pairs '
      x(21)='must be chosen for each end-point (s'
      y(21)='ee xamples.f: #16 (Jacobi),         '
      x(22)='#18 (Dunsch), and #19 (Donsch)).    '
      y(22)=' '
      do 602 i = 1,22
        write(*,*) x(i),y(i)
  602   continue
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)=' '
      y(1)=' '
      x(2)='  Note that a solution pair u,v is a'
      y(2)='lways a maximal domain pair, but not'
      x(3)='necessarily vice versa.             '
      y(3)=' '
      x(4)=' '
      y(4)=' '
      x(5)='EXAMPLES:                           '
      y(5)=' '
      x(6)='1. -y''''(x) = lambda*y(x) on [0,pi] i'
      y(6)='s R at 0 and R at pi.               '
      x(7)='   At 0, with lambda = 0, a solution'
      y(7)=' pair is u(x) = x, v(x) = 1.        '
      x(8)='   At pi, with lambda = 1, a solutio'
      y(8)='n pair is                           '
      x(9)='     u(x) = sin(x), v(x) = cos(x).  '
      y(9) =' '
      x(10)='2. -(sqrt(x)*y''(x))'' = lambda*y(x)/s'
      y(10)='qrt(x) on (0,1] is                  '
      x(11)='     WR at 0 and R at 1.            '
      y(11)=' '
      x(12)='   (The general solutions of this eq'
      y(12)='uation are                          '
      x(13)='     u(x) = cos(2*sqrt(x*lambda)), v'
      y(13)='(x) = sin(2*sqrt(x*lambda)).)       '
      x(14)='   At 0, with lambda = 0, a solution'
      y(14)=' pair is                            '
      x(15)='     u(x) = 2*sqrt(x), v(x) = 1.    '
      y(15)=' '
      x(16)='   At 1, with lambda = pi*pi/4, a so'
      y(16)='lution pair is                      '
      x(17)='     u(x) = sin(pi*sqrt(x)), v(x) = '
      y(17)='cos(pi*sqrt(x)).                    '
      x(18)='   At 1, with lambda = 0, a solution'
      y(18)=' pair is                            '
      x(19)='     u(x) = 2*(1-sqrt(x)), v(x) = 1.'
      y(19)=' '
      x(20)='   See also xamples.f, #10 (Weakly R'
      y(20)='egular).                            '
      x(21)='3. -((1-x*x)*y''(x))'' = lambda*y(x) o'
      y(21)='n (-1,1) is LCNO at both ends.      '
      x(22)='   At +-1, with lambda = 0, a soluti'
      y(22)='on pair is                          '
      x(23)='     u(x) = 1, v(x) = 0.5*log((1+x)/'
      y(23)='(1-x)).                             '
      do 603 i = 1,23
        write(*,*) x(i),y(i)
  603   continue
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)='   At 1, a maximal domain pair is u('
      y(1)='x) = 1, v(x) = log(1-x)             '
      x(2)='   At -1, a maximal domain pair is u'
      y(2)='(x) = 1, v(x) = log(1+x).           '
      x(3)='   See also xamples.f, #1 (Legendre)'
      y(3)='.                                   '
      x(4)='4. -y''''(x) - (1/(4x*x))*y(x) = lambd'
      y(4)='a*y(x) on (0,infinity) is           '
      x(5)='     LCNO at 0 and LP at +infinity. '
      y(5)=' '
      x(6)='   At 0, a maximal domain pair is   '
      y(6)=' '
      x(7)='     u(x) = sqrt(x), v(x) = sqrt(x)*'
      y(7)='log(x).                             '
      x(8)='   See also xamples.f, #2 (Bessel). '
      y(8)=' '
      x(9)='5. -y''''(x) - 5*(1/(4*x*x))*y(x) = la'
      y(9)='mbda*y(x) on (0,infinity) is        '
      x(10)='     LCO at 0 and LP at +infinity.  '
      y(10)=' '
      x(11)='   At 0, with lambda = 0, a solution'
      y(11)=' pair is                            '
      x(12)='     u(x) = sqrt(x)*cos(log(x)), v(x'
      y(12)=') = sqrt(x)*sin(log(x))             '
      x(13)='   See also xamples.f, #20 (Krall). '
      y(13)=' '
      x(14)='6. -y''''(x) - (1/x)*y(x) = lambda*y(x'
      y(14)=') on (0,infinity) is               '
      x(15)='     LCNO at 0 and LP at +infinity.'
      y(15)=' '
      x(16)='   At 0, a maximal domain pair is   '
      y(16)=' '
      x(17)='     u(x) = x, v(x) = 1 -x*log(x).  '
      y(17)=' '
      x(18)='   See also xamples.f, #4(Boyd).    '
      y(18)=' '
      x(19)='7. -((1/x)*y''(x))'' + (k/(x*x) + k*k/'
      y(19)='x)*y(x) = lambda*y(x) on (0,1],     '
      x(20)='     with k real and .ne. 0, is LCNO'
      y(20)=' at 0 and R at 1.                   '
      x(21)='   At 0, a maximal domain pair is   '
      y(21)=' '
      x(22)='     u(x) = x*x, v(x) = x - 1/k.    '
      y(22)=' '
      x(23)='   See also xamples.f, #8 (Laplace T'
      y(23)='idal Wave).                         '
      do 604 i = 1,23
        write(*,*) x(i),y(i)
  604   continue
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
    7 CONTINUE
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) 'H7:  General self-adjoint boundary conditions.'
      x(1)='  Boundary conditions for Sturm-Liou'
      y(1)='ville boundary value problems       '
      x(2)=' '
      y(2)=' '
      x(3)='                   -(p*y'')'' + q*y = '
      y(3)='lambda*w*y              (*)         '
      x(4)=' '
      y(4)=' '
      x(5)='on an interval (a,b) are either     '
      y(5)=' '                                    
      x(6)='  SEPARATED, with at most one condit'
      y(6)='ion at end-point a and at most one  '
      x(7)='    condition at end-point b, or    '
      y(7)=' '
      x(8)='  COUPLED, when both a and b are, in'
      y(8)='dependently, in one of the end-point'
      x(9)='    classifications R, WR, LCNO, LCO'
      y(9)=', in which case two independent     '
      x(10)='    boundary conditions are required'
      y(10)=' which link the solution values near'
      x(11)='    a to those near b.              '
      y(11)=' '
      x(12)='  The SLEIGN2 program allows for all'
      y(12)=' self-adjoint boundary conditions:  '
      x(13)='separated self-adjoint conditions an'
      y(13)='d all cases of coupled self-adjoint '
      x(14)='conditions.                         '
      y(14)=' '
      do 701 i = 1,14
        write(*,*) x(i),y(i)
  701   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      write(*,*) '    Separated Conditions:      '
      write(*,*) '    ---------------------      '
      x(1)='  The boundary conditions to be sele'
      y(1)='cted depend upon the classification '
      x(2)='of the differential equation at the '
      y(2)='end-point, say, a:                  '
      x(3)='  1. If the end-point a is LP, then '
      y(3)='no boundary condition is required or'
      x(4)='     allowed.                       '
      y(4)=' '
      x(5)='  2. If the end-point a is R or WR, '
      y(5)='then a separated boundary condition '
      x(6)='     is of the form                 '
      y(6)=' '
      x(7)='         A1*y(a) + A2*(py'')(a) = 0,'
      y(7)=' '
      x(8)='     where A1, A2 are real constants'
      y(8)=' the user must choose, not both zero.  '
      x(9)='  3. If the end-point a is LCNO or'
      y(9)=' LCO, then a separated boundary     '
      x(10)='  condition is of the form          '
      y(10)=' '
      x(11)='         A1*[y,u](a) + A2*[y,v](a) ='
      y(11)=' 0,                                 '
      x(12)='  where A1, A2 are real constants th'
      y(12)='e user must choose, not both zero;  '
      x(13)='  here, u,v are the pair of boundary'
      y(13)=' condition functions you have       '
      x(14)='  previously selected when the input'
      y(14)=' FORTRAN file was being prepared    '
      x(15)='  with makepqw.f.                   '
      y(15)=' ' 
      x(16)='  4. If the end-point a is LCNO an'
      y(16)='d the boundary condition pair       '
      x(17)='  u,v has been chosen so that       '
      y(17)=' '
      x(18)='         lim u(x)/v(x) = 0  as x->a '
      y(18)=' '
      x(19)='  (which is always possible), then A'
      y(19)='1 = 1, A2 = 0 (i.e., [y,u](a) = 0)  '
      x(20)='  gives the principal (Friedrichs) b'
      y(20)='oundary condition at a.             '
      do 702 i = 1,20
        write(*,*) x(i),y(i)
  702   continue
      write(*,*)
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)='  5. If a is R or WR and boundary '
      y(1)='condition functions u,v have been   '
      x(2)='  entered in the FORTRAN input file,'
      y(2)=' then (3.,4.) above apply to        '
      x(3)='  entering separated boundary condit'
      y(3)='ions at such an end-point; the      '
      x(4)='  boundary conditions in this form a'
      y(4)='re equivalent to the point-wise     '
      x(5)='  conditions in (2.) (subject to car'
      y(5)='e in choosing A1, A2).  This        '
      x(6)='  singular form of a regular boundar'
      y(6)='y condition may be particularly     '
      x(7)='  effective in the WR case if the bo'
      y(7)='undary condition form in (2.) leads '
      x(8)='  to numerical difficulties.        '
      y(8)=' '
      x(9)='  Conditions (2.,3.,4.,5.) apply sim'
      y(9)='ilarly at end-point b (with U,V as  '
      x(10)='the boundary condition functions at '
      y(10)='b.                                  '
      x(11)='    6. If a is R, WR, LCNO, or LCO a'
      y(11)='nd b is LP, then only a separated   '
      x(12)='  condition at a is required and all'
      y(12)='owed (or instead at b if a and b    '
      x(13)='  are interchanged).                '
      y(13)=' '
      x(14)='    7. If both end-points a and b ar'
      y(14)='e LP, then no boundary conditions   '
      x(15)='  are required or allowed.          '
      y(15)=' '
      x(16)='  The indexing of eigenvalues for bo'
      y(16)='undary value problems with separated'
      x(17)='  conditions is discussed in H13.   '
      y(17)=' '
      x(18)='    Coupled Conditions:             '
      y(18)=' '
      x(19)='    -------------------             '
      y(19)=' '
      x(20)='    8. Coupled regular self-adjoint '
      y(20)='boundary conditions on (a,b) apply  '
      x(21)='only when both end-points a and b ar'
      y(21)='e R or WR.                          '
      x(22)=' '
      y(22)=' '
      do 704 i = 1,22
        write(*,*) x(i),y(i)
  704   continue
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
    8 CONTINUE
      write(*,*) 'H8:  Recording the results.'
      x(1)='  If you choose to have a record kep'
      y(1)='t of the results, then the following'
      x(2)='information is stored in a file with'
      y(2)=' the name you select:               '
      x(3)=' '
      y(3)=' '
      x(4)='  1. The file name.                 '
      y(4)=' '
      x(5)='  2. The header line prompted for (u'
      y(5)='p to 32 characters of your choice). '
      x(6)='  3. The interval (a,b) which was us'
      y(6)='ed.                                 '
      x(7)=' '
      y(7)=' '
      x(8)='  For SEPARATED boundary conditions:'
      y(8)=' '
      x(9)='  4. The end-point classification.  '
      y(9)=' '
      x(10)='  5. A summary of coefficient inform'
      y(10)='ation at WR, LCNO, LCO end-points.  '
      x(11)='  6. The boundary condition constant'
      y(11)='s (A1,A2), (B1,B2) if entered.      '
      x(12)='  7. (NUMEIG,EIG,TOL) or (NUMEIG1,NU'
      y(12)='MEIG2,TOL), as entered.             '
      x(13)=' '
      y(13)=' '
      x(14)='  For COUPLED boundary conditions:  '
      y(14)=' '
      x(15)='  8. The boundary condition paramete'
      y(15)='r alpha and the coupling matrix K;  '
      x(16)='     see H6.                        '
      y(16)=' '
      x(17)='  For ALL self-adjoint boundary cond'
      y(17)='itions: '
      x(18)='  9. The computed eigenvalue, EIG, a'
      y(18)='nd its estimated accuracy, TOL.     '
      x(19)=' 10. IFLAG reported (see H15).      '
      y(19)=' '
      do 801 i = 1,19
        write(*,*) x(i),y(i)
  801   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
    9 CONTINUE
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) 'H9:  Type and choice of interval.'
      x(1)='  You may enter any interval (a,b) f'
      y(1)='or which the coefficients p,q,w are '
      x(2)='well-defined by your FORTRAN stateme'
      y(2)='nts in the input file, provided that'
      x(3)='(a,b) contains no interior singulari'
      y(3)='ties.                               '
      do 901 i = 1,3
        write(*,*) x(i),y(i)
  901   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
   10 CONTINUE
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) 'H10:  Entry of end-points.'
      x(1)='  End-points a and b should generall'
      y(1)='y be entered as real numbers to an  '
      x(2)='appropriate number of decimal places'
      y(2)='. '
      do 1001 i = 1,2
        write(*,*) x(i),y(i)
 1001   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
   11 CONTINUE
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) 'H11:  End-point values of p,q,w.'
      x(1)='  The program SLEIGN2 needs to know '
      y(1)='whether the coefficient functions   '
      x(2)='p(x),q(x),w(x) defined by the FORTRA'
      y(2)='N expressions entered in the input  '
      x(3)='file can be evaluated numerically wi'
      y(3)='thout running into difficulty.  If, '
      x(4)='for example, either q or w is unboun'
      y(4)='ded at a, or p(a) is 0, then SLEIGN2'
      x(5)='needs to know this so that a is not '
      y(5)='chosen for functional evaluation.   '
      do 1101 i = 1,5
        write(*,*) x(i),y(i)
 1101   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
   12 CONTINUE
      write(*,*) 'H12:  Initial value problems.'
      x(1)='  The initial value problem facility'
      y(1)=' for Sturm-Liouville problems       '
      x(2)=' '
      y(2)=' '
      x(3)='                   -(p*y'')'' + q*y = '
      y(3)=' lambda*w*y              (*)        '
      x(4)=' '
      y(4)=' '
      x(5)='allows for the computation of a solu'
      y(5)='tion of (*) with a user-chosen      '
      x(6)='value lambda and any one of the foll'
      y(6)='owing initial conditions:           '
      x(7)='  1. From end-point a of any classif'
      y(7)='ication except LP towards           '
      x(8)='end-point b of any classification,  '
      y(8)=' '
      x(9)='  2. From end-point b of any classif'
      y(9)='ication except LP back towards      '
      x(10)='end-point a of any classification,  '
      y(10)=' '
      x(11)='  3. From end-points a and b of any '
      y(11)='classifications except LP towards an'
      x(12)='interior point of (a,b) selected by '
      y(12)='the program.                        '
      x(13)=' '
      y(13)=' '
      x(14)='  Initial values at a are of the for'
      y(14)='m y(a) = alpha1, (p*y'')(a) =alpha2,'
      x(15)='when a is R or WR; and [y,u](a) = al'
      y(15)='pha1, [y,v](a) = alpha2, when a is  '
      x(16)='LCNO or LCO.                        '
      y(16)=' '
      x(17)='  Initial values at b are of the for'
      y(17)='m y(b) = beta1, (p*y'')(b) = beta2, '
      x(18)='when b is R or WR; and [y,u](b) = be'
      y(18)='ta1, [y,v](b) = beta2, when b is    '
      x(19)='LCNO or LCO.                        '
      y(19)=' '
      x(20)='  In (*), lambda is a user-chosen re'
      y(20)='al number; while in the above ini-  '
      x(21)='tial values, (alpha1,alpha2) and (be'
      y(21)='ta1,beta2) are user-chosen pairs of '
      x(22)='real numbers not both zero.         '
      y(22)=' '
      do 1201 i = 1,22
        write(*,*) x(i),y(i)
 1201   continue
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      x(1)='  In the initial value case (3.) abo'
      y(1)='ve when the interval (a,b) is       '
      x(2)='finite, the interior point selected '
      y(2)='by the program is generally near the'
      x(3)='midpoint of (a,b); when (a,b) is inf'
      y(3)='inite, no general rule can be given.'
      x(4)='Also if, given (alpha1,alpha2) and ('
      y(4)='beta1,beta2), the lambda chosen is  '
      x(5)='an eigenvalue of the associated boun'
      y(5)='dary value problem, the computed    '
      x(6)='solution may not be the correspondin'
      y(6)='g eigenfunction -- the signs of the '
      x(7)='computed solutions on either side of'
      y(7)=' the interior point may be opposite.'
      x(8)='  The output for a solution of an in'
      y(8)='itial value problem is in the form  '
      x(9)='of stored numerical data which can b'
      y(9)='e plotted on the screen (see H16),  '
      x(10)='or printed out in graphical form if '
      y(10)='graphics software is available.     '
      do 1202 i = 1,10
        write(*,*) x(i),y(i)
 1202   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
   13 continue
      write(*,*) 'H13:  Indexing of eigenvalues.'
      x(1)='  The indexing of eigenvalues is an '
      y(1)='automatic facility in SLEIGN2.  The '
      x(2)='following general results hold for t'
      y(2)='he separated boundary condition     '
      x(3)='problem (see H7):                   '
      y(3)=' '
      x(4)='  1. If neither end-point a or b is '
      y(4)='LP or LCO, then the spectrum of the '
      x(5)='eigenvalue problem is discrete (eige'
      y(5)='nvalues only), simple (eigenvalues  '
      x(6)='all of multiplicity 1), and bounded '
      y(6)='below with a single cluster point at'
      x(7)='+infinity.  The eigenvalues are inde'
      y(7)='xed as {lambda(n): n=0,1,2,...},    '
      x(8)='where lambda(n) < lambda(n+1) (n=0,1'
      y(8)=',2,...), lim lambda(n) -> +infinity;'
      x(9)='and if {psi(n): n=0,1,2,...} are the'
      y(9)=' corresponding eigenfunctions, then '
      x(10)='psi(n) has exactly n zeros in the op'
      y(10)='en interval (a,b).                  '
      x(11)='  2. If neither end-point a or b is '
      y(11)='LP but at least one end-point is    '
      x(12)='LCO, then the spectrum is discrete a'
      y(12)='nd simple as for (1.), but with     '
      x(13)='cluster points at both +infinity and'
      y(13)=' -infinity.  The eigenvalues are in-'
      x(14)='dexed as {lambda(n): n=0,1,-1,2,-2,.'
      y(14)='..}, where                          '
      x(15)='lambda(n) < lambda(n+1) (n=...-2,-1,'
      y(15)='0,1,2,...) with lambda(0) the small-'
      x(16)='est non-negative eigenvalue and lim '
      y(16)='lambda(n) -> +infinity or -> -infi- '
      x(17)='nity with n; and if {psi(n): n=0,1,-'
      y(17)='1,2,-2,...} are the corresponding   '
      x(18)='eigenfunctions, then every psi(n) ha'
      y(18)='s infinitely many zeros in (a,b).   '
      do 1301 i = 1,18
        write(*,*) x(i),y(i)
 1301   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)='  3. If one or both end-points is LP'
      y(1)=', then there can be one or more in- '
      x(2)='tervals of continuous spectrum for t'
      y(2)='he boundary value problem in addi-  '
      x(3)='tion to some (necessarily simple) ei'
      y(3)='genvalues.  For these essentially   '
      x(4)='more difficult problems, SLEIGN2 can'
      y(4)=' be used as an investigative tool to' 
      x(5)='give qualitative and possibly quanti'
      y(5)='tative information on the spectrum. '
      x(6)='     For example, if a problem has a'
      y(6)=' continuous spectrum starting at L, '
      x(7)='then there may be no eigenvalue belo'
      y(7)='w L, any finite number of eigenval- '
      x(8)='ues below L, or an infinite (but cou'
      y(8)='ntable) number of eigenvalues below '
      x(9)='L. SLEIGN2 can be used to compute L '
      y(9)='(see the paper bewz on the sleign2  '
      x(10)='home page for an algorithm to comput'
      y(10)='e L), and determine the number of   '
      x(11)='these eigenvalues and compute them. '
      y(11)=' In this respect, see xamples.f: #13'
      x(12)='(Hydrogen Atom), #17 (Morse Oscillat'
      y(12)='or), #21 (Fourier), #27 (Joergens)  '
      x(13)='as examples of success; and #12 (Mat'
      y(13)='hieu), #14 (Marletta), and #28      '
      x(14)='(Behnke-Goerisch) as examples of fai'
      y(14)='lure.                               '
      x(15)='     The problem need not have a con'
      y(15)='tinuous spectrum, in which case if  '
      x(16)='its discrete spectrum is bounded bel'
      y(16)='ow, then the eigenvalues are indexed'
      x(17)='and the eigenfunctions have zero cou'
      y(17)='nts as in (1.).  If, on the other   '
      x(18)='hand, the discrete spectrum is unbou'
      y(18)='nded below, then all the eigenfunc- '
      x(19)='tions have infinitely many zeros in '
      y(19)='the open interval (a,b).  SLEIGN2   '   
      x(20)='can, in principle, compute these eig'
      y(20)='envalues if neither end-point is LP,'
      x(21)='although this is a computationally d'
      y(21)='ifficult problem.  Note, however,   '
      x(22)='that SLEIGN2 has no algorithm when t'
      y(22)='he spectrum is discrete, unbounded  '
      x(23)='above and below, and one end-point i'
      y(23)='s LP, as in xamples.f #30.          '
      do 1302 i = 1,23
        write(*,*) x(i),y(i)
 1302   continue
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)='  In respect to the three different '
      y(1)='types of indexing discussed above,  '
      x(2)='the following identified examples fr'
      y(2)='om xamples.f illustrate the spectral'
      x(3)='property of these boundary problems:'
      y(3)='                                    '
      x(4)='  1. Neither end-point is LP or LCO.'
      y(4)=' '
      x(5)='       #1 (Legendre)                '
      y(5)=' '
      x(6)='       #2 (Bessel) with -1/4 < c < 3'
      y(6)='/4                                  '
      x(7)='       #4 (Boyd)                    '
      y(7)=' '
      x(8)='       #5 (Latzko)                  '
      y(8)=' '
      x(9)='  2. Neither end-point is LP, but at'
      y(9)=' least one is LCO.                  '
      x(10)='       #6 (Sears-Titchmarsh)        '
      y(10)=' '
      x(11)='       #7 (BEZ)                     '
      y(11)=' '
      x(12)='      #19 (Donsch)                  '
      y(12)=' '
      x(13)='  3. At least one end-point is LP.  '
      y(13)=' '
      x(14)='      #13 (Hydrogen Atom)           '
      y(14)=' '
      x(15)='      #14 (Marletta)                '
      y(15)=' '
      x(16)='      #20 (Krall)                   '
      y(16)=' '
      x(17)='      #21 (Fourier) on [0,infinity) '
      y(17)=' '
      do 1303 i = 1,17
        write(*,*) x(i),y(i)
 1303   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
   14 CONTINUE
      write(*,*) 'H14:  Entry of eigenvalue index, initial guess,'//
     1           ' and tolerance.'
      x(1)='  For all self-adjoint boundary cond'
      y(1)='ition problems (see H7), SLEIGN2    '
      x(2)='calls for input information options '
      y(2)='to compute either                   '
      x(3)='  1. a single eigenvalue, or        '
      y(3)=' '
      x(4)='  2. a series of eigenvalues.       '
      y(4)=' '
      x(5)='In each case indexing of eigenvalues'
      y(5)=' is called for (see H13).           '
      x(6)='  (1.) above asks for data triples N'
      y(6)='UMEIG, EIG, TOL separated by commas.'
      x(7)='Here NUMEIG is the integer index of '
      y(7)='the desired eigenvalue; NUMEIG can  '
      x(8)='be negative only when the problem is'
      y(8)=' LCO at one or both end-points.     '
      x(9)='EIG allows for the entry of an initi'
      y(9)='al guess for the requested          '
      x(10)='eigenvalue (if an especially good on'
      y(10)='e is available), or can be set to 0 '
      x(11)='in which case an initial guess is ge'
      y(11)='nerated by SLEIGN2 itself.          '
      x(12)='TOL is the desired accuracy of the c'
      y(12)='omputed eigenvalue.  It is an       '
      x(13)='absolute accuracy if the magnitude o'
      y(13)='f the eigenvalue is 1 or less, and  '
      x(14)='is a relative accuracy otherwise.  T'
      y(14)='ypical values might be .001 for     '
      x(15)='moderate accuracy and .0000001 for h'
      y(15)='igh accuracy in single precision.   '
      x(16)='If TOL is set to 0, the maximum achi'
      y(16)='evable accuracy is requested.       '
      x(17)='  If the input data list is truncate'
      y(17)='d with a "/" after NUMEIG or EIG,   '
      x(18)='then the remaining elements default '
      y(18)='to 0.                               '
      do 1401 i = 1,18
        write(*,*) x(i),y(i)
 1401   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      x(1)='  (2.) above asks for data triples N'
      y(1)='UMEIG1, NUMEIG2, TOL separated by   '
      x(2)='commas.  Here NUMEIG1 and NUMEIG2 ar'
      y(2)='e the first and last integer indices'
      x(3)='of the sequence of desired eigenvalu'
      y(3)='es, NUMEIG1 < NUMEIG2; they can be  '
      x(4)='negative only when the problem is LC'
      y(4)='O at one or both end-points.        '
      x(5)='TOL is the desired accuracy of the c'
      y(5)='omputed eigenvalues.  It is an      '
      x(6)='absolute accuracy if the magnitude o'
      y(6)='f an eigenvalue is 1 or less, and   '
      x(7)='is a relative accuracy otherwise.  T'
      y(7)='ypical values might be .001 for     '
      x(8)='moderate accuracy and .0000001 for h'
      y(8)='igh accuracy in single precision.   '
      x(9)='If TOL is set to 0, the maximum achi'
      y(9)='evable accuracy is requested.       '
      x(10)='  If the input data list is truncate'
      y(10)='d with a "/" after NUMEIG2, then TOL'
      x(11)='defaults to 0.                      '
      y(11)=' '
      x(12)='  For COUPLED self-adjoint boundary '
      y(12)='condition problems (see H7 and H17),'
      x(13)='SLEIGN2 also reports which eigenvalu'
      y(13)='es are double.  Double eigenvalues  '
      x(14)='can occur only for coupled boundary '
      y(14)='conditions with alpha = 0 or pi.    ' 
      do 1402 i = 1,14
        write(*,*) x(i),y(i)
 1402   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
   15 CONTINUE
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) 'H15:  IFLAG information.'
      x(1)='  All results are reported by SLEIGN'
      y(1)='2 with a flag identification.  There'
      x(2)='are four values of IFLAG:           '
      y(2)=' '
      x(3)=' '
      y(3)=' '
      x(4)='  1 - The computed eigenvalue has an'
      y(4)=' estimated accuracy within the      '
      x(5)='      tolerance requested.          '
      y(5)=' '
      x(6)=' '
      y(6)=' '
      x(7)='  2 - The computed eigenvalue does n'
      y(7)='ot have an estimated accuracy within'
      x(8)='      the tolerance requested, but i'
      y(8)='s the best the program could obtain.'
      x(9)=' '
      y(9)=' '
      x(10)='  3 - There seems to be no eigenvalu'
      y(10)='e of index equal to NUMEIG.         '
      x(11)=' '
      y(11)=' '
      x(12)='  4 - The program has been unable to'
      y(12)=' compute the requested eigenvalue.  '
      do 1501 i = 1,12
        write(*,*) x(i),y(i)
 1501   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
   16 CONTINUE
      write(*,*) 'H16:  Plotting.'
      x(1)='  After computing a single eigenvalu'
      y(1)='e (see H14(1.)), but not a sequence '
      x(2)='of eigenvalues (see H14(2.)), the ei'
      y(2)='genfunction can be plotted for sepa-'
      x(3)='rated conditions and for coupled one'
      y(3)='s with alpha = 0 or pi.  When alpha '
      x(4)='is not zero or pi the eigenfunctions'
      y(4)=' are not real-valued and so no plot '
      x(5)='is provided.  If this is desired, re'
      y(5)='spond "y" when asked so that SLEIGN2'
      x(6)='will compute some eigenfunction data'
      y(6)=' and store them.                    '
      x(7)='  One can ask that the eigenfunction'
      y(7)=' data be in the form of either      '
      x(8)='points (x,y) for x in (a,b), or poin'
      y(8)='ts (t,y) for t in the standardized  '
      x(9)='interval (-1,1) mapped onto from (a,'
      y(9)='b); the t- choice can be especially '
      x(10)='helpful when the original interval i'
      y(10)='s infinite.  Additionally, one can  '
      x(11)='ask for a plot of the so-called Prue'
      y(11)='fer angle, in x- or t- variables.   '
      x(12)='  In both forms, once the choice has'
      y(12)=' been made of the function to be    '
      x(13)='plotted, a crude plot is displayed o'
      y(13)='n the monitor screen and you are    '
      x(14)='asked whether you wish to save the c'
      y(14)='omputed plot points in a file.      '
      do 1601 i = 1,14
        write(*,*) x(i),y(i)
 1601   continue
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*) ' '
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
   17 CONTINUE
      write(*,*) 'H17:  Indexing of eigenvalues for'//
     1           ' coupled self-adjoint problems.'
      x(1)='  The indexing of eigenvalues is an '
      y(1)='automatic facility in SLEIGN2.  The '
      x(2)='following general result holds for c'
      y(2)='oupled boundary condition problems  '
      x(3)='(see H7):                           '
      y(3)=' '
      x(4)='  The spectrum of the eigenvalue pro'
      y(4)='blem is discrete (eigenvalues only).'
      x(5)='In general the spectrum is not simpl'
      y(5)='e, but no eigenvalue exceeds multi- '
      x(6)='plicity 2.The eigenvalues are indexe'
      y(6)='d as {lambda(n): n=0,1,2,...}, where'
      x(7)='lambda(n) .le. lambda(n+1) (n=0,1,2,'
      y(7)='...), lim lambda(n) -> +infinity if '
      x(8)='neither end-point is LCO.  If one or'
      y(8)=' both end-points are LCO the eigen- '
      x(9)='values cluster at both +infinity and'
      y(9)=' at -infinity, and all eigenfunc-   '
      x(10)='tions have infinitely many zeros.   '
      y(10)='                                    '
      x(11)='  If neither end-point is LCO and al'
      y(11)='pha = 0 or pi, then the n-th eigen- '
      x(12)='function has n-1, n, or n+1 zeros in'
      y(12)=' the half-open interval [a,b) (also '
      x(13)='in (a,b]).  All three possibilities '
      y(13)='occur.  Recall that in the case of  '
      x(14)='double eigenvalues, although the n-t'
      y(14)='h eigenvalue is well-defined, there '
      x(15)='is an ambiguity about which solution'
      y(15)=' is declared the n-th eigenfunction.'
      x(16)='  If alpha is not 0 or pi, then the '
      y(16)='eigenfunction is non-real and has no'
      x(17)='zero in (a,b); but each of the real '
      y(17)='and imaginary parts of the n-th ei- '
      x(18)='genfunction have the same zero prope'
      y(18)='rties as mentioned above when alpha '
      x(19)='= 0 or pi.                          '
      y(19)=' '
      do 1651 i = 1,19
        write(*,*) x(i),y(i)
 1651   continue    
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      x(1)='  The following identified examples '
      y(1)='from xamples.f are of special inter-'
      x(2)='est:                                '
      y(2)=' '
      x(3)='    #11 (Plum) on [0,pi]           '
      y(3)=' '
      x(4)='    #21 (Fourier) on [0,pi]        '
      y(4)=' '
      x(5)='    #25 (Meissner) on [-0.5,0.5]   '
      y(5)=' '
      do 1701 i = 1,5
        write(*,*) x(i),y(i)
 1701   continue
      write(*,*) ' '
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      write(*,*)
      read(*,999) ans,n
      if (ans.eq.'r' .or. ans.eq.'R') return
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17),N
      go to 1
  999 FORMAT(A1,I2)
      end
SHAR_EOF
fi # end of overwriting check
if test -f 'res1'
then
	echo shar: will not over-write existing file "'res1'"
else
cat << "SHAR_EOF" > 'res1'
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NUMBER OF ITERATIONS WAS            1
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NUMBER OF ITERATIONS WAS            2
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NUMBER OF ITERATIONS WAS            3
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  BRACKET 
  DO SECANT METHOD 
  NUMBER OF ITERATIONS WAS            4
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NEWTON'S METHOD 
  NUMBER OF ITERATIONS WAS            5
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NEWTON'S METHOD 
  NUMBER OF ITERATIONS WAS            6
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NEWTON'S METHOD 
  NUMBER OF ITERATIONS WAS            7
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NUMBER OF ITERATIONS WAS            1
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  BRACKET 
  DO SECANT METHOD 
  NUMBER OF ITERATIONS WAS            2
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NRAY =            2
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NUMBER OF ITERATIONS WAS            1
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NUMBER OF ITERATIONS WAS            2
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  BRACKET 
  DO SECANT METHOD 
  NUMBER OF ITERATIONS WAS            3
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NEWTON'S METHOD 
  NUMBER OF ITERATIONS WAS            4
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            3
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NUMBER OF ITERATIONS WAS            5
 -----------------------------------------
  tol =    1.000000E-02
  NUMEIG, EIG, TOL, IFLAG =            3   129.1077       1.000000E-02
           1
  EIGENFUNCTION 
   2.439024E-02  0.1843239    
   4.878049E-02  0.3875616    
   7.317073E-02  0.5925087    
   9.756097E-02  0.7730039    
  0.1219512      0.9096436    
  0.1463415      0.9882429    
  0.1707317       1.000000    
  0.1951219      0.9418139    
  0.2195122      0.8163515    
  0.2439024      0.6317391    
  0.2682927      0.4008913    
  0.2926829      0.1404982    
  0.3170732     -0.1302928    
  0.3414634     -0.3913654    
  0.3658537     -0.6231784    
  0.3902439     -0.8082872    
  0.4146341     -0.9326829    
  0.4390244     -0.9868982    
  0.4634146     -0.9667394    
  0.4878049     -0.8736328    
  0.5121951     -0.7145320    
  0.5365854     -0.5014054    
  0.5609756     -0.2503364    
  0.5853658       1.968684E-02
  0.6097561      0.2882183    
  0.6341463      0.5348929    
  0.6585366      0.7409933    
  0.6829268      0.8908585    
  0.7073171      0.9730875    
  0.7317073      0.9814129    
  0.7560976      0.9151979    
  0.7804878      0.7794352    
  0.8048781      0.5844262    
  0.8292683      0.3449862    
  0.8536586       7.931010E-02
  0.8780488     -0.1923980    
  0.9024390     -0.4494697    
  0.9268293     -0.6723418    
  0.9512195     -0.8440480    
  0.9756098     -0.9515125    
SHAR_EOF
fi # end of overwriting check
if test -f 'res2'
then
	echo shar: will not over-write existing file "'res2'"
else
cat << "SHAR_EOF" > 'res2'
  np =            1
  a =   -1.000000    
    P0ATA,QFATA =    1.000000       1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lcno                                                          
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.2500000       0.000000E+00
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   2.250013       1.623200E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   6.250016       1.237014E-07
 
 ______________________________________________
  np =            1
  a =    0.000000E+00
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lcno                                                          
    B1,B2 =    0.000000E+00   1.000000    
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.2499998       1.023036E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   9.137038       1.466703E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   26.07486       1.291642E-08
 
 ______________________________________________
  np =            2
  param =   0.7500000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   12.18714       2.341864E-08
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   44.25756       4.609519E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   96.07160       3.908298E-08
 
 ______________________________________________
  np =            2
  param =   0.7500000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    0.000000E+00   1.000000    
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0   1.120459       1.548081E-04
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   18.35443       3.618022E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   55.36758       2.305809E-06
 
 ______________________________________________
  np =            2
  param =   0.7500000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            3
  * THERE SEEM TO BE NO EIGENVALUES                *
  IFLAG =            3
  * THERE SEEM TO BE NO EIGENVALUES                *
  IFLAG =            3
  * THERE SEEM TO BE NO EIGENVALUES                *
 
  * THERE SEEMS TO BE CONTINUOUS SPECTRUM BEGINNING*
  * AT ABOUT 4.7D-11                               *
 ______________________________________________
  np =            3
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000       1.000000    
    CLASSA = wr                                                            
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lcno                                                          
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   5.783186       4.544096E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   30.47117       1.332183E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   74.88702       2.554860E-07
 
 ______________________________________________
  np =            4
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   7.373990       3.599457E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   36.33601       1.710510E-10
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   85.29259       1.761736E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   154.0986       1.039524E-11
  IFLAG =            2
  NUMEIG,EIG,TOL =            4   242.7056       2.162225E-07
 
 ______________________________________________
  np =            4
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    0.000000E+00   1.000000    
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.9843206       9.071464E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   21.96709       3.192975E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   62.12804       4.399757E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   121.8128       3.678471E-09
  IFLAG =            2
  NUMEIG,EIG,TOL =            4   201.1194       8.829408E-07
 
 ______________________________________________
  np =            5
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = wr                                                            
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   7.374030       3.380070E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   36.33622       1.018603E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   85.29340       1.945537E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   154.0990       2.410782E-08
  IFLAG =            2
  NUMEIG,EIG,TOL =            4   242.7072       1.852725E-06
 
 ______________________________________________
  np =            5
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = wr                                                            
    A1,A2 =    1.000000       1.000000    
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0  0.9845399       5.873397E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   21.97102       1.285538E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   62.12859       2.196669E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   121.8127       9.634303E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            4   201.1203       3.318861E-08
 
 ______________________________________________
  np =            6
  a =    1.000000    
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lco                                                           
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =           -2           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =           -2  -16.00223       3.667952E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =           -1  -3.802630       1.203780E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =            0   4.435460       4.053261E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   14.82855       2.022616E-04
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   27.72313       2.671632E-05
 
 ______________________________________________
  np =            6
  a =    1.000000    
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lco                                                           
    B1,B2 =    0.000000E+00   1.000000    
  NUMEIG1,NUMEIG2 =           -2           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =           -2  -25.02998       5.644441E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =           -1  -8.987889       1.573901E-06
  IFLAG =            2
  NUMEIG,EIG,TOL =            0  0.2879478       3.573658E-06
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   9.277247       3.890050E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   20.99024       4.662531E-05
 
 ______________________________________________
  np =            7
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000      -1.000000    
    CLASSA = lco                                                           
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =           -2           3
 
  IFLAG =            2
  NUMEIG,EIG,TOL =           -2  -127.0453       5.035825E-03
  IFLAG =            1
  NUMEIG,EIG,TOL =           -1  -5.426962       2.222912E-04
  IFLAG =            2
  NUMEIG,EIG,TOL =            0   4.397848       1.330141E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   18.12068       2.112323E-04
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   37.92352       2.845487E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   63.47567       3.562436E-04
 
 ______________________________________________
  np =            7
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000      -1.000000    
    CLASSA = lco                                                           
    A1,A2 =    0.000000E+00   1.000000    
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =           -1           5
 
  IFLAG =            1
  NUMEIG,EIG,TOL =           -1  -26.36498       2.824862E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   2.995483E-06   8.032315E-11
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   10.44947       4.732026E-05
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   27.29205       6.729619E-05
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   50.02732       8.700747E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =            4   78.38776       1.063048E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            5   112.2355       1.232737E-04
 
 ______________________________________________
  np =            7
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000      -1.000000    
    CLASSA = lco                                                           
  b =    1.000000    
    CLASSB = r                                                             
     ALFA =    0.000000E+00
  K11,K12 =    1.000000       0.000000E+00
  K21,K22 =    0.000000E+00   1.000000    
  DET =    1.000000    
  NUMEIG1,NUMEIG2 =           -1           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =           -1  -1.752737       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   14.57461       9.999999E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   21.87494       9.999999E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   55.57359       9.999999E-04
 ______________________________________________
  np =            8
  param =    1.000000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           1
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   30.39583       4.436753E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   102.4421       1.380663E-07
 
 ______________________________________________
  np =            8
  param =    1.000000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    0.000000E+00   1.000000    
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0  -1.514330       2.616173E-04
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   42.21439       4.138282E-06
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   127.6121       3.991765E-07
 
 ______________________________________________
  np =            8
  param =  -0.5000000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           1
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   24.46245       2.042590E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   94.09742       2.174501E-07
 
 ______________________________________________
  np =            8
  param =  -0.5000000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    0.000000E+00   1.000000    
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0   4.912322       1.612672E-05
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   45.86612       5.685998E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   131.0852       1.559603E-07
 
 ______________________________________________
  np =            9
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000       1.000000    
    CLASSA = wr                                                            
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lcno                                                          
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   8.727497       4.274168E-08
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   152.4240       2.811454E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   435.0685       1.277678E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            3   855.5906       9.064525E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            4   1413.968       2.679770E-07
 
 ______________________________________________
  np =            9
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000       1.000000    
    CLASSA = wr                                                            
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lcno                                                          
    B1,B2 =    0.000000E+00   1.000000    
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -11.44399       4.113226E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   110.5386       6.395486E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   376.0186       4.195959E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            3   780.8220       6.603556E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            4   1323.937       1.283997E-06
 
 ______________________________________________
  np =           10
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = wr                                                            
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0   2.467553       6.290385E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   9.870468       2.631066E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   22.20890       1.097374E-06
 
 ______________________________________________
  np =           11
  a =    0.000000E+00
    CLASSA = r                                                             
  b =    3.141593    
    CLASSB = r                                                             
     ALFA =    0.000000E+00
  K11,K12 =    1.000000       0.000000E+00
  K21,K22 =    0.000000E+00   1.000000    
  DET =    1.000000    
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   9.743221       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   28.68514       9.999999E-05
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   46.47783       1.000000E-02
 ______________________________________________
  np =           12
  param =    5.000000    
  a =    0.000000E+00
    CLASSA = r                                                             
  b =    3.141593    
    CLASSB = r                                                             
     ALFA =    0.000000E+00
  K11,K12 =    1.000000       0.000000E+00
  K21,K22 =    0.000000E+00   1.000000    
  DET =    1.000000    
  NUMEIG1,NUMEIG2 =            0           6
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -5.800044       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   2.099460       9.999999E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   7.449109       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   16.64823       9.999999E-05
  IFLAG =            1
  NUMEIG,EIG,TOL =            4   17.09656       9.999999E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =            5   36.36221       9.999999E-05
  THIS EIGENVALUE APPEARS TO BE DOUBLE. 
  IFLAG =            2
  NUMEIG,EIG,TOL =            6   36.35990       9.999999E-05
  THIS EIGENVALUE APPEARS TO BE DOUBLE. 
 ______________________________________________
  np =           13
  param =   -1.000000       2.000000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -6.250001E-02   8.235754E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            1  -2.777767E-02   1.189267E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2  -1.562498E-02   8.267769E-09
 
  * THERE SEEMS TO BE CONTINUOUS SPECTRUM BEGINNING*
  * AT ABOUT-1.2D-05                               *
 ______________________________________________
  np =           14
  a =    0.000000E+00
    CLASSA = r                                                             
    A1,A2 =    5.000000       8.000000    
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0  -1.185215       4.098948E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            1  -1.476557E-08   3.537459E-08
  IFLAG =            3
  * THERE SEEMS TO BE NO EIGENVALUE OF INDEX       *
  * GREATER THAN    1                              *
 
  * THERE SEEMS TO BE CONTINUOUS SPECTRUM BEGINNING*
  * AT ABOUT 1.1D-10                               *
 ______________________________________________
  np =           15
  A =  -INF
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.9999987       6.143419E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   3.000000       2.887227E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   5.000000       8.709401E-08
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           16
  param =  -0.5000000      -1.200000    
  a =   -1.000000    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  b =    1.000000    
    P0ATB,QFATB =    1.000000      -1.000000    
    CLASSB = wr                                                            
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   1.700078       2.990736E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   5.400301       8.815109E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   11.10050       1.304223E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           16
  param =   0.5000000      -1.200000    
  a =   -1.000000    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lcno                                                          
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   1.799999       5.350955E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   5.499990       9.523299E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   11.19997       1.594841E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           16
  param =    1.200000      -1.200000    
  a =   -1.000000    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   2.640180       4.102007E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   7.040290       1.490146E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   13.44038       3.013832E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           16
  param =   0.5000000     -0.5000000    
  a =   -1.000000    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = wr                                                            
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lcno                                                          
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.7499469       4.251627E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   3.750189       3.303244E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   8.750423       6.691114E-10
 
 ______________________________________________
  np =           16
  param =    1.200000     -0.5000000    
  a =   -1.000000    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = wr                                                            
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   1.099910       3.079692E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   4.800034       5.082312E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   10.50054       1.541088E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           16
  param =    1.200000      0.5000000    
  a =   -1.000000    
    P0ATA,QFATA =    1.000000       1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -5.398488E-08   1.390756E-16
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   3.700003       4.963928E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   9.400015       3.097163E-08
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           17
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           3
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -1923.530       3.816839E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1  -1777.291       2.584533E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2  -1636.832       5.421725E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            3  -1502.155       1.277586E-07
 
  * THERE SEEMS TO BE CONTINUOUS SPECTRUM BEGINNING*
  * AT ABOUT 3.0D-10                               *
 ______________________________________________
  np =           18
  param =   0.2000000      0.6000000    
  a =   -1.000000    
    P0ATA,QFATA =    1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000      -1.000000    
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   1.440026       7.188100E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   5.040562       4.372558E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   10.64384       1.023286E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           19
  param =   0.5000000      0.2000000    
  a =   -1.000000    
    P0ATA,QFATA =    1.000000      -1.000000    
    CLASSA = lco                                                           
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000      -1.000000    
    CLASSB = lcno                                                          
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =           -1           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =           -1  -8.299860E-02   6.689788E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   6.000289E-02   4.372909E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   3.281972       1.093854E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   8.923641       1.553110E-06
 
 ______________________________________________
  np =           19
  param =   0.5000000      0.6000000    
  a =   -1.000000    
    P0ATA,QFATA =    1.000000      -1.000000    
    CLASSA = lco                                                           
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000      -1.000000    
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           3
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0  0.9507382       7.565559E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   5.211924       5.710576E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   11.79338       2.395671E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   20.61071       3.544208E-06
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           20
  param =    1.000000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lco                                                           
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =           -2           1
 
  IFLAG =            2
  NUMEIG,EIG,TOL =           -2  -27122.01       5.806144E-05
  IFLAG =            1
  NUMEIG,EIG,TOL =           -1  -49.63317       7.235560E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.9054454       2.386840E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            1  0.9999983       8.324409E-05
 
  * THERE SEEMS TO BE CONTINUOUS SPECTRUM BEGINNING*
  * AT ABOUT 1.0D+00                               *
 ______________________________________________
  np =           21
  a =   -3.141593    
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  b =    3.141593    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.2500001       1.144485E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   1.000000       2.448057E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   2.250000       6.745866E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   4.000002       2.448005E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            4   6.250000       0.000000E+00
 
 ______________________________________________
  np =           21
  a =   -3.141593    
    CLASSA = r                                                             
  b =    3.141593    
    CLASSB = r                                                             
     ALFA =    0.000000E+00
  K11,K12 =    1.000000       0.000000E+00
  K21,K22 =    0.000000E+00   1.000000    
  DET =    1.000000    
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   2.320417E-08   1.000000E-02
  IFLAG =            2
  NUMEIG,EIG,TOL =            1  0.9999427       9.999999E-05
  THIS EIGENVALUE APPEARS TO BE DOUBLE. 
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   1.000098       9.999999E-05
  THIS EIGENVALUE APPEARS TO BE DOUBLE. 
  IFLAG =            2
  NUMEIG,EIG,TOL =            3   3.999958       9.999999E-05
  THIS EIGENVALUE APPEARS TO BE DOUBLE. 
  IFLAG =            2
  NUMEIG,EIG,TOL =            4   4.000043       9.999999E-05
  THIS EIGENVALUE APPEARS TO BE DOUBLE. 
 ______________________________________________
  np =           21
  a =   -3.141593    
    CLASSA = r                                                             
  b =    3.141593    
    CLASSB = r                                                             
  BCC = G 
     ALFA =   0.7853982    
  K11,K12 =    2.000000       1.000000    
  K21,K22 =    1.000000       1.000000    
  DET =    1.000000    
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -6.854099       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            1 -0.1724424       9.999999E-05
  IFLAG =            1
  NUMEIG,EIG,TOL =            2  0.6465324       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   1.418499       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            4   3.565771       1.000000E-02
 ______________________________________________
  np =           22
  param =    0.000000E+00
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000       1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   6.124560E-08   2.575899E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   1.000186       1.568899E-04
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   2.010715       2.899273E-03
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           22
  param =    0.000000E+00
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000       1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    0.000000E+00   1.000000    
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0 -0.7238111       2.172801E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            1  0.6250747       2.286314E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   1.679729       1.398322E-03
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           22
  param =   -1.200000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0   1.202147       1.578277E-04
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   2.212156       5.083272E-03
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   3.340242       2.599581E-02
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           22
  param =  -0.6000000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = wr                                                            
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.6000011       4.396054E-06
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   1.600965       3.857370E-04
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   2.625299       4.002534E-03
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           22
  param =   0.5000000    
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000       1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0   1.780892E-07   1.820222E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   1.000051       2.895401E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   2.003115       4.195821E-04
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           22
  param =   0.5000000    
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000       1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    0.000000E+00   1.000000    
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0 -0.5000198       6.353588E-06
  IFLAG =            1
  NUMEIG,EIG,TOL =            1  0.4999023       3.181945E-06
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   1.500451       1.243966E-04
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           22
  param =    1.200000    
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000       1.000000    
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   8.458892E-08   4.269161E-08
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   1.000191       5.363456E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =            2   2.007833       8.566619E-04
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           23
  param =    0.000000E+00
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            1           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   1.000001       2.562651E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   1.999999       2.370820E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           23
  param =   -1.200000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   1.200000       7.809699E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   2.200002       1.111408E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   3.200001       2.459040E-08
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           23
  param =   0.6000000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -8.116149E-08   1.256651E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   1.000001       6.992908E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   2.000000       1.059875E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           23
  param =   0.5000000    
  a =    0.000000E+00
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -4.362323E-08   2.176583E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   1.000001       7.033938E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   2.000000       6.459348E-08
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           23
  param =    1.200000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            2
  NUMEIG,EIG,TOL =            0   6.865588E-08   9.872200E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   1.000001       7.061217E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   2.000002       2.261668E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           24
  param =  -0.6000000      -1.200000    
  a =   -1.570796    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  b =    1.570796    
    P0ATB,QFATB =   -1.000000      -1.000000    
    CLASSB = lcno                                                          
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   1.800051       2.420128E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   5.600335       3.084510E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   11.40111       1.382167E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           24
  param =   0.5000000      -1.200000    
  a =   -1.570796    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  b =    1.570796    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   1.800046       7.490858E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   5.500312       3.105890E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   11.20105       9.322546E-08
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           24
  param =    1.200000      -1.200000    
  a =   -1.570796    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  b =    1.570796    
    P0ATB,QFATB =   -1.000000      -1.000000    
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   2.640177       8.986748E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   7.040959       3.714351E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   13.44289       2.551236E-08
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           24
  param =   0.5000000     -0.6000000    
  a =   -1.570796    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.570796    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.9000002       8.022207E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   4.000000       1.603900E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   9.100000       9.002807E-08
 
 ______________________________________________
  np =           24
  param =    1.200000     -0.6000000    
  a =   -1.570796    
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.570796    
    P0ATB,QFATB =   -1.000000      -1.000000    
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   1.320051       1.021804E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            1   5.120334       1.505382E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   10.92110       7.599379E-08
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           24
  param =    1.200000      0.5000000    
  a =   -1.570796    
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  b =    1.570796    
    P0ATB,QFATB =   -1.000000      -1.000000    
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   4.536696E-05   1.335018E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   3.700312       4.947385E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   9.401054       1.054291E-08
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           25
  a =  -0.5000000    
    CLASSA = r                                                             
  b =   0.5000000    
    CLASSB = r                                                             
     ALFA =   0.7853982    
  K11,K12 =    1.000000       0.000000E+00
  K21,K22 =    0.000000E+00   1.000000    
  DET =    1.000000    
  NUMEIG1,NUMEIG2 =            0           6
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.1223064       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   6.363539       9.999999E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   14.14196       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   35.20601       9.999999E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            4   43.99551       9.999999E-04
  IFLAG =            1
  NUMEIG,EIG,TOL =            5   77.54198       1.000000E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            6   100.8771       1.000000E-02
 ______________________________________________
  np =           26
  a =    0.000000E+00
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -766.1892       1.912871E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1  -591.2048       4.530190E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2  -447.9438       7.309772E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            3  -321.3208       2.424300E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            4  -205.2622       9.640413E-08
 
 ______________________________________________
  np =           27
  param =    2.000000    
  A =  -INF
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -2.250000       8.233463E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1 -0.2500021       2.631279E-07
  IFLAG =            3
  * THERE SEEMS TO BE NO EIGENVALUE OF INDEX       *
  * GREATER THAN    1                              *
 
  * THERE SEEMS TO BE CONTINUOUS SPECTRUM BEGINNING*
  * AT ABOUT 0.0D+00                               *
 ______________________________________________
  np =           28
  param =    2.000000    
  a =    0.000000E+00
    CLASSA = r                                                             
    A1,A2 =    0.000000E+00   1.000000    
  b =    3.141593    
    CLASSB = r                                                             
    B1,B2 =    0.000000E+00   1.000000    
  NUMEIG1,NUMEIG2 =            0           6
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.8782346       2.335631E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   2.466767       8.934072E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   5.100900       7.405345E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   10.01761       7.667311E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            4   17.00836       7.130479E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            5   26.00521       3.833846E-09
  IFLAG =            2
  NUMEIG,EIG,TOL =            6   37.00360       1.648778E-07
 
 ______________________________________________
  np =           29
  param =    1.000000    
  a =    0.000000E+00
    P0ATA,QFATA =   -1.000000      -1.000000    
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  0.9999998       1.103903E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   2.000000       2.793699E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   3.000001       8.900191E-08
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           30
  a =    0.000000E+00
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  b =    10.00000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           9
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -3.282521       6.474966E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1 -0.4411472       1.335193E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   1.695664       2.232077E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            3   2.576408       1.189793E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            4   4.218426       3.216729E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            5   4.704751       4.592186E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            6   6.049498       6.147590E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            7   7.899601       6.038611E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            8   9.502640       1.569990E-09
  IFLAG =            1
  NUMEIG,EIG,TOL =            9   11.08074       1.424450E-07
 
 ______________________________________________
  np =           30
  a =    0.000000E+00
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  b =    20.00000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           9
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -14.42148       4.630085E-08
  IFLAG =            2
  NUMEIG,EIG,TOL =            1  -8.788376       5.441314E-03
  IFLAG =            1
  NUMEIG,EIG,TOL =            2  -8.739977       5.730926E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            3  -4.288173       1.229574E-08
  IFLAG =            2
  NUMEIG,EIG,TOL =            4  -3.444830       1.178764E-02
  IFLAG =            2
  NUMEIG,EIG,TOL =            5  -3.282521       4.012191E-05
  IFLAG =            2
  NUMEIG,EIG,TOL =            6 -0.4411488       4.359679E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            7 -0.1536089       2.419883E-06
  IFLAG =            2
  NUMEIG,EIG,TOL =            8   1.579559       1.385482E-05
  IFLAG =            1
  NUMEIG,EIG,TOL =            9   1.695661       1.092819E-08
 
 ______________________________________________
  np =           30
  a =    0.000000E+00
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  b =    30.00000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           9
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -20.45948       1.222829E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1  -20.20757       2.214055E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2  -14.42148       2.849872E-09
  IFLAG =            2
  NUMEIG,EIG,TOL =            3  -13.59181       6.664543E-02
  IFLAG =            1
  NUMEIG,EIG,TOL =            4  -8.788380       9.831155E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            5  -8.739976       5.591357E-03
  IFLAG =            2
  NUMEIG,EIG,TOL =            6  -7.283415       1.000359    
  IFLAG =            2
  NUMEIG,EIG,TOL =            7  -7.255684      0.3026575    
  IFLAG =            2
  NUMEIG,EIG,TOL =            8  -4.288174       1.982404E-03
  IFLAG =            2
  NUMEIG,EIG,TOL =            9  -3.444951       6.913358E-07
 
 ______________________________________________
  np =           30
  a =    0.000000E+00
    CLASSA = r                                                             
    A1,A2 =    1.000000       0.000000E+00
  b =    40.00000    
    CLASSB = r                                                             
    B1,B2 =    1.000000       0.000000E+00
  NUMEIG1,NUMEIG2 =            0           9
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -31.95168       1.585298E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1  -26.05754       5.790772E-08
  IFLAG =            2
  NUMEIG,EIG,TOL =            2  -23.70292      0.1020873    
  IFLAG =            1
  NUMEIG,EIG,TOL =            3  -20.20758       8.424398E-08
  IFLAG =            2
  NUMEIG,EIG,TOL =            4  -18.58225      0.1109363    
  IFLAG =            2
  NUMEIG,EIG,TOL =            5  -15.72533      0.1145801    
  IFLAG =            1
  NUMEIG,EIG,TOL =            6  -14.42148       3.767827E-07
  IFLAG =            2
  NUMEIG,EIG,TOL =            7  -13.59178       7.223222E-02
  IFLAG =            2
  NUMEIG,EIG,TOL =            8  -11.38139      0.2459849    
  IFLAG =            1
  NUMEIG,EIG,TOL =            9  -8.788383       2.692789E-09
 
 ______________________________________________
  np =           31
  A =  -INF
    CLASSA = lp                                                            
  B = +INF
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           4
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0  -6.250001       3.659573E-08
  IFLAG =            1
  NUMEIG,EIG,TOL =            1  -2.249999       9.381459E-08
  IFLAG =            2
  NUMEIG,EIG,TOL =            2 -0.2500000       2.891981E-07
  IFLAG =            3
  * THERE SEEMS TO BE NO EIGENVALUE OF INDEX       *
  * GREATER THAN    2                              *
  IFLAG =            3
  * THERE SEEMS TO BE NO EIGENVALUE OF INDEX       *
  * GREATER THAN    2                              *
 
  * THERE SEEMS TO BE CONTINUOUS SPECTRUM BEGINNING*
  * AT ABOUT 0.0D+00                               *
 ______________________________________________
  np =           32
  param =    1.000000       4.000000       2.000000    
             1.500000       4.500000       1.000000    
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000       1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lp                                                            
  NUMEIG1,NUMEIG2 =            0           2
 
  IFLAG =            1
  NUMEIG,EIG,TOL =            0   1.801087       2.738954E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            1   10.27988       6.118663E-07
  IFLAG =            1
  NUMEIG,EIG,TOL =            2   21.70573       2.382815E-07
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
  np =           32
  param =    1.000000       4.000000       2.000000    
             1.500000       4.500000       1.000000    
  a =    0.000000E+00
    P0ATA,QFATA =    1.000000       1.000000    
    CLASSA = lcno                                                          
    A1,A2 =    1.000000       0.000000E+00
  b =    1.000000    
    P0ATB,QFATB =    1.000000       1.000000    
    CLASSB = lp                                                            
  NUMEIG =           18
 
  IFLAG =            2
  NUMEIG,EIG,TOL =           18   600.9661       3.787571E-06
 
  * THERE SEEMS TO BE NO CONTINUOUS SPECTRUM       *
 ______________________________________________
 end results.txt                                                   
SHAR_EOF
fi # end of overwriting check
if test -f 'res3'
then
	echo shar: will not over-write existing file "'res3'"
else
cat << "SHAR_EOF" > 'res3'
 
  ******************** 
  EIGENVALUE            2
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NUMBER OF ITERATIONS WAS            1
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            2
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  BRACKET 
  DO SECANT METHOD 
  NUMBER OF ITERATIONS WAS            2
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            2
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  BRACKET 
  DO SECANT METHOD 
  NUMBER OF ITERATIONS WAS            3
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            2
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NEWTON'S METHOD 
  NUMBER OF ITERATIONS WAS            4
 -----------------------------------------------
 
  ******************** 
  EIGENVALUE            2
  SET TMID AND BOUNDARY CONDITIONS 
  OBTAIN DTHETA 
  SET BRACKET 
  NUMBER OF ITERATIONS WAS            5
 -----------------------------------------
  NUMEIG, EIG, TOL, IFLAG =            2   96.07165       4.492589E-07
           1
  EIGENFUNCTION = 
   4.761905E-02  -1.416879    
   9.523810E-02  -1.359300    
  0.1428571      -1.228830    
  0.1904762      -1.032400    
  0.2380952     -0.7804999    
  0.2857143     -0.4866511    
  0.3333333     -0.1666390    
  0.3809524      0.1623511    
  0.4285714      0.4825928    
  0.4761905      0.7768494    
  0.5238096       1.029226    
  0.5714286       1.226115    
  0.6190476       1.356875    
  0.6666667       1.414441    
  0.7142857       1.395683    
  0.7619048       1.301583    
  0.8095238       1.137223    
  0.8571429      0.9114306    
  0.9047619      0.6364385    
  0.9523810      0.3270384    
SHAR_EOF
fi # end of overwriting check
if test -f 'xamples.f'
then
	echo shar: will not over-write existing file "'xamples.f'"
else
cat << "SHAR_EOF" > 'xamples.f'
C  SUBROUTINE EXAMP

C     **********
C     MARCH 1, 2001; P.B. BAILEY, W.N. EVERITT AND A. ZETTL
C     VERSION 1.2
C     **********

      SUBROUTINE EXAMP
C
C
C     THIS SUBROUTINE CONTAINS A SELECTION OF COEFFICIENT FUNCTIONS
C     p,q,w (AND POSSIBLY SUITABLE FUNCTIONS u,v WITH WHICH TO 
C     DEFINE BOUNDARY CONDITIONS AT LIMIT CIRCLE ENDPOINTS) 
C     WHICH DEFINE SOME INTERESTING STURM-LIOUVILLE BOUNDARY
C     VALUE PROBLEMS. IT CAN BE CALLED BY THE MAIN PROGRAM, DRIVE.
C
C     .. Scalars in Common ..
      REAL A,ALPHA,B,BETA,C,D,E,GAMMA,H,K,L,NU,S
      INTEGER NUMBER
C     ..
C     .. Local Scalars ..
      REAL TMP
      INTEGER MUMBER
      CHARACTER ANS
C     ..
C     .. Common blocks ..
      COMMON /FLAG/NUMBER
      COMMON /PAR/NU,H,K,L,ALPHA,BETA,GAMMA,S,A,B,C,D,E
C     ..
      WRITE (*,FMT=*)
     +  ' Here is a collection of 32 differential equations '
      WRITE (*,FMT=*) ' which can be used with SLEIGN2.  By typing an '
      WRITE (*,FMT=*)
     +  ' integer from 1 to 32, one of these differential '
      WRITE (*,FMT=*)
     +  ' equations is selected, whereupon its coefficient '
      WRITE (*,FMT=*) ' functions p,q,w will be displayed along with a '
      WRITE (*,FMT=*) ' brief description of its singular points.  The'
      WRITE (*,FMT=*) ' endpoints a, b of the interval over which the '
      WRITE (*,FMT=*)
     +  ' differential equation is integrated are specified '
      WRITE (*,FMT=*) ' later; any interval which does not contain '
      WRITE (*,FMT=*) ' singular points in its interior is acceptable. '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' DO YOU WISH TO CONTINUE ? (Y/N) '
      READ (*,FMT=*) ANS
      IF (.NOT. (ANS.EQ.'y'.OR.ANS.EQ.'Y')) STOP
   35 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) '  1 IS THE LEGENDRE EQUATION '
      WRITE (*,FMT=*) '  2 IS THE BESSEL EQUATION '
      WRITE (*,FMT=*) '  3 IS THE HALVORSEN EQUATION '
      WRITE (*,FMT=*) '  4 IS THE BOYD EQUATION '
      WRITE (*,FMT=*) '  5 IS THE REGULARIZED BOYD EQUATION '
      WRITE (*,FMT=*) '  6 IS THE SEARS-TITCHMARSH EQUATION '
      WRITE (*,FMT=*) '  7 IS THE BEZ EQUATION '
      WRITE (*,FMT=*) '  8 IS THE LAPLACE TIDAL WAVE EQUATION '
      WRITE (*,FMT=*) '  9 IS THE LATZKO EQUATION '
      WRITE (*,FMT=*) ' 10 IS A WEAKLY REGULAR EQUATION '
      WRITE (*,FMT=*) ' 11 IS THE PLUM EQUATION '
      WRITE (*,FMT=*) ' 12 IS THE MATHIEU PERIODIC EQUATION '
      WRITE (*,FMT=*) ' 13 IS THE HYDROGEN ATOM EQUATION '
      WRITE (*,FMT=*) ' 14 IS THE MARLETTA EQUATION '
      WRITE (*,FMT=*) ' 15 IS THE HARMONIC OSCILLATOR EQUATION '
      WRITE (*,FMT=*) ' 16 IS THE JACOBI EQUATION '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' Press any key to continue. '
      READ (*,FMT=9010) ANS
 9010 FORMAT (A1)
      WRITE (*,FMT=*) ' 17 IS THE ROTATION MORSE OSCILLATOR EQUATION '
      WRITE (*,FMT=*) ' 18 IS THE DUNSCH EQUATION '
      WRITE (*,FMT=*) ' 19 IS THE DONSCH EQUATION '
      WRITE (*,FMT=*) ' 20 IS THE KRALL EQUATION '
      WRITE (*,FMT=*) ' 21 IS THE FOURIER EQUATION '
      WRITE (*,FMT=*) ' 22 IS THE LAGUERRE EQUATION '
      WRITE (*,FMT=*) ' 23 IS THE LAGUERRE/LIOUVILLE FORM EQUATION '
      WRITE (*,FMT=*) ' 24 IS THE JACOBI/LIOUVILLE FORM EQUATION '
      WRITE (*,FMT=*) ' 25 IS THE MEISSNER EQUATION '
      WRITE (*,FMT=*) ' 26 IS THE LOHNER EQUATION '
      WRITE (*,FMT=*) ' 27 IS THE JOERGENS EQUATION '
      WRITE (*,FMT=*) ' 28 IS THE BEHNKE-GOERISCH EQUATION '
      WRITE (*,FMT=*) ' 29 IS THE WHITTAKER EQUATION '
      WRITE (*,FMT=*) ' 30 IS THE LITTLEWOOD-MCLEOD EQUATION '
      WRITE (*,FMT=*) ' 31 IS THE MORSE EQUATION '
      WRITE (*,FMT=*) ' 32 IS THE HEUN EQUATION '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' ENTER THE NUMBER OF YOUR CHOICE: '
      READ (*,FMT=*) NUMBER
      IF (NUMBER.LT.1 .OR. NUMBER.GT.32) GO TO 35
      MUMBER = NUMBER
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
     +       23,24,25,26,27,28,29,30,31,32) NUMBER
C
    1 CONTINUE
      WRITE (*,FMT=*) '    -(p*y'')'' + q*y = lambda*w*y on (-1,1) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1 - x*x, q = 1/4, w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT CIRCLE, NON-OSCILLATORY AT -1. '
      WRITE (*,FMT=*) ' LIMIT CIRCLE, NON-OSCILLATORY AT +1. '
      GO TO 40
C
    2 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = (nu*nu-0.25)/x*x, w = 1 '
      WRITE (*,FMT=*) '            (nu a parameter) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' THE ENDPOINT X = 0: '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '       FOR -1.LT.nu.LT.1 BUT nu*nu.NE.0.25. '
      WRITE (*,FMT=*) '    REGULAR FOR nu*nu = 0.25. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR nu*nu.GE.1.0. '
      WRITE (*,FMT=*) ' THE ENDPOINT X = +INFINITY: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR ALL nu. '
      MUMBER = 101
      GO TO 40
C
    3 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 0, w = exp(-2/x)/x**4 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' WEAKLY REGULAR AT 0. '
      WRITE (*,FMT=*) ' LIMIT CIRCLE, NON-OSCILLATORY AT +INFINITY. '
      GO TO 40
C
    4 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity,0) '
      WRITE (*,FMT=*)
     +  '                            AND on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = -1/x, w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT CIRCLE, NON-OSCILLATORY AT 0+ AND 0-. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
    5 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity,0) '
      WRITE (*,FMT=*)
     +  '                            AND on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = r*r, q = -r*r*(ln|x|)**2, w = r*r '
      WRITE (*,FMT=*) '      where r = exp(-(x*ln(|x|)-x)) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' WEAKLY REGULAR AT 0+ AND 0-. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
    6 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = x, q = -x, w = 1/x '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT 0. '
      WRITE (*,FMT=*) ' LIMIT CIRCLE, OSCILLATORY AT +INFINITY. '
      GO TO 40
C
    7 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity,0) '
      WRITE (*,FMT=*)
     +  '                            AND on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = x, q = -1/x, w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT CIRCLE, OSCILLATORY AT 0+ AND 0-. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
    8 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1/x, q = (k/x**2) + (k**2/x), w = 1 '
      WRITE (*,FMT=*) '         (k a non-zero parameter) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT CIRCLE, NON-OSCILLATORY AT 0. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      MUMBER = 102
      GO TO 40
C
    9 CONTINUE
      WRITE (*,FMT=*) '    -(p*y'')'' + q*y = lambda*w*y on (0,1) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1 - x**7, q = 0, w = x**7 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' WEAKLY REGULAR AT 0. '
      WRITE (*,FMT=*) ' LIMIT CIRCLE, NON-OSCILLATORY AT +1. '
      GO TO 40
C
   10 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = sqrt(x), q = 0, w = 1/sqrt(x) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' WEAKLY REGULAR AT 0. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   11 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity, '
      WRITE (*,FMT=*) '                                    +infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 100*cos(x)**2, w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   12 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity, '
      WRITE (*,FMT=*) '                                    +infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 2*k*cos(2x), w = 1 '
      WRITE (*,FMT=*) '       (k a non-zero parameter) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      MUMBER = 103
      GO TO 40
C
   13 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = k/x + h/x**2, w = 1 '
      WRITE (*,FMT=*) '        q = k/x + h/x**2 + 1  if h.lt.-0.25  '
      WRITE (*,FMT=*) '        (h,k parameters) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' THE ENDPOINT X = 0: '
      WRITE (*,FMT=*) '    REGULAR for h = k = 0. '
      WRITE (*,FMT=*) '    LIMIT-CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '       FOR h = 0 AND ALL k.NE.0. '
      WRITE (*,FMT=*) '    LIMIT-CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*)
     +  '       FOR -0.25.LE.h.LT.0.75 BUT h.NE.0, AND ALL k. '
      WRITE (*,FMT=*) '    LIMIT-CIRCLE, OSCILLATORY '
      WRITE (*,FMT=*) '       FOR h.LT.-0.25 AND ALL k. '
      WRITE (*,FMT=*) '      (Here, 1 has been added to the usual q so '
      WRITE (*,FMT=*) '       at least some eigenvalues are positive.) '
      WRITE (*,FMT=*) '    LIMIT POINT FOR h.GE.0.75 AND ALL k. '
      WRITE (*,FMT=*) ' THE ENDPOINT X = +INFINITY: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR ALL h,k. '
      MUMBER = 104
      GO TO 40
C
   14 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' p = 1, q = 3.0*(X-31.0)/(4.0*(X+1.0)*(4.0+X)**2), '
      WRITE (*,FMT=*) ' w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' REGULAR AT 0. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   15 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity, '
      WRITE (*,FMT=*) '                                    +infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = x*x, w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   16 CONTINUE
      WRITE (*,FMT=*) '    -(p*y'')'' + q*y = lambda*w*y on (-1,1) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = (1-x)**(alpha+1)*(1+x)**(beta+1), '
      WRITE (*,FMT=*) ' q = 0, w = (1-x)**alpha*(1+x)**beta '
      WRITE (*,FMT=*) '            (alpha, beta parameters) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' THE ENDPOINT X = -1.0: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR beta.LE.-1. '
      WRITE (*,FMT=*) '    WEAKLY REGULAR FOR -1.LT.beta.LT.0. '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '       FOR 0.LE.beta.LT.1. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR beta.GE.1. '
      WRITE (*,FMT=*) ' THE ENDPOINT X = +1.0: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR alpha.LE.-1. '
      WRITE (*,FMT=*) '    WEAKLY REGULAR FOR -1.LT.alpha.LT.0. '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '       FOR 0.LE.alpha.LT.1. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR alpha.GE.1. '
      MUMBER = 105
      GO TO 40
C
   17 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 2/x**2 - 2000(2e-e*e), w = 1 '
      WRITE (*,FMT=*) '       where e = exp(-1.7(x-1.3)) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT 0. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   18 CONTINUE
      WRITE (*,FMT=*) '    -(p*y'')'' + q*y = lambda*w*y on (-1,1) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' p = 1 - x*x, q = 2*alpha**2/(1+x) + 2*beta**2/(1-x),'
      WRITE (*,FMT=*)
     +  ' w = 1        (alpha, beta non-negative parameters) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' THE ENDPOINT X = -1.0: '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '       FOR 0.LE.alpha.LT.0.5. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR alpha.GE.0.5. '
      WRITE (*,FMT=*) ' THE ENDPOINT X = +1.0: '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '       FOR 0.LE.beta.LT.0.5. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR beta.GE.0.5. '
      MUMBER = 106
      GO TO 40
C
   19 CONTINUE
      WRITE (*,FMT=*) '    -(p*y'')'' + q*y = lambda*w*y on (-1,1) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' p = 1 - x*x, q = -2*gamma**2/(1+x) +2*beta**2/(1-x),'
      WRITE (*,FMT=*) ' w = 1            (gamma, beta parameters) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' THE ENDPOINT X = -1.0: '
      WRITE (*,FMT=*)
     +  '    LIMIT CIRCLE, NON-OSCILLATORY FOR gamma = 0. '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, OSCILLATORY FOR gamma.GT.0. '
      WRITE (*,FMT=*) ' THE ENDPOINT X = +1.0: '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '       FOR 0.LE.beta.LT.0.5. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR beta.GE.0.5. '
      MUMBER = 107
      GO TO 40
C
   20 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 1 - (k**2+0.25)/x**2, w = 1 '
      WRITE (*,FMT=*) '        (k a positive parameter) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT CIRCLE, OSCILLATORY AT 0. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      MUMBER = 108
      GO TO 40
C
   21 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity, '
      WRITE (*,FMT=*) '                                    +infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 0, w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   22 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = x**(alpha+1)*exp(-x), w = x**alpha*exp(-x) '
      WRITE (*,FMT=*) ' q = 0        (alpha a parameter) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' THE ENDPOINT X = 0.: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR alpha.LE.-1. '
      WRITE (*,FMT=*) '    WEAKLY REGULAR FOR -1.LT.alpha.LT.0. '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '       FOR 0.LE.alpha.LT.1. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR alpha.GE.1. '
      WRITE (*,FMT=*) ' THE ENDPOINT X = +INFINITY: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR ALL alpha. '
      MUMBER = 109
      GO TO 40
C
   23 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, w = 1 '
      WRITE (*,FMT=*)
     +  ' q = (alpha**2-0.25)/x**2 - (alpha+1)/2 + x**2/16'
      WRITE (*,FMT=*) '              (alpha a parameter) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' THE ENDPOINT X = 0.: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR alpha.LE.-1. '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*)
     +  '       FOR -1.LT.alpha.LT.1 BUT alpha**2.NE.0.25. '
      WRITE (*,FMT=*) '    REGULAR FOR alpha**2 = 0.25. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR alpha.GE.1. '
      WRITE (*,FMT=*) ' THE ENDPOINT X = +INFINITY: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR ALL alpha. '
      MUMBER = 110
      GO TO 40
C
   24 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-pi/2,pi/2) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, w = 1 '
      WRITE (*,FMT=*) ' q = (beta**2-0.25)/(4*tan((x+pi/2)/2)**2)+ '
      WRITE (*,FMT=*) '     (alpha**2-0.25)/(4*tan((x-pi/2)/2)**2)- '
      WRITE (*,FMT=*) '     (4*alpha*beta+4*alpha+4*beta+3)/8 '
      WRITE (*,FMT=*) '            (alpha, beta parameters) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' THE ENDPOINT X = -pi/2: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR beta.LE.-1. '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '       FOR -1.LT.beta.LT.1 BUT beta**2.NE.0.25. '
      WRITE (*,FMT=*) '    REGULAR FOR beta**2 = 0.25. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR beta.GE.1. '
      WRITE (*,FMT=*) ' THE ENDPOINT X = +pi/2: '
      WRITE (*,FMT=*) '    LIMIT POINT FOR alpha.LE.-1. '
      WRITE (*,FMT=*) '    LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*)
     +  '       FOR -1.LT.alpha.LT.1 BUT alpha**2.NE.0.25. '
      WRITE (*,FMT=*) '    REGULAR FOR alpha**2 = 0.25. '
      WRITE (*,FMT=*) '    LIMIT POINT FOR alpha.GE.1. '
      MUMBER = 111
      GO TO 40
C
   25 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity, '
      WRITE (*,FMT=*) '                                    +infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 0 '
      WRITE (*,FMT=*) ' w = 1 when x.le.0. '
      WRITE (*,FMT=*) '   = 9 when x.gt.0. '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   26 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity, '
      WRITE (*,FMT=*) '                                    +infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = -1000*x, w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   27 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity, '
      WRITE (*,FMT=*) '                                    +infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 0.25*exp(2*x) - k*exp(x), w = 1 '
      WRITE (*,FMT=*) '                (k a parameter) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      MUMBER = 112
      GO TO 40
C
   28 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity, '
      WRITE (*,FMT=*) '                                    +infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = k*cos(x)**2, w = 1 '
      WRITE (*,FMT=*) '          (k a parameter) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      MUMBER = 113
      GO TO 40
C
   29 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 0.25 + (k**2-1)/(4*x**2)), w = 1/x '
      WRITE (*,FMT=*) '       (k a positive parameter .GE. 1) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT 0. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      MUMBER = 114
      GO TO 40
C
   30 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (0,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = x*sin(x), w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' REGULAR AT 0. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   31 CONTINUE
      WRITE (*,FMT=*)
     +  '    -(p*y'')'' + q*y = lambda*w*y on (-infinity,+infinity) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = 1, q = 9*exp(-2*x) - 18*exp(-x), w = 1 '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' LIMIT POINT AT -INFINITY. '
      WRITE (*,FMT=*) ' LIMIT POINT AT +INFINITY. '
      GO TO 40
C
   32 CONTINUE
      WRITE (*,FMT=*) '    -(p*y'')'' + q*y = lambda*w*y on (0,1) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' p = x**c*(1-x)**d*(x+s)**e '
      WRITE (*,FMT=*) ' q = a*b*x**c*(1-x)**(d-1)*(x+s)**(e-1) '
      WRITE (*,FMT=*) ' w = x**(c-1)*(1-x)**(d-1)*(x+s)**(e-1) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' where the parameters s,a,b,c,d,e satisfy '
      WRITE (*,FMT=*) ' the conditions '
      WRITE (*,FMT=*) '   s > 0, a.ge.b.ge.1, c.ge.1, d.ge.1, '
      WRITE (*,FMT=*) '   a+b+1-c-d-e = 0. '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' THE ENDPOINT 0: '
      WRITE (*,FMT=*) '   LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '     FOR 1.LE.c.LT.2; '
      WRITE (*,FMT=*) '   LIMIT POINT FOR 2.LE.c. '
      WRITE (*,FMT=*) ' THE ENDPOINT 1: '
      WRITE (*,FMT=*) '   LIMIT CIRCLE, NON-OSCILLATORY '
      WRITE (*,FMT=*) '     FOR 1.LE.d.LT.2; '
      WRITE (*,FMT=*) '   LIMIT POINT FOR 2.LE.d. '
      MUMBER = 115
      GO TO 40
C
   40 CONTINUE
      WRITE (*,FMT=*)
      WRITE (*,FMT=*)
     +  ' IS THIS THE CORRECT DIFFERENTIAL EQUATION ? (Y/N) '
      READ (*,FMT=*) ANS
      IF (.NOT. (ANS.EQ.'y'.OR.ANS.EQ.'Y')) GO TO 35
      IF (MUMBER.EQ.NUMBER) RETURN
C
C     Now enter any parameters needed for these D.E.'s, or defaults.
C
      MUMBER = MUMBER - 100
      GO TO (41,42,43,44,45,46,47,48,49,50,51,52,53,54,55) MUMBER
C
   41 CONTINUE
      NU = 1.0D0
      WRITE (*,FMT=*) ' Choose real parameter nu, nu = '
      READ (*,FMT=*) NU
      RETURN
C
   42 CONTINUE
      K = 1.0D0
      WRITE (*,FMT=*) ' Choose real parameter k.ne.0., k = '
      READ (*,FMT=*) K
      RETURN
C
   43 CONTINUE
      K = 1.0D0
      WRITE (*,FMT=*) ' Choose real parameter k = '
      READ (*,FMT=*) K
      RETURN
C
   44 CONTINUE
      H = 1.0D0
      K = 1.0D0
      WRITE (*,FMT=*) ' Choose real parameters k,h = '
      READ (*,FMT=*) K,H
      RETURN
C
   45 CONTINUE
      BETA = 0.1D0
      ALPHA = 0.1D0
      WRITE (*,FMT=*) ' Choose real parameters alpha,beta = '
      READ (*,FMT=*) ALPHA,BETA
      RETURN
C
   46 CONTINUE
      ALPHA = 0.1D0
      BETA = 0.1D0
      WRITE (*,FMT=*) ' Choose real parameters alpha,beta = '
      READ (*,FMT=*) ALPHA,BETA
      RETURN
C
   47 CONTINUE
      GAMMA = 0.1D0
      BETA = 0.1D0
      WRITE (*,FMT=*) ' Choose real parameters gamma,beta = '
      READ (*,FMT=*) GAMMA,BETA
      RETURN
C
   48 CONTINUE
      K = 1.0D0
      WRITE (*,FMT=*) ' Choose real parameter k.gt.0., k = '
      READ (*,FMT=*) K
      RETURN
C
   49 CONTINUE
      ALPHA = 0.1D0
      WRITE (*,FMT=*) ' Choose real parameter alpha = '
      READ (*,FMT=*) ALPHA
      RETURN
C
   50 CONTINUE
      ALPHA = 0.1D0
      WRITE (*,FMT=*) ' Choose real parameter alpha = '
      READ (*,FMT=*) ALPHA
      RETURN
C
   51 CONTINUE
      BETA = 0.1D0
      ALPHA = 0.1D0
      WRITE (*,FMT=*) ' Choose real parameters alpha,beta = '
      READ (*,FMT=*) ALPHA,BETA
      RETURN
C
   52 CONTINUE
      K = 0.1D0
      WRITE (*,FMT=*) ' Choose real parameter k = '
      READ (*,FMT=*) K
      RETURN
C
   53 CONTINUE
      K = 0.1D0
      WRITE (*,FMT=*) ' Choose real parameter k = '
      READ (*,FMT=*) K
      RETURN
C
   54 CONTINUE
      K = 0.1D0
      WRITE (*,FMT=*) ' Choose real parameter k = '
      READ (*,FMT=*) K
      RETURN
C
   55 CONTINUE
      WRITE (*,FMT=*) ' Choose real parameter s > 0 '
      READ (*,FMT=*) S
      WRITE (*,FMT=*) ' Before entering the numerical values of the '
      WRITE (*,FMT=*) '   parameters a,b,c,d,e the user is advised to '
      WRITE (*,FMT=*) '   make a preliminary choice of these numbers '
      WRITE (*,FMT=*) '   that are consistent with the conditions '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) '    a.ge.b, b.ge.1 '
      WRITE (*,FMT=*) '    1.le.d .le. (a+b-1) '
      WRITE (*,FMT=*) '    1.le.c .le. (a+b-d) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' (Parameter e will be set equal to a+b+1-c-d.) '
      WRITE (*,FMT=*)
      WRITE (*,FMT=*) ' Choose parameters a, b  = '
      READ (*,FMT=*) A,B
      TMP = A + B - 1.0D0
      WRITE (*,FMT=*) ' Choose parameter d, 1.LE.d .LE. ',TMP
      READ (*,FMT=*) D
      TMP = A + B - D
      WRITE (*,FMT=*) ' Choose parameter c, 1.LE.c .LE. ',TMP
      READ (*,FMT=*) C
      E = A + B + 1.0D0 - C - D
      RETURN
      END
C
      REAL FUNCTION P(X)

C     .. Scalar Arguments ..
      REAL X
C     ..
C     .. Scalars in Common ..
      REAL A,ALPHA,B,BETA,C,D,E,GAMMA,H,K,L,NU,S
      INTEGER NUMBER
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,EXP,LOG,SQRT
C     ..
C     .. Common blocks ..
      COMMON /FLAG/NUMBER
      COMMON /PAR/NU,H,K,L,ALPHA,BETA,GAMMA,S,A,B,C,D,E
C     ..
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
     +       23,24,25,26,27,28,29,30,31,32) NUMBER
C
    1 CONTINUE
      P = 1.0D0 - X*X
      RETURN
C
    2 CONTINUE
      P = 1.0D0
      RETURN
C
    3 CONTINUE
      P = 1.0D0
      RETURN
C
    4 CONTINUE
      P = 1.0D0
      RETURN
C
    5 CONTINUE
      P = EXP(-2.0D0* (X*LOG(ABS(X))-X))
      RETURN
C
    6 CONTINUE
      P = X
      RETURN
C
    7 CONTINUE
      P = X
      RETURN
C
    8 CONTINUE
      P = 1.0D0/X
      RETURN
C
    9 CONTINUE
      P = 1.0D0 - X**7
      RETURN
C
   10 CONTINUE
      P = SQRT(X)
      RETURN
C
   11 CONTINUE
      P = 1.0D0
      RETURN
C
   12 CONTINUE
      P = 1.0D0
      RETURN
C
   13 CONTINUE
      P = 1.0D0
      RETURN
C
   14 CONTINUE
      P = 1.0D0
      RETURN
C
   15 CONTINUE
      P = 1.0D0
      RETURN
C
   16 CONTINUE
      IF (ABS(X).EQ.1.0D0) THEN
          P = 0.0D0
      ELSE IF (ALPHA.NE.-1.0D0 .AND. BETA.NE.-1.0D0) THEN
          P = (1.0D0-X)** (ALPHA+1.0D0)* (1.0D0+X)** (BETA+1.0D0)
      ELSE IF (ALPHA.NE.-1.0D0 .AND. BETA.EQ.-1.0D0) THEN
          P = (1.0D0-X)** (ALPHA+1.0D0)
      ELSE IF (ALPHA.EQ.-1.0D0 .AND. BETA.NE.-1.0D0) THEN
          P = (1.0D0+X)** (BETA+1.0D0)
      ELSE
          P = 1.0D0
      END IF
      RETURN
C
   17 CONTINUE
      P = 1.0D0
      RETURN
C
   18 CONTINUE
      P = 1.0D0 - X*X
      RETURN
C
   19 CONTINUE
      P = 1.0D0 - X*X
      RETURN
C
   20 CONTINUE
      P = 1.0D0
      RETURN
C
   21 CONTINUE
      P = 1.0D0
      RETURN
C
   22 CONTINUE
      P = EXP(-X)
      IF (ALPHA.NE.-1.0D0) P = P*X** (ALPHA+1.0D0)
      RETURN
C
   23 CONTINUE
      P = 1.0D0
      RETURN
C
   24 CONTINUE
      P = 1.0D0
      RETURN
C
   25 CONTINUE
      P = 1.0D0
      RETURN
C
   26 CONTINUE
      P = 1.0D0
      RETURN
C
   27 CONTINUE
      P = 1.0D0
      RETURN
C
   28 CONTINUE
      P = 1.0D0
      RETURN
C
   29 CONTINUE
      P = 1.0D0
      RETURN
C
   30 CONTINUE
      P = 1.0D0
      RETURN
C
   31 CONTINUE
      P = 1.0D0
      RETURN
C
   32 CONTINUE
      P = X**C* (1.0D0-X)**D* (X+S)**E
      RETURN
      END
C
      REAL FUNCTION Q(X)
c
C     .. Scalar Arguments ..
      REAL X
C     ..
C     .. Scalars in Common ..
      REAL A,ALPHA,B,BETA,C,D,E,GAMMA,H,K,L,NU,S
      INTEGER NUMBER
C     ..
C     .. Local Scalars ..
      REAL EE,HPI
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN,COS,EXP,LOG,SIN,TAN
C     ..
C     .. Common blocks ..
      COMMON /FLAG/NUMBER
      COMMON /PAR/NU,H,K,L,ALPHA,BETA,GAMMA,S,A,B,C,D,E
C     ..
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
     +       23,24,25,26,27,28,29,30,31,32) NUMBER
C
    1 CONTINUE
      Q = 0.25D0
      RETURN
C
    2 CONTINUE
      Q = 0.0D0
      IF (NU.NE.-0.5D0 .AND. NU.NE.0.5D0) Q = (NU*NU-0.25D0)/X**2
      RETURN
C
    3 CONTINUE
      Q = 0.0D0
      RETURN
C
    4 CONTINUE
      Q = -1.0D0/X
      RETURN
C
    5 CONTINUE
      Q = -EXP(-2.0D0* (X*LOG(ABS(X))-X))*LOG(ABS(X))**2
      RETURN
C
    6 CONTINUE
      Q = -X
      RETURN
C
    7 CONTINUE
      Q = -1.0D0/X
      RETURN
C
    8 CONTINUE
      Q = K/X**2 + K**2/X
      RETURN
C
    9 CONTINUE
      Q = 0.0D0
      RETURN
C
   10 CONTINUE
      Q = 0.0D0
      RETURN
C
   11 CONTINUE
      Q = 100.0D0*COS(X)**2
      RETURN
C
   12 CONTINUE
      Q = 2.0D0*K*COS(2.0D0*X)
      RETURN
C
   13 CONTINUE
      Q = K/X + H/ (X*X)
      IF (H.LT.-0.25D0) Q = Q + 1.0D0
      RETURN
C
   14 CONTINUE
      Q = 3.0D0* (X-31.0D0)/ (4.0D0* (X+1.0D0)* (X+4.0D0)**2)
      RETURN
C
   15 CONTINUE
      Q = X*X
      RETURN
C
   16 CONTINUE
      Q = 0.0D0
      RETURN
C
   17 CONTINUE
      L = 1.0D0
      EE = EXP(-1.7D0* (X-1.3D0))
      Q = L* (L+1.0D0)/X**2 - 2000.0D0*EE* (2.0D0-EE)
      RETURN
C
   18 CONTINUE
      IF (ALPHA.NE.0.0D0 .AND. BETA.NE.0.0D0) THEN
          Q = 2.0D0*ALPHA**2/ (1.0D0+X) + 2.0D0*BETA**2/ (1.0D0-X)
      ELSE IF (ALPHA.EQ.0.0D0 .AND. BETA.NE.0.0D0) THEN
          Q = 2.0D0*BETA**2/ (1.0D0-X)
      ELSE IF (ALPHA.NE.0.0D0 .AND. BETA.EQ.0.0D0) THEN
          Q = 2.0D0*ALPHA**2/ (1.0D0+X)
      ELSE
          Q = 0.0D0
      END IF
      RETURN
C
   19 CONTINUE
      Q = -2.0D0*GAMMA**2/ (1.0D0+X) + 2.0D0*BETA**2/ (1.0D0-X)
      RETURN
C
   20 CONTINUE
      Q = 1.0D0 - (K**2+0.25D0)/X**2
      RETURN
C
   21 CONTINUE
      Q = 0.0D0
      RETURN
C
   22 CONTINUE
      Q = 0.0D0
      RETURN
C
   23 CONTINUE
      Q = - (ALPHA+1.0D0)/2.0D0 + X**2/16.0D0
      IF (ALPHA.NE.0.5D0 .AND. ALPHA.NE.-0.5D0) Q = Q +
     +    (ALPHA**2-0.25D0)/X**2
      RETURN
C
   24 CONTINUE
      HPI = 2.0D0*ATAN(1.0D0)
      IF (BETA*BETA.NE.0.25D0 .AND. ALPHA*ALPHA.NE.0.25D0) THEN
          Q = (BETA**2-0.25D0)/ (4.0D0*TAN((X+HPI)/2.0D0)**2) +
     +        (ALPHA**2-0.25D0)/ (4.0D0*TAN((X-HPI)/2.0D0)**2) -
     +        (ALPHA*BETA+ALPHA+BETA+0.75D0)/2.0D0
      ELSE IF (BETA*BETA.EQ.0.25D0 .AND. ALPHA*ALPHA.NE.0.25D0) THEN
          Q = (ALPHA**2-0.25D0)/ (4.0D0*TAN((X-HPI)/2.0D0)**2) -
     +        (ALPHA*BETA+ALPHA+BETA+0.75D0)/2.0D0
      ELSE IF (BETA*BETA.NE.0.25D0 .AND. ALPHA*ALPHA.EQ.0.25D0) THEN
          Q = (BETA**2-0.25D0)/ (4.0D0*TAN((X+HPI)/2.0D0)**2) -
     +        (ALPHA*BETA+ALPHA+BETA+0.75D0)/2.0D0
      ELSE
          Q = - (ALPHA*BETA+ALPHA+BETA+0.75D0)/2.0D0
      END IF
      RETURN
C
   25 CONTINUE
      Q = 0.0D0
      RETURN
C
   26 CONTINUE
      Q = -1000.0D0*X
      RETURN
C
   27 CONTINUE
      EE = EXP(X)
      Q = EE* (0.25D0*EE-K)
      RETURN
C
   28 CONTINUE
      Q = K*COS(X)**2
      RETURN
C
   29 CONTINUE
      Q = 0.25D0 + (K**2-1.0D0)/ (4.0D0*X**2)
      RETURN
C
   30 CONTINUE
      Q = X*SIN(X)
      RETURN
C
   31 CONTINUE
      EE = EXP(-X)
      Q = 9.0D0*EE*EE - 18.0D0*EE
      RETURN
C
   32 CONTINUE
      Q = A*B*X**C* (1.0D0-X)** (D-1.0D0)* (X+S)** (E-1.0D0)
      RETURN
      END
C
      REAL FUNCTION W(X)

C     .. Scalar Arguments ..
      REAL X
C     ..
C     .. Scalars in Common ..
      REAL A,ALPHA,B,BETA,C,D,E,GAMMA,H,K,L,NU,S
      INTEGER NUMBER
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,EXP,LOG,SQRT
C     ..
C     .. Common blocks ..
      COMMON /FLAG/NUMBER
      COMMON /PAR/NU,H,K,L,ALPHA,BETA,GAMMA,S,A,B,C,D,E
C     ..
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
     +       23,24,25,26,27,28,29,30,31,32) NUMBER
C
    1 CONTINUE
      W = 1.0D0
      RETURN
C
    2 CONTINUE
      W = 1.0D0
      RETURN
C
    3 CONTINUE
      W = 0.0D0
      IF (X.NE.0.0D0) W = EXP(-2.0D0/X)/X**4
      RETURN
C
    4 CONTINUE
      W = 1.0D0
      RETURN
C
    5 CONTINUE
      W = EXP(-2.0D0* (X*LOG(ABS(X))-X))
      RETURN
C
    6 CONTINUE
      W = 1.0D0/X
      RETURN
C
    7 CONTINUE
      W = 1.0D0
      RETURN
C
    8 CONTINUE
      W = 1.0D0
      RETURN
C
    9 CONTINUE
      W = X**7
      RETURN
C
   10 CONTINUE
      W = 1.0D0/SQRT(X)
      RETURN
C
   11 CONTINUE
      W = 1.0D0
      RETURN
C
   12 CONTINUE
      W = 1.0D0
      RETURN
C
   13 CONTINUE
      W = 1.0D0
      RETURN
C
   14 CONTINUE
      W = 1.0D0
      RETURN
C
   15 CONTINUE
      W = 1.0D0
      RETURN
C
   16 CONTINUE
      IF (ALPHA.NE.0.0D0 .AND. BETA.NE.0.0D0) THEN
          W = (1.0D0-X)**ALPHA* (1.0D0+X)**BETA
      ELSE IF (ALPHA.NE.0.0D0 .AND. BETA.EQ.0.0D0) THEN
          W = (1.0D0-X)**ALPHA
      ELSE IF (ALPHA.EQ.0.0D0 .AND. BETA.NE.0.0D0) THEN
          W = (1.0D0+X)**BETA
      ELSE
          W = 1.0D0
      END IF
      RETURN
C
   17 CONTINUE
      W = 1.0D0
      RETURN
C
   18 CONTINUE
      W = 1.0D0
      RETURN
C
   19 CONTINUE
      W = 1.0D0
      RETURN
C
   20 CONTINUE
      W = 1.0D0
      RETURN
C
   21 CONTINUE
      W = 1.0D0
      RETURN
C
   22 CONTINUE
      W = EXP(-X)
      IF (ALPHA.NE.0.0D0) W = W* (X**ALPHA)
      RETURN
C
   23 CONTINUE
      W = 1.0D0
      RETURN
C
   24 CONTINUE
      W = 1.0D0
      RETURN
C
   25 CONTINUE
      W = 9.0D0
      IF (X.LE.0.0D0) W = 1.0D0
      RETURN
C
   26 CONTINUE
      W = 1.0D0
      RETURN
C
   27 CONTINUE
      W = 1.0D0
      RETURN
C
   28 CONTINUE
      W = 1.0D0
      RETURN
C
   29 CONTINUE
      W = 1.0D0/X
      RETURN
C
   30 CONTINUE
      W = 1.0D0
      RETURN
C
   31 CONTINUE
      W = 1.0D0
      RETURN
C
   32 CONTINUE
      W = X** (C-1.0D0)* (1.0D0-X)** (D-1.0D0)* (X+S)** (E-1.0D0)
      RETURN
      END
C
      SUBROUTINE UV(X,U,PUP,V,PVP,HU,HV)
C
C     HERE, HU MEANS -(pu')' + qu.
C
C     .. Scalar Arguments ..
      REAL HU,HV,PUP,PVP,U,V,X
C     ..
C     .. Scalars in Common ..
      REAL A,ALPHA,B,BETA,C,D,E,GAMMA,H,K,L,NU,S
      INTEGER NUMBER
C     ..
C     .. Local Scalars ..
      REAL CC,EE,HPI,L2,SQ,SS,TX
C     ..
C     .. External Functions ..
      REAL Q,W
      EXTERNAL Q,W
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN,COS,EXP,LOG,SIN,SQRT
C     ..
C     .. Common blocks ..
      COMMON /FLAG/NUMBER
      COMMON /PAR/NU,H,K,L,ALPHA,BETA,GAMMA,S,A,B,C,D,E
C     ..
      GO TO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
     +       23,24,25,26,27,28,29,30,31,32) NUMBER
C
    1 CONTINUE
      U = 1.0D0
      PUP = 0.0D0
      V = 0.5D0*LOG((1.0D0+X)/ (1.0D0-X))
      PVP = 1.0D0
      HU = 0.25D0*U
      HV = 0.25D0*V
      RETURN
C
    2 CONTINUE
      IF (NU.NE.-0.5D0 .AND. NU.NE.0.5D0 .AND. NU.NE.0.0D0) THEN
          U = X** (NU+0.5D0)
          PUP = (NU+0.5D0)*X** (NU-0.5D0)
          V = X** (-NU+0.5D0)
          PVP = (-NU+0.5D0)*X** (-NU-0.5D0)
      ELSE IF (NU.EQ.-0.5D0) THEN
          U = X
          PUP = 1.0D0
          V = 1.0D0
          PVP = 0.0D0
      ELSE IF (NU.EQ.0.5D0) THEN
          U = X
          PUP = 1.0D0
          V = -1.0D0
          PVP = 0.0D0
      ELSE IF (NU.EQ.0.0D0) THEN
          U = SQRT(X)
          PUP = 0.5D0/U
          V = U*LOG(X)
          PVP = (0.5D0*LOG(X)+1.0D0)/U
      END IF
      HU = 0.0D0
      HV = 0.0D0
      RETURN
C
    3 CONTINUE
      U = 1.0D0
      V = X
      PUP = 0.0D0
      PVP = 1.0D0
      HU = 0.0D0
      HV = 0.0D0
      RETURN
C
    4 CONTINUE
      TX = LOG(ABS(X))
      U = X
      PUP = 1.0D0
      V = 1.0D0 - X*TX
      PVP = -1.0D0 - TX
      HU = -1.0D0
      HV = TX
      RETURN
C
    5 CONTINUE
      RETURN
C
    6 CONTINUE
      U = (COS(X)+SIN(X))/SQRT(X)
      V = (COS(X)-SIN(X))/SQRT(X)
      PUP = -0.5D0*U + X*V
      PVP = -0.5D0*V - X*U
      HU = -0.25D0*U/X
      HV = -0.25D0*V/X
      RETURN
C
    7 CONTINUE
      TX = LOG(ABS(X))
      U = COS(TX)
      V = SIN(TX)
      PUP = -V
      PVP = U
      HU = 0.0D0
      HV = 0.0D0
      RETURN
C
    8 CONTINUE
      V = X - 1.0D0/K
      U = X*X
      PVP = 1.0D0/X
      PUP = 2.0D0
      HU = K + X*K**2
      HV = K**2
      RETURN
C
    9 CONTINUE
      U = 1.0D0
      V = -LOG(1.0D0-X)
      PUP = 0.0D0
      PVP = (((((X+1.0D0)*X+1.0D0)*X+1.0D0)*X+1.0D0)*X+1.0D0)*X + 1.0D0
      HU = 0.0D0
      HV = - (((((6.0D0*X+5.0D0)*X+4.0D0)*X+3.0D0)*X+2.0D0)*X+1.0D0)
      RETURN
C
   10 CONTINUE
      U = 2.0D0*SQRT(X)
      V = 1.0D0
      PUP = 1.0D0
      PVP = 0.0D0
      HU = 0.0D0
      HV = 0.0D0
      RETURN
C
   11 CONTINUE
      RETURN
C
   12 CONTINUE
      RETURN
C
   13 CONTINUE
      IF (H.GT.-0.25D0) THEN
          L = SQRT(H+0.25D0)
          IF (H.EQ.0.0D0) THEN
              U = X
              V = 1.0D0 + K*X*LOG(X)
              PUP = 1.0D0
              PVP = K* (1.0D0+LOG(X))
              HU = K
              HV = K*K*LOG(X)
          ELSE
              U = X** (0.5D0+L)
              V = X** (0.5D0-L) + (K/ (1.0D0-2.0D0*L))*X** (1.5D0-L)
              PUP = (0.5D0+L)*X** (L-0.5D0)
              PVP = (0.5D0-L)*X** (-L-0.5D0) +
     +              K* (1.5D0-L)/ (1.0D0-2.0D0*L)*X** (0.5D0-L)
              HU = K*X** (L-0.5D0)
              HV = K**2/ (1.0D0-2.0D0*L)*X** (0.5D0-L)
          END IF
      ELSE IF (H.LT.-0.25D0) THEN
          L2 = - (H+0.25D0)
          L = SQRT(L2)
          CC = COS(L*LOG(X))
          SS = SIN(L*LOG(X))
          SQ = SQRT(X)
          U = SQ* ((1.D0-0.25D0*K*X/H)*CC+0.5D0*K*L*X*SS)
          V = SQ* ((1.D0-0.25D0*K*X/H)*SS+0.5D0*K*L*X*CC)
          PUP = (0.5D0*CC-L*SS)/SQ - 0.5D0*K*SQ* ((0.5D0-H)*CC+L*SS)/H
          PVP = (0.5D0*SS+L*CC)/SQ + 0.5D0*K*SQ* ((H-0.5D0)*SS+L*CC)/H
          HU = 0.5D0*K*K*SQ* ((H+0.5D0)*CC+L*SS)/ (H*H) + U
          HV = 0.5D0*K*K*SQ* ((H+0.5D0)*SS-L*CC)/ (H*H) + V
      ELSE IF (H.EQ.-0.25D0) THEN
          SQ = SQRT(X)
          U = SQ + K*X*SQ
          V = 2.0D0*SQ + (SQ+K*X*SQ)*LOG(X)
          PUP = 0.5D0* (1.0D0/SQ+3.D0*K*SQ)
          PVP = 2.0D0/SQ + K*SQ + 0.5D0* (1.0D0/SQ+3.0D0*K*SQ)*LOG(X)
          HU = K*K*SQ
          HV = K*K*SQ*LOG(X)
      END IF
      RETURN
C
   14 CONTINUE
      RETURN
C
   15 CONTINUE
      RETURN
C
   16 CONTINUE
      IF (X.LT.0.0D0) THEN
          IF (BETA.GT.-1.0D0 .AND. BETA.LT.0.0D0) THEN
              U = (1.0D0+X)** (-BETA)
              V = 1.0D0
              IF (ALPHA.NE.-1.0D0) THEN
                  PUP = -BETA* (1.0D0-X)** (ALPHA+1.0D0)
                  HU = -BETA* (ALPHA+1.0D0)* (1.0D0-X)**ALPHA
              ELSE
                  PUP = -BETA
                  HU = 0.0D0
              END IF
              PVP = 0.0D0
              HV = 0.0D0
          ELSE IF (BETA.EQ.0.0D0) THEN
              U = 1.0D0
              V = LOG((1.0D0+X)/ (1.0D0-X))
              PUP = 0.0D0
              PVP = 2.0D0* (1.0D0-X)**ALPHA
              HU = 0.0D0
              HV = 2.0D0*ALPHA* (1.0D0-X)** (ALPHA-1.0D0)
          ELSE IF (BETA.GT.0.0D0 .AND. BETA.LT.1.0D0) THEN
              U = 1.0D0
              V = (1.0D0+X)** (-BETA)
              PUP = 0.0D0
              IF (ALPHA.NE.-1.0D0) THEN
                  PVP = -BETA* (1.0D0-X)** (ALPHA+1.0D0)
                  HV = -BETA* (ALPHA+1.0D0)* (1.0D0-X)**ALPHA
              ELSE
                  PVP = -BETA
                  HV = 0.0D0
              END IF
              HU = 0.0D0
          END IF
      ELSE IF (X.GE.0.0D0) THEN
          IF (ALPHA.GT.-1.0D0 .AND. ALPHA.LT.0.0D0) THEN
              U = (1.0D0-X)** (-ALPHA)
              V = 1.0D0
              IF (BETA.NE.-1.0D0) THEN
                  PUP = ALPHA* (1.0D0+X)** (BETA+1.0D0)
                  HU = -ALPHA* (BETA+1.0D0)* (1.0D0+X)**BETA
              ELSE
                  PUP = ALPHA
                  HU = 0.0D0
              END IF
              PVP = 0.0D0
              HV = 0.0D0
          ELSE IF (ALPHA.EQ.0.0D0) THEN
              U = 1.0D0
              V = LOG((1.0D0+X)/ (1.0D0-X))
              PUP = 0.0D0
              PVP = 2.0D0* (1.0D0+X)**BETA
              HU = 0.0D0
              HV = -2.0D0*BETA* (1.0D0+X)** (BETA-1.0D0)
          ELSE IF (ALPHA.GT.0.0D0 .AND. ALPHA.LT.1.0D0) THEN
              U = 1.0D0
              V = (1.0D0-X)** (-ALPHA)
              PUP = 0.0D0
              HU = 0.0D0
              IF (BETA.NE.-1.0D0) THEN
                  PVP = ALPHA* (1.0D0+X)** (BETA+1.0D0)
                  HV = -ALPHA* (BETA+1.0D0)* (1.0D0+X)**BETA
              ELSE
                  PVP = ALPHA
                  HV = 0.0D0
              END IF
          END IF
      END IF
      RETURN
C
   17 CONTINUE
      RETURN
C
   18 CONTINUE
      IF (X.LT.0.0D0) THEN
          IF (ALPHA.EQ.0.0D0) THEN
              U = 1.0D0
              V = 0.5D0*LOG((1.0D0+X)/ (1.0D0-X))
              PUP = 0.0D0
              PVP = 1.0D0
              HU = Q(X)
              HV = Q(X)*V
          ELSE IF (ALPHA.GT.0.0D0 .AND. ALPHA.LT.0.5D0) THEN
              U = (1.0D0+X)**ALPHA
              V = (1.0D0+X)** (-ALPHA)
              PUP = ALPHA* (1.0D0-X)*U
              PVP = -ALPHA* (1.0D0-X)*V
              HU = ALPHA* (ALPHA+1.0D0)*U + 2.0D0*BETA**2*U/ (1.0D0-X)
              HV = ALPHA* (ALPHA-1.0D0)*V + 2.0D0*BETA**2*V/ (1.0D0-X)
          ELSE
          END IF
      ELSE IF (X.GE.0.0D0) THEN
          IF (BETA.EQ.0.0D0) THEN
              U = 1.0D0
              V = 0.5D0*LOG((1.0D0+X)/ (1.0D0-X))
              PUP = 0.0D0
              PVP = 1.0D0
              HU = Q(X)
              HV = Q(X)*V
          ELSE IF (BETA.GT.0.0D0 .AND. BETA.LT.0.5D0) THEN
              U = (1.0D0-X)**BETA
              V = (1.0D0-X)** (-BETA)
              PUP = -BETA* (1.0D0+X)*U
              PVP = BETA* (1.0D0+X)*V
              HU = BETA* (BETA+1.0D0)*U + 2.0D0*ALPHA**2*U/ (1.0D0+X)
              HV = BETA* (BETA-1.0D0)*V + 2.0D0*ALPHA**2*V/ (1.0D0+X)
          ELSE
          END IF
      END IF
      RETURN
C
   19 CONTINUE
      IF (X.LT.0.0D0) THEN
          IF (GAMMA.EQ.0.0D0) THEN
              U = 1.0D0
              V = 0.5D0*LOG((1.0D0+X)/ (1.0D0-X))
              PUP = 0.0D0
              PVP = 1.0D0
              HU = Q(X)*U
              HV = Q(X)*V
          ELSE
              U = COS(GAMMA*LOG(1.0D0+X))
              V = SIN(GAMMA*LOG(1.0D0+X))
              PUP = -GAMMA* (1.0D0-X)*V
              PVP = GAMMA* (1.0D0-X)*U
              HU = -GAMMA**2*U - GAMMA*V + 2.0D0*BETA**2*U/ (1.0D0-X)
              HV = -GAMMA**2*V + GAMMA*U + 2.0D0*BETA**2*V/ (1.0D0-X)
          END IF
      ELSE IF (X.GE.0.0D0) THEN
          IF (BETA.EQ.0.0D0) THEN
              U = 1.0D0
              V = 0.5D0*LOG((1.0D0+X)/ (1.0D0-X))
              PUP = 0.0D0
              PVP = 1.0D0
              HU = Q(X)*U
              HV = Q(X)*V
          ELSE IF (BETA.GT.0.0D0 .AND. BETA.LT.0.5D0) THEN
              U = (1.0D0-X)**BETA
              V = (1.0D0-X)** (-BETA)
              PUP = -BETA* (1.0D0+X)*U
              PVP = BETA* (1.0D0+X)*V
              HU = BETA* (BETA+1.0D0)*U - 2.0D0*GAMMA**2*U/ (1.0D0+X)
              HV = BETA* (BETA-1.0D0)*V - 2.0D0*GAMMA**2*V/ (1.0D0+X)
          ELSE
          END IF
      END IF
      RETURN
C
   20 CONTINUE
      U = SQRT(X)*COS(K*LOG(X))
      V = SQRT(X)*SIN(K*LOG(X))
      PUP = 0.5D0*U/X - K*V/X
      PVP = 0.5D0*V/X + K*U/X
      HU = U
      HV = V
      RETURN
C
   21 CONTINUE
      RETURN
C
   22 CONTINUE
      EE = EXP(-X)
      IF (ALPHA.GT.-1.0D0 .AND. ALPHA.LT.0.0D0) THEN
          U = X** (-ALPHA)
          V = 1.0D0
          PUP = -ALPHA*EE
          PVP = 0.0D0
          HU = -ALPHA*EE
          HV = 0.0D0
      ELSE IF (ALPHA.EQ.0.0D0) THEN
          U = 1.0D0
          V = LOG(X)
          PUP = 0.0D0
          PVP = EE
          HU = 0.0D0
          HV = EE
      ELSE IF (ALPHA.GT.0.0D0 .AND. ALPHA.LT.1.0D0) THEN
          U = 1.0D0
          V = X** (-ALPHA)
          PUP = 0.0D0
          PVP = -ALPHA*EE
          HU = 0.0D0
          HV = -ALPHA*EE
      ELSE
      END IF
      RETURN
C
   23 CONTINUE
      IF (ALPHA.GT.-1.0D0 .AND. ALPHA.LT.0.0D0) THEN
          IF (ALPHA.NE.-0.5D0) THEN
              U = X** (0.5D0-ALPHA)
              V = X** (0.5D0+ALPHA)
              PUP = (0.5D0-ALPHA)*X** (-0.5D0-ALPHA)
              PVP = (0.5D0+ALPHA)*X** (-0.5D0+ALPHA)
          ELSE
              U = X
              V = 1.0D0
              PUP = 1.0D0
              PVP = 0.0D0
          END IF
          TX = X**2/16.0D0 - (ALPHA+1.0D0)/2.0D0
          HU = TX*U
          HV = TX*V
      ELSE IF (ALPHA.EQ.0.0D0) THEN
          U = SQRT(X)
          V = U*LOG(X)
          PUP = 0.5D0/U
          PVP = (1.0D0+0.5D0*LOG(X))/U
          HU = (X**2/16.0D0-0.5D0)*U
          HV = (X**2/16.0D0-0.5D0)*V
      ELSE IF (ALPHA.GT.0.0D0 .AND. ALPHA.LT.1.0D0) THEN
          IF (ALPHA.NE.0.5D0) THEN
              U = X** (0.5D0+ALPHA)
              V = X** (0.5D0-ALPHA)
              PUP = (0.5D0+ALPHA)*X** (-0.5D0+ALPHA)
              PVP = (0.5D0-ALPHA)*X** (-0.5D0-ALPHA)
          ELSE
              U = X
              V = 1.0D0
              PUP = 1.0D0
              PVP = 0.0D0
          END IF
          TX = X**2/16.0D0 - (ALPHA+1.0D0)/2.0D0
          HU = TX*U
          HV = TX*V
      ELSE
      END IF
      RETURN
C
   24 CONTINUE
      HPI = 2.0D0*ATAN(1.0D0)
      IF (X.GE.0.0D0) THEN
          IF (ALPHA.GT.-1.0D0 .AND. ALPHA.LT.0.0D0) THEN
              U = (HPI-X)** (0.5D0-ALPHA)
              V = (HPI-X)** (0.5D0+ALPHA)
              PUP = - (0.5D0-ALPHA)* (HPI-X)** (-0.5D0-ALPHA)
              PVP = - (0.5D0+ALPHA)* (HPI-X)** (-0.5D0+ALPHA)
              HU = (0.25D0-ALPHA**2)* (HPI-X)** (-1.5D0-ALPHA) + Q(X)*U
              HV = (0.25D0-ALPHA**2)* (HPI-X)** (-1.5D0+ALPHA) + Q(X)*V
          ELSE IF (ALPHA.EQ.0.0D0) THEN
              U = SQRT(HPI-X)
              V = U*LOG(HPI-X)
              PUP = -0.5D0/U
              PVP = - (1.0D0+0.5D0*LOG(HPI-X))/U
              HU = 0.25D0/ ((HPI-X)*U) + Q(X)*U
              HV = 0.25D0*LOG(HPI-X)/ ((HPI-X)*U) + Q(X)*V
          ELSE IF (ALPHA.GT.0.0D0 .AND. ALPHA.LT.1.0D0) THEN
              U = (HPI-X)** (0.5D0+ALPHA)
              V = (HPI-X)** (0.5D0-ALPHA)
              PUP = - (0.5D0+ALPHA)* (HPI-X)** (-0.5D0+ALPHA)
              PVP = - (0.5D0-ALPHA)* (HPI-X)** (-0.5D0-ALPHA)
              HU = (0.25D0-ALPHA**2)* (HPI-X)** (-1.5D0+ALPHA) + Q(X)*U
              HV = (0.25D0-ALPHA**2)* (HPI-X)** (-1.5D0-ALPHA) + Q(X)*V
          END IF
      ELSE
          IF (BETA.GT.-1.0D0 .AND. BETA.LT.0.0D0) THEN
              U = (HPI+X)** (0.5D0-BETA)
              V = (HPI+X)** (0.5D0+BETA)
              PUP = (0.5D0-BETA)* (HPI+X)** (-0.5D0-BETA)
              PVP = (0.5D0+BETA)* (HPI+X)** (-0.5D0+BETA)
              HU = (0.25D0-BETA**2)* (HPI+X)** (-1.5D0-BETA) + Q(X)*U
              HV = (0.25D0-BETA**2)* (HPI+X)** (-1.5D0+BETA) + Q(X)*V
          ELSE IF (BETA.EQ.0.0D0) THEN
              U = SQRT(HPI+X)
              V = U*LOG(HPI+X)
              PUP = 0.5D0/U
              PVP = (1.0D0+0.5D0*LOG(HPI+X))/U
              HU = 0.25D0/ ((HPI+X)*U) + Q(X)*U
              HV = 0.25D0*LOG(HPI+X)/ ((HPI+X)*U) + Q(X)*V
          ELSE IF (BETA.GT.0.0D0 .AND. BETA.LT.1.0D0) THEN
              U = (HPI+X)** (0.5D0+BETA)
              V = (HPI+X)** (0.5D0-BETA)
              PUP = (0.5D0+BETA)* (HPI+X)** (-0.5D0+BETA)
              PVP = (0.5D0-BETA)* (HPI+X)** (-0.5D0-BETA)
              HU = (0.25D0-BETA**2)* (HPI+X)** (-1.5D0+BETA) + Q(X)*U
              HV = (0.25D0-BETA**2)* (HPI+X)** (-1.5D0-BETA) + Q(X)*V
          END IF
      END IF
      RETURN
C
   25 CONTINUE
      RETURN
C
   26 CONTINUE
      RETURN
C
   27 CONTINUE
      RETURN
C
   28 CONTINUE
      RETURN
C
   29 CONTINUE
      RETURN
C
   30 CONTINUE
      RETURN
C
   31 CONTINUE
      RETURN
C
   32 CONTINUE
      U = 1.0D0
      PUP = 0.0D0
      HU = Q(X)
      IF (X.LE.0.5D0) THEN
          IF (C.EQ.1.0D0) THEN
              V = LOG(X)
              PVP = (1.0D0-X)* (X+S)*W(X)
              HV = D* (X+S)*W(X) - E* (1.0D0-X)*W(X) + V*Q(X)
          ELSE
              V = X** (1.0D0-C)
              PVP = (1.0D0-C)* (1.0D0-X)**D* (X+S)**E
              HV = (1.0D0-C)* (D* (1.0D0-X)** (D-1.0D0)* (X+S)**E-
     +             E* (1.0D0-X)**D* (X+S)** (E-1.0D0)) + V*Q(X)
          END IF
      ELSE
          IF (D.EQ.1.0D0) THEN
              V = LOG(1.0D0-X)
              PVP = -X* (X+S)*W(X)
              HV = C* (X+S)*W(X) + E*X*W(X) + V*Q(X)
          ELSE
              V = (1.0D0-X)** (1.0D0-D)
              PVP = - (1.0D0-D)*X**C* (X+S)**E
              HV = (1.0D0-D)* (C*X** (C-1.0D0)* (X+S)**E+
     +             E*X**C* (X+S)** (E-1.0D0)) + V*Q(X)
          END IF
      END IF
      RETURN
      END
SHAR_EOF
fi # end of overwriting check
cd ..
if test ! -d 'Src'
then
	mkdir 'Src'
fi
cd 'Src'
if test -f 'src.f'
then
	echo shar: will not over-write existing file "'src.f'"
else
cat << "SHAR_EOF" > 'src.f'
c-------------------------------------------------------------------
C  SUBROUTINE SLEIGN

C     **********
C     MARCH 1, 2001; P.B. BAILEY, W.N. EVERITT AND A. ZETTL
C     VERSION 1.2
C     **********

      SUBROUTINE SLEIGN(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,
     +                  NUMEIG,EIG,TOL,IFLAG,ISLFUN,SLFUN,NCA,NCB)

C     **********
C
C     This subroutine is designed for the calculation of a specified
C     eigenvalue, EIG, of a Sturm-Liouville problem for the equation
C
C       -(p(x)*y'(x))' + q(x)*y(x) = eig*w(x)*y(x)  on (a,b)
C
C     with user-supplied coefficient functions p, q, and w,
C     and with separated boundary conditions.  (For coupled
C     boundary conditions, see the companion subroutine SLCOUP.)
C          The problem may be either nonsingular or singular.  In
C     the nonsingular case, boundary conditions are of the form
C
C        A1*y(a) + A2*p(a)*y'(a) = 0
C        B1*y(b) + B2*p(b)*y'(b) = 0,
C
C     but are of the form
C
C        A1*[y,u](a) + A2*[y,v](a) = 0
C        B1*[y,U](b) + B2*[y,V](a) = 0,
C
C     when the endpoints are singular, of type Limit Circle.
C     In either case the boundary conditions are prescribed by
C     specifying the numbers A1, A2, B1, B2.  In the singular
C     case the user must also supply the "boundary condition
C     functions" u, v near a and/or U, V near b, whichever is
C     singular, of type Limit Circle.
C     The index of the desired eigenvalue is specified in NUMEIG
C     and its requested accuracy in TOL.  Initial data for the
C     associated eigenfunction are also computed along with values
C     at selected points, if desired, in array SLFUN.
C
C     In addition to the coefficient functions p, q, and w, the user
C     must supply subroutine UV to describe the boundary condition
C     when the problem is limit circle.  UV can be a dummy subroutine
C     if the problem is not limit circle.
C
C     The SUBROUTINE statement is
C
C     SUBROUTINE SLEIGN(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,
C    1    NUMEIG,EIG,TOL,IFLAG,ISLFUN,SLFUN,NCA,NCB)
C
C     where
C
C       A and B are input variables defining the interval.  If the
C         interval is finite, A must be less than B.  (See INTAB below.)
C
C       INTAB is an integer input variable specifying the nature of the
C         interval.  It can have four values.
C
C         INTAB = 1 - A and B are finite.
C         INTAB = 2 - A is finite and B is infinite (+).
C         INTAB = 3 - A is infinite (-) and B is finite.
C         INTAB = 4 - A is infinite (-) and B is infinite (+).
C
C         If either A or B is infinite, it is classified singular and
C         its value is ignored.
C
C       P0ATA, QFATA, P0ATB, and QFATB are input variables set to
C         1.0 or -1.0 as the following properties of p, q, and w at
C         the interval endpoints are true or false, respectively.
C
C         P0ATA -  p(a) is zero.              (If true, A is singular.)
C         QFATA -  q(a) and w(a) are finite.  (If false, A is singular.)
C         P0ATB -  p(b) is zero.              (If true, B is singular.)
C         QFATB -  q(b) and w(b) are finite.  (If false, B is singular.)
C
C       A1 and A2 are input variables set to prescribe the boundary
C         condition at A.
C
C       B1 and B2 are input variables set to prescribe the boundary
C         condition at B.
C
C       NUMEIG is an integer variable.  On input, it should be set to
C         the index of the desired eigenvalue (increasing sequence where
C         index 0 corresponds to the lowest eigenvalue -- if the
C         eigenvalues are bounded below -- or to the smallest nonegative
C         eigenvalue otherwise).  On output, it is unchanged unless the
C         problem (apparently) lacks eigenvalue NUMEIG, in which case it
C         is reset to the index of the largest eigenvalue that seems to
C         exist.
C
C       EIG is a variable set on input to 0.0 or to an initial guess of
C         the eigenvalue.  If EIG is set to 0.0, SLEIGN2 will generate
C         the initial guess.  On output, EIG holds the calculated
C         eigenvalue if IFLAG (see below) signals success.
C
C       TOL is a variable set on input to the desired accuracy of the
C         eigenvalue.  On output, TOL is reset to the accuracy estimated
C         to have been achieved if IFLAG (see below) signals success.
C         This accuracy estimate is absolute if EIG is less than one
C         in magnitude, and relative otherwise.  In addition, prefixing
C         TOL with a negative sign, removed after interrogation, serves
C         as a flag to request trace output from the calculation.
C
C       IFLAG is an integer output variable set as follows:
C
C         IFLAG = 0 -  improper input parameters.
C         IFLAG = 1  - successful problem solution, within tolerance.
C         IFLAG = 2  - best problem result, not within tolerance.
C         IFLAG = 3  - NUMEIG exceeds actual highest eigenvalue index.
C         IFLAG = 4  - RAY and EIG fail to agree after 5 tries.
C         IFLAG = 6  - in SECANT-METHOD, ABS(DE) .LT. EPSMIN .
C         IFLAG = 7  - iterations are stuck in a loop.
C         IFLAG = 8  - number of iterations has reached the set limit.
C         IFLAG = 9  - residual truncation error dominates.
C         IFLAG = 10 - integrator tolerance cannot be reduced.
C         IFLAG = 11 - no more improvement.
C         IFLAG = 13 - AA cannot be moved in any further.
C         IFLAG = 14 - BB cannot be moved in any further.
c         iflag = 15 - Bad behavior of coefficients at an endpoint.
C         IFLAG = 16 - Could not get started.
C         IFLAG = 17 - Failed to get a bracket.
C         IFLAG = 18 - Estimator failed.
C         IFLAG = 51 - integration failure after 1st call to INTEG.
C         IFLAG = 52 - integration failure after 2nd call to INTEG.
C         IFLAG = 53 - integration failure after 3rd call to INTEG.
C         IFLAG = 54 - integration failure after 4th call to INTEG.
C
C       ISLFUN is an integer input variable set to the number of
C         selected eigenfunction values desired.  If no values are
C         desired, set ISLFUN to zero.
c         (If ISLFUN is set to -1, the result will be that SLEIGN2
c           will return to the calling program directly after sampling
c           the coefficients p,q,w .  This device is used only once,
c           in SUBROUTINE PERIO.)
C
C       SLFUN is an array of length at least 9.  On output, the first 9
C         locations contain the integration interval and initial data
C         that completely determine the eigenfunction.
C
C         SLFUN(1) - point where two pieces of eigenfunction Y match.
C         SLFUN(2) - left endpoint XAA of the (truncated) interval.
C         SLFUN(3) - value of THETA at XAA.  (Y = RHO*sin(THETA))
C         SLFUN(4) - value of F at XAA.  (RHO = exp(F))
C         SLFUN(5) - right endpoint XBB of the (truncated) interval.
C         SLFUN(6) - value of THETA at XBB.
C         SLFUN(7) - value of F at XBB.
C         SLFUN(8) - final value of integration accuracy parameter EPS.
C         SLFUN(9) - the constant Z in the polar form transformation.
C
C         F(XAA) and F(XBB) are chosen so that the eigenfunction is
C         continuous in the interval (XAA,XBB) and has weighted (by W)
C         L2-norm of 1.0 on the interval.  If ISLFUN is positive, then
C         on input the further ISLFUN locations of SLFUN specify the
C         points, in ascending order, where the eigenfunction values
C         are desired and on output contain the values themselves.
C
c       nca & ncb are integers which indicate the nature of the
c         endpoints a & b, respectively.  Namely:
c       nca = 1 : Endpoint a is REGULAR .
C             2 :     "         WEAKLY REGULAR .
C             3 :     "         LIMIT CIRCLE, NON-OSC .
C             4 :     "         LIMIT CIRCLE, OSC .
C             5 :     "         LIMIT POINT, REGULAR, AT FINITE PT.
C             6 :     "         LIMIT POINT, DEFAULT .
C             7 :     "         LIMIT POINT, AT INFINITY OR IRREG.
C             8 :     "         LIMIT POINT, BAD BEHAVIOR AT ENDPT.
C        ncb = 1 : Endpoint b is REGULAR .
C                  etc. as for nca .
C
C     **********
C  INPUT QUANTITIES: A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,
C                   NUMEIG,EIG,TOL,IFLAG,ISLFUN,SLFUN,NCA,NCB,PR
C  OUTPUT QUANTITIES: NUMEIG,EIG,TOL,IFLAG,SLFUN,
C                   MFS,MLS,PI,TWOPI,HPI,EPSMIN,Z,JAY,ZEE,
C                   AA,TMID,BB,DTHDAA,DTHDBB,MDTHZ,ADDD
C
C     .. Scalar Arguments ..
      REAL A,A1,A2,B,B1,B2,EIG,P0ATA,P0ATB,QFATA,QFATB,TOL
      INTEGER IFLAG,INTAB,ISLFUN,NCA,NCB,NUMEIG
C     ..
C     .. Array Arguments ..
      REAL SLFUN(9)
C     ..
C     .. Scalars in Common ..
      REAL A1S,A2S,AA,ASAV,B1S,B2S,BB,BSAV,DTHDAA,DTHDBB,
     +                 EIGSAV,EPSMIN,FA,FB,GQA,GQB,GWA,GWB,HPI,LPQA,
     +                 LPQB,LPWA,LPWB,P0ATAS,P0ATBS,PI,QFATAS,QFATBS,
     +                 TMID,TSAVEL,TSAVER,TWOPI,Z
      INTEGER IND,INTSAV,ISAVE,MDTHZ,MFS,MLS,MMWD,T21
      LOGICAL ADDD,PR
C     ..
C     .. Arrays in Common ..
      REAL TEE(100),TT(7,2),YS(200),YY(7,3,2),ZEE(100)
      INTEGER JAY(100),MMW(100),NT(2)
C     ..
C     .. Local Scalars ..
      REAL AA1,AAA,AAF,AAL,AAS,ALFA,ATHETA,BALLPK,BB1,BBB,
     +                 BBF,BBL,BBS,BESTAA,BESTBB,BETA,BSTEIG,BSTEPS,
     +                 BSTEST,BSTMID,CHLIM,CHNG,CONVC,DE,DEDW,DIST,
     +                 DTHDA,DTHDB,DTHDE,DTHDEA,DTHDEB,DTHETA,DTHOLD,
     +                 DTHOLY,EEE,EIGLO,EIGLT,EIGPI,EIGRT,EIGUP,EL,
     +                 ELIMUP,EMAX,EMIN,EOLD,EPS,EPSL,EPSM,ER1,ER1M,
     +                 ESTERR,FLO,FLOUP,FMAX,FUP,GUESS,OLDEST,OLDRAY,
     +                 OLRAYS,ONE,PIN,PT2,PT3,RAY,RLX,SAVAA,SAVBB,
     +                 SAVERR,SUM,T1,T2,T3,TAU,TAU0,TAUM,TMID1,TMP,U,V,
     +                 WL,ZZ
      INTEGER I,IMAX,IMID,IMIN,J,JFLAG,JJL,JJR,K,LOOP2,LOOP3,MF,ML,NEIG,
     +        NEIGST,NITER,NRAY,NTMP
      LOGICAL AOK,BOK,BRACKT,BRS,BRSS,CHEPS,CONVRG,ENDA,ENDB,EXIT,
     +        FIRSTT,GESS0,IOSC,LCOA,LCOB,LIMUP,LOGIC,NEWTF,NEWTON,
     +        OLNEWT,ONEDIG,THEGT0,THELT0,TRUNKA,TRUNKB
C     ..
C     .. Local Arrays ..
      REAL DELT(100),DS(100),EIGEST(200,4),PS(100),PSS(100),
     +                 QS(100),WS(100),XS(100)
C     ..
C     .. External Functions ..
      REAL EPSLON
      EXTERNAL EPSLON
C     ..
C     .. External Subroutines ..
      EXTERNAL AABB,EFDATA,EIGFCN,ESTIM,OBTAIN,PRELIM,RESET,SAMPLE,SAVE
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN,INT,MAX,MIN,SIGN
C     ..
C     .. Common blocks ..
c     COMMON /ALBE/LPWA,LPQA,LPWB,LPQB
      COMMON /ALBE/LPWA,LPQA,FA,GWA,GQA,LPWB,LPQB,FB,GWB,GQB
      COMMON /BCDATA/A1S,A2S,P0ATAS,QFATAS,B1S,B2S,P0ATBS,QFATBS
      COMMON /DATADT/ASAV,BSAV,INTSAV
      COMMON /DATAF/EIGSAV,IND
      COMMON /LP/MFS,MLS
      COMMON /PASS/YS,MMW,MMWD
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
      COMMON /TDATA/AA,TMID,BB,DTHDAA,DTHDBB,MDTHZ,ADDD
      COMMON /TEEZ/TEE
      COMMON /TEMP/TT,YY,NT
      COMMON /TSAVE/TSAVEL,TSAVER,ISAVE
      COMMON /Z1/Z
      COMMON /ZEEZ/JAY,ZEE
C     ..
C     To produce printout, set PR = .TRUE.
      PR = .true.
C
      IFLAG = 1
      ONE = 1.0D0
      EPSMIN = EPSLON(ONE)
        if(epsmin .le. 1.0d-12) epsmin = 1.0d-12
      PI = 4.0D0*ATAN(ONE)
      TWOPI = 2.0D0*PI
      HPI = 0.5D0*PI
      Z = 1.0D0
      NEIG = NUMEIG - 1
C
      LOGIC = 1 .LE. INTAB .AND. INTAB .LE. 4 .AND.
     +        P0ATA*QFATA*P0ATB*QFATB .NE. 0.0D0
      IF (INTAB.EQ.1) LOGIC = LOGIC .AND. A .LT. B
      IF (.NOT.LOGIC) THEN
          IFLAG = 0
          GO TO 150
      END IF
C
C     (JFLAG = 0 INDICATES FAILURE OF THE ESTIMATOR)
      JFLAG = 1
C
      CALL SAVE(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2)
C
      DO 5 I = 1,100
          JAY(I) = 0
          ZEE(I) = 1.0D0
    5 CONTINUE
C
      CALL SAMPLE(NCA,NCB,MF,ML,XS,PS,QS,WS,DS,DELT,EMIN,EMAX,IMIN,IMAX,
     +            AAA,BBB)

C       (MAKE MF,ML AVALABLE THROUGH COMMON/LP/ )
      MFS = MF
      MLS = ML
C
      EIGPI = NUMEIG*PI
      PIN = EIGPI + PI
      TAU = ABS(TOL)
      TAU0 = 0.001D0
      TAUM = MAX(TAU,EPSMIN)
      LIMUP = .FALSE.
      ELIMUP = EMAX
      GUESS = EIG
      GESS0 = ABS(EIG) .LE. (1D-7)
      LCOA = NCA .EQ. 4
      LCOB = NCB .EQ. 4
      IOSC = LCOA .OR. LCOB

      IF (GESS0) THEN
          CALL ESTIM(IOSC,PIN,MF,ML,PS,QS,WS,PSS,DS,DELT,TAU0,JJL,JJR,
     +               SUM,LIMUP,ELIMUP,EMAX,IMAX,IMIN,EL,WL,DEDW,BALLPK,
     +               EEE,JFLAG)
      END IF

      IF (JFLAG.EQ.0) THEN
          IF (PR) WRITE (T21,FMT=*) ' ESTIMATOR FAILED '
          IFLAG = 18
          RETURN
      END IF

      CALL PRELIM(MF,ML,EEE,BALLPK,XS,QS,WS,DS,DELT,PS,PSS,TAU0,JJL,JJR,
     +            LIMUP,ELIMUP,EL,WL,DEDW,GUESS,EIG,AAA,AA,BBB,BB,NCA,
     +            NCB,EIGPI,ALFA,BETA,DTHDEA,DTHDEB,IMID,TMID)

      IF (JAY(3).EQ.0 .AND. ZEE(2).NE.1.0D0) THEN
          IF (PR) WRITE (T21,FMT=*) ' COULD NOT GET STARTED. '
          IFLAG = 16
          RETURN
      END IF
C
      IF (NCA.EQ.8 .OR. NCB.EQ.8) THEN
C       (WE CAN'T HANDLE THIS KIND OF LIMIT POINT)
          IFLAG = 15
          RETURN
      END IF
C
      IF (ISLFUN.EQ.-1) THEN
          SLFUN(1) = TMID
          SLFUN(2) = AA
          SLFUN(3) = ALFA
          SLFUN(5) = BB
          SLFUN(6) = BETA + EIGPI
          SLFUN(9) = Z
          ADDD = .FALSE.
          MDTHZ = 0
          IFLAG = 1
          RETURN
      END IF
C
C     SET LOGICAL VARIABLES:
      AOK = INTAB .LT. 3.D0 .AND. P0ATA .LT. 0.0D0 .AND.
     +      QFATA .GT. 0.0D0
      BOK = (INTAB.EQ.1 .OR. INTAB.EQ.3) .AND. P0ATB .LT. 0.0D0 .AND.
     +      QFATB .GT. 0.0D0
      LCOA = NCA .EQ. 4
      LCOB = NCB .EQ. 4
      TRUNKA = LCOA .OR. (NCA.EQ.6)
      TRUNKB = LCOB .OR. (NCB.EQ.6)
C
C     END PRELIMINARY WORK, BEGIN MAIN TASK OF COMPUTING EIG.
C
C     LOGICAL VARIABLES HAVE THE FOLLOWING MEANINGS IF TRUE.
C        AOK    - ENDPOINT A IS NOT SINGULAR.
C        BOK    - ENDPOINT B IS NOT SINGULAR.
C        BRACKT - EIG HAS BEEN BRACKETED.
C        CONVRG - CONVERGENCE TEST FOR EIG HAS BEEN SUCCESSFULLY PASSED.
C        NEWTON - NEWTON ITERATION MAY BE EMPLOYED.
C        THELT0 - LOWER BOUND FOR EIG HAS BEEN FOUND.
C        THEGT0 - UPPER BOUND FOR EIG HAS BEEN FOUND.
C        LIMIT  - UPPER BOUND EXISTS WITH BOUNDARY CONDITIONS SATISFIED.
C        ONEDIG - MOST SIGNIFICANT DIGIT CAN BE EXPECTED TO BE CORRECT.
C
C     INITIALIZE SOME OF THE CONTROL VARIABLES
      EXIT = .FALSE.
      FIRSTT = .TRUE.
      LOOP2 = 0
      LOOP3 = 0
      PT2 = 0.0D0
      PT3 = 0.0D0
      ENDA = .FALSE.
      ENDB = .FALSE.
      EPSM = EPSMIN
      CHEPS = .FALSE.
      NEWTF = .FALSE.
      BRS = .FALSE.
      BRSS = .FALSE.
      SAVERR = 1.0D+9
      ATHETA = 1.0D+9
      BSTEST = 1.0D+9
      OLDEST = 1.0D+9
      OLDRAY = 1.0D+9
      NRAY = 1
      AAL = AA
      BBL = BB
      AAS = AA
      BBS = BB
      AAF = AAA
      BBF = BBB
      NEIGST = 0
      EIG = EEE
      BSTEIG = EIG
      EPS = 0.0001D0
      EPSL = EPS
      BESTAA = AA
      BESTBB = BB
      BSTMID = TMID
      BSTEPS = EPS
C
  110 CONTINUE
C       (INITIAL-IZE)
      BRACKT = .FALSE.
      CONVRG = .FALSE.
      THELT0 = .FALSE.
      THEGT0 = .FALSE.
      NEWTON = .FALSE.
      EIGLO = EMIN - 1.0D0
      FLO = -5.0D0
      FUP = 5.0D0
      EIGLT = 0.0D0
      EIGRT = 0.0D0
      EIGUP = EMAX + 1.0D0
      IF (LIMUP) EIGUP = MIN(EMAX,ELIMUP)
      DTHOLD = 1.0D0
C
      IF (PR) WRITE (T21,FMT=*)
      IF (PR) WRITE (T21,FMT=*)
     +    '---------------------------------------------'
      IF (PR) WRITE (T21,FMT=*) ' INITIAL GUESS FOR EIG = ',EIG
      IF (PR) WRITE (T21,FMT=*) ' AA,BB = ',AA,BB

C           (UNTIL(CONVRG .OR. EXIT)
      DO 120 NITER = 1,40
          IF (PR) WRITE (*,FMT=*)
          IF (PR) WRITE (*,FMT=*) ' ******************** '
          IF (PR) WRITE (*,FMT=*) ' EIGENVALUE ',NUMEIG
C
          CALL RESET(AA,BB,ALFA,BETA,EIG,GUESS,MF,ML,QS,WS,IMID,TMID,
     +               LIMUP,ELIMUP,DTHDEA,DTHDEB,THELT0,EIGLO,EIGUP,
     +               BRACKT,NCA,NCB,IFLAG)
          IF (IFLAG.EQ.11) THEN
c             EXIT = .TRUE.
c             GO TO 130
              GO TO 333
          END IF
C
          AA1 = AA
          BB1 = BB
          TMID1 = TMID
          IFLAG = 1
          CALL OBTAIN(NCA,ALFA,DTHDEA,NCB,BETA,DTHDEB,AA1,BB1,EIG,EIGPI,
     +                TMID1,EPS,DTHETA,DTHDE,ONEDIG,DTHDA,DTHDB,ER1,
     +                ER1M,IFLAG)
          IF (IFLAG.EQ.2) THEN
              AAS = AA
              BBS = BB
          END IF
          ATHETA = ABS(DTHETA)
          IF (51.LE.IFLAG .AND. IFLAG.LE.54) THEN
              EXIT = .TRUE.
              GO TO 130
          ELSE
              FIRSTT = .FALSE.
          END IF
C-----------------------------------------------------------
          CHEPS = .FALSE.
          CONVRG = .FALSE.
          OLNEWT = NEWTON
          NEWTON = ABS(DTHETA) .LT. 0.06D0 .AND. BRACKT
          IF (NEWTON) ONEDIG = ONEDIG .OR.
     +                         ABS(DTHETA+ER1) .LT. 0.5D0*DTHOLD
          IF (.NOT.ONEDIG .AND. BRS) THEN
              EXIT = .TRUE.
              IF (PR) WRITE (T21,FMT=*) ' NOT ONEDIG '
              GO TO 130
          END IF
C
          IF (PR) WRITE (*,FMT=*) ' SET BRACKET '
          IF (DTHETA.GT.0.0D0) THEN
              IF (.NOT.THEGT0 .OR. EIG.LE.EIGUP) THEN
                  THEGT0 = .TRUE.
                  EIGUP = EIG
                  FUP = DTHETA
                  EIGRT = EIG - DTHETA/DTHDE
              END IF
          ELSE
              IF (.NOT.THELT0 .OR. EIG.GE.EIGLO) THEN
                  THELT0 = .TRUE.
                  EIGLO = EIG
                  FLO = DTHETA
                  EIGLT = EIG - DTHETA/DTHDE
              END IF
          END IF
C
C     EIG IS BRACKETED WHEN BOTH THEGT0=.TRUE. AND THELT0=.TRUE.
C
          BRACKT = THELT0 .AND. THEGT0
          IF (BRACKT) LOOP2 = 0
C              (TEST-FOR-CONVERGENCE)
C
C     MEASURE CONVERGENCE AFTER ADDING SEPARATE CONTRIBUTIONS TO ERROR.
C
          FLOUP = MIN(ABS(FLO),ABS(FUP))
          T1 = (ABS(DTHETA)+ER1M)/ABS(DTHDE)
          IF (TRUNKA) THEN
              T2 = (1.0D0+AA)*ABS(DTHDA)/ABS(DTHDE)
              PT2 = (AAF-AA)*DTHDA/DTHDE
          ELSE
              T2 = 0.0D0
          END IF
          IF (TRUNKB) THEN
              T3 = (1.0D0-BB)*ABS(DTHDB)/ABS(DTHDE)
              PT3 = (BBF-BB)*DTHDB/DTHDE
          ELSE
              T3 = 0.0D0
          END IF
          IF (PR) WRITE (T21,FMT=*) ' FLO,FUP,FLOUP = ',FLO,FUP,FLOUP
          IF (PR) WRITE (T21,FMT=*) ' DTHDE,DTHDA,DTHDB = ',DTHDE,DTHDA,
     +        DTHDB
          ESTERR = T1 + T2 + T3
          CONVC = T1 + T2 + T3

          IF (BRACKT) THEN
              TMP = EIGUP - EIGLO
c             ESTERR = MIN(ESTERR,TMP)
              CONVC = MIN(ESTERR,TMP)
          END IF

 333      CONTINUE
          ESTERR = ESTERR/MAX(ONE,ABS(EIG))
          CONVC = CONVC/MAX(ONE,ABS(EIG))
          NEIGST = NEIGST + 1
          EIGEST(NEIGST,1) = EIG
          EIGEST(NEIGST,2) = DTHETA
          EIGEST(NEIGST,3) = ESTERR
          EIGEST(NEIGST,4) = 0.0D0
c         CONVRG = ESTERR .LE. TAUM .AND. NEWTON
          CONVRG = CONVC .LE. TAUM .AND. NEWTON
          IF (PR) WRITE (T21,FMT=*) ' T1,T2,T3 = ',T1,T2,T3
          IF (PR) WRITE (T21,FMT=*) ' PT2,PT3 = ',PT2,PT3
          IF (PR) WRITE (T21,FMT=*) ' TMID,EPS = ',TMID,EPS
          IF (PR) WRITE (T21,FMT=*) ' ONEDIG,BRACKT,NEWTON,CONVRG = ',
     +        ONEDIG,BRACKT,NEWTON,CONVRG
          IF (PR) WRITE (T21,FMT=*) ' EIG,DTHETA,ESTERR = ',EIG,DTHETA,
     +        ESTERR

          IF (BRACKT .AND. (ESTERR.LT.BSTEST.OR..NOT.BRS) .AND.
     +        T1.LT.0.1D0) THEN
              BESTAA = AA
              BESTBB = BB
              BSTMID = TMID
              BSTEPS = EPS
              BSTEIG = EIG
              BSTEST = ESTERR
              BRS = BRACKT
              IF (BRS) BRSS = BRS
              IF (PR) WRITE (T21,FMT=*) ' BSTEIG,BSTEST = ',BSTEIG,
     +            BSTEST
              IF (PR) WRITE (T21,FMT=*) ' BRS = ',BRS
          END IF

          IF (THEGT0 .AND. PR) WRITE (T21,FMT=*) '         EIGUP = ',
     +        EIGUP
          IF (THELT0 .AND. PR) WRITE (T21,FMT=*) '         EIGLO = ',
     +        EIGLO
          IF (PR) WRITE (T21,FMT=*)
     +        '-------------------------------------------'
          IF (CONVRG) THEN
              IF (PR) WRITE (*,FMT=*) ' NUMBER OF ITERATIONS WAS ',NITER
              IF (PR) WRITE (T21,FMT=*) ' NUMBER OF ITERATIONS WAS ',
     +            NITER
              IF (PR) WRITE (*,FMT=*)
     +            '-----------------------------------------'
              GO TO 130
          ELSE
              IF (NEWTON) THEN
                  IF (OLNEWT .AND. ATHETA.GT.0.8D0*ABS(DTHOLD)) THEN
                      IF (PR) WRITE (T21,FMT=*) ' ATHETA,DTHOLD = ',
     +                    ATHETA,DTHOLD
                      IF (PR) WRITE (T21,FMT=*
     +                    ) ' NEWTON DID NOT IMPROVE EIG '
                      NEWTF = .TRUE.
                      LOOP3 = LOOP3 + 1
                  ELSE IF (TRUNKA .OR. TRUNKB) THEN
                      ENDA = ATHETA .LT. 1.0D0 .AND. TRUNKA .AND.
     +                       ABS(PT2) .GT. MAX(TAUM,T1)
                      ENDB = ATHETA .LT. 1.0D0 .AND. TRUNKB .AND.
     +                       ABS(PT3) .GT. MAX(TAUM,T1)
                      IF (ENDA .OR. ENDB) THEN
                          NEWTON = .FALSE.
                      ELSE IF (((T2+T3).GT.T1) .AND.
     +                         (ATHETA.LT.1.0D0) .AND.
     +                         (AA.LE.AAF.AND.BB.GE.BBF)) THEN
                          IF (PR) WRITE (*,FMT=*
     +                        ) ' RESIDUAL TRUNCATION ERROR DOMINATES '
                          EXIT = .TRUE.
                          IFLAG = 9
                          IF (PR) WRITE (T21,FMT=*) ' IFLAG = 9 '
                          GO TO 130
                      END IF
                  END IF
                  IF (NEWTF .OR. ENDA .OR. ENDB) THEN
                      IF (PR) WRITE (T21,FMT=*) ' NEWTF,ENDA,ENDB = ',
     +                    NEWTF,ENDA,ENDB
                      EXIT = .TRUE.
                      GO TO 130
                  END IF
C                  (NEWTON'S-METHOD)
                  IF (PR) WRITE (*,FMT=*) ' NEWTON''S METHOD '
                  RLX = 1.2D0
                  IF (BRACKT) RLX = 1.0D0
                  EIG = EIG - RLX*DTHETA/DTHDE
                  IF (EIG.LE.EIGLO .OR. EIG.GE.EIGUP) EIG = 0.5D0*
     +                (EIGLO+EIGUP)
                  IF (PR) WRITE (T21,FMT=*) ' NEWTON: EIG = ',EIG
              ELSE IF (BRACKT) THEN
                  IF (PR) WRITE (*,FMT=*) ' BRACKET '
C                  (SECANT-METHOD)
                  IF (PR) WRITE (*,FMT=*) ' DO SECANT METHOD '
                  FMAX = MAX(-FLO,FUP)
                  EOLD = EIG
                  EIG = 0.5D0* (EIGLO+EIGUP)
                  IF (FMAX.LE.1.5D0) THEN
                      U = -FLO/ (FUP-FLO)
                      DIST = EIGUP - EIGLO
                      EIG = EIGLO + U*DIST
                      V = MIN(EIGLT,EIGRT)
                      IF (EIG.LE.V) EIG = 0.5D0* (EIG+V)
                      V = MAX(EIGLT,EIGRT)
                      IF (EIG.GE.V) EIG = 0.5D0* (EIG+V)
                      DE = EIG - EOLD
                      IF (ABS(DE).LT.EPSMIN) THEN
                          TOL = ABS(DE)/MAX(ONE,ABS(EIG))
                          IFLAG = 6
                          EXIT = .TRUE.
                          GO TO 130
                      END IF
                  END IF
                  IF (PR) WRITE (T21,FMT=*) ' SECANT: EIG = ',EIG
              ELSE
C                  (TRY-FOR-BRACKET)
                  LOOP2 = LOOP2 + 1
                  IF (LOOP2.GT.9 .AND. .NOT.LIMUP) THEN
                      IFLAG = 12
                      IF (PR) WRITE (T21,FMT=*) ' IFLAG = 12 '
                      EXIT = .TRUE.
                      GO TO 130
                  END IF
                  IF (EIG.EQ.EEE) THEN
                      IF (GUESS.NE.0.0D0) DEDW = 1.0D0/DTHDE
                      CHNG = -0.6D0* (DEDW+1.0D0/DTHDE)*DTHETA
                      IF (EIG.NE.0.0D0 .AND. ABS(CHNG).GT.
     +                    0.1D0*ABS(EIG)) CHNG = -0.1D0*SIGN(EIG,DTHETA)
                  ELSE
                      CHNG = -1.2D0*DTHETA/DTHDE
                      IF (CHNG.EQ.0.D0) CHNG = 0.1D0*MAX(ONE,ABS(EIG))
                      IF (PR) WRITE (T21,FMT=*
     +                    ) ' IN BRACKET, 1,CHNG = ',CHNG
C
C     LIMIT CHANGE IN EIG TO A FACTOR OF 2.
C
                      IF (ABS(CHNG).GT. (1.0D0+2.0D0*ABS(EIG))) THEN
                          TMP = 1.0D0+2.0D0*ABS(EIG)
                          CHNG = SIGN(TMP,CHNG)
                          IF (PR) WRITE (T21,FMT=*
     +                        ) ' IN BRACKET, 2,CHNG = ',CHNG
                      ELSE IF (ABS(EIG).GE.1.0D0 .AND.
     +                         ABS(CHNG).LT.0.1D0*ABS(EIG)) THEN
                          CHNG = 0.1D0*SIGN(EIG,CHNG)
                          IF (PR) WRITE (T21,FMT=*
     +                        ) ' IN BRACKET, 3,CHNG = ',CHNG
                      END IF
                      IF (DTHOLD.LT.0.0D0 .AND. LIMUP .AND.
     +                    CHNG.GT. (ELIMUP-EIG)) THEN
                          CHNG = 0.95D0* (ELIMUP-EIG)
                          IF (PR) WRITE (T21,FMT=*
     +                        ) ' ELIMUP,EIG,CHNG = ',ELIMUP,EIG,CHNG
                          IF (CHNG.LT.EPSMIN) THEN
                              IF (PR) WRITE (*,FMT=*) ' ELIMUP,EIG = ',
     +                            ELIMUP,EIG
                              IF (PR) WRITE (T21,FMT=*
     +                            ) ' IN BRACKET, CHNG.LT.EPSMIN '
                              ENDA = TRUNKA .AND. AA .GT. AAF .AND.
     +                               (0.5D0*DTHETA+ (AAF-AA)*DTHDA) .GT.
     +                               0.0D0
                              ENDB = TRUNKB .AND. BB .LT. BBF .AND.
     +                               (0.5D0*DTHETA- (BBF-BB)*DTHDB) .GT.
     +                               0.0D0
                              IF (.NOT. (ENDA.OR.ENDB)) THEN
                                  NUMEIG = NEIG - INT(-DTHETA/PI)
                                  IF (PR) WRITE (*,FMT=*
     +                                ) ' NEW NUMEIG = ',NUMEIG
                                  IF (PR) WRITE (T21,
     +                                FMT=*) ' NEW NUMEIG = ',NUMEIG
                              END IF
                              IFLAG = 3
                              GO TO 150
                          END IF
                      END IF
                  END IF
                  EOLD = EIG
                  CHLIM = 2.0D0*ESTERR*MAX(ONE,ABS(EIG))
                  IF (ATHETA.LT.0.06D0 .AND. ABS(CHNG).GT.CHLIM .AND.
     +                CHLIM.NE.0.0D0) CHNG = SIGN(CHLIM,CHNG)
                  IF ((THELT0.AND.CHNG.LT.0.0D0) .OR.
     +                (THEGT0.AND.CHNG.GT.0.0D0)) CHNG = -CHNG
                  EIG = EIG + CHNG
                  IF (PR) WRITE (T21,FMT=*) ' BRACKET: EIG = ',EIG
              END IF
          END IF
          IF (IFLAG.EQ.3) GO TO 130
          IF (NITER.GE.3 .AND. DTHOLY.EQ.DTHETA) THEN
              IFLAG = 7
              IF (PR) WRITE (T21,FMT=*) ' IFLAG = 7 '
              BSTEIG = EIG
              BSTEST = ESTERR
              EXIT = .TRUE.
              GO TO 130
          END IF
          DTHOLY = DTHOLD
          DTHOLD = DTHETA
          IF (PR) WRITE (*,FMT=*) ' NUMBER OF ITERATIONS WAS ',NITER
          IF (PR) WRITE (*,FMT=*)
     +        '-----------------------------------------------'
  120 CONTINUE
      IFLAG = 8
      IF (PR) WRITE (T21,FMT=*) ' IFLAG = 8 '
      EXIT = .TRUE.
  130 CONTINUE
      IF (AA.EQ.AAL .AND. BB.EQ.BBL .AND. EPS.LT.EPSL .AND.
     +    ESTERR.GE.0.5D0*SAVERR .AND. .NOT.EXIT) GO TO 140
      EPSL = EPS
      AAL = AA
      BBL = BB
      TOL = BSTEST
      EIG = BSTEIG
      IF (EXIT) THEN
          IF (PR) WRITE (T21,FMT=*) ' EXIT '
          IF (FIRSTT) THEN
              IF (IFLAG.EQ.51 .OR. IFLAG.EQ.53) THEN
                  IF (AA.LT.-0.71D0) THEN
                      IF (PR) WRITE (T21,FMT=*
     +                    ) ' FIRST COMPLETE INTEGRATION FAILED. '
                      IF (AA.EQ.-1.0D0) GO TO 150
                      AAF = AA
                      CALL AABB(AA,-ONE)
                      IF (PR) WRITE (T21,FMT=*) ' AA MOVED FROM ',AAF,
     +                    ' IN TO ',AA
                      EXIT = .FALSE.
                      GO TO 110
                  ELSE
                      IF (PR) WRITE (T21,FMT=*) ' AA.GE.-0.71 '
                      IFLAG = 13
                      GO TO 150
                  END IF
              ELSE IF (IFLAG.EQ.52 .OR. IFLAG.EQ.54) THEN
                  IF (BB.GT.0.71D0) THEN
                      IF (PR) WRITE (T21,FMT=*
     +                    ) ' FIRST COMPLETE INTEGRATION FAILED. '
                      IF (BB.EQ.1.0D0) GO TO 150
                      BBF = BB
                      CALL AABB(BB,-ONE)
                      IF (PR) WRITE (T21,FMT=*) ' BB MOVED FROM ',BBF,
     +                    ' IN TO ',BB
                      EXIT = .FALSE.
                      GO TO 110
                  ELSE
                      IF (PR) WRITE (T21,FMT=*) ' BB.LE.0.71 '
                      IFLAG = 14
                      GO TO 150
                  END IF
              END IF
          ELSE IF (IFLAG.EQ.51 .OR. IFLAG.EQ.53) THEN
              IF (PR) WRITE (*,FMT=*) ' A COMPLETE INTEGRATION FAILED. '
              IF (PR) WRITE (T21,FMT=*)
     +            ' A COMPLETE INTEGRATION FAILED. '
              IF (CHEPS) THEN
                  EPS = 5.0D0*EPS
                  EPSM = EPS
                  IF (PR) WRITE (T21,FMT=*) ' EPS INCREASED TO ',EPS
              ELSE
                  AAF = AA
                  CALL AABB(AA,-ONE)
                  IF (PR) WRITE (T21,FMT=*) ' AA MOVED FROM ',AAF,
     +                ' IN TO ',AA
              END IF
              EXIT = .FALSE.
              GO TO 110
          ELSE IF (IFLAG.EQ.52 .OR. IFLAG.EQ.54) THEN
              IF (PR) WRITE (*,FMT=*) ' A COMPLETE INTEGRATION FAILED. '
              IF (PR) WRITE (T21,FMT=*)
     +            ' A COMPLETE INTEGRATION FAILED. '
              IF (CHEPS) THEN
                  EPS = 5.0D0*EPS
                  EPSM = EPS
                  IF (PR) WRITE (T21,FMT=*) ' EPS INCREASED TO ',EPS
              ELSE
                  BBF = BB
                  CALL AABB(BB,-ONE)
                  IF (PR) WRITE (T21,FMT=*) ' BB MOVED FROM ',BBF,
     +                ' IN TO ',BB
              END IF
              EXIT = .FALSE.
              GO TO 110
          ELSE IF (IFLAG.EQ.6) THEN
              IF (PR) WRITE (*,FMT=*) ' IN SECANT, CHNG.LT.EPSMIN '
              IF (PR) WRITE (T21,FMT=*) ' IN SECANT, CHNG.LT.EPSMIN '
              GO TO 140
          ELSE IF (IFLAG.EQ.7) THEN
              IF (PR) WRITE (*,FMT=*) ' DTHETA IS REPEATING '
              IF (PR) WRITE (T21,FMT=*) ' DTHETA IS REPEATING '
              GO TO 140
          ELSE IF (IFLAG.EQ.8) THEN
              IF (PR) WRITE (*,FMT=*)
     +            ' NUMBER OF ITERATIONS REACHED SET LIMIT '
              IF (PR) WRITE (T21,FMT=*)
     +            ' NUMBER OF ITERATIONS REACHED SET LIMIT '
              GO TO 140
          ELSE IF (IFLAG.EQ.9) THEN
              IF (PR) WRITE (T21,FMT=*)
     +            ' RESIDUAL TRUNCATION ERROR DOMINATES '
              GO TO 140
          ELSE IF (IFLAG.EQ.11) THEN
              IF (PR) WRITE (*,FMT=*)
     +            ' IN TRY FOR BRACKET, CHNG.LT.EPSMIN '
              IF (PR) WRITE (T21,FMT=*)
     +            ' IN TRY FOR BRACKET, CHNG.LT.EPSMIN '
              GO TO 140
          ELSE IF (IFLAG.EQ.12) THEN
              IF (PR) WRITE (*,FMT=*) ' FAILED TO GET A BRACKET. '
              IF (PR) WRITE (T21,FMT=*) ' FAILED TO GET A BRACKET. '
              GO TO 140
          ELSE IF (NEWTF .OR. .NOT.ONEDIG) THEN
              IF (LOOP3.GE.3) THEN
                  IF (PR) WRITE (T21,FMT=*)
     +                ' NEWTON IS NOT GETTING ANYWHERE '
                  NEWTF = .FALSE.
                  GO TO 140
              END IF
              IF (PR) WRITE (T21,FMT=*) ' BSTEST,OLDEST = ',BSTEST,
     +            OLDEST
              IF (EPS.GT.EPSM .AND. BSTEST.LT.OLDEST) THEN
                  CHEPS = .TRUE.
                  SAVERR = ESTERR
                  EPS = 0.2D0*EPS
                  IF (BSTEST.LT.0.001D0) EPS = EPSM
                  IF (PR) WRITE (T21,FMT=*) ' EPS REDUCED TO ',EPS
                  EXIT = .FALSE.
                  NEWTON = .FALSE.
                  OLDEST = BSTEST
                  GO TO 110
              ELSE
                  IF (EPS.LE.EPSM) THEN
                      IF (PR) WRITE (T21,FMT=*
     +                    ) ' EPS CANNOT BE REDUCED FURTHER. '
                      IFLAG = 2
                      GO TO 140
                  ELSE
                      IF (PR) WRITE (*,FMT=*) ' NO MORE IMPROVEMENT '
                      IF (PR) WRITE (T21,FMT=*) ' NO MORE IMPROVEMENT '
                      GO TO 140
                  END IF
              END IF
          ELSE IF (ENDA) THEN
              CALL AABB(AA,ONE)
              AA = MAX(AA,AAA)
              IF (AA.LE.AAF) THEN
                  IF (PR) WRITE (T21,FMT=*) ' NO MORE IMPROVEMENT '
                  CALL AABB(AA,-ONE)
                  GO TO 140
              END IF
              IF (PR) WRITE (*,FMT=*) ' AA MOVED OUT TO ',AA
              IF (PR) WRITE (T21,FMT=*) ' AA MOVED OUT TO ',AA
              EXIT = .FALSE.
              GO TO 110
          ELSE IF (ENDB) THEN
              CALL AABB(BB,ONE)
              BB = MIN(BB,BBB)
              IF (BB.GE.BBF) THEN
                  IF (PR) WRITE (T21,FMT=*) ' NO MORE IMPROVEMENT '
                  CALL AABB(BB,-ONE)
                  GO TO 140
              END IF
              IF (PR) WRITE (*,FMT=*) ' BB MOVED OUT TO ',BB
              IF (PR) WRITE (T21,FMT=*) ' BB MOVED OUT TO ',BB
              EXIT = .FALSE.
              GO TO 110
          END IF
      END IF
  140 CONTINUE
C
C     IF CONVRG IS FALSE, CHECK THAT ANY TRUNCATION ERROR MIGHT POSSIBLY
C     BE REDUCED OR THAT THE INTEGRATIONS MIGHT BE DONE MORE ACCURATELY.
C
      IF (.NOT.CONVRG .AND. IFLAG.LT.50 .AND. IFLAG.NE.11) THEN
          SAVAA = AA
          SAVBB = BB
          IF (EPS.GT.EPSM .AND. ESTERR.LT.0.5D0*SAVERR) THEN
              IF (PR) WRITE (T21,FMT=*) ' SAVERR,ESTERR = ',SAVERR,
     +            ESTERR
              SAVERR = ESTERR
              EPS = 0.2D0*EPS
              IF (ESTERR.LT.0.001D0) EPS = EPSM
              IF (PR) WRITE (T21,FMT=*) ' 2,EPS REDUCED TO ',EPS
              EXIT = .FALSE.
              NEWTON = .FALSE.
              IF (DTHOLY.EQ.DTHETA) THEN
                  BSTEST = ESTERR
                  BSTEIG = EIG
              END IF
              OLDEST = BSTEST
              GO TO 110
          ELSE IF (ABS(PT2).GT.TAUM .OR. ABS(PT3).GT.TAUM) THEN
              IF ((AAS-AAF).GT.2.0D0*EPSMIN .AND. ABS(PT2).GT.TAUM) THEN
                  CALL AABB(AA,ONE)
                  AA = MAX(AA,AAA)
                  IF (AA.GT.AAF .AND. AA.LT.SAVAA) THEN
                      IF (PR) WRITE (*,FMT=*) ' AA MOVED OUT TO ',AA
                      IF (PR) WRITE (T21,FMT=*) ' 3,AA MOVED OUT TO ',AA
                      EXIT = .FALSE.
                  END IF
              END IF
              IF ((BBF-BBS).GT.2.0D0*EPSMIN .AND. ABS(PT3).GT.TAUM) THEN
                  CALL AABB(BB,ONE)
                  BB = MIN(BB,BBB)
                  IF (BB.GT.SAVBB .AND. BB.LT.BBF) THEN
                      IF (PR) WRITE (*,FMT=*) ' BB MOVED OUT TO ',BB
                      IF (PR) WRITE (T21,FMT=*) ' 3,BB MOVED OUT TO ',BB
                      EXIT = .FALSE.
                  END IF
              END IF
              IF (.NOT.EXIT .AND. (AA.NE.SAVAA.OR.BB.NE.SAVBB))
     +            GO TO 110
          END IF
      END IF
      IF (PR) WRITE (T21,FMT=*) 'NUMEIG = ',NUMEIG,' EIG = ',EIG,
     +    ' TOL = ',TOL
      IF (BRSS .AND. BSTEST.LT.0.05D0) THEN

C          DO (COMPUTE-EIGENFUNCTION-DATA)
          EPS = BSTEPS
          CALL EFDATA(ALFA,DTHDEA,A1,A2,BETA,DTHDEB,B1,B2,EIG,EIGPI,EPS,
     +                AOK,NCA,BOK,NCB,RAY,SLFUN)
C
C     IF NEXT CONDITION IS .TRUE., THEN SOMETHING IS APPARENTLY WRONG
C     WITH THE ACCURACY OF EIG. BISECT AND GO THROUGH THE LOOP AGAIN.
C
          IF (PR) WRITE (T21,FMT=*) ' EIG,RAY = ',EIG,RAY
          IF (ABS(RAY-EIG).GT.2.0D0*TAUM*MAX(ONE,ABS(EIG))) THEN
              NRAY = NRAY + 1
              IF (PR) WRITE (*,FMT=*) ' NRAY = ',NRAY
              IF (PR) WRITE (T21,FMT=*) ' NRAY,RAY,OLDRAY = ',NRAY,RAY,
     +            OLDRAY
              IF (ESTERR.GE.0.5D0*SAVERR) THEN
                  IFLAG = 2
                  GO TO 150
              END IF
              TMP = EIG
              EIG = 0.5D0* (EIG+RAY)
              OLRAYS = OLDRAY
              OLDRAY = RAY
              IF (OLDRAY.NE.OLRAYS .AND. NRAY.LT.2) THEN
                  GO TO 110
              ELSE
                  EIG = TMP
              END IF
          END IF
C     DO (GENERATE-EIGENFUNCTION-VALUES)
          CALL EIGFCN(EIGPI,A1,A2,B1,B2,AOK,BOK,NCA,NCB,SLFUN,ISLFUN)
          IFLAG = 1
      END IF
C
C     IF THE ESTIMATED ACCURACY IMPLIES THAT THE COMPUTED VALUE
C     OF THE EIGENVALUE IS UNCERTAIN, SIGNAL BY IFLAG = 2.
C
      IF ((ABS(EIG).LE.ONE.AND.TOL.GE.ABS(EIG)) .OR.
     +    (ABS(EIG).GT.ONE.AND.TOL.GE.ONE)) IFLAG = 2
  150 CONTINUE
      IF ((IFLAG.EQ.2) .OR. (6.LE.IFLAG.AND.IFLAG.LE.11)) THEN
          NTMP = 1
          IF (NEIGST.GE.10) NTMP = NEIGST - 9
          K = NTMP
          TMP = EIGEST(NTMP,4)
          DO 160 I = NTMP,NEIGST
              IF (EIGEST(I,4).LT.TMP) THEN
                  K = I
                  TMP = EIGEST(I,4)
              END IF
  160     CONTINUE
          J = K
          TMP = EIGEST(K,3)
          DO 155 I = K,NEIGST
              IF (EIGEST(I,3).LT.TMP) THEN
                  J = I
                  TMP = EIGEST(I,3)
              END IF
  155     CONTINUE
          EIG = EIGEST(J,1)
          TOL = EIGEST(J,3)
          IFLAG = 2
      END IF
C
C     TO BE SAFE, RESET AA,BB,EPS:-
      AA = BESTAA
      BB = BESTBB
      EPS = BSTEPS
C
      ZZ = -100000.0D0
      IF (NCA.GE.5 .OR. NCB.GE.5) THEN
          ZZ = 1.0D+19
          IF (LIMUP) ZZ = ELIMUP
      END IF
      SLFUN(9) = ZZ

      IF (PR) WRITE (T21,FMT=*) ' BEST AA,BB,TMID,EPS = ',BESTAA,BESTBB,
     +    BSTMID,BSTEPS
      IF (PR) WRITE (T21,FMT=*) ' BRS,BSTEIG,BSTEST = ',BRS,BSTEIG,
     +    BSTEST
      IF (PR) WRITE (T21,FMT=*) ' IFLAG = ',IFLAG
      IF (PR) WRITE (T21,FMT=*)
     +    '********************************************'
      IF (PR) WRITE (T21,FMT=*)
      IF (PR) WRITE (T21,FMT=*) ' EIGEST = '
      DO 1211 I = 1,NEIGST
          IF (PR) WRITE (T21,FMT=*) EIGEST(I,1),EIGEST(I,2),EIGEST(I,3)
 1211 CONTINUE
C-----------------------------------------------------------
C
      RETURN
      END
C
      SUBROUTINE SAVE(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2)

C  THIS PROGRAM SIMPLY SAVES THE CALLING ARGUMENTS IN
C    TWO COMMON BLOCKS FOR USE WHEREVER NEEDED.
C    IT IS CALLED BY SLEIGN.
C
C     .. Scalar Arguments ..
      REAL A,A1,A2,B,B1,B2,P0ATA,P0ATB,QFATA,QFATB
      INTEGER INTAB
C     ..
C     .. Scalars in Common ..
      REAL A1S,A2S,ASAV,B1S,B2S,BSAV,P0ATAS,P0ATBS,QFATAS,
     +                 QFATBS
      INTEGER INTSAV
C     ..
C     .. Common blocks ..
      COMMON /BCDATA/A1S,A2S,P0ATAS,QFATAS,B1S,B2S,P0ATBS,QFATBS
      COMMON /DATADT/ASAV,BSAV,INTSAV
C     ..
      ASAV = A
      BSAV = B
      INTSAV = INTAB
      P0ATAS = P0ATA
      QFATAS = QFATA
      P0ATBS = P0ATB
      QFATBS = QFATB
      A1S = A1
      A2S = A2
      B1S = B1
      B2S = B2
      IF (A1S.LT.0.0D0) THEN
          A1S = -A1S
          A2S = -A2S
      END IF
      IF (B1S.LT.0.0D0) THEN
          B1S = -B1S
          B2S = -B2S
      END IF
      RETURN
      END
C
      SUBROUTINE THUM(MF,ML,XS)
C     **********
C
C    THIS PROGRAM DETERMINES THE NUMBER OF CHANGES OF SIGN OF
C    THE BOUNDARY CONDITION FUNCTION U (OF THE PAIR (U,V))
C    WHICH THE USER SUPPLIES.  IT IS NEEDED ONLY IF ONE OF THE
C    ENDPOINTS OF THE INTERVAL (A,B) IS LCO.
C    IT IS CALLED BY SLEIGN.
C
C  YS IS LIKE XS, BUT HAS TWICE AS MANY POINTS.
C  MMW(N) IS THE VALUE OF THE INDEX I OF U(I), MF .LE. I .LE. 2*ML-2,
C    WHERE U FOR THE NTH TIME CHANGES SIGN FROM - TO +
C    AND WHERE P*U' IS POSITIVE.
C  MMWD IS THE NUMBER OF SUCH POINTS OF U.
C  THE QUANTITIES YS, MMW, MMWD ARE NEEDED BY SUBROUTINE SETTHU.
C
C  INPUT QUANTITIES: MF,ML,XS
C  OUTPUT QUANTITIES: YS,MMW,MMWD
C     **********
C     .. Scalars in Common ..
      INTEGER MMWD
C     ..
C     .. Arrays in Common ..
      REAL YS(200)
      INTEGER MMW(100)
C     ..
C     .. Local Scalars ..
C
      REAL PUP,PUP1,TMP1,TMP2,TMP3,TMP4,U,U1
      INTEGER I,N
C     ..
C     .. Common blocks ..
      COMMON /PASS/YS,MMW,MMWD
C     ..
C     .. Scalar Arguments ..
      INTEGER MF,ML
C     ..
C     .. Array Arguments ..
      REAL XS(*)
C     ..
C     .. External Subroutines ..
      EXTERNAL UV
C     ..
      DO 10 I = 1,99
          YS(2*I-1) = XS(I)
          YS(2*I) = 0.5D0* (XS(I)+XS(I+1))
   10 CONTINUE
      YS(199) = XS(100)
      N = 0
      U1 = 0.0D0
      PUP1 = 0.0D0
      DO 20 I = 2*MF - 1,2*ML - 1
          CALL UV(YS(I),U,PUP,TMP1,TMP2,TMP3,TMP4)
          IF (U1.LT.0.0D0 .AND. U.GT.0.0D0 .AND. PUP1.GT.0.0D0) THEN
              N = N + 1
              MMW(N) = I - 1
          END IF
          U1 = U
          PUP1 = PUP
   20 CONTINUE
      MMWD = N
      RETURN
      END
C
      SUBROUTINE AABB(TEND,OUT)

C  THIS PROGRAM IS FOR THE PURPOSE OF MOVING THE TRUNCATED ENDPOINTS,
C    AA OR BB, EITHER FURTHER OUT TOWARDS -1 OR +1, OR CLOSER IN,
C    DEPENDING ON THE SIGN OF OUT.
C    IT IS CALLED BY SLEIGN AND BY EFDATA.

C  INPUT QUANTITIES: TEND,OUT
C  OUTPUT QUANTITIES: TEND
C
C     .. Scalar Arguments ..
      REAL OUT,TEND
C     ..
C     .. Local Scalars ..
      REAL S,SEND
      INTEGER I,J
C     ..
C     .. Local Arrays ..
      REAL U(15)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS
C     ..
      U(1) = 0.7D0
      U(2) = 0.8D0
      U(3) = 0.9D0
      U(4) = 0.95D0
      U(5) = 0.99D0
      U(6) = 0.999D0
      U(7) = 0.9999D0
      U(8) = 0.99999D0
      U(9) = 0.999999D0
      U(10) = 0.9999999D0
      U(11) = 1.0D0
c
      S = ABS(TEND)
      J = 9
      DO 10 I = 1,9
          IF (U(I).LT.S .AND. S.LE.U(I+1)) J = I
   10 CONTINUE
      IF (OUT.GT.0.0D0) THEN
          SEND = U(J+1)
          IF (S.EQ.SEND .AND. J.LT.10) SEND = U(J+2)
      ELSE
          SEND = U(J)
      END IF
      IF (SEND*TEND.LT.0.0D0) SEND = -SEND
      TEND = SEND
      RETURN
      END
C
      SUBROUTINE OBTAIN(NCA,ALFA,DTHDEA,NCB,BETA,DTHDEB,AA,BB,EIG,EIGPI,
     +                  TMID,EPS,DTHETA,DTHDE,ONEDIG,DTHDA,DTHDB,ER1,
     +                  ER1M,JFLAG)
C
C  THIS PROGRAM OBTAINS THE DIFFERENCE, DTHETA, BETWEEN THE VALUES
C    OF THETA OBTAINED BY INTEGRATING THE INITIAL VALUE PROBLEMS FOR
C    THETA FROM (OR NEAR) THE TWO ENDS OF THE INTERVAL (A,B) TO XMID.
C    THIS DIFFERENCE VANISHES WHEN THE VALUE BEING USED FOR THE
C     EIGENPARAMETER, EIG, IS EQUAL TO AN EIGENVALUE FOR THE PROBLEM.
C    IT IS CALLED BY SLEIGN.
C
C  INPUT QUANTITIES: NCA,ALFA,DTHDEA,NCB,BETA,DTHDEB,
C                    AA,BB,EIG,EIGPI,TMID,EPS,PI,TWOPI,HPI,
C                    A1,A2,P0ATA,QFATA,B1,B2,P0ATB,QFATB,
C                    A,B,INTAB,PR
C  OUTPUT QUANTITIES: EIGSAV,IND,ISAVE,TSAVEL,TSAVER,DTHDAA,
C                     DTHDBB,DTHETA,DTHDE,ONEDIG,DTHZ,
C                     MDTHZ,TSAVEL,TSAVER,ISAVE,JFLAG,
C                     DTHDA,DTHDB,ER1,ER1M
C     .. Scalar Arguments ..
      REAL AA,ALFA,BB,BETA,DTHDA,DTHDB,DTHDE,DTHDEA,DTHDEB,
     +                 DTHETA,EIG,EIGPI,EPS,ER1,ER1M,TMID
      INTEGER JFLAG,NCA,NCB
      LOGICAL ONEDIG
C     ..
C     .. Scalars in Common ..
      REAL A,A1,A2,AAS,B,B1,B2,BBS,DTHDAA,DTHDBB,EIGSAV,HPI,
     +                 P0ATA,P0ATB,PI,QFATA,QFATB,TMIDS,TSAVEL,TSAVER,
     +                 TWOPI
      INTEGER IND,INTAB,ISAVE,MDTHZ,T21
      LOGICAL ADDD,PR
C     ..
C     .. Local Scalars ..
      REAL ATHETA,C,DT,DTHZ,ER2,PX,QX,REMZ,THA,THB,WX,X
      INTEGER IFLAG
      LOGICAL AOK,BOK,LCA,LCB,LCOA,LCOB,SINGA,SINGB
C     ..
C     .. Local Arrays ..
      REAL ERL(3),ERR(3),YL(3),YR(3),YZL(3),YZR(3)
C     ..
C     .. External Functions ..
      REAL P,Q,W
      EXTERNAL P,Q,W
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,INTEG
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,COS,EXP,MAX,SIN
C     ..
C     .. Common blocks ..
      COMMON /BCDATA/A1,A2,P0ATA,QFATA,B1,B2,P0ATB,QFATB
      COMMON /DATADT/A,B,INTAB
      COMMON /DATAF/EIGSAV,IND
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /TDATA/AAS,TMIDS,BBS,DTHDAA,DTHDBB,MDTHZ,ADDD
      COMMON /TSAVE/TSAVEL,TSAVER,ISAVE
C     ..
      AOK = INTAB .LT. 3.D0 .AND. P0ATA .LT. 0.0D0 .AND.
     +      QFATA .GT. 0.0D0
      BOK = (INTAB.EQ.1 .OR. INTAB.EQ.3) .AND. P0ATB .LT. 0.0D0 .AND.
     +      QFATB .GT. 0.0D0
      LCA = NCA .EQ. 3 .OR. NCA .EQ. 4
      LCB = NCB .EQ. 3 .OR. NCB .EQ. 4
      LCOA = NCA .EQ. 4
      LCOB = NCB .EQ. 4
      SINGA = NCA .GE. 3
      SINGB = NCB .GE. 3
c     JFLAG = 0
      jflag = 0
      IND = 1
C  INITIALIZE TSAVEL, TSAVER, DTHDAA
      TSAVEL = -1.0D0
      TSAVER = 1.0D0
      IF (PR) WRITE (*,FMT=*) ' OBTAIN DTHETA '
      THA = ALFA
      DTHDAA = 0.0D0
      IF (SINGA .AND. .NOT.LCA) THEN
          CALL DXDT(AA,DT,X)
          PX = P(X)
          QX = Q(X)
          WX = W(X)
          C = EIG*WX - QX
          DTHDAA = - (COS(ALFA)**2/PX+C*SIN(ALFA)**2)*DT
C
C        TWO SPECIAL CASES FOR DTHDAA .
C
          IF (C.GE.0.0D0 .AND. P0ATA.LT.0.0D0 .AND.
     +        QFATA.LT.0.0D0) DTHDAA = DTHDAA + ALFA*DT/ (X-A)
          IF (C.GE.0.0D0 .AND. P0ATA.GT.0.0D0 .AND.
     +        QFATA.GT.0.0D0) DTHDAA = DTHDAA +
     +                                 (ALFA-0.5D0*PI)*DT/ (X-A)
      END IF

      THB = BETA
      DTHDBB = 0.0D0
      IF (SINGB .AND. .NOT.LCB) THEN
          CALL DXDT(BB,DT,X)
          PX = P(X)
          QX = Q(X)
          WX = W(X)
          C = EIG*WX - QX
          DTHDBB = - (COS(BETA)**2/PX+C*SIN(BETA)**2)*DT
C
C        TWO SPECIAL CASES FOR DTHDBB .
C
          IF (C.GE.0.0D0 .AND. P0ATB.LT.0.0D0 .AND.
     +        QFATB.LT.0.0D0) DTHDBB = DTHDBB + (PI-BETA)*DT/ (B-X)
          IF (C.GE.0.0D0 .AND. P0ATB.GT.0.0D0 .AND.
     +        QFATB.GT.0.0D0) DTHDBB = DTHDBB +
     +                                 (0.5D0*PI-BETA)*DT/ (B-X)
      END IF
C
C  PASS EIG TO SUBROUTINE F VIA THE COMMON/DATAF/ :
      EIGSAV = EIG

C  INTEGRATE FOR YL:
C
C     YL = (THETA,D(THETA)/D(EIG),D(THETA)/DA)
C
      YL(1) = 0.0D0
      YL(2) = 0.0D0
      YL(3) = 0.0D0
C
      ISAVE = 0
      CALL INTEG(AA,THA,DTHDAA,DTHDEA,TMID,A1,A2,EPS,YL,ERL,AOK,NCA,
     +           IFLAG)
      IF (IFLAG.EQ.5) THEN
          JFLAG = 51
          IF (PR) WRITE (T21,FMT=*) ' JFLAG = 51 '
          GO TO 130
      END IF

C  SET DTHDA:
      DTHDA = DTHDAA*EXP(-2.0D0*YL(3))

C  INTEGRATE FOR YR:
C
C     YR = (THETA,D(THETA)/D(EIG),D(THETA)/DB)
C
      YR(1) = 0.0D0
      YR(2) = 0.0D0
      YR(3) = 0.0D0
C
      ISAVE = 0
      CALL INTEG(BB,THB,DTHDBB,DTHDEB,TMID,B1,B2,EPS,YR,ERR,BOK,NCB,
     +           IFLAG)
      IF (IFLAG.EQ.5) THEN
          JFLAG = 52
          IF (PR) WRITE (T21,FMT=*) ' JFLAG = 52 '
          GO TO 130
      END IF

C  SET DTHDB:
      DTHDB = DTHDBB*EXP(-2.0D0*YR(3))
C
C  SET ER1, ER2, ER1M:
      ER1 = ERL(1) - ERR(1)
      ER2 = ERL(2) - ERR(2)
      ER1M = MAX(ABS(ERL(1)),ABS(ERR(1)))
C
C  IF EITHER ENDPOINT IS LCO, THEN INTEGRATIONS WITH EIG = 0
C    MUST ALSO BE CARRIED OUT.
C  THE VALUE OF THETA WHEN EIG=0 IS USED TO "CALIBRATE" THE
C  EIGENVALUE INDEXING -- IN THE LCO CASE, ONLY.
C  IN THIS CASE, SET ISAVE = 1 FOR USE IN SUBROUTINE LCO,
C    AND INTEGRATE FOR YZL:
C
      IF (LCOA .OR. LCOB) THEN
          EIGSAV = 0.0D0
          ISAVE = 1
          CALL INTEG(AA,THA,DTHDAA,DTHDEA,TMID,A1,A2,EPS,YZL,ERL,AOK,
     +               NCA,IFLAG)
          IF (IFLAG.EQ.5) THEN
              JFLAG = 53
              IF (PR) WRITE (T21,FMT=*) ' JFLAG = 53 '
              GO TO 130
          END IF
          ISAVE = 1
          CALL INTEG(BB,THB,DTHDBB,DTHDEB,TMID,B1,B2,EPS,YZR,ERR,BOK,
     +               NCB,IFLAG)
          IF (IFLAG.EQ.5) THEN
              JFLAG = 54
              IF (PR) WRITE (T21,FMT=*) ' JFLAG = 54 '
              GO TO 130
          END IF

          EIGSAV = EIG
C  SET DTHZ, MDTHZ:
          DTHZ = YZR(1) - YZL(1)
          MDTHZ = DTHZ/PI
          REMZ = DTHZ - MDTHZ*PI
          IF (DTHZ.LT.0.0D0 .AND. REMZ.LT.0.0D0) THEN
              MDTHZ = MDTHZ - 1
              REMZ = REMZ + PI
          END IF
          IF (REMZ.GT.3.14D0) MDTHZ = MDTHZ + 1
C  RESET ISAVE TO 0:
          ISAVE = 0
      END IF
C
C     DTHETA MEASURES THETA DIFFERENCE FROM LEFT AND RIGHT INTEGRATIONS.
C
C  SET DTHETA, DTHDE:
      DTHETA = YL(1) - YR(1) - EIGPI
      IF (LCOA .OR. LCOB) DTHETA = DTHETA + MDTHZ*PI
      DTHDE = YL(2) - YR(2)
      IF (PR) WRITE (T21,FMT=*) ' EIG = ',EIG
      IF (PR) WRITE (T21,FMT=*) ' YL(1),YR(1) = ',YL(1),YR(1)
      IF (PR) WRITE (T21,FMT=*) ' DTHETA,DTHDE = ',DTHETA,DTHDE
      IF (PR) WRITE (T21,FMT=*) ' MDTHZ = ',MDTHZ
C
      ATHETA = ABS(DTHETA)
      ONEDIG = (ABS(ER1).LE.0.5D0*ABS(DTHETA) .AND.
     +         ABS(ER2).LE.0.5D0*ABS(DTHDE)) .OR.
     +         MAX(ATHETA,ABS(ER1)) .LT. 1.0D-6

C     RIGHT AFTER LEAVING THIS SUBROUTINE:
C     WE NEED TO SET AAS = AA, AND BBS = BB ,
C     AND SET ATHETA = ABS(DTHETA).
C
C     WE ALSO NEED TO SET FIRSTT = .FALSE., UNLESS
C     JFLAG.EQ. 51, 52, 53, OR 54, WHEN WE NEED TO "GOTO 130"
C     AND SET          EXIT = .TRUE.
C     THIS SUBROUTINE NEEDS TO BE CALLED WITH THE INPUT FLAG
C     BEING CALLED "IFLAG" -- SO THAT EXTERNALLY THE "IFLAG"
C     WILL RETURN AS "IFLAG = 52, ETC".

  130 CONTINUE
      IFLAG = JFLAG
      RETURN
      END
C
      SUBROUTINE RESET(AA,BB,ALFA,BETA,EIG,GUESS,MF,ML,QS,WS,IMID,TMID,
     +                 LIMUP,ELIMUP,DTHDEA,DTHDEB,THELT0,EIGLO,EIGUP,
     +                 BRACKT,NCA,NCB,IFLAG)
C
C  THIS PROGRAM IS USED TO RESET THE MATCHING POINT, TMID, AND THE
C    BOUNDARY VALUES, ALFA & BETA, WHEN NECESSARY.  THESE
C    QUANTITIES CAN DEPEND ON THE CURRENT VALUE BEING USED FOR EIG.
C  IT IS CALLED BY SLEIGN.
C
C  INPUT QUANTITIES: AA,BB,ALFA,BETA,EIG,GUESS,MF,ML,
C                    QS,WS,IMID,TMID,LIMUP,ELIMUP,DTHDEA,DTHDEB,
C                    THELT0,EIGLO,EIGUP,BRACKT,NCA,NCB,
C                    A,B,INTAB,A1,A2,P0ATA,QFATA,B1,B2,P0ATB,QFATB,
C                    PI,TWOPI,HPI,EPSMIN,PR
C  OUTPUT QUANTITIES: IFLAG,ALFA,BETA,DTHDEA,DTHDEB,EIG,IMID,TMID,
C                    EIGUP
C
C     .. Scalar Arguments ..
      REAL AA,ALFA,BB,BETA,DTHDEA,DTHDEB,EIG,EIGLO,EIGUP,
     +                 ELIMUP,GUESS,TMID
      INTEGER IFLAG,IMID,MF,ML,NCA,NCB
      LOGICAL BRACKT,LIMUP,THELT0
C     ..
C     .. Array Arguments ..
      REAL QS(100),WS(100)
C     ..
C     .. Scalars in Common ..
      REAL A,A1,A2,B,B1,B2,EPSMIN,HPI,P0ATA,P0ATB,PI,QFATA,
     +                 QFATB,TWOPI
      INTEGER INTAB,T21
      LOGICAL PR
C     ..
C     .. Local Scalars ..
      REAL DERIVL,DERIVR,TMP1,TMP2,V
      INTEGER JFLAG,KFLAG
      LOGICAL LCA,LCB,SINGA,SINGB
C     ..
C     .. External Subroutines ..
      EXTERNAL ALFBET,SETMID
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC MIN
C     ..
C     .. Common blocks ..
      COMMON /BCDATA/A1,A2,P0ATA,QFATA,B1,B2,P0ATB,QFATB
      COMMON /DATADT/A,B,INTAB
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
C     ..
      LCA = NCA .EQ. 3 .OR. NCA .EQ. 4
      LCB = NCB .EQ. 3 .OR. NCB .EQ. 4
      SINGA = NCA .GE. 3
      SINGB = NCB .GE. 3

C        (SET-TMID-AND-BOUNDARY-CONDITIONS)
      IF (PR) WRITE (*,FMT=*) ' SET TMID AND BOUNDARY CONDITIONS '
      V = EIG*WS(IMID) - QS(IMID)
      IF (V.LE.0.0D0) CALL SETMID(MF,ML,EIG,QS,WS,IMID,TMID)

C        (RESET-BOUNDARY-CONDITIONS)
      DERIVL = 0.0D0
      IF (SINGA) CALL ALFBET(A,INTAB,AA,A1,A2,EIG,P0ATA,QFATA,.TRUE.,
     +                       ALFA,KFLAG,DERIVL)
      DTHDEA = DERIVL
      DERIVR = 0.0D0

      IF (SINGB) THEN
          CALL ALFBET(B,INTAB,BB,B1,B2,EIG,P0ATB,QFATB,.TRUE.,BETA,
     +                JFLAG,DERIVR)
          BETA = PI - BETA
      END IF
      DTHDEB = -DERIVR
      IF (PR) WRITE (T21,FMT='(A,E22.14,A,E22.14)') '  ALFA=',ALFA,
     +    '   BETA=',BETA
C
C     CHECK THAT BOUNDARY CONDITIONS CAN BE SATISFIED AT SINGULAR
C     ENDPOINTS.  IF NOT, TRY FOR SLIGHTLY ALTERED EIG CONSISTENT
C     WITH BOUNDARY CONDITIONS.
C     LIMUP = .TRUE. MEANS THAT THE EIGENVALUES ARE BOUNDED ABOVE,
C       BY APPROX. ELIMUP.
C
      IF (LIMUP .AND. EIG.NE.GUESS .AND. .NOT.BRACKT) THEN
          KFLAG = 1
          IF (SINGA .AND. .NOT.LCA) CALL ALFBET(A,INTAB,AA,A1,A2,EIG,
     +        P0ATA,QFATA,.TRUE.,TMP1,KFLAG,TMP2)
          JFLAG = 1
          IF (SINGB .AND. .NOT.LCB) CALL ALFBET(B,INTAB,BB,B1,B2,EIG,
     +        P0ATB,QFATB,.TRUE.,TMP1,JFLAG,TMP2)
          IFLAG = 1
          IF ((KFLAG.NE.1.OR.JFLAG.NE.1) .AND.
     +        (THELT0.AND.EIGLO.LT.ELIMUP)) THEN
              TMP1 = ELIMUP+2.0D0*EPSMIN
              EIGUP = MIN(TMP1,EIGUP)
c             EIGUP = MIN(ELIMUP+2.0D0*EPSMIN,EIGUP)
              IF (EIG.NE.EIGLO .AND. EIG.NE.EIGUP) THEN
                  EIG = 0.05D0*EIGLO + 0.95D0*EIGUP
              ELSE
                  IFLAG = 11
                  IF (PR) WRITE (T21,FMT=*) ' IFLAG = 11 '
                  GO TO 130
              END IF
          END IF
      END IF

C        (IMMEDIATELY UPON LEAVING THIS SUBROUTINE WE NEED
C         TO CHECK FOR IFLAG = 11.  IF SO, SET EXIT = .TRUE.
C         AND GOTO 130.)

  130 CONTINUE
      RETURN
      END
C
      SUBROUTINE DXDT(T,DT,X)
C     **********
C
C     THIS SUBROUTINE TRANSFORMS COORDINATES FROM T ON (-1,1) TO
C     X ON (A,B) .
C
C  INPUT QUANTITIES: T,A,B INTAB
C  OUTPUT QUANTITIES: DT,X
C     **********
C     .. Scalars in Common ..
      REAL A,B
      INTEGER INTAB
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS
C     ..
C     .. Common blocks ..
      COMMON /DATADT/A,B,INTAB
C     ..
C     .. Scalar Arguments ..
      REAL DT,T,X
C     ..
      GO TO (10,20,30,40) INTAB
   10 CONTINUE
      DT = 0.5D0* (B-A)
      X = 0.5D0* ((B+A)+ (B-A)*T)
      RETURN
   20 CONTINUE
      DT = 2.0D0/ (1.0D0-T)**2
      X = A + (1.0D0+T)/ (1.0D0-T)
      RETURN
   30 CONTINUE
      DT = 2.0D0/ (1.0D0+T)**2
      X = B - (1.0D0-T)/ (1.0D0+T)
      RETURN
   40 CONTINUE
      DT = 1.0D0/ (1.0D0-ABS(T))**2
      X = T/ (1.0D0-ABS(T))
      RETURN
      END
C
      REAL FUNCTION TFROMX(X)

C  THIS FUNCTION DETERMINES THE VALUE OF T IN (-1,1) WHICH
C    CORRESPONDS TO ANY VALUE OF X IN (A,B).

C  INPUT QUANTITIES: X,A,B,INTAB
C  OUTPUT QUANTITIES: TFROMX

C     .. Scalar Arguments ..
      REAL X
C     ..
C     .. Scalars in Common ..
      REAL A,B
      INTEGER INTAB
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS
C     ..
C     .. Common blocks ..
      COMMON /DATADT/A,B,INTAB
C     ..
      GO TO (10,20,30,40) INTAB
   10 CONTINUE
      TFROMX = (2.0D0*X- (B+A))/ (B-A)
      RETURN
   20 CONTINUE
      TFROMX = (X-A-1.0D0)/ (X-A+1.0D0)
      RETURN
   30 CONTINUE
      TFROMX = (1.0D0+X-B)/ (1.0D0-X+B)
      RETURN
   40 CONTINUE
      TFROMX = X/ (1.0D0+ABS(X))
      RETURN
      END
C
      REAL FUNCTION TFROMI(I)
C     **********
C
C  THIS FUNCTION DETERMINES THE VALUE OF THE VARIABLE T IN (-1,1)
C    WHICH CORRESPONDS TO THE SAMPLE POINT INDEX I.
C
C  INPUT QUANTITIES: I
C  OUTPUT QUANTITIES: TFROMI
C     **********
C     .. Scalar Arguments ..
      INTEGER I
C     ..
      IF (I.LT.8) THEN
          TFROMI = -1.0D0 + 0.1D0/4.0D0** (8-I)
      ELSE IF (I.GT.92) THEN
          TFROMI = 1.0D0 - 0.1D0/4.0D0** (I-92)
      ELSE
          TFROMI = 0.0227D0* (I-50)
      END IF
      RETURN
      END
C
      SUBROUTINE EXTRAP(T,TT,EIG,VALUE,DERIV,IFLAG)
C     **********
C
C     THIS SUBROUTINE IS CALLED FROM ALFBET IN DETERMINING BOUNDARY
C     VALUES AT A SINGULAR ENDPOINT OF THE INTERVAL FOR A
C     STURM-LIOUVILLE PROBLEM IN THE FORM
C
C       -(P(X)*Y'(X))' + Q(X)*Y(X) = EIG*W(X)*Y(X)  ON (A,B)
C
C     FOR USER-SUPPLIED COEFFICIENT FUNCTIONS P, Q, AND W.
C
C     EXTRAP, WHICH IN TURN CALLS INTPOL, EXTRAPOLATES THE FUNCTION
C
C        ARCTAN(1.0/SQRT(-P*(EIG*W-Q)))
C
C     FROM ITS VALUES FOR T WITHIN (-1,1) TO AN ENDPOINT.
C
C  INPUT QUANTITIES: T,TT,EIG,PR
C  OUTPUT QUANTITIES: VALUE,DERIV,IFLAG

C     SUBPROGRAMS CALLED
C
C       USER-SUPPLIED ..... P,Q,W
C
C       SLEIGN-SUPPLIED .. DXDT,INTPOL
C
C     **********
C     .. Local Scalars ..
      REAL ANS,CTN,ERROR,PROD,PX,QX,T1,TEMP,WX,X
      INTEGER KGOOD
C     ..
C     .. Local Arrays ..
      REAL FN1(5),XN(5)
C     ..
C     .. External Functions ..
      REAL P,Q,W
      EXTERNAL P,Q,W
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,INTPOL
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN,SQRT,TAN
C     ..
C     .. Scalar Arguments ..
      REAL DERIV,EIG,T,TT,VALUE
      INTEGER IFLAG
C     ..
C     .. Scalars in Common ..
      INTEGER T21
      LOGICAL PR
C     ..
C     .. Common blocks ..
      COMMON /PRIN/PR,T21
C     ..
C     (JUST TO MAKE SURE VALUE IS DEFINED, EVEN IF NOT
C     (NEEDED, SET IT TO 0.
      VALUE = 0.0D0
C
      IFLAG = 1
      KGOOD = 0
C  HERE, COMING FROM ALFBET, TT IS (PROBABLY) AA OR BB
      T1 = TT
      XN(1) = TT
   10 CONTINUE
      CALL DXDT(T1,TEMP,X)
      PX = P(X)
      QX = Q(X)
      WX = W(X)
      PROD = -PX* (EIG*WX-QX)
      IF (PROD.GT. (1.0D+10)) THEN
          ANS = 1.D-5
          GO TO 20
      END IF
      IF (PROD.LE.0.0D0) THEN
          T1 = 0.5D0* (T1+T)
          IF ((1.0D0+ (T1-T)**2).GT.1.0D0) GO TO 10
          IF (PROD.GT.-1.0D-6) VALUE = 2.0D0*ATAN(1.0D0)
          IFLAG = 5
          RETURN
      ELSE
          KGOOD = KGOOD + 1
          XN(KGOOD) = T1
          FN1(KGOOD) = ATAN(1.0D0/SQRT(PROD))
          T1 = 0.5D0* (T+T1)
          IF (KGOOD.LT.5) GO TO 10
      END IF

C  AT THIS POINT, THE XN(I) ARE VALUES OF T BETWEEN TT
C   (AA OR BB) AND 1.0 OR -1.0, OBTAINED BY BISECTION,
C   AND THE VALUES OF FN1 ARE THE CORRESPONDING VALUES
C   OF ATAN(1.0/SQRT(PROD)).
C  IN THIS CALL TO INTPOL, T IS 1.0 OR -1.0 AND
C    THE T1 SERVES AS ABSERR IN INTPOL.  THE RETURNED
C    VALUE ANS IS THE EXTRAPOLATED VALUE OF
C      ATAN(1.0/SQRT(PROD)) AT 1.0 OR -1.0   .

      IF (KGOOD.EQ.5) THEN
          IFLAG = 1
      ELSE
          IF (PR) WRITE (T21,FMT=*) ' IN EXTRAP, FAILED TO '
          IF (PR) WRITE (T21,FMT=*) ' GET 5 VALUES OF XN,FN '
      END IF
      T1 = 0.00001D0
      CALL INTPOL(5,XN,FN1,T,T1,3,ANS,ERROR)
   20 CONTINUE
      VALUE = ABS(ANS)
      CTN = 1.0D0/TAN(VALUE)
      DERIV = 0.5D0*PX*WX/CTN/ (1.0D0+CTN**2)
C  RESTORE TT TO ITS ORIGINAL VALUE.
      TT = XN(1)
      RETURN
      END
C
      SUBROUTINE INTPOL(N,XN,FN,X,ABSERR,MAXDEG,ANS,ERROR)
C     **********
C
C     THIS SUBROUTINE FORMS AN INTERPOLATING POLYNOMIAL FOR DATA PAIRS.
C     IT IS CALLED FROM EXTRAP AND FROM EXTR.
C     IT IS BEING USED TO EXTRAPOLATE THE VALUES FN AT POINTS XN
C     TO THE VALUE OF F AT X.
C     THE PARAMETER ABSERR IS THE REQUESTED ACCURACY IN ANS .
C
C   INPUT QUANTITIES: N,XN,FN,X,ABSERR,MAXDEG
C   OUTPUT QUANTITIES: ANS, ERROR
C     **********
C     .. Local Scalars ..
      REAL PROD
      INTEGER I,I1,II,IJ,IK,IKM1,J,K,L,LIMIT
C     ..
C     .. Local Arrays ..
      REAL V(10,10)
      INTEGER INDEX(10)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MIN
C     ..
C     .. Scalar Arguments ..
      REAL ABSERR,ANS,ERROR,X
      INTEGER MAXDEG,N
C     ..
C     .. Array Arguments ..
      REAL FN(N),XN(N)
C     ..
      L = MIN(MAXDEG,N-2) + 2
      LIMIT = MIN(L,N-1)
      DO 10 I = 1,N
          V(I,1) = ABS(XN(I)-X)
          INDEX(I) = I
   10 CONTINUE
      DO 30 I = 1,LIMIT
          DO 20 J = I + 1,N
              II = INDEX(I)
              IJ = INDEX(J)
              IF (V(II,1).GT.V(IJ,1)) THEN
                  INDEX(I) = IJ
                  INDEX(J) = II
              END IF
   20     CONTINUE
   30 CONTINUE
      PROD = 1.0D0
      I1 = INDEX(1)
      ANS = FN(I1)
      V(1,1) = FN(I1)
      DO 50 K = 2,L
          IK = INDEX(K)
          V(K,1) = FN(IK)
          DO 40 I = 1,K - 1
              II = INDEX(I)
              V(K,I+1) = (V(I,I)-V(K,I))/ (XN(II)-XN(IK))
   40     CONTINUE
          IKM1 = INDEX(K-1)
          PROD = (X-XN(IKM1))*PROD
          ERROR = PROD*V(K,K)
          IF (ABS(ERROR).LE.ABSERR) RETURN
          ANS = ANS + ERROR
   50 CONTINUE
      ANS = ANS - ERROR
      RETURN
      END
C
      REAL FUNCTION EPSLON(X)
C
C     ESTIMATE UNIT ROUNDOFF IN QUANTITIES OF SIZE X.
C
C     THIS PROGRAM SHOULD FUNCTION PROPERLY ON ALL SYSTEMS
C     SATISFYING THE FOLLOWING TWO ASSUMPTIONS,
C        1.  THE BASE USED IN REPRESENTING FLOATING POINT
C            NUMBERS IS NOT A POWER OF THREE.
C        2.  THE QUANTITY  A  IN STATEMENT 10 IS REPRESENTED TO
C            THE ACCURACY USED IN FLOATING POINT VARIABLES
C            THAT ARE STORED IN MEMORY.
C     THE STATEMENT NUMBER 10 AND THE GO TO 10 ARE INTENDED TO
C     FORCE OPTIMIZING COMPILERS TO GENERATE CODE SATISFYING
C     ASSUMPTION 2.
C     UNDER THESE ASSUMPTIONS, IT SHOULD BE TRUE THAT,
C            A  IS NOT EXACTLY EQUAL TO FOUR-THIRDS,
C            B  HAS A ZERO FOR ITS LAST BIT OR DIGIT,
C            C  IS NOT EXACTLY EQUAL TO ONE,
C            EPS  MEASURES THE SEPARATION OF 1.0 FROM
C                 THE NEXT LARGER FLOATING POINT NUMBER.
C
C     .. Scalar Arguments ..
      REAL X
C     ..
C     .. Local Scalars ..
      REAL A,B,C,EPS,FOUR,THREE
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS
C     ..
      FOUR = 4.0D0
      THREE = 3.0D0
      A = FOUR/THREE
   10 B = A - 1.0D0
      C = B + B + B
      EPS = ABS(C-1.0D0)
      IF (EPS.EQ.0.0D0) GO TO 10
      EPSLON = EPS*ABS(X)
      RETURN
      END
C
      SUBROUTINE ESTPAC(IOSC,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,TAU,
     +                  JJL,JJR,SUM,U)
C     **********
C
C     THIS SUBROUTINE ESTIMATES THE CHANGE IN 'PHASE ANGLE' IN THE
C     EIGENVALUE DETERMINATION OF A STURM-LIOUVILLE PROBLEM IN THE FORM
C
C       -(P(X)*Y'(X))' + Q(X)*Y(X) = EIG*W(X)*Y(X)  ON (A,B)
C
C     FOR USER-SUPPLIED COEFFICIENT FUNCTIONS P, Q, AND W.
C
C     THE SUBROUTINE APPROXIMATES (BY TRAPEZOIDAL RULE) THE INTEGRAL OF
C
C        SQRT((EIG*W-Q)/P)
C
C     WHERE THE INTEGRAL IS TAKEN OVER THOSE X IN (A,B) FOR WHICH
C
C        (EIG*W-Q)/P .GT. 0
C
C     ESTPAC IS CALLED BY SUBROUTINES ESTIM AND PRELIM.
C
C   IN THE MAIN IF..THEN..ELSE, THE FIRST PART DOES THE ESTIMATING OF
C     THE PHASE ANGLE CHANGE, AND THE SECOND PART DETERMINES THE ZEE'S
C     TO BE USED IN THE PRUFER TRANSFORMATION BY SUBROUTINE GERKZ.
C
C  INPUT QUANTITIES: IOSC,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,TAU
C  OUTPUT QUANTITIES: PSS,JJL,JJR,SUM,U,JAY,ZEE
C     **********
C     .. Local Scalars ..
      REAL C1,C2,C3,C4,DPSUM,DPSUMT,ONE,PSUM,RT,RTSAV,UT,V,
     +                 WSAV,WW,ZAV,ZAVJ
      INTEGER J,JJ,MF1
C     ..
C     .. Arrays in Common ..
      REAL ZEE(100)
      INTEGER JAY(100)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,MIN,MOD,SIGN,SQRT
C     ..
C     .. Common blocks ..
      COMMON /ZEEZ/JAY,ZEE
C     ..
C     .. Scalar Arguments ..
      REAL EEE,SUM,SUM0,TAU,U
      INTEGER JJL,JJR,MF,ML
      LOGICAL IOSC
C     ..
C     .. Array Arguments ..
      REAL DELT(100),DS(100),PS(100),PSS(100),QS(100),
     +                 WS(100)
C     ..
      ONE = 1.0D0
      C1 = 0.1D0
      C2 = 0.25D0
      C3 = 0.5D0
      C4 = 0.001D0
C
C     SUM ACCUMULATES THE INTEGRAL APPROXIMATION.  U MEASURES THE TOTAL
C     LENGTH OF SUBINTERVALS WHERE (EIG*W-Q)/P .GT. 0.0.  ZAV IS THE
C     AVERAGE VALUE OF SQRT((EIG*W-Q)*P) OVER THOSE SUBINTERVALS.
C
      IF (.NOT.IOSC) THEN

          DO 5 J = 1,100
              PSS(J) = 0.0D0
    5     CONTINUE

          JJL = 99
          JJR = 1
          SUM = 0.0D0
          U = 0.0D0
          UT = 0.0D0
          ZAV = 0.0D0
          WSAV = EEE*WS(MF) - QS(MF)
          IF (WSAV.GT.0.0D0) THEN
              RTSAV = SIGN(SQRT(WSAV),PS(MF))
          ELSE
              RTSAV = 0.0D0
          END IF
          DO 10 J = MF + 1,ML
              WW = EEE*WS(J) - QS(J)
              IF (WW.GT.0.0D0) THEN
                  U = U + DS(J-1)
                  UT = UT + DELT(J-1)
                  RT = SIGN(SQRT(WW),PS(J))
              ELSE
                  RT = 0.0D0
              END IF
              IF (WW.EQ.0.0D0 .OR. WSAV.EQ.0.0D0 .OR.
     +            WW.EQ.SIGN(WW,WSAV)) THEN
                  V = RT + RTSAV
              ELSE
                  V = (WW*RT+WSAV*RTSAV)/ABS(WW-WSAV)
              END IF
              WSAV = WW
              RTSAV = RT
              PSUM = DS(J-1)*V
              IF (EEE.EQ.0.0D0) THEN
                  PSS(J) = PSUM
              ELSE
                  DPSUM = PSUM - PSS(J)
                  DPSUMT = DPSUM*DELT(J-1)/DS(J-1)
                  IF (DPSUMT.GT.C4*TAU) THEN
                      JJL = MIN(JJL,J)
                      JJR = MAX(JJR,J)
                  END IF
              END IF
              SUM = SUM + PSUM
              IF (U.GT.0.0D0) ZAV = ZAV + DELT(J-1)*V*ABS(PS(J)+PS(J-1))
   10     CONTINUE
          SUM = C3*SUM - SUM0
          ZAV = C2*ZAV
      ELSE
          JJ = 1
          JAY(1) = MF
   20     CONTINUE
          SUM = 0.0D0
          U = 0.0D0
          UT = 0.0D0
          ZAV = 0.0D0
          ZAVJ = 0.0D0
          MF1 = JAY(JJ)
          WSAV = EEE*WS(MF1) - QS(MF1)
          IF (WSAV.GT.0.0D0) THEN
              RTSAV = SIGN(SQRT(WSAV),PS(MF1))
          ELSE
              RTSAV = 0.0D0
          END IF
          DO 30 J = MF1 + 1,ML
              WW = EEE*WS(J) - QS(J)
              IF (WW.GT.0.0D0) THEN
                  U = U + DS(J-1)
                  UT = UT + DELT(J-1)
                  RT = SIGN(SQRT(WW),PS(J))
              ELSE
                  RT = 0.0D0
              END IF
              IF (WW.EQ.0.0D0 .OR. WSAV.EQ.0.0D0 .OR.
     +            WW.EQ.SIGN(WW,WSAV)) THEN
                  V = RT + RTSAV
              ELSE
                  V = (WW*RT+WSAV*RTSAV)/ABS(WW-WSAV)
              END IF
              WSAV = WW
              RTSAV = RT
              PSUM = DS(J-1)*V
              SUM = SUM + PSUM
              IF (U.GT.0.0D0) ZAV = ZAV + DELT(J-1)*V*ABS(PS(J)+PS(J-1))
              IF (U.NE.0.0D0) THEN
                  ZAVJ = C2*ZAV/UT
                  IF ((MOD(J-MF1,7).EQ.0) .OR. J.EQ.ML) THEN
                      JJ = JJ + 1
                      JAY(JJ) = J
                      ZEE(JJ) = ZAVJ
                      IF (ZEE(JJ).NE.0.0D0) ZEE(JJ) = MAX(ZAVJ,C1)
                      IF (ZEE(JJ).EQ.0.0D0) ZEE(JJ) = ONE
                      GO TO 40
                  END IF
              END IF
   30     CONTINUE
   40     CONTINUE
          IF (J.GT.ML) THEN
              JJ = JJ + 1
              JAY(JJ) = ML
              ZEE(JJ) = ZAVJ
              IF (ZEE(JJ).NE.0.0D0) ZEE(JJ) = MAX(ZAVJ,C1)
              IF (ZEE(JJ).EQ.0.D0) ZEE(JJ) = ONE
          END IF
          IF (J.LT.ML) GO TO 20
          SUM = C3*SUM
          ZAV = C2*ZAV
      END IF
      RETURN
      END
C
      SUBROUTINE ALFBET(XEND,INTAB,TT,COEF1,COEF2,EIG,P0,QF,SING,VALUE,
     +                  IFLAG,DERIV)
C     **********
C
C  THIS SUBROUTINE COMPUTES A BOUNDARY VALUE OF THE PRUEFER ANGLE,
C    THETA, FOR A SPECIFIED ENDPOINT OF THE INTERVAL FOR A
C    STURM-LIOUVILLE PROBLEM IN THE FORM
C
C       -(P(X)*Y'(X))' + Q(X)*Y(X) = EIG*W(X)*Y(X)  ON (A,B)
C
C     FOR USER-SUPPLIED COEFFICIENT FUNCTIONS P, Q, AND W.  IT IS CALLED
C     FROM RESET AND PRELIM.
C     BOTH REGULAR AND SINGULAR ENDPOINTS ARE TREATED.
C
C     SUBPROGRAMS CALLED
C
C       USER-SUPPLIED ..... P,Q,W
C
C       SLEIGN-SUPPLIED .. DXDT,EXTRAP
C  INPUT QUANTITIES: XEND,INTAB,TT,COEF1,COEF2,EIG,P0,QF,
C                    SING,PI,TWOPI,HPI
C  OUTPUT QUANTITIES: VALUE,DERIV,IFLAG
C
C     **********
C     .. Local Scalars ..
      REAL C,CD,D,HH,ONE,PX,QX,T,TEMP,TTS,WX,X
      LOGICAL LOGIC
C     ..
C     .. External Functions ..
      REAL P,Q,W
      EXTERNAL P,Q,W
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,EXTRAP
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN,SIGN,SQRT
C     ..
C     .. Common blocks ..
      COMMON /PIE/PI,TWOPI,HPI
C     ..
C     SET MACHINE DEPENDENT CONSTANT.
C
C     .. Scalar Arguments ..
      REAL COEF1,COEF2,DERIV,EIG,P0,QF,TT,VALUE,XEND
      INTEGER IFLAG,INTAB
      LOGICAL SING
C     ..
C     .. Scalars in Common ..
      REAL HPI,PI,TWOPI
C     ..
      ONE = 1.0D0
      IFLAG = 1
      DERIV = 0.0D0
      IF (.NOT.SING) THEN
          VALUE = 0.5D0*PI
          IF (COEF1.NE.0.0D0) VALUE = ATAN(-COEF2/COEF1)
          LOGIC = (TT.LT.0.0D0 .AND. VALUE.LT.0.0D0) .OR.
     +            (TT.GT.0.0D0 .AND. VALUE.LE.0.0D0)
          IF (LOGIC) VALUE = VALUE + PI
      ELSE
          LOGIC = (INTAB.EQ.2 .AND. TT.GT.0.0D0) .OR.
     +            (INTAB.EQ.3 .AND. TT.LT.0.0D0) .OR. INTAB .EQ. 4 .OR.
     +            (P0.GT.0.0D0 .AND. QF.LT.0.0D0)
          IF (LOGIC) THEN
              T = SIGN(ONE,TT)
              TTS = TT

C  HERE, T IS 1.0 OR -1.0, AND
C    TTS IS AA OR BB (PROBABLY)
C  THIS CALL TO EXTRAP EXTRAPOLATES THE VALUES OF
C    ATAN(1.0/SQRT(-P(EIG*W - Q)) AT POINTS T BETWEEN
C    AA OR BB AND -1.0 OR 1.0 TO THE ENDPOINT, -1.0 OR 1.0
C    IT ALSO RETURNS THE ASSOCIATED VALUE OF DERIV AT THAT
C      ENDPOINT.  DERIV IS D(VALUE)/D(EIG) .

              CALL EXTRAP(T,TTS,EIG,VALUE,DERIV,IFLAG)
          ELSE
              CALL DXDT(TT,TEMP,X)
              PX = P(X)
              QX = Q(X)
              WX = W(X)
              C = 2.0D0* (EIG*WX-QX)
              IF (C.LT.0.0D0) THEN
                  VALUE = 0.0D0
                  IF (P0.GT.0.0D0) VALUE = 0.5D0*PI
              ELSE
                  HH = ABS(XEND-X)
                  D = 2.0D0*HH/PX
                  CD = C*D*HH
                  IF (P0.GT.0.0D0) THEN
                      VALUE = C*HH
                      IF (CD.LT.1.0D0) VALUE = VALUE/
     +                    (1.0D0+SQRT(1.0D0-CD))
                      VALUE = VALUE + 0.5D0*PI
                  ELSE
                      VALUE = D
                      IF (CD.LT.1.0D0) VALUE = VALUE/
     +                    (1.0D0+SQRT(1.0D0-CD))
                  END IF
              END IF
          END IF
      END IF
      RETURN
      END
C
      SUBROUTINE SAMPLE(NCA,NCB,MF,ML,XS,PS,QS,WS,DS,DELT,EMIN,EMAX,
     +                  IMIN,IMAX,AAA,BBB)

C  THIS PROGRAM IS FOR THE PURPOSE OF SAMPLING THE COEFFICIENT
C    FUNCTIONS P, Q, W, PRIMARILY IN ORDER TO BE ABLE TO MAKE A
C    FIRST ESTIMATE OF THE DESIRED EIGENVALUE.
C    IT IS CALLED FROM SLEIGN.
C  THE ARRAY XS CONTAINS THE VALUES OF X IN (A,B) WHICH ARE
C    USED IN THE SAMPLING PROCESS.  THE ARRAY PS CONTAINS THE
C    CORRESPONDING VALUES OF P.  BUT THE ARRAYS QS AND WS CONTAIN
C    THE CORRESPONDING VALUES NOT OF Q AND W BUT OF
C    Q/P AND W/P.
C  ARRAYS DS AND DELT CONTAIN THE CORRESPONDING SAMPLING POINT
C    INTERVALS OF X AND T.
C  ALSO COMPUTED ARE MINIMUM AND MAXIMUM VALUES OF Q/W, CALLED
C    EMIN AND EMAX, WHICH OCCUR AT THE INDEX I EQUAL TO IMIN AND IMAX.
C  MF AND ML ARE THE FIRST AND LAST VALUES OF THE INDEX I,
C    1 .LE. MF .LT. ML .LE. 99.
C
C  INPUT QUANTITIES: NCA,NCB,EPSMIN
C  OUTPUT QUANTITIES: MF,ML,XS,PS,QS,WS,DS,DELT,EMIN,EMAX,
C                 IMIN,IMAX,AAA,BBB

C     .. Scalar Arguments ..
      REAL AAA,BBB,EMAX,EMIN
      INTEGER IMAX,IMIN,MF,ML,NCA,NCB
C     ..
C     .. Array Arguments ..
      REAL DELT(100),DS(100),PS(100),QS(100),WS(100),XS(100)
C     ..
C     .. Scalars in Common ..
      REAL EPSMIN
C     ..
C     .. Local Scalars ..
      REAL ONE,PX,QX,T,T50,THRESH,TMP,TS,WX,X,X50,XSAV
      INTEGER I
      LOGICAL FYNYT,LCOA,LCOB,SINGA,SINGB
C     ..
C     .. External Functions ..
      REAL P,Q,TFROMI,W
      EXTERNAL P,Q,TFROMI,W
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,THUM
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS
C     ..
C     .. Common blocks ..
      COMMON /RNDOFF/EPSMIN
C     ..
      SINGA = NCA .GE. 3
      SINGB = NCB .GE. 3
      LCOA = NCA .EQ. 4
      LCOB = NCB .EQ. 4
      ONE = 1.0D0
C     DO (SAMPLE-COEFFICIENTS)
      THRESH = 1.D+35
      IF (NCA.GE.5) THRESH = 1.D+17
      T50 = 0.0D0
      CALL DXDT(T50,TMP,X50)
      XS(50) = X50
      TS = T50
      PX = P(X50)
      QX = Q(X50)
      WX = W(X50)
      PS(50) = PX
      QS(50) = QX/PX
      WS(50) = WX/PX
C
C     EMIN = MIN(Q/W), ACHIEVED AT X FOR INDEX VALUE IMIN.
C     EMAX = MAX(Q/W), ACHIEVED AT X FOR INDEX VALUE IMAX.
C     MF AND ML ARE THE LEAST AND GREATEST INDEX VALUES, RESPECTIVELY.
C
      XSAV = X50
      EMIN = 0.0D0
      IF (QX.NE.0.0D0) EMIN = QX/WX
      EMAX = EMIN
      IMIN = 50
      IMAX = 50
      DO 20 I = 49,1,-1
          T = TFROMI(I)
          CALL DXDT(T,TMP,X)
          XS(I) = X
          PX = P(X)
          QX = Q(X)
          WX = W(X)
          PS(I) = PX
          QS(I) = QX/PX
          WS(I) = WX/PX
          DS(I) = XSAV - X
          DELT(I) = 0.5D0* (TS-T)
          XSAV = X
          TS = T
C
C     TRY TO AVOID OVERFLOW BY STOPPING WHEN FUNCTIONS ARE LARGE NEAR A
C     OR WHEN W IS SMALL NEAR A.
C
          FYNYT = (ABS(WX)+ABS(QX)+1.0D0/ABS(PX)) .LE. THRESH .AND.
     +            WX .GT. EPSMIN
          IF (QX.NE.0.0D0 .AND. QX/WX.LT.EMIN) THEN
              EMIN = QX/WX
              IMIN = I
          END IF
          IF (QX.NE.0.0D0 .AND. QX/WX.GT.EMAX) THEN
              EMAX = QX/WX
              IMAX = I
          END IF
          MF = I
          IF (.NOT.FYNYT) GO TO 30
   20 CONTINUE
      DO 25 I = 0,-14,-1
          T = TFROMI(I)
          IF (T.LE.-ONE+EPSMIN) GO TO 30
          CALL DXDT(T,TMP,X)
          PX = P(X)
          QX = Q(X)
          WX = W(X)
          FYNYT = (ABS(WX)+ABS(QX)+1.0D0/ABS(PX)) .LE. THRESH .AND.
     +            WX .GT. EPSMIN
          IF (.NOT.FYNYT) GO TO 30
   25 CONTINUE
   30 CONTINUE
      THRESH = 1.D+35
      IF (NCB.GE.5) THRESH = 1.D+17
      AAA = T
      IF (.NOT.SINGA) AAA = -ONE
      TS = T50
      XSAV = X50
      DO 40 I = 51,99
          T = TFROMI(I)
          CALL DXDT(T,TMP,X)
          XS(I) = X
          PX = P(X)
          QX = Q(X)
          WX = W(X)
          PS(I) = PX
          QS(I) = QX/PX
          WS(I) = WX/PX
          DS(I-1) = X - XSAV
          DELT(I-1) = 0.5D0* (T-TS)
          XSAV = X
          TS = T
C
C     TRY TO AVOID OVERFLOW BY STOPPING WHEN FUNCTIONS ARE LARGE NEAR B
C     OR WHEN W IS SMALL NEAR B.
C
          FYNYT = (ABS(QX)+ABS(WX)+1.0D0/ABS(PX)) .LE. THRESH .AND.
     +            WX .GT. EPSMIN
          IF (QX.NE.0.0D0 .AND. QX/WX.LT.EMIN) THEN
              EMIN = QX/WX
              IMIN = I
          END IF
          IF (QX.NE.0.0D0 .AND. QX/WX.GT.EMAX) THEN
              EMAX = QX/WX
              IMAX = I
          END IF
          ML = I - 1
          IF (.NOT.FYNYT) GO TO 50
   40 CONTINUE
      XS(100) = 0.0D0
      DO 45 I = 100,114
          T = TFROMI(I)
          IF (T.GE.ONE-EPSMIN) GO TO 50
          CALL DXDT(T,TMP,X)
          PX = P(X)
          QX = Q(X)
          WX = W(X)
          FYNYT = (ABS(WX)+ABS(QX)+1.0D0/ABS(PX)) .LE. THRESH .AND.
     +            WX .GT. EPSMIN
          IF (.NOT.FYNYT) GO TO 50
   45 CONTINUE
   50 CONTINUE
      BBB = T
      IF (.NOT.SINGB) BBB = ONE
C
      IF (LCOA .OR. LCOB) CALL THUM(MF,ML,XS)
C
      RETURN
      END
C
      SUBROUTINE ESTIM(IOSC,PIN,MF,ML,PS,QS,WS,PSS,DS,DELT,TAU,JJL,JJR,
     +                 SUM,LIMUP,ELIMUP,EMAX,IMAX,IMIN,EL,WL,DEDW,
     +                 BALLPK,EEE,JFLAG)

C  THIS PROGRAM MAKES A FIRST ESTIMATE OF THE DESIRED
C    EIGENVALUE, USING THE ARRAYS PS,QS,WS OF SAMPLED VALUES OF
C    THE COEFFICIENT FUNCTIONS P,Q,W OBTAINED BY SUBROUTINE SAMPLE.
C    IT IS CALLED BY SLEIGN.
C    THIS ESTIMATE IS RETURNED IN THE VARIABLE EEE.
C  JJL AND JJR ARE THE MIN AND MAX OF THE INDEX I FOR WHICH
C    EIG*W - Q IS NONNEGATIVE (OF THE SAMPLED VALUES).
C  IMIN AND IMAX ARE THE SAMPLE INDICES WHERE THE FUNCTION QS/WS
C  ATTAINS ITS MINIMUM AND MAXIMUM OF EMIN AND EMAX.
C  WHEN THE ESTIMATING PROCESS BREAKS DOWN, A "BALLPARK" ESTIMATE,
C    BALLPK, IS DETERMINED.
C
C  BASICALLY, THE ESTIMATE, EEE, IS THE SOLUTION OF THE
C  EQUATION
C                  |b
C          INTEGRAL|SQRT((EEE*W-Q)/P)*DX = (NUMEIG+1)*PI
C                  |a
C
C  WHERE THE INTEGRATION IS OVER THOSE X FOR WHICH THE INTEGRAND
C  IS REAL.
C  INPUT QUANTITIES: IOSC,PIN,MF,ML,PS,QS,WS,DS,DELT,TAU,
C                    JJL,JJR,LIMUP,ELIMUP,EMIN,EMAX,IMIN,IMAX
C  OUTPUT QUANTITIES: PSS,JJL,JJR,SUM,IMIN,IMAX,EL,WL,DEDW,
C                     BALLPK,EEE,JFLAG
C
C     .. Scalar Arguments ..
      REAL BALLPK,DEDW,EEE,EL,ELIMUP,EMAX,PIN,SUM,TAU,WL
      INTEGER IMAX,IMIN,JFLAG,JJL,JJR,MF,ML
      LOGICAL IOSC,LIMUP
C     ..
C     .. Array Arguments ..
      REAL DELT(100),DS(100),PS(100),PSS(100),QS(100),
     +                 WS(100)
C     ..
C     .. Scalars in Common ..
      REAL A,B
      INTEGER INTAB,T21
      LOGICAL PR
C     ..
C     .. Local Scalars ..
      REAL EU,FNEW,FOLD,ONE,SUM0,U,ULO,UUP,WU
      INTEGER IE,JLOOP
      LOGICAL LOGIC
C     ..
C     .. External Subroutines ..
      EXTERNAL ESTPAC
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,MIN
C     ..
C     .. Common blocks ..
      COMMON /DATADT/A,B,INTAB
      COMMON /PRIN/PR,T21
C     ..
      JFLAG = 1
      ONE = 1.0D0
      SUM0 = 0.0D0
C           ------------------------
C  WHEN ESTPAC IS CALLED, THE RETURNED VALUE OF SUM (OR SUM0) IS
C  THE APPROXIMATION TO THE ABOVE INTEGRAL,
C  THE VALUE OF U IS THE TOTAL LENGTH OF THOSE SUBINTERVALS FOR
C  WHICH THE INTEGRAND IS REAL.

      IF (IOSC) THEN
          EEE = 0.0D0
          CALL ESTPAC(.FALSE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,TAU,
     +                JJL,JJR,SUM,U)
          SUM0 = SUM
      END IF
C           ------------------------
      EEE = MIN(ELIMUP,EMAX)
      CALL ESTPAC(.FALSE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,TAU,JJL,
     +            JJR,SUM,U)
C           ------------------------
      EU = EEE
      WU = SUM
      UUP = U
C          --------------------------
C   PIN IS NORMALLY SET = (NUMEIG+1)*PI, EXCEPT WHEN IOSC = .TRUE.

   55 CONTINUE
      IF (.NOT.LIMUP .AND. ABS(SUM).GE.10.0D0*MAX(ONE,ABS(PIN))) THEN
          IF (SUM.GE.10.0D0*PIN) THEN
              IF (EEE.GE.ONE) THEN
                  EEE = EEE/10.0D0
              ELSE IF (EEE.LT.-ONE) THEN
                  EEE = 10.0D0*EEE
              ELSE
                  EEE = EEE - ONE
              END IF
          ELSE
              IF (EEE.LE.-ONE) THEN
                  EEE = EEE/10.0D0
              ELSE IF (EEE.GT.ONE) THEN
                  EEE = 10.0D0*EEE
              ELSE
                  EEE = EEE + ONE
              END IF
          END IF
          CALL ESTPAC(.FALSE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,TAU,
     +                JJL,JJR,SUM,U)
          GO TO 55
      END IF
C           -------------------------------
C   THE LOCAL VARIABLES EL, WL ARE USED TO INDICATE VALUE OF EIG
C   AND VALUE OF SUM WHEN SUM .LT. PIN;
C   EU, WU ARE USED TO INDICATE VALUE OF EIG AND VALUE OF SUM
C   WHEN SUM .GT. PIN.
C   ULO, UUP ARE CORRESPONDING VALUES FOR U, THE TOTAL LENGTH
C   OF INTERVAL FOR WHICH THE INTEGRAND IS POSITIVE.
      EU = EEE
      WU = SUM
      UUP = U
      IF (SUM.GE.PIN) THEN
          EL = EU
          WL = WU
          ULO = UUP
C           ----------------------
          JLOOP = 0
   60     CONTINUE
          IF (WL.GE.PIN) THEN
C           REDUCE EEE:
              EU = EL
              WU = WL
              UUP = ULO
              EEE = EL - ((WL-PIN+3.0D0)/U)**2 - ONE
              CALL ESTPAC(.FALSE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,
     +                    TAU,JJL,JJR,SUM,U)
              EL = EEE
              WL = SUM
              ULO = U
              IF (SUM.EQ.0.0D0) JLOOP = JLOOP + 1
              IF (JLOOP.GE.5) THEN
C                   (ESTIMATOR FAILURE)
                  JFLAG = 0
                  RETURN
              END IF
              GO TO 60
          END IF
C           -----------------------

      ELSE
C       INCREASE EEE:
          EL = EEE
          WL = SUM
          ULO = U
      END IF
      IF (LIMUP .AND. WU.LT.PIN) THEN
          EEE = ELIMUP
      ELSE
          IF (UUP.EQ.0.0D0) THEN
              EEE = EMAX + ONE
              CALL ESTPAC(.FALSE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,
     +                    TAU,JJL,JJR,SUM,U)
              EU = EEE
              WU = SUM
              UUP = U
          END IF
   70     CONTINUE
          IF (WU.LE.PIN) THEN
C           INCREASE EEE:
              EL = EU
              WL = WU
              ULO = UUP
              EEE = EU + ((PIN-WU+3.0D0)/U)**2 + ONE
              CALL ESTPAC(.FALSE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,
     +                    TAU,JJL,JJR,SUM,U)
              EU = EEE
              WU = SUM
              UUP = U
              GO TO 70
          END IF
C            --------------------------------
   80     CONTINUE
C    DETERMINE THE INDICES IMIN, IMAX, WHERE THE FUNCTION
C    QS/WS ATTAINS ITS MINIMUM AND MAXIMUM VALUES OF EMIN, EMAX:
          IF (ABS(IMAX-IMIN).GE.2 .AND. EU.LE.EMAX) THEN
              IE = (IMAX+IMIN)/2
              EEE = QS(IE)/WS(IE)
              CALL ESTPAC(.FALSE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,
     +                    TAU,JJL,JJR,SUM,U)
              IF (SUM.GT.PIN) THEN
                  IMAX = IE
                  WU = SUM
                  EU = EEE
                  UUP = U
              ELSE
                  IMIN = IE
                  WL = SUM
                  EL = EEE
                  ULO = U
              END IF
              GO TO 80
          END IF
C            ---------------------------------
C
C     IMPROVE APPROXIMATION FOR EIG USING BISECTION OR SECANT METHOD.
C     SUBSTITUTE 'BALLPARK' ESTIMATE IF APPROXIMATION GROWS TOO LARGE.
C
          DEDW = (EU-EL)/ (WU-WL)
          FOLD = 0.0D0
          IF (INTAB.EQ.1) BALLPK = (PIN/ (A-B))**2
          IF (INTAB.EQ.1 .AND. PR) WRITE (T21,FMT=*) ' BALLPK = ',BALLPK
C             ---------------------------------
          LOGIC = .TRUE.
   90     CONTINUE
C      NOW TRY TO REFINE THE ESTIMATE EEE:
C       USE A SECANT METHOD.
          IF (LOGIC) THEN
              LOGIC = (WL.LT.PIN-ONE .OR. WU.GT.PIN+ONE)
              EEE = EL + DEDW* (PIN-WL)
              FNEW = MIN(PIN-WL,WU-PIN)
              IF (FNEW.GT.0.4D0*FOLD .OR. FNEW.LE.ONE) EEE = 0.5D0*
     +            (EL+EU)
              IF (INTAB.EQ.1 .AND. ABS(EEE).GT.1.0D3*BALLPK) THEN
                  EEE = BALLPK
                  GO TO 100
              ELSE IF (INTAB.NE.1 .AND. ABS(EEE).GT.1.0D6) THEN
                  EEE = ONE
                  GO TO 100
              ELSE
                  FOLD = FNEW
                  CALL ESTPAC(.FALSE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,
     +                        PSS,TAU,JJL,JJR,SUM,U)
                  IF (SUM.LT.PIN) THEN
                      EL = EEE
                      WL = SUM
                      ULO = U
                  ELSE
                      EU = EEE
                      WU = SUM
                      UUP = U
                  END IF
                  DEDW = (EU-EL)/ (WU-WL)
                  GO TO 90
              END IF
          END IF
C             -----------------------------
      END IF
  100 CONTINUE
      RETURN
      END
C
      SUBROUTINE PRELIM(MF,ML,EEE,BALLPK,XS,QS,WS,DS,DELT,PS,PSS,TAU,
     +                  JJL,JJR,LIMUP,ELIMUP,EL,WL,DEDW,GUESS,EIG,AAA,
     +                  AA,BBB,BB,NCA,NCB,EIGPI,ALFA,BETA,DTHDEA,DTHDEB,
     +                  IMID,TMID)

C  THIS PROGRAM, USING THE FIRST ESTIMATE FOR THE EIGENVALUE
C    OBTAINED BY ESTIM,
C    SETS THE INITIAL INTERVAL (POSSIBLY A SUBINTERVAL OF (A,B))
C    TO BE USED FOR THE PROBLEM.  IT IS CALLED BY SLEIGN.
C    IT DETERMINES ALFA, BETA (THE
C    BOUNDARY VALUES OF THE PRUEFER ANGLE THETA), TRIES TO IMPROVE
C    THE ESTIMATE OF THE EIGENVALUE (TAKING ALFA, BETA INTO ACCOUNT)
C    AND SETS THE MIDPOINT, TMID, IN (-1,1) TO BE USED IN THE
C    COMPUTATIONS.
C
C    IT ALSO CHECKS TO SEE IF AN ENDPOINT IS LP, AND IF SO, WHETHER
C    THE POINT SPECTRUM MIGHT BE BOUNDED ABOVE.

C  INPUT QUANTITIES: MF,ML,EEE,BALLPK,XS,QS,WS,DS,DELT,PS,PSS,
C                    TAU,JJL,JJR,LIMUP,ELIMUP,EL,WL,DEDW,GUESS,
C                    EIG,NCA,NCB,EIGPI
C  OUTPUT QUANTITIES: EEE,PSS,JJL,JJR,TEE,JAY,ZEE,LIMUP,ELIMUP,
C                     AAA,AA,BBB,BB,ALFA,BETA,DTHDEA,DTHDEB,
C                     IMID,TMID
C     .. Scalar Arguments ..
      REAL AA,AAA,ALFA,BALLPK,BB,BBB,BETA,DEDW,DTHDEA,
     +                 DTHDEB,EEE,EIG,EIGPI,EL,ELIMUP,GUESS,TAU,TMID,WL
      INTEGER IMID,JJL,JJR,MF,ML,NCA,NCB
      LOGICAL LIMUP
C     ..
C     .. Array Arguments ..
      REAL DELT(100),DS(100),PS(100),PSS(100),QS(100),
     +                 WS(100),XS(100)
C     ..
C     .. Scalars in Common ..
      REAL A,A1,A2,B,B1,B2,HPI,P0ATA,P0ATB,PI,QFATA,QFATB,
     +                 TWOPI
      INTEGER INTAB,MFS,MLS,T21
      LOGICAL PR
C     ..
C     .. Arrays in Common ..
      REAL TEE(100),ZEE(100)
      INTEGER JAY(100)
C     ..
C     .. Local Scalars ..
      REAL BOUNDA,BOUNDB,DERIVL,DERIVR,ELIMA,ELIMB,ONE,PIN,
     +                 SUM,SUM0,THOUS,U,TMP
      INTEGER I,IPA,IPB,JFLAG,KFLAG
      LOGICAL GESS0,LCOA,LCOB,LIMA,LIMB,SINGA,SINGB
C     ..
C     .. External Functions ..
      REAL TFROMI
      EXTERNAL TFROMI
C     ..
C     .. External Subroutines ..
      EXTERNAL ALFBET,ENDPT,ESTPAC,SETMID
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,MIN,SIGN
C     ..
C     .. Common blocks ..
      COMMON /BCDATA/A1,A2,P0ATA,QFATA,B1,B2,P0ATB,QFATB
      COMMON /DATADT/A,B,INTAB
      COMMON /LP/MFS,MLS
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /TEEZ/TEE
      COMMON /ZEEZ/JAY,ZEE
C     ..
      THOUS = 1000.0D0
      PIN = EIGPI + PI
      SINGA = NCA .GE. 3
      SINGB = NCB .GE. 3
      LCOA = NCA .EQ. 4
      LCOB = NCB .EQ. 4
      GESS0 = ABS(GUESS) .LE. (1D-7)
      ONE = 1.0D0
      SUM0 = 0.0D0
C  LIMUP = .TRUE. MEANS IT APPEARS THE EIGENVALUES ARE BOUNDED ABOVE.
C  IN THIS CASE, ELIMUP IS THE ESTIMATED UPPER BOUND -- OR, RATHER,
C  THE LOWER BOUND OF THE CONTINUOUS SPECTRUM.
      IF (LIMUP .AND. EEE.GE.ELIMUP) EEE = ELIMUP - 1.0D0

C        SET-INITIAL-INTERVAL-AND-MATCHPOINT
      IF (.NOT.GESS0) THEN
          EEE = EIG
          CALL ESTPAC(.FALSE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,TAU,
     +                JJL,JJR,SUM,U)
      END IF
C
C     CHOOSE INITIAL INTERVAL AS LARGE AS POSSIBLE THAT AVOIDS OVERFLOW.
C     JJL AND JJR ARE BOUNDARY INDICES FOR NONNEGATIVITY OF EIG*W-Q.
C
      IF (.NOT.SINGA) THEN
          AA = -ONE
      ELSE IF (LCOA) THEN
          AA = -0.9999D0
          AAA = AA
      ELSE
          AA = TFROMI(JJL)
          AAA = MIN(AAA,AA)
          AA = MAX(AA,AAA)
          TMP = -0.99D0
          AA = MIN(AA,TMP)
          AA = MAX(AA,AAA)
      END IF
      IF (.NOT.SINGB) THEN
          BB = ONE
      ELSE IF (LCOB) THEN
          BB = 0.9999D0
          BBB = BB
      ELSE
          BB = TFROMI(JJR)
          BBB = MAX(BBB,BB)
          BB = MIN(BB,BBB)
          TMP = 0.99D0
          BB = MAX(BB,TMP)
          BB = MIN(BB,BBB)
      END IF
C
C     DETERMINE BOUNDARY VALUES ALFA AND BETA FOR THETA AT A AND B.
C
      CALL ALFBET(A,INTAB,AA,A1,A2,EEE,P0ATA,QFATA,SINGA,ALFA,KFLAG,
     +            DERIVL)
      CALL ALFBET(B,INTAB,BB,B1,B2,EEE,P0ATB,QFATB,SINGB,BETA,JFLAG,
     +            DERIVR)
      IF (SINGB) BETA = PI - BETA
C
C     TAKE BOUNDARY CONDITIONS INTO ACCOUNT IN ESTIMATION OF EIG.
C
      PIN = EIGPI + BETA - ALFA
      IF (LCOA) PIN = PIN + ALFA
      IF (LCOB) PIN = PIN + PI - BETA

      IF (GESS0) THEN
          EEE = EL + DEDW* (PIN-WL)
          IF (.NOT. (LCOA.OR.LCOB) .AND.
     +        ABS(EEE).GT.THOUS) EEE = SIGN(THOUS,EEE)
          IF (INTAB.EQ.1 .AND. ABS(EEE).GT.1.0D3*BALLPK) EEE = BALLPK
      END IF

      CALL ESTPAC(.TRUE.,MF,ML,EEE,SUM0,QS,WS,DS,DELT,PS,PSS,TAU,JJL,
     +            JJR,SUM,U)
C
C     RESET BOUNDARY VALUES ALFA AND BETA, WHICH MAY DEPEND UPON
C     THE CURRENT VALUE FOR THE EIGENPARAMETER.
C
      CALL ALFBET(A,INTAB,AA,A1,A2,EEE,P0ATA,QFATA,SINGA,ALFA,KFLAG,
     +            DERIVL)
      CALL ALFBET(B,INTAB,BB,B1,B2,EEE,P0ATB,QFATB,SINGB,BETA,JFLAG,
     +            DERIVR)
      IF (SINGB) BETA = PI - BETA
      DTHDEA = DERIVL
      DTHDEB = -DERIVR
      IF (PR) WRITE (T21,FMT='(A,E22.14,A,E22.14)') '  ALFA=',ALFA,
     +    '   BETA=',BETA
C
C     CHOOSE INITIAL MATCHING POINT TMID .
C
      IMID = 50
      TMID = 0.5D0* (AA+BB) + 0.031D0*PI
      IF (PR) WRITE (T21,FMT='(A,E15.7,A,F11.8,A,E15.7)') ' ESTIM=',EEE,
     +    '  TMID=',TMID
      IF (PR) WRITE (T21,FMT='(A,F11.8,A,F11.8,A,F11.8,A,F11.8)')
     +    ' AAA=',AAA,'  AA=',AA,'  BB=',BB,'  BBB=',BBB

C        END (SET-INITIAL-INTERVAL-AND-MATCHPOINT)
C
C  IF EITHER ENDPOINT IS LP, USE SUBROUTINE ENDPT TO SEE IF THAT
C  ENDPOINT REQUIRES THE EIGENVALUES TO BE BOUNDED ABOVE, AND IF SO,
C  WHAT IS AN ESTIMATED UPPER BOUND.
      LIMA = .FALSE.
      IF (NCA.EQ.5 .OR. NCA.EQ.6) THEN
          CALL ENDPT(MF,ML,XS,PS,QS,WS,-ONE,IPA,NCA,BOUNDA)
          IF (PR) WRITE (T21,FMT=*) ' IPA,NCA,BOUNDA = ',IPA,NCA,BOUNDA
          IF (BOUNDA.LT. (10000.0D0)) THEN
              LIMA = .TRUE.
              ELIMA = BOUNDA
          END IF
      END IF
      LIMB = .FALSE.
      IF (NCB.EQ.5 .OR. NCB.EQ.6) THEN
          CALL ENDPT(MF,ML,XS,PS,QS,WS,ONE,IPB,NCB,BOUNDB)
          IF (PR) WRITE (T21,FMT=*) ' IPB,NCB,BOUNDB = ',IPB,NCB,BOUNDB
          IF (BOUNDB.LT. (10000.0D0)) THEN
              LIMB = .TRUE.
              ELIMB = BOUNDB
          END IF
      END IF
C
C  IF BOTH ENDPOINTS CAUSE THE EIGENVALUES TO BE BOUNDED ABOVE,
C  SET ELIMUP TO BE THE LOWEST UPPER BOUND.
C
      IF (LIMA .OR. LIMB) THEN
          LIMUP = .TRUE.

          IF (.NOT.LIMB) THEN
              ELIMUP = ELIMA
          ELSE IF (.NOT.LIMA) THEN
              ELIMUP = ELIMB
          ELSE
              ELIMUP = MIN(ELIMA,ELIMB)
          END IF

          IF (PR) WRITE (T21,FMT=*)
     +        ' THE CONTINUOUS SPECTRUM HAS A LOWER '
          IF (PR) WRITE (T21,FMT=*) '   BOUND, SIGMA0 = ',ELIMUP
      END IF
C
      IF (EIG.EQ.0.0D0 .AND. LIMUP .AND. EEE.GE.ELIMUP) EEE = ELIMUP -
     +    0.01D0

      CALL SETMID(MF,ML,EEE,QS,WS,IMID,TMID)
C  SET THE VALUES OF T, TEE(*), CORRESPONDING TO THE PLACES
C  WHERE THE Z's, ZEE(*), CHANGE WHEN USING SUBROUTINE GERKZ
C  FOR THE INTEGRATIONS FOR THETA.
C  THE VALUES OF JAY(*) WERE SET IN SUBROUTINE ESTPAC.
      DO 85 I = 1,100
          TEE(I) = ONE
          IF (JAY(I).NE.0) TEE(I) = TFROMI(JAY(I))
          IF (ZEE(I).GT.100.0D0) ZEE(I) = 100.0D0
          IF (JAY(I).NE.0 .AND. PR) WRITE (T21,FMT=*) ' I,T,Z = ',I,
     +        TEE(I),ZEE(I)
   85 CONTINUE
      IF (JAY(3).EQ.0 .AND. ZEE(2).NE.1.0D0) THEN
          TEE(3) = TEE(2)
          ZEE(3) = ZEE(2)
          TEE(2) = 0.0D0
          ZEE(2) = 1.0D0
      ENDIF

      RETURN
      END
C
      SUBROUTINE EIGFCN(EIGPI,A1,A2,B1,B2,AOK,BOK,NCA,NCB,SLFUN,ISLFUN)
C     **********
C  THIS PROGRAM CALCULATES SELECTED EIGENFUNCTION VALUES BY
C    INTEGRATION (OVER T).  THE SELECTED VALUES OF T ARE IN
C    THE ARRAY SLFUN, WHICH ARE REPLACED BY THE CALCULATED
C    VALUES OF THE EIGENFUNCTION.
C    IT IS CALLED FROM SLEIGN.
C  INPUT QUANTITIES: EIGPI,A1,A2,B1,B2,AOK,BOK,NCA,NCB,
C                    SLFUN,ISLFUN
C  OUTPUT QUANTITIES: SLFUN
C
C     N.B.: IN THIS PROGRAM IT IS ASSUMED THAT THE POINTS T
C              IN SLFUN ALL LIE WITHIN THE INTERVAL (AA,BB).
C
C     .. Scalars in Common ..
      REAL AA,BB,DTHDAA,DTHDBB,TMID
      INTEGER MDTHZ,T21
      LOGICAL ADDD,PR
C     ..
C     .. Local Scalars ..
      REAL DTHDAT,DTHDBT,DTHDET,EFF,T,THT,TM
      INTEGER I,IFLAG,J,NC,NMID
      LOGICAL LCOA,LCOB,OK
C     ..
C     .. Local Arrays ..
      REAL ERL(3),ERR(3),YL(3),YR(3)
C     ..
C     .. External Subroutines ..
      EXTERNAL INTEG
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC EXP,SIN
C     ..
C     .. Common blocks ..
      COMMON /PRIN/PR,T21
      COMMON /TDATA/AA,TMID,BB,DTHDAA,DTHDBB,MDTHZ,ADDD
C     ..
C     .. Scalar Arguments ..
      REAL A1,A2,B1,B2,EIGPI
      INTEGER ISLFUN,NCA,NCB
      LOGICAL AOK,BOK
C     ..
C     .. Array Arguments ..
      REAL SLFUN(ISLFUN+9)
C     ..
      NMID = 0
      DO 10 I = 1,ISLFUN
          IF (SLFUN(9+I).LE.TMID) NMID = I
   10 CONTINUE
      IF (NMID.GT.0) THEN
          T = AA
          YL(1) = SLFUN(3)
          YL(2) = 0.0D0
          YL(3) = 0.0D0
          LCOA = NCA .EQ. 4
          OK = AOK
          NC = NCA
          EFF = 0.0D0
          DO 20 J = 1,NMID
              TM = SLFUN(J+9)
              IF (TM.LT.AA .OR. TM.GT.BB) THEN
                  IF (PR) WRITE (*,FMT=*) ' T.LT.AA .OR. T.GT.BB '
                  STOP
              END IF
              THT = YL(1)
              DTHDAT = DTHDAA*EXP(-2.0D0*EFF)
              DTHDET = YL(2)
              IF (TM.GT.AA) THEN
                  CALL INTEG(T,THT,DTHDAT,DTHDET,TM,A1,A2,SLFUN(8),YL,
     +                       ERL,OK,NC,IFLAG)
                  IF (LCOA) THEN
                      EFF = YL(3)
                  ELSE
                      NC = 1
                      OK = .TRUE.
                      EFF = EFF + YL(3)
                  END IF
              END IF
              SLFUN(J+9) = SIN(YL(1))*EXP(EFF+SLFUN(4))
              T = TM
              IF (T.GT.-1.0D0) NC = 1
              IF (T.LT.-0.9D0 .AND. LCOA) THEN
                  NC = 4
                  T = AA
                  YL(1) = SLFUN(3)
                  YL(2) = 0.0D0
                  YL(3) = 0.0D0
              END IF
   20     CONTINUE
      END IF
      IF (NMID.LT.ISLFUN) THEN
          T = BB
          YR(1) = SLFUN(6)
          YR(2) = 0.0D0
          YR(3) = 0.0D0
          LCOB = NCB .EQ. 4
          OK = BOK
          NC = NCB
          EFF = 0.0D0
          DO 30 J = ISLFUN,NMID + 1,-1
              TM = SLFUN(J+9)
              IF (TM.LT.AA .OR. TM.GT.BB) THEN
                  IF (PR) WRITE (*,FMT=*) ' T.LT.AA .OR. T.GT.BB '
                  STOP
              END IF
              THT = YR(1)
              DTHDBT = DTHDBB*EXP(-2.0D0*EFF)
              DTHDET = YR(2)
              IF (TM.LT.BB) THEN
                  CALL INTEG(T,THT,DTHDBT,DTHDET,TM,B1,B2,SLFUN(8),YR,
     +                       ERR,OK,NC,IFLAG)
                  IF (LCOB) THEN
                      EFF = YR(3)
                  ELSE
                      OK = .TRUE.
                      NC = 1
                      EFF = EFF + YR(3)
                  END IF
              END IF
              SLFUN(J+9) = SIN(YR(1)+EIGPI)*EXP(EFF+SLFUN(7))
              IF (ADDD) SLFUN(J+9) = -SLFUN(J+9)
              T = TM
              IF (T.LT.1.0D0) NC = 1
              IF (T.GT.0.9D0 .AND. LCOB) THEN
                  NC = 4
                  T = BB
                  YR(1) = SLFUN(6)
                  YR(2) = 0.0D0
                  YR(3) = 0.0D0
              END IF
   30     CONTINUE
      END IF
      RETURN
      END
C
      SUBROUTINE EFDATA(ALFA,DTHDEA,A1,A2,BETA,DTHDEB,B1,B2,EIG,EIGPI,
     +                  EPS,AOK,NCA,BOK,NCB,RAY,SLFUN)
C
C  THIS PROGRAM IS USED ONLY AFTER THE WANTED EIGENVALUE HAS BEEN
C    SUCCESSFULLY COMPUTED. IT IS CALLED FROM SLEIGN.
C    IT CONVERTS THE T-DATA AA,TMID,BB TO CORRESPONDING X-DATA,
C    FILLS 7 OF THE FIRST 9 LOCATIONS OF SLFUN,
C    COMPUTES VALUES OF LOG(RHO(A)), LOG(RHO(B)) SUCH THAT THE
C    CORRESPONDING SOLUTION Y(X) = RHO(X)*SIN(THETA(X)) IS
C    CONTINUOUS AT XMID, AND HAS L2-NORM EQUAL TO 1.0 .
C    THESE VALUES ARE PLACED IN SLFUN(4) AND SLFUN(7).
C  THE COMPUTED VALUE OF EIG IS FINALLY CHECKED ONE LAST TIME
C    USING THE JUMPS IN Y AND PY' AT XMID IN A FORM OF
C    RALEIGH QUOTIENT CORRECTION.  (HERE CALLED "RAY".)
C
C  INPUT QUANTITIES: ALFA,DTHDEA,A1,A2,BETA,DTHDEB,B1,B2,EIG,
C                    EIGPI,EPS,AOK,BOK,NCA,NCB,SLFUN
C  OUTPUT QUANTITIES: XAA,XMID,XBB,EIGSAV,ISAVE,AA,BB,RAY,ADDD
C                     SLFUN
C
C     .. Scalar Arguments ..
      REAL A1,A2,ALFA,B1,B2,BETA,DTHDEA,DTHDEB,EIG,EIGPI,
     +                 EPS,RAY
      INTEGER NCA,NCB
      LOGICAL AOK,BOK
C     ..
C     .. Array Arguments ..
      REAL SLFUN(9)
C     ..
C     .. Scalars in Common ..
      REAL AA,BB,DTHDAA,DTHDBB,EIGSAV,TMID,TSAVEL,TSAVER,Z
      INTEGER IND,ISAVE,MDTHZ,T21
      LOGICAL ADDD,PR
C     ..
C     .. Local Scalars ..
      REAL AAF,BBF,CL,CR,DEN,DUM,E,ONE,PSIL,PSIPL,PSIPR,
     +                 PSIR,SL,SQL,SQR,SR,THDAAX,THDBBX,TMP,UL,UR,XAA,
     +                 XBB,XMID
      INTEGER JFLAG
C     ..
C     .. Local Arrays ..
      REAL ERL(3),ERR(3),YL(3),YR(3)
C     ..
C     .. External Subroutines ..
      EXTERNAL AABB,DXDT,INTEG
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,COS,EXP,LOG,SIN,SQRT
C     ..
C     .. Common blocks ..
      COMMON /DATAF/EIGSAV,IND
      COMMON /PRIN/PR,T21
      COMMON /TDATA/AA,TMID,BB,DTHDAA,DTHDBB,MDTHZ,ADDD
      COMMON /TSAVE/TSAVEL,TSAVER,ISAVE
      COMMON /Z1/Z
C     ..
      ONE = 1.0D0
      Z = 1.0D0
   50 CONTINUE
      CALL DXDT(TMID,TMP,XMID)
      CALL DXDT(AA,TMP,XAA)
      SLFUN(1) = XMID
      SLFUN(2) = XAA
      SLFUN(3) = ALFA
      SLFUN(6) = BETA + EIGPI
      SLFUN(8) = EPS
      SLFUN(9) = Z
C
C     INTEGRATE FROM BOTH ENDPOINTS TO THE MIDPOINT:
C
      EIGSAV = EIG
      THDAAX = 0.0D0
      YL(1) = 0.0D0
      YL(2) = 0.0D0
      YL(3) = 0.0D0
      ISAVE = 0
      CALL INTEG(AA,ALFA,THDAAX,DTHDEA,TMID,A1,A2,EPS,YL,ERL,AOK,NCA,
     +           JFLAG)
      IF (JFLAG.EQ.5) THEN
          AAF = AA
          CALL AABB(AA,-ONE)
          IF (PR) WRITE (T21,FMT=*) ' AA MOVED FROM ',AAF,'IN TO',AA
          GO TO 50
      END IF
  100 CONTINUE
      CALL DXDT(BB,TMP,XBB)
      SLFUN(5) = XBB
      THDBBX = 0.0D0
      YR(1) = 0.0D0
      YR(2) = 0.0D0
      YR(3) = 0.0D0
      ISAVE = 0
      CALL INTEG(BB,BETA,THDBBX,DTHDEB,TMID,B1,B2,EPS,YR,ERR,BOK,NCB,
     +           JFLAG)
      IF (JFLAG.EQ.5) THEN
          BBF = BB
          CALL AABB(BB,-ONE)
          IF (PR) WRITE (T21,FMT=*) ' BB MOVED FROM ',BBF,'IN TO',BB
          GO TO 100
      END IF
      YR(1) = YR(1) + EIGPI
      SL = SIN(YL(1))
      SR = SIN(YR(1))
      CL = COS(YL(1))
      CR = COS(YR(1))
C  UL AND UR ARE THE VALUES OF THE INTEGRAL OF Y**2*W FROM THE
C  ENDPOINTS A AND B, RESPECTIVELY.
      UL = (YL(2)-DTHDEA*EXP(-2.0D0*YL(3)))
      UR = (YR(2)-DTHDEB*EXP(-2.0D0*YR(3)))
      DEN = 0.5D0*LOG(UL*SR*SR-UR*SL*SL)
      DUM = 0.5D0*LOG(UL-UR)
C     COMPUTE SLFUN(4), SLFUN(7) TOWARDS NORMALIZING THE EIGENFUNCTION.
      SLFUN(4) = -YL(3) - DUM
      SLFUN(7) = -YR(3) - DUM

C     DO (CHECK-MATCHING-VALUES-OF-EIGENFUNCTION)
C     PERFORM FINAL CHECK ON EIG.
C
      DEN = UL*SR*SR - UR*SL*SL
      E = ABS(SR)/SQRT(DEN)
      PSIL = E*SL
      PSIPL = E*CL
      SQL = E*E*UL
      E = ABS(SL)/SQRT(DEN)
      PSIR = E*SR
      PSIPR = E*CR
      SQR = E*E*UR
      ADDD = PSIL*PSIR .LT. 0.0D0 .AND. PSIPL*PSIPR .LT. 0.0D0
      RAY = EIG + (PSIL*PSIPL-PSIR*PSIPR)/ (SQL-SQR)
      IF (PR) WRITE (T21,FMT=*) ' RAY,ADDD = ',RAY,ADDD
C           END (CHECK-MATCHING-VALUES-OF-EIGENFUNCTION)
      RETURN
      END
C
      SUBROUTINE SETMID(MF,ML,EIG,QS,WS,IMID,TMID)
C     **********
C
C     THIS PROGRAM SELECTS A POINT IN (-1,1) AS TMID.
C     IT IS CALLED BY RESET AND PRELIM.
C     IT TESTS THE INTERVAL SAMPLE POINTS IN THE ORDER
C     50,51,49,52,48,...,ETC. FOR THE FIRST ONE WHERE THE EXPRESSION
C     (LAMBDA*W-Q) IS POSITIVE.  THIS T-POINT IS DESIGNATED TMID.
C  THEORETICALLY IT DOESN'T MATTER WHICH POINT T IN (-1,1) IS USED
C    FOR TMID, BUT IN PRACTICE IT CAN MAKE A GREAT DEAL OF
C    DIFFERENCE. THIS SCHEME IS JUST A RULE OF THUMB WHICH SEEMS
C    TO WORK FAIRLY WELL IN AVOIDING BAD CHOICES FOR TMID.
C
C   INPUT QUANTITIES: MF, ML, EIG, QS, WS
C   OUTPUT QUANTITIES: IMID, TMID
C     **********
C     .. Local Scalars ..
      REAL S
      INTEGER I,J
C     ..
C     .. External Functions ..
      REAL TFROMI
      EXTERNAL TFROMI
C     ..
C     .. Scalar Arguments ..
      REAL EIG,TMID
      INTEGER IMID,MF,ML
C     ..
C     .. Array Arguments ..
      REAL QS(*),WS(*)
C     ..
C     .. Scalars in Common ..
      INTEGER T21
      LOGICAL PR
C     ..
C     .. Common blocks ..
      COMMON /PRIN/PR,T21
C     ..
      S = -1.0D0
      DO 10 J = 1,100
          I = 50 + S* (J/2)
          S = -S
          IF (I.LT.MF .OR. I.GT.ML) GO TO 20
          IF (EIG*WS(I)-QS(I).GT.0.0D0) THEN
              IMID = I
              TMID = TFROMI(IMID)
              GO TO 20
          END IF
   10 CONTINUE
   20 CONTINUE
      IF (PR) WRITE (T21,FMT=*) ' NEW TMID = ',TMID
      RETURN
      END
C
      SUBROUTINE EXTR(MM,F,GQ,GW,XS,PS,QS,WS)

C  THIS SUBROUTINE IS CALLED FROM SUBROUTINE ENDPT ONLY,
C    FOR THE PURPOSE OF DETERMINING THE ENDPOINT VALUES
C    OF F (OR Q, OR W) IN THE INDICIAL EQUATION AT A FINITE
C    LP ENDPOINT.
C    IT PUTS VALUES OF F (OR Q OR W), CORRESPONDING TO
C    EQUALLY SPACED VALUES OF X, IN
C    AN ARRAY DF, AND EXTRAPOLATES THE VALUES OF F (OR Q, OR W)
C    TO THE ENDPOINT, XEND, OF THE INTERVAL.
C
C  INPUT QUANTITIES: MM,XS,PS,QS,WS,A,B,EPSMIN
C  OUTPUT QUANTITIES: F,GQ,GW

C     .. Scalar Arguments ..
      REAL F,GQ,GW
      INTEGER MM
C     ..
C     .. Array Arguments ..
      REAL PS(100),QS(100),WS(100),XS(100)
C     ..
C     .. Scalars in Common ..
      REAL A,B,EPSMIN
      INTEGER INTAB
C     ..
C     .. Local Scalars ..
      REAL TI,TIE,TMP,XEND,XI,XIE,EPST,ERR
      INTEGER EP,I,J
C     ..
C     .. Local Arrays ..
      REAL DF(6),DQ(6),DW(6),XX(6)
C     ..
C     .. External Functions ..
      REAL P,TFROMI
      EXTERNAL P,TFROMI
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,INTPOL
C     ..
C     .. Common blocks ..
      COMMON /DATADT/A,B,INTAB
      COMMON /RNDOFF/EPSMIN
C     ..
      IF (MM.LT.50) THEN
          EP = 1
          XEND = A
      ELSE
          EP = -1
          XEND = B
      END IF

C  HERE WE WANT TO FIND THE LIMIT OF
C   (X-A)*P'(X)/P(X) AT X=A
C  AND OF
C    (X-A)**2*Q(X)/P(X)
C  AND OF
C    (X-A)**2*W(X)/P(X)
C  OR THE SAME SORT OF THINGS AT X=B.

      DO 10 J = 1,5
          I = MM + (J-1)*EP
          TI = TFROMI(I)
          TIE = TI + 2.0D0*EPSMIN*EP
          CALL DXDT(TI,TMP,XI)
          CALL DXDT(TIE,TMP,XIE)
          DF(J) = (XS(I)-XEND)* (P(XIE)-PS(I))/ ((XIE-XS(I))*PS(I))
          DQ(J) = (XS(I)-XEND)**2*QS(I)
          DW(J) = (XS(I)-XEND)**2*WS(I)
          XX(J) = XS(I)
   10 CONTINUE
           EPST = 0.00001D0
           CALL INTPOL(5,XX,DF,XEND,EPST,3,F,ERR)
           CALL INTPOL(5,XX,DQ,XEND,EPST,3,GQ,ERR)
           CALL INTPOL(5,XX,DW,XEND,EPST,3,GW,ERR)
      IF(ABS(F).LE.ERR) F = 0.0D0
      IF(ABS(GQ).LE.ERR) GQ = 0.0D0
      IF(GW.LE.ERR) GW = 0.0D0 
      RETURN
      END
C
      SUBROUTINE ENDPT(MF,ML,XS,PS,QS,WS,TEND,IPM,NC,BOUND)
C  THIS PROGRAM IS CALLED FROM PRELIM.
C  MAINLY IT COMPUTES THE QUANTITIES IN /COMMON/ALBE/ FOR
C    USE WHEN A FINITE ENDPOINT IS LP.
C    IF THE ENDPOINT IS SUCH THAT THE QUANTITIES INVOLVED
C    APPEAR TO NOT HAVE LIMITING VALUES, (AS HAPPENS IN THE
C    PROBLEM
C         p(x) = 1, q(x) = cos(x)**2, w(x) = 1  on (0,+Inf)
C    FOR EXAMPLE),  THEN SLEIGN2 CANNOT CONTINUE.
C
C    AT THE SAME TIME, IT TRIES TO DETERMINE WHETHER OR NOT
C    THE EIGENVALUES HAVE A FINITE UPPER BOUND.
C
C  INPUT QUANTITIES: MF,ML,XS,PS,QS,WS,TEND,INTAB,EPSMIN
C  OUTPUT QUANTITIES: LPWA,LPQA,LPWB,LPQB,NC,BOUND
C
C  RECALL THAT THE STORED ARRAYS QS AND WS ARE REALLY THE
C    VALUES OF Q/P AND W/P.
C  N.B.: INDICIAL EQUATION IS (AT A REGULAR SINGULAR POINT):
C            S*S + (F-1)*S + G = 0
C      WHERE  F IS FA OR FB
C      AND    G IS LAMBDA*GWA - GQA
C               OR LAMBDA*GWB - GQB
C  (HERE, THE INDEPENDENT VARIABLE IS X IN (A,B)

C     .. Scalar Arguments ..
      REAL BOUND,TEND
      INTEGER IPM,MF,ML,NC
C     ..
C     .. Array Arguments ..
      REAL PS(100),QS(100),WS(100),XS(100)
C     ..
C     .. Scalars in Common ..
      REAL A,B,EPSMIN,LPQA,LPQB,LPWA,LPWB
      INTEGER INTAB,T21
      LOGICAL PR
C     ..
C     .. Local Scalars ..
      REAL APQ1,APQ2,APW1,APW2,PQ1,PQ2,PW1,PW2,TMP,
     +     FA,FB,GQA,GQB,GWA,GWB
      INTEGER I,IQ,IW,MM,MM6
      LOGICAL LOGIC
C     ..
C     .. External Subroutines ..
      EXTERNAL EXTR
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MIN
C     ..
C     .. Common blocks ..
c     COMMON /ALBE/LPWA,LPQA,LPWB,LPQB
      COMMON /ALBE/LPWA,LPQA,FA,GWA,GQA,LPWB,LPQB,FB,GWB,GQB
      COMMON /DATADT/A,B,INTAB
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
C     ..
      IF (PR) WRITE (T21,FMT=*) ' IN ENDPT, NC = ',NC
      IF (TEND.LT.0.0D0) THEN
          MM = MF
      ELSE
          MM = ML
      END IF
      BOUND = 1.D+19
      IQ = 0
      IW = 0
      IF (MM.LT.50) THEN
          MM6 = MM + 6
          DO 10 I = MM,MM6
              PW1 = PS(I+1)**2*WS(I+1) - PS(I)**2*WS(I)
              PW2 = PS(I+2)**2*WS(I+2) - PS(I+1)**2*WS(I+1)
              PQ1 = PS(I+1)**2*QS(I+1) - PS(I)**2*QS(I)
              PQ2 = PS(I+2)**2*QS(I+2) - PS(I+1)**2*QS(I+1)
              APW1 = ABS(PW1)
              APW2 = ABS(PW2)
              APQ1 = ABS(PQ1)
              APQ2 = ABS(PQ2)
              IF ((APW1.LE.EPSMIN.AND.APW2.LE.EPSMIN) .OR.
     +            PW1*PW2.GT.0.D0) IW = IW + 1
              IF ((APQ1.LE.EPSMIN.AND.APQ2.LE.EPSMIN) .OR.
     +            PQ1*PQ2.GT.0.D0) IQ = IQ + 1
   10     CONTINUE
          IPM = MIN(IW,IQ)
          IF (IPM.GE.5) THEN
              LPWA = PS(MM)**2*WS(MM)
              LPQA = PS(MM)**2*QS(MM)
              IF (INTAB.EQ.1 .OR. INTAB.EQ.2) THEN
                  CALL EXTR(MM,FA,GQA,GWA,XS,PS,QS,WS)
                  IF (PR) WRITE (T21,FMT=*) ' FA,GWA,GQA = ',FA,GWA,GQA
                  LOGIC = (ABS(FA)+ABS(GWA)+ABS(GQA)) .LT. 1000.0D0
                  IF (LOGIC) THEN

C  INDICIAL EQUATION IS:  S*S + (FA-1)*S + (LAMBDA*GWA-GQA)=0

                      IF (GWA.GT.EPSMIN) THEN
C               FOR REAL ROOTS, REQUIRE LAMBDA .LE. BOUND, WHERE:
                          TMP = (0.25D0*(FA-1.0D0)**2+GQA)/GWA
                          BOUND = MIN(BOUND,TMP)
                      END IF
                  ELSE
C  THIS CASE MEANS THAT THE ENDPOINT IS PROBABLY AN "IRREGULAR"
C    POINT.
                      NC = 6
                  END IF
              ELSE
C  THIS CASE MEANS THAT THE ENDPOINT A IS AT -INF.  SO
                  IF (LPWA.GT.EPSMIN) BOUND = MIN(BOUND,LPQA/LPWA)
C  CHOOSE NC=7 ONLY IF THE USER HAS NOT ALREADY CHOSEN NC=6.
                  IF (NC.NE.6) NC = 7
C    TEMPORARILY SET (NC = 7 IS NOT BEING USED YET)
                  NC = 6
              END IF
          ELSE
C           ARRIVING HERE MEANS THAT IPM.LT.7, WHICH MEANS THAT
C           P*W AND P*Q DO NOT APPEAR TO BE MONOTONELY TENDING
C           TO A LIMIT (OR +INF OR -INF).  I SUPPOSE THIS MAY
C           MEAN THAT THERE ARE BANDS & GAPS.  I DON'T KNOW.
              IF (PR) WRITE (T21,FMT=*)
     +            ' P*W & P*Q BEHAVE BADLY NEAR THE END A. '
              NC = 8
          END IF
      ELSE
          MM6 = MM - 6
          DO 20 I = MM,MM6,-1
              PW1 = PS(I-1)**2*WS(I-1) - PS(I)**2*WS(I)
              PW2 = PS(I-2)**2*WS(I-2) - PS(I-1)**2*WS(I-1)
              PQ1 = PS(I-1)**2*QS(I-1) - PS(I)**2*QS(I)
              PQ2 = PS(I-2)**2*QS(I-2) - PS(I-1)**2*QS(I-1)
              APW1 = ABS(PW1)
              APW2 = ABS(PW2)
              APQ1 = ABS(PQ1)
              APQ2 = ABS(PQ2)
              IF ((APW1.LE.EPSMIN.AND.APW2.LE.EPSMIN) .OR.
     +            PW1*PW2.GT.0.D0) IW = IW + 1
              IF ((APQ1.LE.EPSMIN.AND.APQ2.LE.EPSMIN) .OR.
     +            PQ1*PQ2.GT.0.D0) IQ = IQ + 1
   20     CONTINUE
          IPM = MIN(IQ,IW)
          IF (IPM.GE.5) THEN
              LPWB = PS(MM)**2*WS(MM)
              LPQB = PS(MM)**2*QS(MM)
              IF (INTAB.EQ.1 .OR. INTAB.EQ.3) THEN
                  CALL EXTR(MM,FB,GQB,GWB,XS,PS,QS,WS)
                  IF (PR) WRITE (T21,FMT=*) ' FB,GWB,GQB = ',FB,GWB,GQB
                  LOGIC = (ABS(FB)+ABS(GWB)+ABS(GQB)) .LT. 1000.0D0
                  IF (LOGIC) THEN
C  INDICIAL EQUATION IS:  S*S + (FB-1)*S + (LAMBDA*GWB-GQB)=0
                      IF (GWB.GT.EPSMIN) THEN
C    FOR REAL ROOTS, REQUIRE LAMBDA .LE. BOUND, WHERE:
                          TMP = (0.25D0*(FB-1.0D0)**2+GQB)/GWB
                          BOUND = MIN(BOUND, TMP)
                      END IF
                  ELSE
C  THIS CASE MEANS THAT THE ENDPOINT IS PROBABLY AN "IRREGULAR"
C    POINT.
                      NC = 6
                  END IF
              ELSE
C  THIS CASE MEANS THAT THE ENDPOINT B IS AT +INF.  SO
                  IF (LPWB.GT.EPSMIN) BOUND = MIN(BOUND,LPQB/LPWB)
C  CHOOSE NC=7 ONLY IF THE USER HAS NOT ALREADY CHOSEN NC=6.
                  IF (NC.NE.6) NC = 7
C  TEMPORARILY SET (NC = 7 IS NOT BEING USED YET)
                  NC = 6
              END IF
          ELSE
C         ARRIVING HERE MEANS THAT IPM.LT.7, WHICH MEANS THAT
C         P*W AND P*Q DO NOT APPEAR TO BE MONOTONELY TENDING
C         TO A LIMIT (OR +INF OR -INF).  I SUPPOSE THIS MAY
C         MEAN THAT THERE ARE BANDS & GAPS.  I DON'T KNOW.
              IF (PR) WRITE (T21,FMT=*)
     +            ' P*W & P*Q BEHAVE BADLY NEAR THE END B. '
              NC = 8
          END IF
      END IF
      RETURN
      END
C
      SUBROUTINE THZ2TH(U,ERU,Z,Y,ERY)
C     **********

C  THIS PROGRAM IS CALLED FROM GERKZ.  THERE THE PRUEFER
C    ANGLE HAS A CONSTANT Z IN ITS DEFINITION, AND IS HERE
C    DENOTED BY THZ.  THE USUAL THETA (EQUIVALENT TO Z = 1)
C    IS DENOTED BY TH.
C  THIS PROGRAM CONVERTS FROM THZ TO TH WHERE
C    TAN(TH)=Y/(P*Y')
C  AND
C    TAN(THZ)=Z*Y/(P*Y'),
C  OR
C    TAN(THZ)=Z*TAN(TH) .
C  SO WE HAVE
C    DTHZ=Z*(COS(THZ)/COS(TH))**2 * DTH  ,
C  OR
C    DTH=(1/Z)*(COS(TH)/COS(THZ))**2 * DTHZ .
C
C  INPUT QUANTITIES: U,ERU,Z
C  OUTPUT QUANTITIES: Y,ERY
C     **********
C     .. Scalars in Common ..
      REAL HPI,PI,TWOPI
C     ..
C     .. Local Scalars ..
      REAL DTH,DTHZ,DUM,FAC,PIK,REMTHZ,TH,THZ
      INTEGER K
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN,COS,LOG,SIN,TAN
C     ..
C     .. Common blocks ..
      COMMON /PIE/PI,TWOPI,HPI
C     ..
C     .. Scalar Arguments ..
      REAL Z
C     ..
C     .. Array Arguments ..
      REAL ERU(3),ERY(3),U(3),Y(3)
C     ..
      THZ = U(1)
      DTHZ = U(2)
      K = THZ/PI
      IF (THZ.LT.0.0D0) K = K - 1
      PIK = K*PI
      REMTHZ = THZ - PIK
      IF (4.0D0*REMTHZ.LE.PI) THEN
          TH = ATAN(TAN(REMTHZ)/Z) + PIK
      ELSE IF (4.0D0*REMTHZ.GE.3.0D0*PI) THEN
          TH = ATAN(TAN(REMTHZ)/Z) + PIK + PI
      ELSE
          TH = ATAN(Z*TAN(REMTHZ-HPI)) + PIK + HPI
      END IF
C  THE TWO DIFFERENT APPEARING FORMULAS BELOW FOR FAC ARE
C    IN FACT EQUIVALENT.  WE USE WHICHEVER ONE AVOIDS
C    DIVIDING BY A SMALL NUMBER.
      DUM = ABS(COS(TH))
      IF (DUM.GE.0.5D0) THEN
          FAC = (DUM/COS(THZ))**2/Z
      ELSE
          FAC = Z* (SIN(TH)/SIN(THZ))**2
      END IF
      DTH = FAC*DTHZ
      Y(1) = TH
      Y(2) = DTH
      Y(3) = U(3) + 0.5D0*LOG(Z/FAC)

C  ALSO CONVERT THE ESTIMATED ERRORS IN THE THZ COMPUTATIONS
C  TO CORRESPONDING ERRORS IN TH.
      ERY(1) = FAC*ERU(1)
      ERY(2) = FAC*ERU(2)
      ERY(3) = FAC*ERU(3)
      RETURN
      END
C
      SUBROUTINE TH2THZ(Y,Z,U)
C     **********

C  THIS PROGRAM IS CALLED FROM GERKZ.  THERE THE PRUEFER
C    ANGLE HAS A CONSTANT Z IN ITS DEFINITION, AND IS HERE
C    DENOTED BY THZ.  THE USUAL THETA (EQUIVALENT TO Z = 1)
C    IS DENOTED BY TH.
C  THIS PROGRAM CONVERTS FROM TH TO THZ WHERE
C    TAN(TH)=Y/(P*Y')
C  AND
C    TAN(THZ)=Z*Y/(P*Y'),
C  OR
C    TAN(THZ)=Z*TAN(TH) .
C  SO WE HAVE
C    DTHZ=Z*(COS(THZ)/COS(TH))**2 * DTH  ,
C  OR
C    DTH=(1/Z)*(COS(TH)/COS(THZ))**2 * DTHZ .
C
C  INPUT QUANTITIES: Y,Z
C  OUTPUT QUANTITIES: U
C     **********

C     .. Scalars in Common ..
      REAL HPI,PI,TWOPI
C     ..
C     .. Local Scalars ..
      REAL DTH,DTHZ,DUM,FAC,PIK,REMTH,TH,THZ
      INTEGER K
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN,COS,LOG,SIN,TAN
C     ..
C     .. Common blocks ..
      COMMON /PIE/PI,TWOPI,HPI
C     ..
C     .. Scalar Arguments ..
      REAL Z
C     ..
C     .. Array Arguments ..
      REAL U(3),Y(3)
C     ..
      TH = Y(1)
      DTH = Y(2)
      K = TH/PI
      IF (TH.LT.0.0D0) K = K - 1
      PIK = K*PI
      REMTH = TH - PIK
      IF (4.0D0*REMTH.LE.PI) THEN
          THZ = ATAN(Z*TAN(REMTH)) + PIK
      ELSE IF (4.0D0*REMTH.GE.3.0D0*PI) THEN
          THZ = ATAN(Z*TAN(REMTH)) + PIK + PI
      ELSE
          THZ = ATAN(TAN(REMTH-HPI)/Z) + PIK + HPI
      END IF
C  THE TWO DIFFERENT APPEARING FORMULAS BELOW FOR FAC ARE
C    IN FACT EQUIVALENT.  WE USE WHICHEVER ONE AVOIDS
C    DIVIDING BY A SMALL NUMBER.
      DUM = ABS(COS(THZ))
      IF (DUM.GE.0.5D0) THEN
          FAC = Z* (DUM/COS(TH))**2
      ELSE
          FAC = (SIN(THZ)/SIN(TH))**2/Z
      END IF
      DTHZ = FAC*DTH
      U(1) = THZ
      U(2) = DTHZ
      U(3) = Y(3) - 0.5D0*LOG(Z*FAC)
      RETURN
      END
C
      SUBROUTINE PQEXT(F)

C  THIS SUBROUTINE IS CALLED ONLY BY SUBROUTINE WR.	
C    IT IS USED TO EXTRAPOLATE THE VALUES F(I),
C      I=2,5, TO F(1) . IT ASSUMES THE INDEPENDENT
C      VARIABLE VALUES ARE EQUALLY SPACED.
C
C  INPUT QUANTITIES: F(2),F(3),F(4),F(5)
C  OUTPUT QUANTITIES: F(1)

C     .. Array Arguments ..
      REAL F(6)
C     ..
C     .. Local Scalars ..
      REAL D2F1,D2F2,D2F3,D3F2
      INTEGER I
C     ..
C     .. Local Arrays ..
      REAL DF(6)
C     ..
      DO 10 I = 2,4
          DF(I) = F(I+1) - F(I)
   10 CONTINUE
      D2F3 = DF(4) - DF(3)
      D2F2 = DF(3) - DF(2)
      D3F2 = D2F3 - D2F2
      D2F1 = D2F2 + D3F2
      DF(1) = DF(2) + D2F1
      F(1) = F(2) + DF(1)
      RETURN
      END
C
      SUBROUTINE FIT(TH1,TH,TH2)
C     **********
C
C  THIS PROGRAM IS CALLED ONLY FROM SUBROUTINE UVPHI, WHICH
C    IS CALLED BY SUBROUTINE LCO.
C     IT CONVERTS TH INTO AN 'EQUIVALENT' ANGLE BETWEEN
C     TH1 AND TH2.  WE ASSUME TH1.LT.TH2 AND PI.LE.(TH2-TH1).
C
C  INPUT QUANTITIES: TH1,TH2
C  OUTPUT QUANTITIES: TH
C
C     **********
C     .. Scalars in Common ..
      REAL HPI,PI,TWOPI
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC AINT
C     ..
C     .. Common blocks ..
      COMMON /PIE/PI,TWOPI,HPI
C     ..
C     .. Scalar Arguments ..
      REAL TH,TH1,TH2
C     ..
      IF (TH.LT.TH1) TH = TH + AINT((TH1-TH+PI)/PI)*PI
      IF (TH.GT.TH2) TH = TH - AINT((TH-TH2+PI)/PI)*PI
      RETURN
      END
C
      SUBROUTINE F(U,Y,YP)
C     **********
C
C     THIS SUBROUTINE EVALUATES THE DERIVATIVE FUNCTIONS FOR USE WITH
C     INTEGRATOR GERK IN SOLVING THE SYSTEM OF DIFFERENTIAL
C     EQUATIONS FOR THETA, RHO (OR, RATHER, LOG(RHO)), AND
C     DTHDE = D(THETA)/D(LAMBDA), WHERE
C        Y = RHO*SIN(THETA)
C     AND
C       PY' = Z*RHO*COS(THETA) .
C     THE DIFFERENTIAL EQUATIONS ARE:
C       THETA' = (Z/P)*COS(THETA)**2 + (EIG*W - Q)*SIN(THETA)**2/Z
C       LOG(RHO)' = (Z/P - (EIG*W - Q)/Z)*SIN(THETA)*COS(THETA)
C       DTHDE' = -2*(Z/P - (EIG*W - Q)/Z)*DTHDE + W*SIN(THETA)**2/Z
C
C     EXCEPT WHEN CALLED FROM GERKZ, Z IS ALWAYS = 1.0 .
C
C  INPUT QUANTITIES: U,Y,EIG,IND,Z
C  OUTPUT QUANTITIES: YP
C     **********
C     .. Scalars in Common ..
      REAL EIG,Z
      INTEGER IND
C     ..
C     .. Local Scalars ..
      REAL C,C2,DT,QX,S,S2,T,TH,V,WW,WX,X,XP
C     ..
C     .. External Functions ..
      REAL P,Q,W
      EXTERNAL P,Q,W
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC COS,MOD,SIN
C     ..
C     .. Common blocks ..
      COMMON /DATAF/EIG,IND
      COMMON /Z1/Z
C     ..
C     .. Scalar Arguments ..
      REAL U
C     ..
C     .. Array Arguments ..
      REAL Y(2),YP(3)
C     ..

      IF (MOD(IND,2).EQ.1) THEN
          T = U
          TH = Y(1)
      ELSE
          T = Y(1)
          TH = U
      END IF
      CALL DXDT(T,DT,X)
      XP = Z/P(X)
      QX = Q(X)/Z
      WX = W(X)/Z
      V = EIG*WX - QX
      S = SIN(TH)
      C = COS(TH)
      S2 = S*S
      C2 = C*C
      YP(1) = DT* (XP*C2+V*S2)
      IF (IND.EQ.1) THEN
          WW = (XP-V)*S*C
          YP(2) = DT* (-2.0D0*WW*Y(2)+WX*S2)
          YP(3) = DT*WW
      ELSE IF (IND.EQ.2) THEN
C  IN THIS CASE THE INDEPENDENT AND DEPENDENT VARIABLES
C    (t and dtheta, etc.) HAVE BEEN INTERCHANGED.
          YP(2) = YP(2)/YP(1)
          YP(3) = YP(3)/YP(1)
          YP(1) = 1.0D0/YP(1)
      ELSE IF (IND.EQ.3) THEN
      ELSE
          YP(1) = 1.0D0/YP(1)
      END IF
      RETURN
      END
C
      SUBROUTINE UVPHI(U,PUP,V,PVP,THU,THV,PHI,TH)
C     **********
C
C  THIS PROGRAM IS CALLED BY SUBROUTINE LCO.
C     IT FINDS TH (= THETA) APPROPRIATE TO THU, THV, AND PHI, WHERE
C     THU IS THE PHASE ANGLE FOR U, AND THV IS THE PHASE ANGLE FOR V.
C
C  INPUT QUANTITIES: U,PUP,V,PVP,THU,THV
C  OUTPUT QUANTITIES: TH
C
C     **********
C     .. Scalars in Common ..
      REAL HPI,PI,TWOPI
C     ..
C     .. Local Scalars ..
      REAL C,D,PYP,S,Y
C     ..
C     .. External Subroutines ..
      EXTERNAL FIT
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ATAN2,COS,SIN
C     ..
C     .. Common blocks ..
      COMMON /PIE/PI,TWOPI,HPI
C     ..
C     .. Scalar Arguments ..
      REAL PHI,PUP,PVP,TH,THU,THV,U,V
C     ..
      TH = THU
      IF (PHI.EQ.0.0D0) RETURN
      IF (THV-THU.LT.PI) THEN
          TH = THV
          IF (PHI.EQ.-HPI) RETURN
          TH = THV - PI
          IF (PHI.EQ.HPI) RETURN
      ELSE
          TH = THV - PI
          IF (PHI.EQ.-HPI) RETURN
          TH = THV - TWOPI
          IF (PHI.EQ.HPI) RETURN
      END IF
      C = COS(PHI)
      S = SIN(PHI)
      Y = U*C + V*S
      PYP = PUP*C + PVP*S
      TH = ATAN2(Y,PYP)
      IF (Y.LT.0.0D0) TH = TH + TWOPI
      D = U*PVP - V*PUP
      IF (D*PHI.GT.0.0D0) THEN
          CALL FIT(THU-PI,TH,THU)
      ELSE
          CALL FIT(THU,TH,THU+PI)
      END IF
      RETURN
      END

      SUBROUTINE WR(FG,NC,TSTAR,YSTAR,THEND,DTHDE,TOUT,Y,TT,YY,IFLAG,
     +              ERR,WORK,IWORK)
C     **********
C
C     THIS PROGRAM IS CALLED BY WREG AND LCNO.
C     IT INTEGRATES Y' = F(T,Y) FROM T = +/-1.0 TO THEND
C     WHEN F CANNOT BE EVALUATED AT T.  (T*,Y*) IS CHOSEN AS A
C     NEARBY POINT, AND THE EQUATION IS INTEGRATED FROM THERE AND
C     CHECKED FOR CONSISTENCY WITH HAVING INTEGRATED FROM T.  IF NOT,
C     A DIFFERENT (T*,Y*) IS CHOSEN UNTIL CONSISTENCY IS ACHIEVED.
C
C  INPUT QUANTITIES: NC,TSTAR,YSTAR,THEND,DTHDE
C  OUTPUT QUANTITIES: IFLAG,TT,YY,IND,Y,TOUT,ERR,WORK,IWORK,TSTAR
C
C   The criterion to be used for "consistency" here is a so-called
C   "correction formula", obtained by integrating Newton's backward
C   difference formula - which can be written as
C       Dx0 = h(q4 - (7/2)Dq3 + (53/12)DDq2 - (55/24)DDDq1 +
C                     + (251/720)DDDDq0 ....)
C   (Here Dx0 = x1-x0, Dq1 = q2-q1, etc., and the qi terms are the
C    derivatives of the function x(*) at the points yi.)  When the
C   numerical integration for x has reached y4 and there is some
C   uncertainty about the earlier value of x1 at y1, this formula
C   can be used to effect a correction.
C
C  THE BASIC IDEA IS THIS:
C    SUPPOSE THE PROBLEM IS TO INTEGRATE
C            y'(x) = f(x, y(x)),  y(a) = A
C    FROM a TO c, BUT f(a,A) is +Infinity.
C    INTERCHANGE INDEPENDENT AND DEPENDENT VARIABLES SO THAT THE
C    PROBLEM BECOMES
C           x'(y) = 1/f(x,y), x(A) = a.
C    Let yi, i=1,2,3,4, be equally spaced points, distance h apart.
C    Let x1 be an initial "guess" for the value of the solution at y1,
C    and integrate the d.e. for the variable x from y1 to y4, obtaining
C    values xi for i=1,2,3,4.  Let qi be the values for the derivative
C    function for x at the points yi.  Then, according to the above
C    correction formula, a "corrected" value of the initial guess x1 is
C      x1 = x0 + h(q4 - (7/2)Dq3 + (53/12)DDq2 - (55/24)DDDq1 +
C                   (251/720)DDDDq0 + ... )
C    This process can be repeated until, hopefully, x1 no longer
C    changes.
C    IN THE EVENT THAT THE EQUATION y'(x) = f(x, y(x)) IS NOT
C    +Infinity, BUT SIMPLY CANNOT BE EVALUATED AT x=a, THE ONLY
C    DIFFERENCE IS THAT THERE IS NO NEED TO INTERCHANGE INDEPENDENT
C    AND DEPENDENT VARIABLES.
C
C     **********
C     .. Scalars in Common ..
      REAL EIG,EPSMIN
      INTEGER IND,T21
      LOGICAL PR
C     ..
C     .. Local Scalars ..
      REAL CHM,CHNG,D2F,D2G,D3F,D3G,D4F,D4G,EPST,HT,HU,
     +                 OLDSS2,OLDYY2,ONE,RR,SLO,SOUT,SUMM,SUP,T,TEN5,
     +                 TIN,U,UOUT,USTAR,YLO,YOUT,YUP
      INTEGER I,K,KFLAG,NN3
C     ..
C     .. Local Arrays ..
      REAL DF(4),DG(4),FF(6),GG(5),S(3),SS(6,3),UU(6)
C     ..
C     .. External Subroutines ..
      EXTERNAL GERK,PQEXT
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,SIGN
C     ..
C     .. Scalar Arguments ..
      REAL DTHDE,THEND,TOUT,TSTAR,YSTAR
      INTEGER IFLAG,NC
C     ..
C     .. Array Arguments ..
      REAL ERR(3),TT(7),WORK(27),Y(3),YY(7,3)
      INTEGER IWORK(5)
C     ..
C     .. Subroutine Arguments ..
      EXTERNAL FG
C     ..
C     .. Common blocks ..
      COMMON /DATAF/EIG,IND
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
C     ..
      IFLAG = 1
      ONE = 1.0D0
      TEN5 = 100000.0D0
      EPST = 1.D-7
C
C     INTEGRATE Y' = F(T,Y,YP), STARTING AT T = TSTAR.
C
      TIN = SIGN(ONE,TSTAR)
      TT(1) = TIN
      YY(1,1) = THEND
      YY(1,2) = DTHDE
      YY(1,3) = 0.0D0

C  THE NEXT THREE VALUES FOR YY(2,*) ARE JUST INITIAL GUESSES.
      YY(2,1) = YSTAR
      YY(2,2) = DTHDE
      YY(2,3) = 0.0D0
C
      YLO = -TEN5
      YUP = TEN5
      CHM = MAX(0.01D0*ONE,0.1D0*ABS(THEND))
C
C     NORMALLY IND = 1 OR 3;  IND IS SET TO 2 OR 4 WHEN Y IS TO BE USED
C     AS THE INDEPENDENT VARIABLE IN FG(T,Y,YP), INSTEAD OF THE USUAL T.
C     BEFORE LEAVING THIS SUBROUTINE, IND IS RESET TO 1.
C
   10 CONTINUE
      T = TSTAR
      HT = TSTAR - TIN
      TT(2) = TSTAR
      Y(1) = YY(2,1)
      Y(2) = YY(2,2)
      Y(3) = YY(2,3)
      KFLAG = 1
      IND = 1
      DO 30 K = 3,6
          TOUT = T + HT
          NN3 = 0
   20     CONTINUE
          CALL GERK(FG,3,Y,T,TOUT,EPST,EPST,KFLAG,ERR,WORK,IWORK)
          IF (KFLAG.GT.3 .AND. ABS(TSTAR).GE.0.89D0) THEN
              TSTAR = TIN + 5.0D0* (TSTAR-TIN)
              IF (PR) WRITE (T21,FMT=*) ' KFLAG,NEW TSTAR = ',KFLAG,
     +            TSTAR
              GO TO 10
          END IF
          IF (KFLAG.EQ.3) THEN
              NN3 = NN3 + 1
              IF (NN3.GE.6) THEN
                  IFLAG = 0
                  RETURN
              END IF
              GO TO 20
          END IF
          YOUT = Y(1)
          TT(K) = T
          YY(K,1) = YOUT
          YY(K,2) = Y(2)
          YY(K,3) = Y(3)
   30 CONTINUE
      IND = 3
      DO 40 I = 2,6
          CALL FG(TT(I),YY(I,1),FF(I))
   40 CONTINUE
C SET FF(1) = 0., JUST TO HAVE IT DEFINED BEFORE GOING INTO PQEXT() :
C SUBROUTINE PQEXT, IF USED, TRIES TO DETERMINE WHETHER THE VALUES
C   OF FF(I) EXTRAPOLATE TO A FINITE OR INFINITE VALUE AT FF(1).
      FF(1) = 0.0D0
      IF (NC.LE.4 .OR. NC.EQ.7) THEN
          CALL PQEXT(FF(1))
      ELSE
          CALL FG(TT(1),YY(1,1),FF(1))
      END IF

      WRITE (T21,FMT=*) ' in wr, ff1 = ',FF(1)
      IF (ABS(FF(1)).LE.50.0D0) THEN
C
C     NOW WE WANT TO APPLY THE ABOVE CONSISTENCY CRITERION,
C     TO SEE IF THESE RESULTS ARE CONSISTENT WITH HAVING
C     INTEGRATED FROM (TT(1),YY(1,1).
C
          WRITE (T21,FMT=*) ' in wr, finite '
          DO 50 I = 1,4
              DF(I) = FF(I+1) - FF(I)
   50     CONTINUE
          D2F = DF(4) - DF(3)
          D3F = DF(4) - 2.0D0*DF(3) + DF(2)
          D4F = DF(4) - 3.0D0*DF(3) + 3.0D0*DF(2) - DF(1)
          SUMM = HT* (FF(5)-3.5D0*DF(4)+53.0D0*D2F/12.0D0-
     +           55.0D0*D3F/24.0D0+251.0D0*D4F/720.0D0)
C
C     PRESUMABLY, YY(2,1) SHOULD BE YY(1,1) + SUMM.
C
          OLDYY2 = YY(2,1)
C     TO COUNTER THE TENDENCY TO OVERCORRECT, USE A FACTOR
C     OF RR < 1.0 :
          RR = 0.95D0
          YY(2,1) = YY(1,1) + RR*SUMM
C
C     ALSO IMPROVE THE VALUE OF Y(2) AT TSTAR.
C
          YY(2,2) = 0.5D0* (YY(1,2)+YY(3,2))
          YY(2,3) = 0.5D0* (YY(1,3)+YY(3,3))
          CHNG = YY(2,1) - OLDYY2
          IF (CHNG.GE.0.0D0 .AND. OLDYY2.GT.YLO) YLO = OLDYY2
          IF (CHNG.LE.0.0D0 .AND. OLDYY2.LT.YUP) YUP = OLDYY2
          IF ((YY(2,1).GE.YUP.AND.YLO.GT.-TEN5) .OR.
     +        (YY(2,1).LE.YLO.AND.YUP.LT.TEN5)) YY(2,1) = 0.5D0*
     +        (YLO+YUP)
          CHNG = YY(2,1) - OLDYY2
          IF (ABS(CHNG).GT.CHM) CHNG = SIGN(CHM,CHNG)
          YY(2,1) = OLDYY2 + CHNG
c            IF(PR)WRITE(T21,*) ' YY2, CHNG = ',YY(2,1),CHNG
          IF (ABS(YY(2,1)-OLDYY2).GT.EPST) GO TO 10
          TOUT = TT(6)
      ELSE
C
C     HERE, Y' IS ASSUMED INFINITE AT T = TIN.  IN THIS CASE,
C     IT CANNOT BE EXPECTED TO APPROXIMATE Y WITH A POLYNOMIAL,
C     SO THE INDEPENDENT AND DEPENDENT VARIABLES ARE INTERCHANGED.
C     THE POINTS ARE ASSUMED EQUALLY SPACED.
C
          WRITE (T21,FMT=*) ' in wr, infinite '
          HU = (YY(6,1)-YY(1,1))/5.0D0
          UU(1) = YY(1,1)
          SS(1,1) = TT(1)
          SS(1,2) = DTHDE
          SS(1,3) = 0.0D0
          UU(2) = UU(1) + HU
          SS(2,1) = TSTAR
          SS(2,2) = DTHDE
          SS(2,3) = 0.0D0
          USTAR = UU(2)
          SLO = -TEN5
          SUP = TEN5
   60     CONTINUE
          U = USTAR
          S(1) = SS(2,1)
          S(2) = SS(2,2)
          S(3) = SS(2,3)
          KFLAG = 1
          IND = 2
          DO 80 K = 3,6
              UOUT = U + HU
              NN3 = 0
   70         CONTINUE
              CALL GERK(FG,3,S,U,UOUT,EPST,EPST,KFLAG,ERR,WORK,IWORK)
              IF (KFLAG.GT.3 .AND. ABS(TSTAR).GE.0.89D0) THEN
                  TSTAR = TIN + 5.0D0* (TSTAR-TIN)
                  GO TO 10
              END IF
              IF (KFLAG.EQ.3) THEN
                  NN3 = NN3 + 1
                  IF (NN3.GE.6) THEN
                      IFLAG = 0
                      RETURN
                  END IF
                  GO TO 70
              END IF
              SOUT = S(1)
              UU(K) = U
              SS(K,1) = SOUT
              SS(K,2) = S(2)
              SS(K,3) = S(3)
   80     CONTINUE
          IND = 4
          DO 90 I = 2,5
              CALL FG(UU(I),SS(I,1),GG(I))
   90     CONTINUE
          GG(1) = 0.0D0
          DO 100 I = 1,4
              DG(I) = GG(I+1) - GG(I)
  100     CONTINUE
          D2G = DG(4) - DG(3)
          D3G = DG(4) - 2.0D0*DG(3) + DG(2)
          D4G = DG(4) - 3.0D0*DG(3) + 3.0D0*DG(2) - DG(1)
          SUMM = HU* (GG(5)-3.5D0*DG(4)+53.0D0*D2G/12.0D0-
     +           55.0D0*D3G/24.0D0+251.0D0*D4G/720.0D0)
C
C     PRESUMABLY, SS(2,1) SHOULD BE SS(1,1) + SUMM.
C
          OLDSS2 = SS(2,1)
          SS(2,1) = SS(1,1) + SUMM
          IF (SS(2,1).LE.-1.0D0) SS(2,1) = -1.0D0 + EPSMIN
          IF (SS(2,1).GE.1.0D0) SS(2,1) = 1.0D0 - EPSMIN
C
C     ALSO IMPROVE THE VALUE OF Y(2) AT TSTAR.
C
          SS(2,2) = 0.5D0* (SS(1,2)+SS(3,2))
          SS(2,3) = 0.5D0* (SS(1,3)+SS(3,3))
          CHNG = SS(2,1) - OLDSS2
C                IF(PR)WRITE(T21,*) ' CHNG = ',CHNG
          IF (CHNG.GE.0.0D0 .AND. OLDSS2.GT.SLO) SLO = OLDSS2
          IF (CHNG.LE.0.0D0 .AND. OLDSS2.LT.SUP) SUP = OLDSS2
          IF ((SS(2,1).GE.SUP.AND.SLO.GT.-TEN5) .OR.
     +        (SS(2,1).LE.SLO.AND.SUP.LT.TEN5)) SS(2,1) = 0.5D0*
     +        (SLO+SUP)
          IF (ABS(SS(2,1)-OLDSS2).GT.EPST) GO TO 60
      END IF

      IF (IND.EQ.4) THEN

C  NOW INTEGRATE AGAIN BUT WITH T AS THE INDEPENDENT VARIABLE:
C  THIS IS USEFUL FOR OBTAINING THE USUAL GLOBAL ERROR
C  ESTIMATES FOR THE QUANTITIES Y(1),Y(2),Y(3).
  120     CONTINUE
          TT(6) = SS(6,1)
          YY(6,1) = UU(6)
          YY(6,2) = SS(6,2)
          YY(6,3) = SS(6,3)
          T = TT(6)
          HT = T - TIN
          Y(1) = YY(6,1)
          Y(2) = YY(6,2)
          Y(3) = YY(6,3)
          KFLAG = 1
          IND = 1

          DO 130 K = 7,12
              TOUT = T + HT
              CALL GERK(FG,3,Y,T,TOUT,EPST,EPST,KFLAG,ERR,WORK,IWORK)
              IF (KFLAG.EQ.5) THEN
                  EPST = 5.0D0*EPST
                  WRITE (T21,FMT=*) ' in wr, epst = ',EPST
                  GO TO 120
              END IF
  130     CONTINUE

          TOUT = T
      END IF

C     TOUT = TT(6)
      IND = 1
      RETURN
      END
C
      SUBROUTINE SETTHU(X,THU)
C     **********
C
C  THIS SUBROUTINE IS CALLED ONLY FROM SUBROUTINE LCO.
C    IT ESTABLISHES A DEFINITE VALUE FOR THU,
C    THE PHASE ANGLE FOR THE FUNCTION U, INCLUDING AN
C    APPROPRIATE INTEGER MULTIPLE OF PI
C    IT NEEDS THE NUMBERS MMW(*) FOUND IN THUM
C
C  INPUT QUANTITIES: X,THU,YS,MMW,MMWD
C  OUTPUT QUANTITIES: THU
C
C     **********
C     .. Scalars in Common ..
      REAL HPI,PI,TWOPI
      INTEGER MMWD
C     ..
C     .. Arrays in Common ..
      REAL YS(200)
      INTEGER MMW(100)
C     ..
C     .. Local Scalars ..
      INTEGER I
C     ..
C     .. Common blocks ..
      COMMON /PASS/YS,MMW,MMWD
      COMMON /PIE/PI,TWOPI,HPI
C     ..
C     .. Scalar Arguments ..
      REAL THU,X
C     ..
      DO 10 I = 1,MMWD
          IF (X.GE.YS(MMW(I)) .AND. X.LE.YS(MMW(I)+1)) THEN
              IF (THU.GT.PI) THEN
                  THU = THU + (I-1)*TWOPI
                  RETURN
              ELSE
                  THU = THU + I*TWOPI
                  RETURN
              END IF
          END IF
   10 CONTINUE
      DO 20 I = 1,MMWD
          IF (X.GE.YS(MMW(I))) THU = THU + TWOPI
   20 CONTINUE
      RETURN
      END
C
      SUBROUTINE FZ(UU,Y,YP)
C     **********
C
C  THIS SUBROUTINE EVALUATES THE DERIVATIVE OF THE FUNCTION PHI,
C    PLUS THOSE OF ITS COMPANION FUNCTIONS SIGMA AND D(PHI)/D(LAMBDA),
C    FOR INTEGRATION BY GERK.  THESE INTEGRATIONS ARE CALLED FOR
C    BY THE SUBROUTINES LCNO AND LCO.
C
C  INPUT QUANTITIES: EIG,IND,UU,Y
C  OUTPUT QUANTITIES: YP
C
C  THE FUNCTIONS PHI AND SIGMA RESULT FROM REGULARIZING THE GIVEN
C    STURM-LIOUVILLE DIFFERENTIAL EQUATION NEAR A LIMIT CIRCLE
C    ENDPOINT.  NAMELY, WRITING
C      Y = Z1*U + Z2*V
C      PY' = Z1*PU' + Z2*PV',
C    WHERE U,V ARE THE BOUNDARY CONDITION FUNCTIONS NEAR THE LC
C    ENDPOINT, FOLLOWED BY
C      Z1 = SIGMA*COS(PHI)
C      Z2 = SIGMA*SIN(PHI),
C    GIVES THE FOLLOWING DIFFERENTIAL EQUATIONS FOR PHI, SIGMA,
C    AND D(PHI)/D(LAMBDA):
C    [u,v]*phi' = -a1122*sin(phi)*cos(phi) +
C                   a21*cos(phi)**2 -a12*sin(phi)**2
C    [u,v]*sigma'/sigma = (a12+a21)*sin(phi)*cos(phi) +
C                   a11*cos(phi)**2 + a22*sin(phi)**2
C    [u,v]*dphide' = -{a1122*(cos(phi)**2 - sin(phi)**2) +
C                   2*(a12+a21)*sin(phi)*cos(phi)}*dphide -
C                   {2*w*u*v*sin(phi)*cos(phi) +
C                    w*v**2*sin(phi)**2 + w*u**2*cos(phi)**2}
C    WHERE
C       a11 = eig*w*u*v - v*Hu,  a12 = eig*w*v**2 - v*Hv
C       a21 = -eig*w*u**2 + u*Hu,  a22 = -eig*w*u*v + uHv .
C       a1122 = u*(eig*w*v - Hv) + v*(eig*w*u - Hu)
C
C    HERE, Hu MEANS -(pu')' + qu,
C    AND [u,v] means u*pv' - v*pu' .
C
C     **********
C     .. Scalars in Common ..
      REAL EIG
      INTEGER IND
C     ..
C     .. Local Scalars ..
      REAL A1122,A12,A21,AU,AV,B1122,B12,B21,C,C2,D,DT,HU,
     +                 HV,PHI,PUP,PVP,S,S2,SC,T,U,V,WW,WX,X
C     ..
C     .. External Functions ..
      REAL W
      EXTERNAL W
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,UV
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC COS,MOD,SIN
C     ..
C     .. Common blocks ..
      COMMON /DATAF/EIG,IND
C     ..
C     .. Scalar Arguments ..
      REAL UU
C     ..
C     .. Array Arguments ..
      REAL Y(2),YP(3)
C     ..
      IF (MOD(IND,2).EQ.1) THEN
          T = UU
          PHI = Y(1)
      ELSE
          T = Y(1)
          PHI = UU
      END IF
      CALL DXDT(T,DT,X)
      CALL UV(X,U,PUP,V,PVP,HU,HV)
      D = U*PVP - V*PUP
      WX = W(X)
      S = SIN(PHI)
      C = COS(PHI)
      S2 = S*S
      C2 = C*C
      SC = S*C
      B1122 = WX*U*V
      B12 = WX*V*V
      B21 = -WX*U*U
      AU = EIG*WX*U - HU
      AV = EIG*WX*V - HV
      A1122 = U*AV + V*AU
      A12 = V*AV
      A21 = -U*AU
      YP(1) = -DT* (A1122*SC+A12*S2-A21*C2)/D
      IF (IND.EQ.1) THEN
          WW = 2.0D0* (A12+A21)*SC + A1122* (C2-S2)
          YP(2) = -DT* (WW*Y(2)+2.0D0*B1122*SC+B12*S2-B21*C2)/D
          YP(3) = 0.5D0*DT*WW/D
      ELSE IF (IND.EQ.2) THEN
C  IN THIS CASE THE INDEPENDENT AND DEPENDENT VARIABLES
C    (t and phi, etc.) HAVE BEEN INTERCHANGED.
          YP(2) = YP(2)/YP(1)
          YP(3) = YP(3)/YP(1)
          YP(1) = 1.0D0/YP(1)
      ELSE IF (IND.EQ.3) THEN
      ELSE
          YP(1) = 1.0D0/YP(1)
      END IF
      RETURN
      END
C
      SUBROUTINE GERKZ(F,NEQ,Y,TIN,TOUT,REPS,AEPS,LFLAG,ERY,WORK,IWORK)
C     **********

C  THIS PROGRAM CONTROLS THE INTEGRATION OF THE DIFFERENTIAL EQUATIONS
C    FOR THETA, RHO (OR F = LOG(RHO)), AND DTHDE = D(THETA)/D(LAMBDA)
C    WHERE Y = RHO*SIN(THETA) AND PY' = Z*RHO*COS(THETA), WITH
C    SUITABLY CHOSEN CONSTANT Z.
C    IT IS CALLED FROM INTEGZ.
C
C  INPUT QUANTITIES: TIN,TOUT,Y,REPS,AEPS,ERY,EPSMIN,TEE,ZEE,
C                    WORK,IWORK
C  OUTPUT QUANTITIES: Y,LFLAG,ERY
C
C  ACTUALLY, DIFFERENT CONSTANTS Z ARE USED IN DIFFERENT SUBINTERVALS
C    OF THE INTEGRATION.  THE Z's HAVE BEEN CHOSEN ELSEWHERE AND HAVE
C    BEEN STORED IN THE ARRAY ZEE.  THE CONSTANT ZEE(J) IS USED IN
C    THE T-SUBINTERVAL (TEE(J),TEE(J+1)).
C  N.B. THE EXACT T-SUBINTERVALS USED ARE NOT AT ALL CRITICAL.
C  THE PRUEFER ANGLE, CALLED THETA WHEN Z = 1 (THE USUAL PRUEFER
C    ANGLE), IS HERE CALLED THZ WHEN Z MAY NOT BE 1.
C    THE SUBROUTINES TH2THZ AND THZ2TH ARE USED TO CONVERT FROM THE
C    ONE ANGLE TO THE OTHER.
C  THE VALUE OF Z IN COMMON/Z1/Z IS ALWAYS EQUAL TO 1 EXCEPT
C    DURING THE INTEGRATIONS IN THIS SUBROUTINE.  SO WE ALWAYS
C    SET Z = 1.0 BEFORE LEAVING HERE.
C  IT IS ALWAYS ASSUMED THAT WHEN THIS PROGRAM IS CALLED, THE
C    ARRAY ERY HAS MEANINGFUL VALUES IN IT.

C     **********
C     .. Scalars in Common ..
      REAL EPSMIN,Z
      INTEGER T21
      LOGICAL PR
C     ..
C     .. Local Scalars ..
      REAL T,TOUTS,Y3,Y3S
      INTEGER I,J,K,L,LLFLAG,NK
C     ..
C     .. Arrays in Common ..
      REAL TEE(100),ZEE(100)
      INTEGER JAY(100)
C     ..
C     .. Local Arrays ..
      REAL ERT(3),ERU(3),U(3)
C     ..
C     .. External Subroutines ..
      EXTERNAL ERRZ,GERK,TH2THZ,THZ2TH
C     ..
C     .. Common blocks ..
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
      COMMON /TEEZ/TEE
      COMMON /Z1/Z
      COMMON /ZEEZ/JAY,ZEE
C     ..
C     .. Scalar Arguments ..
      REAL AEPS,REPS,TIN,TOUT
      INTEGER LFLAG,NEQ
C     ..
C     .. Array Arguments ..
      REAL ERY(3),WORK(27),Y(3)
      INTEGER IWORK(5)
C     ..
C     .. Subroutine Arguments ..
      EXTERNAL F
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC MAX,MIN
C     ..
C  SET ARRAY ERT TO THE INCOMING ARRAY ERY:
      ERT(1) = ERY(1)
      ERT(2) = ERY(2)
      ERT(3) = ERY(3)

      T = TIN
      J = 1
      L = 1
      IF (TIN.LT.TOUT) THEN
          DO 10 I = 1,19
              IF (TEE(I)-EPSMIN.LE.TIN .AND.
     +            TIN.LT.TEE(I+1)+EPSMIN) J = I
              IF (TEE(I)-EPSMIN.LT.TOUT .AND.
     +            TOUT.LE.TEE(I+1)+EPSMIN) L = I
   10     CONTINUE
          DO 30 K = J,L
              TOUTS = MIN(TOUT,TEE(K+1))
              Z = ZEE(K+1)
              IF (Z.EQ.0.0D0) Z = 1.0D0
              CALL TH2THZ(Y,Z,U)
              LLFLAG = 1
              NK = 0
   20         CONTINUE
              CALL GERK(F,NEQ,U,T,TOUTS,REPS,AEPS,LLFLAG,ERU,WORK,IWORK)
              IF (LLFLAG.GT.3) THEN
                  IF (PR) WRITE (T21,FMT=*) ' LLFLAG = ',LLFLAG
                  LFLAG = 5
                  RETURN
              END IF
              IF (LLFLAG.EQ.3 .OR. LLFLAG.EQ.-2) THEN
                  NK = NK + 1
                  IF (NK.GE.10) THEN
                      LFLAG = 5
                      RETURN
                  END IF
                  GO TO 20
              END IF
              Y3S = Y(3)
              CALL THZ2TH(U,ERU,Z,Y,ERY)
              Y3 = Y(3)
              CALL ERRZ(ERT,Y3S,Y3,ERY)
   30     CONTINUE
      ELSE
          DO 40 I = 20,2,-1
              IF (TEE(I-1)-EPSMIN.LT.TIN .AND.
     +            TIN.LE.TEE(I)+EPSMIN) J = I
              IF (TEE(I-1)-EPSMIN.LE.TOUT .AND.
     +            TOUT.LT.TEE(I)+EPSMIN) L = I
   40     CONTINUE
          DO 60 K = J,L,-1
              TOUTS = MAX(TOUT,TEE(K-1))
              Z = ZEE(K)
              IF (Z.EQ.0.0D0) Z = 1.0D0
              CALL TH2THZ(Y,Z,U)
              LLFLAG = 1
              NK = 0
   50         CONTINUE
              CALL GERK(F,NEQ,U,T,TOUTS,REPS,AEPS,LLFLAG,ERU,WORK,IWORK)
              IF (LLFLAG.GT.3) THEN
                  IF (PR) WRITE (T21,FMT=*) ' LLFLAG = ',LLFLAG
                  LFLAG = 5
                  RETURN
              END IF
              IF (LLFLAG.EQ.3 .OR. LLFLAG.EQ.-2) THEN
                  NK = NK + 1
                  IF (NK.GE.10) THEN
                      LFLAG = 5
                      RETURN
                  END IF
                  GO TO 50
              END IF
              Y3S = Y(3)
              CALL THZ2TH(U,ERU,Z,Y,ERY)
              Y3 = Y(3)
              CALL ERRZ(ERT,Y3S,Y3,ERY)
   60     CONTINUE
      END IF
      TIN = T

C  BEFORE LEAVING THIS ROUTINE WE WANT TO RESET THE PARAMETER Z
C    (STORED IN COMMON/Z1/Z) TO BE 1.0 AGAIN.

      Z = 1.0D0
      LFLAG = LLFLAG
      RETURN
      END
C
      SUBROUTINE ERRZ(ERT,Y3S,Y3,ERY)
C  THIS PROGRAM COMPUTES AN ESTIMATE OF THE GLOBAL ERROR,
C  ERY, IN Y IN INTEGRATING FROM X1 TO X2, WHEN THERE
C  IS AN ERROR, ERT, IN THE INITIAL VALUE OF Y AT X1.
C  IT IS CALLED FROM INTEGZ.
C
C  INPUT QUANTITIES: ERT,Y3S,Y3,ERY
C  OUTPUT QUANTITIES: ERY
C
C  USING THE FACT THAT F (= LOG(RHO)) SATISFIES
C      F' = f
C  WHILE IF G REPRESENTS D(THETA)/D(INITIAL VALUE), THEN
C      G' = -2*f*G,
C  SO
C      AN ERROR OF ERT AT X1 BECOMES AN ERROR OF
C            ERT*EXP(-2*(F(X2)-F(X1)))
C  WHICH MUST BE ADDED TO THE GLOBAL ERROR, ERY.
C  WHEN THIS SUBROUTINE IS CALLED, Y3 IS THE CURRENT
C  VALUE OF Y(3) (OR F), AND Y3S IS THE VALUE IT
C  HAD AT THE BEGINNING OF THE LAST INTEGRATION, AT X1.
C  ON EXIT, ERY IS THE CURRENT ESTIMATE OF THE GLOBAL
C  ERROR.
C
C     .. Scalar Arguments ..
      REAL Y3,Y3S
C     ..
C     .. Array Arguments ..
      REAL ERT(3),ERY(3)
C     ..
C     .. Local Scalars ..
      INTEGER I
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC EXP
C     ..
      DO 10 I = 1,3
          ERY(I) = ERT(I)*EXP(-2.0D0* (Y3-Y3S)) + ERY(I)
   10 CONTINUE
      RETURN
      END
C
      SUBROUTINE LCNO(TEND,THEND,DTHDAA,TM,COF1,COF2,EPS,Y,ER,IFLAG)
C  THIS PROGRAM IS CALLED FROM INTEG.
C
C  INPUT QUANTITIES: TEND,THEND,TM,COF1,COF2,EPS
C  OUTPUT QUANTITIES: Y,THEND,DTHDAA,TT,YY,ER,IFLAG
C
C  IT CONTROLS THE INTEGRATIONS WHICH BEGIN AT AN
C    LCNO ENDPOINT.  NEAR SUCH AN ENDPOINT, THE EQUATION
C         -(py')' + q*y = lambda*w*y
C    IS TRANSFORMED BY SETTING
C        y = sigma*(u*cos(phi) + v*sin(phi))
C       py' = sigma*(pu'*cos(phi) + pv'*sin(phi))
C    WHERE u,v ARE THE BOUNDARY CONDITION FUNCTIONS.  THE RESULTING
C    DIFFERENTIAL EQUATIONS FOR sigma, phi, d(phi)/d(lambda) ARE
C    FIRST INTEGRATED FROM THE ENDPOINT TO A POINT FAR ENOUGH AWAY,
C    AND ARE THEN TRANSLATED TO THE USUAL PRUEFER VARIABLES
C    THETA, RHO, ETC., WHICH ARE THEN INTEGRATED TO TM.


C     .. Scalar Arguments ..
      REAL COF1,COF2,DTHDAA,EPS,TEND,THEND,TM
      INTEGER IFLAG
C     ..
C     .. Array Arguments ..
      REAL ER(3),Y(3)
C     ..
C     .. Scalars in Common ..
      REAL HPI,PI,TWOPI
      INTEGER T21
      LOGICAL PR
C     ..
C     .. Arrays in Common ..
      REAL TT(7,2),YY(7,3,2)
      INTEGER NT(2)
C     ..
C     .. Local Scalars ..
      REAL C,D,DDD,DPHIDE,DTHIN,DUM,EFF,FAC2,FRA,HU,HV,ONE,
     +                 PHI,PHI0,PHIDAA,PUP,PVP,PYPZ,PYPZ0,RHOSQ,S,T,TH,
     +                 TH0,THBAR,THIN,TIN,TMP,TOUT,TSTAR,U,V,XT,YZ,YZ0
      INTEGER I,J,K2PI,KFLAG,M,NC
      CHARACTER*16 PREC
C     ..
C     .. Local Arrays ..
      REAL WORK(27),YP(3)
      INTEGER IWORK(5)
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,FZ,GERK,INTEGZ,UV,WR
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN2,COS,EXP,LOG,MIN,SIN
C     ..
C     .. Common blocks ..
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /TEMP/TT,YY,NT
C     ..
      ONE = 1.0D0
      PREC = '  REAL'
      NC = 3

      T = TEND

C  THE LCNO BOUNDARY CONDITION A1*[u,y] + A2*[v,y] = 0
C  IS EQUIVALENT TO COF1*sin(phi) - COF2*cos(phi) = 0.  SO
      PHI0 = ATAN2(COF2,COF1)
C
C     WE WANT -PI/2 .LT. PHI0 .LE. PI/2.
C
      Y(1) = PHI0
      Y(2) = 0.0D0
      Y(3) = 0.0D0
      CALL DXDT(T,TMP,XT)
      CALL FZ(T,Y,YP)
      PHIDAA = -YP(1)
      CALL UV(XT,U,PUP,V,PVP,HU,HV)
      D = U*PVP - V*PUP
      YZ0 = U*COF1 + V*COF2
      PYPZ0 = (PUP*COF1+PVP*COF2)

C   USING THE RELATION BETWEEN theta AND phi, NAMELY
C  tan(theta) = (u*cos(phi) + v*sin(phi))/(pup*cos(phi)+pv'*sin(phi))
C  AND, DIFFERENTIATING W.R.T. lambda or a or b,
C  d(theta)*sec(theta)**2 = -[u,v]*d(phi)/(pu'*cos(phi)+pv'*sin(phi))**2
C
C     SET TH0 AND COPY INTO THEND, OVERWRITING ITS INPUT VALUE.
C     ALSO, REDEFINE DTHDAA, OVERWRITING ITS INPUT VALUE.
C
      TH0 = ATAN2(YZ0,PYPZ0)
      IF (YZ0.LT.0.0D0) TH0 = TH0 + TWOPI
      THEND = TH0
      IF (PR) WRITE (T21,FMT=*) ' PHI0,TH0 = ',PHI0,TH0
      DUM = ABS(COS(TH0))

      IF (DUM.GE.0.5D0) THEN
          FAC2 = (-D)* (DUM/PYPZ0)**2
      ELSE
          FAC2 = (-D)* (SIN(TH0)/YZ0)**2
      END IF

C  PHIDAA REPRESENTS d(phi)/da  EVALUATED AT THE ENDPOINT (A or B).
      DTHDAA = FAC2*PHIDAA
C
C     IN THE NEXT PIECE, WE ASSUME TH0 .GE. 0.
C
      M = 0
      IF (TH0.EQ.0.0D0) M = -1
      IF (TH0.GT.PI .OR. (TH0.EQ.PI.AND.T.LT.TM)) M = 1
      PHI = PHI0
      K2PI = 0
      YZ0 = U*COS(PHI0) + V*SIN(PHI0)

C  BEGIN THE INTEGRATION FOR PHI,SIGMA, ETC. AT THE LCNO ENDPOINT
C    USING SUBROUTINE WR.
C  THE FIRST 6 VALUES OF PHI,ETC. AT T = TT(K,J) ARE YY(1,K,J),
C    K = 1,..,6.

      IF (TM.GT.TEND) THEN
          J = 1
          TSTAR = -0.99999D0
          IF (PREC(3:3).NE.'R') TSTAR = -0.9999999999D0
      ELSE
          J = 2
          TSTAR = 0.99999D0
          IF (PREC(3:3).NE.'R') TSTAR = 0.9999999999D0
      END IF
      DPHIDE = 0.0D0

        DO 23 I = 1,27
           WORK(I) = 0.0D0
           IF(I.LE.5) IWORK(I) = 0
  23    CONTINUE

      CALL WR(FZ,NC,TSTAR,PHI0,PHI0,DPHIDE,TOUT,Y,TT(1,J),YY(1,1,J),
     +        KFLAG,ER,WORK,IWORK)
      IF (KFLAG.NE.1) THEN
          IF (PR) WRITE (T21,FMT=*) ' KFLAG = 0 '
          IFLAG = 5
          RETURN
      END IF

C  THE INTEGRATION FOR PHI, ETC. HAS BEEN STARTED, BUT NEEDS TO
C    CONTINUE A LITTLE FARTHER TO GET WELL AWAY FROM THE ENDPOINT.
C    FOR THIS, WE CAN JUST CONTINUE USING KFLAG = 2.
      TIN = TOUT
      TMP = 0.01D0
      DDD = MIN(TMP,ABS(TOUT))
      TOUT = TOUT + DDD* (-TOUT)/ABS(TOUT)
      T = TIN
      KFLAG = 2
   60 CONTINUE
      CALL GERK(FZ,3,Y,T,TOUT,EPS,EPS,KFLAG,ER,WORK,IWORK)
      IF (KFLAG.GT.3) THEN
          IF (PR) WRITE (T21,FMT=*) ' KFLAG2 = ',KFLAG
          IFLAG = 5
          RETURN
      END IF
      IF (KFLAG.EQ.3) THEN
          FRA = ABS(T-TIN)/ABS(T-TOUT)
          IF (FRA.LT.0.001D0) THEN
              IF (PR) WRITE (T21,FMT=*) ' KFLAG2 = ',KFLAG
              IFLAG = 5
              RETURN
          END IF
          GO TO 60
      END IF
      IF (T.EQ.TOUT) THEN
C  STORE THE 7th VALUES FOR T, PHI,ETC.
          TT(7,J) = T
          YY(7,1,J) = Y(1)
          YY(7,2,J) = Y(2)
          YY(7,3,J) = Y(3)
      END IF
      T = TOUT
      CALL DXDT(T,TMP,XT)
      CALL UV(XT,U,PUP,V,PVP,HU,HV)
      PHI = Y(1)
      S = SIN(PHI)
      C = COS(PHI)
      YZ = U*C + V*S
      IF (YZ*YZ0.LT.0.0D0) K2PI = K2PI + 1
      YZ0 = YZ
C
C     CONVERT FROM PHI TO THETA.
C
      DPHIDE = Y(2)
      D = U*PVP - V*PUP
      PYPZ = (PUP*C+PVP*S)
      THBAR = ATAN2(YZ,PYPZ)
      IF (TM.GT.TEND .AND. THBAR.LT.TH0 .AND.
     +    PHI.LT.PHI0) THBAR = THBAR + TWOPI
      IF (TM.LT.TEND .AND. THBAR.GT.TH0 .AND.
     +    PHI.GT.PHI0) THBAR = THBAR - TWOPI
      TH = THBAR - M*PI
      IF (TH.LT.-PI) TH = TH + TWOPI
      IF (TH.GT.TWOPI) TH = TH - TWOPI
      IF (TM.LT.TEND .AND. K2PI.GT.1) TH = TH - (K2PI-1)*TWOPI
      IF (TM.GT.TEND .AND. K2PI.GT.1) TH = TH + (K2PI-1)*TWOPI
      IF (TM.GT.TEND .AND. TH*TH0.LT.0.0D0) TH = TH + TWOPI
      IF (PR) WRITE (T21,FMT=*) ' PHI,TH = ',PHI,TH
C
C     WE NOW HAVE YZ, PYPZ, PHI AND TH, SO WE CAN GET DTHDE
C       FROM DPHIDE.
C
      DUM = ABS(COS(TH))
      IF (DUM.GE.0.5D0) THEN
          FAC2 = - (D)* (DUM/PYPZ)**2
      ELSE
          FAC2 = - (D)* (SIN(TH)/YZ)**2
      END IF
      DTHIN = FAC2*DPHIDE
C  ALSO CONVERT THE ESTIMATED INTEGRATION ERRORS FOR PHI,ETC.,
C    INTO CORRESPONDING ERRORS FOR THETA,ETC.
      ER(1) = FAC2*ER(1)
      ER(2) = FAC2*ER(2)
      ER(3) = FAC2*ER(2)
C
      RHOSQ = EXP(2.0D0*Y(3))* (YZ**2+PYPZ**2)
      EFF = 0.5D0*LOG(RHOSQ)
C           END (INTEGRATE-FOR-PHI-NONOSC)

C  NOW COMPLETE THE INTEGRATION FOR THETA, RHO, ETC. TO TM.
      TIN = TOUT
      TOUT = TM
      THIN = TH
C        DO (INTEGRATE-FOR-THETA)
      CALL INTEGZ(TIN,TOUT,THIN,DTHIN,EPS,Y,IFLAG,ER,WORK,IWORK)
C
C           END (INTEGRATE-FOR-THETA)
      Y(3) = Y(3) + EFF
      RETURN
      END
C
      SUBROUTINE REG(TEND,THEND,TM,DTHDE,EPS,Y,ER,IFLAG)
C
C     THIS PROGRAM IS CALLED FROM INTEG.
C     THIS IS THE REGULAR (NOT WEAKLY REGULAR) CASE,
C     SO THERE IS NO ENDPOINT PROBLEM AT ALL, AND INTEGZ
C     CAN BE CALLED DIRECTLY.
C
C  INPUT QUANTITIES: TEND,THEND,TM,DTHDE,EPS,Y
C  OUTPUT QUANTITIES: Y,ER,IFLAG
C
C     .. Scalar Arguments ..
      REAL DTHDE,EPS,TEND,THEND,TM
      INTEGER IFLAG
C     ..
C     .. Array Arguments ..
      REAL ER(3),Y(3)
C     ..
C     .. Local Scalars ..
      REAL DTHIN,THIN,TIN,TOUT
C     ..
C     .. Local Arrays ..
      REAL WORK(27)
      INTEGER IWORK(5)
C     ..
C     .. External Subroutines ..
      EXTERNAL INTEGZ
C     ..
      TIN = TEND
      TOUT = TM
      THIN = THEND
      DTHIN = DTHDE
C        DO (INTEGRATE-FOR-THETA)
C        INITIALIZE ER BEFORE CALLING INTEGZ:
      ER(1) = 0.0D0
      ER(2) = 0.0D0
      ER(3) = 0.0D0
      CALL INTEGZ(TIN,TOUT,THIN,DTHIN,EPS,Y,IFLAG,ER,WORK,IWORK)
C           END (INTEGRATE-FOR-THETA)
      RETURN
      END
C
      SUBROUTINE WREG(TEND,THEND,DTHDE,TM,EPS,ER,Y,IFLAG)
C    THIS PROGRAM IS CALLED FROM INTEG.
C
C  INPUT QUANTITIES: TEND,THEND,DTHDE,TM,EPS,ER
C  OUTPUT QUANTITIES: Y,ER,IFLAG,TT,YY,NT
C
C    THIS IS THE 'WEAKLY REGULAR' CASE, SO SUBROUTINE WR MUST
C    BE USED FOR THE INTEGRATIONS STARTING AT THE WR ENDPOINT
C    UNTIL THE INTEGRATIONS HAVE REACHED A POINT FAR ENOUGH
C    AWAY THAT THE WEAKLY REGULAR ENDPOINT NO LONGER PRESENTS
C    A DIFFICULTY, AND THE SUBROUTINE INTEGZ CAN BE USED FROM
C    THERE ON.
C     .. Scalar Arguments ..
      REAL DTHDE,EPS,TEND,THEND,TM
      INTEGER IFLAG
C     ..
C     .. Array Arguments ..
      REAL ER(3),Y(3)
C     ..
C     .. Scalars in Common ..
      REAL EIG,HPI,PI,TWOPI
      INTEGER IND,T21
      LOGICAL PR
C     ..
C     .. Arrays in Common ..
      REAL TT(7,2),YY(7,3,2)
      INTEGER NT(2)
C     ..
C     .. Local Scalars ..
      REAL DDD,DTHIN,EFF,ONE,P1,Q1,T,THIN,TIN,TMP,TOUT,
     +                 TSTAR,W1,XSTAR,YSTAR
      INTEGER I,J,KFLAG,NC
      CHARACTER*16 PREC
C     ..
C     .. Local Arrays ..
      REAL WORK(27),YU(3)
      INTEGER IWORK(5)
C     ..
C     .. External Functions ..
      REAL P,Q,W
      EXTERNAL P,Q,W
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,F,GERK,INTEGZ,WR
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,COS,MIN,SIN
C     ..
C     .. Common blocks ..
      COMMON /DATAF/EIG,IND
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /TEMP/TT,YY,NT
C     ..
      PREC = '  REAL'
      ONE = 1.0D0
C
      NC = 2
      IF (TM.GT.TEND) THEN
          J = 1
          TSTAR = -0.99999D0
          IF (PREC(3:3).NE.'R') TSTAR = -0.9999999999D0
      ELSE
          J = 2
          TSTAR = 0.99999D0
          IF (PREC(3:3).NE.'R') TSTAR = 0.9999999999D0
      END IF
C  FORM AN ESTIMATE FOR YSTAR TO BE USED IN THE CALL TO WR.
      CALL DXDT(TSTAR,TMP,XSTAR)
      P1 = 1.0D0/P(XSTAR)
      Q1 = Q(XSTAR)
      W1 = W(XSTAR)
      YSTAR = THEND + 0.5D0* (TSTAR-TEND)*
     +        (P1*COS(THEND)**2+ (EIG*W1-Q1)*SIN(THEND)**2)

        DO 23 I = 1,27
           WORK(I) = 0.0D0
           IF(I.LE.5) IWORK(I) = 0
  23    CONTINUE

      CALL WR(F,NC,TSTAR,YSTAR,THEND,DTHDE,TOUT,YU,TT(1,J),YY(1,1,J),
     +        KFLAG,ER,WORK,IWORK)
C  USE THE SAME ARRAY, ER, AS IN THE NEXT CALL TO GERK, SO THAT THE
C  ERROR MEASUREMENT IS CONTINUED.
      IF (KFLAG.NE.1) THEN
          IF (PR) WRITE (T21,FMT=*) ' KFLAG = 0 '
          IFLAG = 5
          RETURN
      END IF
C  CONTINUE THE INTEGRATIONS TO A POINT FARTHER AWAY FROM THE
C  WR ENDPOINT.
      T = TOUT
      TMP = 0.01D0
      DDD = MIN(TMP,ABS(TOUT))
      TOUT = TOUT + DDD* (-TOUT)/ABS(TOUT)
C  IN ORDER TO JUST CONTINUE THE INTEGRATION THAT WAS BEING
C  DONE IN SUBROUTINE WR(), SET KFLAG = 2.
      KFLAG = 2
      CALL GERK(F,3,YU,T,TOUT,EPS,EPS,KFLAG,ER,WORK,IWORK)
      IF (KFLAG.EQ.5) THEN
          IFLAG = 5
          GO TO 50
      END IF
C  THE FIRST 6 VALUES OF PHI,ETC. AT T = TT(K,J) ARE YY(1,K,J),
C    K = 1,..,6.
C  STORE THE 7th VALUE FOR T, THETA, ETC.
      TT(7,J) = T
      YY(7,1,J) = YU(1)
      YY(7,2,J) = YU(2)
      YY(7,3,J) = YU(3)
C  NOW CONTINUE THE INTEGRATIONS FOR THETA, ETC., TO TM.
      TIN = TOUT
      TOUT = TM
      THIN = YU(1)
      DTHIN = YU(2)
      EFF = YU(3)
      CALL INTEGZ(TIN,TOUT,THIN,DTHIN,EPS,Y,IFLAG,ER,WORK,IWORK)
      Y(3) = EFF + Y(3)
   50 CONTINUE
      RETURN
      END
C
      SUBROUTINE LCO(TEND,THEND,DTHDAA,DTHDE,TM,COF1,COF2,EPS,Y,ER,OK,
     +               IFLAG)

C  THIS PROGRAM CONTROLS THE INTEGRATIONS WHICH BEGIN NEAR AN
C    LCO ENDPOINT.  IT IS CALLED FROM INTEG.
C
C  INPUT QUANTITIES: OK,TEND,THEND,COF1,COF2,DTHDAA,TM,EPS,
C                    TSAVEL,TSAVER,EIG,ISAVE,Y
C  OUTPUT QUANTITIES: THEND,DTHDAA,TT,YY,NT,TSAVEL,TSAVER,
C                     Y,ER,IFLAG
C
C    NEAR SUCH AN ENDPOINT, THE EQUATION
C         -(py')' + q*y = lambda*w*y
C    IS TRANSFORMED BY SETTING
C        y = sigma*(u*cos(phi) + v*sin(phi))
C       py' = sigma*(pu'*cos(phi) + pv'*sin(phi))
C    WHERE u,v ARE THE BOUNDARY CONDITION FUNCTIONS.  THE RESULTING
C    DIFFERENTIAL EQUATIONS FOR sigma, phi, d(phi)/d(lambda) ARE
C    FIRST INTEGRATED FROM NEAR THE ENDPOINT TO A POINT FAR ENOUGH AWAY,
C    AND ARE THEN TRANSLATED TO THE USUAL PRUEFER VARIABLES
C    THETA, RHO, ETC., WHICH ARE THEN INTEGRATED TO TM.
C  BECAUSE THE INTEGRATIONS MUST BE CARRIED OUT NOT ONLY WHEN LAMBDA
C    IS SET EQUAL TO EIG, BUT ALSO WHEN LAMBDA IS SET EQUAL TO 0.0,
C    IT IS NECESSARY TO MAKE SURE THE INTEGRATIONS IN BOTH CASES
C    ARE CARRIED OUT OVER EXACTLY THE SAME SUBINTERVALS.
C    THE T-VALUES WHERE THE CHANGE FROM PHI TO THETA TAKES PLACE
C    ARE DENOTED AND SAVED AS THE VARIABLES TSAVEL AND TSAVER.


C     .. Scalar Arguments ..
      REAL COF1,COF2,DTHDAA,DTHDE,EPS,TEND,THEND,TM
      INTEGER IFLAG
      LOGICAL OK
C     ..
C     .. Array Arguments ..
      REAL ER(3),Y(3)
C     ..
C     .. Scalars in Common ..
      REAL EIG,HPI,PI,TSAVEL,TSAVER,TWOPI
      INTEGER IND,ISAVE,T21
      LOGICAL PR
C     ..
C     .. Arrays in Common ..
      REAL TT(7,2),YY(7,3,2)
      INTEGER NT(2)
C     ..
C     .. Local Scalars ..
      REAL C,D,DPHIDE,DTHIN,DUM,EFF,FAC2,HU,HV,PHI,PHI0,
     +                 PHIDAA,PUP,PVP,PYPZ,PYPZ0,RHOSQ,S,T,TH,TH0,THIN,
     +                 THU,THU0,THV,THV0,TIN,TINTHZ,TMP,TOUT,U,V,XT,XT0,
     +                 YZ,YZ0
      INTEGER I,J,KFLAG,LFLAG,NK,NNN
      LOGICAL LOGIC
C     ..
C     .. Local Arrays ..
      REAL WORK(27),YP(3)
      INTEGER IWORK(5)
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,FZ,GERK,INTEGZ,SETTHU,UV,UVPHI
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN2,COS,EXP,LOG,SIGN,SIN
C     ..
C     .. Common blocks ..
      COMMON /DATAF/EIG,IND
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /TEMP/TT,YY,NT
      COMMON /TSAVE/TSAVEL,TSAVER,ISAVE
C     ..
      IF (.NOT.OK) THEN
          LOGIC = .FALSE.
      ELSE IF (TEND.LE.TM) THEN
          LOGIC = TEND .GE. TSAVEL
      ELSE
          LOGIC = TEND .LE. TSAVER
      END IF
C
      IF (LOGIC) THEN
          TINTHZ = TEND
          TH = THEND
          DTHIN = DTHDE
          Y(1) = TH
          Y(2) = DTHIN
          EFF = Y(3)
      ELSE
C           DO (INTEGRATE-FOR-PHI-OSC)
          T = TEND
C  THE LCO BOUNDARY CONDITION A1*[u,y] + A2*[v,y] = 0
C  IS EQUIVALENT TO COF1*sin(phi) - COF2*cos(phi) = 0.  SO
          PHI0 = ATAN2(COF2,COF1)

          IF (TM.GT.TEND) THEN
              J = 1
          ELSE
              J = 2
          END IF
C
C     WE WANT -PI/2 .LT. PHI0 .LE. PI/2.
C
          IF (COF1.LT.0.0D0) PHI0 = PHI0 - SIGN(PI,COF2)
          Y(1) = PHI0
          Y(2) = 0.0D0
          Y(3) = 0.0D0
C  PHIDAA REPRESENTS d(phi)/da  EVALUATED AT THE ENDPOINT (A or B).
          CALL DXDT(T,TMP,XT0)
          CALL FZ(T,Y,YP)
          PHIDAA = -YP(1)
          CALL UV(XT0,U,PUP,V,PVP,HU,HV)
          D = U*PVP - V*PUP
C
C  DETERMINE A DEFINITE VALUE FOR ATAN(u/pu') AND ATAN(v/pv') AT TEND:
C     SET THU0 AND THV0.
C
          THU0 = ATAN2(U,PUP)
          IF (U.LT.0.0D0) THU0 = THU0 + TWOPI
          CALL SETTHU(XT0,THU0)
          THV0 = ATAN2(V,PVP)
          IF (V.LT.0.0D0) THV0 = THV0 + TWOPI
   10     CONTINUE
          IF (THV0.LT.THU0) THEN
              THV0 = THV0 + TWOPI
              GO TO 10
          END IF
C
C   USING THE RELATION BETWEEN theta AND phi, NAMELY
C  tan(theta) = (u*cos(phi) + v*sin(phi))/(pup*cos(phi)+pv'*sin(phi))
C  AND, DIFFERENTIATING W.R.T. lambda or a or b,
C  d(theta)*sec(theta)**2 = -[u,v]*d(phi)/(pu'*cos(phi)+pv'*sin(phi))**2

C     SET TH0 AND COPY INTO THEND, OVERWRITING ITS INPUT VALUE.
C     ALSO, REDEFINE DTHDAA, OVERWRITING ITS INPUT VALUE.
C
          CALL UVPHI(U,PUP,V,PVP,THU0,THV0,PHI0,TH0)
          THEND = TH0
          C = COS(PHI0)
          S = SIN(PHI0)
          YZ0 = U*C + V*S
          PYPZ0 = PUP*C + PVP*S
          DUM = ABS(COS(TH0))

          IF (DUM.GE.0.5D0) THEN
              FAC2 = -D* (DUM/PYPZ0)**2
          ELSE
              FAC2 = -D* (SIN(TH0)/YZ0)**2
          END IF

C  DTHDAA REPRESENTS d(theta)/da  EVALUATED AT THE ENDPOINT (A or B).
          DTHDAA = PHIDAA*FAC2
          TOUT = TM
          I = 2
          TT(I,J) = T
          YY(I,1,J) = Y(1)
          YY(I,2,J) = Y(2)
          YY(I,3,J) = Y(3)

          DO 23 I = 1,27
             WORK(I) = 0.0D0
             IF(I.LE.5) IWORK(I) = 0
  23      CONTINUE

   18     CONTINUE
          NNN = 0
          KFLAG = -1
C
C     TSAVEL, TSAVER PRESUMED SET BY AN EARLIER CALL WITH EIG .NE. 0.
C
          IF (EIG.EQ.0.0D0 .AND. ISAVE.EQ.1) THEN
              IF (T.LE.TSAVEL) TOUT = TSAVEL
              IF (T.GT.TSAVER) TOUT = TSAVER
              KFLAG = 1
          END IF

          NK = 0
   20     CONTINUE
          CALL GERK(FZ,3,Y,T,TOUT,EPS,EPS,KFLAG,ER,WORK,IWORK)
          IF (KFLAG.GT.3) THEN
              IF (PR) WRITE (T21,FMT=*) ' KFLAG1 = 5 '
              IFLAG = 5
              RETURN
          END IF
          IF (KFLAG.EQ.3) THEN
              NK = NK + 1
              IF (NK.GE.10) THEN
                  KFLAG = 5
                  RETURN
              END IF
              GO TO 20
          END IF
          NNN = NNN + 1
C  PREVENT EXP(Y(3)) FROM BECOMING UNNECESSARILY SMALL.
          IF (Y(3).LT.-15.0D0) Y(3) = -15.0D0
          PHI = Y(1)
C
C     STORE UP TO SEVEN VALUES OF (T,PHI) FOR LATER REFERENCE.
C
          I = I + 1
          IF (I.LE.7) THEN
              TT(I,J) = T
              YY(I,1,J) = PHI
              YY(I,2,J) = Y(2)
              YY(I,3,J) = Y(3)
          END IF
C  STOP THE INTEGRATION FROM GOING TOO FAR AWAY FROM THE ENDPOINT.
          IF (10.0D0*ABS(PHI-PHI0).GE.PI) GO TO 30
          IF (KFLAG.EQ.-2) THEN
              IF (NNN.GT.500) THEN
                  EPS = 10.D0*EPS
                  GO TO 18
              END IF
              GO TO 20
          END IF
   30     CONTINUE
          IF (T.LE.TOUT) THEN
              TSAVEL = T
          ELSE
              TSAVER = T
          END IF
          NT(J) = I
          DPHIDE = Y(2)
          TINTHZ = T
          CALL DXDT(T,TMP,XT)
          CALL UV(XT,U,PUP,V,PVP,HU,HV)
          D = U*PVP - V*PUP
C
C     SET THU AND THV.
C
          THU = ATAN2(U,PUP)
          IF (U.LT.0.0D0) THU = THU + TWOPI
          CALL SETTHU(XT,THU)
          THV = ATAN2(V,PVP)
          IF (V.LT.0.0D0) THV = THV + TWOPI
   40     CONTINUE
          IF (THV.LT.THU) THEN
              THV = THV + TWOPI
              GO TO 40
          END IF
C
C  TRANSLATE FROM THE VARIABLES PHI, SIGMA, ETC. TO THETA, RHO,ETC.
C    DEFINE TH IN TERMS OF PHI, THU, AND THV.
C
          CALL UVPHI(U,PUP,V,PVP,THU,THV,PHI,TH)
          YZ = U*COS(PHI) + V*SIN(PHI)
          PYPZ = PUP*COS(PHI) + PVP*SIN(PHI)
          Y(1) = TH
          S = SIN(TH)
          C = COS(TH)
          DUM = ABS(C)

          IF (DUM.GE.0.5D0) THEN
              FAC2 = -D* (DUM/PYPZ)**2
          ELSE
              FAC2 = -D* (S/YZ)**2
          END IF

C  d(theta)/d(lambda) = FAC2*d(phi)/d(lambda)
          DTHIN = FAC2*DPHIDE
C  ALSO CONVERT THE GLOBAL ERROR ESTIMATES FROM THOSE FOR
C  PHI,ETC., TO THOSE CORRESPONDING TO THETA, ETC.
          ER(1) = FAC2*ER(1)
          ER(2) = FAC2*ER(2)
          ER(3) = FAC2*ER(3)
          Y(2) = DTHIN
          RHOSQ = EXP(2.0D0*Y(3))* (YZ**2+PYPZ**2)
          EFF = 0.5D0*LOG(RHOSQ* (S**2+C**2))
          Y(3) = EFF
C              END (INTEGRATE-FOR-PHI-OSC)
      END IF
      IF (TINTHZ.NE.TM) THEN
C  NOW INTEGRATE THE REST OF THE WAY TO TM FOR theta, etc.
          TIN = TINTHZ
          TOUT = TM
          THIN = TH
C           DO (INTEGRATE-FOR-THETA)
          CALL INTEGZ(TIN,TOUT,THIN,DTHIN,EPS,Y,LFLAG,ER,WORK,IWORK)
          Y(3) = EFF + Y(3)
C
      END IF
      RETURN
      END
C
      SUBROUTINE LP5(TEND,THEND,DTHDE,TM,EPS,ER,Y,IFLAG)
C  THIS PROGRAM IS CALLED FROM INTEG.
C
C  INPUT QUANTITIES:
C  OUTPUT QUANTITIES:
C
C    IT CONTROLS THE INTEGRATIONS FOR THE USUAL PRUEFER
C    VARIABLES THETA, RHO, ETC. FROM AN ENDPOINT THAT IS LP
C    BUT IS NOT AT +INF OR  -INF.  IN THIS CASE THE ENDPOINT IS
C    A REGULAR SINGULAR POINT AND THE INDICIAL EQUATION IS USED
C    TO OBTAIN THE INITIAL VALUE OF THETA AND IT'S SLOPE THERE
C    (WHICH IS COMPUTED BY THE SUBROUTINE FINELP.)


C     .. Scalar Arguments ..
      REAL DTHDE,EPS,TEND,THEND,TM
      INTEGER IFLAG
C     ..
C     .. Array Arguments ..
      REAL ER(3),Y(3)
C     ..
C     .. Scalars in Common ..
      REAL EIG
      INTEGER IND,T21
      LOGICAL PR
C     ..
C     .. Local Scalars ..
      REAL DDD,DTHIN,EFF,ONE,T,THIN,TIN,TMP,TOUT
      INTEGER I,KFLAG
C     ..
C     .. Local Arrays ..
      REAL WORK(27),YU(3)
      INTEGER IWORK(5)
C     ..
C     .. External Subroutines ..
      EXTERNAL F,GERK,INTEGZ
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MIN
C     ..
C     .. Common blocks ..
      COMMON /DATAF/EIG,IND
      COMMON /PRIN/PR,T21
C     ..
      ONE = 1.0D0
C
      IF (PR) WRITE (T21,FMT=*) ' THIS IS THE LP CASE AT '
      IF (PR) WRITE (T21,FMT=*) ' A FINITE ENDPOINT. '

C
      T = TEND
      YU(1) = THEND
      YU(2) = DTHDE
      YU(3) = 0.0D0

      DO 23 I = 1,27
         WORK(I) = 0.0D0
         IF(I.LE.5) IWORK(I) = 0
  23  CONTINUE

      TMP = 0.01D0
      DDD = MIN(TMP,ABS(TEND))
      TOUT = TEND + DDD* (-TEND)/ABS(TEND)
      KFLAG = 1
      CALL GERK(F,3,YU,T,TOUT,EPS,EPS,KFLAG,ER,WORK,IWORK)
C  NOW CONTINUE THE INTEGRATIONS TO TM.
      TIN = TOUT
      TOUT = TM
      THIN = YU(1)
      DTHIN = YU(2)
      EFF = YU(3)
C          DO (INTEGRATE-FOR-THETA)
      CALL INTEGZ(TIN,TOUT,THIN,DTHIN,EPS,Y,IFLAG,ER,WORK,IWORK)
      Y(3) = EFF + Y(3)
      RETURN
      END
C
      SUBROUTINE LP6(TEND,THEND,TM,DTHDE,EPS,Y,ER,IFLAG)
C  THIS PROGRAM IS CALLED FROM INTEG.
C
C  INPUT QUANTITIES: TEND,TM,THEND,DTHDE,EPS,Y
C  OUTPUT QUANTITIES: Y,ER,IFLAG
C
C    THIS CASE IS EITHER LP AT AN INFINITE ENDPOINT,
C    OR IS IRREGULAR LP AT A FINITE ENDPOINT,
C    OR IS DEFAULT BY THE USER .

C     .. Scalar Arguments ..
      REAL DTHDE,EPS,TEND,THEND,TM
      INTEGER IFLAG
C     ..
C     .. Array Arguments ..
      REAL ER(3),Y(3)
C     ..
C     .. Local Scalars ..
      REAL DTHIN,THIN,TIN,TOUT
C     ..
C     .. Local Arrays ..
      REAL WORK(27)
      INTEGER IWORK(5)
C     ..
C     .. External Subroutines ..
      EXTERNAL INTEGZ
C     ..
      TIN = TEND
      TOUT = TM
      THIN = THEND
      DTHIN = DTHDE
C         DO (INTEGRATE-FOR-THETA)
C        INITIALIZE ER BEFORE CALLING INTEGZ:
      ER(1) = 0.0D0
      ER(2) = 0.0D0
      ER(3) = 0.0D0
      CALL INTEGZ(TIN,TOUT,THIN,DTHIN,EPS,Y,IFLAG,ER,WORK,IWORK)
C            END (INTEGRATE-FOR-THETA)
C
      RETURN
      END
C
      SUBROUTINE INTEG(TEND,THEND,DTHDAA,DTHDE,TM,COEF1,COEF2,EPS,Y,ER,
     +                 OK,NC,IFLAG)
C     **********

C  THIS PROGRAM ACTUALLY DOES NOTHING BUT CALL THE
C    APPROPRIATE SUBROUTINE FROM THE LIST
C    REG,WREG,LCNO,LCO,LP5,LP6,
C    DEPENDING UPON THE VALUE OF NC.
C
C  INPUT QUANTITIES: TEND,THEND,DTHDAA,DTHDE,TM,COEF1,
C                    COEF2,EPS,Y,ER,OK,NC
C  OUTPUT QUANTITIES: DTHDAA,DTHDE,Y,ER,IFLAG
C
C     **********
C     .. Local Scalars ..
      REAL COF1,COF2
C     ..
C     .. External Subroutines ..
      EXTERNAL LCNO,LCO,LP5,LP6,REG,WREG
C     ..
C     NOTE: THE INPUT VALUES OF THEND AND DTHDAA ARE OVERWRITTEN
C           WHEN INTEGRATING FROM A LIMIT CIRCLE ENDPOINT.
C
C     .. Scalar Arguments ..
      REAL COEF1,COEF2,DTHDAA,DTHDE,EPS,TEND,THEND,TM
      INTEGER IFLAG,NC
      LOGICAL OK
C     ..
C     .. Array Arguments ..
      REAL ER(3),Y(3)
C     ..
      IFLAG = 1
      COF1 = COEF1
      COF2 = COEF2

      IF (NC.EQ.1) THEN

C        THIS IS THE REGULAR (NOT WEAKLY REGULAR) CASE.
          CALL REG(TEND,THEND,TM,DTHDE,EPS,Y,ER,IFLAG)
C
      ELSE IF (NC.EQ.2) THEN
C
C        THIS IS THE 'WEAKLY REGULAR' CASE.
          CALL WREG(TEND,THEND,DTHDE,TM,EPS,ER,Y,IFLAG)
C
      ELSE IF (NC.EQ.3) THEN

          CALL LCNO(TEND,THEND,DTHDAA,TM,COF1,COF2,EPS,Y,ER,IFLAG)

      ELSE IF (NC.EQ.4) THEN

          CALL LCO(TEND,THEND,DTHDAA,DTHDE,TM,COF1,COF2,EPS,Y,ER,OK,
     +             IFLAG)

      ELSE IF (NC.EQ.5) THEN
C
C        THIS IS THE CASE OF A REGULAR LP AT A FINITE END.
          CALL LP5(TEND,THEND,DTHDE,TM,EPS,ER,Y,IFLAG)
C
      ELSE IF (NC.EQ.6) THEN

C        THIS CASE IS EITHER LP AT AN INFINITE ENDPOINT,
C        OR ELSE IS IRREGULAR LP AT A FINITE ENDPOINT,
C        OR ELSE IS DEFAULT BY THE USER .
          CALL LP6(TEND,THEND,TM,DTHDE,EPS,Y,ER,IFLAG)

      END IF

      RETURN
      END
C
C
      SUBROUTINE INTEGZ(TIN,TOUT,THIN,DTHIN,EPS,Y,IFLAG,ER,WORK,IWORK)
C     **********
C
C  THIS PROGRAM IS USED FOR CALLING SUBROUTINE GERKZ WHEN THERE
C    IS NO SINGULARITY OF ANY KIND EITHER AT TIN OR AT TOUT.
C  IT IS CALLED FROM LCNO, REG, WREG, LCO, LP5, LP6.
C
C  INPUT QUANTITIES: TIN,TOUT,THIN,DTHIN,EPS,Y,ER
C  OUTPUT QUANTITIES: Y,IFLAG,ER
C
C     **********
C     .. Local Scalars ..
      INTEGER I,LFLAG,NK
C     ..
C     .. External Subroutines ..
      EXTERNAL F,GERKZ
C     ..
C     DO (INTEGRATE-FOR-TH)
C     .. Scalar Arguments ..
      REAL DTHIN,EPS,THIN,TIN,TOUT
      INTEGER IFLAG
C     ..
C     .. Array Arguments ..
      REAL ER(3),WORK(27),Y(3)
      INTEGER IWORK(5)
C     ..
C     .. Scalars in Common ..
      INTEGER T21
      LOGICAL PR
C     ..
C     .. Common blocks ..
      COMMON /PRIN/PR,T21
C     ..

C     IT IS ALWAYS ASSUMED THAT THE ARRAY ER HAS BEEN
C     INITIALIZED BEFORE THIS PROGRAM IS CALLED.
C     EITHER TO ZEROS, OR ELSE IT HAS THE VALUES IT ACQUIRED
C     THE LAST TIME GERK WAS CALLED.  THE PROGRAM INTEGZ
C     WILL BE DEPENDING UPON RECEIVING MEANINGFUL VALUES IN ER.

        DO 23 I = 1,27
           WORK(I) = 0.0D0
           IF(I.LE.5) IWORK(I) = 0
  23    CONTINUE

      Y(1) = THIN
      Y(2) = DTHIN
      Y(3) = 0.0D0
      LFLAG = 1
      NK = 0
   10 CONTINUE
      CALL GERKZ(F,3,Y,TIN,TOUT,EPS,EPS,LFLAG,ER,WORK,IWORK)
      IF (LFLAG.EQ.3) THEN
          NK = NK + 1
          IF (NK.GE.10) THEN
              LFLAG = 5
              RETURN
          END IF
          GO TO 10
      END IF
      IF (LFLAG.GT.3) THEN
          IF (PR) WRITE (T21,FMT=*) ' LFLAG = ',LFLAG
          IFLAG = 5
          RETURN
      END IF
C        END (INTEGRATE-FOR-TH)
      RETURN
      END

C
      SUBROUTINE FZERO(F,B,C,R,RE,AE,IFLAG)
C     **********
C  THIS PROGRAM IS CALLED FROM PERIO.
C  IT SEARCHES FOR A ZERO OF A FUNCTION F(X)
C  BETWEEN THE GIVEN VALUES B AND C UNTIL THE WIDTH OF
C  THE INTERVAL (B,C) HAS COLLAPSED TO WITHIN A TOLERANCE
C  SPECIFIED BY THE STOPPING CRITERION,
C     ABS(B-C) .LE. 2.*(RW*ABS(B)+AE).  THE METHOD USED IS
C  A COMBINATION OF BISECTION AND THE SECANT RULE.
C
C  THE MEANING OF IFLAG IS:-
C  IFLAG = 1, B IS WITHIN THE REQUESTED TOLERANCE OF A ZERO.
C             THE INTERVAL (B,C) COLLAPSED TO THE REQUESTED
C             TOLERANCE, THE FUNCTION CHANGES SIGN IN (B,C),
C             AND F(X) DECREASED IN MAGNITUDE AS (B,C) COLLAPSED.
C          2, F(B) = 0. HOWEVER, THE INTERVAL (B,C) MAY NOT HAVE
C             HAVE COLLAPSED TO THE REQUESTED TOLERANCE.
C          3, B MAY BE NEAR A SINGULAR POINT OF F(X).  THE
C             INTERVAL (B,C) COLLAPSED TO THE REQUESTED TOLERANCE
C             AND THE FUNCTION CHANGES SIGN IN (B,C), BUT F(X)
C             INCREASED IN MAGNITUDE AS (B,C) COLLAPSED.
C          4, NO CHANGE IN SIGN OF F(X) WAS FOUND ALTHOUGH THE
C             INTERVAL (B,C) COLLAPSED TO THE REQUESTED TOLERANCE.
C          5, TOO MANY (.GT. 500) FUNCTION EVALUATIONS USED.
C          6, NO MORE PROGRESS IS BEING MADE.
C
C     .. Local Scalars ..
      REAL A,ACBS,ACMB,AW,CMB,DIF,DIFS,FA,FB,FC,FX,FZ,P,Q,
     +                 RW,TOL,Z,ZER
      INTEGER IC,KOUNT
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,MIN,SIGN
C     ..
C     .. Scalar Arguments ..
      REAL AE,B,C,R,RE
      INTEGER IFLAG
C     ..
C     .. Function Arguments ..
      REAL F
      EXTERNAL F
C     ..
      IFLAG = 1
      ZER = 0.0D0
      DIF = 1.D+9
      Z = R
      IF (R.LE.MIN(B,C) .OR. R.GE.MAX(B,C)) Z = C
      RW = MAX(RE,ZER)
      AW = MAX(AE,ZER)
      IC = 0
      FZ = F(Z)
      FB = F(B)
      KOUNT = 2
      IF (FZ*FB.LT.0.0D0) THEN
          C = Z
          FC = FZ
      ELSE IF (Z.NE.C) THEN
          FC = F(C)
          KOUNT = 3
          IF (FZ*FC.LT.0.0D0) THEN
              B = Z
              FB = FZ
          END IF
      END IF
      A = C
      FA = FC
      ACBS = ABS(B-C)
      FX = MAX(ABS(FB),ABS(FC))
C
   10 CONTINUE
      IF (ABS(FC).LT.ABS(FB)) THEN
          A = B
          FA = FB
          B = C
          FB = FC
          C = A
          FC = FA
      END IF
      CMB = 0.5D0* (C-B)
      ACMB = ABS(CMB)
      TOL = RW*ABS(B) + AW
      IF (ACMB.LE.TOL) THEN
          IFLAG = 1
          IF (FB*FC.GE.0.0D0) IFLAG = 4
          IF (ABS(FB).GT.FX) IFLAG = 3
          RETURN
      END IF
      IF (FB.EQ.0.0D0) THEN
          IFLAG = 2
          RETURN
      END IF
      IF (KOUNT.GE.500) THEN
          IFLAG = 5
          RETURN
      END IF
C
      P = (B-A)*FB
      Q = FA - FB
      IF (P.LT.0.0D0) THEN
          P = -P
          Q = -Q
      END IF
      A = B
      FA = FB
      IC = IC + 1
      IF (IC.GE.4) THEN
          IF (8.0D0*ACMB.GE.ACBS) B = 0.5D0* (C+B)
      ELSE
          IC = 0
          ACBS = ACMB
          IF (P.LE.ABS(Q)*TOL) THEN
              B = B + SIGN(TOL,CMB)
          ELSE IF (P.GE.CMB*Q) THEN
              B = 0.5D0* (C+B)
          ELSE
              B = B + P/Q
          END IF
      END IF
      FB = F(B)
      DIFS = DIF
      DIF = FB - FC
      IF (DIF.EQ.DIFS) THEN
          IFLAG = 6
          RETURN
      END IF
      KOUNT = KOUNT + 1
      IF (FB*FC.GE.0.0D0) THEN
          C = A
          FC = FA
      END IF
      GO TO 10
      END
C
      SUBROUTINE PERFUN(AA,BB,TMID,NCA,NCB,K11,K12,K21,K22,LAMBDA,ISLFN,
     +                  XT,PLOTF)
C     **********
C  THIS PROGRAM IS USED ONLY TO COMPUTE EIGENFUNCTIONS FOR PROBLEMS
C  WITH COUPLED BOUNDARY CONDITIONS.  IT IS CALLED BY SUBROUTINE
C  SLCOUP AND BY DRAW.
C
C  INPUT QUANTITIES: AA,BB,TMID,NCA,NCB,K11,K12,K21,K22,LAMBDA,
C                    ISLFN,XT
C  OUTPUT QUANTITIES: XT,PLOTF
C
C     .. Scalars in Common ..
C
      REAL EIGSAV,EPSMIN,HPI,PI,TSAVEL,TSAVER,TWOPI,Z
      INTEGER IND,ISAVE,T21
      LOGICAL PR
C     ..
C     .. Local Scalars ..
      REAL A1,A2,ADTH,AEE,B1,B2,BEE,BRA,BRB,C,DA,DB,DELTMP,
     +                 DTH,DTHDAA,DTHDBB,DTHDEA,DTHDEB,DTHM,DTHS,E,EFF,
     +                 EPS,ETAA,ETAB,F,HU,HV,PUP,PVP,PY1PL,PY1PR,PY2PL,
     +                 PY2PR,RHOL,RHOR,T,THA,THB,THL,THR,THS,THT,TM,TMP,
     +                 TMP0,TMP1,TMP2,TMPS,TT,U,V,XX,Y1L,Y1R,Y2L,Y2R,YM,
     +                 YM1,YM2,ZM
      INTEGER I,J,K,LFLAG,NC,NI,NM,NMID,NMIDM,NMIDP,NPI
      LOGICAL AOK,BOK,OK
C     ..
C     .. Local Arrays ..
      REAL ERR(3),PYLI(500),PYRI(500),THLI(500),THRI(500),
     +                 TI(1000),Y(3),YL(500,2,2),YLI(500),YR(500,2,2),
     +                 YRI(500)
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,INTEG,UV
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,ATAN2,COS,EXP,MAX,MIN,SIN,SQRT
C     ..
C     .. Common blocks ..
      COMMON /DATAF/EIGSAV,IND
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
      COMMON /TSAVE/TSAVEL,TSAVER,ISAVE
      COMMON /Z1/Z
C     ..
C
C     .. Scalar Arguments ..
      REAL AA,BB,K11,K12,K21,K22,LAMBDA,TMID
      INTEGER ISLFN,NCA,NCB
C     ..
C     .. Array Arguments ..
      REAL PLOTF(1000,6),XT(1000,2)
C     ..
      IND = 1
      EIGSAV = LAMBDA
      EPS = EPSMIN
      AOK = NCA .EQ. 1
      BOK = NCB .EQ. 1
C
C  JUST IN CASE THAT THE USER SUPPLIED BOUNDARY CONDITION
C  FUNCTIONS u,v AND/OR U,V HAVE NOT BEEN "NORMALIZED" TO HAVE
C   [u,v](a) = 1.0 AND/OR [U,V](b) = 1.0,
C  THE VALUES OF THE WRONSKIANS BRA = [u,v](a) & BRB = [U,V](b),
C  WILL BE NEEDED, AS ARE THE QUANTITIES ETAA, DA, ETAB,DB
C  WHERE BRA = DA*ETAA AND BRB = DB*ETAB, AND DA,DB ARE POSITIVE.
      BRA = 1.0D0
      BRB = 1.0D0
      ETAA = 1.0D0
      ETAB = 1.0D0
      DA = 1.0D0
      DB = 1.0D0
      IF (NCA.EQ.3 .OR. NCA.EQ.4) THEN
          TT = AA
          CALL DXDT(TT,TMP,XX)
          CALL UV(XX,U,PUP,V,PVP,HU,HV)
          BRA = U*PVP - V*PUP
          DA = SQRT(ABS(BRA))
          ETAA = BRA/ (DA*DA)
      END IF
      IF (NCB.EQ.3 .OR. NCB.EQ.4) THEN
          TT = BB
          CALL DXDT(TT,TMP,XX)
          CALL UV(XX,U,PUP,V,PVP,HU,HV)
          BRB = U*PVP - V*PUP
          DB = SQRT(ABS(BRB))
          ETAB = BRB/ (DB*DB)
      END IF
      IF (PR) WRITE (T21,FMT=*) ' BRA,BRB = ',BRA,BRB
C
C  GET THE ARRAY OF POINTS T IN (-1,1) WHERE THE EIGENFUNCTION
C    IS WANTED.  THESE POINTS CORRESPOND TO POINTS X IN (a,b).

      DO 3 I = 1,ISLFN
          TI(I) = XT(9+I,2)
          CALL DXDT(TI(I),TMP,XX)
          XT(9+I,1) = XX
    3 CONTINUE
      NI = ISLFN

C  FIND THE INDEX, NMID, IN (1,NI) CORRESPONDING NEARLY TO
C    TMID, OR XMID.

      NMID = 0
      DO 5 I = 1,NI
          IF (TI(I).LE.TMID) NMID = I
    5 CONTINUE
      NMIDP = NMID + 5
      NMIDM = NMID - 5
C
C  NOW COMPUTE VALUES OF THE FUNDAMENTAL SYSTEM OF FUNCTIONS
C    Y1L, Y1R, Y2L, Y2R
C  AT THE POINTS TI.
C
      Z = 1.0D0
C
C  N.B.: IN LIMIT CIRCLE CASE, IF Y IS A SOLUTION,
C
C         [Y,V] =  SIGMA*[U,V]*COS(PHI)
C         [Y,U] = -SIGMA*[U,V]*SIN(PHI)
C
C     FOR Y2: NEUMANN PROBLEM :
C
C  N.B. IF ENDPOINT A IS REGULAR, INTEG USES THA;
C       BUT IF A IS LC, INTEG USES A1,A2.
C
      A1 = 0.0D0
      A2 = -1.0D0
      THA = HPI
      Y(1) = THA
      Y(2) = 1.0D0
      Y(3) = 0.0D0
      DTHDAA = 0.0D0
      DTHDEA = 1.0D0
      NC = NCA
      OK = AOK
      T = AA
      EFF = 0.0D0
      LFLAG = 1
      ISAVE = 0
      DO 12 I = 1,NMIDP
          THT = Y(1)
          TM = TI(I)
          IF (TM.GT.-1.0D0) CALL INTEG(T,THT,DTHDAA,DTHDEA,TM,A1,A2,EPS,
     +                                 Y,ERR,OK,NC,LFLAG)
          IF (NC.EQ.4) THEN
              EFF = Y(3)
          ELSE IF (TM.GT.-1.0D0) THEN
              OK = .TRUE.
              NC = 1
              EFF = EFF + Y(3)
          END IF
          RHOL = EXP(EFF)
          THL = Y(1)
          Y2L = RHOL*SIN(THL)
          PY2PL = RHOL*COS(THL)
C
          Y2L = Y2L*DA
          PY2PL = PY2PL*DA
          YL(I,2,1) = Y2L
          YL(I,2,2) = PY2PL
          T = TM
          IF (TM.GT.-1.0D0) THEN
              OK = .TRUE.
              NC = 1
          END IF
          IF (T.LT.-0.9D0 .AND. NCA.EQ.4) THEN
C  IN THIS CASE, INTEGRATE FROM AA AGAIN, AS AN OSC PROBLEM.
              NC = 4
              OK = .FALSE.
              T = AA
              Y(1) = THA
              Y(2) = 0.0D0
              Y(3) = 0.0D0
          END IF
   12 CONTINUE
C
C  N.B. IF ENDPOINT B IS REGULAR, INTEG USES THB;
C       BUT IF B IS LC, INTEG USES B1,B2.
      B1 = 0.0D0
      B2 = -1.0D0
      THB = HPI
      Y(1) = THB
      Y(2) = 1.0D0
      Y(3) = 0.0D0
      DTHDBB = 0.0D0
      DTHDEB = 1.0D0
      NC = NCB
      OK = BOK
      T = BB
      EFF = 0.0D0
      LFLAG = 1
      ISAVE = 0
      DO 22 I = NI,NMIDM,-1
          THT = Y(1)
          TM = TI(I)
          IF (TM.LT.1.0D0) CALL INTEG(T,THT,DTHDBB,DTHDEB,TM,B1,B2,EPS,
     +                                Y,ERR,OK,NC,LFLAG)
          IF (NC.EQ.4) THEN
              EFF = Y(3)
          ELSE IF (TM.LT.1.0D0) THEN
              OK = .TRUE.
              NC = 1
              EFF = EFF + Y(3)
          END IF
          RHOR = EXP(EFF)
          THR = Y(1)
          Y2R = RHOR*SIN(THR)
          PY2PR = RHOR*COS(THR)
C
          Y2R = Y2R*DB
          PY2PR = PY2PR*DB
          YR(I,2,1) = Y2R
          YR(I,2,2) = PY2PR
          T = TM
          IF (T.LT.1.0D0) THEN
              OK = .TRUE.
              NC = 1
          END IF
          IF (T.GT.0.9D0 .AND. NCB.EQ.4) THEN
C  IN THIS CASE, INTEGRATE FROM BB AGAIN, AS AN OSC PROBLEM.
              NC = 4
              OK = .FALSE.
              T = BB
              Y(1) = THB
              Y(2) = 0.0D0
              Y(3) = 0.0D0
          END IF
   22 CONTINUE
C
C     FOR Y1: DIRICHLET PROBLEM :
C
C  N.B. IF ENDPOINT A IS REGULAR, INTEG USES THA;
C       BUT IF A IS LC, INTEG USES A1,A2.
      A1 = 1.0D0
      A2 = 0.0D0
      THA = 0.0D0
      Y(1) = THA
      Y(2) = 1.0D0
      Y(3) = 0.0D0
      DTHDAA = 0.0D0
      DTHDEA = 1.0D0
      NC = NCA
      OK = AOK
      T = AA
      EFF = 0.0D0
      LFLAG = 1
      ISAVE = 0
      DO 32 I = 1,NMIDP
          THT = Y(1)
          TM = TI(I)
          IF (TM.GT.-1.0D0) CALL INTEG(T,THT,DTHDAA,DTHDEA,TM,A1,A2,EPS,
     +                                 Y,ERR,OK,NC,LFLAG)
          IF (NC.EQ.4) THEN
              EFF = Y(3)
          ELSE IF (TM.GT.-1.0D0) THEN
              NC = 1
              OK = .TRUE.
              EFF = EFF + Y(3)
          END IF
          RHOL = EXP(EFF)
          THL = Y(1)
          Y1L = RHOL*SIN(THL)
          PY1PL = RHOL*COS(THL)
C
          Y1L = Y1L*DA*ETAA
          PY1PL = PY1PL*DA*ETAA
          YL(I,1,1) = Y1L
          YL(I,1,2) = PY1PL
          T = TM
          IF (T.GT.-1.0D0) THEN
              OK = .TRUE.
              NC = 1
          END IF
          IF (T.LT.-0.9D0 .AND. NCA.EQ.4) THEN
C  IN THIS CASE, INTEGRATE FROM AA AGAIN, AS AN OSC PROBLEM.
              NC = 4
              OK = .FALSE.
              T = AA
              Y(1) = THA
              Y(2) = 0.0D0
              Y(3) = 0.0D0
          END IF
   32 CONTINUE
C
C  N.B. IF ENDPOINT B IS REGULAR, INTEG USES THB;
C       BUT IF B IS LC, INTEG USES B1,B2.
      B1 = 1.0D0
      B2 = 0.0D0
      THB = 0.0D0
      Y(1) = THB
      Y(2) = 1.0D0
      Y(3) = 0.0D0
      DTHDBB = 0.0D0
      DTHDEB = 1.0D0
      NC = NCB
      OK = BOK
      T = BB
      EFF = 0.0D0
      LFLAG = 1
      ISAVE = 0
      DO 42 I = NI,NMIDM,-1
          THT = Y(1)
          TM = TI(I)
          IF (TM.LT.1.0D0) CALL INTEG(T,THT,DTHDBB,DTHDEB,TM,B1,B2,EPS,
     +                                Y,ERR,OK,NC,LFLAG)
          IF (NC.EQ.4) THEN
              EFF = Y(3)
          ELSE IF (TM.LT.1.0D0) THEN
              NC = 1
              OK = .TRUE.
              EFF = EFF + Y(3)
          END IF
          RHOR = EXP(EFF)
          THR = Y(1)
          Y1R = RHOR*SIN(THR)
          PY1PR = RHOR*COS(THR)
          IF (NCB.EQ.3) THEN
              Y1R = -Y1R
              PY1PR = -PY1PR
          END IF
C
          Y1R = Y1R*DB*ETAB
          PY1PR = PY1PR*DB*ETAB
          YR(I,1,1) = Y1R
          YR(I,1,2) = PY1PR
          T = TM
          IF (T.LT.1.0D0) THEN
              OK = .TRUE.
              NC = 1
          END IF
          IF (T.GT.0.9D0 .AND. NCB.EQ.4) THEN
C  IN THIS CASE, INTEGRATE FROM BB AGAIN, AS AN OSC PROBLEM.
              NC = 4
              OK = .FALSE.
              T = BB
              Y(1) = THB
              Y(2) = 0.0D0
              Y(3) = 0.0D0
          END IF
   42 CONTINUE
C
C  NOW WE WANT TO FIND CONSTANTS, AEE, BEE, AND
C  E, F SO THAT THE EIGENFUNCTION , Y, CAN BE OBTAINED AS
C      Y = AEE*Y1L + BEE*Y2L = E*Y1R + F*Y2R.
C  THE CONSTANTS E, F ARE OBTAINED IN TERMS OF AEE, BEE
C  BY MEANS OF THE COUPLED BOUNDARY CONDITIONS, AND ARE
C      E = K21*BEE + K22*AEE
C      F = K11*BEE + K12*AEE,
C
C   WHILE THE AEE, BEE ARE GOING TO BE CHOSEN BELOW BY THE
C   REQUIREMENT THAT Y AND PY' ARE CONTINUOUS.
C
C
      NM = NMID + 5

      DTHM = 5.0D0
      DELTMP = PI/100.0D0
      TMP0 = 0.0D0
      K = 0
  150 CONTINUE
      DO 110 J = 1,100
          TMP0 = TMP0 + DELTMP
          AEE = SIN(TMP0)
          BEE = COS(TMP0)
          E = K21*BEE + K22*AEE
          F = K11*BEE + K12*AEE
          TMP1 = AEE*YL(NM,1,1) + BEE*YL(NM,2,1)
          TMP2 = AEE*YL(NM,1,2) + BEE*YL(NM,2,2)
          TMP = ATAN2(TMP1,TMP2)
          IF (TMP.LT.0.0D0) TMP = TMP + PI
          THL = TMP
          TMP1 = E*YR(NM,1,1) + F*YR(NM,2,1)
          TMP2 = E*YR(NM,1,2) + F*YR(NM,2,2)
          TMP = ATAN2(TMP1,TMP2)
          IF (TMP.LE.0.0D0) TMP = TMP + PI
          THR = TMP
          DTH = THR - THL
          ADTH = ABS(DTH)
          IF (ADTH.LT.DTHM) THEN
              DTHM = ADTH
              TMPS = TMP0
              DTHS = DTH
          END IF
  110 CONTINUE
      K = K + 1
      IF (K.LT.2 .OR. (K.LE.4.AND.ABS(DTHS).GT. (1.0D-6))) THEN
          TMP0 = TMPS - DELTMP
          DELTMP = DELTMP/50.0D0
          GO TO 150
      END IF
C  WE NOW HAVE THE "BEST" CHOICE OF THE RATIO OF AEE:BEE .
C
C  NOW RESET NM WHERE YM IS THE LARGEST VALUE OF Y.
      NM = NMIDM
      YM = 0.0D0
      DO 56 I = NMIDM,NMIDP
          TMP1 = AEE*YL(I,1,1) + BEE*YL(I,2,1)
          TMP = ABS(TMP1)
          TMP2 = AEE*YL(I,1,2) + BEE*YL(I,2,2)
          TMP2 = ATAN2(TMP1,TMP2)
          IF (TMP2.LT.0.0D0) TMP2 = TMP2 + PI
          IF (TMP.GT.YM) THEN
              YM = TMP
              NM = I
          END IF
   56 CONTINUE
C
C  DEFINE THLI(*) AND SET YM1 WHERE YL IS THE GREATEST.
      YM1 = 0.0D0
      DO 62 I = 1,NMIDP
          YLI(I) = (AEE*YL(I,1,1)+BEE*YL(I,2,1))
          PYLI(I) = (AEE*YL(I,1,2)+BEE*YL(I,2,2))
          THLI(I) = ATAN2(YLI(I),PYLI(I))
          IF (THLI(I).LT.0.0D0) THLI(I) = THLI(I) + PI
          TMP = ABS(YLI(I))
          IF (TMP.GT.YM1) YM1 = TMP
   62 CONTINUE

C  DEFINE THRI(*) AND SET YM2 WHERE YR IS THE GREATEST.
      YM2 = 0.0D0
      DO 72 I = NMIDM,NI
          YRI(I) = (E*YR(I,1,1)+F*YR(I,2,1))
          PYRI(I) = (E*YR(I,1,2)+F*YR(I,2,2))
          THRI(I) = ATAN2(YRI(I),PYRI(I))
          IF (THRI(I).LT.0.0D0) THRI(I) = THRI(I) + PI
          TMP = ABS(YRI(I))
          IF (TMP.GT.YM2) YM2 = TMP
   72 CONTINUE
C
C  ADJUST THE THLI(*) TO BE CONTINUOUS; I.E. HAVE NO "JUMPS".
      NPI = 0
      THS = THLI(1)
      DO 82 I = 1,NMIDP
          TMP = THLI(I) - THS
          THS = THLI(I)
          IF (TMP.LT.-2.0D0) THEN
              NPI = NPI + 1
          END IF
          THLI(I) = THLI(I) + NPI*PI
   82 CONTINUE
C
C  ADJUST THE THRI(*) TO BE CONTINUOUS; I.E. HAVE NO "JUMPS".
      NPI = 0
      THS = THRI(NMIDM)
      DO 87 I = NMIDM,NI
          TMP = THRI(I) - THS
          THS = THRI(I)
          IF (TMP.LT.-2.0D0) THEN
              NPI = NPI + 1
          END IF
          THRI(I) = THRI(I) + NPI*PI
   87 CONTINUE
C
C  FIND J IN (NMIDM,NMIDP) WHERE TMP, BELOW, IS GREATEST.
      J = NMIDM
      ZM = 0.0D0
      DO 177 I = NMIDM,NMIDP
          TMP = MIN(ABS(YLI(I)),ABS(YRI(I)))
          IF (TMP.GT.ZM) THEN
              ZM = TMP
              J = I
          END IF
  177 CONTINUE
C
      C = YLI(J)/YRI(J)
      YM = MAX(YM1,C*YM2)
C  WITH THIS C AND YM RESCALE THE YLI, PYLI, YRI, PYRI
C  SO AS TO MAKE YL AND YR "CONTINUOUS".
C  ALSO FILL THE ARRAY PLOTF.

      DO 182 I = 1,NM
          YLI(I) = YLI(I)/YM
          PYLI(I) = PYLI(I)/YM
          PLOTF(9+I,1) = YLI(I)
          PLOTF(9+I,2) = PYLI(I)
          PLOTF(9+I,3) = YLI(I)
          PLOTF(9+I,4) = PYLI(I)
          PLOTF(9+I,5) = THLI(I)
          PLOTF(9+I,6) = SQRT(YLI(I)**2+PYLI(I)**2)
  182 CONTINUE
      DO 192 I = NM,NI
          YRI(I) = C*YRI(I)/YM
          PYRI(I) = C*PYRI(I)/YM
          PLOTF(9+I,1) = YRI(I)
          PLOTF(9+I,2) = PYRI(I)
          PLOTF(9+I,3) = YRI(I)
          PLOTF(9+I,4) = PYRI(I)
          PLOTF(9+I,5) = THRI(I)
          PLOTF(9+I,6) = SQRT(YRI(I)**2+PYRI(I)**2)
  192 CONTINUE
C
      RETURN
      END
C
      REAL FUNCTION FF(ALFLAM)
C     **********
C  THIS PROGRAM COMPUTES THE FUNCTION WHOSE ZEROS ARE THE
C  EIGENVALUES OF PROBLEMS WITH COUPLED BOUNDARY CONDITIONS.
C
C  INPUT QUANTITIES: ALFLAM,AA,BB,TMID,EIGSAV,IND,AOK,BOK,
C                    NCA,NCB,ALFA,K11,K12,K21,K22,ETAA,ETAB,
C                    DA,DB,EPSMIN
C  OUTPUT QUANTITIES: FF
C
C       THE STURM-LIOUVILLE DIFFERENTIAL EQUATION IS
C           -(py')' + q*y = lambda*w*y ,
C  AND THE COUPLED BOUNDARY CONDITIONS ARE OF THE FORM
C            y(b) = exp(-i*alfa)*(k11*y(a) + k12*py'(a))
C           py'(b) = exp(-i*alfa)*(k21*y(a) + k22*py'(a))
C  (IN THE REGULAR CASE).
C
C  WHEN y1,y2 IS A SYSTEM OF SOLUTIONS SUITABLY DEFINED AT A,
C  AND Y1,Y2 IS A SYSTEM OF SOLUTIONS SUITABLY DEFINED AT B,
C  THEN
C  D(LAMBDA) IS DEFINED BY THE FORMULA:
C    D(LAMBDA) := K11[Y2,y1]+K12[y2,Y2)+K21[Y1,y1]+K22[y2,Y1]
C  AND THE EIGENVALUES OF THE COUPLED BOUNDARY CONDITION
C  PROBLEM ARE THE ZEROS OF
C        D(LAMBDA) - 2.0*COS(ALFA)
C
C  THIS PROGRAM RECEIVES DATA FROM SUBROUTINE PERIO VIA
C  COMMON/PASS2, COMMON/ENCEE, AND COMMON/ABEE,
C  AND RETURNS DATA TO PERIO VIA COMMON/TERM
C
C     **********
C     .. Scalars in Common ..
C
      REAL AA,ALFA,BB,BB1,BB2,DA,DB,DMU,DNU,EIGSAV,EPSMIN,
     +                 ETAA,ETAB,FFMAX,FFMIN,FFV,HPI,K11,K12,K21,K22,PI,
     +                 TMID,TRM11,TRM12,TRM21,TRM22,TSAVEL,TSAVER,TWOPI,
     +                 Z
      INTEGER IND,ISAVE,NCA,NCB,T21
      LOGICAL AOK,BOK,PR
C     ..
C     .. Local Scalars ..
      REAL A1,A2,B1,B2,DTHDAA,DTHDBB,DTHDEA,DTHDEB,EPS,
     +                 LAMBDA,PY1PL,PY1PR,PY2PL,PY2PR,RHOL,RHOR,THA,THB,
     +                 THL,THR,Y1L,Y1R,Y2L,Y2R
      INTEGER LFLAG
C     ..
C     .. Local Arrays ..
      REAL ERR(3),Y(3)
C     ..
C     .. External Subroutines ..
      EXTERNAL INTEG
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC COS,EXP,MAX,MIN,SIN
C     ..
C     .. Common blocks ..
      COMMON /ABEE/AA,BB,TMID
      COMMON /DATAF/EIGSAV,IND
      COMMON /ENCEE/AOK,BOK,NCA,NCB
      COMMON /PASS2/ALFA,K11,K12,K21,K22,ETAA,ETAB,DA,DB
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
      COMMON /TERM/TRM11,TRM12,TRM21,TRM22,FFMIN,FFMAX,DMU,DNU,BB1,BB2,
     +       FFV
      COMMON /TSAVE/TSAVEL,TSAVER,ISAVE
      COMMON /Z1/Z
C     ..
C
C     .. Scalar Arguments ..
      REAL ALFLAM
C     ..
      IND = 1
      LAMBDA = ALFLAM
      EIGSAV = LAMBDA
      EPS = EPSMIN
C
   50 CONTINUE
      Z = 1.0D0

C  LET y1,y2 DENOTE SOLUTIONS OF
C      -(py')' + q*y = lambda*w*y
C  SATISFYING THE BOUNDARY CONDITIONS AT a
C       y1(a) = 0,  py1'(a) = 1
C       y2(a) = 1,  py2'(a) = 0
C  IF a IS REGULAR,
C  OR
C       [y1,u](a) = 0, [y1,v](a) = 1
C       [y2,u](a) = 1, [y2,v](a) = 0
C  IF a IS LC.
C  DENOTE THEIR VALUES AT THE MIDPOINT BY
C    Y1L, PY1PL AND Y2L, PY2PL, RESPECTIVELY.

C  SIMILARLY, LET Y1,Y2 DENOTE SOLUTIONS OF
C      -(py')' + q*y = lambda*w*y
C  SATISFYING THE BOUNDARY CONDITIONS AT b
C       Y1(b) = 0, pY1'(b) = 1
C       Y2(b) = 1, pY2'(b) = 0
C  IF b IS REGULAR,
C  OR
C       [Y1,U](b) = 0, [Y1,V](b) = 1
C       [Y2,U](b) = 1, [Y2,V](b) = 0
C  IF b IS LC.
C  DENOTE THEIR VALUES AT THE MIDPOINT BY
C    Y1R, PY1PR AND Y2R, PY2PR, RESPECTIVELY.
C
C  THUS:
C     FOR y2 & Y2: NEUMANN PROBLEM :
C
C  N.B. IF ENDPOINT A IS REGULAR, INTEG USES THA;
C       BUT IF A IS LC, INTEG USES A1,A2.
C
      A1 = 0.0D0
      A2 = -1.0D0
      THA = HPI
      Y(1) = THA
      Y(2) = 1.0D0
      Y(3) = 0.0D0
      DTHDAA = 0.0D0
      DTHDEA = 1.0D0
      LFLAG = 1
      ISAVE = 0
      CALL INTEG(AA,THA,DTHDAA,DTHDEA,TMID,A1,A2,EPS,Y,ERR,AOK,NCA,
     +           LFLAG)
      IF (LFLAG.EQ.5) THEN
          EPS = 10.0D0*EPS
          GO TO 50
      END IF
      RHOL = EXP(Y(3))
      THL = Y(1)
      Y2L = RHOL*SIN(THL)
      PY2PL = RHOL*COS(THL)
C
C  IF [u,v](a) .NE. 1, LET [u,v](a) = DA*ETAA (ABS(ETAA) = 1).
C  THEN NORMALIZE:
      Y2L = Y2L*DA
      PY2PL = PY2PL*DA
C
C  N.B. IF ENDPOINT B IS REGULAR, INTEG USES THB;
C       BUT IF B IS LC, INTEG USES B1,B2.
      B1 = 0.0D0
      B2 = -1.0D0
      THB = HPI
      Y(1) = THB
      Y(2) = 1.0D0
      Y(3) = 0.0D0
      DTHDBB = 0.0D0
      DTHDEB = 1.0D0
      LFLAG = 1
      ISAVE = 0
      CALL INTEG(BB,THB,DTHDBB,DTHDEB,TMID,B1,B2,EPS,Y,ERR,BOK,NCB,
     +           LFLAG)
      IF (LFLAG.EQ.5) THEN
          EPS = 10.0D0*EPS
          GO TO 50
      END IF
      THR = Y(1)
      RHOR = EXP(Y(3))
      Y2R = RHOR*SIN(THR)
      PY2PR = RHOR*COS(THR)
C
C  IF [U,V](b) .NE. 1, LET [U,V](b) = DB*ETAB (ABS(ETAB) = 1).
C  THEN NORMALIZE:
      Y2R = Y2R*DB
      PY2PR = PY2PR*DB

C
C     FOR y1 & Y1: DIRICHLET PROBLEM :
C
C  N.B. IF ENDPOINT A IS REGULAR, INTEG USES THA;
C       BUT IF A IS LC, INTEG USES A1,A2.
      A1 = 1.0D0
      A2 = 0.0D0
      THA = 0.0D0
      Y(1) = THA
      Y(2) = 1.0D0
      Y(3) = 0.0D0
      DTHDAA = 0.0D0
      DTHDEA = 1.0D0
      LFLAG = 1
      ISAVE = 0
      CALL INTEG(AA,THA,DTHDAA,DTHDEA,TMID,A1,A2,EPS,Y,ERR,AOK,NCA,
     +           LFLAG)
      IF (LFLAG.EQ.5) THEN
          EPS = 10.0D0*EPS
          GO TO 50
      END IF
      RHOL = EXP(Y(3))
      THL = Y(1)
      Y1L = RHOL*SIN(THL)
      PY1PL = RHOL*COS(THL)
C
C  IF [u,v](a) .NE. 1, LET [u,v](a) = DA*ETAA (ABS(ETAA) = 1).
C  THEN NORMALIZE:
      Y1L = Y1L*DA*ETAA
      PY1PL = PY1PL*DA*ETAA
C
C  N.B. IF ENDPOINT B IS REGULAR, INTEG USES THB;
C       BUT IF B IS LC, INTEG USES B1,B2.
      B1 = 1.0D0
      B2 = 0.0D0
      THB = 0.0D0
      Y(1) = THB
      Y(2) = 1.0D0
      Y(3) = 0.0D0
      DTHDBB = 0.0D0
      DTHDEB = 1.0D0
      LFLAG = 1
      ISAVE = 0
      CALL INTEG(BB,THB,DTHDBB,DTHDEB,TMID,B1,B2,EPS,Y,ERR,BOK,NCB,
     +           LFLAG)
      IF (LFLAG.EQ.5) THEN
          EPS = 10.0D0*EPS
          GO TO 50
      END IF
      RHOR = EXP(Y(3))
      THR = Y(1)
      Y1R = RHOR*SIN(THR)
      PY1PR = RHOR*COS(THR)
      IF (NCB.EQ.2 .OR. NCB.EQ.3) THEN
          Y1R = -Y1R
          PY1PR = -PY1PR
      END IF
C
C  IF [U,V](b) .NE. 1, LET [U,V](b) = DB*ETAB (ABS(ETAB) = 1).
C  THEN NORMALIZE:
      Y1R = Y1R*DB*ETAB
      PY1PR = PY1PR*DB*ETAB

C  N.B. D(LAMBDA) IS DEFINED BY THE FORMULA:
C    D(LAMBDA) := K11[Y2,y1]+K12[y2,Y2)+K21[Y1,y1]+K22[y2,Y1]
C  AND THE EIGENVALUES OF THE COUPLED BOUNDARY CONDITION
C  PROBLEM ARE THE ZEROS OF
C        D(LAMBDA) - 2.0*COS(ALFA)
C
      TRM11 = Y2R*PY1PL - Y1L*PY2PR
      TRM22 = Y2L*PY1PR - Y1R*PY2PL
      TRM21 = Y1R*PY1PL - Y1L*PY1PR
      TRM12 = Y2L*PY2PR - Y2R*PY2PL
C
      BB1 = K12*TRM12 + K22*TRM22
      BB2 = K21*TRM21 + K11*TRM11
C
      FF = BB1 + BB2 - 2.0D0*COS(ALFA)
c     IF(PR)WRITE(T21,*) ' TRMS =',TRM11,TRM12,TRM21,TRM22
c     IF(PR)WRITE(T21,*) ' Y1L,Y1R = ',Y1L,Y1R
c     IF(PR)WRITE(T21,*) ' PY1PL,PY1PR = ',PY1PL,PY1PR
c     IF(PR)WRITE(T21,*) ' Y2L,Y2R = ',Y2L,Y2R
c     IF(PR)WRITE(T21,*) ' PY2PL,PY2PR = ',PY2PL,PY2PR
C     IF(PR)WRITE(T21,*) ' BB1,BB2 = ',BB1,BB2
c      dmu = k22*trm21 + k12*trm11
c      dnu = k11*trm12 + k21*trm22
c      dmu = dmu/sqrt(1.0+dmu**2)
c      dnu = dnu/sqrt(1.0+dnu**2)

      FFV = FF
      IF (PR) WRITE (T21,FMT=*) ' EIG,FF = ',EIGSAV,FF
      FFMIN = MIN(FFMIN,FF)
      FFMAX = MAX(FFMAX,FF)

      RETURN
      END
C
      SUBROUTINE SLCOUP(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,
     +                  NUMEIG,EIG,TOL,IFLAG,ICPFUN,CPFUN,NCA,NCB,ALFA,
     +                  K11,K12,K21,K22)
C
C     This routine is for the sole purpose of making it as simple as
C     possible to obtain the eigenvalues and eigenfunctions of a
C     Sturm-Liouville problem with coupled boundary conditions.
C
C  INPUT QUANTITIES: A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,
C                    NUMEIG,EIG,TOL,ICPFUN,CPFUN,NCA,NCB,ALFA,
C                    K11,K12,K21,K22
C  OUTPUT QUANTITIES: EIG,TOL,CPFUN
C
C     The differential equation is of the form
C
C       -(p(x)*y'(x))' + q(x)*y(x) = eig*w(x)*y(x)  on (a,b)
C
C     with user-supplied coefficient functions p, q, and w,
C     and the coupled boundary conditions are of the form
C
C        Yb = exp(-i*alfa)*Ya,
C
C     where
C              (  y(b)
C        Yb =  (             if b is Regular,
C              (py'(b)
C
C              (  [y,U](b)
C        Yb =  (             if b is Limit Circle.
C              (  [y,V](b)
C
C              (  k11*y(a) + k12*py'(a)
C        Ya =  (                         if a is Regular,
C              (  k21*y(a) + k22*py'(a)
C
C              (  k11*[y,u](a) + k12*[y,v](a)
C        Ya =  (                          if a is Limit Circle,
C              (  k21*[y,u](a) + k22*[y,v](a)
C
C     where alfa is any real number in [0,pi), and the
C     "boundary condition" functions u, v and/or U, V (if any)
C     are "maximal domain functions".
C     The real numbers k11, k12, k21, k22 are required to
C     satisfy the condition
C
C            k11*k22 - k12*k21 = 1
C
C     in order that the resulting eigenvalue problem be
C     Self-Adjoint.
C     Here the expression
C
C        [y,u](x)
C     represents the Wronskian
C           [y,u](x) = y(x)*pu'(x) - u(x)*py'(x).
C
C     THE INPUT ARGUMENTS A, B, INTAB, P0ATA, QFATA, P0ATB,
C     QFATB, NUMEIG, EIG, TOL, NCA, NCB
C     HAVE THE SAME MEANINGS HERE AS IN SUBROUTINE SLEIGN.
C     THE INPUT ARGUMENTS A1, A2, B1, B2 ARE THE BOUNDARY
C     CONDITION CONSTANTS, AS ARE ALFA, K11, K12, K21, K22.
C     If ICPFUN on entry to this routine is .le. 0, then no
C     eigenvalues are wanted.
C     If ICPFUN is positive, then on input the ICPFUN values in
C     CPFUN specify the x-coordinates, in ascending order, where
C     the eigenfunction values are desired, and on output
C     those x-values will have been replaced by the eigenfunction
C     values.  The x-values must be interior to the interval (A,B).
C
C     .. Scalar Arguments ..
      REAL A,A1,A2,ALFA,B,B1,B2,EIG,K11,K12,K21,K22,P0ATA,
     +                 P0ATB,QFATA,QFATB,TOL
      INTEGER ICPFUN,IFLAG,INTAB,NCA,NCB,NUMEIG
C     ..
C     .. Array Arguments ..
      REAL CPFUN(100)
C     ..
C     .. Local Scalars ..
      REAL AA,BB,TMID
      INTEGER I
C     ..
C     .. Local Arrays ..
      REAL PLOTF(1000,6),SLFUN(9),XT(1000,2)
C     ..
C     .. External Functions ..
      REAL TFROMX
      EXTERNAL TFROMX
C     ..
C     .. External Subroutines ..
      EXTERNAL PERFUN,PERIO
C     ..
C  ----------------------------------------------------------------C
C     OBTAIN THE WANTED EIGENVALUE:
C  ----------------------------------------------------------------C
      CALL PERIO(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,NUMEIG,
     +           EIG,TOL,IFLAG,SLFUN,NCA,NCB,ALFA,K11,K12,K21,K22)

C  ----------------------------------------------------------------C
      IF (ICPFUN.GT.0) THEN

C        IN THIS CASE, THE EIGENFUNCTION IS ALSO WANTED.
C        IT MUST BE COMPUTED SEPARATELY, USING PERFUN.
C
C        CONVERT VALUES OF X IN (A,B) INTO VALUES FOR T IN (-1,1):

          DO 10 I = 1,ICPFUN
              XT(9+I,2) = TFROMX(CPFUN(I))
   10     CONTINUE
C
C        AFTER THE CALL TO PERIO, THE VALUES IN SLFUN ARE T-VALUES.
          TMID = SLFUN(1)
          AA = SLFUN(2)
          BB = SLFUN(5)
          CALL PERFUN(AA,BB,TMID,NCA,NCB,K11,K12,K21,K22,EIG,ICPFUN,XT,
     +                PLOTF)

C      REPLACE THE INPUT VALUES OF X BY THE OUTPUT VALUES OF Y(X),
C      WHICH HAVE BEEN PLACED IN PLOTF BY SUBROUTINE PERFUN.
          DO 20 I = 1,ICPFUN
              CPFUN(I) = PLOTF(9+I,1)
   20     CONTINUE

      END IF
C  ----------------------------------------------------------------C
      RETURN
      END
C
      SUBROUTINE PERIO(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,
     +                 NUMEIG,EIG,TOL,IFLAG,SLFUN,NCA,NCB,ALFA,K11,K12,
     +                 K21,K22)
C     **********
C  THIS PROGRAM IS USED TO FIND THE EIGENVALUES OF PROBLEMS WITH
C  COUPLED BOUNDARY CONDITIONS, BY FINDING THE APPROPRIATE ZEROS OF
C  THE FUNCTION FF.
C  IT IS CALLED BY THE PROGRAM DRIVE, OR BY SUBROUTINE SLCOUP,
C  OR CAN BE CALLED BY ANY OTHER "DRIVER".
C
C  INPUT QUANTITIES: A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,
C                    NUMEIG,EIG,TOL,NCA,NCB,ALFA,K11,K12,K21,K22
C
C  OUTPUT QUANTITIES: EIG,TOL,IFLAG
C
C  FUNCTION FF COMPUTES THE VALUES OF THE FUNCTION
C
C             D(LAMBDA) - 2.0*COS(ALFA).
C
C  NECESSARY DATA IS SENT TO FF VIA ENCEE, ABEE,
C    AND PASS2.  THE PROGRAM RECEIVES DATA FROM FF VIA TERM.
C
C     **********
C     .. Scalars in Common ..
      REAL AA,BB,BB1,BB2,DA,DB,DMU,DNU,EPSMIN,ETAA,ETAB,
     +                 FFMAX,FFMIN,FFV,GAMMA,H11,H12,H21,H22,HPI,PI,
     +                 TMID,TRM11,TRM12,TRM21,TRM22,TWOPI
      INTEGER MCA,MCB,T21
      LOGICAL AOK,BOK,PR
C     ..
C     .. Local Scalars ..
      REAL A1D,A1N,A2D,A2N,AE,B1D,B1N,B2D,B2N,BRA,BRB,EIGLO,
     +                 EIGLOD,EIGMU,EIGNU,EIGUP,EIGUPD,HU,HV,LAMBDA,
     +                 LAMUP,ONE,PUP,PVP,RE,STEP,TMP,TOLL,TOLS,TT,U,V,
     +                 VFFMU,VFFNU,XX
      INTEGER I,J,JFLAG,KFLAG,LCASE,NTRY,NUM
      LOGICAL LL1,LL2,LL2S,LL3
C     ..
C     .. External Subroutines ..
      EXTERNAL CERRZ,DXDT,FZERO,SLEIGN,UV
C     ..
C     .. External Functions ..
      REAL FF
      EXTERNAL FF
C     ..
C     .. Common blocks ..
      COMMON /ABEE/AA,BB,TMID
      COMMON /ENCEE/AOK,BOK,MCA,MCB
      COMMON /PASS2/GAMMA,H11,H12,H21,H22,ETAA,ETAB,DA,DB
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /RNDOFF/EPSMIN
      COMMON /TERM/TRM11,TRM12,TRM21,TRM22,FFMIN,FFMAX,DMU,DNU,BB1,BB2,
     +       FFV
C     ..
C  THE FUNCTION FF(LAMBDA) HAS BEEN DEFINED SO THAT ITS
C    ZEROS ARE THE EIGENVALUES OF THE COUPLED BOUNDARY
C    CONDITION PROBLEM. BUT IN ORDER TO COMPUTE A PARTICULAR
C    EIGENVALUE, IT IS NECESSARY TO ISOLATE IT FROM ALL THE
C    OTHERS.  FOR THIS PURPOSE WE CALCULATE THE EIGENVALUES
C    OF TWO RELATED PROBLEMS WITH SEPARATED BOUNDARY
C    CONDITIONS, WHICH EIGENVALUES DEFINE AN INTERVAL
C    CONTAINING ONLY THE ONE ZERO OF FF(LAMBDA) WHICH IS
C    WANTED.
C    THE PARTICULAR RELATED PROBLEMS WHICH ARE MOST SUITABLE FOR
C    THIS PURPOSE CAN BE SELECTED BY EXAMINING THE FOUR
C    NUMBERS K11,K12,K21,K22 IN THE GIVEN COUPLED BOUNDARY
C    CONDITIONS.
C
C     .. Scalar Arguments ..
      REAL A,A1,A2,ALFA,B,B1,B2,EIG,K11,K12,K21,K22,P0ATA,
     +                 P0ATB,QFATA,QFATB,TOL
      INTEGER IFLAG,INTAB,NCA,NCB,NUMEIG
C     ..
C     .. Array Arguments ..
      REAL SLFUN(9)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,SQRT
C     ..
C     .. Local Arrays ..
      REAL FTT(5)
C     ..
      ONE = 1.0D0
      IFLAG = 1
C
      MCA = NCA
      MCB = NCB

      AOK = (INTAB.EQ.1 .OR. INTAB.EQ.2) .AND. P0ATA .LT. 0.0D0 .AND.
     +      QFATA .GT. 0.0D0
      BOK = (INTAB.EQ.1 .OR. INTAB.EQ.3) .AND. P0ATB .LT. 0.0D0 .AND.
     +      QFATB .GT. 0.0D0
C
      A1 = 1.0D0
      A2 = 0.0D0
      B1 = 1.0D0
      B2 = 0.0D0
C     THE FOLLOWING CALL TO SLEIGN SETS THE STAGE FOR INTEG.
C     THIS IS NECESSARY BECAUSE, OTHERWISE, THE USUAL
C     SAMPLING IN SLEIGN WOULD NOT TAKE PLACE.
C       (INTEG IS USED IN FUNCTION FF.)
C     BY SETTING THE CALLING ARGUMENT ISLFUN EQUAL TO -1,
C     SLEIGN RETURNS RIGHT AFTER OBTAINING THE QUANTITIES
C       AA, TMID, BB.
C
      LAMBDA = 10.D0
      TOLS = .001D0
      CALL SLEIGN(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1,A2,B1,B2,NUMEIG,
     +            LAMBDA,TOLS,KFLAG,-1,SLFUN,NCA,NCB)
C     (RETURNING FROM SLEIGN WITH ISLFUN = -1, SLFUN HAS THE
C        T-VARIABLES TMID, AA, BB.)
      TMID = SLFUN(1)
      AA = SLFUN(2)
      BB = SLFUN(5)
C
C  THE FUNCTION FF(LAMBDA) NEEDS TO HAVE THE QUANTITIES
C    BRA,DA,ETAA AND BRB,DB,ETAB FOR THIS PROBLEM, WHICH
C    ARE PASSED TO IT VIA COMMON/PASS2/ .
C  THESE WILL ALL BE = 1.0 IF THE BOUNDARY CONDITION FUNCTIONS
C  u,v AND U,V HAVE BEEN "NORMALIZED" SO THAT
C    [u,v](a) = 1 AND/OR [U,V](b) = 1.
C
      BRA = 1.0D0
      BRB = 1.0D0
      ETAA = 1.0D0
      ETAB = 1.0D0
      DA = 1.0D0
      DB = 1.0D0
      IF (NCA.EQ.3 .OR. NCA.EQ.4) THEN
          TT = AA
          CALL DXDT(TT,TMP,XX)
          CALL UV(XX,U,PUP,V,PVP,HU,HV)
          BRA = U*PVP - V*PUP
          DA = SQRT(ABS(BRA))
          ETAA = BRA/ (DA*DA)
      END IF
      IF (NCB.EQ.3 .OR. NCB.EQ.4) THEN
          TT = BB
          CALL DXDT(TT,TMP,XX)
          CALL UV(XX,U,PUP,V,PVP,HU,HV)
          BRB = U*PVP - V*PUP
          DB = SQRT(ABS(BRB))
          ETAB = BRB/ (DB*DB)
      END IF
      IF (PR) WRITE (T21,FMT=*) ' BRA,BRB = ',BRA,BRB
C
C  WE DISTINGUISH 4 CASES:
C  CASE(1): K11 .GT. 0 & K12 .LE. 0
C      (2): K11 .LT. 0 & K12 .LT. 0
C      (3): K11 .LT. 0 & K12 .GE. 0
C      (4): K11 .GT. 0 & K12 .GT. 0
C  IN CASE(1) WE HAVE
C    NU(0).LE.EIG(0).LE.NU(1),MU(1).LE.EIG(1).LE.NU(2),MU(2)...
C  IN CASE(2) WE HAVE
C    EIG(0).LE.NU(0),MU(0).LE.EIG(1).LE.NU(1),MU(1).LE.EIG(2)...
C  IN CASE(3) WE SET
C    HIJ = -KIJ & GAMMA = PI-ALFA
C    SO THAT THE HIJ ARE LIKE THE KIJ IN CASE(1).
C  IN CASE(4) WE SET
C    HIJ = -KIJ & GAMMA = PI-ALFA
C    SO THAT THE HIJ ARE LIKE THE KIJ IN CASE(2).
C  NOTICE THAT IT IS GAMMA AND THE HIJ THAT ARE
C    PASSED TO FF(LAMBDA) VIA PASS2, RATHER THAN
C    THE GIVEN ALFA AND THE KIJ.
      GAMMA = ALFA
      H11 = K11
      H12 = K12
      H21 = K21
      H22 = K22

      IF (K11.GT.0.0D0 .AND. K12.LE.0.0D0) THEN
          LCASE = 1
      ELSE IF (K11.LT.0.0D0 .AND. K12.LT.0.0D0) THEN
          LCASE = 2
      ELSE IF (K11.LT.0.0D0 .AND. K12.GE.0.0D0) THEN
          LCASE = 3
      ELSE IF (K11.GT.0.0D0 .AND. K12.GT.0.0D0) THEN
          LCASE = 4
      END IF

      IF (LCASE.EQ.3 .OR. LCASE.EQ.4) THEN
          H11 = -K11
          H12 = -K12
          H21 = -K21
          H22 = -K22
          GAMMA = PI
          IF (ALFA.NE.0.0D0) GAMMA = PI-ALFA
      END IF
      NTRY = 0
      A1N = 0.0D0
      A2N = 1.0D0
      A1D = 1.0D0
      A2D = 0.0D0
      B1N = -H21
      B2N = H11
      B1D = H22
      B2D = -H12
C
C   SETTING TOLL = 0.0 CAUSES SLEIGN TO GET THE MOST ACCURACY
C   IT IS CAPABLE OF.
      TOLL = 0.0D0
C
C  PROBLEM FOR NU:
      NUM = NUMEIG
      IF ((LCASE.EQ.2.OR.LCASE.EQ.4) .AND. NUMEIG.GE.1) NUM = NUMEIG - 1
      TOLS = TOLL
      EIGNU = 0.0D0
      CALL SLEIGN(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1N,A2N,B1N,B2N,NUM,
     +            EIGNU,TOLS,KFLAG,0,SLFUN,NCA,NCB)
      IF (PR) WRITE (T21,FMT=*) ' EIGNU,KFLAG = ',EIGNU,KFLAG
      EIGLO = EIGNU
   35 CONTINUE
      IF ((LCASE.EQ.2.OR.LCASE.EQ.4) .AND. NUMEIG.EQ.0) THEN
          NTRY = NTRY + 1
          EIGLO = EIGLO - 10.0D0
      END IF

C
C  PROBLEM FOR MU:
      NUM = NUMEIG
      IF (NCA.EQ.4 .OR. NCB.EQ.4) NUM = NUMEIG + 1
      TOLS = TOLL
      EIGMU = 0.0D0
      CALL SLEIGN(A,B,INTAB,P0ATA,QFATA,P0ATB,QFATB,A1D,A2D,B1D,B2D,NUM,
     +            EIGMU,TOLS,KFLAG,0,SLFUN,NCA,NCB)
      IF (PR) WRITE (T21,FMT=*) ' EIGMU,KFLAG = ',EIGMU,KFLAG
C
      VFFNU = FF(EIGNU)
      IF (PR) WRITE (T21,FMT=*) ' EIGNU,BB1,BB2 = ',EIGNU,BB1,BB2
      VFFMU = FF(EIGMU)
      IF (PR) WRITE (T21,FMT=*) ' EIGMU,BB1,BB2 = ',EIGMU,BB1,BB2
      IF (PR) WRITE (T21,FMT=*) ' EIGNU,VFFNU,EIGMU,VFFMU = ',EIGNU,
     +    VFFNU,EIGMU,VFFMU
C
      EIGUP = EIGMU
C
      IF (PR) WRITE (T21,FMT=*) ' EIGLO,EIGUP = ',EIGLO,EIGUP
C
      EIG = EIGLO
      LAMUP = EIGUP
      RE = EPSMIN
      AE = RE
C
C  THE WANTED EIGENVALUE IS PRESUMABLY BRACKETED BY (EIGLO,EIGUP),
C  BUT BECAUSE OF COMPUTING IMPERFECTIONS WE WILL USE A SLIGHTLY
C  LARGER BRACKET.
      EIGLOD = 0.01D0*MAX(ONE,ABS(EIGLO))
      EIGUPD = 0.01D0*MAX(ONE,ABS(EIGUP))

      EIGLO = EIGLO - EIGLOD
      EIGUP = EIGUP + EIGUPD
      IF (PR) WRITE (T21,FMT=*) ' 2,EIGLO,EIGUP = ',EIGLO,EIGUP

      EIG = EIGLO
      LAMUP = EIGUP
      LAMBDA = 0.5D0* (EIG+LAMUP)

      CALL FZERO(FF,EIG,LAMUP,LAMBDA,RE,AE,JFLAG)

C  ESTIMATE ERROR IN EIG, USING SUBROUTINE CERRZ:
      LL2S = .FALSE.
      TOL = 1.0D-1
      STEP = TOL
      DO 78 J = 1,5
          STEP = STEP* (1.0D-1)
          DO 73 I = 1,5
              TMP = EIG + (I-3)*STEP*MAX(ONE,ABS(EIG))
              FTT(I) = FF(TMP)
              WRITE (T21,FMT=*) TMP,FTT(I)
   73     CONTINUE

          CALL CERRZ(FTT,LL1,LL2,LL3)
C  LL1 = .TRUE. MEANS EIG IS SIMPLE.
C  LL2 = .TRUE. MEANS EIG IS PROBABLY DOUBLE.
          IF (LL1 .AND. LL3) THEN
              TOL = STEP
          ELSE IF (LL2 .AND. LL3) THEN
              LL2S = .TRUE.
              TOL = STEP
          ELSE
              GO TO 80
          END IF
   78 CONTINUE
   80 CONTINUE
      TOL = TOL/10.0D0
      WRITE (*,FMT=*) ' tol = ',TOL

      KFLAG = 0
      IF (EIG.GT.EIGLO .AND. EIG.LT.EIGUP) KFLAG = 1
      IF (KFLAG.EQ.1 .AND. LL2S) KFLAG = 2
      IF (PR) WRITE (T21,FMT=*) ' EIG,JFLAG,KFLAG = ',EIG,JFLAG,KFLAG
      TMP = BB1*BB2
      IF (PR) WRITE (T21,FMT=*) ' BB1*BB2 = ',TMP
C
C  KFLAG=0 MEANS WE HAVE NOT FOUND A ROOT.
C
      IF (KFLAG.EQ.0 .AND. NTRY.EQ.1) THEN
          IF (PR) WRITE (T21,FMT=*) ' FAILED ONCE WITH EIGLO =',EIGLO
          GO TO 35
      ELSE IF (KFLAG.EQ.0 .AND. NTRY.GT.1) THEN
          IFLAG = 4
          IF (PR) WRITE (T21,FMT=*) ' REQUESTED EIGENVALUE NOT FOUND. '
          IF (PR) WRITE (*,FMT=*) ' REQUESTED EIGENVALUE NOT FOUND. '
          GO TO 100
      ELSE
          IFLAG = KFLAG
      END IF
C
C  KFLAG=1 MEANS WE HAVE FOUND A ROOT IN (EIGLO,EIGUP).
C  KFLAG=2 MEANS THE ROOT MAY BE A DOUBLE.
C
C  N.B. JFLAG = 1 MEANS EIG IS WITHIN THE REQUESTED
C       ERROR TOLERANCE AND ALL IS WELL;
C       JFLAG = 2 MEANS FF(EIG) = 0 BUT INTERVAL
C       (EIG,LAMUP) MAY NOT HAVE COLLAPSED TO REQUESTED
C       SIZE AS SPECIFIED BY RE,AE.
C  SO :
      IF (KFLAG.EQ.0) TOL = 0.0D0
      IF (PR) WRITE (T21,FMT=*) ' EIGLO,EIG,EIGUP = ',EIGLO,EIG,EIGUP
C
C  NOTE THAT IF ALFA = 0 (IN THE BOUNDARY CONDITION),
C    THEN IT IS POSSIBLE THAT AN EIGENVALUE BE A DOUBLE.
C    ON THE OTHER HAND, IF ALFA .NE. 0, THEN ANY EIGEN-
C    VALUE MUST BE SIMPLE;  MOREOVER, IN THIS CASE THE
C    EIGENFUNCTION IS COMPLEX !, AND WE HAVE NO PROVISION
C    (AT THE MOMENT) FOR PLOTTING IT.  SO, IN THIS CASE,
C    WE DO NOT NEED TO PREPARE FOR PLOTTING.
C
C  NOTE THAT FACTORS DA,DB,ETAA,ETAB HAVE BEEN USED IN
C  FUNCTION FF
C    WHEN THE GIVEN MAX.DOMAIN FUNCTIONS U,V GIVEN
C         BY THE USER HAVE [U,V] = 1 -- THEN
C
C     YL = AEE*Y1L + BEE*Y2L
C    AND
C     YR = E*Y1R + F*Y2R,
C    (WHERE Y1L,Y1R,Y2L,Y2R ARE THE FUNCTIONS COMPUTED IN FF)
C    WITH
C    AEE = Y2L - K21*Y1R - K11*Y2R
C    BEE = -(Y1L - K22*Y1R - K12*Y2R).

  100 CONTINUE
C
      RETURN
      END
C
      SUBROUTINE CERRZ(FTT,LOGIC1,LOGIC2,LOGIC3)
C
C  THIS PROGRAM ATTEMPTS TO DETERMINE WHETHER OR NOT THE
C  NUMBERS IN THE ARRAY FTT ARE TOO CONTAMINATED WITH ERRORS
C  TO BE USEFUL.  IT IS CALLED BY PERIO.
C
C  INPUT QUANTITIES: FTT
C  OUTPUT QUANTITIES: LOGIC1,LOGIC2,LOGIC3
C
C  IT IS ASSUMED THAT THE NUMBERS FTT(I), I=1,5, CORRESPOND TO
C  EQUALLY SPACED ARGUMENTS IN THE INDEPENDENT VARIABLE, AND THAT
C  FTT(3) IS NEAR A SIMPLE ZERO OF THE FUNCTION, OR NEAR A
C  DOUBLE ZERO, WHERE THE FUNCTION HAS A MAXIMUM.
C  THE THREE LOGICAL VARIABLES INDICATE
C
C  LOGIC1 = .TRUE. MEANS  THERE IS A SIMPLE ZERO NEAR FTT(3),
C  LOGIC2 = .TRUE. MEANS  THERE IS A MAXIMUM NEAR FTT(3),
C  LOGIC3 = .TRUE. MEANS  THE NUMBERS IN ARRAY FTT ARE
C                         PROBABLY USEFUL.
C
C     .. Scalars in Common ..
      INTEGER T21
      LOGICAL PR
C     ..
C     .. Scalar Arguments ..
      LOGICAL LOGIC1,LOGIC2,LOGIC3
C     ..
C     .. Array Arguments ..
      REAL FTT(5)
C     ..
C     .. Local Scalars ..
      REAL TMP1,TMP2
      INTEGER I
C     ..
C     .. Local Arrays ..
      REAL D2F(3),DF(4)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,MIN
C     ..
C     Common blocks
C     .. Common blocks ..
      COMMON /PRIN/PR,T21
C     ..
      DO 10 I = 1,4
          DF(I) = FTT(I+1) - FTT(I)
   10 CONTINUE
      DO 20 I = 1,3
          D2F(I) = DF(I+1) - DF(I)
   20 CONTINUE
      LOGIC3 = (FTT(1)*FTT(2).GT.0.0D0) .AND. (FTT(4)*FTT(5).GT.0.0D0)
      LOGIC1 = LOGIC3 .AND. (FTT(1)*FTT(4).LT.0.0D0)
      LOGIC2 = LOGIC3 .AND. (FTT(1).LT.0.0D0) .AND. (FTT(4).LT.0.0D0)

C  LOGIC1 MEANS FUNCTION FTT HAS A SIMPLE ZERO NEAR FTT(3)
C  LOGIC2 MEANS FUNCTION FTT HAS A MAXIMUM NEAR FTT(3)

      LOGIC3 = (D2F(1).LT.0.0D0) .AND. (D2F(2).LT.0.0D0) .AND.
     +         (D2F(3).LT.0.0D0)
      TMP1 = MIN(ABS(D2F(1)),ABS(D2F(2)),ABS(D2F(3)))
      TMP2 = MAX(ABS(D2F(1)),ABS(D2F(2)),ABS(D2F(3)))
      LOGIC3 = LOGIC3 .AND. (TMP2/TMP1.LE.1.2D0)
      IF (PR) WRITE (T21,FMT=*) 'LOGIC1, LOGIC2, LOGIC3 = ',LOGIC1,
     +    LOGIC2,LOGIC2
      IF (PR .AND. LOGIC1) WRITE (T21,FMT=*) ' FTT HAS A SIMPLE ZERO '
      IF (PR .AND. LOGIC2) WRITE (T21,FMT=*) ' FTT HAS A MAXIMUM '

C  LOGIC3 MEANS ALL THE SECOND DIFFERENCES ARE NEGATIVE
C    AND ARE NEARLY CONSTANT.  THIS IS INTERPRETED TO MEAN
C    THAT THE FUNCTION VALUES FTT(I), I=1,5, ARE PROBABLY
C    USEFUL NUMBERS.  I.E. NOT OVERLY CONTAMINATED BY ERRORS.

      RETURN
      END
C
      SUBROUTINE MESH(EIG,TS,NN)
C  THIS PROGRAM IS CALLED FROM DRAW.
C
C  INPUT QUANTITIES: EIG
C  OUTPUT QUANTITIES: TS,NN
C
C  IT GENERATES A MESH OF POINTS IN (-1,1), TO BE USED
C    FOR PLOTTING SOLUTIONS OF THE D.EQUATION
C           -(py')' + q*y = lambda*w*y
C    ON THE TRANSFORMED INTERVAL (-1,1).  THE POINTS ARE
C    GENERALLY NOT EVENLY SPACED, BUT ARE INTENDED TO BE
C    SPACED SO THAT THEY ARE CLOSER TOGETHER WHERE THE
C    D.E. IS "TRIGONOMETRIC", AND FARTHER APART WHERE IT
C    IS "EXPONENTIAL".  THE SPACING IS BASED ON THE SIGN
C    AND SIZE OF THE QUANTITY
C            (EIG*WX - QX)/PX
C
C
C     .. Scalar Arguments ..
      REAL EIG
      INTEGER NN
C     ..
C     .. Array Arguments ..
      REAL TS(1000)
C     ..
C     .. Local Scalars ..
      REAL DELT,H,T,TM,TP
      INTEGER I,NMAX,NN1,NN2
C     ..
C     .. Local Arrays ..
      REAL TS1(1000),TS2(1000)
C     ..
C     .. External Subroutines ..
      EXTERNAL SIZEH
C     ..
      NMAX = 300
      DELT = 0.01D0

      TP = 1.0D0 - (1.0D-7)
      TM = -TP
      T = 0.0D0
      H = DELT
      DO 10 I = 1,NMAX
          IF (T.GE.TP) GO TO 15
          CALL SIZEH(EIG,T,H)
          TS1(I) = T
          IF (T.GE.TP) TS1(I) = TP
          NN1 = I
   10 CONTINUE
   15 CONTINUE
      T = 0.0D0
      H = -DELT
      DO 20 I = 1,NMAX
          IF (T.LE.TM) GO TO 25
          CALL SIZEH(EIG,T,H)
          TS2(I) = T
          IF (T.LE.TM) TS2(I) = TM
          NN2 = I
   20 CONTINUE
   25 CONTINUE
      TS1(1) = 1.0D-7
      TS2(1) = -1.0D-7
      NN = NN1 + NN1
      DO 30 I = 1,NN2
          TS(NN2-I+1) = TS2(I)
   30 CONTINUE
      DO 40 I = 1,NN1
          TS(NN2+I) = TS1(I)
   40 CONTINUE
      NN = NN1 + NN2
      RETURN
      END
C
      SUBROUTINE SIZEH(EIG,T,H)
C  INPUT QUANTITIES: EIG,T,H,HPI
C  OUTPUT QUANTITIES: T,H
C
C  N.B.  FK = 3.0 GIVES ABOUT THE "MINIMAL" NUMBER OF POINTS
C        FOR A DECENT GRAPH.  DOUBLING FK MORE OR LESS DOUBLES
C        THE NUMBER OF POINTS.
C     FK = 3.0
C     .. Scalar Arguments ..
      REAL EIG,H,T
C     ..
C     .. Scalars in Common ..
      REAL HPI,PI,TWOPI
C     ..
C     .. Local Scalars ..
      REAL DT,FK,H1,H2,PX,Q0,Q0SQ,QQ,QX,SQ,T1,TMP,WX,X,X1
C     ..
C     .. External Functions ..
      REAL P,Q,W
      EXTERNAL P,Q,W
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,MIN,SQRT
C     ..
C     .. Common blocks ..
      COMMON /PIE/PI,TWOPI,HPI
C     ..
      FK = 5.0D0
      Q0 = HPI
      Q0SQ = Q0*Q0
      CALL DXDT(T,DT,X)
      PX = P(X)
      QX = Q(X)
      WX = W(X)
      QQ = DT*DT* (EIG*WX-QX)/PX
      IF (QQ.GE.Q0SQ) THEN
          SQ = FK*SQRT(QQ)
      ELSE IF (QQ.LT.Q0SQ .AND. QQ.GE.-Q0SQ) THEN
          SQ = FK*SQRT(0.9D0*Q0SQ+0.1D0*QQ)
      ELSE
          SQ = FK*SQRT(0.8D0)*Q0
      END IF
      H1 = 1.0D0/SQ
C  DON'T LET H CHANGE TOO MUCH IN SIZE FROM THE LAST TIME.
      TMP = 2.0D0*ABS(H)
      H1 = MIN(H1,TMP)
      TMP = 0.5D0*ABS(H)
      H1 = MAX(H1,TMP)
      IF (H.LT.0.0D0) H1 = -H1
      T1 = T + H1
      CALL DXDT(T1,DT,X1)
      PX = P(X1)
      QX = Q(X1)
      WX = W(X1)
      QQ = DT*DT* (EIG*WX-QX)/PX
      IF (QQ.GE.Q0SQ) THEN
          SQ = FK*SQRT(QQ)
      ELSE IF (QQ.LT.Q0SQ .AND. QQ.GE.-Q0SQ) THEN
          SQ = FK*SQRT(0.9D0*Q0SQ+0.1D0*QQ)
      ELSE
          SQ = FK*SQRT(0.8D0)*Q0
      END IF
      H2 = 1.0D0/SQ
C  DON'T LET H CHANGE TOO MUCH IN SIZE FROM THE LAST TIME.
      TMP = 2.0D0*ABS(H)
      H2 = MIN(H2,TMP)
      TMP = 0.5D0*ABS(H)
      H2 = MAX(H2,TMP)
      IF (H.LT.0.0D0) H2 = -H2
      H = 0.5D0* (H1+H2)
      T = T + H
      RETURN
      END
C
      SUBROUTINE QPLOT(ISLFN,XT,NV,PLOTF,NF)
C     **********
C  THIS PROGRAM IS CALLED FROM "DRIVE".
C
C  INPUT QUANTITIES: ISLFN,XT,NV,PLOTF,NF
C  OUTPUT QUANTITIES: A "GRAPH"
C
C    IT IS INTENDED TO PROVIDE A ROUGH PLOT
C    OF EIGENFUNCTIONS.  IN ORDER TO BE INDEPENDENT OF
C    GRAPHICS PACKAGES, WHICH ARE EXTREMELY PLATFORM DEPENDENT,
C    IT USES ONLY THE SET OF CHARACTERS AVAILABLE ON THE USUAL
C    KEYBOARD.  RATHER THAN USING JUST ONE SYMBOL, LIKE A "."
C    OR A "x", IT USES THE SET OF SYMBOLS ".", "+", "_" (underscore),
C    AND """ (double quote).  THIS MAKES THE RESULTING "graph"
C    A LITTLE BIT SMOOTHER.
C
C    NOTE THAT THE NUMBER OF POINTS RESULTING HERE ARE NOT
C    NECESSARILY THE SAME AS THE NUMBER OF POINTS, ISLFUN,
C    IN THE INPUT, XT.  HERE, THERE WILL BE 75, ONE FOR EACH
C    COLUMN OF A TYPEWRITTEN PAGE (NOT COUNTING THE MARGIN).
C    IF ISLFUN IS LESS THAN 75, OR IF THE GIVEN X-COORDS. ARE
C    NOT UNIFORMLY SPACED, THE SCHEME HERE WILL "INTERPOLATE"
C    TO GET ONE POINT FOR EACH COLUMN.
C     **********
C     .. Parameters ..
      INTEGER NMAX,MMAX
      PARAMETER (NMAX=75,MMAX=22)
C     ..
C     .. Local Scalars ..
      REAL DZ,ONE,REM,X,XK,XKP,XMAX,XMIN,Y,YK,YKP,YMAX,YMIN
      INTEGER I,II,IZ,J,K,L
C     ..
C     .. Local Arrays ..
      REAL A(1000,2)
      CHARACTER AX(NMAX,MMAX)
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,INT,MAX,MIN
C     ..
C     .. Scalar Arguments ..
      INTEGER ISLFN,NF,NV
C     ..
C     .. Array Arguments ..
      REAL PLOTF(1000,6),XT(1000,2)
C     ..
      ONE = 1.0D0
C  FIRST, DETERMINE SCALING FACTORS FOR THE X-COORDS.
C    AND FOR THE Y-CORRDS.
      XMAX = -1000000.D0
      XMIN = 1000000.D0
      YMAX = -1000000.D0
      YMIN = 1000000.D0
      DZ = YMIN
      DO 10 I = 1,ISLFN
          X = XT(9+I,NV)
          Y = PLOTF(9+I,NF)
          XMAX = MAX(XMAX,X)
          XMIN = MIN(XMIN,X)
          YMAX = MAX(YMAX,Y)
          YMIN = MIN(YMIN,Y)
          A(I,1) = X
          A(I,2) = Y
          IF (ABS(Y).LT.DZ) THEN
              DZ = ABS(Y)
              IZ = I
          END IF
   10 CONTINUE
C  IZ IS THE INDEX FOR WHICH DZ = ABS(Y) IS LEAST.
C
      IF (YMIN*YMAX.LE.0.0D0) THEN
          Y = MAX(ONE,YMAX-YMIN)
      ELSE
          Y = MAX(ONE,ABS(YMIN),ABS(YMAX))
      END IF
C  RESCALE THE Y-COORDS.
      DO 20 I = 1,ISLFN
          A(I,2) = A(I,2)/Y
   20 CONTINUE
      YMAX = YMAX/Y
      YMIN = YMIN/Y
C
C  SHIFT BOTH COORDS. SO THAT THEIR MINIMA ARE EQUAL TO 0.0
      DO 30 I = 1,ISLFN
          A(I,1) = A(I,1) - XMIN
          A(I,2) = A(I,2) - YMIN
   30 CONTINUE
C
C     NOW MIN(X) = 0. AND MIN(Y) = 0.
C
      X = XMAX - XMIN
      DO 40 I = 1,ISLFN
          A(I,1) = NMAX*A(I,1)/X
          A(I,2) = MMAX*A(I,2)
   40 CONTINUE
C
C  INITIALIZE THE ARRAY ENTRIES TO BE BLANKS.
      DO 60 J = 1,NMAX
          DO 50 K = 1,MMAX
              AX(J,K) = ' '
   50     CONTINUE
   60 CONTINUE
C
C  FOR EACH J, FIND INDEX II SUCH THAT A(II,1).LE.J-1/2
C    AND A(II+1,1).GT.J-1/2 .
      DO 80 J = 2,NMAX
          II = 0
          X = J - 0.5D0
          DO 70 I = 1,ISLFN
              IF (A(I,1).LE.X) II = I
   70     CONTINUE
C
C   POINT PK IS (XK,YK); POINT PKP IS (XKP,YKP).
C     LINE PK,PKP IS: Y-YK = (X-XK)*(YKP-YK)/(XKP-XK)
C     THIS LINE MEETS THE LINE X = J - 0.5 WHERE:
C
          XK = A(II,1)
          XKP = A(II+1,1)
          YK = A(II,2)
          YKP = A(II+1,2)
          Y = YK + (X-XK)* (YKP-YK)/ (XKP-XK)
C
C  THE CHARACTERS _ . + " , IN ORDER, ARE ASCENDING.
C  USE WHICHEVER MARK IS CLOSEST TO Y FOR THE ENTRY AX(J, )
          K = MMAX - INT(Y)
          REM = Y + (K-MMAX)
          IF (REM.LE.0.25D0) THEN
              AX(J,K) = '_'
          ELSE IF (REM.LE.0.50D0) THEN
              AX(J,K) = '.'
          ELSE IF (REM.LE.0.75D0) THEN
              AX(J,K) = '+'
          ELSE
              AX(J,K) = '"'
          END IF
   80 CONTINUE
C
C  DRAW A HORIZONTAL LINE WHICH IS EITHER THE ZERO LINE,
C    OR IS BELOW THE LOWEST POINT ON THE CURVE,
C    OR IS ABOVE THE HIGHEST POINT ON THE CURVE.

      IF (YMIN*YMAX.LT.0.0D0) THEN
          L = INT(A(IZ,2))
      ELSE IF (YMAX.GT.0.0D0) THEN
          L = 0
      ELSE
          L = 22
      END IF
      K = MMAX - L
      DO 90 J = 1,NMAX
          IF (AX(J,K).EQ.' ') AX(J,K) = '.'
   90 CONTINUE
      WRITE (*,FMT=*)
      DO 100 K = 1,MMAX
          WRITE (*,FMT='(1X,80A1)') (AX(J,K),J=1,NMAX)
  100 CONTINUE
      RETURN
      END
C
      SUBROUTINE SCREEN(AA,BB,NCA,NCB,NIVP,NEND,ISLFN,SLFN)
C  THIS PROGRAM IS CALLED FROM DRAW.
C
C  INPUT QUANTITIES: AA,BB,NCA,NCB,NIVP,NEND,ISLFN,SLFN
C  OUTPUT QUANTITIES: ISLFN,SLFN
C
C    IT TAKES THE POINTS GENERATED BY SUBROUTINE MESH
C    AND REMOVES ANY WHICH ARE LIKELY TO CAUSE TROUBLE IN
C    EITHER COMPUTING FUNCTION VALUES THERE OR ARE TOO CLOSE
C    TOGETHER FOR PLOTTING.
C
C     THE POINTS GENERATED BY MESH MAY NOT BE WITHIN THE INTERVAL
C     (AA,BB).  WE WANT TO ENSURE THAT WE USE ONLY SUCH POINTS
C     AS ARE WITHIN THE INTERVAL.
C
C     IN ADDITION, IF THE ENDPOINT IS NOT REG, WE WILL NOT TRY TO
C      PLOT POINTS WITH T.LT.-.95 OR T.GT..95 (IT COULD CAUSE TROUBLE
C      IN TRYING TO INTEGRATE FROM TOO NEAR A SINGULAR POINT). SO:

C     .. Scalar Arguments ..
      REAL AA,BB
      INTEGER ISLFN,NCA,NCB,NEND,NIVP
C     ..
C     .. Array Arguments ..
      REAL SLFN(1000,2)
C     ..
C     .. Local Scalars ..
      REAL AAM,BBM,ONE,TMP
      INTEGER I,JJ,K
      LOGICAL REGA,REGB
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,MIN
C     ..
      ONE = 1.0D0
      REGA = NCA .EQ. 1
      REGB = NCB .EQ. 1
      AAM = AA
      BBM = BB
      TMP = -0.995D0
      IF (.NOT.REGA) AAM = MAX(AA,TMP)
      TMP = 0.995D0
      IF (.NOT.REGB) BBM = MIN(BB,TMP)
      K = 0
      DO 20 I = 1,ISLFN
          IF (SLFN(9+I,1).GT.AAM .AND. SLFN(9+I,1).LT.BBM) THEN
              K = K + 1
              SLFN(9+K,1) = SLFN(9+I,1)
          END IF
   20 CONTINUE
      ISLFN = K
C
C     WE ALSO WANT TO BE SURE AN INITIAL ENDPOINT IS AA OR BB UNLESS THE
C     POINT IS LIMIT CIRCLE, AND THAT THE LAST POINT IS NOT AA OR BB.
C
C     NEAR AN OSCILLATORY ENDPOINT THE POINTS MAY BE SO CLOSE THAT WE
C     COULDN'T SEE THE ACTUAL CURVE EVEN IF WE PLOTTED IT.  SO WE WANT
C     TO REMOVE POINTS FROM THAT END UP TO WHERE THEY ARE NOT SO CLOSE.
C
      IF (NCA.EQ.4) THEN
          JJ = 0
          DO 40 I = 1,ISLFN
c             IF (ABS(SLFN(9+I,1)-SLFN(10+I,1)).LT.0.001) JJ = JJ + 1
              IF (ABS(SLFN(9+I,1)-SLFN(10+I,1)).LT.0.0001D0) JJ = JJ + 1

   40     CONTINUE
          IF (JJ.GT.0) THEN
              ISLFN = ISLFN - JJ
              DO 50 I = 1,ISLFN
                  SLFN(9+I,1) = SLFN(9+I+JJ,1)
   50         CONTINUE
          END IF
      END IF
      IF (NCB.EQ.4) THEN
          JJ = 0
          DO 60 I = ISLFN,1,-1
              IF (ABS(SLFN(9+I,1)-SLFN(8+I,1)).LT.0.001D0) JJ = JJ + 1
   60     CONTINUE
          IF (JJ.GT.0) ISLFN = ISLFN - JJ
      END IF
C
C     FINALLY, IN THE CASE OF AN INITIAL VALUE PROBLEM,
C     WE CANNOT AFFORD TO INTEGRATE TO THE OTHER END B (OR A)
C     UNLESS BOTH ENDS ARE REGULAR.

C  RECALL: NIVP=1 MEANS IVP FROM ONE END.
C          NIVP=2 MEANS IVP FROM BOTH ENDS.
C          NEND=1 MEANS INITIAL POINT A.
C          NEND=2 MEANS INITIAL POINT B.
C
      IF (NIVP.EQ.1 .AND. .NOT. (REGA.AND.REGB)) THEN
          ISLFN = ISLFN - 1
          IF (NEND.EQ.2) THEN
              DO 70 I = 1,ISLFN
                  SLFN(9+I,1) = SLFN(10+I,1)
   70         CONTINUE
          END IF
      END IF
C
      RETURN
      END
C
      SUBROUTINE RENORM(EIGV,NEND,NIVP,A1,A2,B1,B2,NCA,NCB,ISLFN,SLFN,
     +                  CCYA,CCYB,ENDA,ENDB,PERIOD)
C  THIS PROGRAM IS CALLED FROM DRAW.
C
C  INPUT QUANTITIES: EIGV,NEND,NIVP,A1,A2,B1,B2,NCA,NCB,ISLFN,SLFN,
C                    ENDA,ENDB,PERIOD
C  OUTPUT QUANTITIES: CCYA,CCYB
C
C  SLEIGN NORMALIZES THE WAVEFUNCTION TO HAVE L2-NORM 1.0, BUT FOR AN
C  INITIAL VALUE PROBLEM WE WANT TO HAVE THE VALUE (Y) AND SLOPE (P*Y')
C  (OR [Y,U] AND [Y,V]) AT THE END TO BE THOSE SPECIFIED FOR THE
C  INITIAL CONDITIONS.  SO HERE WE MUST RE-NORMALIZE FOR THIS PURPOSE.
C  N.B. A1 = ALFA2 & A2 = -ALFA1
C
C    THE RESULT OF THIS RE-NORMALIZATION IS THE PAIR OF
C    QUANTITIES CCYA AND CCYB.
C
C     THE VALUES IN THE ARRAYS TT AND YY COME FROM THE INTEGRATIONS
C     IN SUBROUTINE WR, EXCEPT WHEN THE ENDPOINT IS OSCILLATORY.

C     .. Scalar Arguments ..
      REAL A1,A2,B1,B2,CCYA,CCYB
      INTEGER ISLFN,NCA,NCB,NEND,NIVP
      LOGICAL EIGV,ENDA,ENDB,PERIOD
C     ..
C     .. Array Arguments ..
      REAL SLFN(1000,2)
C     ..
C     .. Arrays in Common ..
      REAL TT(7,2),YY(7,3,2)
      INTEGER NT(2)
C     ..
C     .. Local Scalars ..
      REAL BRYU,BRYUA,BRYUB,BRYV,BRYVA,BRYVB,DD,FZ,GEE,HU,
     +                 HV,PHI,PUP,PVP,PYPA,PYPB,RHOZ,SIG,T,THETAZ,TMP,U,
     +                 V,X,YA,YB
      INTEGER I,NPTS
      LOGICAL LCA,LCB,REGA,REGB,WREGA,WREGB
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,UV
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC COS,EXP,SIN
C     ..
C     .. Common blocks ..
      COMMON /TEMP/TT,YY,NT
C     ..
C
C  RECALL: EIGV MEANS AN EIGENFUNCTION WAS COMPUTED.
C          PERIOD MEANS COUPLED BOUNDARY CONDITIONS.
C          NIVP=1 MEANS IVP FROM ONE END.
C          NIVP=2 MEANS IVP FROM BOTH ENDS.
C          NEND=1 MEANS INITIAL POINT A.
C          NEND=2 MEANS INITIAL POINT B.
C
      REGA = NCA .EQ. 1
      REGB = NCB .EQ. 1
      WREGA = NCA .EQ. 2
      WREGB = NCB .EQ. 2
      LCA = NCA .EQ. 3 .OR. NCA .EQ. 4
      LCB = NCB .EQ. 3 .OR. NCB .EQ. 4
C
C  THE ENTRIES IN THE ARRAY TT ARE
C     TT(I,1) VALUES OF T NEAR A,
C     TT(I,2) VALUES OF T NEAR B.
C  THE ENTRIES IN THE ARRAY SLFN ARE (FOR I = 1,ISLFN):
C         SLFN(9+I,1) IS THETA(I)
C         SLFN(9+I,2) IS F(I), F = LN(RHO)
C         Y = RHO*SIN(THETA)
C       PY' = RHO*COS(THETA)
C
C  AT OR NEAR THE ENDPOINT A:
      RHOZ = 1.0D0
      CCYA = 1.0D0
      IF (.NOT.EIGV .AND. (NEND.EQ.1.OR.NIVP.EQ.2) .AND. REGA) THEN
          THETAZ = SLFN(9+1,1)
          FZ = SLFN(9+1,2)
          RHOZ = EXP(FZ)
          YA = RHOZ*SIN(THETAZ)
          PYPA = RHOZ*COS(THETAZ)
          IF (A1.EQ.0.0D0) THEN
              CCYA = -A2/YA
          ELSE IF (A2.EQ.0.0D0) THEN
              CCYA = A1/PYPA
          ELSE
              CCYA = -A2/YA
          END IF
      END IF
      ENDA = (NEND.EQ.1 .OR. NIVP.EQ.2) .AND. (LCA .OR. WREGA)
      IF ((.NOT.EIGV.OR.PERIOD) .AND. ENDA) THEN
          NPTS = 6
          IF (NCA.EQ.4) NPTS = NT(1)
          SIG = 1.0D0
          DO 110 I = 2,NPTS
              T = TT(I,1)
              PHI = YY(I,1,1)
              GEE = YY(I,3,1)
              SIG = EXP(GEE)
              IF (WREGA .AND. I.EQ.2) THEN
                  YA = SIG*SIN(PHI)
                  PYPA = SIG*COS(PHI)
                  IF (A1.EQ.0.0D0) THEN
                      CCYA = -A2/YA
                  ELSE IF (A2.EQ.0.0D0) THEN
                      CCYA = A1/PYPA
                  ELSE
                      CCYA = -A2/YA
                  END IF
              END IF
              IF (LCA) THEN
                  CALL DXDT(T,TMP,X)
                  CALL UV(X,U,PUP,V,PVP,HU,HV)
                  DD = U*PVP - V*PUP
                  BRYU = -DD*SIN(PHI)*SIG
                  BRYV = DD*COS(PHI)*SIG
                  IF (I.EQ.2) THEN
                      BRYUA = BRYU
                      BRYVA = BRYV
                      IF (A1.EQ.0.0D0) THEN
                          CCYA = -A2/BRYUA
                      ELSE IF (A2.EQ.0.0D0) THEN
                          CCYA = A1/BRYVA
                      ELSE
                          CCYA = -A2/BRYUA
                      END IF
                  END IF
                  BRYU = BRYU*CCYA
                  BRYV = BRYV*CCYA
              END IF
  110     CONTINUE
      END IF

C  AT OR NEAR THE ENDPOINT B:
      RHOZ = 1.0D0
      CCYB = 1.0D0
      IF (.NOT.EIGV .AND. (NEND.EQ.2.OR.NIVP.EQ.2) .AND. REGB) THEN
          THETAZ = SLFN(9+ISLFN,1)
          FZ = SLFN(9+ISLFN,2)
          RHOZ = EXP(FZ)
          YB = RHOZ*SIN(THETAZ)
          PYPB = RHOZ*COS(THETAZ)
          IF (B1.EQ.0.0D0) THEN
              CCYB = -B2/YB
          ELSE IF (B2.EQ.0.0D0) THEN
              CCYB = B1/PYPB
          ELSE
              CCYB = -B2/YB
          END IF
      END IF
      ENDB = (NEND.EQ.2 .OR. NIVP.EQ.2) .AND. (LCB .OR. WREGB)
      IF ((.NOT.EIGV.OR.PERIOD) .AND. ENDB) THEN
          NPTS = 6
          IF (NCB.EQ.4) NPTS = NT(2)
          SIG = 1.0D0
          DO 120 I = 2,NPTS
              T = TT(I,2)
              PHI = YY(I,1,2)
              GEE = YY(I,3,2)
              SIG = EXP(GEE)
              IF (WREGB .AND. I.EQ.2) THEN
                  YB = SIG*SIN(PHI)
                  PYPB = SIG*COS(PHI)
                  IF (B1.EQ.0.0D0) THEN
                      CCYB = -B2/YB
                  ELSE IF (B2.EQ.0.0D0) THEN
                      CCYB = B1/PYPB
                  ELSE
                      CCYB = -B2/YB
                  END IF
              END IF
              IF (LCB) THEN
                  CALL DXDT(T,TMP,X)
                  CALL UV(X,U,PUP,V,PVP,HU,HV)
                  DD = U*PVP - V*PUP
                  BRYU = -DD*SIN(PHI)*SIG
                  BRYV = DD*COS(PHI)*SIG
                  IF (I.EQ.2) THEN
                      BRYUB = BRYU
                      BRYVB = BRYV
                      IF (B1.EQ.0.0D0) THEN
                          CCYB = -B2/BRYUB
                      ELSE IF (B2.EQ.0.0D0) THEN
                          CCYB = B1/BRYVB
                      ELSE
                          CCYB = -B2/BRYUB
                      END IF
                  END IF
                  BRYU = BRYU*CCYB
                  BRYV = BRYV*CCYB
              END IF
  120     CONTINUE
      END IF
C
      ENDA = (NEND.EQ.1 .OR. NIVP.EQ.2) .AND. NCA .GE. 3
      ENDB = (NEND.EQ.2 .OR. NIVP.EQ.2) .AND. NCB .GE. 3
C
C     RENORMALIZE.
C
      IF (NCA.EQ.3) THEN
          IF (A1.EQ.0.0D0) THEN
              IF (A2.GT.0.0D0) CCYA = -CCYA
          ELSE IF (A2.EQ.0.0D0) THEN
              IF (A1.LT.0.0D0) CCYA = -CCYA
          ELSE
              IF (A2.GT.0.0D0) CCYA = -CCYA
          END IF
      END IF
      IF (NCB.EQ.3) THEN
          IF (B1.EQ.0.0D0) THEN
              IF (B2.LT.0.0D0) CCYB = -CCYB
          ELSE IF (B2.EQ.0.0D0) THEN
              IF (B1.LT.0.0D0) CCYB = -CCYB
          ELSE
              IF (B2.LT.0.0D0) CCYB = -CCYB
          END IF
      END IF
      RETURN
      END
C
      SUBROUTINE DRAW(A1,A2,B1,B2,NUMEIG,EIG,SLFUN,NIVP,NEND,EIGV,NCA,
     +                NCB,ISLFN,XT,PLOTF,K11,K12,K21,K22,PERIOD)
C     **********
C  THIS PROGRAM PROVIDES POINTS OF EITHER AN EIGENFUNCTION
C  OR THE SOLUTION OF AN INITIAL VALUE PROBLEM FOR PLOTTING.
C  IT IS CALLED FROM "DRIVE".
C
C  INPUT QUANTITIES: A1,A2,B1,B2,NUMEIG,EIG,SLFUN,NIVP,NEND,
C                    EIGV,NCA,NCB,K11,K12,K21,K22,PERIOD
C  OUTPUT QUANTITIES: ISLFN,XT,PLOTF
C
C  IT FIRST OBTAINS A SET OF MESH POINTS T IN (-1,1)
C  WHICH ARE DEEMED SUITABLE FOR PLOTTING THE FUNCTION
C  WANTED, AND THEN OBTAINS THE VALUES OF THE FUNCTION AT
C  THOSE POINTS.  THE RESULTS FOR PLOTTING ARE STORED IN
C  ARRAYS XT AND PLOTF.
C     .. Scalars in Common ..
      REAL AA,BB,DTHDAA,DTHDBB,EIGSAV,HPI,PI,TMID,TWOPI
      INTEGER IND,MDTHZ,T21
      LOGICAL ADDD,PR
C     ..
C     .. Local Scalars ..
      REAL AXJMP,BRYU,BRYV,CCY,CCYA,CCYB,FZ,HUI,HVI,PUPI,
     +                 PVPI,PYP,RHO,RHOZ,TH,THETAZ,TI,TMP,UI,VI,XI,XJMP,
     +                 XJMPS,Y
      INTEGER I,JJ,KFLAG,MM
      LOGICAL ENDA,ENDB,LCOA,LCOB,REGA,REGB
C     ..
C     .. Local Arrays ..
      REAL SLFN(1000,2)
C     ..
C     .. External Subroutines ..
      EXTERNAL DXDT,EIGENF,MESH,PERFUN,RENORM,SCREEN,UV
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,COS,EXP,INT,SIN,SQRT
C     ..
C     .. Common blocks ..
C
      COMMON /DATAF/EIGSAV,IND
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /TDATA/AA,TMID,BB,DTHDAA,DTHDBB,MDTHZ,ADDD
C     ..
C     DEFINITION OF SOME LOGICALS.
C
C     .. Scalar Arguments ..
      REAL A1,A2,B1,B2,EIG,K11,K12,K21,K22
      INTEGER ISLFN,NCA,NCB,NEND,NIVP,NUMEIG
      LOGICAL EIGV,PERIOD
C     ..
C     .. Array Arguments ..
      REAL PLOTF(1000,6),SLFUN(9),XT(1000,2)
C     ..
      REGA = NCA .EQ. 1
      REGB = NCB .EQ. 1
      LCOA = NCA .EQ. 4
      LCOB = NCB .EQ. 4
C
C     NV = 1 MEANS THE INDEPENDENT VARIABLE IS X.
C     NV = 2 MEANS THE INDEPENDENT VARIABLE IS T.
C
C     NF = 1 MEANS THE EIGENFUNCTION Y IS WANTED.
C     NF = 2 MEANS THE QUASI-DERIVATIVE P*Y' IS WANTED.
C     NF = 3 MEANS BOUNDARY CONDITION FUNCTION Y OR [Y,U] IS WANTED.
C     NF = 4 MEANS BOUNDARY CONDITION FUNCTION P*Y' OR [Y,V] IS WANTED.
C     NF = 5 MEANS THE PRUFER ANGLE THETA IS WANTED.
C     NF = 6 MEANS THE PRUFER MODULUS RHO IS WANTED.
C
C     IF AN EIGENVALUE HAS BEEN COMPUTED (EIGV = .TRUE.),
C     THE RELEVANT VALUES HAVE BEEN STORED IN ARRAY SLFUN, AND
C     NEED TO BE COPIED INTO THE FIRST COLUMN OF ARRAY SLFN.
C
C  THE FIRST 9 POSITIONS IN SLFUN() ARE RESERVED FOR
C  INITIAL DATA.  THEY ARE NOT USED FOR EIGENFUNCTION VALUES.
C
      IF (PR) WRITE (T21,FMT=*) ' SLFUN = '
      DO 10 I = 1,9
          SLFN(I,1) = SLFUN(I)
          IF (PR) WRITE (T21,FMT=*) SLFUN(I)
   10 CONTINUE

C ---------------------------------------------------------C
C
      CALL MESH(EIG,SLFN(10,1),ISLFN)
C
C     THE POINTS GENERATED BY MESH MAY NOT BE WITHIN THE INTERVAL
C     (AA,BB).  WE WANT TO ENSURE THAT WE USE ONLY SUCH POINTS
C     AS ARE WITHIN THE INTERVAL.
C
C     IN ADDITION, IF THE ENDPOINT IS NOT REG, WE WILL NOT TRY TO
C     PLOT POINTS WITH T.LT.-.95 OR T.GT..95 (IT COULD CAUSE TROUBLE
C     IN TRYING TO INTEGRATE FROM TOO NEAR A SINGULAR POINT).
C     SUBROUTINE SCREEN REMOVES POINTS GENERATED BY SUBROUTINE
C     MESH WHICH PROBABLY WOULD BE A PROBLEM.
C
C
      CALL SCREEN(AA,BB,NCA,NCB,NIVP,NEND,ISLFN,SLFN)
C
C  THE ENTRIES IN SLFN(9+I,1) INITIALLY ARE THE POINTS T IN (-1,1)
C     WHERE THE FUNCTION IS TO BE EVALUATED.
C
      DO 80 I = 1,ISLFN
          XT(9+I,2) = SLFN(9+I,1)
          IF (PR) WRITE (T21,FMT=*) ' I,XT = ',I,XT(9+I,2)
   80 CONTINUE
C
C     WARNING: THE VALUES RETURNED IN SLFN BY EIGENF DEPEND
C              ON THE VALUE OF KFLAG IN THE CALL TO EIGENF:
C
C              IF KFLAG = 1, THE VALUES IN SLFN(9+I,1) ARE THE
C                            EIGENFUNCTION Y ITSELF.
C
C              IF KFLAG = 2, THE VALUES IN THE TWO COLUMNS OF SLFN ARE
C                               SLFN(9+I,1) = THETA(9+I)
C                               SLFN(9+I,2) = EFF(9+I)
C                     WHERE
C                               RHO  = EXP(EFF)
C                                Y   = RHO*SIN(THETA)
C                               P*Y' = RHO*COS(THETA)*Z
C
C     HERE, WE SET KFLAG = 2 SO THAT EIGENF WILL RETURN EFF, ENABLING
C     US TO DEAL WITH IT BEFORE FORMING THE FUNCTION Y = RHO*SIN .
C
      KFLAG = 2
      EIGSAV = EIG

c     IF(PR)WRITE(T21,*) ' A1,A2,B1,B2 = ',A1,A2,B1,B2
c     IF(PR)WRITE(T21,*) ' REGA,NCA,REGB,NCB = ',REGA,NCA,REGB,NCB
c     IF(PR)WRITE(T21,*) ' ISLFN,KFLAG,EIGSAV = ',ISLFN,KFLAG,EIGSAV
c     IF(PR)WRITE(T21,*) ' THA,THB = ',SLFN(3,1),SLFN(6,1)


      IF (PERIOD) THEN
          CALL PERFUN(AA,BB,TMID,NCA,NCB,K11,K12,K21,K22,EIG,ISLFN,XT,
     +                PLOTF)

      ELSE
          CALL EIGENF(NUMEIG,A1,A2,B1,B2,REGA,NCA,REGB,NCB,SLFN,ISLFN,
     +                KFLAG)

          DO 113 I = 1,ISLFN
              IF (PR) WRITE (T21,FMT=*) I,SLFN(9+I,1),SLFN(9+I,2)
  113     CONTINUE
C
C     IT MAY HAPPEN THAT THETA(I) HAS A JUMP OF MM*PI AT TMID.
C     IN THIS CASE, WE NEED TO SUBTRACT MM*PI FROM THETA(I).
C

          IF (EIGV .AND. (LCOA.OR.LCOB)) THEN
              JJ = 0
              XJMPS = 2.5D0
              DO 90 I = 1,ISLFN - 1
                  XJMP = SLFN(10+I,1) - SLFN(9+I,1)
                  IF (ABS(XJMP).GT.XJMPS) THEN
                      XJMPS = ABS(XJMP)
                      JJ = I
                  END IF
   90         CONTINUE
              IF (JJ.NE.0) THEN
                  XJMP = SLFN(10+JJ,1) - SLFN(9+JJ,1)
                  AXJMP = ABS(XJMP)
                  MM = INT(AXJMP/PI)
                  IF (AXJMP-MM*PI.GT.HPI) MM = MM + 1
                  IF (XJMP.LT.0.0D0) MM = -MM
                  DO 100 I = JJ,ISLFN - 1
                      SLFN(10+I,1) = SLFN(10+I,1) - MM*PI
  100             CONTINUE
              END IF
          END IF
C
C  SLEIGN NORMALIZES THE WAVEFUNCTION TO HAVE L2-NORM 1.0, BUT FOR AN
C  INITIAL VALUE PROBLEM WE WANT TO HAVE THE VALUE (Y) AND SLOPE (P*Y')
C  (OR [Y,U] AND [Y,V]) AT THE END TO BE THOSE SPECIFIED FOR THE
C  INITIAL CONDITIONS.  SO HERE WE MUST RE-NORMALIZE FOR THIS PURPOSE.
C  N.B. A1 = ALFA2 & A2 = -ALFA1

          CALL RENORM(EIGV,NEND,NIVP,A1,A2,B1,B2,NCA,NCB,ISLFN,SLFN,
     +                CCYA,CCYB,ENDA,ENDB,PERIOD)

C  THE MAIN OUTPUT OF SUBROUTINE RENORM IS THE QUANTITIES
C    CCYA AND CCYB.

          CCY = 1.0D0
          DO 140 I = 1,ISLFN
              TI = XT(9+I,2)
              IF (.NOT.EIGV) THEN
                  IF (TI.LE.TMID) THEN
                      CCY = CCYA
                  ELSE
                      CCY = CCYB
                  END IF
              END IF

              CALL DXDT(TI,TMP,XI)
              XT(9+I,1) = XI
              THETAZ = SLFN(9+I,1)
              FZ = SLFN(9+I,2)
              RHOZ = EXP(FZ)
              Y = RHOZ*SIN(THETAZ)
              PYP = RHOZ*COS(THETAZ)
              Y = Y*CCY
              PYP = PYP*CCY
              RHO = SQRT(Y**2+PYP**2)
              IF ((.NOT.ENDA.AND.TI.LE.TMID) .OR.
     +            (.NOT.ENDB.AND.TI.GT.TMID)) THEN
              END IF
              PLOTF(9+I,1) = Y
              PLOTF(9+I,2) = PYP
              PLOTF(9+I,3) = Y
              PLOTF(9+I,4) = PYP
              TH = THETAZ
              PLOTF(9+I,5) = TH
              PLOTF(9+I,6) = RHO
C
              IF ((ENDA.AND.TI.LE.TMID) .OR. (ENDB.AND.TI.GT.TMID)) THEN
                  CALL UV(XI,UI,PUPI,VI,PVPI,HUI,HVI)
                  BRYU = PUPI*Y - PYP*UI
                  BRYV = PVPI*Y - PYP*VI
C
                  PLOTF(9+I,3) = BRYU
                  PLOTF(9+I,4) = BRYV
              END IF
  140     CONTINUE

C
C        IN THE CASE OF NIVP = 2  WE HAVE COMPUTED
C        THE SOLUTIONS TO TWO INITIAL VALUE PROBLEMS.
C        FROM THE TWO ENDS.  IF (.NOT.ENDA .AND. .NOT.ENDB)
C        WE SHOULD NOW HAVE
C
C        Y(A) = -A2 (ALFA1)  ;  Y(B) = -B2 (BETA1)
C        PY'(A) = A1 (ALFA2)  ;  PY'(B) = B1 (BETA2)
C
C  ------------------------------------------------------C
      END IF

      RETURN
      END
C
      SUBROUTINE EIGENF(NUMEIG,A1,A2,B1,B2,AOK,NCA,BOK,NCB,SLFN,ISLFN,
     +                  KFLAG)
C     **********
C  THIS PROGRAM CALCULATES SELECTED EIGENFUNCTION VALUES BY
C  INTEGRATION (OVER T IN (-1,1)).  IT IS CALLED FROM DRAW.
C
C  INPUT QUANTITIES: NUMEIG,A1,A2,B1,B2,AOK,NCA,BOK,NCB,SLFN,ISLFN,
C                    KFLAG,AA,TMID,BB,DTHDAA,DTHDBB
C  OUTPUT QUANTITIES: SLFN
C
C  N.B.: IT IS ASSUMED THAT THE POINTS T (=SLFN(9+I,1)) IN THE ARRAY
C     SLFN ALL LIE WITHIN THE INTERVAL (AA,BB).
C
C     WARNING:  THE ARRAY SLFN HERE IS TWO-DIMENSIONAL,
C            WHEREAS IT IS ONE-DIMENSIONAL IN SUBROUTINE SLEIGN.
C     **********
C     .. Scalars in Common ..
      REAL AA,BB,DTHDAA,DTHDBB,HPI,PI,TMID,TSAVEL,TSAVER,
     +                 TWOPI,Z
      INTEGER ISAVE,MDTHZ,T21
      LOGICAL ADDD,PR
C     ..
C     .. Local Scalars ..
      REAL DTHDAT,DTHDBT,DTHDET,EFF,EIGPI,T,THT,TM
      INTEGER I,IFLAG,J,NC,NMID
      LOGICAL LCOA,LCOB,OK
C     ..
C     .. Local Arrays ..
      REAL ERL(3),ERR(3),YL(3),YR(3)
C     ..
C     .. External Subroutines ..
      EXTERNAL INTEG
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC EXP,SIN
C     ..
C     .. Common blocks ..
      COMMON /PIE/PI,TWOPI,HPI
      COMMON /PRIN/PR,T21
      COMMON /TDATA/AA,TMID,BB,DTHDAA,DTHDBB,MDTHZ,ADDD
      COMMON /TSAVE/TSAVEL,TSAVER,ISAVE
      COMMON /Z1/Z
C     ..
C
C     .. Scalar Arguments ..
      REAL A1,A2,B1,B2
      INTEGER ISLFN,KFLAG,NCA,NCB,NUMEIG
      LOGICAL AOK,BOK
C     ..
C     .. Array Arguments ..
      REAL SLFN(1000,2)
C     ..
      Z = 1.0D0
      EIGPI = NUMEIG*PI
      NMID = 0
      DO 10 I = 1,ISLFN
          IF (SLFN(9+I,1).LE.TMID) NMID = I
   10 CONTINUE
      IF (NMID.GT.0) THEN
          LCOA = NCA .EQ. 4
          T = AA
          YL(1) = SLFN(3,1)
          YL(2) = 0.0D0
          YL(3) = 0.0D0
          OK = AOK
          NC = NCA
          EFF = 0.0D0
          DO 20 J = 1,NMID
              TM = SLFN(J+9,1)
              IF (TM.LT.AA .OR. TM.GT.BB) THEN
                  IF (PR) WRITE (*,FMT=*) ' T.LT.AA .OR. T.GT.BB '
                  STOP
              END IF
              THT = YL(1)
              DTHDAT = DTHDAA*EXP(-2.0D0*EFF)
              DTHDET = YL(2)
              IF (TM.GT.AA) THEN
                  ISAVE = 0
                  CALL INTEG(T,THT,DTHDAT,DTHDET,TM,A1,A2,SLFN(8,1),YL,
     +                       ERL,OK,NC,IFLAG)
                  IF (NC.EQ.4) THEN
                      EFF = YL(3)
                  ELSE
                      NC = 1
                      OK = .TRUE.
                      EFF = EFF + YL(3)
                  END IF
              END IF
              IF (KFLAG.EQ.1) THEN
                  SLFN(J+9,1) = SIN(YL(1))*EXP(EFF+SLFN(4,1))
              ELSE
                  SLFN(J+9,1) = YL(1)
                  SLFN(J+9,2) = EFF + SLFN(4,1)
              END IF
              T = TM
              IF (T.GT.-1.0D0) THEN
                  OK = .TRUE.
                  NC = 1
              END IF
              IF (T.LT.-0.9D0 .AND. LCOA) THEN
C  IN THIS CASE, INTEGRATE FROM AA AGAIN, AS AN OSC PROBLEM.
                  NC = 4
                  OK = .FALSE.
                  T = AA
                  YL(1) = SLFN(3,1)
                  YL(2) = 0.0D0
                  YL(3) = 0.0D0
              END IF
   20     CONTINUE
      END IF
      EFF = 0.0D0
      IF (NMID.LT.ISLFN) THEN
          LCOB = NCB .EQ. 4
          T = BB
          YR(1) = SLFN(6,1) - EIGPI
          YR(2) = 0.0D0
          YR(3) = 0.0D0
          OK = BOK
          NC = NCB
          EFF = 0.0D0
          DO 30 J = ISLFN,NMID + 1,-1
              TM = SLFN(J+9,1)
              IF (TM.LT.AA .OR. TM.GT.BB) THEN
                  IF (PR) WRITE (*,FMT=*) ' T.LT.AA .OR. T.GT.BB '
                  STOP
              END IF
              THT = YR(1)
              DTHDBT = DTHDBB*EXP(-2.0D0*EFF)
              DTHDET = YR(2)
              IF (TM.LT.BB) THEN
                  ISAVE = 0
                  CALL INTEG(T,THT,DTHDBT,DTHDET,TM,B1,B2,SLFN(8,1),YR,
     +                       ERR,OK,NC,IFLAG)
                  IF (NC.EQ.4) THEN
                      EFF = YR(3)
                  ELSE
                      NC = 1
                      OK = .TRUE.
                      EFF = EFF + YR(3)
                  END IF
              END IF
              IF (KFLAG.EQ.1) THEN
                  SLFN(J+9,1) = SIN(YR(1)+EIGPI)*EXP(EFF+SLFN(7,1))
              ELSE
                  SLFN(J+9,1) = YR(1) + EIGPI
                  SLFN(J+9,2) = EFF + SLFN(7,1)
              END IF
              T = TM
              IF (T.LT.1.0D0) THEN
                  OK = .TRUE.
                  NC = 1
              END IF
              IF (T.GT.0.9D0 .AND. LCOB) THEN
C  IN THIS CASE, INTEGRATE FROM BB AGAIN, AS AN OSC PROBLEM.
                  NC = 4
                  OK = .FALSE.
                  T = BB
                  YR(1) = SLFN(6,1) - EIGPI
                  YR(2) = 0.0D0
                  YR(3) = 0.0D0
              END IF
   30     CONTINUE
      END IF
      RETURN
      END
C
      SUBROUTINE GERK(F,NEQN,Y,T,TOUT,RELERR,ABSERR,IFLAG,GERROR,WORK,
     +                IWORK)
C
C     FEHLBERG FOURTH(FIFTH) ORDER RUNGE-KUTTA METHOD WITH
C     GLOBAL ERROR ASSESSMENT
C
C     WRITTEN BY H.A.WATTS AND L.F.SHAMPINE
C                   SANDIA LABORATORIES
C
C    GERK IS DESIGNED TO SOLVE SYSTEMS OF DIFFERENTIAL EQUATIONS
C    WHEN IT IS IMPORTANT TO HAVE A READILY AVAILABLE GLOBAL ERROR
C    ESTIMATE.  PARALLEL INTEGRATION IS PERFORMED TO YIELD TWO
C    SOLUTIONS ON DIFFERENT MESH SPACINGS AND GLOBAL EXTRAPOLATION
C    IS APPLIED TO PROVIDE AN ESTIMATE OF THE GLOBAL ERROR IN THE
C    MORE ACCURATE SOLUTION.
C
C    FOR IBM SYSTEM 360 AND 370 AND OTHER MACHINES OF SIMILAR
C    ARITHMETIC CHARACTERISTICS, THIS CODE SHOULD BE CONVERTED TO
C    REAL.
C
C*******************************************************************
C ABSTRACT
C*******************************************************************
C
C    SUBROUTINE  GERK  INTEGRATES A SYSTEM OF NEQN FIRST ORDER
C    ORDINARY DIFFERENTIAL EQUATIONS OF THE FORM
C             DY(I)/DT = F(T,Y(1),Y(2),...,Y(NEQN))
C              WHERE THE Y(I) ARE GIVEN AT T .
C    TYPICALLY THE SUBROUTINE IS USED TO INTEGRATE FROM T TO TOUT
C    BUT IT CAN BE USED AS A ONE-STEP INTEGRATOR TO ADVANCE THE
C    SOLUTION A SINGLE STEP IN THE DIRECTION OF TOUT. ON RETURN, AN
C    ESTIMATE OF THE GLOBAL ERROR IN THE SOLUTION AT T IS PROVIDED
C    AND THE PARAMETERS IN THE CALL LIST ARE SET FOR CONTINUING THE
C    INTEGRATION. THE USER HAS ONLY TO CALL GERK AGAIN (AND PERHAPS
C    DEFINE A NEW VALUE FOR TOUT). ACTUALLY, GERK  IS MERELY AN
C    INTERFACING ROUTINE WHICH ALLOCATES VIRTUAL STORAGE IN THE
C    ARRAYS WORK, IWORK AND CALLS SUBROUTINE GERKS FOR THE SOLUTION.
C    GERKS IN TURN CALLS SUBROUTINE FEHL WHICH COMPUTES AN APPROX-
C    IMATE SOLUTION OVER ONE STEP.
C
C    GERK  USES THE RUNGE-KUTTA-FEHLBERG (4,5)  METHOD DESCRIBED
C    IN THE REFERENCE
C    E.FEHLBERG , LOW-ORDER CLASSICAL RUNGE-KUTTA FORMULAS WITH
C                 STEPSIZE CONTROL , NASA TR R-315
C
C
C    THE PARAMETERS REPRESENT-
C      F -- SUBROUTINE F(T,Y,YP) TO EVALUATE DERIVATIVES
C           YP(I)=DY(I)/DT
C      NEQN -- NUMBER OF EQUATIONS TO BE INTEGRATED
C      Y(*) -- SOLUTION VECTOR AT T
C      T -- INDEPENDENT VARIABLE
C      TOUT -- OUTPUT POINT AT WHICH SOLUTION IS DESIRED
C      RELERR,ABSERR -- RELATIVE AND ABSOLUTE ERROR TOLERANCES FOR
C            LOCAL ERROR TEST. AT EACH STEP THE CODE REQUIRES THAT
C                 ABS(LOCAL ERROR) .LE. RELERR*ABS(Y) + ABSERR
C            FOR EACH COMPONENT OF THE LOCAL ERROR AND SOLUTION
C            VECTORS.
C      IFLAG -- INDICATOR FOR STATUS OF INTEGRATION
C      GERROR(*) -- VECTOR WHICH ESTIMATES THE GLOBAL ERROR AT T.
C                   THAT IS, GERROR(I) APPROXIMATES  Y(I)-TRUE
C                   SOLUTION(I).
C      WORK(*) -- ARRAY TO HOLD INFORMATION INTERNAL TO GERK WHICH
C            IS NECESSARY FOR SUBSEQUENT CALLS. MUST BE DIMENSIONED
C            AT LEAST  3+8*NEQN
C      IWORK(*) -- INTEGER ARRAY USED TO HOLD INFORMATION INTERNAL
C            TO GERK WHICH IS NECESSARY FOR SUBSEQUENT CALLS. MUST
C            BE DIMENSIONED AT LEAST  5
C
C
C*******************************************************************
C  FIRST CALL TO GERK
C*******************************************************************
C
C    THE USER MUST PROVIDE STORAGE IN HIS CALLING PROGRAM FOR THE
C    ARRAYS IN THE CALL LIST  -   Y(NEQN), WORK(3+8*NEQN), IWORK(5),
C    DECLARE F IN AN EXTERNAL STATEMENT, SUPPLY SUBROUTINE F(T,Y,YP)
C    AND INITIALIZE THE FOLLOWING PARAMETERS-
C
C      NEQN -- NUMBER OF EQUATIONS TO BE INTEGRATED.  (NEQN .GE. 1)
C      Y(*) -- VECTOR OF INITIAL CONDITIONS
C      T -- STARTING POINT OF INTEGRATION , MUST BE A VARIABLE
C      TOUT -- OUTPUT POINT AT WHICH SOLUTION IS DESIRED.
C            T=TOUT IS ALLOWED ON THE FIRST CALL ONLY,IN WHICH CASE
C            GERK RETURNS WITH IFLAG=2 IF CONTINUATION IS POSSIBLE.
C      RELERR,ABSERR -- RELATIVE AND ABSOLUTE LOCAL ERROR TOLERANCES
C            WHICH MUST BE NON-NEGATIVE BUT MAY BE CONSTANTS. WE CAN
C            USUALLY EXPECT THE GLOBAL ERRORS TO BE SOMEWHAT SMALLER
C            THAN THE REQUESTED LOCAL ERROR TOLERANCES. TO AVOID
C            LIMITING PRECISION DIFFICULTIES THE CODE ALWAYS USES
C            THE LARGER OF RELERR AND AN INTERNAL RELATIVE ERROR
C            PARAMETER WHICH IS MACHINE DEPENDENT.
C      IFLAG -- +1,-1  INDICATOR TO INITIALIZE THE CODE FOR EACH NEW
C            PROBLEM. NORMAL INPUT IS +1. THE USER SHOULD SET IFLAG=
C            -1 ONLY WHEN ONE-STEP INTEGRATOR CONTROL IS ESSENTIAL.
C            IN THIS CASE, GERK ATTEMPTS TO ADVANCE THE SOLUTION A
C            SINGLE STEP IN THE DIRECTION OF TOUT EACH TIME IT IS
C            CALLED. SINCE THIS MODE OF OPERATION RESULTS IN EXTRA
C            COMPUTING OVERHEAD, IT SHOULD BE AVOIDED UNLESS NEEDED.
C
C
C*******************************************************************
C  OUTPUT FROM GERK
C*******************************************************************
C
C      Y(*) -- SOLUTION AT T
C      T -- LAST POINT REACHED IN INTEGRATION.
C      IFLAG = 2 -- INTEGRATION REACHED TOUT.  INDICATES SUCCESSFUL
C                   RETURN AND IS THE NORMAL MODE FOR CONTINUING
C                   INTEGRATION.
C            =-2 -- A SINGLE SUCCESSFUL STEP IN THE DIRECTION OF
C                   TOUT HAS BEEN TAKEN. NORMAL MODE FOR CONTINUING
C                   INTEGRATION ONE STEP AT A TIME.
C            = 3 -- INTEGRATION WAS NOT COMPLETED BECAUSE MORE THAN
C                   9000 DERIVATIVE EVALUATIONS WERE NEEDED. THIS
C                   IS APPROXIMATELY 500 STEPS.
C            = 4 -- INTEGRATION WAS NOT COMPLETED BECAUSE SOLUTION
C                   VANISHED MAKING A PURE RELATIVE ERROR TEST
C                   IMPOSSIBLE. MUST USE NON-ZERO ABSERR TO CONTINUE.
C                   USING THE ONE-STEP INTEGRATION MODE FOR ONE STEP
C                   IS A GOOD WAY TO PROCEED.
C            = 5 -- INTEGRATION WAS NOT COMPLETED BECAUSE REQUESTED
C                   ACCURACY COULD NOT BE ACHIEVED USING SMALLEST
C                   ALLOWABLE STEPSIZE. USER MUST INCREASE THE ERROR
C                   TOLERANCE BEFORE CONTINUED INTEGRATION CAN BE
C                   ATTEMPTED.
C            = 6 -- GERK IS BEING USED INEFFICIENTLY IN SOLVING
C                   THIS PROBLEM. TOO MUCH OUTPUT IS RESTRICTING THE
C                   NATURAL STEPSIZE CHOICE. USE THE ONE-STEP
C                   INTEGRATOR MODE.
C            = 7 -- INVALID INPUT PARAMETERS
C                   THIS INDICATOR OCCURS IF ANY OF THE FOLLOWING IS
C                   SATISFIED - NEQN .LE. 0
C                               T=TOUT  AND  IFLAG .NE. +1 OR -1
C                               RELERR OR ABSERR .LT. 0.
C                               IFLAG .EQ. 0 OR .LT. -2 OR .GT. 7
C      GERROR(*) -- ESTIMATE OF THE GLOBAL ERROR IN THE SOLUTION AT T
C      WORK(*),IWORK(*) -- INFORMATION WHICH IS USUALLY OF NO
C                   INTEREST TO THE USER BUT NECESSARY FOR SUBSEQUENT
C                   CALLS.  WORK(1),...,WORK(NEQN) CONTAIN THE FIRST
C                   DERIVATIVES OF THE SOLUTION VECTOR Y AT T.
C                   WORK(NEQN+1) CONTAINS THE STEPSIZE H TO BE
C                   ATTEMPTED ON THE NEXT STEP.  IWORK(1) CONTAINS
C                   THE DERIVATIVE EVALUATION COUNTER.
C
C
C*******************************************************************
C  SUBSEQUENT CALLS TO GERK
C*******************************************************************
C
C    SUBROUTINE GERK RETURNS WITH ALL INFORMATION NEEDED TO CONTINUE
C    THE INTEGRATION. IF THE INTEGRATION REACHED TOUT, THE USER NEED
C    ONLY DEFINE A NEW TOUT AND CALL GERK AGAIN. IN THE ONE-STEP
C    INTEGRATOR MODE (IFLAG=-2) THE USER MUST KEEP IN MIND THAT EACH
C    STEP TAKEN IS IN THE DIRECTION OF THE CURRENT TOUT.  UPON
C    REACHING TOUT (INDICATED BY CHANGING IFLAG TO 2), THE USER MUST
C    THEN DEFINE A NEW TOUT AND RESET IFLAG TO -2 TO CONTINUE IN THE
C    ONE-STEP INTEGRATOR MODE.
C
C    IF THE INTEGRATION WAS NOT COMPLETED BUT THE USER STILL WANTS
C    TO CONTINUE (IFLAG=3 CASE), HE JUST CALLS GERK AGAIN.  THE
C    FUNCTION COUNTER IS THEN RESET TO 0 AND ANOTHER 9000 FUNCTION
C    EVALUATIONS ARE ALLOWED.
C
C    HOWEVER, IN THE CASE IFLAG=4, THE USER MUST FIRST ALTER THE
C    ERROR CRITERION TO USE A POSITIVE VALUE OF ABSERR BEFORE
C    INTEGRATION CAN PROCEED. IF HE DOES NOT,EXECUTION IS TERMINATED.
C
C    ALSO, IN THE CASE IFLAG=5, IT IS NECESSARY FOR THE USER TO
C    RESET IFLAG TO 2 (OR -2 WHEN THE ONE-STEP INTEGRATION MODE IS
C    BEING USED) AS WELL AS INCREASING EITHER ABSERR,RELERR OR BOTH
C    BEFORE THE INTEGRATION CAN BE CONTINUED. IF THIS IS NOT DONE,
C    EXECUTION WILL BE TERMINATED.  THE OCCURRENCE OF IFLAG=5
C    INDICATES A TROUBLE SPOT (SOLUTION IS CHANGING RAPIDLY,
C    SINGULARITY MAY BE PRESENT) AND IT OFTEN IS INADVISABLE TO
C    CONTINUE.
C
C    IF IFLAG=6 IS ENCOUNTERED, THE USER SHOULD USE THE ONE-STEP
C    INTEGRATION MODE WITH THE STEPSIZE DETERMINED BY THE CODE. IF
C    THE USER INSISTS UPON CONTINUING THE INTEGRATION WITH GERK IN
C    THE INTERVAL MODE, HE MUST RESET IFLAG TO 2 BEFORE CALLING GERK
C    AGAIN.  OTHERWISE,EXECUTION WILL BE TERMINATED.
C
C    IF IFLAG=7 IS OBTAINED, INTEGRATION CAN NOT BE CONTINUED UNLESS
C    THE INVALID INPUT PARAMETERS ARE CORRECTED.
C
C    IT SHOULD BE NOTED THAT THE ARRAYS WORK,IWORK CONTAIN
C    INFORMATION REQUIRED FOR SUBSEQUENT INTEGRATION. ACCORDINGLY,
C    WORK AND IWORK SHOULD NOT BE ALTERED.
C
C*******************************************************************
C
C     .. Scalar Arguments ..
      REAL ABSERR,RELERR,T,TOUT
      INTEGER IFLAG,NEQN
C     ..
C     .. Array Arguments ..
      REAL GERROR(NEQN),WORK(3+8*NEQN),Y(NEQN)
      INTEGER IWORK(5)
C     ..
C     .. Subroutine Arguments ..
      EXTERNAL F
C     ..
C     .. Local Scalars ..
      REAL H,SAVAE,SAVRE
      INTEGER I,IM,INIT,JFLAG,K1,K1M,K2,K3,K4,K5,K6,K7,K8,KFLAG,KOP,NFE
C     ..
C     .. External Subroutines ..
      EXTERNAL GERKS
C     ..
C COMPUTE INDICES FOR THE SPLITTING OF THE WORK ARRAY
C     .. Local Arrays ..
      REAL F1(3),F2(3),F3(3),F4(3),F5(3),YG(3),YGP(3),YP(3)
C     ..
      K1M = NEQN + 1
      K1 = K1M + 1
      K2 = K1 + NEQN
      K3 = K2 + NEQN
      K4 = K3 + NEQN
      K5 = K4 + NEQN
      K6 = K5 + NEQN
      K7 = K6 + NEQN
      K8 = K7 + NEQN
C  THE FOLLOWING SECTION DEFINES LOCAL VARIABLES, F1,F2,...,SO
C  THAT GERKS CAN BE CALLED IN A WAY THAT IS MORE "PORTABLE"
C  THAN THE ORIGINAL ARRANGEMENT.  NOTE THE NEW ARGUMENT LIST
C  FOR GERKS.
      DO 13 I = 1,3
          IM = I - 1
          YP(I) = WORK(I)
          F1(I) = WORK(K1+IM)
          F2(I) = WORK(K2+IM)
          F3(I) = WORK(K3+IM)
          F4(I) = WORK(K4+IM)
          F5(I) = WORK(K5+IM)
          YG(I) = WORK(K6+IM)
          YGP(I) = WORK(K7+IM)
   13 CONTINUE
      H = WORK(K1M)
      SAVRE = WORK(K8)
      SAVAE = WORK(K8+1)
      NFE = IWORK(1)
      KOP = IWORK(2)
      INIT = IWORK(3)
      JFLAG = IWORK(4)
      KFLAG = IWORK(5)
C *******************************************************************
C      THIS INTERFACING ROUTINE MERELY RELIEVES THE USER OF A LONG
C      CALLING LIST VIA THE SPLITTING APART OF TWO WORKING STORAGE
C      ARRAYS. IF THIS IS NOT COMPATIBLE WITH THE USERS COMPILER,
C      HE MUST USE GERKS DIRECTLY.
C *******************************************************************
c     CALL GERKS(F,NEQN,Y,T,TOUT,RELERR,ABSERR,IFLAG,GERROR,WORK(1),
c    +           WORK(K1M),WORK(K1),WORK(K2),WORK(K3),WORK(K4),WORK(K5),
c    +           WORK(K6),WORK(K7),WORK(K8),WORK(K8+1),IWORK(1),
c    +           IWORK(2),IWORK(3),IWORK(4),IWORK(5))

      CALL GERKS(F,NEQN,Y,T,TOUT,RELERR,ABSERR,IFLAG,GERROR,YP,H,F1,F2,
     +           F3,F4,F5,YG,YGP,SAVRE,SAVAE,NFE,KOP,INIT,JFLAG,KFLAG)

C  NOW WE HAVE TO REPLACE THE LOCAL ARRAYS, F1,F2,..., WITH THEIR
C  EQUIVALENT LOCATIONS IN THE ARRAY WORK.
      DO 15 I = 1,3
          IM = I - 1
          WORK(I) = YP(I)
          WORK(K1+IM) = F1(I)
          WORK(K2+IM) = F2(I)
          WORK(K3+IM) = F3(I)
          WORK(K4+IM) = F4(I)
          WORK(K5+IM) = F5(I)
          WORK(K6+IM) = YG(I)
          WORK(K7+IM) = YGP(I)
   15 CONTINUE
      WORK(K1M) = H
      WORK(K8) = SAVRE
      WORK(K8+1) = SAVAE
      IWORK(1) = NFE
      IWORK(2) = KOP
      IWORK(3) = INIT
      IWORK(4) = JFLAG
      IWORK(5) = KFLAG
      RETURN
      END
      SUBROUTINE GERKS(F,NEQN,Y,T,TOUT,RELERR,ABSERR,IFLAG,GERROR,YP,H,
     +                 F1,F2,F3,F4,F5,YG,YGP,SAVRE,SAVAE,NFE,KOP,INIT,
     +                 JFLAG,KFLAG)
C      FEHLBERG FOURTH(FIFTH) ORDER RUNGE-KUTTA METHOD WITH
C      GLOBAL ERROR ASSESSMENT
C *******************************************************************
C      GERKS INTEGRATES A SYSTEM OF FIRST ORDER ORDINARY DIFFERENTIAL
C      EQUATIONS AS DESCRIBED IN THE COMMENTS FOR GERK.  THE ARRAYS
C      YP,F1,F2,F3,F4,F5,YG AND YGP (OF DIMENSION AT LEAST NEQN) AND
C      THE VARIABLES H,SAVRE,SAVAE,NFE,KOP,INIT,JFLAG,AND KFLAG ARE
C      USED INTERNALLY BY THE CODE AND APPEAR IN THE CALL LIST TO
C      ELIMINATE LOCAL RETENTION OF VARIABLES BETWEEN CALLS.
C      ACCORDINGLY, THEY SHOULD NOT BE ALTERED. ITEMS OF POSSIBLE
C      INTEREST ARE
C          YP - DERIVATIVE OF SOLUTION VECTOR AT T
C          H  - AN APPROPRIATE STEPSIZE TO BE USED FOR THE NEXT STEP
C          NFE- COUNTER ON THE NUMBER OF DERIVATIVE FUNCTION
C               EVALUATIONS.
C *******************************************************************
C     .. Scalar Arguments ..
      REAL ABSERR,H,RELERR,SAVAE,SAVRE,T,TOUT
      INTEGER IFLAG,INIT,JFLAG,KFLAG,KOP,NEQN,NFE
C     ..
C     .. Array Arguments ..
      REAL F1(NEQN),F2(NEQN),F3(NEQN),F4(NEQN),F5(NEQN),
     +                 GERROR(NEQN),Y(NEQN),YG(NEQN),YGP(NEQN),YP(NEQN)
C     ..
C     .. Subroutine Arguments ..
      EXTERNAL F
C     ..
C     .. Local Scalars ..
      REAL A,AE,DT,EE,EEOET,ESTTOL,ET,HH,HMIN,ONE,REMIN,RER,
     +                 S,SCALE,TMP,TOL,TOLN,TS,U,U26,YPK
      INTEGER K,MAXNFE,MFLAG
      LOGICAL HFAILD,OUTPUT
C     ..
C     .. External Functions ..
      REAL EPSLON
      EXTERNAL EPSLON
C     ..
C     .. External Subroutines ..
      EXTERNAL FEHL
C     ..
C     .. Intrinsic Functions ..
      INTRINSIC ABS,MAX,MIN,SIGN
C     ..
C *******************************************************************
C   REMIN IS A TOLERANCE THRESHOLD WHICH IS ALSO DETERMINED BY THE
C   INTEGRATION METHOD. IN PARTICULAR, A FIFTH ORDER METHOD WILL
C   GENERALLY NOT BE CAPABLE OF DELIVERING ACCURACIES NEAR LIMITING
C   PRECISION ON COMPUTERS WITH LONG WORDLENGTHS.
C *******************************************************************
C      THE EXPENSE IS CONTROLLED BY RESTRICTING THE NUMBER
C      OF FUNCTION EVALUATIONS TO BE APPROXIMATELY MAXNFE.
C      AS SET,THIS CORRESPONDS TO ABOUT 500 STEPS.
C *******************************************************************
C     U - THE COMPUTER UNIT ROUNDOFF ERROR U IS THE SMALLEST POSITIVE
C         VALUE REPRESENTABLE IN THE MACHINE SUCH THAT  1.+ U .GT. 1.
C     (VARIABLE ONE SET TO 1.0 EASES PRECISION CONVERSION.)
C
C     .. Data statements ..
      DATA REMIN/3.0D-11/
      DATA MAXNFE/9000/
C     ..
      ONE = 1.0D0
      U = EPSLON(ONE)
C *******************************************************************
C      CHECK INPUT PARAMETERS
      IF (NEQN.LT.1) GO TO 10
      IF ((RELERR.LT.0.D0) .OR. (ABSERR.LT.0.D0)) GO TO 10
      MFLAG = ABS(IFLAG)
      IF ((MFLAG.GE.1) .AND. (MFLAG.LE.7)) GO TO 20
C INVALID INPUT
   10 IFLAG = 7
      RETURN
C IS THIS THE FIRST CALL
   20 IF (MFLAG.EQ.1) GO TO 70
C CHECK CONTINUATION POSSIBILITIES
      IF (T.EQ.TOUT) GO TO 10
      IF (MFLAG.NE.2) GO TO 30
C IFLAG = +2 OR -2
      IF (INIT.EQ.0) GO TO 60
      IF (KFLAG.EQ.3) GO TO 50
      IF ((KFLAG.EQ.4) .AND. (ABSERR.EQ.0.D0)) GO TO 40
      IF ((KFLAG.EQ.5) .AND. (RELERR.LE.SAVRE) .AND.
     +    (ABSERR.LE.SAVAE)) GO TO 40
      GO TO 70
C IFLAG = 3,4,5,6, OR 7
   30 IF (IFLAG.EQ.3) GO TO 50
      IF ((IFLAG.EQ.4) .AND. (ABSERR.GT.0.D0)) GO TO 60
C INTEGRATION CANNOT BE CONTINUED SINCE USER DID NOT RESPOND TO
C THE INSTRUCTIONS PERTAINING TO IFLAG=4,5,6 OR 7
   40 STOP
C *******************************************************************
C      RESET FUNCTION EVALUATION COUNTER
   50 NFE = 0
      IF (MFLAG.EQ.2) GO TO 70
C RESET FLAG VALUE FROM PREVIOUS CALL
   60 IFLAG = JFLAG
C SAVE INPUT IFLAG AND SET CONTINUATION FLAG VALUE FOR SUBSEQUENT
C INPUT CHECKING
   70 JFLAG = IFLAG
      KFLAG = 0
C SAVE RELERR AND ABSERR FOR CHECKING INPUT ON SUBSEQUENT CALLS
      SAVRE = RELERR
      SAVAE = ABSERR
C RESTRICT RELATIVE ERROR TOLERANCE TO BE AT LEAST AS LARGE AS
C 32U+REMIN TO AVOID LIMITING PRECISION DIFFICULTIES ARISING
C FROM IMPOSSIBLE ACCURACY REQUESTS
      TMP = 32.0D0*U+REMIN
      RER = MAX(RELERR,TMP)
      U26 = 26.D0*U
      DT = TOUT - T
      IF (MFLAG.EQ.1) GO TO 80
      IF (INIT.EQ.0) GO TO 90
      GO TO 110
C *******************************************************************
C      INITIALIZATION --
C                        SET INITIALIZATION COMPLETION INDICATOR,INIT
C                        SET INDICATOR FOR TOO MANY OUTPUT POINTS,KOP
C                        EVALUATE INITIAL DERIVATIVES
C                        COPY INITIAL VALUES AND DERIVATIVES FOR THE
C                              PARALLEL SOLUTION
C                        SET COUNTER FOR FUNCTION EVALUATIONS,NFE
C                        ESTIMATE STARTING STEPSIZE
   80 INIT = 0
      KOP = 0
      A = T
      CALL F(A,Y,YP)
      NFE = 1
      IF (T.NE.TOUT) GO TO 90
      IFLAG = 2
      RETURN
   90 INIT = 1
      H = ABS(DT)
      TOLN = 0.D0
      DO 100 K = 1,NEQN
          YG(K) = Y(K)
          YGP(K) = YP(K)
          TOL = RER*ABS(Y(K)) + ABSERR
          IF (TOL.LE.0.D0) GO TO 100
          TOLN = TOL
          YPK = ABS(YP(K))
          IF (YPK*H**5.GT.TOL) H = (TOL/YPK)**0.2D0
  100 CONTINUE
      IF (TOLN.LE.0.D0) H = 0.D0
      H = MAX(H,U26*MAX(ABS(T),ABS(DT)))
C *******************************************************************
C      SET STEPSIZE FOR INTEGRATION IN THE DIRECTION FROM T TO TOUT
  110 H = SIGN(H,DT)
C TEST TO SEE IF GERK IS BEING SEVERELY IMPACTED BY TOO MANY
C OUTPUT POINTS
      IF (ABS(H).GT.2.D0*ABS(DT)) KOP = KOP + 1
      IF (KOP.NE.100) GO TO 120
      KOP = 0
      IFLAG = 6
      RETURN
  120 IF (ABS(DT).GT.U26*ABS(T)) GO TO 140
C IF TOO CLOSE TO OUTPUT POINT,EXTRAPOLATE AND RETURN
      DO 130 K = 1,NEQN
          YG(K) = YG(K) + DT*YGP(K)
          Y(K) = Y(K) + DT*YP(K)
  130 CONTINUE
      A = TOUT
      CALL F(A,YG,YGP)
      CALL F(A,Y,YP)
      NFE = NFE + 2
      GO TO 230
C INITIALIZE OUTPUT POINT INDICATOR
  140 OUTPUT = .FALSE.
C TO AVOID PREMATURE UNDERFLOW IN THE ERROR TOLERANCE FUNCTION,
C SCALE THE ERROR TOLERANCES
      SCALE = 2.D0/RER
      AE = SCALE*ABSERR
C *******************************************************************
C *******************************************************************
C      STEP BY STEP INTEGRATION
  150 HFAILD = .FALSE.
C SET SMALLEST ALLOWABLE STEPSIZE
      HMIN = U26*ABS(T)
C ADJUST STEPSIZE IF NECESSARY TO HIT THE OUTPUT POINT.
C LOOK AHEAD TWO STEPS TO AVOID DRASTIC CHANGES IN THE STEPSIZE
C AND THUS LESSEN THE IMPACT OF OUTPUT POINTS ON THE CODE.
      DT = TOUT - T
      IF (ABS(DT).GE.2.D0*ABS(H)) GO TO 170
      IF (ABS(DT).GT.ABS(H)) GO TO 160
C THE NEXT SUCCESSFUL STEP WILL COMPLETE THE INTEGRATION TO THE
C OUTPUT POINT
      OUTPUT = .TRUE.
      H = DT
      GO TO 170
  160 H = 0.5D0*DT
C *******************************************************************
C      CORE INTEGRATOR FOR TAKING A SINGLE STEP
C *******************************************************************
C      THE TOLERANCES HAVE BEEN SCALED TO AVOID PREMATURE UNDERFLOW
C      IN COMPUTING THE ERROR TOLERANCE FUNCTION ET.
C      TO AVOID PROBLEMS WITH ZERO CROSSINGS, RELATIVE ERROR IS
C      MEASURED USING THE AVERAGE OF THE MAGNITUDES OF THE SOLUTION
C      AT THE BEGINNING AND END OF A STEP.
C      THE ERROR ESTIMATE FORMULA HAS BEEN GROUPED TO CONTROL LOSS OF
C      SIGNIFICANCE.
C      TO DISTINGUISH THE VARIOUS ARGUMENTS, H IS NOT PERMITTED
C      TO BECOME SMALLER THAN 26 UNITS OF ROUNDOFF IN T.
C      PRACTICAL LIMITS ON THE CHANGE IN THE STEPSIZE ARE ENFORCED TO
C      SMOOTH THE STEPSIZE SELECTION PROCESS AND TO AVOID EXCESSIVE
C      CHATTERING ON PROBLEMS HAVING DISCONTINUITIES.
C      TO PREVENT UNNECESSARY FAILURES, THE CODE USES 9/10 THE
C      STEPSIZE IT ESTIMATES WILL SUCCEED.
C      AFTER A STEP FAILURE, THE STEPSIZE IS NOT ALLOWED TO INCREASE
C      FOR THE NEXT ATTEMPTED STEP.  THIS MAKES THE CODE MORE
C      EFFICIENT ON PROBLEMS HAVING DISCONTINUITIES AND MORE
C      EFFECTIVE IN GENERAL SINCE LOCAL EXTRAPOLATION IS BEING USED
C      AND THE ERROR ESTIMATE MAY BE UNRELIABLE OR UNACCEPTABLE WHEN
C      A STEP FAILS.
C *******************************************************************
C      TEST NUMBER OF DERIVATIVE FUNCTION EVALUATIONS.
C      IF OKAY,TRY TO ADVANCE THE INTEGRATION FROM T TO T+H
  170 IF (NFE.LE.MAXNFE) GO TO 180
C TOO MUCH WORK
      IFLAG = 3
      KFLAG = 3
      RETURN
C ADVANCE AN APPROXIMATE SOLUTION OVER ONE STEP OF LENGTH H
  180 CALL FEHL(F,NEQN,YG,T,H,YGP,F1,F2,F3,F4,F5,F1)
      NFE = NFE + 5
C COMPUTE AND TEST ALLOWABLE TOLERANCES VERSUS LOCAL ERROR
C ESTIMATES AND REMOVE SCALING OF TOLERANCES. NOTE THAT RELATIVE
C ERROR IS MEASURED WITH RESPECT TO THE AVERAGE MAGNITUDES OF THE
C OF THE SOLUTION AT THE BEGINNING AND END OF THE STEP.
      EEOET = 0.D0
      DO 200 K = 1,NEQN
          ET = ABS(YG(K)) + ABS(F1(K)) + AE
          IF (ET.GT.0.D0) GO TO 190
C INAPPROPRIATE ERROR TOLERANCE
          IFLAG = 4
          KFLAG = 4
          RETURN
  190     EE = ABS((-2090.D0*YGP(K)+ (21970.D0*F3(K)-15048.D0*F4(K)))+
     +         (22528.D0*F2(K)-27360.D0*F5(K)))
          EEOET = MAX(EEOET,EE/ET)
  200 CONTINUE
      ESTTOL = ABS(H)*EEOET*SCALE/752400.D0
      IF (ESTTOL.LE.1.D0) GO TO 210
C UNSUCCESSFUL STEP
C                   REDUCE THE STEPSIZE , TRY AGAIN
C                   THE DECREASE IS LIMITED TO A FACTOR OF 1/10
      HFAILD = .TRUE.
      OUTPUT = .FALSE.
      S = 0.1D0
      IF (ESTTOL.LT.59049.D0) S = 0.9D0/ESTTOL**0.2D0
      H = S*H
      IF (ABS(H).GT.HMIN) GO TO 170
C REQUESTED ERROR UNATTAINABLE AT SMALLEST ALLOWABLE STEPSIZE
      IFLAG = 5
      KFLAG = 5
      RETURN
C SUCCESSFUL STEP
C                    STORE ONE-STEP SOLUTION YG AT T+H
C                    AND EVALUATE DERIVATIVES THERE
  210 TS = T
      T = T + H
      DO 220 K = 1,NEQN
          YG(K) = F1(K)
  220 CONTINUE
      A = T
      CALL F(A,YG,YGP)
      NFE = NFE + 1
C NOW ADVANCE THE Y SOLUTION OVER TWO STEPS OF
C LENGTH H/2 AND EVALUATE DERIVATIVES THERE
      HH = 0.5D0*H
      CALL FEHL(F,NEQN,Y,TS,HH,YP,F1,F2,F3,F4,F5,Y)
      TS = TS + HH
      A = TS
      CALL F(A,Y,YP)
      CALL FEHL(F,NEQN,Y,TS,HH,YP,F1,F2,F3,F4,F5,Y)
      A = T
      CALL F(A,Y,YP)
      NFE = NFE + 12
C CHOOSE NEXT STEPSIZE
C THE INCREASE IS LIMITED TO A FACTOR OF 5
C IF STEP FAILURE HAS JUST OCCURRED, NEXT
C    STEPSIZE IS NOT ALLOWED TO INCREASE
      S = 5.D0
      IF (ESTTOL.GT.1.889568D-4) S = 0.9D0/ESTTOL**0.2D0
      IF (HFAILD) S = MIN(S,ONE)
      H = SIGN(MAX(S*ABS(H),HMIN),H)
C *******************************************************************
C      END OF CORE INTEGRATOR
C *******************************************************************
C      SHOULD WE TAKE ANOTHER STEP
      IF (OUTPUT) GO TO 230
      IF (IFLAG.GT.0) GO TO 150
C *******************************************************************
C *******************************************************************
C      INTEGRATION SUCCESSFULLY COMPLETED
C      ONE-STEP MODE
      IFLAG = -2
      GO TO 240
C INTERVAL MODE
  230 T = TOUT
      IFLAG = 2
  240 DO 250 K = 1,NEQN
          GERROR(K) = (YG(K)-Y(K))/31.D0
  250 CONTINUE
      RETURN
      END
      SUBROUTINE FEHL(F,NEQN,Y,T,H,YP,F1,F2,F3,F4,F5,S)
C      FEHLBERG FOURTH-FIFTH ORDER RUNGE-KUTTA METHOD
C *******************************************************************
C     FEHL INTEGRATES A SYSTEM OF NEQN FIRST ORDER
C     ORDINARY DIFFERENTIAL EQUATIONS OF THE FORM
C              DY(I)/DT=F(T,Y(1),---,Y(NEQN))
C     WHERE THE INITIAL VALUES Y(I) AND THE INITIAL DERIVATIVES
C     YP(I) ARE SPECIFIED AT THE STARTING POINT T. FEHL ADVANCES
C     THE SOLUTION OVER THE FIXED STEP H AND RETURNS
C     THE FIFTH ORDER (SIXTH ORDER ACCURATE LOCALLY) SOLUTION
C     APPROXIMATION AT T+H IN ARRAY S(I).
C     F1,---,F5 ARE ARRAYS OF DIMENSION NEQN WHICH ARE NEEDED
C     FOR INTERNAL STORAGE.
C     THE FORMULAS HAVE BEEN GROUPED TO CONTROL LOSS OF SIGNIFICANCE.
C     FEHL SHOULD BE CALLED WITH AN H NOT SMALLER THAN 13 UNITS OF
C     ROUNDOFF IN T SO THAT THE VARIOUS INDEPENDENT ARGUMENTS CAN BE
C     DISTINGUISHED.
C *******************************************************************
C     .. Scalar Arguments ..
      REAL H,T
      INTEGER NEQN
C     ..
C     .. Array Arguments ..
      REAL F1(NEQN),F2(NEQN),F3(NEQN),F4(NEQN),F5(NEQN),
     +                 S(NEQN),Y(NEQN),YP(NEQN)
C     ..
C     .. Subroutine Arguments ..
      EXTERNAL F
C     ..
C     .. Local Scalars ..
      REAL CH,T1
      INTEGER K
C     ..
      CH = 0.25D0*H
      DO 10 K = 1,NEQN
          F5(K) = Y(K) + CH*YP(K)
   10 CONTINUE
      T1 = T + 0.25D0*H
c     CALL F(T+0.25*H,F5,F1)
      CALL F(T1,F5,F1)
      CH = 0.09375D0*H
      DO 20 K = 1,NEQN
          F5(K) = Y(K) + CH* (YP(K)+3.D0*F1(K))
   20 CONTINUE
      T1 = T + 0.375D0*H
c     CALL F(T+0.375*H,F5,F2)
      CALL F(T1,F5,F2)
      CH = H/2197.D0
      DO 30 K = 1,NEQN
          F5(K) = Y(K) + CH* (1932.D0*YP(K)+
     +            (7296.D0*F2(K)-7200.D0*F1(K)))
   30 CONTINUE
      T1 = T + 12.D0/13.D0*H
c     CALL F(T+12./13.*H,F5,F3)
      CALL F(T1,F5,F3)
      CH = H/4104.D0
      DO 40 K = 1,NEQN
          F5(K) = Y(K) + CH* ((8341.D0*YP(K)-845.D0*F3(K))+
     +            (29440.D0*F2(K)-32832.D0*F1(K)))
   40 CONTINUE
      T1 = T + H
c     CALL F(T+H,F5,F4)
      CALL F(T1,F5,F4)
      CH = H/20520.D0
      DO 50 K = 1,NEQN
          F1(K) = Y(K) + CH* ((-6080.D0*YP(K)+ (9295.D0*F3(K)-
     +            5643.D0*F4(K)))+ (41040.D0*F1(K)-28352.D0*F2(K)))
   50 CONTINUE
      T1 = T + 0.5D0*H
c     CALL F(T+0.5*H,F1,F5)
      CALL F(T1,F1,F5)
C COMPUTE APPROXIMATE SOLUTION AT T+H
      CH = H/7618050.D0
      DO 60 K = 1,NEQN
          S(K) = Y(K) + CH* ((902880.D0*YP(K)+ (3855735.D0*F3(K)-
     +           1371249.D0*F4(K)))+ (3953664.D0*F2(K)+277020.D0*F5(K)))
   60 CONTINUE
      RETURN
      END
SHAR_EOF
fi # end of overwriting check
cd ..
cd ..
cd ..
#       End of shell archive
exit 0