aboutsummaryrefslogtreecommitdiff
path: root/example_packages
diff options
context:
space:
mode:
authorSebastian Ehlert <28669218+awvwgk@users.noreply.github.com>2020-11-08 17:00:35 +0100
committerSebastian Ehlert <28669218+awvwgk@users.noreply.github.com>2020-11-13 09:34:56 +0100
commit681e4add145a71735da85193403d77abec8bb0ef (patch)
treef61d190babf2601e3235f627082406a927525f09 /example_packages
parent1e4cf61d964de8322f266c87b9377780063a03a3 (diff)
downloadfpm-681e4add145a71735da85193403d77abec8bb0ef.tar.gz
fpm-681e4add145a71735da85193403d77abec8bb0ef.zip
Add package with external dependency
- BLAS is installed on the OSX and Linux image, but not on Windows
Diffstat (limited to 'example_packages')
-rw-r--r--example_packages/README.md3
-rw-r--r--example_packages/link_external/.gitignore1
-rw-r--r--example_packages/link_external/app/main.f9021
-rw-r--r--example_packages/link_external/fpm.toml4
-rw-r--r--example_packages/link_external/src/wrapped_gemv.f90126
5 files changed, 154 insertions, 1 deletions
diff --git a/example_packages/README.md b/example_packages/README.md
index 65f4109..95f28d7 100644
--- a/example_packages/README.md
+++ b/example_packages/README.md
@@ -16,5 +16,6 @@ the features demonstrated in each package and which versions of fpm are supporte
| makefile_complex | External build command (makefile); local path dependency | Y | N |
| program_with_module | App-only; module+program in single source file | Y | Y |
| submodules | Lib-only; submodules (3 levels) | N | Y |
+| link_external | Link external library | N | Y |
| with_c | Compile with `c` source files | N | Y |
-| with_makefile | External build command (makefile) | Y | N | \ No newline at end of file
+| with_makefile | External build command (makefile) | Y | N |
diff --git a/example_packages/link_external/.gitignore b/example_packages/link_external/.gitignore
new file mode 100644
index 0000000..a007fea
--- /dev/null
+++ b/example_packages/link_external/.gitignore
@@ -0,0 +1 @@
+build/*
diff --git a/example_packages/link_external/app/main.f90 b/example_packages/link_external/app/main.f90
new file mode 100644
index 0000000..8df408d
--- /dev/null
+++ b/example_packages/link_external/app/main.f90
@@ -0,0 +1,21 @@
+program test_blas
+ use wrapped_gemv, only : sp, gemv
+ implicit none
+
+ integer :: i, j
+ real(sp) :: mat(4, 4), vec(4), res(4)
+
+ do i = 1, size(vec)
+ vec(i) = sqrt(real(i, sp))
+ end do
+
+ do i = 1, size(mat, 2)
+ do j = 1, size(mat, 1)
+ mat(j, i) = sqrt(real(j * i, sp))
+ end do
+ end do
+
+ call gemv(mat, vec, res, alpha=-1.0_sp, trans='t')
+
+end program test_blas
+
diff --git a/example_packages/link_external/fpm.toml b/example_packages/link_external/fpm.toml
new file mode 100644
index 0000000..f2eafa2
--- /dev/null
+++ b/example_packages/link_external/fpm.toml
@@ -0,0 +1,4 @@
+name = "link_external"
+
+[build]
+link = "blas"
diff --git a/example_packages/link_external/src/wrapped_gemv.f90 b/example_packages/link_external/src/wrapped_gemv.f90
new file mode 100644
index 0000000..5ff1d7c
--- /dev/null
+++ b/example_packages/link_external/src/wrapped_gemv.f90
@@ -0,0 +1,126 @@
+!> Performs one of the matrix-vector operations
+!>
+!> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y,
+!>
+!> where alpha and beta are scalars, x and y are vectors and A is an
+!> m by n matrix.
+module wrapped_gemv
+ implicit none
+ private
+
+ public :: sp, dp, gemv
+
+ integer, parameter :: sp = selected_real_kind(6)
+ integer, parameter :: dp = selected_real_kind(15)
+
+
+ interface gemv
+ module procedure :: wrap_sgemv
+ module procedure :: wrap_dgemv
+ end interface gemv
+
+
+ interface blas_gemv
+ subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
+ import :: sp
+ real(sp), intent(in) :: a(lda, *)
+ real(sp), intent(in) :: x(*)
+ real(sp), intent(inout) :: y(*)
+ real(sp), intent(in) :: alpha
+ real(sp), intent(in) :: beta
+ character(len=1), intent(in) :: trans
+ integer, intent(in) :: incx
+ integer, intent(in) :: incy
+ integer, intent(in) :: m
+ integer, intent(in) :: n
+ integer, intent(in) :: lda
+ end subroutine sgemv
+ subroutine dgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
+ import :: dp
+ real(dp), intent(in) :: a(lda, *)
+ real(dp), intent(in) :: x(*)
+ real(dp), intent(inout) :: y(*)
+ real(dp), intent(in) :: alpha
+ real(dp), intent(in) :: beta
+ character(len=1), intent(in) :: trans
+ integer, intent(in) :: incx
+ integer, intent(in) :: incy
+ integer, intent(in) :: m
+ integer, intent(in) :: n
+ integer, intent(in) :: lda
+ end subroutine dgemv
+ end interface blas_gemv
+
+
+contains
+
+
+ subroutine wrap_sgemv(amat, xvec, yvec, alpha, beta, trans)
+ real(sp), intent(in) :: amat(:, :)
+ real(sp), intent(in) :: xvec(:)
+ real(sp), intent(inout) :: yvec(:)
+ real(sp), intent(in), optional :: alpha
+ real(sp), intent(in), optional :: beta
+ character(len=1), intent(in), optional :: trans
+ real(sp) :: a, b
+ character(len=1) :: tra
+ integer :: incx, incy, m, n, lda
+ if (present(alpha)) then
+ a = alpha
+ else
+ a = 1.0_sp
+ end if
+ if (present(beta)) then
+ b = beta
+ else
+ b = 0
+ end if
+ if (present(trans)) then
+ tra = trans
+ else
+ tra = 'n'
+ end if
+ incx = 1
+ incy = 1
+ lda = max(1, size(amat, 1))
+ m = size(amat, 1)
+ n = size(amat, 2)
+ call blas_gemv(tra, m, n, a, amat, lda, xvec, incx, b, yvec, incy)
+ end subroutine wrap_sgemv
+
+
+ subroutine wrap_dgemv(amat, xvec, yvec, alpha, beta, trans)
+ real(dp), intent(in) :: amat(:, :)
+ real(dp), intent(in) :: xvec(:)
+ real(dp), intent(inout) :: yvec(:)
+ real(dp), intent(in), optional :: alpha
+ real(dp), intent(in), optional :: beta
+ character(len=1), intent(in), optional :: trans
+ real(dp) :: a, b
+ character(len=1) :: tra
+ integer :: incx, incy, m, n, lda
+ if (present(alpha)) then
+ a = alpha
+ else
+ a = 1.0_dp
+ end if
+ if (present(beta)) then
+ b = beta
+ else
+ b = 0
+ end if
+ if (present(trans)) then
+ tra = trans
+ else
+ tra = 'n'
+ end if
+ incx = 1
+ incy = 1
+ lda = max(1, size(amat, 1))
+ m = size(amat, 1)
+ n = size(amat, 2)
+ call blas_gemv(tra, m, n, a, amat, lda, xvec, incx, b, yvec, incy)
+ end subroutine wrap_dgemv
+
+
+end module wrapped_gemv