ForTran - PDF Free Download

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 理 1953. 1957 Fortran compiler. 1966 Fortran ~ Fortran 66. 1979 Fortran ~ Fortran 77. 1991 ~ Fortran 90 念列. 1997 ~ Fortran 95 minor update of Fortran 90. 2003 ~ Fortran 2003 object-oriented and generic programming. 2010 ~ Fortran 2008 was approved in September 2010. 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 1539-1: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

1-4 G95 Free Fortran 95 compliant compiler. Stable version 0.92, June 2009 http://www.g95.org/downloads.shtml#v0.92 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

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 0 1 1 byte = 8 bit : 料來 (a) integer 數 (i) integer(kind=2) 16 bits (2 bytes) 數 32767 15 15 (i.e. 2 1 2 + 1 ) (ii) integer(kind=4) 32 bits (4 bytes) 數 2147483647 31 31 (i.e. 2 1 2 + 1 ) (b) real 數 (i) real(kind=4) 精度 32 bits 度數 6~8 max. value = 38 3.4 10 min. value = (c) complex a+bi a b 數 (d) character (e) logical True and False 3 1.18 10 (ii) real(kind=8) 精度 64 bits 度數 15~61 max. value = 308 1.79 10 min. value = 38 2.23 10 308

(5) 數 4

Chapter 3 3-1 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

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 ex0406 2+2*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

數都數來 e.q. 12345 12345678 5 0.123450 10 0.123457 10 數數 Program ex0409 real :: a, b a = 100000.0 b = 0.0001 write (*,*) a, +, b, =, a + b end program ex0409 8 (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 = 3.2 + 2.5i (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

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 1 2 3 write (*,*) A, B, C end program ex0419 (Format) : Example program ex0420 integer :: A A = 100 write(*, 100) A write(*, (I4) ) A 8

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) ) 123.45 0.1234500E+03 w d+7 7 15 Fw.d w 度來數數 d write(*, (1X,F9.3) ) 123.45 123.450 Iw 度來數 write(*, (1X,I5) ) 100 100 Lw 度來 T F write(*, (1X,L5) ).TRUE. T Notes: (1) write(*, (1X,I3) ) 10000 10000 5 欄 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

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 = 3.14159 write(*, (1X,A10,F5.2) ) sin(pi/6)=, sin(pi/6.0) end program ex0428 real, parameter :: pi = 3.14159 不省略 pi 數 3.14159 pi 不數不 ( ) 行不 (3) 數 Example Program ex0430 integer :: a = 1 real :: b = 1.0 complex :: c = (1.0, 1.0) character(len=1) :: d = A 10

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 0.00000 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 ex0433 11

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

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= 3.14159 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

integer(kind=1) -127~127 integer(kind=2) -32767~32767 integer(kind=4) -2147483647~2147483647 real(kind=4) 38 1.18 10 ~.40 real(kind=8) 308.23 10 38 3 10 2 ~ 1.79 10 力 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=12345678 =2 integer(kind=short_int) :: b=12 =8 real(kind=long_real) :: c=1.23456789d45 =4 real(kind=short_real) :: d=1230 write(*, (I10) ) a 12345678 write(*, (I10) ) b 12 write(*, (E15.5) ) c 0.12346E+46 write(*, (E15.5) ) d 0.12300E+04 end program ex0436 14 308

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

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

Program ex0501 Implicit none Real :: Height, Weight Real :: Standard_Weight Write(*,*) Please input your height : Read(*,*) Weight Standard_Weight = Height 100.0 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

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 ex0502 4-2 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

Level = E Case default Level =? End select 19

Chapter 5 5-1 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, 2 2 2 => I = 2, 4, 6, 8, 10 (3) do I = 1, N, 1 write(*,*) Do-Loop Demo (1) (3) 20

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 ex0604 5-3 Cycle cycle 略來行 Program ex0605 integer :: i integer, parameter :: n=10 do i = 1, n if (i = = 4) cycle 21

write(*,*, (I3) ) I end program ex0605 5-4 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 ex0608 22

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

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) 3 3 3 列 (7) integer :: A(0:3,0:3) 4 4 6-2 列 (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

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

sum = sum + A(j,i) better than (i) 利 cache 行度 6-4 Fortran90 6-4-1 (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) 6-4-2 where, forall where ( 邏 ) 邏行 else where 邏行 end where 26

(*) 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

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 6-4-3 列 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(:,:)

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

end program ex0710 allocate(grades(students), stat = error) Error 數數 allocate stat error 數 If error = 0 then allocate 列 Otherwise allocate 不 deallocate(grades(students), stat = error) 6-4-4 列數 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 = 9 6 3 8 5 2 7 4 1 a e.q. integer :: b(2,3) = reshape( (/1,2,3,4,5,6/), (/2,3/) ) = 6 4 2 5 3 1 b 7. transpose(matrix) returns the transpose of matri

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

行 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 7-1-1 variable passing in Fortran : The pass-by-reference scheme Fortran 參數數 33

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

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

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

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=3.14159 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

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

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

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=3.14159 angle_to_rad = angle * pi / 180.0 return end function angle_to_rad Fortran 90 interface interface (i) 參數來參數 (ii) 參數數不 (iii) 參數 (iv) 列參數 40

(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 10 20 數 present optional 參數數 present 邏參數.true..false. 類不數參數 interface 41

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

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 = 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) 43

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 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

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 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 立 module module module module 數數 module module 來 contains module 45

subroutine sub1(a) end subroutine sub1 function fun1(b) end function fun1 end module module_name 數 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 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

read(*,*) angle write(*,*) Input shoot speed: read(*,*) speed write(*, (T2, A4, F7.2, 1A) ) Fly, get_distance(angle, speed), m end program ex0820 7-10 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 * 3.14159 / 180.0) return end function trig_func 47

Chapter 8 讀讀讀兩 (1) 讀讀來讀料 (2) 讀讀來讀 (1) 料都理來易 (2) 料 ( ) 讀省 8-1-1 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

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) 8-1-2 The close statement close (close_list) 8-1-3 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

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

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 + 1 30 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 3.12 2.98 3.34 2.86 51

2.54 2.78 2.23 2.56 來率 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 行度 = 4 + 2 = 6 unix 行行行度行數量 1 Example : 率 Program ex0910 character(len = 20), parameter :: input = newlist 52

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

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