This lesson just contains some extra material(s) to be discussed in the final lecture. The discriptions here are quite brief.
In Fortran 77 many of the intrinsic functions (sin, cos, abs) return the same type as they receive as an argument. These are known as generic functions. There was no way in Fortran 77 to do the same for user routines. Here is an example of Fortran 90 generic subroutines from Fortran 90 for the Fortran 77 Programmer. This example defines a subroutine, SWAP, which works for reals, integers and characters. Note that while this example only defines a genereic subroutine, generic functions are written in the same way.
MODULE SWAPPER INTERFACE SWAP MODULE PROCEDURE SWAP_R, SWAP_I, SWAP_C END INTERFACE CONTAINS SUBROUTINE SWAP_R(A, B) IMPLICIT NONE REAL, INTENT (INOUT) :: A, B REAL :: TEMP TEMP = A ; A = B ; B = TEMP END SUBROUTINE SWAP_R SUBROUTINE SWAP_I(A, B) IMPLICIT NONE INTEGER, INTENT (INOUT) :: A, B INTEGER :: TEMP TEMP = A ; A = B ; B = TEMP END SUBROUTINE SWAP_I SUBROUTINE SWAP_C(A, B) IMPLICIT NONE CHARACTER, INTENT (INOUT) :: A, B CHARACTER :: TEMP TEMP = A ; A = B ; B = TEMP END SUBROUTINE SWAP_C END MODULE SWAPPER
Here is a simple program to use the SWAP subroutine:
PROGRAM SWAP_MAIN USE SWAPPER IMPLICIT NONE INTEGER :: I, J, K, L REAL :: A, B, X, Y CHARACTER :: C, D, E, F I = 1 ; J = 2 ; K = 100 ; L = 200 A = 7.1 ; B = 10.9 ; X = 11.1; Y = 17.0 C = 'a' ; d = 'b' ; E = '1' ; F = '"' WRITE (*,*) I, J, K, L, A, B, X, Y, C, D, E, F CALL SWAP (I, J) ; CALL SWAP (K, L) CALL SWAP (A, B) ; CALL SWAP (X, Y) CALL SWAP (C, D) ; CALL SWAP (E, F) WRITE (*,*) I, J, K, L, A, B, X, Y, C, D, E, F END
Here is (long) an example which shows both modules procedures and operator overloading. The purpose of this example is to define a matrix type so that the following things work as they would in Matlab:
type(matrix), dimension(n,n) :: A, B, C type(matrix), dimension(n) :: x, b A = B * C b = A * x x = b / A
A normal array of reals in Fortran 90 would do addition, subtraction and assignment correctly. However, it would do multiplication and division element-wise as explained in class. The module below defines the matrix type and the =, +, -, * and / operators for it. Note that the operators are defined in the same manner as other generic subprograms.
! matrix.f90 ! ! Module for matrix type and operations ! by Paul H. Hargrove ! May 13, 1996 ! module operator type matrix real elem end type matrix interface assignment(=) module procedure matrix_from_real, matrix_from_matrix, & vector_from_real, vector_from_vector end interface interface operator(+) module procedure matrix_add, vector_add end interface interface operator(-) module procedure matrix_sub, vector_sub end interface interface operator(*) module procedure matrix_mul, vector_mul, matrix_vector_mul end interface interface operator(/) module procedure matrix_div, matrix_vector_div end interface contains ! ! ASSIGNMENT OPERATORS: X = Y ! subroutine matrix_from_real(X, Y) ! copy a 2D array of reals to a 2D array of type matrix real, intent(in), dimension(:,:) :: Y type(matrix), intent(out), dimension(size(Y,1),size(Y,2)) :: X X(:,:)%elem = Y(:,:) end subroutine matrix_from_real subroutine matrix_from_matrix(X, Y) ! copy a 2D array of type matrix type(matrix), intent(in), dimension(:,:) :: Y type(matrix), intent(out), dimension(size(Y,1),size(Y,2)) :: X X(:,:)%elem = Y(:,:)%elem end subroutine matrix_from_matrix subroutine vector_from_real(X, Y) ! copy a 1D array of reals to a 1D array of type matrix real, intent(in), dimension(:) :: Y type(matrix), intent(out), dimension(size(Y,1)) :: X X(:)%elem = Y(:) end subroutine vector_from_real subroutine vector_from_vector(X, Y) ! copy a 1D array of type matrix type(matrix), intent(in), dimension(:) :: Y type(matrix), intent(out), dimension(size(Y,1)) :: X X(:)%elem = Y(:)%elem end subroutine vector_from_vector ! ! ADDITION OPERATORS: X = Y + Z ! function matrix_add(Y, Z) result(X) ! add 2D arrays of type matrix type(matrix), intent(in), dimension(:,:) :: Y type(matrix), intent(in), dimension(size(Y,1),size(Y,2)) :: Z type(matrix), dimension(size(Y,1),size(Y,2)) :: X X(:,:)%elem = Y(:,:)%elem + Z(:,:)%elem end function matrix_add function vector_add(Y, Z) result(X) ! add 1D arrays of type matrix type(matrix), intent(in), dimension(:) :: Y type(matrix), intent(in), dimension(size(Y,1)) :: Z type(matrix), dimension(size(Y,1)) :: X X(:)%elem = Y(:)%elem + Z(:)%elem end function vector_add ! ! SUBTRACTION OPERATORS: X = Y - Z ! function matrix_sub(Y, Z) result(X) ! subtract 2D arrays of type matrix type(matrix), intent(in), dimension(:,:) :: Y type(matrix), intent(in), dimension(size(Y,1),size(Y,2)) :: Z type(matrix), dimension(size(Y,1),size(Y,2)) :: X X(:,:)%elem = Y(:,:)%elem - Z(:,:)%elem end function matrix_sub function vector_sub(Y, Z) result(X) ! subtract 1D arrays of type matrix type(matrix), intent(in), dimension(:) :: Y type(matrix), intent(in), dimension(size(Y,1)) :: Z type(matrix), dimension(size(Y,1)) :: X X(:)%elem = Y(:)%elem - Z(:)%elem end function vector_sub ! ! MULTIPLICATION OPERATORS: X = Y * Z ! function matrix_mul(Y, Z) result(X) ! multiply 2D arrays of type matrix ! NOTE: NAG's F90 demo won't deal w/ "half constrained" dimensions type(matrix), intent(in), dimension(:,:) :: Y type(matrix), intent(in), dimension(:,:) :: Z type(matrix), dimension(size(Y,1),size(Z,2)) :: X X(:,:)%elem = MATMUL(Y(:,:)%elem, Z(:,:)%elem) end function matrix_mul function vector_mul(Y, Z) result(X) ! multiply 1D arrays of type matrix type(matrix), intent(in), dimension(:) :: Y type(matrix), intent(in), dimension(size(Y,1)) :: Z real X X = DOTPRODUCT(Y(:)%elem, Z(:)%elem) end function vector_mul function matrix_vector_mul(Y, Z) result(X) ! multiply 2D array times 1D array of type matrix type(matrix), intent(in), dimension(:,:) :: Y type(matrix), intent(in), dimension(size(Y,2)) :: Z type(matrix), dimension(size(Y,1)) :: X X(:)%elem = MATMUL(Y(:,:)%elem, Z(:)%elem) end function matrix_vector_mul ! ! DIVISION OPERATORS: X = Y/Z = INV(Z) * Y ! function matrix_div(Y, Z) result(X) ! "divide" 2D arrays of type matrix type(matrix), intent(in), dimension(:,:) :: Y type(matrix), intent(in), dimension(:,:) :: Z type(matrix), dimension(size(Y,1),size(Y,2)) :: X real, dimension(size(Z,1),size(Z,2)) :: W integer i, j, k, n ! copy arguments so they aren't modified W(:,:) = Z(:,:)%elem X(:,:)%elem = Y(:,:)%elem ! perform Gauss elimination on augmented matrix (W|X) n = size(Z,2) do k = 1,n-1 do i=k+1,n W(i,k) = W(i,k)/W(k,k) X(i,:)%elem = X(i,:)%elem - W(i,k) * X(k,:)%elem end do do j=k+1,n do i=k+1,n W(i,j) = W(i,j) - W(i,k) * W(k,j) end do end do end do ! perform back substitution on X do k = n,1,-1 X(k,:)%elem = X(k,:)%elem / W(k,k) do i=1,k-1 X(i,:)%elem = X(i,:)%elem - W(i,k) * X(k,:)%elem end do end do end function matrix_div function matrix_vector_div(Y, Z) result(X) ! "divide" 1D array by 2D array of type matrix type(matrix), intent(in), dimension(:) :: Y type(matrix), intent(in), dimension(:,:) :: Z type(matrix), dimension(size(Y,1)) :: X real, dimension(size(Z,1),size(Z,2)) :: W integer i, j, k, n ! copy arguments so they aren't modified W(:,:) = Z(:,:)%elem X(:)%elem = Y(:)%elem ! perform Gauss elimination on augmented matrix (W|X) n = size(Z,2) do k = 1,n-1 do i=k+1,n W(i,k) = W(i,k)/W(k,k) X(i)%elem = X(i)%elem - W(i,k) * X(k)%elem end do do j=k+1,n do i=k+1,n W(i,j) = W(i,j) - W(i,k) * W(k,j) end do end do end do ! perform back substitution on X do k = n,1,-1 X(k)%elem = X(k)%elem / W(k,k) do i=1,k-1 X(i)%elem = X(i)%elem - W(i,k) * X(k)%elem end do end do end function matrix_vector_div end module operator
Copyright © 1998 by Stanford University. All rights reserved.