|
| 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