1!! Copyright (C) 2005-2006 Heiko Appel
2!!
3!! This program is free software; you can redistribute it and/or modify
4!! it under the terms of the GNU General Public License as published by
5!! the Free Software Foundation; either version 2, or (at your option)
6!! any later version.
7!!
8!! This program is distributed in the hope that it will be useful,
9!! but WITHOUT ANY WARRANTY; without even the implied warranty of
10!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11!! GNU General Public License for more details.
12!!
13!! You should have received a copy of the GNU General Public License
14!! along with this program; if not, write to the Free Software
15!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
16!! 02110-1301, USA.
17!!
18
19! ---------------------------------------------------------
20subroutine X(root_solver_run)(rs, func, root, success, startval, coeff)
21  type(root_solver_t), intent(in) :: rs
22  R_TYPE,                intent(out)  :: root(:)        !< roots we are searching
23  logical,               intent(out)  :: success
24  R_TYPE, optional,      intent(in)   :: startval(:)    !< start value for the search
25  R_TYPE, optional,      intent(in)   :: coeff(:)       !< polynomial coefficients
26  interface
27    subroutine func(z, f, jf)
28      implicit none
29      R_TYPE, intent(in)  :: z(:)
30      R_TYPE, intent(out) :: f(:), jf(:, :)
31    end subroutine func
32  end interface
33
34  ! no push_sub, called too often
35
36  ! Initializations
37  root = M_ZERO
38  success = .false.
39
40  select case(rs%solver_type)
41#if defined(R_TREAL)
42  case(ROOT_NEWTON)
43    call droot_newton(rs, func, root, startval, success)
44#endif
45  case(ROOT_WATTERSTROM)
46#ifdef R_TREAL
47    message(1) = 'root_solver: Watterstrom method not defined for pure real arithmetic'
48    call messages_fatal(1)
49#endif
50#ifdef R_TCOMPLEX
51    if(present(coeff)) then
52      message(1) = 'Info: root_solver: Using Watterstrom method.'
53      call messages_info(1)
54      call zroot_watterstrom(rs, root, coeff)
55    else
56      message(1) = 'root_solver: Watterstrom method only valid for polynomials.'
57      call messages_fatal(1)
58    end if
59#endif
60
61  case default
62    write(message(1), '(a,i4,a)') "Input: '", rs%solver_type, &
63      "' is not a valid root solver"
64    message(2) = '( root solver = root_newton | root_watterstrom )'
65    call messages_fatal(2)
66  end select
67
68end subroutine X(root_solver_run)
69
70!! Local Variables:
71!! mode: f90
72!! coding: utf-8
73!! End:
74