diff --git a/.github/actions/setup-intel/action.yml b/.github/actions/setup-intel/action.yml index 5efe3001e1..64c3ae51d9 100644 --- a/.github/actions/setup-intel/action.yml +++ b/.github/actions/setup-intel/action.yml @@ -95,7 +95,7 @@ runs: run: | # Install MPI devel package and common build tools # The compilers (icc, ifort) should already be installed by setup-fortran action - sudo apt-get install -y -q intel-oneapi-mpi-devel ninja-build cmake libcurl4-gnutls-dev + sudo apt-get install -y -q intel-oneapi-mpi-devel intel-oneapi-mkl ninja-build cmake libcurl4-gnutls-dev - name: (Ubuntu) Source oneAPI environment and add to GITHUB_ENV if: contains(inputs.os, 'ubuntu') diff --git a/.github/workflows/meta.yml b/.github/workflows/meta.yml index 37805fdd39..5339923d24 100644 --- a/.github/workflows/meta.yml +++ b/.github/workflows/meta.yml @@ -81,14 +81,14 @@ jobs: run: | sudo apt-get update sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev \ - libhdf5-fortran-102 libnetcdf-dev libnetcdff-dev + libhdf5-fortran-102 libnetcdf-dev libnetcdff-dev libopenblas-dev - name: (Ubuntu) Install MPICH if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich') run: | sudo apt-get update sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-fortran-102 \ - libnetcdf-dev libnetcdff-dev + libnetcdf-dev libnetcdff-dev libopenblas-dev # Intel @@ -334,4 +334,3 @@ jobs: shell: bash run: | ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}" - diff --git a/ci/meta_tests.sh b/ci/meta_tests.sh index 3d55cf07ac..c37011f816 100755 --- a/ci/meta_tests.sh +++ b/ci/meta_tests.sh @@ -52,5 +52,10 @@ pushd metapackage_netcdf "$fpm" run --verbose popd +pushd metapackage_blas +"$fpm" build --verbose +"$fpm" run --verbose +popd + # Cleanup rm -rf ./*/build diff --git a/example_packages/metapackage_blas/app/main.f90 b/example_packages/metapackage_blas/app/main.f90 new file mode 100644 index 0000000000..2b76d47e57 --- /dev/null +++ b/example_packages/metapackage_blas/app/main.f90 @@ -0,0 +1,58 @@ +program metapackage_blas + implicit none + + interface + subroutine dgesv(n, nrhs, a, lda, ipiv, b, ldb, info) + integer, intent(in) :: n, nrhs, lda, ldb + double precision, intent(in out) :: a(lda,*), b(ldb,*) + integer, intent(out) :: ipiv(*), info + end subroutine dgesv + end interface + + integer, parameter :: dp = kind(1.0d0) + real(dp), dimension(:,:), allocatable :: a + real(dp), dimension(:), allocatable :: b + integer :: info + + allocate(a(3,3), b(3)) + a = reshape([1.0_dp, 2.0_dp, 3.0_dp, & + 4.0_dp, 5.0_dp, 6.0_dp, & + 7.0_dp, 8.0_dp, 9.0_dp], [3,3]) + b = [1.0_dp, 2.0_dp, 3.0_dp] + + call solve_eqsys(a, b, info) + if (info /= 0) error stop + + stop 0 + + contains + + !> simple wrapper for solvers for real system of linear + !> equations A * X = B + subroutine solve_eqsys(a, b, info) + + real(dp), dimension(:,:), intent(inout) :: a + real(dp), dimension(:), intent(inout) :: b + integer, intent(out) :: info + integer :: i_alloc + integer :: n, nrhs, lda, ldb + integer, dimension(:), allocatable :: ipiv + ! ------------------------------------------------------------------ + + lda = size(a,1) + n = size(a,2) + ldb = size(b,1) + nrhs = 1 + + allocate(ipiv(n), stat = i_alloc) + if (i_alloc /= 0) stop 'solve_eqsys: Allocation for array failed!' + + call dgesv(n, nrhs, a, lda, ipiv, b, ldb, info) + + info = 0 + + deallocate(ipiv, stat = i_alloc) + if (i_alloc /= 0) stop 'solve_eqsys: Deallocation for array failed!' + + end subroutine solve_eqsys +end program metapackage_blas diff --git a/example_packages/metapackage_blas/fpm.toml b/example_packages/metapackage_blas/fpm.toml new file mode 100644 index 0000000000..440192c69a --- /dev/null +++ b/example_packages/metapackage_blas/fpm.toml @@ -0,0 +1,2 @@ +name = "metapackage_blas" +dependencies.blas="*" diff --git a/src/fpm/manifest/meta.f90 b/src/fpm/manifest/meta.f90 index 55bf436c71..f1f51aa4bc 100644 --- a/src/fpm/manifest/meta.f90 +++ b/src/fpm/manifest/meta.f90 @@ -56,6 +56,9 @@ module fpm_manifest_metapackages !> NetCDF type(metapackage_request_t) :: netcdf + !> BLAS + type(metapackage_request_t) :: blas + end type metapackage_config_t @@ -210,6 +213,9 @@ subroutine new_meta_config(self, table, meta_allowed, error) call new_meta_request(self%netcdf, "netcdf", table, meta_allowed, error) if (allocated(error)) return + call new_meta_request(self%blas, "blas", table, meta_allowed, error) + if (allocated(error)) return + end subroutine new_meta_config !> Check local schema for allowed entries @@ -221,7 +227,7 @@ logical function is_meta_package(key) select case (key) !> Supported metapackages - case ("openmp","stdlib","mpi","minpack","hdf5","netcdf") + case ("openmp","stdlib","mpi","minpack","hdf5","netcdf","blas") is_meta_package = .true. case default diff --git a/src/fpm_meta.f90 b/src/fpm_meta.f90 index d52284aecd..d1e6a1cb88 100644 --- a/src/fpm_meta.f90 +++ b/src/fpm_meta.f90 @@ -31,6 +31,7 @@ module fpm_meta use fpm_meta_mpi, only: init_mpi use fpm_meta_hdf5, only: init_hdf5 use fpm_meta_netcdf, only: init_netcdf + use fpm_meta_blas, only: init_blas use shlex_module, only: shlex_split => split use regex_module, only: regex @@ -63,6 +64,7 @@ subroutine init_from_name(this,name,compiler,error) case("mpi"); call init_mpi (this,compiler,error) case("hdf5"); call init_hdf5 (this,compiler,error) case("netcdf"); call init_netcdf (this,compiler,error) + case("blas"); call init_blas (this,compiler,error) case default call syntax_error(error, "Package "//name//" is not supported in [metapackages]") return @@ -161,6 +163,12 @@ subroutine resolve_metapackage_model(model,package,settings,error) if (allocated(error)) return endif + ! blas + if (package%meta%blas%on) then + call add_metapackage_model(model,package,settings,"blas",error) + if (allocated(error)) return + endif + end subroutine resolve_metapackage_model end module fpm_meta diff --git a/src/metapackage/fpm_meta_blas.f90 b/src/metapackage/fpm_meta_blas.f90 new file mode 100644 index 0000000000..4f5c15178e --- /dev/null +++ b/src/metapackage/fpm_meta_blas.f90 @@ -0,0 +1,93 @@ +module fpm_meta_blas + use fpm_compiler, only: compiler_t, get_include_flag + use fpm_environment, only: get_os_type, OS_MACOS, OS_WINDOWS + use fpm_meta_base, only: metapackage_t, destroy + use fpm_meta_util, only: add_pkg_config_compile_options + use fpm_pkg_config, only: assert_pkg_config, pkgcfg_has_package + use fpm_strings, only: string_t + use fpm_error, only: error_t, fatal_error + + implicit none + + private + + public :: init_blas + +contains + + !> Initialize blas metapackage for the current system + subroutine init_blas(this, compiler, error) + class(metapackage_t), intent(inout) :: this + type(compiler_t), intent(in) :: compiler + type(error_t), allocatable, intent(out) :: error + + integer :: i + character(len=:), allocatable :: include_flag, libdir + character(*), parameter :: candidates(*) = & + [character(20) :: 'mkl-dynamic-lp64-tbb', 'openblas', 'blas'] + + include_flag = get_include_flag(compiler, "") + + !> Cleanup + call destroy(this) + allocate (this%link_libs(0), this%incl_dirs(0), this%external_modules(0)) + this%link_flags = string_t("") + this%flags = string_t("") + this%has_external_modules = .false. + + if (get_os_type() == OS_MACOS) then + if (compile_and_link_flags_supported(compiler, "-framework Accelerate")) then + call set_compile_and_link_flags(this, compiler, "-framework Accelerate") + return + end if + end if + + if (compiler%is_intel()) then + if (get_os_type() == OS_WINDOWS) then + if (compile_and_link_flags_supported(compiler, "/Qmkl")) then + call set_compile_and_link_flags(this, compiler, "/Qmkl") + return + end if + else if (compile_and_link_flags_supported(compiler, "-qmkl")) then + call set_compile_and_link_flags(this, compiler, "-qmkl") + return + endif + end if + + !> Assert pkg-config is installed + if (.not. assert_pkg_config()) then + call fatal_error(error, 'blas metapackage requires pkg-config to continue lookup') + return + end if + + do i = 1, size(candidates) + if (pkgcfg_has_package(trim(candidates(i)))) then + call add_pkg_config_compile_options( & + this, trim(candidates(i)), include_flag, libdir, error) + print *, 'found blas package: ', trim(candidates(i)) + return + end if + end do + + call fatal_error(error, 'pkg-config could not find a suitable blas package.') + end subroutine init_blas + + function compile_and_link_flags_supported(compiler, flags) result(is_supported) + type(compiler_t), intent(in) :: compiler + character(len=*), intent(in) :: flags + logical :: is_supported + + is_supported = compiler%check_flags_supported(compile_flags=flags, link_flags=flags) + end function compile_and_link_flags_supported + + subroutine set_compile_and_link_flags(this, compiler, flags) + class(metapackage_t), intent(inout) :: this + type(compiler_t), intent(in) :: compiler + character(len=*), intent(in) :: flags + + this%flags = string_t(flags) + this%link_flags = string_t(flags) + this%has_build_flags = .true. + this%has_link_flags = .true. + end subroutine set_compile_and_link_flags +end module fpm_meta_blas