Chapter 7 Subroutine and Function 7 1 subroution
Chapter 7 Subroutine and Function
7 -1 subroution(副程式) program main … 主程式 (program) call sub_1 ( argument_list) … 呼叫副程式 end program main 副程式 (subroutine) 傳遞主副程式間的 參數,其順序和資 料型態必須相同 subroutine sub_1 ( argument_list) … return 副程式的名稱 回到主程式 end subroutine sub_1
7 -1 subroution(副程式) < Ex. 完整程式> subroutine sub 1() < Ex. 執行結果> implicit none In subroutine sub 1: integer : : A=3, B=4 A= 3 B= 4 write(*, *) 'In subroutine sub 1: ' In main program: write(*, '(2(A 3, I 3))') 'A=', A, 'B=', B A= 1 B= 2 return end subroutine sub 1
7 -1 subroution(副程式) 副程式內參數的宣告 < Ex. 完整程式> 輸入直角三角形的兩股長,求其斜邊長 program test_hypotenuse implicit none real : : S 1, S 2 real : : hypot write(*, *) 'Program to test suubroutine calc_hypotenuse: ' write(*, *) 'Enter the hength of side 1' read(*, *) S 1 write(*, *) 'Enter the hength of side 2' read(*, *) S 2 <接下頁>
7 -1 subroution(副程式) 副程式內參數的宣告 < Ex. 完整程式> call calc_hypotenuse(S 1, S 2, hypot) write (*, 10) hypot 10 format(1 X, 'The length of the hypotenuse is ', F 10. 4) stop end program test_hypotenuse <接下頁>
7 -1 subroution(副程式) 副程式內參數的宣告 < Ex. 完整程式> subroutine calc_hypotenuse( side_1, side_2, hypotenuse ) implicit none real, intent(in) : : side_1, side_2 real, intent(out) : : hypotenuse real : : 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 記憶體 主程式 副程式 位置 001 a x 002 b(1) y(1) 003 b(2) y(2) 004 b(3) y(3) real : : a, b(4) 005 b(4) y(4) integer : : next 006 next i Fortran在傳遞參數時, 是傳遞這個變數的記憶體位址 < Ex. 程式片段> program test . . . call sub 1(a, b, next). . . end program test subroutine sub 1(x, y, i) real, intent(out) : : x real, dimension(4), intent(in) : : y integer : : i. . . end subroutine sub 1
7 -1 subroution(副程式) 參數的傳遞 傳遞參數要注意參數的資料型態和順序 real : : a, b(4) real, intent(out) : : x real, dimension(4), intent(in) : : y integer : : next integer : : I call sub 1(a, b, next) subroutine sub 1(x, y, i)
7 -1 subroution(副程式) 參數的傳遞 < Ex. 完整程式> 錯誤範例:參數傳遞時資料型態不同 program bad_call implicit none real : : x = 1. 0 call bad_argument(x) end program bad_call subroutine bad_argument(i) implicit none integer : : i write(*, *) 'I=', i end subroutine bad_argument < Ex. 執行結果> I= 1065353216
7 -1 subroution(副程式) 陣列參數的傳遞 1) 利用傳遞參數的方式傳遞陣列大小 < Ex. 程式片段> subroutine process 1(data 1, data 2, n, nvals) integer, intent(in) : : n, nvals real, intent(in), dimension(n) : : data 1 real, intent(out), dimension(n) : : data 2 do i = 1, nvals data 2(i) = 3. 0 * data 1(i) end do return end subroutine process 1
7 -1 subroution(副程式) 陣列參數的傳遞 2) 利用*作為假定的陣列大小宣告陣列 < Ex. 程式片段> subroutine process 2(data 1, data 2, nvals) real, intent(in), dimension(*) : : data 1 real, intent(out), dimension(*) : : data 2 integer, intent(in) : : nvals do i = 1, nvals data 2(i) = 3. 0 * data 1(i) end do return end subroutine process 2 Not Good. Complier無法偵 測運算時,array的大小是否超 過實際size
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. 程式片段> program main implicit none type : : mytype. . . end type mytype. . . stop end program main < Ex. 程式片段> module typedef type : : mytype. . . end type mytype end module typedef program main implicit none use typedef. . . stop end program main subroutine sub 1() implicit none type : : mytype 主程式與subroutine皆需 subroutine sub 1(). . . implicit none 使用mytype的資料型態 end type mytype 右邊的寫法較為繁雜,可 use typedef. . . 以使用module來簡化之 return end subroutine sub 1
7 -3 利用module共用資料 全域變數 在程式中,使用模組的主 副程式,都可以使用到一 樣的變數a, b, c < Ex. 程式片段> module vars implicit none real, save : : a, b, c end module vars program main use vars. . . stop end program main subroutine sub 1() use vars. . . return end subroutine sub 1
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 sub 1() use constants. . . return end subroutine sub 1
7 -4 Fortran Functions 程式內定函數 內建在Fortran語言,可以直接使用 Ex. sin(x) 或 log(x)
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, F 10. 4, A, F 12. 4) stop end program test_quadf <接下頁>
7 -4 Fortran Functions < 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. 程式片段> program test real, external : : fun_1, fun_2 在宣告函數時,加入externa表 示可在主副程式間傳遞的函數 real : : x, y, output 函數當作參數傳入副程式 . . . call evaluate(fun_1, x, y, output) call evaluate(fun_2, x, y, output). . . <接右> < Ex. 程式片段> subroutine evaluate(fun, a, b, result) real, external : : fun real, intent(in) : : a, b real, intent(out) : : result end program test result = b * fun(a) 使用函數 return end subroutine evaluate
7 -6 Interface(介面) 程式說明 interface … …. . . end interface 包含subroution與function的頭尾 還有傳入參數的宣告部分
7 -6 Interface(介面) < Ex. 完整程式> program ex 0702 implicit none real : : angle, speed interface function get_distance(angle, speed) implicit none 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(*, '(T 2, A 4, F 7. 2, 1 A)') 'Fly', get_distance(angle, speed), 'm' stop end program ex 0702 <接下頁>
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. 完整程式> 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. 31 m
7 -7 不定個數的參數傳遞 < Ex. 完整程式> program ex 0703 要呼叫不定數目參數的函 數時,一定要先宣告出函 數的interface implicit none integer : : a=10, b=20 interface subroutine sub(a, b) 使用optional 這個敘述 來表示後面所宣告的參 數可以不一定要傳入 implicit none integer, intent(in) : : a integer, intent(in), optional : : b end subroutine sub end interface write(*, *) 'Call sub with arg a' call sub(a) <接下頁>
7 -7 不定個數的參數傳遞 < Ex. 完整程式> write(*, *) 'Call sub with arg a, b' call sub(a, b) stop end program ex 0703 subroutine sub(a, b) implicit none < Ex. 執行結果> Call sub with arg a 10 Call sub with arg a, b 10 20 integer, intent(in) : : a integer, intent(in), optional : : b write(*, *) a if (present(b)) write(*, *) b return end subroutine sub present用來檢查 參數b是否有傳入
7 -8 Recursive(遞迴)procedures < Ex. 完整程式> program ex 0704 implicit none integer : : n, ans 自己呼叫自己的副程式時要 先宣告出副程式的interface subroutine fact(n, ans) implicit none integer, intent(in) : : n integer, intent(inout) : : ans end subroutine fact end interface write(*, *) 'Input N: ' read(*, *) n <接下頁>
7 -8 Recursive(遞迴)procedures < Ex. 完整程式> call fact(n, ans) write(*, '(t 2, i 2, a 3, i 10)') n, '!=', ans stop end program ex 0704 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 < Ex. 執行結果> TEST ans=0 return end if if (n>=1) then call fact(n-1, temp) ans = n * temp else ans = 1 end if return end subroutine fact 呼叫本身副程式
7 -8 Recursive(遞迴)procedures < Ex. 完整程式> program ex 0704 implicit none integer : : n, ans interface function fact(n) result(ans) implicit none 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(*, '(t 2, i 2, a 3, i 10)') n, '!=', fact(n) stop end program ex 0704 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 sub 2 … contains subroutine sub 2 … end subroutine sub 2 end program scoping_test 定義副程式sub 2只能在主 程式中scoping_test使用 contains敘述都放在整個區 塊的最後面
7 -9 Contains statement < Ex. 完整程式> module_example implicit none real : : x = 100. 0 real : : y = 200. 0 end module_example program scoping_test use module_example implicit none integer : : i = 1, j = 2 <接下頁> write(*, '(A 25, 2 I 7, 2 f 7. 1)') 'Beginning: ', i, j, x, y
7 -9 Contains statement < Ex. 完整程式> call sub 1(i, j) write(*, '(A 25, 2 I 7, 2 f 7. 1)') 'After sub 1: ', i, j, x, y call sub 2 write(*, '(A 25, 2 I 7, 2 f 7. 1)') 'After sub 2: ', i, j, x, y contains subroutine sub 2 real : : x x = 1000. 0 y = 2000. 0 write(*, '(A 25, 2 F 7. 1)') 'In sub 2: ', x, y end subroutine sub 2 end program scoping_test <接下頁>
7 -9 Contains statement < Ex. 完整程式> subroutine sub 1(i, j) implicit none integer, intent(inout) : : i, j integer, dimension(5) : : array write(*, '(A 25, 2 I 7)') 'In sub 1 before sub 2 : ', i, j call sub 3 write(*, '(A 25, 2 I 7)') 'In sub 1 after sub 2 : ', i, j array = (/(1000*i, i = 1, 5)/) <接下頁> write(*, '(A 25, 2 I 7)') 'After array def in sub 2 : ', i, j, array
7 -9 Contains statement < Ex. 完整程式> contains subroutine sub 3 integer : : i i = 1000 j = 2000 write(*, '(A 25, 2 I 7)') 'In sub 1 in sub 3 : ', i, j end subroutine sub 3 end subroutine sub 1
7 -9 Contains statement < Ex. 執行結果> Beginning: 1 2 100. 0 200. 0 In sub 1 before sub 2 : 1 2 In sub 1 in sub 3 : 1000 2000 In sub 1 after sub 2 : 1 2000 After array def in sub 2 : 1 2000 ? 2000 3000 ? 5000 After sub 1: 1 2000 100. 0 200. 0 In sub 2: 1000. 0 2000. 0 After sub 2: 1 2000 100. 0 2000. 0 TEST
7 -9 Contains statement 模組中可以容納其他模組、副程式與函數的存在 < Ex. 程式片段> module_name use prher_module_name implicit none integer : : I. . . type : : type_name. . . end type : : type_name contains subroutine sub 1(a). . . end subroutine sub 1 function fun 1(b). . . end function fun 1 end 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) implicit none real : : angle_to_rad <接下頁>
7 -9 Contains statement < Ex. 完整程式> real, intent(in) : : 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 = angle_to_rad(angle) get_distance = (speed * cos(rad)) * (2. 0 * speed * sin(rad) / g) return <接下頁>
7 -9 Contains statement < Ex. 完整程式> end function get_distance end module calculate_distance program ex 0705 < Ex. 執行結果> use calculate_distance Input shoot angle: implicit none 60 <輸入 6 0 [ENTER] > real : : speed, angle Input shoot speed: write(*, *) 'Input shoot angle: ' 20 <輸入 2 0 [ENTER] > read(*, *) angle Fly 35. 31 m write(*, *) 'Input shoot speed: ' read(*, *) speed write(*, '(T 2, A 4, F 7. 2, 1 A)') 'Fly', get_distance(angle, speed), 'm' stop end program ex 0705
7 -10 Intrinsic & External < Ex. 完整程式> function trig_func(func, x) program ex 0706 implicit none real : : A = 30. 0 real : : trig_func real, intrinsic : : sin, cos real, external : : func real, external : : trig_func real, intent(in) : : x write(*, *) trig_func(sin, A) trig_func = func(x * 3. 14159 / 180. 0) write(*, *) trig_func(cos, A) return end function trig_func stop end program ex 0706 <接右> < Ex. 執行結果> 0. 49999964 0. 8660256
- Slides: 56