untitled - PDF 免费下载

Fortran Chapter 7 Subroutine ( ) and Function 7-1 subroution 行不行來行 The general form of a subroutine is subroutine subroutine_name ( argument_list) (Declaration section) (Execution section) retrun end subroutine_name To call a subroutine, the calling program places a CALL statement in it s code. The form of a call statement is call subroutine_name ( argument_list) where the order and type of the actual arguments in the argument list must match the order and type of the dummy argunemts declared in the subroutine. Remark 立數若了數不不 1

Example Program ex0803 Implicit none integer :: A=1, b=2 call sub1() write(*,*) In main program: write(*, (2(A3,I3)) A=, A, B=, B stop end program ex0803 subroutine sub1() integer :: A=3, B=4 write(*,*) In subroutine sub1: write(*, (2(A3,I3)) A=, A, B=, B end 行 In subroutine sub1: A=3 b=4 In main program: A=1 b=2 Example Asimple subroutine to calculate the hypctenuse of a right triangle. subtoutine calc_hypotenuse( side_1, side_2, hypotenuse ) inplicit none real, intent(in) :: side_1, side_2 real, intent(out) :: hypotenuse real :: temp temp = side_1 ** 2 + side_2 ** 2 hypotenuse = sqrt(temp) end subroutine intent(in) 參數不數 intent(out) 參數數 intent(inout) 參數數 2

A test driver program fot subroutine calc_hyponteuse Program test_hypotenuse real :: S1, S2 real :: hypot write(*,*) Program to test suubroutine calc_hypotenuse: write(*,*) Enter the hength of side 1 read(*,*) S1 write(*,*) Enter the hength of side 2 read(*,*) S2 call calc_hypotenuse(s1, S2, hypot) write (*,10) hypot 10 Format(1X, The length of the hypotenuse is, F10.4) stop end program test_hypotenuse 3

7-1-1 variable passing in Fortran : The pass-by-reference scheme Fortran 參數數 Program test real :: a, b(4) integer :: next call sub1(a, b, next) end program test subroutine sub1(x, y, i) real, intent(out) :: x real, dimension(4), intent(in) :: y integer :: i end subroutine Memory address Main program name Subroutine name 001 a x 002 b(1) y(1) 003 b(2) y(2) 004 b(3) y(3) 005 b(4) y(4) 006 nest i 007 Example Illustrating the effects of a type mismatch when calling a subroutine. Program bad_call Implicit none real :: x = 1.0 call bad_argument(x) end program bad_call subroutine bad_argument(i) integer ::i write(*,*) I=, i end subroutine 行 I=106535321.6 4

7-1-2 Passing arrays to subroutines There are two possible approaches to specify the length of a dummy array in a subroutine (1) pass the bounds of each dimension of the array to the subroutine as arguments in the subroutine call and to declare the corresponding dummy array to be that length. Example: Subroutine process1(data1, data2, n, nvals) integer, intent(in) :: n, nvals real, intent(in), dimension(n) :: data1 real, intent(out), dimension(n) :: data2 do i = 1, nvals data2(i) = 3.0 * data1(i) end do end subroutine process1 (2) Declare the length of each dummy array with an asterisk as an assumed-size dummy array. Example: Subroutine process2(data1, data2, nvals) real, intent(in), dimension(*) :: data1 real, intent(out), dimension(*) :: data2 integer, intent(in) :: nvals do i = 1, nvals data2(i) = 3.0 * data1(i) end do end subroutine process2 Not Good. Complier array size. 5

7-2 save The values of all local variables and arrays in a procedure become indefined when we exist the procedure. SAVE: guarantee the local variables and arrays to be saved unchanged between calls to a procedure. Example: Subroutine running_average(x, ave, nvals, reset) Implicit none real, intent(in) :: x real, intent(out) :: ave integer, intent(out) :: nvals logical, intent(in) :: reset! List of local variables: integer, save :: n real, save :: sum_x if (reset) then n = 0; sum_x = 0.0; ave = 0.0; nvals = 0 else n = n+1 sum_x = sum_x + x ave = sum_x / real(n) nvals = n end if end subroutine running_average 6

7-3 Sharing data rusing modules Example: Program main Implicit none type :: mytype type end type mytype stop end program main subroutine sub1() Implicit none type :: mytype end type mytype end subroutine sub1() type 7

subroutine mytype 料 module 來 module typedef Implicit none type :: mytype end type mytype end module typefef program main use type def stop end program main subroutine sub1() use type def end subroutine sub1 module 來數 Example: Module vars real, save :: a, b, c end module vars 8

都數 a, b, c Example: Module constants real, parameter :: pi=3.14159 real, parameter :: g=9.81 end module constants program main use constants stop end program main subroutine sub1() use constants end subroutine sub1 9

7-4 Fortran Functions Two different types of functions : intrinsic functions and User_defined functions Intrinsic functions are built into the Fortran language e.q. sin(x) and log(x) The general form of a user_defined Fortran function is Function name (argument_list) (Declaration section must declare type of name) (Execution section) 數數 name = expr 數數 end function [name] The type declaration of a user_defined Fortran function can take one of two equivalent forms: integer function my_function (i, j) or function my_function (i, j) integer :: my_function 10

Example: A function to evaluate a quadratic polynomial of the form real function quadf(x, a, b, c) real, intent(in) :: x, a, b, c quadf = a * x ** 2 + b * x + c end function 2 quad ( x) = ax + bx + c program test_quadf real :: quadf real :: a, b, c, x write(*,*) Enter quadratic coefficients a, b and c : read(*,*) a, b, c write(*,*) Enter location at which to evaluate equation : real(*,*) x write(*,100) quadf(, x, )=, quadf(x, a, b, c) 100 format(a, F10.4, A, F12.4) stop end program test_quadf The function should never modify its own imput arguments. 11

7-5 Passing user_definited functions as arguments. Example: program test real, external :: fun_1, fun_2 real :: x, y, output call evaluate(fun_1, x, y, output) call evaluate(fun_2, x, y, output) end program test subroutine evaluate(fun, a, b, result) real, external :: fun real, intent(in) :: a, b real, intent(out) :: result result = b * fun(a) end subroutine evaluate 12

7-6 Procedure interfaces and interface blocks Interface between the function/subroutine and a calling program unit The general form of an interface is interface interface_body_1 interface_body_2 end interface Each interface_body consists of the initial subroutine or function statement of the corresponding external procedure, the type specification statemts associated with its arguments, and an end subroutine or end function statement. 13

Example: Program ex0815 Implicit none real :: angle, speed interface function get_distance(angle, speed) real :: get_distance real, intent(in) :: angle, speed end function get_distance end interface write(*,*) Input shoot angle: read(*,*) angle write(*,*) Input shoot speed: read(*,*) speed: write(*, (T2, A4, F7.2, 1A) ) Fly, get_distance(angle, speed), m stop end program ex0815 function get_distance(angle, speed) real :: get_distance real, intent(in) :: speed, angle real :: rad real, parameter :: G=9.81 interface function angle_to_rad(angle) real :: angle_to_rad real, intent(in) :: angle end function angle_to_rad(angle) end interface rad = angle_to_rad(angle) get_distance = (speed * cos(rad)) * (2.0 * speed * sin(rad) / G) end function get_distance 14

function angle_to_rad(angle) real :: angle_to_rad real, intent(in) :: angle real, parameter :: pi=3.14159 angle_to_rad = angle * pi / 180.0 end function angle_to_rad Fortran 90 interface interface (i) 參數來參數 (ii) 參數數不 (iii) 參數 (iv) 列參數 (v) 數列 (vi) 數 15

7-7 不數參數 Fortran 90 optional 來參數略 Example Program ex0817 imteger :: a=10, b=>0 interface subroutine sub(a, b) integer, intent(in) :: a integer, intent(in), optional :: b end subroutine sub end interface write(*,*) Call sub with arg a call sub(a) write(*,*) Call sub with arg a, b call sub(a, b) stop end program ex0817 來參數不 subroutine sub(a, b) integer, intent(in) :: a integer, intent(in), optional :: b write(*,*) a if (present(b)) write(*,*) b 數來參數 end subroutine sub Output: Call sub with arg a 10 Call sub with arg a, b 10 20 數 present optional 參數數 present 邏參數.true..false. 類不數參數 interface 16

7-8 Recursive procedures 數來行 3! = 3 2! 2! = 2 1! 2! 1! 1! = 1 0! 0! := 1 0! Example: program ex0818 integer :: n, ans interface subroutine fact(n, and) function fact(n) result(ans) integer, intent(in) :: n integer, intent(inout) :: ans end subroutine fact end interface write(*,*) Input N: read(*,*) n call fact(n, ans) 省略 for function fact write(*, (t2, i2, a3, i10) ) n,!=, ans fact(n) stop end program ex0818 17

recursive subroutine fact(n, ans) integer, intent(in) :: n integer, intent(inout) :: ans integer :: temp if (n<0) then ans>0 end if if (n>=1) then call fact(n-1, temp) ans = n * temp else ans = 1 end if end subroutine fact 來來數來來數來 recursive function fact(n) result(ans) 數數來數 integer, intent(in) :: n integer :: ans ans 數數 select case(n) case(0) ans = 1 case(1) ans = n * fact(n-1) ans fact 來數 case default ans = 0 end select end function fact 18

7-9 Contains statement ( ) Example: module module_example real :: x = 100.0 real :: y = 200.0 end module program scoping_test use module_example integer :: i = 1, j = 2 write(*, (A25, 2I7, 2f7.1) ) Beginning:, i, j, x, y call sub1(i, j) write(*, (A25, 2I7, 2f7.1) ) After sub1:, i, j, x, y call sub2(i, j) write(*, (A25, 2I7, 2f7.1) ) After sub2:, i, j, x, y contains subroutine sub2 real :: x x = 1000.0 y = 2000.0 Appears after the last excutable statement in program scoping_test. Only program scoping_test can use this subroutine sub2. write(*, (A25, 2F7.1) ) In sub2:, x, y end subroutine sub2 end program scoping_test 19

subroutine sub1(i, j) integer, intent(inout) :: i, j integer, dimension(5) :: array write(*, (A25, 2I7) ) In sub1 before sub2 :, i, j call sub2 write(*, (A25, 2I7) ) In sub1 after sub2 :, i, j array = (/(1000*i, i = 1, 5)/) write(*, (A25, 2I7) ) After array def in sub2 :, i, j, array contains subroutine sub2 integer :: i i = 1000 j = 2000 write(*, (A25, 2I7) ) In sub1 in sub2 :, i, j end subroutine sub2 end subroutine sub1 Module_example x, y Use Association Program scoping_test i, j local x, y from module i, j calling arguments Subroutine sub1 i, j dummy arguments local subroutine sub2 x local y inherited local subroutine sub2 i local j inherited 20

行 Beginning 1 2 100.0 200.0 In sub1 before sub2: 1 2 In sub1 in sub2: 1000 2000 In sub1 after sub2: 1 2000 After array def in sub2: 1 2000 1000 2000 3000 4000 5000 After sub1: 1 2000 100.0 200.0 In sub2: 1000.0 2000.0 After sub2: 1 2000 100.0 2000.0 module 數 module module_name use prher_module_name integer :: i type :: type_name end type :: type_name contains subroutine sub1(a) end subroutine sub1 function fun1(b) end function fun1 end module module_name 立 module module module module 數數 module module 來 contains module 數 21

Example: module constants real, parameter :: pi = 3.14159 real, parameter :: g = 9.81 end module constants module calculate_distance use constants contains function argle_to_rad(angle) real :: angle_to_rad real, intent(in) :: angle angle_to_rad = angle * pi / 180.0 end function argle_to_rad function get_distance(speed, angle) real :: get_distance real, intent(in) :: speed, angle real :: rad rad = angle_to_rad(angle) get_distance = (speed * cos(rad)) * (2.0 * speed * sin(rad) / g) end function get_distance end module calculate_distance program ex0820 use calculate_distance write(*,*) Input shoot angle: read(*,*) angle write(*,*) Input shoot speed: read(*,*) speed write(*, (T2, A4, F7.2, 1A) ) Fly, get_distance(angle, speed), m stop end program ex0820 22

7-10 Intrinsic, external Datatype, external :: Func1, Func2 Func1 Func2 不數 Intrinsic 來 real, intrinsic :: sin, cos 兩省略不參數來 external intrinsic 不省略 Example: program ex0821 real :: A = 30.0 real, intrinsic :: sin, cos real, external :: trig_func write(*,*) trig_func(sin, A) write(*,*) trig_func(cos, A) stop end program ex0821 function trig_func(func, x) real :: trig_func real, external :: func real, intent(in) :: x trig_func = func(x * 3.14159 / 180.0) end function trig_func 23