Fortran 90 Subprograms

1
Fortran 90 Subprograms

• Thus far, any procedure (subroutine or function)
  that we have used has an implicit interface. The
  compiler has no information about the argument
  list, and is therefore unable to check that it is
  correct it cannot verify that the actual and
  dummy arguments match.
• With an implicit interface, the assumption is
  that the programmer has got the number, type,
  intent, etc. of the arguments correct.
• But this can go wrong with unexpected
  consequences.

2
Simple Example

• SUBROUTINE calculate_hypotenuse (side_1,
  side_2, hypotenuse)
• IMPLICIT NONE
• ! Subroutine arguments
• INTEGER, PARAMETER isp KIND(1.0)
• REAL (KINDisp), INTENT(IN) side_1,
  side_2
• REAL (KINDisp), INTENT(OUT) hypotenuse
• ! Local variables
• REAL (KINDisp) temp
• ! Calculate hypotenuse
• temp side_12 side_22
• hypotenuse SQRT(temp)
• RETURN
• END SUBROUTINE calculate_hypotenuse

3
Simple Example

• PROGRAM right_angled_triangle
• IMPLICIT NONE
• INTEGER, PARAMETER idp KIND(1.0d0)
• REAL (KINDidp) a, b, c ! sides of
  right angled triangle
• !
• PRINT , 'Input shorter two sides of right
  angled triangle'
• READ , a,b
• !
• ! Determine and print hypotenuse
• !
• CALL calculate_hypotenuse (a,b,c)
• PRINT , 'Hypotenuse is', c
• STOP
• END PROGRAM right_angled_triangle

4
Simple Example

• lfreeman-module_example-gt gfortran -c -o
  hypotenuse_pitfall.out hypotenuse_pitfall.f
• lfreeman-module_example-gt gfortran -c -o
  triangle_pitfall.out triangle_pitfall.f
• lfreeman-module_example-gt gfortran
  triangle_pitfall.out hypotenuse_pitfall.out
• lfreeman-module_example-gt a.out
• Input shorter two sides of right angled
  triangle
• 3.0d0 4.0d0
• Hypotenuse is 4.085516692269676E-308
• lfreeman-module_example-gt

5
Module Procedures

• The way to avoid this difficulty is for each
  procedure (subroutine or function) to have an
  explicit interface. Then the compiler knows all
  of the details about the argument list, and check
  the interface to ensure that the procedure is
  called correctly.
• How do we arrange for a procedure to have an
  explicit interface?
• Include the subroutine (function) within a MODULE
  and then USE that module in the program unit that
  calls the subroutine (function).

6
Module Procedure

• Modules may contain subroutines and functions
  they may also contain shared data see later.
• These procedures are compiled as part of the
  module, and made available to a program unit by
  including a USE statement.
• When a procedure is compiled within a module and
  the module is used by a calling program, all the
  details of the procedures interface are made
  available to the compiler the arguments can be
  checked the procedure is said to have an
  explicit interface.

7
Module Procedure

• MODULE my_subs
• IMPLICIT NONE
• CONTAINS
• SUBROUTINE sub1 (a, b, c, x, error)
• IMPLICIT NONE
• ! Subroutine arguments
• REAL, INTENT(IN) a, b, c
• REAL, INTENT(OUT) x
• LOGICAL, INTENT(OUT) error
• ...
• RETURN
• END SUBROUTINE sub1
• END MODULE my_subs

8
Module Procedure

• The subroutine sub1 (and any other procedures
  contained in the MODULE my_subs) is made
  available for use in a calling program by
  including the statement
• USE my_subs
• as the first non-comment statement in the
  program unit.

9

• MODULE my_subroutines
• IMPLICIT NONE
• CONTAINS
• SUBROUTINE calculate_hypotenuse (side_1,
  side_2, hypotenuse)
• IMPLICIT NONE
• ! Subroutine arguments
• INTEGER, PARAMETER isp KIND(1.0)
• REAL (KINDisp), INTENT(IN) side_1,
  side_2
• REAL (KINDisp), INTENT(OUT) hypotenuse
• ! Local variables
• REAL (KINDisp) temp
• ! Calculate hypotenuse
• temp side_12 side_22
• hypotenuse SQRT(temp)
• RETURN
• END SUBROUTINE calculate_hypotenuse
• END MODULE my_subroutines

10

• PROGRAM right_angled_triangle
• USE my_subroutines
• IMPLICIT NONE
• INTEGER, PARAMETER idp KIND(1.0d0)
• REAL (KINDidp) a, b, c ! sides of right
  angled triangle
• !
• PRINT , 'Input shorter two sides of right
  angled triangle'
• READ , a,b
• !
• ! Determine and print hypotenuse
• !
• CALL calculate_hypotenuse (a,b,c)
• PRINT , 'Hypotenuse is', c
• STOP
• END PROGRAM right_angled_triangle

11

• lfreeman-module_example-gt gfortran -c -o
  hypotenuse_module.out hypotenuse_module.f
• lfreeman-module_example-gt gfortran -c -o
  triangle_module.out triangle_module.f
• In file triangle_module.f12
• CALL calculate_hypotenuse (a,b,c)
  
• 1
• Error Type/rank mismatch in argument 'side_1' at
  (1)
• lfreeman-module_example-gt

12

• MODULE my_subroutines
• IMPLICIT NONE
• CONTAINS
• SUBROUTINE calculate_hypotenuse (side_1,
  side_2, hypotenuse)
• IMPLICIT NONE
• ! Subroutine arguments
• INTEGER, PARAMETER isp KIND(1.0)
• REAL (KINDisp), INTENT(IN) side_1,
  side_2
• REAL (KINDisp), INTENT(OUT) hypotenuse
• ! Local variables
• REAL (KINDisp) temp
• ! Calculate hypotenuse
• temp side_12 side_22
• hypotenuse SQRT(temp)
• RETURN
• END SUBROUTINE calculate_hypotenuse
• END MODULE my_subroutines

13

• PROGRAM right_angled_triangle
• USE my_subroutines
• IMPLICIT NONE
• INTEGER, PARAMETER isp KIND(1.0)
• REAL (KINDisp) a, b, c ! sides of right
  angled triangle
• !
• PRINT , 'Input shorter two sides of right
  angled triangle'
• READ , a,b
• !
• ! Determine and print hypotenuse
• !
• CALL calculate_hypotenuse (a,b,c)
• PRINT , 'Hypotenuse is', c
• STOP
• END PROGRAM right_angled_triangle

14

• lfreeman-module_example-gt gfortran -c -o
  hypotenuse_module.out hypotenuse_module.f
• lfreeman-module_example-gt gfortran -c -o
  triangle_module.out triangle_module.f
• lfreeman-module_example-gt gfortran
  hypotenuse_module.out triangle_module.out
• lfreeman-module_example-gt a.out
• Input shorter two sides of right angled
  triangle
• 3.0 4.0
• Hypotenuse is 5.000000
• lfreeman-module_example-gt a.out
• Input shorter two sides of right angled
  triangle
• 5.0 12.0
• Hypotenuse is 13.00000
• lfreeman-module_example-gt

15
Passing User-Defined Functions as Arguments

• Typical scenarios
• Suppose we have available a subroutine solve that
  implements Newton-Raphson and we wish to pass
  different user-defined functions whose zeros are
  required.
• Suppose we have available a subroutine integrate
  that implements a repeated Newton-Cotes
  quadrature rule and we wish to pass different
  user-supplied functions that specify the
  integrands.

16
Passing User-Defined Functions as Arguments

• If a user-defined functions is named as an actual
  argument in a procedure call, then a pointer to
  the function is passed to the procedure.
• If the corresponding dummy argument in the
  procedure is a function, then when the procedure
  is executed, the user-defined function is used in
  place of the dummy function in the procedure.

17
Passing User-Defined Functions as Arguments

• So that the compiler knows that a user-defined
  function is being passed to a procedure, the
  function must be declared as EXTERNAL in both the
  calling program and the called procedure.
• A function may be declared either with an
  EXTERNAL attribute or in an EXTERNAL statement
• REAL, EXTERNAL fun_1, fun_2
• or
• EXTERNAL fun_1, fun_2
• where the type of fun_1, fun_2 appear in a
  separate declaration statement.

18

• MODULE my_subroutines
• IMPLICIT NONE
• INTEGER, PARAMETER isp KIND(1.0)
• CONTAINS
• SUBROUTINE evaluate (function, value_1,
  value_2, result)
• IMPLICIT NONE
• ! Subroutine arguments
• REAL (KINDisp), EXTERNAL function
• REAL (KINDisp), INTENT(IN) value_1,
  value_2
• REAL (KINDisp), INTENT(OUT) result
• ! Calculate result
• result value_2function(value_1)
• RETURN
• END SUBROUTINE evaluate
• !
• !

19

• REAL (KINDisp) FUNCTION f1(x)
• IMPLICIT NONE
• ! Subroutine arguments
• REAL (KINDisp), INTENT(IN) x
• f1 3.0x5.0
• RETURN
• END FUNCTION f1
• !
• !
• REAL (KINDisp) FUNCTION f2(x)
• IMPLICIT NONE
• ! Subroutine arguments
• REAL (KINDisp), INTENT(IN) x
• f2 x1.0
• RETURN
• END FUNCTION f2
• END MODULE my_subroutines

20

• PROGRAM test
• USE my_subroutines
• IMPLICIT NONE
• REAL (KINDisp), EXTERNAL f1, f2
• REAL (KINDisp) a, b, result_1, result_2
• !
• PRINT , 'Input values for a and b'
• READ , a,b
• ! Call subroutine evaluate to calculate
  bf1(a)
• CALL evaluate(f1, a , b, result_1)
• ! Call subroutine evaluate to calculate
  bf2(a)
• CALL evaluate(f2, a , b, result_2)
• !
• PRINT , 'bf1(a) ', result_1
• PRINT , 'bf2(a) ', result_2
• STOP
• END PROGRAM test

21
Recursive Procedures

• An ordinary Fortran 95 procedure may not invoke
  itself directly, or indirectly (by invoking
  another procedure that then invokes the original
  procedure).
• But, Fortran 95 allows functions and subroutines
  to be declared recursive.
• A subroutine is declared recursive by adding
  RECURSIVE to the SUBROUTINE statement.
• RECURSIVE SUBROUTINE FACTORIAL(n, result)

22
Recursive Subroutine

• As an example of a recursive subroutine, N! can
  defined as follows

23

• PROGRAM test
• USE my_factorial_subroutine
• IMPLICIT NONE
• INTEGER (KIND int_range) k, result
• !
• ! integer whose factorial is required
• !
• PRINT , 'Input the integer k'
• READ , k
• !
• CALL factorial (k,result)
• !
• PRINT , k, "factorial is ", result
• !
• STOP
• !
• END PROGRAM test

24

• MODULE my_factorial_subroutine
• IMPLICIT NONE
• INTEGER, PARAMETER int_range
  SELECTED_INT_KIND (5)
• CONTAINS
• RECURSIVE SUBROUTINE factorial(n,result)
• IMPLICIT NONE
• INTEGER (KIND int_range) ,
  INTENT(IN) n
• INTEGER (KIND int_range) ,
  INTENT(OUT) result
• !
• IF (n 0) THEN
• result 1
• ELSE
• CALL factorial (n-1, result)
• result n result
• END IF
• !
• RETURN
• END SUBROUTINE factorial
• END MODULE my_factorial_subroutine

25
Recursive Functions

• It is also possible to define recursive
  functions, but there is an extra complication.
• The difficulty is that, if a function were to
  invoke itself, the function name would appear
  both on the left hand side of an assignment
  statement when its return value is being set, and
  on the right hand side of an assignment statement
  when it is invoking itself recursively these
  conflicting uses of the function name could cause
  confusion.

26
Recursive Functions

• Fortran requires that two different names are
  used, one for invoking the function recursively,
  and one for returning the result.
• The actual name of the function is used whenever
  the function is invoked recursively, and a
  special dummy name (specified in a RESULT clause
  in the FUNCTION definition) is used to return
  the result.
• RECURSIVE FUNCTION fact(n) RESULT(answer)

27
Recursive Functions

• If a RESULT clause is included in a function,
  then the function name must not appear in a type
  declaration in the function the name of the
  dummy result variable is declared instead.

28

• PROGRAM test
• USE my_factorial_function
• IMPLICIT NONE
• INTEGER (KIND int_range) k, result
• INTEGER (KIND int_range) fact
• !
• ! integer whose factorial is required
• !
• PRINT , 'Input the integer k'
• READ , k
• !
• result fact (k)
• !
• PRINT , k, "factorial is ", result
• !
• STOP
• !
• END PROGRAM test

29

• MODULE my_factorial_function
• IMPLICIT NONE
• INTEGER, PARAMETER int_range
  SELECTED_INT_KIND (5)
• CONTAINS
• RECURSIVE FUNCTION fact(n)
  RESULT(number)
• IMPLICIT NONE
• INTEGER (KIND int_range) ,
  INTENT(IN) n
• INTEGER (KIND int_range) number
• !
• IF (n 0) THEN
• number 1
• ELSE
• number n fact(n-1)
• END IF
• !
• RETURN
• END FUNCTION fact
• END MODULE my_factorial_function

30
Keyword Arguments and Optional Arguments

• Provided that the interface to a procedure is
  explicit, it is possible to change the order of
  the actual arguments in the argument list, or to
  specify actual arguments for only some of the
  procedures dummy arguments.
• The former is achieved using keyword arguments
• keyword actual_argument
• where keyword is the name of the dummy argument
  that is being associated with the actual argument.

31

• MODULE my_subroutines
• IMPLICIT NONE
• INTEGER, PARAMETER isp KIND(1.0)
• CONTAINS
• SUBROUTINE evaluate (function, value_1,
  value_2, result)
• IMPLICIT NONE
• ! Subroutine arguments
• REAL (KINDisp), EXTERNAL function
• REAL (KINDisp), INTENT(IN) value_1,
  value_2
• REAL (KINDisp), INTENT(OUT) result
• ! Calculate result
• result value_2function(value_1)
• RETURN
• END SUBROUTINE evaluate
• !

32

• !
• REAL (KINDisp) FUNCTION f1(x)
• IMPLICIT NONE
• ! Subroutine arguments
• REAL (KINDisp), INTENT(IN) x
• f1 3.0x5.0
• RETURN
• END FUNCTION f1
• END MODULE my_subroutines

33

• PROGRAM test
• USE my_subroutines
• IMPLICIT NONE
• REAL (KINDisp), EXTERNAL f1
• REAL (KINDisp) a, b, result_1
• !
• PRINT , 'Input values for a and b'
• READ , a,b
• ! Call subroutine evaluate to calculate
  bf1(a)
• CALL evaluate(f1, a , b, result_1)
• PRINT , 'bf1(a) ', result_1
• !
• CALL evaluate(function f1, value_1 a ,
  value_2 b,
• result result_1)
• PRINT , 'bf2(a) ', result_1
• !
• CALL evaluate(result result_1, value_2
  b, value_1 a ,
• function f1)
• PRINT , 'bf2(a) ', result_1

34
Optional Arguments

• An optional argument is a procedure dummy
  argument that does not always have to be present
  when the procedure is invoked.
• If it is present, the procedure will use it, if
  not, the procedure must be able to function
  without it.
• An optional argument is specified by including
  the OPTIONAL attribute in the declaration of the
  dummy argument
• INTEGER, INTENT(IN), OPTIONAL upper_limit

35
Optional Arguments

• The procedure can determine the presence, or
  otherwise, of an optional argument using the
  logical intrinsic function PRESENT, and take
  appropriate action
• IF ( PRESENT(upper_limit)) THEN
• ...
• ELSE
• ...
• ENDIF