next up previous contents
Next: Achieving Portability Up: Examples and Exercises Previous: Dynamic Data Structures

Optional and Keyword Arguments

Optional arguments permit a subprogram to accept a default value for missing arguments in a call. In numerical computing, this is most useful for specifying a tolerance. If specified, the value may override the default tolerance; otherwise, the default tolerance is used. Because any argument in the argument list of a subprogram may be optional, there may be a problem matching actual and formal arguments in a call to a subprogram with optional arguments. In this case, keyword arguments must be used to establish unambiguously the correspondence between actual and formal arguments. The RootFinders module below illustrates some of these features.

module RootFinders
   ! Maximum error permitted in the approximation of a root.
   real, parameter :: DEFAULT_TOLERANCE = epsilon( 1.0 )

   ! Restrict the visibility of these functions to this module.
   private secant, newton

   contains

   ! Use the secant method to find a root of f if df, the 
   !  derivative of f, is unavailable, otherwise, use Newton's 
   !  method.  a and b are used as a starting interval for 
   !  the secant method.  The average of a and b is used as 
   !  the initial guess for Newton's method.

   function findRoot( a, b, f, df, tolerance )
      implicit none
      real findRoot
      real, intent( in ) :: a, b
      real, optional, intent( in ) :: tolerance
      interface
         function f( x )
            real f
            real, intent( in ) :: x
         end function f
         function df( x )
            real df
            real, intent( in ) :: x
         end function df
      end interface
      optional df

      real tol

      ! Initialize tol.
      if ( present( tolerance ) ) then
         tol = tolerance
      else
         tol = DEFAULT_TOLERANCE
      end if

      ! Select the root-finding method.
      if ( present( df ) ) then   ! Use Newton's method.
         findRoot = newton( (a+b)/2, f, df, tol )
      else   ! Use secant method.
         findRoot = secant( a, b, f, tol )
      end if
   end function findRoot

   recursive function secant( a, b, f, tol ) result( root )
      implicit none
      real root
      real, intent( in ) :: a, b, tol
      interface 
         function f( x )
            real f
            real, intent( in ) :: x
         end function f
      end interface

      real c   ! The x-intercept of the secant line.
      real fa, fb, fc   ! f(a), f(b), and f(c), respectively.

      ! Initialize fa and fb.
      fa = f( a ); fb = f( b )

      ! Compute c, the x-intercept of the secant line given by 
      !  the two points, (a, f(a)) and (b, f(b)).
      c = a - fa * ( ( b - a ) / ( fb - fa ) )

      ! Compute the value of the function at this point.
      fc = f( c )

      ! Check for a sufficient root at c.  This could cause an
      !  infinite loop if the round-off error in the evaluation 
      !  of f( c ) exceeds the tolerance.

      if ( ( abs( fc ) <= tol ) .or. ( ( abs( c - b ) <= tol ) ) ) then   ! Root found.
         root = c
      else   ! Go again.
         ! Make sure the function is non-increasing in absolute
         !  value for each recursive call of secant.

         if ( abs( fa ) < abs( fb ) ) then   ! Use a and c.
            root = secant( a, c, f, tol )
         else   ! Use b and c.
            root = secant( b, c, f, tol )
         end if
      end if
   end function secant

   recursive function newton( guess, f, df, tol ) result( root )
      implicit none
      real root
      real, intent( in ) :: guess, tol
      interface 
         function f( x )
            real f
            real, intent( in ) :: x
         end function f

         function df( x )
            real df
            real, intent( in ) :: x
         end function df
      end interface

      real fGuess, dfGuess   ! f(guess), df(guess), respectively.
      real newGuess

      ! Calculate df(guess) and f(guess).
      fGuess = f( guess ); dfGuess = df( guess )

      ! Check for a sufficient root at c.  This could cause an
      !  infinite loop if the round-off error in the evaluation 
      !  of f( c ) exceeds the tolerance.

      if ( abs( fGuess ) <= tol ) then   ! Root found.
         root = guess
      else   ! Go again.
         newGuess = guess - fGuess / dfGuess
         root = newton( newGuess, f, df, tol )
      end if
   end function newton

end module RootFinders

The findRoot function defined above is quite convenient in its use of optional arguments. For example, x = findRoot( a, b, g, dg ) uses the default tolerance and calls newton, due to the presence of the derivative, dg. x = findRoot( a, b, g, dg, 1.0e-10 ) may be used to override this default tolerance. When the derivative of the function is not available, a call such as x = findRoot( a, b, g ), uses the default tolerance and calls secant, as no derivative is present. x = findRoot( a, b, g, tolerance=1.0e-10 ) overrides the default tolerance and calls secant. Notice that overriding the default tolerance when the derivative is not passed requires using the keyword tolerance. If this keyword were not used, the fourth argument would be incorrectly paired with the formal argument df, resulting in a type mismatch. A test program for the RootFinders module is given below.

program Test
   use RootFinders
   implicit none
   real a, b
   real, parameter :: tol = 1.0e-6
   interface 
      function f( x )
         real f
         real, intent( in ) :: x
      end function f

      function df( x )
         real df
         real, intent( in ) :: x
      end function df
   end interface

   print *, 'Enter left and right endpoints'
   read *, a, b
   print *, 'Newton:The root of f is ', findRoot( a, b, f, df )
   print *, 'Secant:The root of f is ', findRoot( a, b, f )

end program Test


function f( x )
   real f
   real, intent( in ) :: x

   f = x + exp( x )
end function f

function df( x )
   real df
   real, intent( in ) :: x

   df = 1 + exp( x )
end function df

exercise341


tex2html_wrap_inline827 .