Modern Fortran sample code

If you had to write 10-12 lines of code (excl. declarations) showing the strengths and diversity of Modern Fortran to a newbie, what could that be? Not necessarily solving any real problem, just showing the capabilities of the language.

2 Likes

@Arjen has shown how to use recursion and the array functionality of Fortran (pack, array sections, vectorized comparisons) to write quicksort very concisely. Here is a lightly modified code of his, with a driver.

module qsort_mod
implicit none
contains
pure recursive function qsort(data) result(sorted)
real, intent(in) :: data(:)
real             :: sorted(size(data))
if (size(data) > 1) then
   sorted = [qsort(pack(data(2:),data(2:)<data(1))), data(1), &
             qsort(pack(data(2:),data(2:)>=data(1)))]
else
   sorted = data
end if
end function qsort
end module qsort_mod
!
program main
use qsort_mod, only: qsort
implicit none
real :: x(10)
call random_seed()
call random_number(x)
write (*,"(a10,*(1x,f0.3))") "initial",x
write (*,"(a10,*(1x,f0.3))") "sorted",qsort(x)
end program main

sample output:

   initial .869 .394 .228 .657 .793 .416 .494 .657 .851 .471
    sorted .228 .394 .416 .471 .494 .657 .657 .793 .851 .869

Edit: With the newly approved conditional expressions, the body of the function can be just one line:

sorted = (size(data) > 1 ? &
      sorted = [qsort(pack(data(2:),data(2:)<data(1))), data(1), &
                qsort(pack(data(2:),data(2:)>=data(1)))] : & 
      data )
8 Likes

You mean

sorted = (size(data) > 1 ? &
! if size(data) > 1 condition is true
   [qsort(pack(data(2:),data(2:)<data(1))), data(1), &
       qsort(pack(data(2:),data(2:)>=data(1)))] :  &
! or else
    data )

Well, if one wanted to simply show the strength and diversity of modern Fortran, especially in terms of Fortran being an evolving multiparadigm language with focus on numerical computing and performance, a silly illustrator can also be as follows, it’s not as short as you seek but not all that long either:

module m
   type :: numseq_t(n)
      integer, len :: n = 3
      integer :: vals(n)
   contains
      procedure, pass(this) :: calc => calc_seq
   end type
contains
   elemental subroutine calc_seq( this )
      class(numseq_t(n=*)), intent(inout) :: this
      integer :: i, lb, ub
      lb = (this_image()-1)*size(this%vals) ; ub = lb + size(this%vals) - 1
      this%vals = fibonacci_number( [( i, i = lb, ub )] )
   end subroutine
   elemental integer function fibonacci_number( n ) result(num)
      integer, intent(in) :: n
      select case ( n ) 
         case ( 0:1 )
            num = n
         case default
            num = fibonacci_number(n-1) + fibonacci_number(n-2) 
      end select
   end function
end module
   use m, only : numseq_t
   type(numseq_t(n=5)) :: numseq[*]
   integer :: i 
   call numseq%calc()
   sync all
   if ( this_image() == 1 ) then
      do i = 1, num_images()
         write( *, fmt="(*(g0,1x))", advance="no" ) numseq[i]%vals
      end do
   end if
end

You will notice the example builds on recent newbie discussions on this forum with

  • recursion to determine a number sequence, the Fibonacci series here,
  • the use of structured programming in program flow,
  • modular programming with auto-generated explicit interfaces to procedures,
  • the use of explicit INTENTs with procedure parameters,
  • along with functional programming aspects to process arrays elementally,
  • it combines that with object-oriented design to establish a “store” of number sequences,
  • it hints at templated programming via a parameterized type for the store, and
  • it employs parallel programming toward the calculations to stock that store of sequences

So you can see there is a lot going on in there that touches upon many of the facilities now available in Fortran.

Here’s the expected output using one processor that outputs the first 40 elements (5 per parallel compute image times 8 images) in the Fibonacci sequence:

C:\Temp>ifort /standard-semantics /Qcoarray:shared /Qcoarray-num-images=8 e.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.3.0 Build 20210609_000000
Copyright (C) 1985-2021 Intel Corporation. All rights reserved.

Microsoft (R) Incremental Linker Version 14.29.30038.1
Copyright (C) Microsoft Corporation. All rights reserved.

-out:e.exe
-subsystem:console
e.obj

C:\Temp>e.exe
0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 3524578 5702887 9227465 14930352 24157817 39088169 63245986

7 Likes

Thanks a lot for great samples! @FortranFan, could you please remind me what does len in
integer, len :: n = 5 mean? My memory seems to have a hole at this very place :slight_smile:

It refers to the length-type parameter of a parameterized type. It has some similarity in terms of semantics and syntax with length of a CHARACTER intrinsic type as in character(len= and how one works with that parameter. The use of such types can help to some degree with “genericization” of one’s methods (procedures) e.g., a subroutine that can reverse any string, or as shown above, filling a store of number sequences of any length.

The standard document itself, or “Modern Fortran Explained”, or some of the vendor language reference sites are good places to peruse if you want to look up further.

Only a code snippet though, but it’s taken from my today’s prototyping, coarray (runtime) parallel code as well. Spin-wait loops are usually inside synchronization routines; here it’s taken to the parallel logic codes to allow the programmer to do some calculation there instead of leaving the coarray image just idle waiting for the synchronization to complete.
Naming conventions are a matter of taste, but Fortran makes it easy to implement features with very few lines of code and keep things readable, I would say.

!*****
  case (Enum_ImageType % ControlImage) ! on the control image
    control_FinishedFragmentedMethod: block
      integer(OOOGglob_kint), dimension (1:intNumberOfExecutingImages, 1:2) :: intA_ExecutingImageAndFMValue
      integer(OOOGglob_kint) :: intNumberOfSuccessfulRemoteNotifys
      !
      ! wait until all the execute images do signal that they are in state FinishedFragmentedMethod:
      spin_wait: do
        !********* local abort timer (time limit) for the spin-wait loop:
        call system_clock(count = intTime2); reaTimeShift = real(intTime2-intTime1) / reaCountRate
        if (reaTimeShift > reaTimeLimitInSec) logNotifyFailure = .true. ! time limit exceeded
        !*********
        if (nofy_SyncFragmentedMethod % IsNotifyWait (intFragmentedMethodNotifyStatus, &
            intNumberOfExecutingImages, intA_ExecutingImageNumbers, &
            intNumberOfSuccessfulRemoteNotifys = intNumberOfSuccessfulRemoteNotifys, &
            intA_RemoteImageAndItsScalarIntegerValueToTransfer = intA_ExecutingImageAndFMValue, &
            logNoSpinWaitLoop = .true.)) then
          ! IsNotifyWait was successfull, no further action is required
        else ! the IsNotifyWait did fail
          logNotifyFailure = .true.
        end if
        if (intNumberOfSuccessfulRemoteNotifys == intNumberOfExecutingImages) exit spin_wait ! successfull
        if (logNotifyFailure) exit spin_wait ! non-successfull
      end do spin_wait
      !
      write(*,*) '==============================================================================='
      write(*,*) 'On the contol image, the newly collected and now adjusted FMValues: ', intA_ExecutingImageAndFMValue(:,2)
      write(*,*) '==============================================================================='
      write(*,*) 'Number Of Successful Remote Notifys: ', intNumberOfSuccessfulRemoteNotifys
      !
      if (logNotifyFailure) return ! non-successfull
    end block control_FinishedFragmentedMethod
  !*****
  end select finished_fragmented_method

Thanks a lot for refreshing my memory, indeed PDTs come with len or kind attributes to type parameters. Following your advise I checked MFE and, incidentally, found an erroneous code snippet there, namely Figure 13.2 on p. 282:

  type character_with_max_length(maxlen, kind)
    integer, len :: maxlen
    integer, kind :: kind = selected_char_kind('default')
    integer       :: length = 0
    character(kind) :: value(maxlen)     ! ERROR 1
  end type

  type(character_with_max_length(100)) :: name

  name = character_with_max_length(100)('John Hancock')  ! ERROR 2

1 - as is, it defines value to be a maxlen-elements array of characters instead of a character object of len=maxlen; it should probably read character(maxlen, kind) :: value
2 - this error is reported by ifort; , 'John Hancock' is interpreted (positionally) as value for length component and thus the component value is not set (though it should be, as there is no default given). To fix it, one can add explicit component name: (value='John Hancock')
With ERROR 2 fixed, ERROR 1 shows only in runtime, segfaulting the program (ifort version 2021.3.0 on Ubuntu 20.04), though I am not quite sure why. Outside of type constructor, an array of characters may be assigned with a longer string, resulting in all elements of the array being set to ‘J’. Probably inside the constructor, the type compatibility requirements are stricter. But if it is really so, it should probably be reported during compile time (?)

1 Like

Attn: @m_b_metcalf , perhaps you and/your coauthors can explain to OP what is going on with Figure 13.2 in the book (8th Edition, 2018)?

I will, but only when I return home. Thanks for drawing this to our attention.

Mike Metcalf

2 Likes

We now confirm that this Figure contains the two errors reported, and the corrections that were suggested will be incorporated into the next printing.

We are always grateful for readers’ comments.

Regards,

Mike Metcalf

2 Likes

Thanks @m_b_metcalf for confirming the errors and for responding here.

You’re welcome! It is a pleasure to be able to make a correction to such a great book.

1 Like