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.