Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

implementing Newton-Raphson mehtod in f90 2

Status
Not open for further replies.

dibas

Programmer
Nov 23, 2011
24
ZA
I am adapting a version of the Newton-Raphson code found in Numerical Recipes in Fortran90 (page 275/572) for solving f(x) = 0. The code (a fortran function) together with a subroutine plus a driver (main) program I have made appear to work with some function f(x). But a different f(x) gives something very different from what I get when I do a paper and pencil calculation.
My ultimate aim is to incorporate this N-R piece of code in a code for solving a stiff ODE. I need to verify it's proper functioning before I can do that.
So, I would highly appreciate help and corrections on my code or rather an example piece of code showing how the numerical recipes version of the code can be implemented.

Here are my pieces of code:

[program rtnewt_driver

! Driver program for testing the N-R iteration code

use nrtype; use nrutil, only : nrerror
use real_type_mod

implicit none

real(kind=wp) :: rtnewt, y, ans
real(kind=wp) :: x, fval, fderiv
real(kind=wp) :: dt, x0, TOL

interface
subroutine funcd(x,fval,fderiv)
use nrtype
use real_type_mod
implicit none
real(kind=wp) :: x, y, dt
real(kind=wp) :: fval,fderiv
end subroutine funcd
end interface

! Specify needed initial values and the tolerance TOL
y = 0.5_wp
dt = 0.01_wp
x0 = y ! initial guess
TOL = 5.0e-10

! Compute and Print result to screen. The function below
! is called with the argument y so that this y-value is
! passed on to x0, the initial guess of the N-R iteration

ans = rtnewt(funcd,x0,TOL)

print*, 'result is:', ans

end program rtnewt_driver]

[function rtnewt(funcd,x0,TOL)

! Function for doing Newton-Raphson iterations

use nrtype; use nrutil, only : nrerror
use real_type_mod

implicit none

real(kind=wp) :: x0, TOL
real(kind=wp) :: rtnewt, prev_rtnewt
integer(I4B), parameter :: maxit = 50
integer(I4B) :: j
real(kind=wp) :: fderiv, dx, fval

interface
subroutine funcd(x,fval,fderiv)
use nrtype
use real_type_mod
implicit none
real(kind=wp) :: x, y, dt
real(kind=wp) :: fval,fderiv
end subroutine funcd
end interface

rtnewt = x0 ! initialising the iterations

do j = 1, maxit
prev_rtnewt = rtnewt ! store previous iterate (x_n)
call funcd(rtnewt, fval, fderiv)
dx = fval/fderiv ! fractional term f(x)/df(x)
rtnewt = rtnewt - dx ! full iterative step
write(*,'(4x, I2, 4x, f22.18, 4x, ES16.8E3)'), j, &
rtnewt, abs(rtnewt - prev_rtnewt)
if ( abs(rtnewt - prev_rtnewt) < TOL) then
print*, 'value of j is:',j
return
end if
end do
call nrerror('rtnewt exceeded maximum iterations')
end function

!-----------------------------------------------------------------
! subroutine "funcd" takes input "x" and returns both the function
! value and the first derivative of the function 'f'.
!-----------------------------------------------------------------

subroutine funcd(x,fval,fderiv)

use nrtype
use real_type_mod

implicit none

real(kind=wp) :: x, y, dt
real(kind=wp) :: fval,fderiv
!real(kind=wp) :: y, dt

fval = x*sin(x) - 1.0
fderiv = x*cos(x) + sin(x)

! fval = 9*dt*(x**3) - 8*dt*(x**2) + (1 - dt)*x - y
! fderiv = 27*dt*(x**2) - 16*dt*x + (1 - dt)

end subroutine funcd]
 
I don't see any error even if I don't like very much your programming style.

For instance, I don't like to see :
- a same interface repeated several times,
- several external procedures rnewt_driver,rnewt and funcd (external <=> which do not not belong to a module)

Usually, I avoid together external subroutines and repetitions which are error prone.

Now, if you try the commented variant of the function funcd, don't forget to initialize the local variables y and dt. For instance :

Code:
subroutine funcd(x,fval,fderiv)

  use types

  implicit none
  
  real(kind=wp) :: x, y=2, dt=1.e-2
  real(kind=wp) :: fval,fderiv
  !real(kind=wp)  :: y, dt

     !fval   = x*sin(x) - 1.0
     !fderiv = x*cos(x) + sin(x)

  fval   = 9*dt*(x**3) - 8*dt*(x**2) + (1 - dt)*x - y
  fderiv = 27*dt*(x**2) - 16*dt*x + (1 - dt)

end subroutine funcd

With the result (I provided my own version of the missing modules nrtype, nrutil and real_type_mod) :

Code:
[lcoul@localhost test]$ ./a.out
     1      2.048593349272485042     1.54859335E+000
     2      1.788957850911645719     2.59635498E-001
     3      1.769620673666768340     1.93371772E-002
     4      1.769524016640442898     9.66570263E-005
     5      1.769524014246341093     2.39410181E-009
     6      1.769524014246340871     2.22044605E-016
 value of j is:           6
 result is:   1.76952401424634

Other comment : declaring y and dt in the interface has no interest because these variable are not arguments of the function. But again, this is not an error...


François Jacq
 
Thanks, FJacq. Your suggestions and comments help. I also appreciate your comment about having to improve my programming style. I'm very new to Fortran - in fact, programming in general- and still trying to get most basic stuff right.
 
I didn't look in detail at your code, but I see that the following things could be improved:
1. Choose tolerances in dependence of machine epsilon
2. Compute the derivatives rather numerically
3. For safety, test if the derivative isn't zero.
For exampel, I would write it something like this:

roots.f95
Code:
[COLOR=#a020f0]module[/color] numerical_methods
  [COLOR=#0000ff]! This module contains the numerical methods  [/color]
[COLOR=#a020f0]contains[/color]
  [COLOR=#a020f0]function[/color] machine_epsilon(start) [COLOR=#a020f0]result[/color] (macheps)
    [COLOR=#0000ff]! Machine Epsilon[/color]
    [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: start [COLOR=#0000ff]! starting point[/color]
    [COLOR=#2e8b57][b]double precision[/b][/color] :: macheps

    macheps [COLOR=#804040][b]=[/b][/color] start
    [COLOR=#804040][b]do[/b][/color] [COLOR=#804040][b]while[/b][/color] (macheps [COLOR=#804040][b]+[/b][/color] [COLOR=#ff00ff]1.0[/color] [COLOR=#804040][b]>[/b][/color] [COLOR=#ff00ff]1.0[/color])
      macheps [COLOR=#804040][b]=[/b][/color] macheps [COLOR=#804040][b]/[/b][/color] [COLOR=#ff00ff]2.0[/color]
    [COLOR=#804040][b]end do[/b][/color]   
    [COLOR=#0000ff]! write (*,*) 'macheps =', macheps[/color]
  [COLOR=#a020f0]end function[/color] machine_epsilon 

  [COLOR=#2e8b57][b]double precision[/b][/color] [COLOR=#a020f0]function[/color] deriv(f, x)
    [COLOR=#0000ff]! numerical derivation of f(x)[/color]
    [COLOR=#2e8b57][b]double precision[/b][/color] :: f
    [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x

    [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]parameter[/b][/color] :: h [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]1e-3[/color] [COLOR=#0000ff]! step[/color]

    deriv [COLOR=#804040][b]=[/b][/color] (f(x[COLOR=#804040][b]+[/b][/color]h) [COLOR=#804040][b]-[/b][/color] f(x[COLOR=#804040][b]-[/b][/color]h)) [COLOR=#804040][b]/[/b][/color] ([COLOR=#ff00ff]2[/color][COLOR=#804040][b]*[/b][/color]h)
  [COLOR=#a020f0]end function[/color] deriv

  [COLOR=#2e8b57][b]double precision[/b][/color] [COLOR=#a020f0]function[/color] newton(f, start, delta, eps, print_out, deriv_zero)
    [COLOR=#0000ff]! Approximate the solution of f(x) = 0[/color]
    [COLOR=#2e8b57][b]double precision[/b][/color] :: f [COLOR=#0000ff]! function from left side[/color]
    [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) ::  start, delta, eps
[COLOR=#2e8b57][b]    logical[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: print_out
[COLOR=#2e8b57][b]    logical[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]out[/b][/color]) :: deriv_zero 

    [COLOR=#2e8b57][b]double precision[/b][/color] :: df, x, x_old 
    [COLOR=#2e8b57][b]integer[/b][/color] :: k

    k [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]0[/color]
    x [COLOR=#804040][b]=[/b][/color] start

    [COLOR=#804040][b]if[/b][/color] (print_out) [COLOR=#804040][b]then[/b][/color]
      [COLOR=#0000ff]! print header and starting values[/color]
      [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]'(A3, A15, A15)'[/color]) [COLOR=#ff00ff]'k'[/color], [COLOR=#ff00ff]'x'[/color], [COLOR=#ff00ff]'f(x)'[/color]
      [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]'(i3, f15.10, f15.10)'[/color]) k, x, f(x)
    [COLOR=#804040][b]end if[/b][/color]

    [COLOR=#804040][b]if[/b][/color] ([COLOR=#008080]abs[/color](f(x)) [COLOR=#804040][b]<[/b][/color] eps) [COLOR=#804040][b]then[/b][/color] 
      [COLOR=#0000ff]! solution at start point - terminate computation[/color]
      [COLOR=#804040][b]go to[/b][/color] [COLOR=#ff00ff]99[/color]
    [COLOR=#804040][b]end if[/b][/color] 

    [COLOR=#804040][b]do[/b][/color] [COLOR=#0000ff]! repeat-until loop[/color]
      df [COLOR=#804040][b]=[/b][/color] deriv(f, x)
      [COLOR=#804040][b]if[/b][/color] (df [COLOR=#804040][b].eq.[/b][/color] [COLOR=#ff00ff]0[/color]) [COLOR=#804040][b]then[/b][/color] 
        [COLOR=#0000ff]! derivative is zero - terminate computation[/color]
        deriv_zero [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff].true.[/color]
        [COLOR=#804040][b]return[/b][/color]
      [COLOR=#804040][b]end if[/b][/color]
      [COLOR=#0000ff]! compute [/color]
      x_old [COLOR=#804040][b]=[/b][/color] x
      x [COLOR=#804040][b]=[/b][/color] x [COLOR=#804040][b]-[/b][/color] f(x)[COLOR=#804040][b]/[/b][/color]df
      k [COLOR=#804040][b]=[/b][/color] k [COLOR=#804040][b]+[/b][/color] [COLOR=#ff00ff]1[/color]      
      [COLOR=#804040][b]if[/b][/color] (print_out) [COLOR=#804040][b]then[/b][/color]
        [COLOR=#0000ff]! print iteratzion result[/color]
        [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#ff00ff]'(i3, f15.10, f15.10)'[/color]) k, x, f(x)
      [COLOR=#804040][b]end if[/b][/color]
      [COLOR=#804040][b]if[/b][/color] (([COLOR=#008080]abs[/color](x [COLOR=#804040][b]-[/b][/color] x_old) [COLOR=#804040][b]<[/b][/color] delta)[COLOR=#804040][b].or.[/b][/color]([COLOR=#008080]abs[/color](f(x)) [COLOR=#804040][b]<[/b][/color] eps)) [COLOR=#804040][b]then[/b][/color]
        [COLOR=#0000ff]! exit repeat-until loop[/color]
        [COLOR=#804040][b]exit[/b][/color]
      [COLOR=#804040][b]end if[/b][/color]
    [COLOR=#804040][b]end do[/b][/color]
    [COLOR=#0000ff]! return value[/color]
    [COLOR=#ff00ff]99[/color] newton [COLOR=#804040][b]=[/b][/color] x   
    [COLOR=#804040][b]return[/b][/color]  
  [COLOR=#a020f0]end function[/color] newton
[COLOR=#a020f0]end module[/color] numerical_methods

[COLOR=#a020f0]module[/color] user_functions
  [COLOR=#0000ff]! Define here your own functions to be integrated [/color]
[COLOR=#a020f0]contains[/color]
  [COLOR=#2e8b57][b]double precision[/b][/color] [COLOR=#a020f0]function[/color] f1(x)
    [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
    [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x
    f1 [COLOR=#804040][b]=[/b][/color] (x[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1[/color]) [COLOR=#804040][b]*[/b][/color] (x[COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]5[/color])
  [COLOR=#a020f0]end function[/color] f1

  [COLOR=#2e8b57][b]double precision[/b][/color] [COLOR=#a020f0]function[/color] f2(x)
    [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
    [COLOR=#2e8b57][b]double precision[/b][/color], [COLOR=#2e8b57][b]intent[/b][/color]([COLOR=#2e8b57][b]in[/b][/color]) :: x

    [COLOR=#2e8b57][b]double precision[/b][/color] :: y[COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]2[/color], dt[COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]1.e-2[/color]
    f2 [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]9[/color][COLOR=#804040][b]*[/b][/color]dt[COLOR=#804040][b]*[/b][/color](x[COLOR=#804040][b]**[/b][/color][COLOR=#ff00ff]3[/color]) [COLOR=#804040][b]-[/b][/color] [COLOR=#ff00ff]8[/color][COLOR=#804040][b]*[/b][/color]dt[COLOR=#804040][b]*[/b][/color](x[COLOR=#804040][b]**[/b][/color][COLOR=#ff00ff]2[/color]) [COLOR=#804040][b]+[/b][/color] ([COLOR=#ff00ff]1[/color] [COLOR=#804040][b]-[/b][/color] dt)[COLOR=#804040][b]*[/b][/color]x [COLOR=#804040][b]-[/b][/color] y
  [COLOR=#a020f0]end function[/color] f2  
[COLOR=#a020f0]end module[/color] user_functions

[COLOR=#a020f0]program[/color] roots
  [COLOR=#a020f0]use[/color] numerical_methods
  [COLOR=#a020f0]use[/color] user_functions
  
  [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
  [COLOR=#2e8b57][b]double precision[/b][/color] :: start, tol, root
[COLOR=#2e8b57][b]  logical[/b][/color] :: deriv_zero

  [COLOR=#0000ff]! compute the tolerance[/color]
  tol [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]1e5[/color] [COLOR=#804040][b]*[/b][/color] machine_epsilon([COLOR=#ff00ff]0.5d0[/color])

  [COLOR=#0000ff]! find the roots of function f1[/color]
  deriv_zero [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff].false.[/color]
  start [COLOR=#804040][b]=[/b][/color] [COLOR=#804040][b]-[/b][/color][COLOR=#ff00ff]1.0[/color]
  root[COLOR=#804040][b]=[/b][/color]newton(f1, start, tol, tol, [COLOR=#ff00ff].true.[/color], deriv_zero)
  [COLOR=#804040][b]if[/b][/color] ([COLOR=#804040][b].not.[/b][/color](deriv_zero)) [COLOR=#804040][b]then[/b][/color]
    [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'the solution of f(x) = 0 is x = '[/color], root
  [COLOR=#804040][b]end if[/b][/color]

  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color], [COLOR=#804040][b]*[/b][/color])

  deriv_zero [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff].false.[/color]
  start [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]4.0[/color]
  root[COLOR=#804040][b]=[/b][/color]newton(f1, start, tol, tol, [COLOR=#ff00ff].false.[/color], deriv_zero)
  [COLOR=#804040][b]if[/b][/color] ([COLOR=#804040][b].not.[/b][/color](deriv_zero)) [COLOR=#804040][b]then[/b][/color]
    [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'the solution of f(x) = 0 is x = '[/color], root
  [COLOR=#804040][b]end if[/b][/color]

  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color], [COLOR=#804040][b]*[/b][/color])

  deriv_zero [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff].false.[/color]
  start [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]4.0[/color]
  root[COLOR=#804040][b]=[/b][/color]newton(f1, start, [COLOR=#ff00ff]0.0005d0[/color], [COLOR=#ff00ff]0.005d0[/color], [COLOR=#ff00ff].true.[/color], deriv_zero)
  [COLOR=#804040][b]if[/b][/color] ([COLOR=#804040][b].not.[/b][/color](deriv_zero)) [COLOR=#804040][b]then[/b][/color]
    [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'the solution of f(x) = 0 is x = '[/color], root
  [COLOR=#804040][b]end if[/b][/color]

  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color], [COLOR=#804040][b]*[/b][/color])

  deriv_zero [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff].false.[/color]
  start [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]3.0[/color]
  root[COLOR=#804040][b]=[/b][/color]newton(f1, start, [COLOR=#ff00ff]0.0005d0[/color], [COLOR=#ff00ff]0.005d0[/color], [COLOR=#ff00ff].true.[/color], deriv_zero)
  [COLOR=#804040][b]if[/b][/color] ([COLOR=#804040][b].not.[/b][/color](deriv_zero)) [COLOR=#804040][b]then[/b][/color]
    [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'the solution of f(x) = 0 is x = '[/color], root
  [COLOR=#804040][b]else[/b][/color]
    [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'With start ='[/color], start, [COLOR=#ff00ff]'derivative is zero !'[/color]
  [COLOR=#804040][b]end if[/b][/color]

  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color], [COLOR=#804040][b]*[/b][/color])

  [COLOR=#0000ff]! find the roots of function f2[/color]
  deriv_zero [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff].false.[/color]
  start [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]0.0[/color]
  root[COLOR=#804040][b]=[/b][/color]newton(f2, start, tol, tol, [COLOR=#ff00ff].true.[/color], deriv_zero)
  [COLOR=#804040][b]if[/b][/color] ([COLOR=#804040][b].not.[/b][/color](deriv_zero)) [COLOR=#804040][b]then[/b][/color]
    [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'the solution of f(x) = 0 is x = '[/color], root
  [COLOR=#804040][b]end if[/b][/color]
[COLOR=#a020f0]end program[/color] roots
Testing ...
Code:
$ gfortran roots.f95 -o roots

$ roots
  k              x           f(x)
  0  -1.0000000000  12.0000000000
  1   0.5000000000   2.2500000000
  2   0.9500000000   0.2025000000
  3   0.9993902439   0.0024393962
  4   0.9999999071   0.0000003717
  5   1.0000000000   0.0000000000
  6   1.0000000000  -0.0000000000
 the solution of f(x) = 0 is x =   1.00000000000000000     

 the solution of f(x) = 0 is x =    5.0000000000000000     

  k              x           f(x)
  0   4.0000000000  -3.0000000000
  1   5.5000000000   2.2500000000
  2   5.0500000000   0.2025000000
  3   5.0006097561   0.0024393962
 the solution of f(x) = 0 is x =    5.0006097560975613     

  k              x           f(x)
  0   3.0000000000  -4.0000000000
 With start =   3.0000000000000000      derivative is zero !

  k              x           f(x)
  0   0.0000000000  -2.0000000000
  1   2.0202018361   0.4155416789
  2   1.7852594322   0.0245249966
  3   1.7695874004   0.0000983962
  4   1.7695240153   0.0000000016
  5   1.7695240142   0.0000000000
 the solution of f(x) = 0 is x =    1.7695240142463411
 
dibas said:
My ultimate aim is to incorporate this N-R piece of code in a code for solving a stiff ODE.
I wrote programs for solving of stiff ODEs in Pascal at the college (it's 15 years ago). In that time good starting point was the book
Solving Ordinary Differential Equations: Stiff and differential-algebraic problems
The example fortran programs from the book are available at the author's page:
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top