ForTran

Transcription

1 Fortran Chapter 1 Introduction 1-1 Computer Languages (1) (2) FORTRAN, COBOL, BASIC, C, C++, PASCAL, LISP, JAVA 1-2 The History of Fortran Language ForTran : Formula Translate 理 Fortran compiler Fortran ~ Fortran Fortran ~ Fortran ~ Fortran 90 念 列 ~ Fortran 95 minor update of Fortran ~ Fortran 2003 object-oriented and generic programming ~ Fortran 2008 was approved in September As with Fortran 95, this is a minor upgrade, incorporating clarifications and corrections to Fortran 2003, as well as introducing a select few new capabilities. 1-3 Properties of Fortran Language Paradigm multi-paradigm: imperative (procedural), structured, object-oriented, generic Stable release Fortran 2008 (ISO/IEC :2010) (2010) Typing discipline strong, static, manifest Major implementations Absoft, Cray, GFortran, G95, IBM, Intel, Lahey/Fujitsu, Open Watcom, Pathscale, PGI, Silverfrost, Oracle, XL Fortran, Visual Fortran, others Influenced by Speedcoding Influenced ALGOL 58, BASIC, C, PL/I, PACT I, MUMPS, Ratfor Usual file extensions.f,.for,.f90,.f95,.f03 1

2 1-4 G95 Free Fortran 95 compliant compiler. Stable version 0.92, June g95 -o hello h1.f90 h2.f90 h3.f90 Compiles multiple source files and links them together to an executable file named hello on unix, or hello.exe on MS Windows systems. Runtime Error Codes Running a g95-compiled program with the --g95 option will dump this list of error codes to standard output. -2 End of record -1 End of file 0 Successful return Operating system error codes (1-199) 200 Conflicting statement options 201 Bad statement option 202 Missing statement option 203 File already opened in another unit 204 Unattached unit 205 FORMAT error 206 Incorrect ACTION specified 207 Read past ENDFILE record 208 Bad value during read 209 Numeric overflow on read 210 Out of memory 211 Array already allocated 212 Deallocated a bad pointer 214 Corrupt record in unformatted sequential-access file 215 Reading more data than the record size (RECL) 216 Writing more data than the record size (RECL) 2

3 Chapter 2 Basic Elements of Fortran Fortran 90 (1)! (2) 行 行 & 行 行 連 行 & 行 行 & 行 行 (3) (a) A~Z or a~z ( 不 ) (b) 數 0~9 (c) + - * / = ( ),. & : _ (4) 數 (a) 數 數 不 數 來 (b) 數 度 31 (c) 數 不 Fortran 行 令 (d) 數 不 (5) data type bit bit byte = 8 bit : 料 來 (a) integer 數 (i) integer(kind=2) 16 bits (2 bytes) 數 (i.e ) (ii) integer(kind=4) 32 bits (4 bytes) 數 (i.e ) (b) real 數 (i) real(kind=4) 精 度 32 bits 度 數 6~8 max. value = min. value = (c) complex a+bi a b 數 (d) character (e) logical True and False (ii) real(kind=8) 精 度 64 bits 度 數 15~61 max. value = min. value =

4 (5) 數 4

5 Chapter WRITE, PRINT program main write(*,*) hello, world! end program main program main 行 省略 end end program end program main ( ) write ( *, * ) Hello, World 不 write (unit = *, FMT = *) Hello, World unit = * unit = 6 行 print *, Hello, World 3-2 (Declaration) 留 行 料 Example Program ex0405 integer :: A real :: B character(len=1) :: C logical :: D 5

6 A = 1 B = 1.0 C = c D =.TRUE. write(*,*) A=,A, B=,B, C=,C, D=,D end program ex0405 (1) 數 integer :: A A 數 數 Example Program ex *4-3 來 數 A 數 integer :: A A = 2+2*4-3 write(*,*) 2+2*4-3=,A end program ex0406 Note: A = 3/2 A = 1 數 略 A = 1/2 A = 0 integer :: A,B,C A,B,C 數 數 integer (kind = 2) :: a 兩 來 錄 數 integer (kind = 4) :: b 來 錄 數 省略 (kind) (kind = 4) integer 數 (1) 數 數 不 數 來 (2) 數 度 31 (3) 數 不 Fortran 行 令 (4) 數 不 (2) real ( 數 ) real :: a a 精 度 數 real (kind = 4) :: a a 精 度 數 real (kind = 8) :: a a 精 度 數 6

7 數 都 數來 e.q 數 數 Program ex0409 real :: a, b a = b = write (*,*) a, +, b, =, a + b end program ex (3) complex complex :: a complex (kind = 4) :: a complex (kind = 8) :: a A = (x,y) x y e.q. A = (3.2, 2.5) A = i (4) character character (len = 1) :: a character (1) :: a a 數 character*1 :: a character (len = 80) :: a character (80) :: a a 數 串 度 80 character*80 :: a a = hello, world or a = hello world (5) logical logical :: A A =.TRUE. A =.FALSE. 7

8 3-3 Read Example Program ex0418 integer :: A real :: B complex :: C character (len = 40) :: D logical :: E write (*,*) Please input a (integer) number: read (*,*) A write (*,*) please input a (real) number: read (*,*) B write (*,*) A, B end program ex0418 (ie. keyboard) read ( *, * ) A 不 read (unit = 5, FMT = *) A unit = * unit = 5 keyboard Example program ex0419 integer :: A,B,C 數 read (*,*) A, B, C e.q. 1, 2, 3 or write (*,*) A, B, C end program ex0419 (Format) : Example program ex0420 integer :: A A = 100 write(*, 100) A write(*, (I4) ) A 8

9 100 format( I4 ) end program ex0420 Aw w 來 串 Dw.d w 度來 數 數 d Ew.d w 度來 數 數 數 d nx n e.q. write(*, (1X,A10) ) hello hello write(*, (E(15.7) ) E+03 w d Fw.d w 度來 數 數 d write(*, (1X,F9.3) ) Iw 度來 數 write(*, (1X,I5) ) Lw 度來 T F write(*, (1X,L5) ).TRUE. T Notes: (1) write(*, (1X,I3) ) 欄 3 欄 欄 不 (2) A=10 write(*,100) A 100 format(1x, Ans =, I3 ) Ans = 10 串 (2X,F5.2) 3 (3) write(*, ( 3 (2X,F5.2) ) ) A, B, C 9

10 write(*, ( 2X, F5.2, 2X, F5.2, 2X, F5.2 ) ) A, B, C (4) write(*, ( 1X, Yor are, I4, years old. ) ) AGE write(*,100) AGE 100 format(1x, You are, I4, years old. ) 3-4 (1) implicit I,J,K,L,M,N 數 數 數 數來 易 implicit integer (A-F, I, K) A F I, K 數都 數 implicit real (F-K) F K 數都 數 (2) parameter Example program ex0428 real, parameter :: pi = write(*, (1X,A10,F5.2) ) sin(pi/6)=, sin(pi/6.0) end program ex0428 real, parameter :: pi = 不 省略 pi 數 pi 不 數 不 ( ) 行 不 (3) 數 Example Program ex0430 integer :: a = 1 real :: b = 1.0 complex :: c = (1.0, 1.0) character(len=1) :: d = A 10

11 logical :: e =.TRUE. write (*, (I3,TR1,F4.2,TR1,(F4.2,TR1,F4.2),A2,L3) ) a,b,c,d,e end program ex0430 (4) program main implicit integer :: A 數 real :: B end program main Program ex0431 integer :: A = 2, B = 1 數 數 real :: C C = B / A C = real(b) / real(a) write(*,*) C end program ex0431 A + int(b) / C A, C integer, B real real integer (5) 料 type :: person person 料 character(len=30) :: name integer :: age integer :: length integer :: weight character(len=80) :: address end type person 料 Program ex

12 type :: person character(len=30) :: name integer :: age integer :: length integer :: weight character(len=80) :: address end type person type(person) :: a write(*,*) Input his(her) name: read(*,*) a% name write(*,*) Input his(her) age: read(*,*) a% age write(*,*) Input his(her) body length: read(*,*) a% length write(*,*) His(her) name is, a% name write(*,*) His(her) age is, a% age end program ex0433 a = person( Tom, 15, 170, 60, Taipei ) type a%name a%age a%lenth a%weight a%address (6) module module typedef module type :: person character(len=30) :: name integer :: age real :: length real :: weight end type person end module typedef program ex0434 use typedef module 12

13 type(person) :: a write(*,*) Input his name: read(*, (a30) ) a%name write(*,*) Input hes age: read(*,*) a%age typedef module person write(*, (1x, a12, a20) ) Name : a%name write(*, (1x, a12, I6) ) age : a%age end program ex0434 module constants real, parameter :: pi= real, parameter :: g = 9.81 end module constants module vars real :: pi_2 end module vars program ex0435 use constants use vars write(*,*) PI =, pi write(*,*) G =, g pi_2 = 2.0* pi write(*,*) 2 PI =, pi_2 end program ex0435 (7) kind (On PC) 13

14 integer(kind=1) -127~127 integer(kind=2) ~32767 integer(kind=4) ~ real(kind=4) ~.40 real(kind=8) ~ 力 selected_int_kind(r) 錄 r 數 kind selected_real_kind(p,r) 錄 p 數 數 r 數 kind Example module kind_var integer, parameter :: long_int=selected_int_kind(9) integer, parameter :: short_int=selected_int_kind(3) integer, parameter :: long_real=selected_real_kind(10,50) integer, parameter :: short_real=selected_real_kind(3,3) end module kind_var program ex0436 use kind_var =4 integer(kind=long_int) :: a= =2 integer(kind=short_int) :: b=12 =8 real(kind=long_real) :: c= d45 =4 real(kind=short_real) :: d=1230 write(*, (I10) ) a write(*, (I10) ) b 12 write(*, (E15.5) ) c E+46 write(*, (E15.5) ) d E+04 end program ex

15 Chapter 4 流 4-1 IF if end if (logical_expr) then statement 1 statement 2 block Logical_expr.FALSE. Statement 1 Statement 2 15

16 if (logical_expr) then statement 1 block 1 statement 2 else if (logical_expr_2) then statement 1 block 2 statement 2 else statement 1 block 3 statement 2 end if Logical_expr_1.FALSE Logical_expr_2.FALSE.TRUE..TRUE. Block 1 Block 2 Block 3 16

17 Program ex0501 Implicit none Real :: Height, Weight Real :: Standard_Weight Write(*,*) Please input your height : Read(*,*) Weight Standard_Weight = Height If (Weight.GT. Stand_Weight) then Write(*,*) You are overweighted! Else Write(*,*) Your weight is under control! End if Stop End program ex0501 邏.EQ. or = =.NE. or /= 不.GT. or >.GE. or >=.LT. or <.LE. or <=.AND..OR..NOT. 了 85 A B C D E 5 90~100 A 80~89 B 70~79 C 60~69 D 60 E 來 Program ex0502 Implicit none Integer :: Grades Character(len=1) :: Level =? Write(*,*) Please input your Grades: Read(*,*) Grades 17

18 If ((Grades.LE. 100).AND. (Grades.GE. 90)) then Level = A else If ((Grades.LE. 89).AND. (Grades.GE. 80)) then Level = B else If ((Grades.LE. 79).AND. (Grades.GE. 70)) then Level = C else If ((Grades.LE. 69).AND. (Grades.GE. 60)) then Level = D else if (Grades.LT. 60) then Level = E else write(*,*) Input error end if write(*,*) You get : [,Level, ] end program ex Select -- case Select csae ( 數 ) case ( 數 1) 數 數 1 行 case ( 數 2) case default 數不 數 行 end select 例 Program ex0507 Implicit none Integer :: Grades Character (len = 1) :: Level Write (*,*) Grades Select case (Grades) Case (90:100) Level = A Case (80:89) 80 <= Grades <= 89 Level = B Case (70:79) Level = C Case (60:69) Level = D Case (:59) Grades <= 59 18

19 Level = E Case default Level =? End select 19

20 Chapter Do 連 行 Program ex0601 integer :: I integer, parameter :: N=10 do 10, I = 1, N, 1 write(*,*) Do Loop Demo 10 continue end program ex0601 量 若 量 1 省略 (1) do 10, I = 1, N, 1 數 I 數 數 行 行 行 10 continue (2) do 10, I = 2, N, => I = 2, 4, 6, 8, 10 (3) do I = 1, N, 1 write(*,*) Do-Loop Demo (1) (3) 20

21 5-2 do while do while (logical_expr) statement 1 statement 2 Logical_expr.FALSE..TRUE. block 不 行 Program ex0604 integer, parameter :: Weight=45 integer :: input = 0 do while (input /= Weight) write(*,*) Weight = read(*,*) input write(*,*) You are right! end program ex Cycle cycle 略 來 行 Program ex0605 integer :: i integer, parameter :: n=10 do i = 1, n if (i = = 4) cycle 21

22 write(*,*, (I3) ) I end program ex Exit exit Program ex0606 integer, parameter :: Weight=45 integer :: input do while (.true.) write(*,*) Weight = read(*,*) input if (input = = Weight) exit write(*,*) You are right! end program ex0606 立 離 5-5 Program ex0607 integer :: i, j outer: do i = 1, 5 inner: do j = 1, 5 write(*, (t2,a1,i3,a1,i3,a1) ) (, i,,, j, ) inner outer end program ex0607 inner outer 5.6 cycle exit Program ex

23 integer :: i, j loop2 loop1: do i = 1,3 loop2:do j = 1,3 loop1 ( if(j == 2) cycle loop2 loop2 if(i == 2) exit loop1 write(*, (t2,a1,i3,a1,i3,a1) ) (,i,,,j, ) loop2 loop1 end program ex0608 output: (1,1),(1,3) 23

24 Chapter 6 列 6-1 列 DataType :: name (Size) 列 數 列 數 integer / real / type 來 or DataType, dimension (Size) :: name (1) integer :: A(10) 10 數 列 A 1~10 i.e. A(1),A(2),,A(10) (2) integer :: A(-1:8) 10 數 列 A A(-1),A(0),A(1),A(2),,A(10) (3) integer :: A( 0:10: 2) 6 數 列 A(0),A(2),A(4),A(6),A(8),A(10) 列 列 (4) integer :: A(10:0:-2) 6 數 列 A(10),A(8),A(6),A(4),A(2),A(0) (5) integer :: A(3,3) 3 3 列 (6) integer :: A(3,3,3) 列 (7) integer :: A(0:3,0:3) 列 (1) integer :: a(5) = (/ 1, 2, 3, 4, 5 /) a(1) = 1, a(2) = 2, a(3) = 3, a(4) = 4, a(5) = 5 不 (2) integer :: a(5) = (/ 3, i = 1, 5 /) a(1) = a(2) = a(3) = a(4) = a(5) = 3 integer :: a(5) = (/ i, i = 1, 5 /) a(1) = 1, a(2) = 2, a(3) = 3, a(4) = 4, a(5) = 5 (3) integer :: a(5) = (/ 0, ( i, i = 2, 4 ), 5 /) a(1) = 0, a(2) = 2, a(3) = 3, a(4) = 4, a(5) = 5 24

25 6-3 列 (1) one-dimension integer :: A(5) 連 列 A(1) A(2) A(3) A(4) A(5) integer :: A(0:10:2) 連 列 A(0) A(2) A(4) A(6) A(8) A(10) (2) two- dimension integer :: A(3,3) A(1,1) A(1,2) A(1,3) A(2,1) A(2,2) A(2,3) The first row A(3,1) A(3,2) A(3,3) The first column 列 A 列 A(1,1) A(1,2) A(1,3) first column A(2,1) A(2,2) A(2,3) second column A(3,1) A(3,2) A(3,3) third column ~column major 列 3 compute sum = 3 = 1 = A ( i, j) i j 1 (i) sum=0 do i = 1, 3 do j = 1, 3 sum = sum + A(i,j) not good, cpu 不 來讀 料 Cache 便利 Cache 料 Cache (ii) sum=0 do i = 1, 3 do j = 1, 3 25

26 sum = sum + A(j,i) better than (i) 利 cache 行 度 6-4 Fortran (1) a = b do i = 1, k a(i) = b(i) (2) a = b + c do i = 1, k a(i) = b(i) + c(i) (3) a = b - c do i = 1, k a(i) = b(i) - c(i) (4) a(1:3) = b(4:6) a(1) = b(4), a(2) = b(5), a(3) = b(6) (5) a(1:5:2) = 3 a(1) = 3, a(3) = 3, a(5) = 5 (6) a(1:10) = a(10:1:-1) a(1~10) (7) a = b * c do i = 1, k a(i) = b(i) * c(i) (8) a = b / c do i = 1, k a(i) = b(i) / c(i) where, forall where ( 邏 ) 邏 行 else where 邏 行 end where 26

27 (*) Program ex0707 integer :: I real :: a(5) = (/ ( I, I = 5, 1, -1) /) a(1)=5,a(2)=4,a(3)=3,a(4)=2,a(5)=1 real :: b(5) = (/ (I, I = 1, 5) /) b(1)=1,b(2)=2,b(3)=3,b(4)=4,b(5)=5 real :: c(5) where ( a > b ) c = b else where c = a end where write (*,100) Array C =, ( c(i), I = 1, 5 ) 100 format ( A10, 5F6.2 ) end program ex0707 (*) do I = 1, k if ( a(i) > b(i) ) then c(i) = b(i) else c(i) = a(i) end if forall ~ Fortran95 (1) forall ( i = 1:2, j = 1:2 ) a(i,j) = i + j do j = 1, 2 do i = 1, 2 a(i,j) = i + j (2) forall ( i = 1:2, j = 1:2 ) a(i,j) = i + j a(j,i) = i - j end forall forall 行 end forall 來 (3) forall ( i = 1:10, j = 1:10, a(i,j) > 0 ) where ( a < 10 ) b = 10 27

28 end forall do j = 1, 10 do i = 1, 10 if ( a(i,j) > 0 ) then if ( a(i,j) < 10 ) then b(i,j) = 10 end if end if 列 Fortran 90 列 行 來 度 Program ex0709 integer :: students, i integer :: allocatable :: grades( : ) write(*,*) How many strdents in this class? read(*,*) students allocate(grades(students)) do i = 1, students write(*, (1X, A25, I2, A2) ) Input grades of number, I, : read(*,*) grades(i) do i = 1, students if (grades(i) < 60) then write(*, (1X, A10, I2, A8) ) number, I, fail! end if end program ex0709 說 (a) integer, allocatable :: grades(:) integer, allocatable, dimension(:) :: grades (b) allocate(grades(students)) 28 度 兩 度 grades(:,:)

29 students allocate(grades(m:n:inc)) 量 (inc) allocate 來 列 列 allocate 來 料 deallocate allocate 列 Program ex0710 integer :: students, i integer :: allocatable :: grades( : ) write(*,*) How many strdents in this class A? read(*,*) students allocate(grades(students)) do i = 1, students write(*, (1X, A25, I2, A2) ) Input grades of number, I, : read(*,*) grades(i) do i = 1, students if (grades(i) < 60) then write(*, (1X, A10, I2, A8) ) number, I, fail! end if deallocate(grades) write(*,*) How many strdents in this class B? read(*,*) students do i = 1, students write(*, (1X, A25, I2, A2) ) Input grades of number, I, : read(*,*) grades(i) do i = 1, students if (grades(i) < 60) then write(*, (1X, A10, I2, A8) ) number, I, fail! end if 29

30 end program ex0710 allocate(grades(students), stat = error) Error 數 數 allocate stat error 數 If error = 0 then allocate 列 Otherwise allocate 不 deallocate(grades(students), stat = error) 列 數 1. dot_product(vector_a, vector_b) Calculates the dot product of two equal-sized vectors. 2. matmul(matrix_a, matrix_b) Performs matrix muttiplication on to conformable matrices. 3. maxloc(array, mask) minloc(array, mask) 列 數 Mask 列 where 邏 e.q. b = maxloc(a, a<50) 列 50 數 4. maxval(array, mask) minval(array, mask) returns the maximum value in array among those elements for which mask was true. 5. reshape(data_source, shape) 料 列 列 6. sum(array, mask) calculates the sum of the elements in array for which the mask is true. If mask is not present, it calculates the sum of all of the elements in the array. e.q. integer :: a(3,3) = reshape( (/1,2,3,4,5,6,7,8,9/), (/3,3/) ) 30

31 31 = a e.q. integer :: b(2,3) = reshape( (/1,2,3,4,5,6/), (/2,3/) ) = b 7. transpose(matrix) returns the transpose of matri

32 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 立 數 若 了 數 不 不 Example Program ex0803 Implicit none integer :: A=1, b=2 call sub1() write(*,*) In main program: write(*, (2(A3,I3)) A=, A, B=, B end program ex0803 subroutine sub1() integer :: A=3, B=4 write(*,*) In subroutine sub1: write(*, (2(A3,I3)) A=, A, B=, B return end 32

33 行 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) return end subroutine intent(in) 參數 不 數 intent(out) 參數 數 intent(inout) 參數 數 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) end program test_hypotenuse variable passing in Fortran : The pass-by-reference scheme Fortran 參數 數 33

34 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= 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. Subroutine process1(data1, data2, n, nvals) integer, intent(in) :: n, nvals real, intent(in), dimension(n) :: data1 real, intent(out), dimension(n) :: data2 34

35 do i = 1, nvals data2(i) = 3.0 * data1(i) return end subroutine process1 (2) Declare the length of each dummy array with an asterisk as an assumed-size dummy array. 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) return end subroutine process2 Not Good. Complier array size. 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. 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 35

36 ave = sum_x / real(n) nvals = n end if return end subroutine running_average 7-3 Sharing data rusing modules Program main Implicit none type :: mytype type end type mytype end program main subroutine sub1() Implicit none type :: mytype end type mytype return end subroutine sub1() type subroutine mytype 料 module 來 module typedef Implicit none type :: mytype end type mytype end module typefef program main use type def 36

37 end program main subroutine sub1() use type def return end subroutine sub1 module 來 數 Module vars real, save :: a, b, c end module vars 都 數 a, b, c Module constants real, parameter :: pi= real, parameter :: g=9.81 end module constants program main use constants end program main subroutine sub1() use constants return end subroutine sub1 7-4 Fortran Functions Two different types of functions : intrinsic functions and User_defined functions Intrinsic functions are built into the Fortran language 37

38 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 數 數 return 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 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 return 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) end program test_quadf The function should never modify its own imput arguments. 38

39 7-5 Passing user_defined functions as arguments. 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) return end subroutine evaluate 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. 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 39

40 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 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) return end function get_distance function angle_to_rad(angle) real :: angle_to_rad real, intent(in) :: angle real, parameter :: pi= angle_to_rad = angle * pi / return end function angle_to_rad Fortran 90 interface interface (i) 參數 來 參數 (ii) 參數數 不 (iii) 參數 (iv) 列參數 40

41 (v) (vi) 數 列 數 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) end program ex0817 來 參數 不 subroutine sub(a, b) integer, intent(in) :: a integer, intent(in), optional :: b write(*,*) a if (present(b)) write(*,*) b return 數 來 參數 end subroutine sub Output: Call sub with arg a 10 Call sub with arg a, b 數 present optional 參數 數 present 邏 參數.true..false. 類不 數 參數 interface 41

42 7-8 Recursive procedures 數 來 行 3! = 3 2! 2! = 2 1! 2! 1! 1! = 1 0! 0! := 1 0! 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) end program ex0818 recursive subroutine fact(n, ans) integer, intent(in) :: n integer, intent(inout) :: ans integer :: temp if (n<0) then ans>0 return end if if (n>=1) then call fact(n-1, temp) ans = n * temp else 來 來 42

43 ans = 1 end if return 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 return end function fact 7-9 Contains statement ( ) module module_example real :: x = real :: y = 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) 43

44 write(*, (A25, 2I7, 2f7.1) ) After sub2:, i, j, x, y contains subroutine sub2 real :: x x = y = 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 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 44

45 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 行 Beginning In sub1 before sub2: 1 2 In sub1 in sub2: In sub1 after sub2: After array def in sub2: After sub1: In sub2: After sub2: module 數 module module_name use prher_module_name integer :: i type :: type_name end type :: type_name contains 立 module module module module 數 數 module module 來 contains module 45

46 subroutine sub1(a) end subroutine sub1 function fun1(b) end function fun1 end module module_name 數 module constants real, parameter :: pi = 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 / return 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) return end function get_distance end module calculate_distance program ex0820 use calculate_distance write(*,*) Input shoot angle: 46

47 read(*,*) angle write(*,*) Input shoot speed: read(*,*) speed write(*, (T2, A4, F7.2, 1A) ) Fly, get_distance(angle, speed), m end program ex Intrinsic, external Datatype, external :: Func1, Func2 Func1 Func2 不 數 Intrinsic 來 real, intrinsic :: sin, cos 兩 省略 不 參數來 external intrinsic 不 省略 program ex0821 real :: A = 30.0 real, intrinsic :: sin, cos real, external :: trig_func write(*,*) trig_func(sin, A) write(*,*) trig_func(cos, A) end program ex0821 function trig_func(func, x) real :: trig_func real, external :: func real, intent(in) :: x trig_func = func(x * / 180.0) return end function trig_func 47

48 Chapter 8 讀 讀 讀 兩 (1) 讀 讀 來 讀 料 (2) 讀 讀 來 讀 (1) 料都 理 來 易 (2) 料 ( ) 讀 省 The open statement OPEN(unit = int_expr, file = char_expr, status = char_expr, action = char_expr, iostat = int_var) (1) unit = int_expr 讀 write, read 來讀 了 unit = int_expr 1, 2, 5, 6 2, 6 1, 5 (2) file = char_expr 來 (3) status = char_expr New, OLD, Scratch or unknown 來 states = New 不 states = OLD (4) Action = char_expr : read, write, readwrite Action = readwrite : 來讀 Action = read : 來讀 料 Action = write : 來 料 (5) Iostate = int_var : 狀 int_var > 0 讀 48

49 int_var = 0 讀 int_var < 0 了 (6) Access = sequential or direct Access = sequential 讀 來 讀 Access = direct 讀 (7) Position = asis or rewind or append Position = asis 讀 不 ( ) Position = rewind 讀 Position = append 讀 Case 1: opening a file for input integer :: ierror open (unit = 8, file = EXAMPLE.DAT, status = OLD, action = read, iostat = ierror) Case 2: opening a file for output integer ::n_unit, ierror character(len = 6) :: filename n_unit = 25 filename = outdat open (unit = n_unit, file = filename, status = new, action = write, iostat= ierror) Case 3: opening a scratch file open (unit = 12, status = scratch, iostat= ierror) The close statement close (close_list) reads and writes to disk files (1) open(unit = 8, file = input.dat, status = old, iostat = ierror) read(8, *) x, y, z ~read the values of variables x, y and z from the file input.dat. (2) open(unit = 9, file = output.dat, status = new, iostat = ierror) read(9, 100) x, y, z 100 Format( X =, F10.2, Y=, F10.2, Z=, F10.2) ~write the values of variables x, y and z to the file output.dat. 49

50 Reading data from a file: Program read character (len =20) :: filename integer :: nvals = 0 integer :: status real :: value! Get the file name and echo it back to the user. write(*,*) Please enter input file name: read(*,*) filename write(*,10) filename 10 format(1x, The input file name is :, A)! Open the file and check for errors on open open(3, file = filename, status = old, action = read, iostat = status) openif: If(status == 0) then! open was OK. Read values readloop: do 50

51 read(3, *, iostat = status) value if(status /= 0) Exit nvals = nvals + 1 write(*, 20) nvals, value 20 format(1x, Line, I6, : Value =, F10.4) readloop! The while loop has terminated. Was it because of a read error or because! of the end of the input file? readif: if(status > 0) then write(*, 30) nvals format(1x, An error occurred reading line, I6) else write(*, 40) nvals 40 format(1x, End of file reached. There were, I6, values in the file. ) end if readif else openif write(*, 50) status 50 format(1x, Error opening file: IOSTAT =,I6) end if openif close(3) end program read read(3, *, iostat = status) value status > 0 讀 status = 0 讀 status < 0 了 讀 讀 行讀 來 行讀 率 列 List

52 來 率 Program ex0909 character(len = 20), parameter :: input = List integer, parameter :: players = 9 integer :: player integer, parameter :: rec_length = 6 real :: hit_rate open(10, file = input, form = formatted, access = direct, & recl = rec_length) do while (.true.) write(*,*) Number: read(*,*) player if(player < 1.or. player > players) exit 讀 read(10, fmt = (F4.2), rec = player) hit_rate write(*, 100) Number, player, hit_rate =, hit_rate 100 format(1x, A8, I2, A10, F5.2) end program ex0909 (1) 讀 open access = direct recl 數 不 省略 數 來切 (2) DOS 行 行 都 兩 不見 來 行 行 度 行 數量 2 e.q. List 行 度 = = 6 unix 行 行 行 度 行 數量 1 Example : 率 Program ex0910 character(len = 20), parameter :: input = newlist 52

53 integer, parameter :: players = 9, rec_length = 6 integer :: player real :: hit_rate open(10, file = input, form = formatted, access = direct, & recl = rec_length) do while (.true.) write(*,*) Hit Number: read(*,*) player if(player < 1.or. player > players) exit read(10, fmt = (F4.2), rec = player) hit_rate write(*,*) Input hit rate: read(*,*) hit_rate write(10, fmt = (F4.2), rec = player) hit_rate end program ex0910 行 : Hit Number : 3 Input hit rate : 2.54 Hit Number : 5 Input hit rate : 3.46 Hit Number : 2 Input hit rate : 3.44 Hit Number : 0 Newlist 了 亂 率 來 Program ex0911 Implicit none character(len = 20), parameter :: output = List.bin integer, parameter :: players = 9, rec_length = 4 integer :: player real :: hit_rate hit_rate 精度 53

54 open(10, file = output, form = unformatted, access = direct, & recl = rec_length) do while (.true.) write(*,*) Hit Number : read(*,*) player if (player < 1.or. player > players) exit read(*,*) hit_rate write(10, rec = player) hit_rate end program ex0911 省 精度 數 4 bytes 若 來 精 度 數 byte 4 bytes 精 量 料 54