Skip to content

Commit 93cc440

Browse files
awvwgkawvwgk
authored
Merge pull request #233 from awvwgk/link
Allow linking against external libraries
2 parents b1fddf3 + fcc971f commit 93cc440

File tree

22 files changed

+435
-25
lines changed

22 files changed

+435
-25
lines changed

‎ci/run_tests.bat‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -132,3 +132,13 @@ if errorlevel 1 exit 1
132132

133133
.\build\gfortran_debug\app\Program_with_module
134134
if errorlevel 1 exit 1
135+
136+
137+
cd ..\link_executable
138+
if errorlevel 1 exit 1
139+
140+
%fpm_path% build
141+
if errorlevel 1 exit 1
142+
143+
.\build\gfortran_debug\app\gomp_test
144+
if errorlevel 1 exit 1

‎ci/run_tests.sh‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -69,3 +69,11 @@ cd ../submodules
6969
cd ../program_with_module
7070
"${f_fpm_path}" build
7171
./build/gfortran_debug/app/Program_with_module
72+
73+
cd ../link_external
74+
"${f_fpm_path}" build
75+
./build/gfortran_debug/app/link_external
76+
77+
cd ../link_executable
78+
"${f_fpm_path}" build
79+
./build/gfortran_debug/app/gomp_test

‎example_packages/README.md‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -16,5 +16,7 @@ the features demonstrated in each package and which versions of fpm are supporte
1616
| makefile_complex | External build command (makefile); local path dependency | Y | N |
1717
| program_with_module | App-only; module+program in single source file | Y | Y |
1818
| submodules | Lib-only; submodules (3 levels) | N | Y |
19+
| link_external | Link external library | N | Y |
20+
| link_executable | Link external library to a single executable | N | Y |
1921
| with_c | Compile with `c` source files | N | Y |
20-
| with_makefile | External build command (makefile) | Y | N |
22+
| with_makefile | External build command (makefile) | Y | N |

‎example_packages/link_executable/.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
build/*

‎example_packages/link_executable/app/main.f90‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
program gomp_example
2+
implicit none
3+
4+
interface
5+
integer function omp_get_num_procs()
6+
end function
7+
end interface
8+
9+
print *, omp_get_num_procs()
10+
11+
end program gomp_example

‎example_packages/link_executable/fpm.toml‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
name = "link_executable"
2+
build.auto-executables = false
3+
4+
[[executable]]
5+
name = "gomp_test"
6+
source-dir = "app"
7+
main = "main.f90"
8+
link = ["gomp"]

‎example_packages/link_external/.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
build/*

‎example_packages/link_external/app/main.f90‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
program test_blas
2+
use wrapped_gemv, only : sp, gemv
3+
implicit none
4+
5+
integer :: i, j
6+
real(sp) :: mat(4, 4), vec(4), res(4)
7+
8+
do i = 1, size(vec)
9+
vec(i) = sqrt(real(i, sp))
10+
end do
11+
12+
do i = 1, size(mat, 2)
13+
do j = 1, size(mat, 1)
14+
mat(j, i) = sqrt(real(j * i, sp))
15+
end do
16+
end do
17+
18+
call gemv(mat, vec, res, alpha=-1.0_sp, trans='t')
19+
20+
end program test_blas
21+

‎example_packages/link_external/fpm.toml‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
name = "link_external"
2+
3+
[build]
4+
link = "blas"

‎example_packages/link_external/src/wrapped_gemv.f90‎

Lines changed: 126 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,126 @@
1+
!> Performs one of the matrix-vector operations
2+
!>
3+
!> y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y,
4+
!>
5+
!> where alpha and beta are scalars, x and y are vectors and A is an
6+
!> m by n matrix.
7+
module wrapped_gemv
8+
implicit none
9+
private
10+
11+
public :: sp, dp, gemv
12+
13+
integer, parameter :: sp = selected_real_kind(6)
14+
integer, parameter :: dp = selected_real_kind(15)
15+
16+
17+
interface gemv
18+
module procedure :: wrap_sgemv
19+
module procedure :: wrap_dgemv
20+
end interface gemv
21+
22+
23+
interface blas_gemv
24+
subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
25+
import :: sp
26+
real(sp), intent(in) :: a(lda, *)
27+
real(sp), intent(in) :: x(*)
28+
real(sp), intent(inout) :: y(*)
29+
real(sp), intent(in) :: alpha
30+
real(sp), intent(in) :: beta
31+
character(len=1), intent(in) :: trans
32+
integer, intent(in) :: incx
33+
integer, intent(in) :: incy
34+
integer, intent(in) :: m
35+
integer, intent(in) :: n
36+
integer, intent(in) :: lda
37+
end subroutine sgemv
38+
subroutine dgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
39+
import :: dp
40+
real(dp), intent(in) :: a(lda, *)
41+
real(dp), intent(in) :: x(*)
42+
real(dp), intent(inout) :: y(*)
43+
real(dp), intent(in) :: alpha
44+
real(dp), intent(in) :: beta
45+
character(len=1), intent(in) :: trans
46+
integer, intent(in) :: incx
47+
integer, intent(in) :: incy
48+
integer, intent(in) :: m
49+
integer, intent(in) :: n
50+
integer, intent(in) :: lda
51+
end subroutine dgemv
52+
end interface blas_gemv
53+
54+
55+
contains
56+
57+
58+
subroutine wrap_sgemv(amat, xvec, yvec, alpha, beta, trans)
59+
real(sp), intent(in) :: amat(:, :)
60+
real(sp), intent(in) :: xvec(:)
61+
real(sp), intent(inout) :: yvec(:)
62+
real(sp), intent(in), optional :: alpha
63+
real(sp), intent(in), optional :: beta
64+
character(len=1), intent(in), optional :: trans
65+
real(sp) :: a, b
66+
character(len=1) :: tra
67+
integer :: incx, incy, m, n, lda
68+
if (present(alpha)) then
69+
a = alpha
70+
else
71+
a = 1.0_sp
72+
end if
73+
if (present(beta)) then
74+
b = beta
75+
else
76+
b = 0
77+
end if
78+
if (present(trans)) then
79+
tra = trans
80+
else
81+
tra = 'n'
82+
end if
83+
incx = 1
84+
incy = 1
85+
lda = max(1, size(amat, 1))
86+
m = size(amat, 1)
87+
n = size(amat, 2)
88+
call blas_gemv(tra, m, n, a, amat, lda, xvec, incx, b, yvec, incy)
89+
end subroutine wrap_sgemv
90+
91+
92+
subroutine wrap_dgemv(amat, xvec, yvec, alpha, beta, trans)
93+
real(dp), intent(in) :: amat(:, :)
94+
real(dp), intent(in) :: xvec(:)
95+
real(dp), intent(inout) :: yvec(:)
96+
real(dp), intent(in), optional :: alpha
97+
real(dp), intent(in), optional :: beta
98+
character(len=1), intent(in), optional :: trans
99+
real(dp) :: a, b
100+
character(len=1) :: tra
101+
integer :: incx, incy, m, n, lda
102+
if (present(alpha)) then
103+
a = alpha
104+
else
105+
a = 1.0_dp
106+
end if
107+
if (present(beta)) then
108+
b = beta
109+
else
110+
b = 0
111+
end if
112+
if (present(trans)) then
113+
tra = trans
114+
else
115+
tra = 'n'
116+
end if
117+
incx = 1
118+
incy = 1
119+
lda = max(1, size(amat, 1))
120+
m = size(amat, 1)
121+
n = size(amat, 2)
122+
call blas_gemv(tra, m, n, a, amat, lda, xvec, incx, b, yvec, incy)
123+
end subroutine wrap_dgemv
124+
125+
126+
end module wrapped_gemv

0 commit comments

Comments
 (0)