Examples¶
The following standalone codes demonstrate how Flibcpp can be used in native Fortran code.
Random numbers and sorting¶
This simple example generates an array of normally-distributed double-precision reals, sorts them, and then shuffles them again.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | !-----------------------------------------------------------------------------! ! \file example/sort.f90 ! ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. !-----------------------------------------------------------------------------! program sort_example use, intrinsic :: ISO_C_BINDING use flc use flc_algorithm, only : sort, shuffle use flc_random, only : Engine => MersenneEngine4, normal_distribution use example_utils, only : write_version, read_positive_int, STDOUT implicit none integer :: arr_size real(c_double), dimension(:), allocatable :: x real(c_double), parameter :: MEAN = 1.0d0, SIGMA = 0.5d0 type(Engine) :: rng ! Print version information call write_version() ! Get array size arr_size = read_positive_int("array size") allocate(x(arr_size)) ! Fill randomly with normal distribution rng = Engine() call normal_distribution(MEAN, SIGMA, rng, x) ! Sort the array call sort(x) write(STDOUT, "(a, 4(f8.3,','))") "First few elements:", x(:min(4, size(x))) ! Rearrange it randomly call shuffle(rng, x) write(STDOUT, "(a, 4(f8.3,','))") "After shuffling:", x(:min(4, size(x))) call rng%release() end program !-----------------------------------------------------------------------------! ! end of example/sort.f90 !-----------------------------------------------------------------------------! |
Vectors of strings¶
Strings and vectors of strings can be easily manipulated and converted to and from native Fortran strings.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 | !-----------------------------------------------------------------------------! ! \file example/vecstr.f90 ! ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. !-----------------------------------------------------------------------------! program vecstr_example use, intrinsic :: ISO_C_BINDING use flc use flc_string, only : String use flc_vector, only : VectorString use example_utils, only : read_strings, write_version, STDOUT implicit none integer :: i type(VectorString) :: vec type(String) :: back, front, temp character(C_CHAR), dimension(:), pointer :: chars ! Print version information call write_version() ! Read a vector of strings call read_strings(vec) write(STDOUT, "(a, i3, a)") "Read ", vec%size(), " strings:" do i = 1, vec%size() write(STDOUT, "(i3, ': ', a)") i, vec%get(i) end do if (vec%empty()) then write(STDOUT, *) "No vectors provided" call vec%release() stop 0 endif ! Get the final string for modification back = vec%back_ref() chars => back%view() temp = String(back%str()) ! Change all characters to exclamation points chars(:) = '!' write(STDOUT, *) "The last string is very excited: " // vec%get(vec%size()) ! Modify a reference to the front value front = vec%front_ref() call front%push_back("?") ! Insert the original 'back' after the first string (make it element #2) call vec%insert(2, temp%str()) ! Inserting the vector invalidates the 'chars' view and back reference. chars => NULL() back = vec%back_ref() write(STDOUT, *) "Inserted the original last string: " // vec%get(2) ! Modify back to be something else. call back%assign("the end") write(STDOUT, *) "Modified 'front' string is " // vec%get(1) write(STDOUT, *) "Modified 'back' string is " // vec%get(vec%size()) ! Remove the first string (invalidating back and front references) call vec%erase(1) call back%release() call front%release() write(STDOUT, "(a, i3, a)") "Ended up with ", vec%size(), " strings:" do i = 1, vec%size() write(STDOUT, "(i3, ': ', a)") i, vec%get(i) end do ! Free allocated vector memory call vec%release() end program !-----------------------------------------------------------------------------! ! end of example/sort.f90 !-----------------------------------------------------------------------------! |
Generic sorting¶
Since sorting algorithms often allow \(O(N)\) algorithms to be written in \(O(\log N)\), providing generic sorting routines is immensely useful in applications that operate on large chunks of data. This example demonstrates the generic version of the argsort subroutine by sorting a native Fortran array of native Fortran types using a native Fortran subroutine. The only C interaction needed is to create C pointers to the Fortran array entries and to provide a C-bound comparator that converts those pointers back to native Fortran pointers. [1]
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | !-----------------------------------------------------------------------------! ! \file example/sort_generic.f90 ! ! Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. !-----------------------------------------------------------------------------! ! Mock-up of a user-created type and comparison operator module sort_generic_extras implicit none public ! Declare an example Fortran derived type type :: FortranString character(len=:), allocatable :: chars end type ! Declare a 'less than' operator for that type interface operator(<) module procedure fortranstring_less end interface contains ! Lexicographically compare strings of equal length. elemental function chars_less(left, right, length) & result(fresult) character(len=*), intent(in) :: left character(len=*), intent(in) :: right integer, intent(in) :: length logical :: fresult integer :: i, lchar, rchar ! If any character code is less than the RHS, it is less than. do i = 1, length lchar = ichar(left(i:i)) rchar = ichar(right(i:i)) if (lchar < rchar) then fresult = .true. return elseif (lchar > rchar) then fresult = .false. return endif end do fresult = .false. end function elemental function fortranstring_less(self, other) & result(fresult) type(FortranString), intent(in) :: self type(FortranString), intent(in) :: other logical :: fresult if (.not. allocated(other%chars)) then ! RHS is null and LHS is not fresult = .true. elseif (.not. allocated(self%chars)) then ! LHS is null => "greater than" (if LHS is string) or equal (if both null) fresult = .false. elseif (len(self%chars) < len(other%chars)) then ! Since LHS is shorter, it is "less than" the RHS. fresult = .true. elseif (len(self%chars) > len(other%chars)) then ! If RHS is shorter fresult = .false. else ! Compare strings of equal length fresult = chars_less(self%chars, other%chars, len(self%chars)) endif end function ! C++-accessible comparison function for two pointers-to-strings ! (null strings always compare "greater than" to move to end of a list) function compare_strings(lcptr, rcptr) bind(C) & result(fresult) use, intrinsic :: ISO_C_BINDING type(C_PTR), intent(in), value :: lcptr type(C_PTR), intent(in), value :: rcptr logical(C_BOOL) :: fresult type(FortranString), pointer :: lptr type(FortranString), pointer :: rptr if (.not. c_associated(rcptr)) then ! RHS is null and LHS is not fresult = .true. elseif (.not. c_associated(lcptr)) then ! LHS is null => "greater than" (if LHS is string) or equal (if both null) fresult = .false. else ! Both associated: convert from C to Fortran pointers call c_f_pointer(cptr=lcptr, fptr=lptr) call c_f_pointer(cptr=rcptr, fptr=rptr) ! Compare the strings fresult = (lptr < rptr) endif end function end module program sort_generic_example use, intrinsic :: ISO_FORTRAN_ENV use, intrinsic :: ISO_C_BINDING use flc use flc_algorithm, only : argsort, INDEX_INT use sort_generic_extras, only : compare_strings, FortranString use example_utils, only : write_version, read_positive_int, STDOUT, STDIN implicit none type(FortranString), dimension(:), allocatable, target :: fs_array type(C_PTR), dimension(:), allocatable, target :: ptrs integer(INDEX_INT), dimension(:), allocatable, target :: ordering character(len=80) :: readstr integer :: arr_size, i, io_ierr call write_version() ! Read strings arr_size = read_positive_int("string array size") allocate(fs_array(arr_size)) do i = 1, arr_size write(STDOUT, "(a, i3)") "Enter string #", i read(STDIN, "(a)", iostat=io_ierr) readstr if (io_ierr == IOSTAT_END) then ! Leave further strings unallocated exit endif ! Allocate string allocate(fs_array(i)%chars, source=trim(readstr)) enddo ! Create C pointers to the Fortran objects ptrs = [(c_loc(fs_array(i)), i = 1, arr_size)] ! Use 'argsort' to determine the new ordering allocate(ordering(arr_size)) call argsort(ptrs, ordering, compare_strings) write(STDOUT, "(a, 20(i3))") "New order:", ordering ! Reorder the Fortran data fs_array = fs_array(ordering) ! Print the results write(STDOUT, *) "Sorted:" do i = 1, arr_size if (.not. allocated(fs_array(i)%chars)) then write(STDOUT, "(i3, '-', i3, a)") i, arr_size, " are unallocated" exit endif write(STDOUT, "(i3, ': ', a)") i, fs_array(i)%chars enddo end program !-----------------------------------------------------------------------------! ! end of example/sort.f90 !-----------------------------------------------------------------------------! |
Example utilities module¶
This pure-Fortran module builds on top of functionality from Flibcpp. It provides procedures to:
- Format and print the Flibcpp version;
- Converts a user input to an integer, validating it with useful error messages;
- Reads a dynamically sized vector of strings from the user.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | !-----------------------------------------------------------------------------! ! \file example/example_utils.f90 ! \brief example_utils module ! \note Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC. !-----------------------------------------------------------------------------! module example_utils use, intrinsic :: ISO_FORTRAN_ENV use, intrinsic :: ISO_C_BINDING implicit none integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT public contains subroutine write_version() use flc implicit none ! Print version information write(STDOUT, "(a)") "========================================" write(STDOUT, "(a, a)") "Flibcpp version: ", get_flibcpp_version() write(STDOUT, "(a, 2(i1,'.'), (i1), a)") "(Numeric version: ", & flibcpp_version_major, flibcpp_version_minor, flibcpp_version_patch, & ")" write(STDOUT, "(a)") "========================================" end subroutine ! Loop until the user inputs a positive integer. Catch error conditions. function read_positive_int(desc) result(result_int) use flc use flc_string, only : stoi implicit none character(len=*), intent(in) :: desc character(len=80) :: readstr integer :: result_int, io_ierr do write(STDOUT, *) "Enter " // desc // ": " read(STDIN, "(a)", iostat=io_ierr) readstr if (io_ierr == IOSTAT_END) then ! Error condition: ctrl-D during input write(STDOUT, *) "User terminated" stop 1 endif result_int = stoi(readstr) if (ierr == 0) then if (result_int <= 0) then ! Error condition: non-positive value write(STDOUT, *) "Invalid " // desc // ": ", result_int continue end if write(STDOUT, *) "Read " // desc // "=", result_int exit endif if (ierr == SWIG_OVERFLOWERROR) then ! Error condition: integer doesn't fit in native integer write(STDOUT,*) "Your integer is too darn big!" else if (ierr == SWIG_VALUEERROR) then ! Error condition: not an integer at all write(STDOUT,*) "That text you entered? It wasn't an integer." else write(STDOUT,*) "Unknown error", ierr end if write(STDOUT,*) "(Detailed error message: ", get_serr(), ")" ! Clear error flag so the next call to stoi succeeds ierr = 0 end do end function ! Loop until the user inputs a positive integer. Catch error conditions. subroutine read_strings(vec) use flc use flc_string, only : String use flc_vector, only : VectorString use ISO_FORTRAN_ENV implicit none type(VectorString), intent(out) :: vec integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT character(len=80) :: readstr integer :: io_ierr type(String) :: str ! Allocate the vector vec = VectorString() do ! Request and read a string write(STDOUT, "(a, i3, a)") "Enter string #", vec%size() + 1, & " or Ctrl-D/empty string to complete" read(STDIN, "(a)", iostat=io_ierr) readstr if (io_ierr == IOSTAT_END) then ! Break out of loop on ^D (EOF) exit end if ! Add string to the end of the vector call vec%push_back(trim(readstr)) ! Get a String object reference to the back to check if it's empty str = vec%back_ref() if (str%empty()) then ! Remove the empty string call vec%pop_back() exit end if end do end subroutine end module !-----------------------------------------------------------------------------! ! end of example/example_utils.f90 !-----------------------------------------------------------------------------! |
Footnotes
[1] | Older versions of Gfortran (before GCC-8) fail to compile the generic sort example because of a bug that incorrectly claims that taking the C pointer of a scalar Fortran value is a violation of the standard: ../example/sort_generic.f90:84:38:
call c_f_pointer(cptr=rcptr, fptr=rptr)
1
Error: TS 29113/TS 18508: Noninteroperable array FPTR at (1) to
C_F_POINTER: Expression is a noninteroperable derived type
See this bug report for more details. |