Skip to content

Commit 0ce98c0

Browse files
authored
[metapackage] BLAS (#1121)
2 parents 880abe6 + cb1b1d6 commit 0ce98c0

File tree

8 files changed

+176
-5
lines changed

8 files changed

+176
-5
lines changed

.github/actions/setup-intel/action.yml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -95,7 +95,7 @@ runs:
9595
run: |
9696
# Install MPI devel package and common build tools
9797
# The compilers (icc, ifort) should already be installed by setup-fortran action
98-
sudo apt-get install -y -q intel-oneapi-mpi-devel ninja-build cmake libcurl4-gnutls-dev
98+
sudo apt-get install -y -q intel-oneapi-mpi-devel intel-oneapi-mkl ninja-build cmake libcurl4-gnutls-dev
9999
100100
- name: (Ubuntu) Source oneAPI environment and add to GITHUB_ENV
101101
if: contains(inputs.os, 'ubuntu')

.github/workflows/meta.yml

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -81,14 +81,14 @@ jobs:
8181
run: |
8282
sudo apt-get update
8383
sudo apt install -y -q openmpi-bin libopenmpi-dev hwloc fabric libhdf5-dev \
84-
libhdf5-fortran-102 libnetcdf-dev libnetcdff-dev
84+
libhdf5-fortran-102 libnetcdf-dev libnetcdff-dev libopenblas-dev
8585
8686
- name: (Ubuntu) Install MPICH
8787
if: contains(matrix.os,'ubuntu') && contains(matrix.mpi,'mpich')
8888
run: |
8989
sudo apt-get update
9090
sudo apt install -y -q mpich hwloc fabric libhdf5-dev libhdf5-fortran-102 \
91-
libnetcdf-dev libnetcdff-dev
91+
libnetcdf-dev libnetcdff-dev libopenblas-dev
9292
9393
# Intel
9494

@@ -334,4 +334,3 @@ jobs:
334334
shell: bash
335335
run: |
336336
ci/meta_tests.sh "$PWD/${{ env.FPM_RELEASE }}"
337-

ci/meta_tests.sh

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -52,5 +52,10 @@ pushd metapackage_netcdf
5252
"$fpm" run --verbose
5353
popd
5454

55+
pushd metapackage_blas
56+
"$fpm" build --verbose
57+
"$fpm" run --verbose
58+
popd
59+
5560
# Cleanup
5661
rm -rf ./*/build
Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
program metapackage_blas
2+
implicit none
3+
4+
interface
5+
subroutine dgesv(n, nrhs, a, lda, ipiv, b, ldb, info)
6+
integer, intent(in) :: n, nrhs, lda, ldb
7+
double precision, intent(in out) :: a(lda,*), b(ldb,*)
8+
integer, intent(out) :: ipiv(*), info
9+
end subroutine dgesv
10+
end interface
11+
12+
integer, parameter :: dp = kind(1.0d0)
13+
real(dp), dimension(:,:), allocatable :: a
14+
real(dp), dimension(:), allocatable :: b
15+
integer :: info
16+
17+
allocate(a(3,3), b(3))
18+
a = reshape([1.0_dp, 2.0_dp, 3.0_dp, &
19+
4.0_dp, 5.0_dp, 6.0_dp, &
20+
7.0_dp, 8.0_dp, 9.0_dp], [3,3])
21+
b = [1.0_dp, 2.0_dp, 3.0_dp]
22+
23+
call solve_eqsys(a, b, info)
24+
if (info /= 0) error stop
25+
26+
stop 0
27+
28+
contains
29+
30+
!> simple wrapper for solvers for real system of linear
31+
!> equations A * X = B
32+
subroutine solve_eqsys(a, b, info)
33+
34+
real(dp), dimension(:,:), intent(inout) :: a
35+
real(dp), dimension(:), intent(inout) :: b
36+
integer, intent(out) :: info
37+
integer :: i_alloc
38+
integer :: n, nrhs, lda, ldb
39+
integer, dimension(:), allocatable :: ipiv
40+
! ------------------------------------------------------------------
41+
42+
lda = size(a,1)
43+
n = size(a,2)
44+
ldb = size(b,1)
45+
nrhs = 1
46+
47+
allocate(ipiv(n), stat = i_alloc)
48+
if (i_alloc /= 0) stop 'solve_eqsys: Allocation for array failed!'
49+
50+
call dgesv(n, nrhs, a, lda, ipiv, b, ldb, info)
51+
52+
info = 0
53+
54+
deallocate(ipiv, stat = i_alloc)
55+
if (i_alloc /= 0) stop 'solve_eqsys: Deallocation for array failed!'
56+
57+
end subroutine solve_eqsys
58+
end program metapackage_blas
Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
name = "metapackage_blas"
2+
dependencies.blas="*"

src/fpm/manifest/meta.f90

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,9 @@ module fpm_manifest_metapackages
5656
!> NetCDF
5757
type(metapackage_request_t) :: netcdf
5858

59+
!> BLAS
60+
type(metapackage_request_t) :: blas
61+
5962
end type metapackage_config_t
6063

6164

@@ -210,6 +213,9 @@ subroutine new_meta_config(self, table, meta_allowed, error)
210213
call new_meta_request(self%netcdf, "netcdf", table, meta_allowed, error)
211214
if (allocated(error)) return
212215

216+
call new_meta_request(self%blas, "blas", table, meta_allowed, error)
217+
if (allocated(error)) return
218+
213219
end subroutine new_meta_config
214220

215221
!> Check local schema for allowed entries
@@ -221,7 +227,7 @@ logical function is_meta_package(key)
221227
select case (key)
222228

223229
!> Supported metapackages
224-
case ("openmp","stdlib","mpi","minpack","hdf5","netcdf")
230+
case ("openmp","stdlib","mpi","minpack","hdf5","netcdf","blas")
225231
is_meta_package = .true.
226232

227233
case default

src/fpm_meta.f90

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ module fpm_meta
3131
use fpm_meta_mpi, only: init_mpi
3232
use fpm_meta_hdf5, only: init_hdf5
3333
use fpm_meta_netcdf, only: init_netcdf
34+
use fpm_meta_blas, only: init_blas
3435

3536
use shlex_module, only: shlex_split => split
3637
use regex_module, only: regex
@@ -63,6 +64,7 @@ subroutine init_from_name(this,name,compiler,error)
6364
case("mpi"); call init_mpi (this,compiler,error)
6465
case("hdf5"); call init_hdf5 (this,compiler,error)
6566
case("netcdf"); call init_netcdf (this,compiler,error)
67+
case("blas"); call init_blas (this,compiler,error)
6668
case default
6769
call syntax_error(error, "Package "//name//" is not supported in [metapackages]")
6870
return
@@ -161,6 +163,12 @@ subroutine resolve_metapackage_model(model,package,settings,error)
161163
if (allocated(error)) return
162164
endif
163165

166+
! blas
167+
if (package%meta%blas%on) then
168+
call add_metapackage_model(model,package,settings,"blas",error)
169+
if (allocated(error)) return
170+
endif
171+
164172
end subroutine resolve_metapackage_model
165173

166174
end module fpm_meta

src/metapackage/fpm_meta_blas.f90

Lines changed: 93 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,93 @@
1+
module fpm_meta_blas
2+
use fpm_compiler, only: compiler_t, get_include_flag
3+
use fpm_environment, only: get_os_type, OS_MACOS, OS_WINDOWS
4+
use fpm_meta_base, only: metapackage_t, destroy
5+
use fpm_meta_util, only: add_pkg_config_compile_options
6+
use fpm_pkg_config, only: assert_pkg_config, pkgcfg_has_package
7+
use fpm_strings, only: string_t
8+
use fpm_error, only: error_t, fatal_error
9+
10+
implicit none
11+
12+
private
13+
14+
public :: init_blas
15+
16+
contains
17+
18+
!> Initialize blas metapackage for the current system
19+
subroutine init_blas(this, compiler, error)
20+
class(metapackage_t), intent(inout) :: this
21+
type(compiler_t), intent(in) :: compiler
22+
type(error_t), allocatable, intent(out) :: error
23+
24+
integer :: i
25+
character(len=:), allocatable :: include_flag, libdir
26+
character(*), parameter :: candidates(*) = &
27+
[character(20) :: 'mkl-dynamic-lp64-tbb', 'openblas', 'blas']
28+
29+
include_flag = get_include_flag(compiler, "")
30+
31+
!> Cleanup
32+
call destroy(this)
33+
allocate (this%link_libs(0), this%incl_dirs(0), this%external_modules(0))
34+
this%link_flags = string_t("")
35+
this%flags = string_t("")
36+
this%has_external_modules = .false.
37+
38+
if (get_os_type() == OS_MACOS) then
39+
if (compile_and_link_flags_supported(compiler, "-framework Accelerate")) then
40+
call set_compile_and_link_flags(this, compiler, "-framework Accelerate")
41+
return
42+
end if
43+
end if
44+
45+
if (compiler%is_intel()) then
46+
if (get_os_type() == OS_WINDOWS) then
47+
if (compile_and_link_flags_supported(compiler, "/Qmkl")) then
48+
call set_compile_and_link_flags(this, compiler, "/Qmkl")
49+
return
50+
end if
51+
else if (compile_and_link_flags_supported(compiler, "-qmkl")) then
52+
call set_compile_and_link_flags(this, compiler, "-qmkl")
53+
return
54+
endif
55+
end if
56+
57+
!> Assert pkg-config is installed
58+
if (.not. assert_pkg_config()) then
59+
call fatal_error(error, 'blas metapackage requires pkg-config to continue lookup')
60+
return
61+
end if
62+
63+
do i = 1, size(candidates)
64+
if (pkgcfg_has_package(trim(candidates(i)))) then
65+
call add_pkg_config_compile_options( &
66+
this, trim(candidates(i)), include_flag, libdir, error)
67+
print *, 'found blas package: ', trim(candidates(i))
68+
return
69+
end if
70+
end do
71+
72+
call fatal_error(error, 'pkg-config could not find a suitable blas package.')
73+
end subroutine init_blas
74+
75+
function compile_and_link_flags_supported(compiler, flags) result(is_supported)
76+
type(compiler_t), intent(in) :: compiler
77+
character(len=*), intent(in) :: flags
78+
logical :: is_supported
79+
80+
is_supported = compiler%check_flags_supported(compile_flags=flags, link_flags=flags)
81+
end function compile_and_link_flags_supported
82+
83+
subroutine set_compile_and_link_flags(this, compiler, flags)
84+
class(metapackage_t), intent(inout) :: this
85+
type(compiler_t), intent(in) :: compiler
86+
character(len=*), intent(in) :: flags
87+
88+
this%flags = string_t(flags)
89+
this%link_flags = string_t(flags)
90+
this%has_build_flags = .true.
91+
this%has_link_flags = .true.
92+
end subroutine set_compile_and_link_flags
93+
end module fpm_meta_blas

0 commit comments

Comments
 (0)