Chapter 7 Subroutine and Function

7-1 subroution(副程式) 主程式 (program) 副程式 (subroutine) 程式碼在程式一開始就自動會去執行 不會自動執行自己的程式碼，它需要別人來"呼叫"它後，才會執行屬於自己的程式碼

7-1 subroution(副程式) program main … call sub_1 ( argument_list) end program main subroutine sub_1 ( argument_list) return end subroutine sub_1 主程式 (program) 副程式 (subroutine) 呼叫副程式 傳遞主副程式間的參數，其順序和資料型態必須相同 副程式的名稱 回到主程式

7-1 subroution(副程式) 主副程式變數的宣告 副程式獨立地擁有屬於自己 的變數宣告，若主程式與副 程式用了同樣的變數名稱， 那它們仍然互不相關的，彼 此之間不會有任何的關係。 < Ex. 完整程式> program ex0701 implicit none integer :: A=1, b=2 call sub1() write(*,*) 'In main program:' write(*, '(2(A3,I3))') 'A=', A, 'B=', B stop end program ex0701 <接下頁>

7-1 subroution(副程式) < Ex. 完整程式> < Ex. 執行結果> subroutine sub1() implicit none integer :: A=3, B=4 write(*,*) 'In subroutine sub1:' write(*, '(2(A3,I3))') 'A=', A, 'B=', B return end subroutine sub1 < Ex. 執行結果> In subroutine sub1: A= 3 B= 4 In main program: A= 1 B= 2

7-1 subroution(副程式) 副程式內參數的宣告 real, intent(in) :: A intent(out) ← 表示這個參數可以在副程式中改變數值(變數 只能放在=右邊) intent(inout) ← 表示這個參數可以在副程式中傳入或傳回數值

7-1 subroution(副程式) 副程式內參數的宣告 < Ex. 完整程式> <接下頁> 輸入直角三角形的兩股長，求其斜邊長 program test_hypotenuse implicit none 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 <接下頁>

7-1 subroution(副程式) 副程式內參數的宣告 < Ex. 完整程式> <接下頁> 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 <接下頁>

7-1 subroution(副程式) 副程式內參數的宣告 < Ex. 完整程式> < Ex. 執行結果> subroutine calc_hypotenuse( side_1, side_2, hypotenuse ) implicit none real, intent(in) :: side_1, side_2 real, intent(out) :: hypotenuse real :: temp temp = side_1 ** 2 + side_2 ** 2 hypotenuse = sqrt(temp) return end subroutine calc_hypotenuse < Ex. 執行結果> Enter the hength of side 1 3 <輸入 3 [ENTER] > Enter the hength of side 2 4 <輸入 4 [ENTER] > The length of the hypotenuse is 5.0000

7-1 subroution(副程式) 參數的傳遞 pass-by-reference Fortran在傳遞參數時， 記憶體 位置 主程式 副程式 001 a x 002 b(1) y(1) 003 b(2) y(2) 004 b(3) y(3) 005 b(4) y(4) 006 next i 參數的傳遞 pass-by-reference Fortran在傳遞參數時， 是傳遞這個變數的記憶體位址 < Ex. 程式片段> 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 sub1

7-1 subroution(副程式) 參數的傳遞 傳遞參數要注意參數的資料型態和順序 real :: a, b(4) real, intent(out) :: x real, dimension(4), intent(in) :: y integer :: next integer :: I call sub1(a, b, next) subroutine sub1(x, y, i)

7-1 subroution(副程式) 參數的傳遞 < Ex. 完整程式> < Ex. 執行結果> 錯誤範例：參數傳遞時資料型態不同 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 bad_argument < Ex. 執行結果> I= 1065353216

7-1 subroution(副程式) 陣列參數的傳遞 利用傳遞參數的方式傳遞陣列大小 < Ex.程式片段> 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 return end subroutine process1

7-1 subroution(副程式) 陣列參數的傳遞 利用*作為假定的陣列大小宣告陣列 < Ex.程式片段> 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 return end subroutine process2 Not Good. Complier無法偵測運算時，array的大小是否超過實際size

7-2 save 程式說明 integer, save :: n

7-2 save < Ex.程式片段> <接下頁> 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 <接下頁>

7-2 save < Ex.程式片段> 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 return end subroutine running_average

7-3 利用module共用資料 共用自訂資料型態 < Ex.程式片段> < Ex.程式片段> module typedef type :: mytype ... end type mytype end module typedef program main implicit none use typedef ... stop end program main subroutine sub1() implicit none use typedef ... return end subroutine sub1 < Ex.程式片段> program main implicit none type :: mytype ... end type mytype ... stop end program main subroutine sub1() implicit none type :: mytype ... end type mytype ... return end subroutine sub1 主程式與subroutine皆需使用mytype的資料型態 右邊的寫法較為繁雜，可以使用module來簡化之

7-3 利用module共用資料 全域變數 < Ex.程式片段> module vars implicit none real, save :: a, b, c end module vars program main use vars ... stop end program main subroutine sub1() use vars ... return end subroutine sub1 在程式中，使用模組的主副程式，都可以使用到一樣的變數a, b, c

7-3 利用module共用資料 共用常數 < Ex.程式片段> module constants implicit none 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 ... return end subroutine sub1 在程式中，使用模組的主副程式，就可以使用模組內宣告的常數

7-4 Fortran Functions 程式內定函數 內建在Fortran語言，可以直接使用 Ex. sin(x) 或 log(x)

7-4 Fortran Functions 自定函數 呼叫函數，同時也代表函數回傳的值 自定函數 program main integer :: fun_1 … … = fun_1 ( argument_list) … end program main function fun_1 ( argument_list) integer :: fun_1 … fun_1 = … return end function fun_1 主程式 (program) 函數 (function) 傳遞主程式與函數間的參數，其順序和資料型態必須相同，注意函數不會修改傳入的參數 副程式的名稱 在函數結束之前，記得要把"函數名稱"設定一個數值，這個數值會傳回呼叫處 回到主程式

7-4 Fortran Functions 函數的宣告 function fun_1 (argument_list) integer :: fun_1 … ≡integer function fun_1(argument_list) 函數內必須宣告一個與函數名稱相同的變數，用來回傳值 直接在函數前宣告

7-4 Fortran Functions < Ex. 完整程式> <接下頁> program test_quadf implicit none 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 :' read(*,*) x write(*,100) 'quadf(', x, ')=', quadf(x, a, b, c) 100 format(A, F10.4, A, F12.4) stop end program test_quadf <接下頁>

7-4 Fortran Functions < Ex. 完整程式> < Ex. 執行結果> real function quadf(x, a, b, c) implicit none real, intent(in) :: x, a, b, c quadf = a * x ** 2 + b * x + c return end function quadf < Ex. 執行結果> Enter quadratic coefficients a, b and c : 1 2 3 <輸入 1 [SPACE] 2 [SPACE] 3 [ENTER] > Enter location at which to evaluate equation : 4 <輸入 4 [ENTER] > quadf( 4.0000)= 27.0000

7-5 利用參數的方式傳遞自訂函數 < Ex.程式片段> < Ex.程式片段> <接右> 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 <接右> 在宣告函數時，加入externa表示可在主副程式間傳遞的函數 函數當作參數傳入副程式 < Ex.程式片段> subroutine evaluate(fun, a, b, result) real, external :: fun real, intent(in) :: a, b real, intent(out) :: result result = b * fun(a) return end subroutine evaluate 使用函數

7-6 Interface(介面) 程式說明 interface … ... end interface 包含subroution與function的頭尾 還有傳入參數的宣告部分

7-6 Interface(介面) < Ex. 完整程式> <接下頁> program ex0702 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 <接下頁>

7-6 Interface(介面) < Ex. 完整程式> <接下頁> 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 ex0702 <接下頁>

7-6 Interface(介面) < Ex. 完整程式> <接下頁> function get_distance(angle, speed) implicit none real :: get_distance real, intent(in) :: speed , angle real :: rad real, parameter :: G=9.81 <接下頁>

7-6 Interface(介面) < Ex. 完整程式> <接下頁> interface function angle_to_rad(angle) implicit none real :: angle_to_rad real, intent(in) :: angle end function angle_to_rad end interface rad = angle_to_rad(angle) get_distance = (speed * cos(rad)) * (2.0 * speed * sin(rad) / G) return end function get_distance <接下頁>

7-6 Interface(介面) < Ex. 完整程式> < Ex. 執行結果> function angle_to_rad(angle) implicit none real :: angle_to_rad real, intent(in) :: angle real, parameter :: pi=3.14159 angle_to_rad = angle * pi / 180.0 return end function angle_to_rad < Ex. 執行結果> Input shoot angle: 60 <輸入 6 0 [ENTER] > Input shoot speed: 20 <輸入 2 0 [ENTER] > Fly 35.31m

7-6 Interface(介面) Fortran 90 的標準並沒有嚴格限制一定要寫作 interface，但是在下面的情況之下，寫作 指定參數位置來傳遞參數時 所呼叫的函式參數數目不固定時 傳入指標參數時 陣列參數沒有設定大小時 函數傳回值為陣列時 函數傳回值為指標時

7-7 不定個數的參數傳遞 程式說明 integer, intent(in), optional :: b present(b) Fortran 90中，我們可以用optional這個敘述來表示某些參數是"可以忽略的" present可以查看宣告成optional的參數是否有傳入，函數present的傳回值是邏輯值，如果有傳入查看的參數，就會傳回 .true.，沒有則傳回 .false.

7-7 不定個數的參數傳遞 < Ex. 完整程式> <接下頁> program ex0703 implicit none integer :: a=10, b=20 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) <接下頁> 要呼叫不定數目參數的函數時，一定要先宣告出函數的interface 使用optional 這個敘述來表示後面所宣告的參數可以不一定要傳入

7-7 不定個數的參數傳遞 < Ex. 完整程式> < Ex. 執行結果> write(*,*) 'Call sub with arg a, b' call sub(a, b) stop end program ex0703 subroutine sub(a, b) implicit none integer, intent(in) :: a integer, intent(in), optional :: b write(*,*) a if (present(b)) write(*,*) b return end subroutine sub < Ex. 完整程式> < Ex. 執行結果> Call sub with arg a 10 Call sub with arg a, b 20 present用來檢查參數b是否有傳入

7-8 Recursive(遞迴)procedures 程式說明 recursive subroutine fact(n, ans) … call fact(n-1, temp) 加入recursive表示副程式或是函數可以自己呼叫自己來執行，叫做"遞迴" 在副程式或函數內呼叫自己

7-8 Recursive(遞迴)procedures 遞迴說明 Ex.算n階層 3!=3*2! 2!=2*1! 1!=1*0! 0!=1 遞迴規則n!=n*(n-1)! 將算出的結果回傳

7-8 Recursive(遞迴)procedures < Ex. 完整程式> program ex0704 implicit none integer :: n, ans interface subroutine fact(n, ans) integer, intent(in) :: n integer, intent(inout) :: ans end subroutine fact end interface write(*,*) 'Input N:' read(*,*) n <接下頁> 自己呼叫自己的副程式時要先宣告出副程式的interface

7-8 Recursive(遞迴)procedures < Ex. 完整程式> call fact(n, ans) write(*, '(t2, i2, a3, i10)') n, '!=', ans stop end program ex0704 recursive subroutine fact(n, ans) implicit none integer, intent(in) :: n integer, intent(inout) :: ans integer :: temp <接下頁> 副程式 fact 的一開頭就以recursive來起頭表示這個副程式可以遞迴地來被自己呼叫

7-8 Recursive(遞迴)procedures < Ex. 完整程式> if (n<0) then ans=0 return end if if (n>=1) then call fact(n-1, temp) ans = n * temp else ans = 1 end subroutine fact < Ex. 執行結果> TEST 呼叫本身副程式

7-8 Recursive(遞迴)procedures < Ex. 完整程式> program ex0704 implicit none integer :: n, ans interface function fact(n) result(ans) integer, intent(in) :: n integer, intent(inout) :: ans end function fact(n) result(ans) end interface write(*,*) 'Input N:' read(*,*) n <接下頁> 自己呼叫自己的函數時要先宣告出函數的interface

7-8 Recursive(遞迴)procedures < Ex. 完整程式> write(*, '(t2, i2, a3, i10)') n, '!=', fact(n) stop end program ex0704 recursive function fact(n) result(ans) implicit none integer, intent(in) :: n integer :: ans <接下頁> 宣告"ans"變數的型態也就等於宣告函數傳回值的型態

7-8 Recursive(遞迴)procedures < Ex. 完整程式> select case(n) case(0) ans = 1 case(1) ans = n * fact(n-1) case default ans = 0 end select return end function fact 改用ans，而非fact來設定函數的傳回值 < Ex. 執行結果> TEST

7-9 Contains statement 定義某些函數或副程式只能被某個特定的函數(或 副程式)、或是只能在主程式中被呼叫 program scoping_test … call sub2 contains subroutine sub2 end subroutine sub2 end program scoping_test 定義副程式sub2只能在主程式中scoping_test使用 contains敘述都放在整個區塊的最後面

7-9 Contains statement < Ex. 完整程式> <接下頁> module module_example implicit none real :: x = 100.0 real :: y = 200.0 end module module_example program scoping_test use module_example integer :: i = 1, j = 2 write(*, '(A25, 2I7, 2f7.1)') 'Beginning:', i, j, x, y <接下頁>

7-9 Contains statement < Ex. 完整程式> <接下頁> call sub1(i, j) write(*, '(A25, 2I7, 2f7.1)') 'After sub1:', i, j, x, y call sub2 write(*, '(A25, 2I7, 2f7.1)') 'After sub2:', i, j, x, y contains subroutine sub2 real :: x x = 1000.0 y = 2000.0 write(*, '(A25, 2F7.1)') 'In sub2:', x, y end subroutine sub2 end program scoping_test <接下頁>

7-9 Contains statement < Ex. 完整程式> <接下頁> subroutine sub1(i, j) implicit none integer, intent(inout) :: i, j integer, dimension(5) :: array write(*, '(A25, 2I7)') 'In sub1 before sub2 :', i, j call sub3 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 <接下頁>

7-9 Contains statement < Ex. 完整程式> contains subroutine sub3 integer :: i i = 1000 j = 2000 write(*, '(A25, 2I7)') 'In sub1 in sub3 :', i, j end subroutine sub3 end subroutine sub1

7-9 Contains statement < Ex. 執行結果> Beginning: 1 2 100.0 200.0 In sub1 before sub2 : 1 2 In sub1 in sub3 : 1000 2000 In sub1 after sub2 : 1 2000 After array def in sub2 : 1 2000 TEST ? 2000 3000 ? 5000 After sub1: 1 2000 100.0 200.0 In sub2: 1000.0 2000.0 After sub2: 1 2000 100.0 2000.0

7-9 Contains statement 模組中可以容納其他模組、副程式與函數的存在 < Ex.程式片段> module module_name use prher_module_name implicit none 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中的副程式來使用 要先加上contains，再開始寫module中的副程式式或函數

7-9 Contains statement < Ex. 完整程式> <接下頁> module constants implicit none real, parameter :: pi = 3.14159 real, parameter :: g = 9.81 end module constants module calculate_distance use constants contains function angle_to_rad(angle) real :: angle_to_rad <接下頁>

7-9 Contains statement < Ex. 完整程式> <接下頁> real, intent(in) :: angle angle_to_rad = angle * pi / 180.0 return end function angle_to_rad function get_distance(angle, speed) implicit none 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) <接下頁>

7-9 Contains statement < Ex. 完整程式> < Ex. 執行結果> end function get_distance end module calculate_distance program ex0705 use calculate_distance implicit none real :: speed, angle 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 ex0705 < Ex. 執行結果> Input shoot angle: 60 <輸入 6 0 [ENTER] > Input shoot speed: 20 <輸入 2 0 [ENTER] > Fly 35.31m

7-10 Intrinsic & External 在實際寫作程式時，intrinsic與external可以省 略，不過當我們要把函式名稱當成參數來傳遞到 其它函式中時，external及intrinsic就不能省略 integer, external :: Func1, Func2 real, intrinsic :: sin, cos 宣告Func1及Func2是程式中的函式名稱，而不是變數 Intrinsic則是用來宣告某個名詞所指的是庫存的函式

7-10 Intrinsic & External < Ex. 完整程式> <接右> program ex0706 implicit none 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 ex0706 function trig_func(func, x) real :: trig_func real, external :: func real, intent(in) :: x trig_func = func(x * 3.14159 / 180.0) return end function trig_func <接右> < Ex. 執行結果> 0.49999964 0.8660256