├── 10.Pointer and Allocatable Variables ├── Linked list │ ├── README.md │ ├── list_sort.f90 │ └── sorted_integer_lists_module.f90 ├── Moving Pointers vs. Moving Data │ ├── README.md │ └── temp_pointer.f90 ├── Trees │ ├── tree_module.f90 │ └── tree_sort.f90 └── pointer_practice │ ├── README.md │ └── pointer_example.f90 ├── 12.Object-Oriented Programming ├── Line_example │ ├── Line_example.f90 │ ├── README.md │ └── line_mod.f90 └── case study vehicle queues │ ├── README.md │ ├── test_q.f90 │ ├── v_q_module.f90 │ └── vehicle_module.f90 ├── 13.coarray(parallel computing) ├── README.md ├── coarray_examples │ ├── image_funs.f90 │ ├── order_images.f90 │ └── sync_star.f90 ├── heat_transfer │ ├── README.md │ ├── heat4.f90 │ └── heat_xfer_mod.f90 ├── more_examples │ ├── bound.f90 │ ├── bound_mod.f90 │ └── ptr_comp.f90 └── sorting │ ├── README.md │ ├── sort_mod.f90 │ └── sorting.f90 ├── 2.control_structure ├── associate │ └── assoc.f90 └── numerical_integration │ └── integral.f90 ├── 3.modules and procedures └── adaptive numerical integration (trapzoid and simpson) │ ├── function_module.f90 │ ├── integral_module.f90 │ ├── integrate.f90 │ └── math_module.f90 ├── 4.Arrays ├── binary_search_example │ ├── binary_search_example.f90 │ └── myfunctions.f90 ├── case study 1 Heat Transfer │ └── heat.f90 ├── case study 2 dice rolls │ ├── dice_roll.f90 │ └── myfunctions.f90 ├── empty_array_append │ ├── README.md │ └── test_q_2.f90 ├── reading a list of Unknown size │ ├── card.txt │ ├── myfunctions.f90 │ └── read_cards_2.f90 ├── select │ ├── myfunctions.f90 │ ├── select_example.f90 │ └── select_mod.f90 ├── sorting │ ├── myfunctions.f90 │ ├── sort_mod.f90 │ └── sorting_example.f90 └── where_example │ └── elsewhere_example.f90 ├── 6.Structures and Derived Types ├── matrix_example │ ├── matrix_example.f90 │ └── matrix_mod.f90 └── student record │ ├── myfunctions.f90 │ ├── student_mod.f90 │ └── student_record.f90 ├── 8.More about Modules and Procedures ├── elemental procedures │ ├── myfunctions.f90 │ └── test_swap.f90 ├── generic procedures │ ├── myfunctions.f90 │ └── test_random.f90 ├── reshape_order │ └── reshape_fun.f90 └── submodules │ ├── line_length_mod.f90 │ ├── line_mod.f90 │ └── submod.f90 └── README.md /10.Pointer and Allocatable Variables/Linked list/README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | ## Linked list (working in gfortran not in ifort) 3 | 1. Recursive List Processing 4 | To view the list as a recursive data structure as described above, a node should consist of a value and another object, next, of type sorted_list. An object of type 5 | sorted_list is a pointer. 6 | 2. Inserting a Number 7 | Let us first do the subroutine that inserts a number into a list. The recursive version is 8 | deceptively simple. First, if the list is empty, another list must be created and the number 9 | placed in its value field. Then the next field is made empty because there are no 10 | other elements in the list. 11 | If the list is not empty, the number to be inserted must be compared with the first 12 | value in the list. If it is smaller or equal, it must be inserted as the first value of the list. 13 | Again, a new first node is created and the number placed in its value field. However, 14 | this time the next field of this new first node is set equal to the original list before the 15 | insertion because all other numbers in the list follow this new number. 16 | A temporary variable of type list is necessary to prevent losing the reference to the 17 | list when a new first node is allocated. Notice that pointer assignment (=>) is used for 18 | the variables of type sorted_list. 19 | These are the nonrecursive base cases of the recursive subroutine insert. The only 20 | other remaining case is when the number to be inserted is greater than the first element 21 | of the list. In this case, the insertion is completed by a recursive call to insert the 22 | number in the rest of the list. 23 | 3. Determining if a List is Empty 24 | The function that determines if a list is empty is straightforward. Recall that a pointer 25 | is not associated if it is null. 26 | 4. Deleting a Number 27 | The subroutine to delete a number from a list, if it is there, is quite similar to the subroutine 28 | to insert. There are two special nonrecursive cases. If the list is empty, the number 29 | cannot be deleted from it, so found is set to false. If the number is the first number 30 | in the list, deleting it may be accomplished by making list start with its second element 31 | (if any) using the statement. 32 | Also, it is a good idea to deallocate the space for the deleted node to avoid unreferenced 33 | storage. 34 | The first of these must be done before list is reassigned, and the others 35 | afterward. temp%next must be set to null, so that when temp is deallocated, the final 36 | subroutine empty does not deallocate the entire remainder of the list. 37 | In case the list is not empty, but the desired number is not its first element, the 38 | number is deleted by a recursive call to delete it from the rest of list. 39 | 5. Whenever a list of type sorted_list is deallocated, the final subroutine empty is called 40 | with the list as its argument. The subroutine deletes the node pointed to by the argument 41 | list and recursively deletes the list referenced by its next component. -------------------------------------------------------------------------------- /10.Pointer and Allocatable Variables/Linked list/list_sort.f90: -------------------------------------------------------------------------------- 1 | ! list_sort.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! list_sort - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: list_sort 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program list_sort 16 | 17 | use sorted_integer_lists_module 18 | implicit none 19 | 20 | type(sorted_list), pointer :: list => null() 21 | logical :: found 22 | integer :: n 23 | integer, dimension(9), parameter :: numbers = [ 4, 6, 3, 8, 7, 9, 2, 1, 5 ] 24 | 25 | do n = 1, size(numbers) 26 | call insert(list, numbers(n)) 27 | end do 28 | print *, "Sorted list" 29 | call print_list(list) 30 | 31 | do n = 1, size(numbers) 32 | if (modulo(numbers(n), 2) /= 0) then 33 | call delete1(list, numbers(n), found) 34 | if (.not. found) then 35 | print *, numbers(n), "not found in list" 36 | end if 37 | end if 38 | end do 39 | 40 | print *; print * 41 | print *, "List with odd numbers deleted" 42 | call print_list(list) 43 | deallocate(list) 44 | print *; print * 45 | print *, "Is list empty?", is_empty(list) 46 | pause 47 | end program list_sort 48 | 49 | -------------------------------------------------------------------------------- /10.Pointer and Allocatable Variables/Linked list/sorted_integer_lists_module.f90: -------------------------------------------------------------------------------- 1 | module sorted_integer_lists_module 2 | implicit none 3 | private 4 | 5 | type, public :: sorted_list 6 | private 7 | integer :: value1 8 | type(sorted_list), pointer :: next => null() 9 | contains 10 | ! the final subroutine will be excuted automatically and we don't need to call the function 11 | final:: empty 12 | end type sorted_list 13 | 14 | public:: is_empty, insert, delete1, print_list 15 | 16 | 17 | 18 | contains 19 | recursive subroutine insert(list, number) 20 | 21 | type(sorted_list), pointer, intent(in out) :: list 22 | 23 | integer, intent(in) :: number 24 | type(sorted_list), pointer :: temp 25 | 26 | if (is_empty(list)) then 27 | allocate (list) 28 | list%value1 = number 29 | ! the inserted number is less, then temp is alias of current cell 30 | ! create a new cell by allocate(cell) 31 | ! the cell is filled by number and pointer: temp pointer to the cell has value larger than number (next) 32 | else if (number <= list%value1) then 33 | temp => list 34 | allocate (list) 35 | list = sorted_list(number, temp) 36 | else 37 | ! the inserted number is greater, then call the recursive 38 | call insert(list%next, number) 39 | end if 40 | end subroutine insert 41 | 42 | function is_empty(list) result(is_empty_result) 43 | type(sorted_list), pointer, intent(in) :: list 44 | 45 | logical :: is_empty_result 46 | ! test if the list is associated with any other data 47 | is_empty_result = .not. associated(list) 48 | end function is_empty 49 | 50 | recursive subroutine delete1(list, number, found) 51 | type(sorted_list), pointer, intent(in out) :: list 52 | integer, intent(in) :: number 53 | logical, intent(out) :: found 54 | type(sorted_list), pointer :: temp 55 | 56 | if (is_empty(list)) then 57 | found = .false. 58 | else if (list%value1 == number) then 59 | ! Delete node pointed to by list, this list is the pointer of previous list%next pointer 60 | temp => list 61 | list => list%next 62 | temp%next => null() 63 | deallocate(temp) 64 | found = .true. 65 | 66 | else 67 | ! if it is not the desired number call the recursive 68 | call delete1(list%next, number, found) 69 | end if 70 | end subroutine delete1 71 | 72 | recursive subroutine print_list(list) 73 | type(sorted_list), pointer, intent(in) :: list 74 | if (associated(list)) then 75 | write (unit=*, fmt="(tr1, i0)", advance="no") list%value1 76 | call print_list(list%next) 77 | end if 78 | end subroutine print_list 79 | 80 | recursive subroutine empty(list) 81 | type(sorted_list), intent(in out) :: list 82 | if (associated(list%next)) then 83 | deallocate (list%next) 84 | end if 85 | end subroutine empty 86 | end module sorted_integer_lists_module -------------------------------------------------------------------------------- /10.Pointer and Allocatable Variables/Moving Pointers vs. Moving Data/README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | ## Moving Pointers vs. Moving Data 3 | Use example in 4.6 4 | It is not a good demo. Associate function is not associate any alias change within it function. -------------------------------------------------------------------------------- /10.Pointer and Allocatable Variables/Moving Pointers vs. Moving Data/temp_pointer.f90: -------------------------------------------------------------------------------- 1 | ! temp_pointer.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! temp_pointer - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: temp_pointer 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program temp_pointer 16 | 17 | implicit none 18 | integer, parameter :: P = 100 19 | double precision, dimension(:, :), pointer:: plate 20 | double precision, dimension(:, :), pointer :: temp_plate, n, s, e, w,inside 21 | double precision, dimension(:, :), pointer :: temporary 22 | double precision, dimension(P-2, P-2),target :: temp 23 | double precision, parameter :: tolerance = 1.0e-4 24 | character(len=*), parameter :: plate_format = "(100f5.2)" 25 | double precision :: diff 26 | integer :: i,j, niter 27 | ! cpu test setup 28 | real:: start, finish 29 | ! Set up initial conditions 30 | allocate(plate(P,P)) 31 | plate = 0.0 32 | plate(:, 1) = 1.0 ! boundary values 33 | plate(1, :) = [ ( dble(j)/P, j = P, 1, -1 ) ] 34 | inside => plate(2:P-1, 2:P-1) 35 | n => plate(1:P-2, 2:P-1) 36 | s => plate(3:P, 2:P-1) 37 | e => plate(2:P-1, 1:P-2) 38 | w => plate(2:P-1, 3:P) 39 | allocate(temp_plate(P,P)) 40 | temp_plate = 0.0 41 | temp_plate(:, 1) = 1.0 ! boundary values 42 | temp_plate(1, :) = [ ( dble(j)/P, j = P, 1, -1 ) ] 43 | allocate(temporary(P,P)) 44 | temporary = 0.0 45 | temporary(:, 1) = 1.0 ! boundary values 46 | temporary(1, :) = [ ( dble(j)/P, j = P, 1, -1 ) ] 47 | 48 | !----------- 49 | call cpu_time(start) 50 | 51 | ! Iterate 52 | niter = 0 53 | do 54 | temp_plate(2:P-1, 2:P-1) = (n + e + s + w) / 4.0 55 | diff = maxval(abs(temp_plate(2:P-1, 2:P-1)-inside)) 56 | niter = niter + 1 57 | 58 | temporary => plate 59 | plate => temp_plate 60 | temp_plate => temporary 61 | inside => plate(2:P-1, 2:P-1) 62 | n => plate(1:P-2, 2:P-1) 63 | s => plate(3:P, 2:P-1) 64 | e => plate(2:P-1, 1:P-2) 65 | w => plate(2:P-1, 3:P) 66 | 67 | if (diff < tolerance) exit 68 | end do 69 | 70 | call cpu_time(finish) 71 | print *, "Moving pointer = ", finish-start, "second" 72 | print plate_format, [(plate(i, :), i = 1, P)] 73 | 74 | pause 75 | 76 | end program temp_pointer 77 | 78 | -------------------------------------------------------------------------------- /10.Pointer and Allocatable Variables/Trees/tree_module.f90: -------------------------------------------------------------------------------- 1 | module tree_module 2 | implicit none 3 | public :: insert, print_tree 4 | type, public :: tree_type 5 | integer :: value1 6 | type(tree_type), pointer :: left, right 7 | end type tree_type 8 | 9 | 10 | contains 11 | 12 | recursive subroutine insert(tree, number) 13 | type(tree_type), pointer, intent(in out) :: tree 14 | integer, intent(in) :: number 15 | ! If (sub)tree is empty, put number at root 16 | if (.not. associated(tree)) then 17 | allocate (tree) 18 | tree%value1 = number 19 | nullify (tree%left) 20 | nullify (tree%right) 21 | ! Otherwise, insert into correct subtree 22 | else if (number < tree%value1) then 23 | call insert(tree%left, number) 24 | else 25 | call insert(tree%right, number) 26 | end if 27 | end subroutine insert 28 | 29 | recursive subroutine print_tree(tree) 30 | ! Print tree in infix order 31 | type(tree_type), pointer :: tree 32 | if (associated(tree)) then 33 | call print_tree(tree % left) 34 | print *, tree % value1 35 | call print_tree(tree % right) 36 | end if 37 | end subroutine print_tree 38 | 39 | end module tree_module -------------------------------------------------------------------------------- /10.Pointer and Allocatable Variables/Trees/tree_sort.f90: -------------------------------------------------------------------------------- 1 | ! tree_sort.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! tree_sort - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: tree_sort 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program tree_sort 16 | 17 | ! Sorts a list of integers by building 18 | ! a tree, sorted in infix order. 19 | ! This sort has expected behavior n log n, 20 | ! but worst case (input is sorted) n ** 2. 21 | use tree_module 22 | implicit none 23 | ! Start with an empty tree 24 | type(tree_type), pointer :: tree 25 | integer :: number, ios, n 26 | integer, dimension(9), parameter :: numbers =[ 4, 6, 3, 8, 7, 9, 2, 1, 5 ] 27 | 28 | 29 | do n = 1, size(numbers) 30 | call insert(tree, numbers(n)) 31 | end do 32 | call print_tree(tree) 33 | pause 34 | 35 | end program tree_sort 36 | 37 | -------------------------------------------------------------------------------- /10.Pointer and Allocatable Variables/pointer_practice/README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | ## pointer 3 | 1. The associated Intrinsic Function 4 | 2. Pointer Remapping 5 | 3. Procedure Pointers 6 | 4. Arrays of Procedures -------------------------------------------------------------------------------- /10.Pointer and Allocatable Variables/pointer_practice/pointer_example.f90: -------------------------------------------------------------------------------- 1 | ! pointer_example.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! pointer_example - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: pointer_example 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program pointer_example 16 | 17 | implicit none 18 | real, target, dimension(4) :: a = [ 1, 2, 3, 4 ] 19 | real, pointer, dimension(:) :: p, q 20 | real, pointer, dimension(:, :) :: matrix 21 | real, pointer, dimension(:) :: diagonal, base 22 | real:: results 23 | !---------------Procedure pointers----------------------------------- 24 | interface 25 | function f(x,y) result(f_result) 26 | real, intent(in)::x,y 27 | real:: f_result 28 | end function f 29 | end interface 30 | procedure (f), pointer :: fff => null() 31 | !---------------arrays of procedure pointers----------------------------------- 32 | type :: proc_type 33 | procedure (f), pointer, nopass :: ptr_to_f => null() 34 | end type proc_type 35 | type (proc_type), dimension(:), allocatable :: ap 36 | integer:: n=3, i 37 | 38 | 39 | !----------------associat------------------------------------- 40 | p => a(1:3) 41 | q => a(2:4) 42 | ! point p and q are asscoiated 43 | print *, "if associated: " 44 | print *, associated(p, q) 45 | print * 46 | !---------------------pointer remapping--------------------- 47 | allocate (base(n*n)) 48 | base = [2.3, 3.6 , 5.2, 6.3, 9.0, 8.5, 6.5, 1.2, 3.7] 49 | matrix(1:n, 1:n) => base 50 | ! diagonal 51 | diagonal => base(::n+1) ! start from 1(:) to the end(:) by increment n+1 52 | print *, "Diagonal: " 53 | print "(3f5.1)", diagonal 54 | print *, "Matrix: " 55 | print "(3f5.1)", [ (matrix(i,:),i=1,n) ] 56 | print * 57 | 58 | !---------------Procedure pointers----------------------------------- 59 | fff => add 60 | results = fff(0.24,3.0) 61 | print *, 'printing 0.24 + 3.0' 62 | print *, 'using procedure pointer:', results ! prints cos(0.24) 63 | print *, 'using intrisc function :', 0.24 + 3.0 64 | print * 65 | 66 | !---------------arrays of procedure pointers----------------------------------- 67 | allocate (ap(n)) 68 | ap(1)%ptr_to_f => add 69 | ap(2)%ptr_to_f => sub 70 | ap(3)%ptr_to_f => times 71 | print *, 'printing 0.24 + 3.0' 72 | print *, 'using procedure pointer:', ap(1)%ptr_to_f(0.24,3.0) 73 | print *, 'printing 0.24 - 3.0' 74 | print *, 'using procedure pointer:', ap(2)%ptr_to_f(0.24,3.0) 75 | print *, 'printing 0.24 * 3.0' 76 | print *, 'using procedure pointer:', ap(3)%ptr_to_f(0.24,3.0) 77 | pause 78 | 79 | 80 | 81 | contains 82 | function add(a,b) result(c) 83 | real, intent(in):: a,b 84 | real:: c 85 | c = a + b 86 | end function add 87 | 88 | function sub(a,b) result(c) 89 | real, intent(in):: a,b 90 | real:: c 91 | c = a - b 92 | end function sub 93 | 94 | function times(a,b) result(c) 95 | real, intent(in):: a,b 96 | real:: c 97 | c = a * b 98 | end function times 99 | end program pointer_example 100 | 101 | -------------------------------------------------------------------------------- /12.Object-Oriented Programming/Line_example/Line_example.f90: -------------------------------------------------------------------------------- 1 | ! Line_example.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! Line_example - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: Line_example 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program Line_example 16 | 17 | use line_mod 18 | 19 | implicit none 20 | ! define polymorphic 21 | class(line_type), allocatable :: line 22 | class(vector_type1), allocatable :: line1 23 | class(vector_type2), allocatable :: line2 24 | class(line_type), allocatable :: fancy_line 25 | ! use type 26 | type(vector_type1) :: line3 27 | type(painted_line_type) :: line4 28 | ! line_type 29 | !-------------------------------------------------------- 30 | ! line = line_type(1.1, 2.2, 4.4, 5.5) fortran 2008 31 | allocate (line, source=line_type(1.1, 2.2, 4.4, 5.5)) 32 | ! it can call it inheritant 33 | print *, 'line type:' 34 | print *, line%x1 35 | !----------------------------------------------------------- 36 | ! the extend type 37 | allocate (line1, source=vector_type1(1.1, 2.2, 4.4, 5.5, 2)) 38 | print *, 'extend type:' 39 | print *, line1%x1 40 | !----------------------------------------------------------- 41 | ! the line is inheritant from this type 42 | allocate (line2, source=vector_type2(line,2)) 43 | print *, 'inheritant type:' 44 | print *, line2%line%x1 45 | !----------------------------------------------------------- 46 | ! the extend extend type 47 | allocate (fancy_line, source=fancy_line_type(0.0, 0.0, 0.0, 1.1, 0, 0, 0, 100)) 48 | print *, 'extend extend type:' 49 | print *, fancy_line%x1 50 | !------------------------------------------------------------ 51 | ! use type 52 | line3 = vector_type1(1.1, 2.2, 4.4, 5.5, 2) 53 | print *, 'type:' 54 | print *, line3%x1 55 | 56 | !-------------------------------------------------------------- 57 | ! type bound procedure 58 | print *, "length" 59 | print *, line%length() 60 | !----------------------------------------------------------- 61 | ! procedure pointer component 62 | line4%fp => add 63 | print*,line4%fp(2.1,2.1) 64 | pause 65 | 66 | end program Line_example 67 | 68 | -------------------------------------------------------------------------------- /12.Object-Oriented Programming/Line_example/README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | ## OOP basics 3 | 1. Extended Data Types 4 | 2. Polymorphism (class) 5 | 3. Procedure and Derived Types 6 | 3.1. Type-Bound Procedures 7 | 3.2. Procedure Pointer Component -------------------------------------------------------------------------------- /12.Object-Oriented Programming/Line_example/line_mod.f90: -------------------------------------------------------------------------------- 1 | module line_mod 2 | 3 | type, public :: line_type 4 | real :: x1, y1, x2, y2 5 | ! type-bound procedures 6 | contains 7 | procedure, public :: length 8 | end type line_type 9 | !---------------------inherited from line_type----------------------- 10 | type, public, extends(line_type) :: painted_line_type 11 | !integer :: r, g, b ! Values each 0-100 12 | ! Procedure Pointer Components 13 | procedure (f), pointer, nopass :: fp => null() 14 | end type painted_line_type 15 | 16 | type, public, extends(line_type) :: vector_type1 17 | integer :: direction ! 0 not directed, 1 toward (x1, y1) or 2 18 | ! Procedure Pointer Components 19 | !procedure (f), pointer, nopass :: fp => null() 20 | end type vector_type1 21 | !--------------------------------------------------------------------- 22 | !-----------------------------inherit line_type----------------------- 23 | type, public :: vector_type2 24 | type(line_type) :: line 25 | integer :: direction 26 | !procedure (f), pointer, nopass :: fp => null() 27 | end type vector_type2 28 | !------------------------------extend vector_type1------------------ 29 | type, public, extends(vector_type1) :: fancy_line_type 30 | integer :: r, g, b 31 | !procedure (f), pointer, nopass :: fp => null() 32 | end type fancy_line_type 33 | !----------------------------------------------------------- 34 | interface 35 | function f(x,y) result(f_result) 36 | real, intent(in)::x,y 37 | real:: f_result 38 | end function f 39 | end interface 40 | 41 | contains 42 | function length(ab) result(length_result) 43 | class(line_type), intent(in) :: ab 44 | length_result = sqrt( (ab%x1-ab%x2)**2 + (ab%y1-ab%y2)**2 ) 45 | end function length 46 | 47 | function add(a,b) result(c) 48 | real, intent(in):: a,b 49 | real:: c 50 | c = a + b 51 | end function add 52 | end module line_mod -------------------------------------------------------------------------------- /12.Object-Oriented Programming/case study vehicle queues/README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | ## OOP basics 3 | This case is not working on ifort.... -------------------------------------------------------------------------------- /12.Object-Oriented Programming/case study vehicle queues/test_q.f90: -------------------------------------------------------------------------------- 1 | ! test_q.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! test_q - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: test_q 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program test_q 16 | 17 | use vehicle_module 18 | use v_q_module 19 | implicit none 20 | class(vehicle_type), allocatable :: v 21 | type(q_type) :: q 22 | logical :: f 23 | call q%empty() 24 | print *, "Is Q empty?", q%is_empty() 25 | allocate (v, source=car_type(2000.0, 4, "C-1455", .false.)) 26 | print *, "Inserting car C-1455" 27 | call q%insert(v) 28 | deallocate (v) 29 | print *, "Is Q empty?", q%is_empty() 30 | print *, "Printing Q:" 31 | call q%print_licenses() 32 | print * 33 | allocate (v, source=bus_type(9000.0, 6, "B-6700", 70)) 34 | print *, "Inserting bus B-6700" 35 | call q%insert(v) 36 | deallocate (v) 37 | allocate (v, source=truck_type(9000.0, 18, "T-8800", 20000.00)) 38 | print *, "Inserting truck T-8800" 39 | call q%insert(v) 40 | deallocate (v) 41 | allocate (v, source=bus_type(8000.0, 6, "B-6701", 70)) 42 | print *, "Inserting bus B-6701" 43 | call q%insert(v) 44 | deallocate (v) 45 | print *, "Printing Q:" 46 | call q%print_licenses() 47 | print * 48 | print *, "Removing first vehicle in Q:" 49 | call q%remove(v, f) 50 | print *, "Found:", f, trim(v%license) 51 | print *, "Printing Q:" 52 | call q%print_licenses() 53 | print * 54 | print *, "Removing all vehicles from Q:" 55 | call q%empty() 56 | print *, "Printing Q:" 57 | call q%print_licenses() 58 | call q%remove(v, f) 59 | print *,f 60 | end program test_q 61 | 62 | -------------------------------------------------------------------------------- /12.Object-Oriented Programming/case study vehicle queues/v_q_module.f90: -------------------------------------------------------------------------------- 1 | module v_q_module 2 | use vehicle_module 3 | implicit none 4 | private 5 | 6 | type :: node_type 7 | class(vehicle_type), allocatable :: v 8 | end type node_type 9 | 10 | type, public :: q_type 11 | private 12 | type(node_type), dimension(:), allocatable :: vehicles 13 | 14 | contains 15 | procedure :: empty 16 | procedure :: is_empty 17 | procedure :: insert 18 | procedure :: remove 19 | procedure :: print_licenses 20 | end type q_type 21 | 22 | contains 23 | subroutine empty(q) 24 | class(q_type), intent(out) :: q 25 | q%vehicles = [ node_type:: ] 26 | end subroutine empty 27 | 28 | function is_empty(q) result(is_empty_result) 29 | class(q_type), intent(in) :: q 30 | logical :: is_empty_result 31 | is_empty_result = (size(q%vehicles) == 0) 32 | end function is_empty 33 | 34 | subroutine insert(q, dv) 35 | class(q_type), intent(in out) :: q 36 | class(vehicle_type), intent(in), allocatable :: dv 37 | q%vehicles = [ q%vehicles, node_type(dv) ] 38 | end subroutine insert 39 | 40 | subroutine remove(q, first, found) 41 | class(q_type), intent(in out) :: q 42 | type(vehicle_type), allocatable, intent(out) :: first 43 | logical, intent(out) :: found 44 | found = .not. is_empty(q) 45 | if (.not. found) return ! Q is empty 46 | first = q%vehicles(1)%v 47 | q%vehicles = q%vehicles(2:) 48 | end subroutine remove 49 | 50 | 51 | subroutine print_licenses(q) 52 | class(q_type), intent(in) :: q 53 | integer :: n 54 | do n = 1, size(q%vehicles) 55 | select type (temp_v=>q%vehicles(n)%v) 56 | type is (car_type) 57 | write (unit=*, fmt="(a9)", advance="no") "Car:" 58 | type is (bus_type) 59 | write (unit=*, fmt="(a9)", advance="no") "Bus:" 60 | type is (truck_type) 61 | write (unit=*, fmt="(a9)", advance="no") "Truck:" 62 | class default 63 | write (unit=*, fmt="(a9)", advance="no") "Vehicle:" 64 | end select 65 | print *, trim(q%vehicles(n)%v%license) 66 | end do 67 | end subroutine print_licenses 68 | 69 | end module v_q_module -------------------------------------------------------------------------------- /12.Object-Oriented Programming/case study vehicle queues/vehicle_module.f90: -------------------------------------------------------------------------------- 1 | module vehicle_module 2 | implicit none 3 | private 4 | 5 | type, public :: vehicle_type 6 | real :: weight 7 | integer :: number_of_wheels 8 | character(len=9) :: license 9 | end type vehicle_type 10 | 11 | type, public, extends(vehicle_type) :: car_type 12 | logical :: is_a_taxi 13 | end type car_type 14 | 15 | type, public, extends(vehicle_type) :: truck_type 16 | real :: capacity 17 | end type truck_type 18 | 19 | type, public, extends(vehicle_type) :: bus_type 20 | integer :: passengers 21 | end type bus_type 22 | 23 | end module vehicle_module -------------------------------------------------------------------------------- /13.coarray(parallel computing)/README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | ## Sorting Example 3 | ## Job Scheduling 4 | -------------------------------------------------------------------------------- /13.coarray(parallel computing)/coarray_examples/image_funs.f90: -------------------------------------------------------------------------------- 1 | ! image_funs.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! image_funs - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: image_funs 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program image_funs 16 | 17 | implicit none 18 | real, codimension[0:1, *] :: C 19 | if (this_image() == 2) then 20 | print *, "num_images =", num_images() 21 | print *, "lower cobounds of C", lcobound(C) 22 | print *, "upper cobounds of C", ucobound(C) 23 | print *, "cosubscripts of C on image 2", this_image(C) 24 | endif 25 | end program image_funs 26 | 27 | !Because there are four images and C is declared with codimensions [0:1, *], C is represented on the four images as follows: 28 | !C[0, 1] is on image 1 29 | !C[1, 1] is on image 2, hence the cosubscripts of C on image 2 are 1 and 1 30 | !C[0, 2] is on image 3 31 | !C[1, 2] is on image 4 -------------------------------------------------------------------------------- /13.coarray(parallel computing)/coarray_examples/order_images.f90: -------------------------------------------------------------------------------- 1 | ! order_images.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! order_images - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: order_images 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | !To understand how this program works, it is helpful to think first about the execution 15 | !by image 1, then image 2, and so forth. For image 1, the first if statement is false, 16 | !so the two assignment statements are executed next. They set p(1) to 1 on image 1 and 17 | !increment k on image 1 to 2. Then it issues a sync with image 2, so image 1 waits at this 18 | !point until image 2 syncs with it. 19 | !Meanwhile, image 2 executes the statement that syncs it with image 1, so it waits 20 | !until image 1 has executed the assignment statements described above and syncs with 21 | !image 2. Then image 1 can continue to the sync all statement and wait for the other 22 | !images to reach that point. Image 2 executes the two assignment statements, setting 23 | !p(2) to 2 and k to 3 (both on image 1 only). 24 | !The execution on images 3 and 4 is similar. After all images reach the sync all 25 | !statement, image 1 prints the four values of the array p, which are 1, 2, 3, and 4. 26 | program order_images 27 | 28 | implicit none 29 | integer :: me, n_i 30 | integer, codimension[*] :: k = 1 31 | integer, dimension(4), codimension[*] :: p 32 | me = this_image() 33 | n_i = num_images() 34 | if (me > 1) sync images (me - 1) 35 | p(k[1])[1] = me 36 | k[1] = k[1] + 1 37 | if (me < n_i) sync images (me + 1) 38 | sync all 39 | if (this_image() == 1) print *, p 40 | pause 41 | 42 | end program order_images 43 | 44 | -------------------------------------------------------------------------------- /13.coarray(parallel computing)/coarray_examples/sync_star.f90: -------------------------------------------------------------------------------- 1 | ! sync_star.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! sync_star - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: sync_star 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program sync_star 16 | 17 | implicit none 18 | integer, codimension[*] :: cointeger = 99 19 | select case (this_image()) 20 | case (1) 21 | cointeger = 10 22 | sync images (*) 23 | case (2, 3) 24 | sync images (1) 25 | print *, this_image() * cointeger[1] 26 | case default 27 | ! Image 1 hangs without this: 28 | sync images (1) 29 | print *, cointeger 30 | end select 31 | pause 32 | end program sync_star 33 | 34 | -------------------------------------------------------------------------------- /13.coarray(parallel computing)/heat_transfer/README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | ## Heat transfer example 3 | need 4 nodes computer to run 4 | -------------------------------------------------------------------------------- /13.coarray(parallel computing)/heat_transfer/heat4.f90: -------------------------------------------------------------------------------- 1 | ! heat4.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! heat4 - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: heat4 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program heat4 16 | use heat_xfer_mod 17 | implicit none 18 | 19 | integer :: start, stop1, counts_per_second 20 | integer :: line 21 | real, dimension(:,:), allocatable, target :: a 22 | real, dimension(:,:), allocatable :: temp 23 | call set_boundary_conditions() 24 | sync all 25 | call system_clock(start, counts_per_second) 26 | call initialize_quadrants() 27 | sync all 28 | call heat_xfer() 29 | sync all 30 | 31 | ! if (this_image() == 1) then 32 | ! call system_clock(stop1) 33 | ! print *, "For 4-image solution, time = ", & 34 | ! (stop1 - start) / counts_per_second, " seconds" 35 | ! allocate (plate(0:P+1,0:P+1), stat = alloc_stat) 36 | ! if (alloc_stat > 0) then 37 | ! print *, "Allocation of plate failed" 38 | ! stop 39 | ! end if 40 | ! plate(0:Q, 0:Q) = quad(0:Q, 0:Q ) [1,1] ! NW 41 | ! plate(Q+1:, 0:Q) = quad(1:Q+1, 0:Q ) [2,1] ! SW 42 | ! plate(0:Q, Q+1:) = quad(0:Q, 1:Q+1) [1,2] ! NE 43 | ! plate(Q+1:, Q+1:) = quad(1:Q+1, 1:Q+1) [2,2] ! SE 44 | ! print * 45 | ! print *, "Number of iterations (4 images):", n_iter !MPI *100 46 | ! ! call print_plate(plate) ! Uncomment for debugging 47 | ! end if 48 | ! 49 | ! if (this_image() == 1) then 50 | ! allocate (a(0:P+1,0:P+1), temp(P,P), & 51 | ! stat = alloc_stat) 52 | ! if (alloc_stat > 0) then 53 | ! print *, "Allocation of a or temp failed" 54 | ! stop 55 | ! end if 56 | ! a = 0 57 | ! a(0, :) = top 58 | ! a(:, 0) = left 59 | ! a(:, P+1) = right 60 | ! a(P+1:, 0) = bottom 61 | ! call system_clock(start) 62 | ! n_iter = 0 63 | ! associate ( & 64 | ! interior => a(1:P, 1:P), & 65 | ! n => a(0:P-1, 1:P ), & 66 | ! s => a(2:P+1, 1:P ), & 67 | ! w => a(1:P, 0:P-1), & 68 | ! e => a(1:P, 2:P+1)) 69 | ! call system_clock(start) 70 | ! n_iter = 0 71 | ! do 72 | ! temp = (n + e + w + s) / 4 73 | ! n_iter = n_iter + 1 74 | ! diff = maxval(abs(temp - interior)) 75 | ! interior = temp 76 | ! if (diff < tolerance) exit 77 | ! end do 78 | ! end associate 79 | ! call system_clock(stop1) 80 | ! print * 81 | ! print *, "For 1-image solution, time = ", & 82 | ! (stop1 - start) / counts_per_second, " seconds" 83 | ! diff = maxval(abs(plate(1:P, 1:P) - a(1:P, 1:P))) 84 | ! print * 85 | ! print *, "Number of iterations (1 image):", n_iter 86 | ! ! call print_plate(a) ! Uncomment to see values for small plate 87 | ! print * 88 | ! print *, "Max difference between methods:", diff 89 | ! end if 90 | pause 91 | sync all 92 | end program heat4 93 | 94 | -------------------------------------------------------------------------------- /13.coarray(parallel computing)/heat_transfer/heat_xfer_mod.f90: -------------------------------------------------------------------------------- 1 | module heat_xfer_mod 2 | ! A parameter P represents the size of the plate (also Q = P/2 will be used in the coarray version). 3 | ! 4 | ! In order to speed up the computation, the plate is divided into quadrants. The iterations 5 | ! needed to solve the heat transfer problem are carried out on each quadrant simultaneously 6 | ! on different images. 7 | ! 8 | ! Although the computations for each quadrant can be executed independently of 9 | ! the other quadrants, some parts of the border of each quadrant are cells in an adjacent 10 | ! quadrant. This is illustrated by looking at the lower-left quadrant (the southwest quadrant). 11 | ! The northern border of this quadrant consists of cells in the northwest quadrant 12 | ! and the eastern border consists of cells in the southeast quadrant. Thus, the values 13 | ! along the southern border of the northwest quadrant must be copied to the image processing 14 | ! the southwest quadrant. 15 | ! 16 | ! Similar declarations are provided for the four-image case, except that there is a 17 | ! coarray quad representing each of four quadrants of the plate and there is a coarray 18 | ! scalar diff that keeps track of how the process is converging. Most of this code is in a 19 | ! module. 20 | implicit none 21 | private 22 | 23 | integer, public, parameter :: P = 100, Q = P/2 24 | real, public, parameter :: tolerance = 1.0e-5 25 | real, public, dimension(:, :), allocatable :: plate 26 | real, public, dimension(:, :), codimension[:,:],allocatable,target :: quad 27 | real, public, dimension(:, :), allocatable :: temp_interior 28 | real, public, codimension[*] :: diff 29 | enum, bind(C) 30 | enumerator :: NW=1, SW, NE, SE 31 | end enum 32 | 33 | real, public, pointer, dimension(:,:) :: n, e, s, w, interior 34 | real, public, allocatable, dimension(:) :: top, bottom, left, right 35 | integer :: j, image 36 | integer, public :: n_iter = 0, alloc_stat 37 | integer, public, parameter :: chunk = 100 38 | 39 | public :: set_boundary_conditions, initialize_quadrants, print_plate , heat_xfer 40 | 41 | contains 42 | ! The module procedure set_boundary_conditions allocates the arrays top, left, 43 | ! right, and bottom and gives them values. A different way to write this code would be 44 | ! to make these parameters 45 | subroutine set_boundary_conditions () 46 | ! boundaries are outside of (1:P,1:P) region 47 | allocate (top (0:P+1), bottom(0:P+1), left(0:P+1), right (0:P+1),stat = alloc_stat) 48 | if (alloc_stat > 0) then 49 | print *, "Allocation of boundary failed on image", this_image() 50 | stop 51 | end if 52 | top = [ 1.0, ( real(j)/P, j = P, 0, -1) ] 53 | left = 1.0 54 | right = 0.0 55 | bottom = 0.0 56 | end subroutine set_boundary_conditions 57 | 58 | ! Another procedure in the module allocates the arrays for each quadrant of the 59 | ! plate. Remember that this same code will be executed on each image. Q is half of P. 60 | subroutine initialize_quadrants () 61 | ! set coarray quad: 62 | ! [1, 1] NW: image 1 63 | ! [2, 1] SW: image 2 64 | ! [1, 2] NE: image 3 65 | ! [2, 2] SE: image 4 66 | ! (0:Q+1, 0:Q+1) to include boundaries and interactive area between other coarray 67 | allocate (quad(0:Q+1, 0:Q+1) [2,*], stat = alloc_stat) 68 | 69 | if (alloc_stat > 0) then 70 | print *, "Allocation of quadrant failed on image", this_image() 71 | stop 72 | end if 73 | ! interior temp of each quad 74 | allocate (temp_interior(1:Q, 1:Q), stat = alloc_stat) 75 | if (alloc_stat > 0) then 76 | print *, "Allocation of temp interior failed on image", this_image() 77 | stop 78 | end if 79 | ! Next, the boundary values are set for each quadrant. Note that NW, SW, NE, and 80 | ! SE are simply parameters with values 1, 2, 3, and 4, declared using enumerators (1.2). 81 | ! The parameter names help to understand the code a little bit better. 82 | 83 | quad = 0.0 84 | select case (this_image()) 85 | case(NW) ! northwest 86 | quad(:,0) = left(:Q+1) 87 | quad(0,:) = top(:Q+1) 88 | case(SW) ! southwest 89 | quad(:,0) = left(Q:) 90 | quad(Q+1,:) = bottom(:Q+1) 91 | case(NE) ! northeast 92 | quad(Q+1,:) = right(:Q+1) 93 | quad(0,:) = top(Q:) 94 | case(SE) ! southeast 95 | quad(Q+1,:) = right(Q:) 96 | quad(Q+1,:) = bottom(Q:) 97 | end select 98 | end subroutine initialize_quadrants 99 | 100 | ! The heat transfer computation itself consists of updating the quadrant boundaries 101 | ! and averaging the temperature at each point in the interior. The loop repeats until 102 | ! there is convergence. This code must use cosubscripts, rather than image numbers. 103 | 104 | subroutine heat_xfer() 105 | heat_xfer_loop: do 106 | ! Update interior quadrant boundaries 107 | ! Plate boundaries have not changed 108 | select case (this_image()) 109 | case(NW) 110 | quad(Q+1, 1:Q) = quad(1, 1:Q)[2,1] ! S shared board with south 111 | quad(1:Q, Q+1) = quad(1:Q, 1)[1,2] ! E shared board with east 112 | case(SW) 113 | quad(0, 1:Q) = quad(Q ,1:Q)[1,1] ! N shared board with north 114 | quad(1:Q, Q+1) = quad(1:Q, 1)[2,2] ! E shared board with east 115 | case(NE) 116 | quad(Q+1, 1:Q) = quad(1, 1:Q)[2,2] ! S shared board with south 117 | quad(1:Q, 0 ) = quad(1:Q, Q)[1,1] ! W shared board with west 118 | case(SE) 119 | quad(0, 1:Q) = quad(Q ,1:Q)[1,2] ! N shared board with north 120 | quad(1:Q, 0 ) = quad(1:Q, Q)[2,1] ! W shared board with west 121 | end select 122 | ! For the southwest quadrant, values are copied from the image to the north into its 123 | ! top boundary, and values are copied from the image to the east into its eastern boundary. 124 | ! The associate construct is used when updating the cells in order to make the code 125 | ! a little more readable. 126 | sync all 127 | ! this is used to reach convergence in each quad 128 | ! associate ( & 129 | ! interior => quad(1:Q, 1:Q), & 130 | ! n => quad(0:Q-1, 1:Q ), & 131 | ! s => quad(2:Q+1, 1:Q ), & 132 | ! e => quad(1:Q , 2:Q+1), & 133 | ! w => quad(1:Q , 0:Q-1)) 134 | ! temp_interior = (n + e + s + w) / 4 135 | ! diff = maxval(abs(interior - temp_interior)) 136 | ! interior = temp_interior 137 | ! end associate 138 | 139 | temp_interior = (quad(1:Q , 2:Q+1) + quad(0:Q-1, 1:Q ) + quad(2:Q+1, 1:Q ) + quad(1:Q , 0:Q-1)) / 4 140 | diff = maxval(abs(quad(1:Q, 1:Q) - temp_interior)) 141 | quad(1:Q, 1:Q) = temp_interior 142 | 143 | sync all 144 | !Then image 1 checks the maximum of the iteration differences 145 | !on the four images and exits the loop if there is convergence. 146 | if (this_image() == 1) then 147 | n_iter = n_iter + 1 148 | do image = 2, num_images() 149 | diff = max (diff, diff[image]) 150 | end do 151 | end if 152 | sync all 153 | if (diff[1] < tolerance) exit heat_xfer_loop 154 | end do heat_xfer_loop 155 | end subroutine heat_xfer 156 | 157 | subroutine print_plate(x) 158 | real, dimension(:,:), intent(in) :: x 159 | integer :: line 160 | print * 161 | do line = 1, size(x, 2) 162 | print "(1000f5.2)", x(line, :) 163 | end do 164 | end subroutine print_plate 165 | 166 | end module heat_xfer_mod -------------------------------------------------------------------------------- /13.coarray(parallel computing)/more_examples/bound.f90: -------------------------------------------------------------------------------- 1 | ! bound.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! bound - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: bound 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program bound 16 | 17 | use bound_mod 18 | implicit none 19 | type(t_type), codimension[*] :: t 20 | t % p => s1 21 | sync all 22 | 23 | select case (this_image()) 24 | case (1) 25 | call t%p() 26 | pause 27 | call t%s2() 28 | pause 29 | call t[2]%p() 30 | pause 31 | call t[2]%s2() 32 | pause 33 | end select 34 | end program bound 35 | 36 | -------------------------------------------------------------------------------- /13.coarray(parallel computing)/more_examples/bound_mod.f90: -------------------------------------------------------------------------------- 1 | module bound_mod 2 | implicit none 3 | private 4 | type, public :: t_type 5 | procedure(s1), pointer, nopass :: p 6 | contains 7 | procedure, nopass :: s2 8 | end type t_type 9 | public :: s1, s2 10 | contains 11 | 12 | subroutine s1() 13 | print *, 1.1 14 | end subroutine s1 15 | 16 | subroutine s2() 17 | print *, 2.2 18 | end subroutine s2 19 | end module bound_mod -------------------------------------------------------------------------------- /13.coarray(parallel computing)/more_examples/ptr_comp.f90: -------------------------------------------------------------------------------- 1 | ! ptr_comp.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! ptr_comp - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: ptr_comp 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | ! A coarray may have a component that is allocatable or a pointer. 15 | ! A coarray may not be a pointer. 16 | ! If the target of a pointer is a coarray, both the pointer and the target must be on the 17 | ! same image. That is, a coarray pointer may not point to a target on a different image. 18 | program ptr_comp 19 | 20 | implicit none 21 | real, target :: x = 1.1, y = 2.2 22 | type :: s_type 23 | real, pointer :: ptr 24 | end type s_type 25 | 26 | type (s_type), codimension[*] :: s 27 | select case (this_image()) 28 | case (1) 29 | s%ptr => x 30 | sync images (2) 31 | case (2) 32 | 33 | s%ptr => y 34 | print *, s[1]%ptr ! 1.1 35 | print *, s%ptr ! 2.2 36 | sync images (1) 37 | pause 38 | end select 39 | !sync all 40 | !print *, s[1]%ptr 41 | !print *, s[2]%ptr 42 | 43 | 44 | end program ptr_comp 45 | 46 | -------------------------------------------------------------------------------- /13.coarray(parallel computing)/sorting/README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | ## Sorting example 3 | This example sures that coarray could reduce computational effort (using interchage_sort subroutine). However, it quick_sort subroutine is used coarray dose not show any 4 | advantages. This is because the data tranfer between the cores could significantly reduce the efficient. 5 | -------------------------------------------------------------------------------- /13.coarray(parallel computing)/sorting/sort_mod.f90: -------------------------------------------------------------------------------- 1 | module sort_mod 2 | 3 | implicit none 4 | public :: quick_sort, interchange_sort 5 | 6 | contains 7 | !------------------------------------------------------- 8 | recursive subroutine quick_sort(list) 9 | 10 | double precision, dimension(:), intent(inout):: list 11 | 12 | integer:: i, j, n 13 | double precision:: chosen, temp 14 | integer, parameter:: max_simple_sort_size = 6 15 | 16 | n = size(list) 17 | if (n <= max_simple_sort_size) then 18 | ! use interchange sort for small lists 19 | call interchange_sort(list) 20 | else 21 | ! use partition ("quick") sort 22 | chosen = list(n/2) 23 | 24 | i = 0 25 | j = n + 1 26 | 27 | do 28 | ! scan list from left end 29 | ! until element >= chosen is found 30 | do 31 | i = i + 1 32 | if(list(i) >= chosen) exit 33 | enddo 34 | ! scan list from right end 35 | ! until element <= chosen is found 36 | do 37 | j = j - 1 38 | if (list(j) <= chosen) exit 39 | enddo 40 | if (i < j) then 41 | ! swap two out of place elements 42 | temp = list(i) 43 | list(i) = list(j) 44 | list(j) = temp 45 | else if (i == j) then 46 | i = i + 1 47 | exit 48 | else 49 | exit 50 | endif 51 | enddo 52 | 53 | if (1 < j) call quick_sort(list(:j)) 54 | if (i < n) call quick_sort(list(i:)) 55 | endif ! test for small array 56 | end subroutine quick_sort 57 | !----------------------------------------------------------------- 58 | subroutine interchange_sort(list) 59 | double precision, dimension(:), intent(inout):: list 60 | integer:: i, j 61 | double precision:: temp 62 | 63 | do i = 1, size(list) - 1 64 | do j = i + 1, size(list) 65 | if (list(i) > list(j)) then 66 | temp = list(i) 67 | list(i) = list(j) 68 | list(j) = temp 69 | endif 70 | enddo 71 | enddo 72 | end subroutine interchange_sort 73 | !------------------------------------------------------------ 74 | ! Here is the function that merges two sorted arrays. At each point in the merging process, 75 | ! the first elements of each sorted list are compared and the smaller one is selected for 76 | ! inclusion as the next element in the merged list. The process is made a little more complicated 77 | ! by handling the merge after one of the lists is exhausted. 78 | function merge2(a,b) result(m) 79 | 80 | double precision, dimension(:), intent(in):: a, b 81 | double precision, dimension(size(a) + size(b)) :: m 82 | integer:: ka, kb, km 83 | 84 | ka = 1; kb = 1; km = 1 85 | 86 | do 87 | if (ka > size(a)) then 88 | m(km:) = b(kb:) 89 | return 90 | else if (kb > size(b)) then 91 | m(km:) = a(ka:) 92 | return 93 | else if (a(ka) < b(kb)) then 94 | m(km) = a(ka) 95 | km = km + 1; ka = ka + 1 96 | else 97 | m(km) = b(kb) 98 | km = km + 1; kb = kb + 1 99 | endif 100 | enddo 101 | end function merge2 102 | end module sort_mod -------------------------------------------------------------------------------- /13.coarray(parallel computing)/sorting/sorting.f90: -------------------------------------------------------------------------------- 1 | ! sorting.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: hello 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program sorting 16 | use sort_mod 17 | implicit none 18 | 19 | ! Variables 20 | integer, parameter:: N = 50000 21 | ! codimension means the array (a) can be accessed by the other images 22 | double precision, dimension(N), codimension[*]::a 23 | double precision, dimension(N):: b 24 | real:: start, finish 25 | 26 | ! generate random numbers on image1 27 | if (this_image() == 1) then 28 | call random_seed() 29 | call random_number(a) 30 | b = a 31 | call cpu_time(start) 32 | endif 33 | ! need sync all beforce coarary 34 | sync all 35 | ! copy 1/3 to image2 36 | if (this_image() == 2) then 37 | ! a(N/3+1:2*N/3) on image1 is copied to image2 38 | a(N/3+1:2*N/3) = a(N/3+1:2*N/3)[1] 39 | endif 40 | ! copy 1/3 to image3 41 | if (this_image() == 3) then 42 | ! a(2*N/3+1:) on image1 is copied to image3 43 | a(2*N/3+1:) = a(2*N/3+1:)[1] 44 | endif 45 | ! need sync all after data transfer 46 | sync all 47 | 48 | ! sorting on image1 and image2 49 | select case (this_image()) 50 | case(1) 51 | call interchange_sort(a(:N/3)) 52 | case(2) 53 | call interchange_sort(a(N/3+1:2*N/3)) 54 | case(3) 55 | call interchange_sort(a(2*N/3+1:)) 56 | 57 | end select 58 | ! need sync all after sorting 59 | sync all 60 | 61 | ! copy data on image2 to image1 and merge 62 | if (this_image() == 1) then 63 | a(N/3+1:2*N/3) = a(N/3+1:2*N/3)[2] 64 | a(:2*N/3) = merge2(a(:N/3), a(N/3+1:2*N/3)) 65 | a(2*N/3+1:) = a(2*N/3+1:)[3] 66 | a = merge2(a(:2*N/3), a(2*N/3+1:)) 67 | call cpu_time(finish) 68 | print *, "For 3-image sort, time = ", finish-start, "second" 69 | print *, a(1), a(N), all(a(:N-1)<=a(2:)) 70 | 71 | endif 72 | ! sort in 1 image 73 | if (this_image() == 1) then 74 | call cpu_time(start) 75 | ! call interchange_sort(b(:N/3)) 76 | ! call interchange_sort(b(N/3+1:2*N/3)) 77 | ! call interchange_sort(b(2*N/3:)) 78 | ! b(:2*N/3) = merge2(b(:N/3), b(N/3+1:2*N/3)) 79 | ! b = merge2(b(:2*N/3), b(2*N/3+1:)) 80 | call interchange_sort(b) 81 | call cpu_time(finish) 82 | print * 83 | print *, "For 1-image sort, time = ", finish-start, "second" 84 | print *, b(1), b(N), all(b(:N-1)<=b(2:)) 85 | 86 | endif 87 | sync all 88 | pause 89 | 90 | end program sorting 91 | 92 | -------------------------------------------------------------------------------- /2.control_structure/associate/assoc.f90: -------------------------------------------------------------------------------- 1 | ! assoc.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! assoc - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: assoc 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program assoc 16 | 17 | implicit none 18 | real :: x = 3, y = 4 19 | associate (s => sqrt(x**2 + y**2)) 20 | print *,s 21 | x = 5; y = 12 22 | print *,s 23 | end associate 24 | associate (s => x) 25 | print *,s 26 | x = 9 27 | print *,s 28 | end associate 29 | ! Variables 30 | pause 31 | 32 | end program assoc 33 | 34 | -------------------------------------------------------------------------------- /2.control_structure/numerical_integration/integral.f90: -------------------------------------------------------------------------------- 1 | program integral 2 | ! calculates a trapezoidal approximation to an area using n trapezoids. n is read from the input file. 3 | ! The region is bounded by lines x = a, y = 0, x = b, and the curve y = sin(x). a and b also are read from the input file 4 | implicit none 5 | real:: a, b, h, total 6 | integer:: i, n 7 | print *, "Input data n:" 8 | read *, n 9 | print *, " n = ", n 10 | print *, "Input data a, b:" 11 | read *, a, b 12 | print *, "a = ", a 13 | print *, "b = ", b 14 | 15 | h = (b - a)/n 16 | ! caculate the total (f(a)/2 + f(a+h) + f(a+2h) + ... + f(b-h) + f(b)/2)*h 17 | ! Do the firts and last terms first 18 | total = 0.5*(sin(a) + sin(b)) 19 | do i = 1, n-1 20 | total = total + sin(a + i*h) 21 | enddo 22 | 23 | print *, "Trapezoidal approximation to the area = ", h*total 24 | pause 25 | end program integral -------------------------------------------------------------------------------- /3.modules and procedures/adaptive numerical integration (trapzoid and simpson)/function_module.f90: -------------------------------------------------------------------------------- 1 | module function_module 2 | implicit none 3 | private 4 | public::f 5 | 6 | contains 7 | function f(x) result(f_result) 8 | double precision, intent(in):: x 9 | double precision:: f_result 10 | 11 | f_result = exp(-x**2) 12 | end function f 13 | end module function_module -------------------------------------------------------------------------------- /3.modules and procedures/adaptive numerical integration (trapzoid and simpson)/integral_module.f90: -------------------------------------------------------------------------------- 1 | module integral_module 2 | implicit none 3 | private 4 | public :: integral_trap, integral_simpson 5 | 6 | contains 7 | recursive function integral_trap(f, a, b, tolerance) result(integral_result) 8 | ! divide the trapzoid area to two parts and evaluate the accuracy 9 | ! f: function 10 | ! a: starting point 11 | ! b: end point 12 | intrinsic :: abs 13 | interface 14 | function f(x) result(f_result) 15 | double precision, intent(in)::x 16 | double precision:: f_result 17 | end function f 18 | end interface 19 | double precision, intent(in):: a, b, tolerance 20 | double precision:: integral_result 21 | double precision:: h, mid 22 | double precision:: one_trapezoid_area, two_trapezoid_area 23 | double precision:: left_area, right_area 24 | 25 | h = b - a 26 | mid = (a + b)/2.0d0 27 | one_trapezoid_area = h*(f(a) + f(b)) / 2.0d0 28 | two_trapezoid_area = h/2.0d0*(f(a) + f(mid)) / 2.0d0 + h/2.0d0*(f(mid) + f(b)) / 2.0d0 29 | ! the error analysis is shown in page 113-114 30 | if (abs(one_trapezoid_area - two_trapezoid_area) < 3.0d0*tolerance) then 31 | integral_result = two_trapezoid_area 32 | else 33 | left_area = integral_trap(f, a, mid, tolerance/2.0d0) 34 | right_area = integral_trap(f, mid, b, tolerance/2.0d0) 35 | integral_result = left_area + right_area 36 | end if 37 | end function integral_trap 38 | 39 | recursive function integral_simpson(f, a, b, tolerance) result(integral_result) 40 | intrinsic :: abs 41 | interface 42 | function f(x) result(f_result) 43 | double precision, intent(in)::x 44 | double precision:: f_result 45 | end function f 46 | end interface 47 | double precision, intent(in):: a, b, tolerance 48 | double precision:: integral_result 49 | double precision:: h, mid, mid1, mid2 50 | double precision:: one_simpson_area, two_simpson_area 51 | double precision:: left_area, right_area 52 | 53 | h = (b - a)/2.0d0 54 | mid = (a + b)/2.0d0 55 | one_simpson_area = h*(f(a) + 4.0d0*f(mid) + f(b)) / 3.0d0 56 | 57 | mid1 = (a + mid)/2.0d0 58 | mid2 = (mid + b)/2.0d0 59 | two_simpson_area = h*(f(a) + 4.0d0*f(mid1) + f(mid)) / 6.0d0 + h*(f(mid) + 4.0d0*f(mid2) + f(b)) / 6.0d0 60 | 61 | if (abs(one_simpson_area - two_simpson_area) < 15.0d0*tolerance) then 62 | integral_result = two_simpson_area 63 | else 64 | left_area = integral_simpson(f, a, mid, tolerance/2) 65 | right_area = integral_simpson(f, mid, b, tolerance/2) 66 | integral_result = left_area + right_area 67 | end if 68 | end function integral_simpson 69 | end module integral_module -------------------------------------------------------------------------------- /3.modules and procedures/adaptive numerical integration (trapzoid and simpson)/integrate.f90: -------------------------------------------------------------------------------- 1 | ! integrate.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! integrate - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: integrate 10 | ! 11 | ! PURPOSE: 1.Show the recursive function, interface (dummy function), and module usage in FORTRAN. 12 | ! 2.Trapezoid (1,2 area) and Simpson's approximation (in the modulu) 13 | ! 14 | !**************************************************************************** 15 | 16 | program integrate 17 | use function_module 18 | use integral_module 19 | use math_module 20 | 21 | implicit none 22 | 23 | double precision:: x_min, x_max, tolerance 24 | double precision:: answer 25 | 26 | x_min = -4.0d0 27 | x_max = 4.0d0 28 | tolerance = 1.0d-2 29 | ! function: f = exp(-x^2) 30 | ! the numerical integration has: 31 | ! f: function 32 | ! x_min: starting point 33 | ! x_max: end point 34 | ! tolerance 35 | answer = integral_trap(f, x_min, x_max, tolerance) 36 | print "(a, f11.6)", "The trapzoid integral is approximately : ", answer 37 | answer = integral_simpson(f, x_min, x_max, tolerance) 38 | print "(a, f11.6)", "The simpson integral is approximately : ", answer 39 | print "(a, f11.6)", "The exact answer is : ", sqrt(pi) 40 | pause 41 | 42 | ! Variables 43 | 44 | 45 | 46 | 47 | end program integrate 48 | 49 | -------------------------------------------------------------------------------- /3.modules and procedures/adaptive numerical integration (trapzoid and simpson)/math_module.f90: -------------------------------------------------------------------------------- 1 | module math_module 2 | implicit none 3 | 4 | double precision :: pi = 4.0d0*ATAN(1.0d0) 5 | 6 | contains 7 | 8 | end module math_module -------------------------------------------------------------------------------- /4.Arrays/binary_search_example/binary_search_example.f90: -------------------------------------------------------------------------------- 1 | ! binary_search_example.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! binary_search_example - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: binary_search_example 10 | ! 11 | ! PURPOSE: compare the efficient of binary search to the brute force search. 12 | ! 13 | !**************************************************************************** 14 | 15 | program binary_search_example 16 | 17 | !use select_mod 18 | use myfunctions, only: quick_sort, binary_search, brute_force_search 19 | implicit none 20 | 21 | ! Variables 22 | integer, parameter:: N = 500000 23 | double precision, dimension(N)::a 24 | integer, parameter::k = 500000 25 | double precision:: element 26 | logical::found 27 | integer:: index 28 | real:: start, finish 29 | ! out of the list range to test if search function is robust 30 | element = 2.0d0 31 | 32 | call random_seed() 33 | call random_number(a) 34 | ! sort first 35 | call quick_sort(a) 36 | ! binary search 37 | call cpu_time(start) 38 | call binary_search(a, element, index, found) 39 | call cpu_time(finish) 40 | print *, "binary search time = ", finish-start, "second" 41 | print *, "search value:", element, "input index: ", k, "if found: ",found 42 | print * 43 | 44 | ! brute force search 45 | call cpu_time(start) 46 | call brute_force_search(a, element, index, found) 47 | call cpu_time(finish) 48 | print *, "brute force search time = ", finish-start, "second" 49 | print *, "search value:", element, "input index: ", k, "if found: ",found 50 | pause 51 | end program binary_search_example 52 | 53 | -------------------------------------------------------------------------------- /4.Arrays/binary_search_example/myfunctions.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hancockyang/fortran-programming/a9c2144e1f384c6d876c65b1b28052800e754359/4.Arrays/binary_search_example/myfunctions.f90 -------------------------------------------------------------------------------- /4.Arrays/case study 1 Heat Transfer/heat.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hancockyang/fortran-programming/a9c2144e1f384c6d876c65b1b28052800e754359/4.Arrays/case study 1 Heat Transfer/heat.f90 -------------------------------------------------------------------------------- /4.Arrays/case study 2 dice rolls/dice_roll.f90: -------------------------------------------------------------------------------- 1 | ! dice_roll.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! dice_roll - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: dice_roll 10 | ! 11 | ! PURPOSE: 2 dice rolls, the program to estimate the 12 | ! probability of rolling 7 or 11 with two dice is a bit shorter than the scalar version. We 13 | ! leave it to the reader to ponder whether it is easier or more difficult to understand than 14 | ! the scalar version. 15 | ! 16 | !**************************************************************************** 17 | 18 | program dice_roll 19 | use myfunctions, only: random_int 20 | implicit none 21 | integer, parameter :: number_of_rolls = 1000 22 | integer, dimension (number_of_rolls) :: dice, die_1, die_2 23 | integer :: wins 24 | call random_seed() 25 | call random_int (die_1, 1, 6) 26 | call random_int (die_2, 1, 6) 27 | dice = die_1 + die_2 28 | wins = count ((dice == 7) .or. (dice == 11)) 29 | print "(a, f6.2)", "The percentage of rolls that are 7 or 11 is", 100.0 * real (wins) / real (number_of_rolls), "%" 30 | pause 31 | 32 | end program dice_roll 33 | 34 | -------------------------------------------------------------------------------- /4.Arrays/case study 2 dice rolls/myfunctions.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hancockyang/fortran-programming/a9c2144e1f384c6d876c65b1b28052800e754359/4.Arrays/case study 2 dice rolls/myfunctions.f90 -------------------------------------------------------------------------------- /4.Arrays/empty_array_append/README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | This example works in GNU fortran not on ifort 3 | -------------------------------------------------------------------------------- /4.Arrays/empty_array_append/test_q_2.f90: -------------------------------------------------------------------------------- 1 | ! test_q.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! test_q - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: test_q 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program test_q 16 | implicit none 17 | integer, dimension(*), parameter:: a=[1 ,3,5,2, 7,10] 18 | integer :: i 19 | 20 | integer, dimension(:), allocatable :: array 21 | array = [integer :: ] 22 | do i = 1, 6 23 | if( a(i) < 6 ) array = [array, a(i)] 24 | enddo 25 | print *, 'hello world' 26 | print *, array 27 | end program test_q 28 | 29 | -------------------------------------------------------------------------------- /4.Arrays/reading a list of Unknown size/card.txt: -------------------------------------------------------------------------------- 1 | 2718281.0 2 | 7389056.1 3 | 1098612.2 4 | 5459815.3 5 | 1484131.4 -------------------------------------------------------------------------------- /4.Arrays/reading a list of Unknown size/myfunctions.f90: -------------------------------------------------------------------------------- 1 | module myfunctions 2 | implicit none 3 | 4 | double precision :: pi = 4.0d0*ATAN(1.0d0) 5 | private 6 | public :: integral_trap, integral_simpson, append 7 | contains 8 | !------------------------------------------Numerical integral--------------------------------- 9 | !--------------------------------------------------------------------------------------------- 10 | !-------------------------------------trapzoid-------------------------------------------- 11 | recursive function integral_trap(f, a, b, tolerance) result(integral_result) 12 | ! divide the trapzoid area to two parts and evaluate the accuracy 13 | ! f: function 14 | ! a: starting point 15 | ! b: end point 16 | intrinsic :: abs 17 | interface 18 | function f(x) result(f_result) 19 | double precision, intent(in)::x 20 | double precision:: f_result 21 | end function f 22 | end interface 23 | double precision, intent(in):: a, b, tolerance 24 | double precision:: integral_result 25 | double precision:: h, mid 26 | double precision:: one_trapezoid_area, two_trapezoid_area 27 | double precision:: left_area, right_area 28 | 29 | h = b - a 30 | mid = (a + b)/2.0d0 31 | one_trapezoid_area = h*(f(a) + f(b)) / 2.0d0 32 | two_trapezoid_area = h/2.0d0*(f(a) + f(mid)) / 2.0d0 + h/2.0d0*(f(mid) + f(b)) / 2.0d0 33 | ! the error analysis is shown in page 113-114 34 | if (abs(one_trapezoid_area - two_trapezoid_area) < 3.0d0*tolerance) then 35 | integral_result = two_trapezoid_area 36 | else 37 | left_area = integral_trap(f, a, mid, tolerance/2.0d0) 38 | right_area = integral_trap(f, mid, b, tolerance/2.0d0) 39 | integral_result = left_area + right_area 40 | end if 41 | end function integral_trap 42 | !-------------------------------------simpson--------------------------------------------- 43 | recursive function integral_simpson(f, a, b, tolerance) result(integral_result) 44 | intrinsic :: abs 45 | interface 46 | function f(x) result(f_result) 47 | double precision, intent(in)::x 48 | double precision:: f_result 49 | end function f 50 | end interface 51 | double precision, intent(in):: a, b, tolerance 52 | double precision:: integral_result 53 | double precision:: h, mid, mid1, mid2 54 | double precision:: one_simpson_area, two_simpson_area 55 | double precision:: left_area, right_area 56 | 57 | h = (b - a)/2.0d0 58 | mid = (a + b)/2.0d0 59 | one_simpson_area = h*(f(a) + 4.0d0*f(mid) + f(b)) / 3.0d0 60 | 61 | mid1 = (a + mid)/2.0d0 62 | mid2 = (mid + b)/2.0d0 63 | two_simpson_area = h*(f(a) + 4.0d0*f(mid1) + f(mid)) / 6.0d0 + h*(f(mid) + 4.0d0*f(mid2) + f(b)) / 6.0d0 64 | 65 | if (abs(one_simpson_area - two_simpson_area) < 15.0d0*tolerance) then 66 | integral_result = two_simpson_area 67 | else 68 | left_area = integral_simpson(f, a, mid, tolerance/2) 69 | right_area = integral_simpson(f, mid, b, tolerance/2) 70 | integral_result = left_area + right_area 71 | end if 72 | end function integral_simpson 73 | !------------------------------------------end of numerical integral------------------------------------- 74 | !------------------------------------------append subroutin, do the same as in python-------------------- 75 | subroutine append(list, element) 76 | 77 | IMPLICIT NONE 78 | 79 | integer :: i, isize 80 | double precision, intent(in) :: element 81 | double precision, dimension(:), allocatable, intent(inout) :: list 82 | double precision, dimension(:), allocatable :: clist 83 | 84 | 85 | if(allocated(list)) then 86 | isize = size(list) 87 | allocate(clist(isize+1)) 88 | clist(1:isize) = list(1:isize) 89 | clist(isize+1) = element 90 | deallocate(list) 91 | call move_alloc(clist, list) 92 | 93 | else 94 | allocate(list(1)) 95 | list(1) = element 96 | end if 97 | 98 | 99 | end subroutine append 100 | !--------------------------------------------end of append subroutine--------------------------------------- 101 | end module myfunctions -------------------------------------------------------------------------------- /4.Arrays/reading a list of Unknown size/read_cards_2.f90: -------------------------------------------------------------------------------- 1 | ! read_cards_2.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! read_cards_2 - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: read_cards_2 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program read_cards_2 16 | use myfunctions 17 | implicit none 18 | double precision, dimension(:), allocatable:: lost_card 19 | double precision:: card 20 | integer:: ios 21 | character(len=99) :: iom 22 | 23 | open(unit = 10,file='card.txt'); 24 | do 25 | 26 | read(unit=10, fmt =*, iostat=ios, iomsg=iom) card 27 | if(ios < 0) exit 28 | if(ios > 0) then 29 | print *, trim(iom) 30 | pause 31 | cycle 32 | end if 33 | CALL append(lost_card,card) 34 | end do 35 | close(unit = 10); 36 | print *, lost_card 37 | pause 38 | 39 | deallocate(lost_card) 40 | 41 | end program read_cards_2 42 | 43 | !subroutine append(list, element) 44 | ! 45 | ! IMPLICIT NONE 46 | ! 47 | ! integer :: i, isize 48 | ! double precision, intent(in) :: element 49 | ! double precision, dimension(:), allocatable, intent(inout) :: list 50 | ! double precision, dimension(:), allocatable :: clist 51 | ! 52 | ! 53 | ! if(allocated(list)) then 54 | ! isize = size(list) 55 | ! allocate(clist(isize+1)) 56 | ! clist(1:isize) = list(1:isize) 57 | ! clist(isize+1) = element 58 | ! deallocate(list) 59 | ! call move_alloc(clist, list) 60 | ! 61 | ! else 62 | ! allocate(list(1)) 63 | ! list(1) = element 64 | ! end if 65 | ! 66 | ! 67 | !end subroutine append 68 | -------------------------------------------------------------------------------- /4.Arrays/select/myfunctions.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hancockyang/fortran-programming/a9c2144e1f384c6d876c65b1b28052800e754359/4.Arrays/select/myfunctions.f90 -------------------------------------------------------------------------------- /4.Arrays/select/select_example.f90: -------------------------------------------------------------------------------- 1 | ! select_example.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! select_example - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: select_example 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program select_example 16 | 17 | !use select_mod 18 | use myfunctions 19 | implicit none 20 | 21 | ! Variables 22 | integer, parameter:: N = 5000000 23 | double precision, dimension(N)::a 24 | integer, parameter::k = 50 25 | double precision:: element 26 | logical::error 27 | integer:: start, stop1,counts_per_second 28 | 29 | 30 | 31 | call random_seed() 32 | call random_number(a) 33 | 34 | call system_clock(start, counts_per_second) 35 | 36 | call quick_select(a, k, element, error) 37 | 38 | ! copy data on image2 to image1 and merge 39 | 40 | call system_clock(stop1) 41 | call quick_sort(a) 42 | print *, "selecting time = ", (stop1-start)/counts_per_second, "second" 43 | print *, "selected value:", element, "input value: ", a(k), "if return error: ",error 44 | 45 | 46 | pause 47 | 48 | end program select_example 49 | 50 | -------------------------------------------------------------------------------- /4.Arrays/select/select_mod.f90: -------------------------------------------------------------------------------- 1 | module select_mod 2 | 3 | implicit none 4 | public :: quick_select 5 | 6 | contains 7 | !------------------------------------------------------- 8 | recursive subroutine quick_select(list, k, element, error) 9 | ! the algorithm is disscused in p148 10 | double precision, dimension(:), intent(in):: list 11 | integer, intent(in):: k 12 | double precision, intent(out):: element 13 | logical, intent(out):: error 14 | double precision, dimension(:), allocatable:: smaller, larger 15 | integer:: i, n, number_smaller, number_equal, number_larger 16 | double precision:: chosen 17 | !integer, parameter:: max_simple_sort_size = 6 18 | 19 | n = size(list) 20 | if (n <= 1) then 21 | error = .not. (n == 1 .and. k == 1) 22 | if (error) then 23 | element = 0.0d0 24 | else 25 | element = list(1) 26 | end if 27 | else 28 | allocate (smaller(n), larger(n)) 29 | chosen = list(1) 30 | number_smaller = 0 31 | number_equal = 1 32 | number_larger = 0 33 | 34 | do i = 2, n 35 | if (list(i) < chosen) then 36 | number_smaller = number_smaller + 1 37 | smaller(number_smaller) = list(i) 38 | else if (list(i) == chosen) then 39 | number_equal = number_equal + 1 40 | else 41 | number_larger = number_larger + 1 42 | larger(number_larger) = list(i) 43 | end if 44 | end do 45 | 46 | if (k <= number_smaller) then 47 | call quick_select(smaller(1:number_smaller), k, element, error) 48 | else if (k <= number_smaller + number_equal) then 49 | element = chosen 50 | error = .false. 51 | else 52 | call quick_select(larger(1:number_larger), k - number_smaller - number_equal, element, error) 53 | end if 54 | 55 | deallocate(smaller, larger) 56 | endif ! test for small array 57 | end subroutine quick_select 58 | !----------------------------------------------------------------- 59 | ! subroutine interchange_sort(list) 60 | ! double precision, dimension(:), intent(inout):: list 61 | ! integer:: i, j 62 | ! double precision:: temp 63 | ! 64 | ! do i = 1, size(list) - 1 65 | ! do j = i + 1, size(list) 66 | ! if (list(i) > list(j)) then 67 | ! temp = list(i) 68 | ! list(i) = list(j) 69 | ! list(j) = temp 70 | ! endif 71 | ! enddo 72 | ! enddo 73 | ! end subroutine interchange_sort 74 | !------------------------------------------------------------ 75 | 76 | end module select_mod -------------------------------------------------------------------------------- /4.Arrays/sorting/myfunctions.f90: -------------------------------------------------------------------------------- 1 | module myfunctions 2 | implicit none 3 | 4 | double precision :: pi = 4.0d0*ATAN(1.0d0) 5 | private 6 | public :: integral_trap, integral_simpson, append, quick_sort, merge2 7 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%PUBLIC FUNCTIONS or SUBROUTINEs%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 8 | ! 1. integral_trap(f, a, b, tolerance) : function, trapzoid numberical integration, double precision 9 | ! f : function 10 | ! a,b : lower limit and upper limit 11 | ! tolerance: the error tolerance 12 | !--------------------------------------------------------------------------------------------------------------------------------------------------------------------- 13 | ! 2. integral_simpson(f, a, b, tolerance) : function, simpson numberical integration, double precision 14 | ! f : function 15 | ! a,b : lower limit and upper limit 16 | ! tolerance: the error tolerance 17 | !--------------------------------------------------------------------------------------------------------------------------------------------------------------------- 18 | ! 3. append(list, element) : subroutine, append element to the end of the list, double precision 19 | ! list : list to be appended 20 | ! element : appedn to the list 21 | !---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 22 | ! 4. quick_sort(list) : soubroutine, sorting a list. small list uses interchage function, large uses recursive sorting, double precision 23 | ! list : list to be sorted 24 | !---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 25 | ! 5. merge2(a,b) : function, merge two list together, double precision 26 | ! a, b : lists to be merged 27 | !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 28 | contains 29 | !*************************************Numerical integral**************************************** 30 | !--------------------------------------------------------------------------------------------- 31 | !-------------------------------------trapzoid-------------------------------------------- 32 | recursive function integral_trap(f, a, b, tolerance) result(integral_result) 33 | ! divide the trapzoid area to two parts and evaluate the accuracy 34 | ! f: function 35 | ! a: starting point 36 | ! b: end point 37 | intrinsic :: abs 38 | interface 39 | function f(x) result(f_result) 40 | double precision, intent(in)::x 41 | double precision:: f_result 42 | end function f 43 | end interface 44 | double precision, intent(in):: a, b, tolerance 45 | double precision:: integral_result 46 | double precision:: h, mid 47 | double precision:: one_trapezoid_area, two_trapezoid_area 48 | double precision:: left_area, right_area 49 | 50 | h = b - a 51 | mid = (a + b)/2.0d0 52 | one_trapezoid_area = h*(f(a) + f(b)) / 2.0d0 53 | two_trapezoid_area = h/2.0d0*(f(a) + f(mid)) / 2.0d0 + h/2.0d0*(f(mid) + f(b)) / 2.0d0 54 | ! the error analysis is shown in page 113-114 55 | if (abs(one_trapezoid_area - two_trapezoid_area) < 3.0d0*tolerance) then 56 | integral_result = two_trapezoid_area 57 | else 58 | left_area = integral_trap(f, a, mid, tolerance/2.0d0) 59 | right_area = integral_trap(f, mid, b, tolerance/2.0d0) 60 | integral_result = left_area + right_area 61 | end if 62 | end function integral_trap 63 | !-------------------------------------simpson--------------------------------------------- 64 | recursive function integral_simpson(f, a, b, tolerance) result(integral_result) 65 | intrinsic :: abs 66 | interface 67 | function f(x) result(f_result) 68 | double precision, intent(in)::x 69 | double precision:: f_result 70 | end function f 71 | end interface 72 | double precision, intent(in):: a, b, tolerance 73 | double precision:: integral_result 74 | double precision:: h, mid, mid1, mid2 75 | double precision:: one_simpson_area, two_simpson_area 76 | double precision:: left_area, right_area 77 | 78 | h = (b - a)/2.0d0 79 | mid = (a + b)/2.0d0 80 | one_simpson_area = h*(f(a) + 4.0d0*f(mid) + f(b)) / 3.0d0 81 | 82 | mid1 = (a + mid)/2.0d0 83 | mid2 = (mid + b)/2.0d0 84 | two_simpson_area = h*(f(a) + 4.0d0*f(mid1) + f(mid)) / 6.0d0 + h*(f(mid) + 4.0d0*f(mid2) + f(b)) / 6.0d0 85 | 86 | if (abs(one_simpson_area - two_simpson_area) < 15.0d0*tolerance) then 87 | integral_result = two_simpson_area 88 | else 89 | left_area = integral_simpson(f, a, mid, tolerance/2) 90 | right_area = integral_simpson(f, mid, b, tolerance/2) 91 | integral_result = left_area + right_area 92 | end if 93 | end function integral_simpson 94 | !*************************************************end of numerical integral********************************************** 95 | !**********************************************append subroutin, do the same as in python******************************** 96 | subroutine append(list, element) 97 | 98 | IMPLICIT NONE 99 | 100 | integer :: i, isize 101 | double precision, intent(in) :: element 102 | double precision, dimension(:), allocatable, intent(inout) :: list 103 | double precision, dimension(:), allocatable :: clist 104 | 105 | 106 | if(allocated(list)) then 107 | isize = size(list) 108 | allocate(clist(isize+1)) 109 | clist(1:isize) = list(1:isize) 110 | clist(isize+1) = element 111 | deallocate(list) 112 | call move_alloc(clist, list) 113 | 114 | else 115 | allocate(list(1)) 116 | list(1) = element 117 | end if 118 | 119 | 120 | end subroutine append 121 | !*************************************end of append subroutine******************************* 122 | !**************************************sorting function************************************* 123 | recursive subroutine quick_sort(list) 124 | 125 | double precision, dimension(:), intent(inout):: list 126 | 127 | integer:: i, j, n 128 | double precision:: chosen, temp 129 | integer, parameter:: max_simple_sort_size = 6 130 | 131 | n = size(list) 132 | if (n <= max_simple_sort_size) then 133 | ! use interchange sort for small lists 134 | call interchange_sort(list) 135 | else 136 | ! use partition ("quick") sort 137 | chosen = list(n/2) 138 | 139 | i = 0 140 | j = n + 1 141 | 142 | do 143 | ! scan list from left end 144 | ! until element >= chosen is found 145 | do 146 | i = i + 1 147 | if(list(i) >= chosen) exit 148 | enddo 149 | ! scan list from right end 150 | ! until element <= chosen is found 151 | do 152 | j = j - 1 153 | if (list(j) <= chosen) exit 154 | enddo 155 | if (i < j) then 156 | ! swap two out of place elements 157 | temp = list(i) 158 | list(i) = list(j) 159 | list(j) = temp 160 | else if (i == j) then 161 | i = i + 1 162 | exit 163 | else 164 | exit 165 | endif 166 | enddo 167 | 168 | if (1 < j) call quick_sort(list(:j)) 169 | if (i < n) call quick_sort(list(i:)) 170 | endif ! test for small array 171 | end subroutine quick_sort 172 | !----------------------------------------------------------------- 173 | subroutine interchange_sort(list) 174 | double precision, dimension(:), intent(inout):: list 175 | integer:: i, j 176 | double precision:: temp 177 | 178 | do i = 1, size(list) - 1 179 | do j = i + 1, size(list) 180 | if (list(i) > list(j)) then 181 | temp = list(i) 182 | list(i) = list(j) 183 | list(j) = temp 184 | endif 185 | enddo 186 | enddo 187 | end subroutine interchange_sort 188 | !------------------------------------------------------------ 189 | ! Here is the function that merges two sorted arrays. At each point in the merging process, 190 | ! the first elements of each sorted list are compared and the smaller one is selected for 191 | ! inclusion as the next element in the merged list. The process is made a little more complicated 192 | ! by handling the merge after one of the lists is exhausted. 193 | function merge2(a,b) result(m) 194 | 195 | double precision, dimension(:), intent(in):: a, b 196 | double precision, dimension(size(a) + size(b)) :: m 197 | integer:: ka, kb, km 198 | 199 | ka = 1; kb = 1; km = 1 200 | 201 | do 202 | if (ka > size(a)) then 203 | m(km:) = b(kb:) 204 | return 205 | else if (kb > size(b)) then 206 | m(km:) = a(ka:) 207 | return 208 | else if (a(ka) < b(kb)) then 209 | m(km) = a(ka) 210 | km = km + 1; ka = ka + 1 211 | else 212 | m(km) = b(kb) 213 | km = km + 1; kb = kb + 1 214 | endif 215 | enddo 216 | end function merge2 217 | end module myfunctions -------------------------------------------------------------------------------- /4.Arrays/sorting/sort_mod.f90: -------------------------------------------------------------------------------- 1 | module sort_mod 2 | 3 | implicit none 4 | public :: quick_sort, interchange_sort 5 | 6 | contains 7 | !------------------------------------------------------- 8 | recursive subroutine quick_sort(list) 9 | 10 | double precision, dimension(:), intent(inout):: list 11 | 12 | integer:: i, j, n 13 | double precision:: chosen, temp 14 | integer, parameter:: max_simple_sort_size = 6 15 | 16 | n = size(list) 17 | if (n <= max_simple_sort_size) then 18 | ! use interchange sort for small lists 19 | call interchange_sort(list) 20 | else 21 | ! use partition ("quick") sort 22 | chosen = list(n/2) 23 | 24 | i = 0 25 | j = n + 1 26 | 27 | do 28 | ! scan list from left end 29 | ! until element >= chosen is found 30 | do 31 | i = i + 1 32 | if(list(i) >= chosen) exit 33 | enddo 34 | ! scan list from right end 35 | ! until element <= chosen is found 36 | do 37 | j = j - 1 38 | if (list(j) <= chosen) exit 39 | enddo 40 | if (i < j) then 41 | ! swap two out of place elements 42 | temp = list(i) 43 | list(i) = list(j) 44 | list(j) = temp 45 | else if (i == j) then 46 | i = i + 1 47 | exit 48 | else 49 | exit 50 | endif 51 | enddo 52 | 53 | if (1 < j) call quick_sort(list(:j)) 54 | if (i < n) call quick_sort(list(i:)) 55 | endif ! test for small array 56 | end subroutine quick_sort 57 | !----------------------------------------------------------------- 58 | subroutine interchange_sort(list) 59 | double precision, dimension(:), intent(inout):: list 60 | integer:: i, j 61 | double precision:: temp 62 | 63 | do i = 1, size(list) - 1 64 | do j = i + 1, size(list) 65 | if (list(i) > list(j)) then 66 | temp = list(i) 67 | list(i) = list(j) 68 | list(j) = temp 69 | endif 70 | enddo 71 | enddo 72 | end subroutine interchange_sort 73 | !------------------------------------------------------------ 74 | ! Here is the function that merges two sorted arrays. At each point in the merging process, 75 | ! the first elements of each sorted list are compared and the smaller one is selected for 76 | ! inclusion as the next element in the merged list. The process is made a little more complicated 77 | ! by handling the merge after one of the lists is exhausted. 78 | function merge2(a,b) result(m) 79 | 80 | double precision, dimension(:), intent(in):: a, b 81 | double precision, dimension(size(a) + size(b)) :: m 82 | integer:: ka, kb, km 83 | 84 | ka = 1; kb = 1; km = 1 85 | 86 | do 87 | if (ka > size(a)) then 88 | m(km:) = b(kb:) 89 | return 90 | else if (kb > size(b)) then 91 | m(km:) = a(ka:) 92 | return 93 | else if (a(ka) < b(kb)) then 94 | m(km) = a(ka) 95 | km = km + 1; ka = ka + 1 96 | else 97 | m(km) = b(kb) 98 | km = km + 1; kb = kb + 1 99 | endif 100 | enddo 101 | end function merge2 102 | end module sort_mod -------------------------------------------------------------------------------- /4.Arrays/sorting/sorting_example.f90: -------------------------------------------------------------------------------- 1 | ! sorting_example.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! sorting_example - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: sorting_example 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program sorting_example 16 | 17 | use myfunctions 18 | implicit none 19 | 20 | ! Variables 21 | integer, parameter:: N = 5000000 22 | double precision, dimension(N)::a 23 | integer:: start, stop1,counts_per_second 24 | 25 | 26 | 27 | call random_seed() 28 | call random_number(a) 29 | 30 | call system_clock(start, counts_per_second) 31 | 32 | call quick_sort(a) 33 | 34 | ! copy data on image2 to image1 and merge 35 | 36 | call system_clock(stop1) 37 | print *, "sorting time = ", (stop1-start)/counts_per_second, "second" 38 | print *, "first element: ", a(1), "second element:", a(N), "if sorted: ",all(a(:N-1)<=a(2:)) 39 | 40 | 41 | pause 42 | 43 | end program sorting_example 44 | 45 | -------------------------------------------------------------------------------- /4.Arrays/where_example/elsewhere_example.f90: -------------------------------------------------------------------------------- 1 | ! elsewhere_example.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! elsewhere_example - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: elsewhere_example 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program elsewhere_example 16 | 17 | implicit none 18 | integer, parameter :: n = 9 19 | integer, dimension(n,n)::key 20 | integer:: i,j 21 | real,dimension(n,n)::a 22 | key = 0 23 | call random_number(a) 24 | do i = 1, n 25 | do j = 1, n 26 | if (i > j) then 27 | ! put negative numbers below the diagonal 28 | a(i,j) = -a(i,j) - 2.0 29 | else if (i < j) then 30 | ! put positive numbers above the diagonal 31 | a(i,j) = a(i,j) + 2.0 32 | else 33 | ! put the zeros on the diagonal 34 | a(i,j) = 0.0 35 | end if 36 | end do 37 | end do 38 | 39 | where(a > 0.0) 40 | key = 1 41 | elsewhere (a < 0) 42 | key = -1 43 | elsewhere 44 | key = 0 45 | end where 46 | 47 | 48 | 49 | print "(9f5.1)", (a(i,:),i=1,9) 50 | print * 51 | print "(9i5.1)", (key(i,:), i = 1,9) 52 | pause 53 | end program elsewhere_example 54 | 55 | -------------------------------------------------------------------------------- /6.Structures and Derived Types/matrix_example/matrix_example.f90: -------------------------------------------------------------------------------- 1 | ! matrix_example.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! matrix_example - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: matrix_example 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program matrix_example 16 | use matrix_mode 17 | implicit none 18 | integer:: rows = 3, cols = 5, i 19 | type(matrix_type):: matrix 20 | matrix%rows = rows 21 | matrix%cols = cols 22 | call matrix%initial() 23 | print *, shape(matrix%values) 24 | print "(5f5.2)", [(matrix%values(i,:), i = 1, rows)] 25 | pause 26 | 27 | 28 | end program matrix_example 29 | 30 | -------------------------------------------------------------------------------- /6.Structures and Derived Types/matrix_example/matrix_mod.f90: -------------------------------------------------------------------------------- 1 | module matrix_mode 2 | type,public :: matrix_type 3 | integer:: rows, cols 4 | 5 | double precision, allocatable, dimension(:,:):: values 6 | 7 | contains 8 | procedure :: initial 9 | 10 | end type matrix_type 11 | 12 | contains 13 | subroutine initial(matrix) 14 | class(matrix_type),intent(inout):: matrix 15 | 16 | 17 | allocate(matrix%values(matrix%rows,matrix%cols)) 18 | 19 | matrix%values = 0.0d0 20 | 21 | end subroutine initial 22 | 23 | end module matrix_mode -------------------------------------------------------------------------------- /6.Structures and Derived Types/student record/myfunctions.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hancockyang/fortran-programming/a9c2144e1f384c6d876c65b1b28052800e754359/6.Structures and Derived Types/student record/myfunctions.f90 -------------------------------------------------------------------------------- /6.Structures and Derived Types/student record/student_mod.f90: -------------------------------------------------------------------------------- 1 | module student_mod 2 | implicit none 3 | 4 | 5 | ! address type, contains stree, city, state, zipcode 6 | type, public :: address_type 7 | character(len=30) :: number, street, city 8 | character(len=2) :: state 9 | character(len=30) :: zip_code 10 | end type address_type 11 | ! phone type, contains area_code and number 12 | type, public :: phone_type 13 | character(len=30) :: area_code, number 14 | end type phone_type 15 | 16 | ! grade type, contains math, english, physics, chemistry, history, average(optional) 17 | ! contains procedure mean to caculate the mean of the grade 18 | type, public :: grade_type 19 | real :: math, english, physics, chemistry, history 20 | real :: average = 0.0 21 | contains 22 | procedure:: mean 23 | end type grade_type 24 | 25 | 26 | ! student type, contains name, address type, phone type, grade type and remarks 27 | ! contains procedure report 28 | type, public:: student 29 | character(len=40) :: name 30 | type(address_type)::address 31 | type(phone_type)::phone 32 | type(grade_type)::grade 33 | character(len=100) :: remarks 34 | contains 35 | procedure:: report 36 | end type student 37 | 38 | contains 39 | subroutine mean(output) 40 | implicit none 41 | class(grade_type),intent(inout)::output 42 | output%average = (output%math + output%english + output%physics + output%chemistry + output%history) / 5.0d0 43 | end subroutine mean 44 | 45 | subroutine report(output) 46 | implicit none 47 | class(student),intent(in)::output 48 | character(len=*), parameter :: write_format = "(5a12)", convert_format = '(f11.2)' 49 | character(len=40) :: math,english,physics,chemistry,history 50 | character ::str*1 51 | str = '|' 52 | write(math,convert_format) output%grade%math 53 | write(english,convert_format) output%grade%english 54 | write(physics,convert_format) output%grade%physics 55 | write(chemistry,convert_format) output%grade%chemistry 56 | write(history,convert_format) output%grade%history 57 | 58 | math = trim(math)//str 59 | english = trim(english)//str 60 | physics = trim(physics)//str 61 | chemistry = trim(chemistry)//str 62 | history = trim(history)//str 63 | 64 | print *,"name: "//output%name 65 | print *,"Address: "//trim(output%address%number )//" "//trim(output%address%street)//" "//trim(output%address%city)//", "//trim(output%address%state)//" "//trim(output%address%zip_code) 66 | print *,"Phone No: "//"("//trim(output%phone%area_code)//")"//trim(output%phone%number) 67 | print *,"------------------------------------------------------------------" 68 | print write_format,"Math|", "English|", "Physics|", "Chemistry|", "History|" 69 | print *,"------------------------------------------------------------------" 70 | print write_format,math,english,physics,chemistry,history 71 | print *,"------------------------------------------------------------------" 72 | print "(a,f10.2)","Average: ",output%grade%average 73 | end subroutine report 74 | end module student_mod -------------------------------------------------------------------------------- /6.Structures and Derived Types/student record/student_record.f90: -------------------------------------------------------------------------------- 1 | ! student_record.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! student_record - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: student_record 10 | ! 11 | ! PURPOSE: demo of derived type and output formatting. 12 | ! 13 | !**************************************************************************** 14 | 15 | program student_record 16 | use student_mod 17 | implicit none 18 | type (student):: joan 19 | 20 | 21 | joan%phone = phone_type("505", "2750800") 22 | joan%address = address_type("360","Huntington Ave", "Boston", "MA", "02115") 23 | joan%grade = grade_type( 97.0, 98.0, 55.0, 69.0, 75.0) 24 | call joan%grade%mean() 25 | joan%name = "Joan Doe" 26 | call joan%report() 27 | 28 | pause 29 | 30 | end program student_record 31 | 32 | -------------------------------------------------------------------------------- /8.More about Modules and Procedures/elemental procedures/myfunctions.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hancockyang/fortran-programming/a9c2144e1f384c6d876c65b1b28052800e754359/8.More about Modules and Procedures/elemental procedures/myfunctions.f90 -------------------------------------------------------------------------------- /8.More about Modules and Procedures/elemental procedures/test_swap.f90: -------------------------------------------------------------------------------- 1 | ! test_dice_roll.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! test_dice_roll - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: test_dice_roll 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program test_swap 16 | 17 | use myfunctions, only: swap 18 | implicit none 19 | integer, dimension(3) :: i = [1, 2, 3], j = [7, 8, 9] 20 | real, dimension(3) :: a = [1.0, 2.0, 3.0], b = [7.0, 8.0, 9.0] 21 | call swap(i, j) 22 | print *, i 23 | print *, j 24 | call swap(a, b) 25 | print *, a 26 | print *, b 27 | pause 28 | end program test_swap 29 | 30 | -------------------------------------------------------------------------------- /8.More about Modules and Procedures/generic procedures/myfunctions.f90: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hancockyang/fortran-programming/a9c2144e1f384c6d876c65b1b28052800e754359/8.More about Modules and Procedures/generic procedures/myfunctions.f90 -------------------------------------------------------------------------------- /8.More about Modules and Procedures/generic procedures/test_random.f90: -------------------------------------------------------------------------------- 1 | ! test_dice_roll.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! test_dice_roll - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: test_dice_roll 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program test_random 16 | 17 | use myfunctions, only: random 18 | implicit none 19 | integer, parameter :: number_of_rolls = 10 20 | integer, dimension (number_of_rolls) :: die_1, die_2 21 | real, dimension (number_of_rolls) :: die_3, die_4 22 | ! run test 1 to 6 by 10 times for integers 23 | call random_seed() 24 | call random (die_1, 1, 6) 25 | call random (die_2, 1, 6) 26 | 27 | print "(10i2)", die_1 28 | print "(10i2)", die_2 29 | 30 | ! run test 1 to 6 by 10 times for reals 31 | call random_seed() 32 | call random (die_3, 1.0, 6.0) 33 | call random (die_4, 1.0, 6.0) 34 | print "(10f10.5)", die_3 35 | print "(10f10.5)", die_4 36 | pause 37 | 38 | end program test_random 39 | 40 | -------------------------------------------------------------------------------- /8.More about Modules and Procedures/reshape_order/reshape_fun.f90: -------------------------------------------------------------------------------- 1 | ! find_loc.f90 2 | ! 3 | ! FUNCTIONS: 4 | ! find_loc - Entry point of console application. 5 | ! 6 | 7 | !**************************************************************************** 8 | ! 9 | ! PROGRAM: find_loc 10 | ! 11 | ! PURPOSE: Entry point for the console application. 12 | ! 13 | !**************************************************************************** 14 | 15 | program reshape_fun 16 | implicit none 17 | integer::i 18 | integer, dimension (3,3) :: X = reshape ([ -11, 12, -13, 21, 22, -23, 31, -32, -33 ],[ 3, 3 ] ,order = [ 2, 1]) 19 | print "(3i5)", [(X(i,:), i=1,3)] 20 | pause 21 | 22 | end program reshape_fun 23 | 24 | -------------------------------------------------------------------------------- /8.More about Modules and Procedures/submodules/line_length_mod.f90: -------------------------------------------------------------------------------- 1 | submodule (line_mod) line_length_mod 2 | 3 | contains 4 | module procedure length 5 | 6 | length = sqrt((l%x2-l%x1)**2 + l%y2-l%y1)**2) 7 | 8 | end procedure length 9 | 10 | end submodule line_length_mod -------------------------------------------------------------------------------- /8.More about Modules and Procedures/submodules/line_mod.f90: -------------------------------------------------------------------------------- 1 | module line_mod 2 | implicit none 3 | private 4 | ! line connected to 5 | type, public :: line 6 | real :: x1, y1, x2, y2 7 | ! contains function length 8 | contains 9 | procedure :: length 10 | end type line 11 | 12 | interface 13 | ! function defined in module 14 | module function length (l) 15 | 16 | class(line), intent(in) :: l 17 | real :: length 18 | 19 | end function length 20 | 21 | end interface 22 | 23 | end module line_mod 24 | 25 | -------------------------------------------------------------------------------- /8.More about Modules and Procedures/submodules/submod.f90: -------------------------------------------------------------------------------- 1 | program submod 2 | use line_mod 3 | implicit none 4 | type (line) :: line_1 5 | line_1 = line(0, 0, 1, 1) 6 | print * line_1%length 7 | end program submod -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # fortran-programming 2 | It is FORTRAN programming practice using ifort and vs2008 for 'Walter S. Brainerd, Guide to Fortran 2008 Programming' 3 | --------------------------------------------------------------------------------