Merge pull request #1 from sourceryinstitute/fpm-build

Add fpm build system and fix non-buildable code

Author: Damian Rouson

README.md

@@ -1,2 +1,76 @@
-# sourcery
-A grab bag of tricks
+Sourcery Library
+================
+
+A grab bag of useful tricks in Fortran 2018.
+
+                                 `
+                              `://:`
+                             ./::+ss+.
+                            -++ydmmmdho-
+                           -+ohmNNNmmmmdy:
+                          .+ohmNNmNNddddddy:
+                         `++hmNNNmmNm+-:sdmdy:
+                         /+sdmNNNmmNmy`   :ymdo
+                        .++ydmNNNmdmNd+      ..
+                        /+ohmNNNNNddmmds.
+                       .++ydmNNNNNmddmmmy:
+                       /++ydmmNNNNNmddmmmy/`
+                      .++ohdmmNNNNNmdhdmmmh+.
+                      /++shdmmNNNNNNmdhdmmmho.
+                     `+/+shdmmNNNNNNmddhdmmmho-
+                     ://+yhdmmNNNNNNNmddhdmmmho-
+                     +//+yhdmmmNNNNNNmddhhmmmmho:
+                    -+//oyhdmmmNNNNNNmmddhdmmmmho-
+                    ////oyhdmmmNNNNNNNmddhhdmmmmho- ``..--------..``
+                   `o//+oyhdmmmmNNNNNNmddhhhhyyso:-+hyssssssyyyyyyyyso/-
+                   -+//+oyhddmmmNNNNNNNmdh+::::::::sddhhhhyyyyhhdddddhhhy-
+               ./oys+:/+oyhddmmmNNNNNNNdo::/+osssyhhhhhhhyhdmmmh+-.`
+           -+shddmms/:/+oyhddmmmNNNNNdo::/sdhyyyyyhhhhhhdmmmy/`
+        -+yhhhhddmd:/:/+oyhddmmmNmho/:::+ddhyoooossyyhs:`
+     `:syssyyyhdmmh-.--:/osssso+:---:/odNmdhyso+++sy+.
+    :osoooossyhhdmmy:------------:/ohmNNNNmmdhysss:
+  .+oo+++++oosyyhddmmdyso++++osyhmNNNNNNNNNNmdh+.
+ .+++++///+++oosyyhhhddmmmmmmmNNNNNNNNNNNNmds:
+ :+++////////++oosssyyhddmmmmmmmNNNNNNNmmh/`
+ .++/////////+++oooosyhhdddmmmmmmmNNmmh+-
+  ./////////++++ooossyhhddddmmmmmddy+-
+    .://////++++oossyyhhhhdhhhhy+:`
+       .--::////++oossyyyso+:-`
+             ```...-..``
+
+Utility functions
+-----------------
+
+* Array functions
+* Assertions
+* Emulated intrinsic functions
+* String functions
+
+Classes
+-------
+* (Co-)Object pattern abstract parent
+
+Prerequisites
+-------------
+The following are the versions or commits currently employed in
+developing and testing.  Earlier versions or commits might work also.
+
+* Compiler: [GNU Fortran] (gfortran) 10.2.0
+* Parallel runtime library: [OpenCoarrays] 2.9.0
+* Fortran package manager: [fpm] 105644
+
+This library also uses the [vegetables] unit testing framework, which
+the [fpm] build system will install automatically.
+
+Downloding, Building, and Testing
+---------------------------------
+
+```zsh
+git clone [email protected]:sourceryinstitute/sourcery
+fpm test --compiler caf --runner cafrun
+```
+
+[GNU Fortran]: https://gcc.gnu.org
+[OpenCoarrays]: https://github.com/sourceryinstitute/opencoarrays
+[fpm]: https://github.com/fortran-lang/fpm
+[vegetables]: https://gitlab.com/everythingfunctional/vegetables

fpm.toml

@@ -0,0 +1,14 @@
+name = "sourcery"
+version = "1.0.0"
+license = "BSD"
+author = ["Damian Rouson"]
+maintainer = "[email protected]"
+copyright = "2020 Sourcery Institute"
+
+[dev-dependencies]
+vegetables = {git = "https://gitlab.com/everythingfunctional/vegetables", tag = "v5.1.1"}
+
+#[[test]]
+#name="inputOutput"
+#source-dir="tests/unit/input-output"
+#main="main.f90"

src/array_functions_implementation.f90

@@ -0,0 +1,49 @@
+!
+!     (c) 2019-2020 Guide Star Engineering, LLC
+!     This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract
+!     "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)",
+!     contract # NRC-HQ-60-17-C-0007
+!
+submodule(array_functions_interface) array_functions_implementation
+  use assertions_interface, only : assert, assertions
+  implicit none
+contains
+
+  module procedure column_vectors
+      integer i, j, k
+
+      associate( n => shape(vector_field) )
+        if (assertions) call assert(size(n)==4, "3D vector field input")
+        allocate( array_of_3D_column_vectors( n(4), product(n(1:3)) ) )
+        do concurrent( i=1:n(1), j=1:n(2), k=1:n(3) )
+          associate( id => (k-1)*PRODUCT(n(1:2)) + (j-1)*n(1) + i )
+            array_of_3D_column_vectors(:,id) =  vector_field(i,j,k,:)
+          end associate
+        end do
+      end associate
+
+  end procedure
+
+  module procedure concatenate_columns
+    !! Using reshape rather than manipulating array elements directly frees the compiler to decide the particular order of array
+    !! element references that best exploits the given platform.  Alternatively, do concurrent could instead free the compiler
+    !! to order element accesses however is best. Trade-off: reshape requires the creation of temporary array results but reshape
+    !! is likely to have more mature compiler support than do concurrent.  If this code turns out to be a critical performance
+    !! bottleneck, try replacing this implementation with element-by-element copying using do concurrent.
+    associate(rows=>size(a,1))
+    associate(cols=>size(a,2)+size(b,2))
+    associate(a_unrolled=>reshape(a,[size(a)]))
+    associate(b_unrolled=>reshape(b,[size(b)]))
+      if (assertions) call assert( rows==size(b,1), "array_functions: compatible shapes")
+      concatenated = reshape( [a_unrolled, b_unrolled ],[rows, cols] )
+    end associate; end associate; end associate; end associate
+  end procedure
+
+  module procedure concatenate_rows
+    !! For simplicity, this implementation invokes concatenate_columns at the cost of transpose creating additional temporaries.
+    !! If this code turns out to be a critical performance bottleneck, try replacing this implementation with element-by-element
+    !! copying using do concurrent.
+    concatenated = transpose( concatenate_columns(transpose(a),transpose(b)) )
+  end procedure
+
+end submodule

src/array_functions_interface.f90

@@ -0,0 +1,60 @@
+!
+!     (c) 2019-2020 Guide Star Engineering, LLC
+!     This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract
+!     "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)",
+!     contract # NRC-HQ-60-17-C-0007
+!
+module array_functions_interface
+  !! author: Damian Rouson
+  !! date: 04/25/2019
+  !!
+  !! Functionally pure array utilities
+  implicit none
+
+  private
+  public :: operator(.catColumns.)
+  public :: operator(.catRows.)
+  public :: operator(.columnVectors.)
+    !! Because the Fortran standard requires that operator dummy arguments have the intent(in) attribute
+    !! exposing only the operator and not the function names communicates more information in the
+    !! public interface and in code using this interface.
+
+    interface operator(.columnVectors.)
+        module procedure column_vectors
+    end interface
+
+    interface operator(.catColumns.)
+        module procedure concatenate_columns
+    end interface
+
+    interface operator(.catRows.)
+        module procedure concatenate_rows
+    end interface
+
+    interface
+
+        pure module function column_vectors(vector_field) RESULT(array_of_3D_column_vectors)
+            !! Result is array of 3D column vectors of dimension (space_dim,nx*ny*nz) reshaped from vector-field argument
+            !! of dimension (nx,ny,nz,space_dim)
+            implicit none
+            real, dimension(:,:,:,:), intent(in) :: vector_field
+            real, dimension(:,:), allocatable ::  array_of_3D_column_vectors
+        end function
+
+        pure module function concatenate_columns(a, b) RESULT(concatenated)
+            !! Result contains the concatenation of the columns of argument a with the columns of argument b
+            implicit none
+            real, dimension(:,:), intent(in) :: a, b
+            real, dimension(:,:), allocatable :: concatenated
+        end function
+
+        pure module function concatenate_rows(a, b) RESULT(concatenated)
+            !! Result contains the concatenation of the rows of argument a with the rows of argument b
+            implicit none
+            real, dimension(:,:), intent(in) :: a, b
+            real, dimension(:,:), allocatable :: concatenated
+        end function
+
+    end interface
+
+end module

src/assertions_implementation.F90

@@ -0,0 +1,57 @@
+!
+!     (c) 2019-2020 Guide Star Engineering, LLC
+!     This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract
+!     "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)",
+!     contract # NRC-HQ-60-17-C-0007
+!
+submodule(assertions_interface) assertions_implementation
+  implicit none
+
+contains
+
+  module procedure assert
+    use iso_fortran_env, only : error_unit
+    use string_functions_interface, only : string
+
+    character(len=:), allocatable :: header, trailer
+    integer, parameter :: max_this_image_digits=9
+
+    if (assertions) then
+
+      if (.not. assertion) then
+
+        associate(assertion_failed_on => 'Assertion "' // description // '" failed on image')
+          header = repeat(" ", ncopies = len(assertion_failed_on) + max_this_image_digits)
+          write(header, *) assertion_failed_on, this_image()
+        end associate
+
+        if (.not. present(diagnostic_data)) then
+
+          trailer = ""
+
+        else
+
+          block
+            character(len=*), parameter :: lede = "with diagnostic data"
+
+            select type(diagnostic_data)
+              type is(character(len=*))
+                trailer =  lede // diagnostic_data
+              type is(integer)
+                trailer = lede // string(diagnostic_data)
+              class default
+                trailer = lede // 'of unsupported type'
+            end select
+          end block
+
+        end if
+
+        error stop header // trailer
+
+      end if
+
+    end if
+
+  end procedure
+
+end submodule

src/assertions_interface.F90

@@ -0,0 +1,47 @@
+!
+!     (c) 2019-2020 Guide Star Engineering, LLC
+!     This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract
+!     "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)",
+!     contract # NRC-HQ-60-17-C-0007
+!
+#ifndef USE_ASSERTIONS
+# define USE_ASSERTIONS .true.
+#endif
+module assertions_interface
+  !! summary: Utility for runtime checking of logical assertions.
+  !! usage: error-terminate if the assertion fails:
+  !!
+  !!    use assertions_interface, only : assert
+  !!    call assert( 2 > 1, "2 > 1")
+  !!
+  !! Turn off assertions in production code by setting USE_ASSERTIONS to .false. via the preprocessor:
+  !!
+  !!    caf -cpp -DUSE_ASSERTIONS=.false. -c assertions_interface.f90
+  !!
+  !! Doing so may eliminate any associated runtime overhead by enabling optimizing compilers to ignore
+  !! the assertion procedure body during a dead-code-removal phase of optimization.
+  implicit none
+  private
+  public :: assert, assertions, max_errmsg_len
+
+  logical, parameter :: assertions=USE_ASSERTIONS
+  integer, parameter :: max_errmsg_len = len( &
+  "warning (183): FASTMEM allocation is requested but the libmemkind library is not linked in, so using the default allocator.")
+  !! longest Intel compiler error message (see https://intel.ly/35x84yr).
+
+  interface
+
+    elemental module subroutine assert(assertion, description, diagnostic_data)
+      !! If assertion is .false., error-terminate with optional, variable stop code containing diagnostic_data
+      implicit none
+      logical, intent(in) :: assertion
+        !! Most assertions will be expressions, e.g., call assert( i>0, "positive i")
+      character(len=*), intent(in) :: description
+        !! Brief statement of what is being asserted
+      class(*), intent(in), optional :: diagnostic_data
+        !! Optional error stop code, which may be of intrinsic type or object class
+    end subroutine
+
+  end interface
+
+end module

src/co_object_implementation.f90

@@ -0,0 +1,20 @@
+!
+!     (c) 2019-2020 Guide Star Engineering, LLC
+!     This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract
+!     "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)",
+!     contract # NRC-HQ-60-17-C-0007
+!
+submodule(co_object_interface) co_object_implementation
+  implicit none
+
+contains
+
+    module procedure mark_as_defined
+      this%defined=.true.
+    end procedure
+
+    module procedure user_defined
+      is_defined = this%defined
+    end procedure
+
+end submodule

src/co_object_interface.f90

@@ -0,0 +1,43 @@
+!
+!     (c) 2019-2020 Guide Star Engineering, LLC
+!     This Software was developed for the US Nuclear Regulatory Commission (US NRC) under contract
+!     "Multi-Dimensional Physics Implementation into Fuel Analysis under Steady-state and Transients (FAST)",
+!     contract # NRC-HQ-60-17-C-0007
+!
+module co_object_interface
+  implicit none
+
+  private
+  public :: co_object
+
+  ! Define an abstract parent type to ensure basic functionality expected to be provided by all non-abstract types.
+  ! Each non-abstract type provides the functionality by extending this type and implementing its deferred binding(s).  This
+  ! type resembles java's Object class in the sense that it is intended to be the ultimate ancester of every other type.
+  type, abstract :: co_object
+    private
+    logical :: defined=.false.
+      !! Default initialization indicates not yet user-defined
+    logical, allocatable :: facilitate_type_extension[:]
+  contains
+    procedure :: mark_as_defined
+    procedure :: user_defined
+  end type
+
+  interface
+
+    pure module subroutine mark_as_defined(this)
+      !! Mark the co_object as user-defined
+      implicit none
+      class(co_object), intent(inout) :: this
+    end subroutine
+
+    pure module function user_defined(this) result(is_defined)
+      !! Return a boolean result indicating whether this co_object has been initialized since its declaration
+      implicit none
+      class(co_object), intent(in) :: this
+      logical :: is_defined
+    end function
+
+  end interface
+
+end module co_object_interface