diff options
Diffstat (limited to 'example_packages')
| -rw-r--r-- | example_packages/README.md | 4 | ||||
| -rw-r--r-- | example_packages/link_executable/.gitignore | 1 | ||||
| -rw-r--r-- | example_packages/link_executable/app/main.f90 | 11 | ||||
| -rw-r--r-- | example_packages/link_executable/fpm.toml | 8 | ||||
| -rw-r--r-- | example_packages/link_external/.gitignore | 1 | ||||
| -rw-r--r-- | example_packages/link_external/app/main.f90 | 21 | ||||
| -rw-r--r-- | example_packages/link_external/fpm.toml | 4 | ||||
| -rw-r--r-- | example_packages/link_external/src/wrapped_gemv.f90 | 126 |
8 files changed, 175 insertions, 1 deletions
diff --git a/example_packages/README.md b/example_packages/README.md index 65f4109..0eb0653 100644 --- a/example_packages/README.md +++ b/example_packages/README.md @@ -16,5 +16,7 @@ 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 | +| link_executable | Link external library to a single executable | 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_executable/.gitignore b/example_packages/link_executable/.gitignore new file mode 100644 index 0000000..a007fea --- /dev/null +++ b/example_packages/link_executable/.gitignore @@ -0,0 +1 @@ +build/* diff --git a/example_packages/link_executable/app/main.f90 b/example_packages/link_executable/app/main.f90 new file mode 100644 index 0000000..b1df402 --- /dev/null +++ b/example_packages/link_executable/app/main.f90 @@ -0,0 +1,11 @@ +program gomp_example + implicit none + + interface + integer function omp_get_num_procs() + end function + end interface + + print *, omp_get_num_procs() + +end program gomp_example diff --git a/example_packages/link_executable/fpm.toml b/example_packages/link_executable/fpm.toml new file mode 100644 index 0000000..f3545ca --- /dev/null +++ b/example_packages/link_executable/fpm.toml @@ -0,0 +1,8 @@ +name = "link_executable" +build.auto-executables = false + +[[executable]] +name = "gomp_test" +source-dir = "app" +main = "main.f90" +link = ["gomp"] 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 |