PROGRAM SWAP_MAIN IMPLICIT NONE INTEGER :: I, J, K, L REAL :: A, B, X, Y CHARACTER :: C, D, E, F INTERFACE SWAP SUBROUTINE SWAP_R(A, B) REAL, INTENT (INOUT) :: A, B END SUBROUTINE SWAP_R SUBROUTINE SWAP_I(A, B) INTEGER, INTENT (INOUT) :: A, B END SUBROUTINE SWAP_I SUBROUTINE SWAP_C(A, B) CHARACTER, INTENT (INOUT) :: A, B END SUBROUTINE SWAP_C END INTERFACE 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 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_CThe above works very well, but the user is not so happy to have to care with all the information about

f90 part2.f90 part1.f90Here the modules follow, it could be in the file

MODULE BO 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 BOHere follows the main program, which is now cleaned of all uninteresting information about

PROGRAM SWAP_MAIN USE BO 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

Last modified: 3 February 1997