Skip to content

Commit 16a0e96

Browse files
jalveszjalvesz
authored
Merge branch 'fortran-lang:master' into intrinsics
2 parents 8a35f38 + 036b091 commit 16a0e96

File tree

4 files changed

+54
-28
lines changed

4 files changed

+54
-28
lines changed

‎example/linalg/example_sparse_from_ijv.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ program example_sparse_from_ijv
3535
print *, 'ELL'
3636
print *, ' index | data'
3737
do i = 1, ELL%nrows
38-
print '(3I4,x,3f8.1)', ELL%index(i,:) , ELL%data(i,:)
38+
print '(3I4,1x,3f8.1)', ELL%index(i,:) , ELL%data(i,:)
3939
end do
4040

41-
end program example_sparse_from_ijv
41+
end program example_sparse_from_ijv

‎src/stdlib_io.fypp

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -252,6 +252,7 @@ contains
252252

253253
integer :: ios, skiprows_, i
254254
character :: c
255+
character(len=:), allocatable :: line
255256
logical :: lastblank
256257

257258
skiprows_ = optval(skiprows, 0)
@@ -261,12 +262,15 @@ contains
261262
do i = 1, skiprows_
262263
read(s, *)
263264
end do
264-
265265
number_of_columns = 0
266+
267+
! Read first non-skipped line as a whole
268+
call getline(s, line, ios)
269+
if (ios/=0 .or. .not.allocated(line)) return
270+
266271
lastblank = .true.
267-
do
268-
read(s, '(a)', advance='no', iostat=ios) c
269-
if (ios /= 0) exit
272+
do i = 1,len(line)
273+
c = line(i:i)
270274
if (lastblank .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1
271275
lastblank = is_blank(c)
272276
end do

‎src/stdlib_linalg_eigenvalues.fypp

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -139,18 +139,18 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
139139
module function stdlib_linalg_eigvals_${ep}$_${ri}$(a#{if ei=='ggev'}#,b#{endif}#,err) result(lambda)
140140
!! Return an array of eigenvalues of matrix A.
141141
!> Input matrix A[m,n]
142-
${rt}$, intent(in), dimension(:,:), target :: a
142+
${rt}$, intent(in), target :: a(:,:)
143143
#:if ei=='ggev'
144144
!> Generalized problem matrix B[n,n]
145-
${rt}$, intent(inout), dimension(:,:), target :: b
145+
${rt}$, intent(inout), target :: b(:,:)
146146
#:endif
147147
!> [optional] state return flag. On error if not requested, the code will stop
148148
type(linalg_state_type), intent(out) :: err
149149
!> Array of eigenvalues
150150
complex(${rk}$), allocatable :: lambda(:)
151151

152152
!> Create
153-
${rt}$, pointer, dimension(:,:) :: amat#{if ei=='ggev'}#, bmat #{endif}#
153+
${rt}$, pointer :: amat(:,:)#{if ei=='ggev'}#, bmat(:,:) #{endif}#
154154
integer(ilp) :: m,n,k
155155

156156
!> Create an internal pointer so the intent of A won't affect the next call
@@ -172,16 +172,16 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
172172
module function stdlib_linalg_eigvals_noerr_${ep}$_${ri}$(a#{if ei=='ggev'}#,b#{endif}#) result(lambda)
173173
!! Return an array of eigenvalues of matrix A.
174174
!> Input matrix A[m,n]
175-
${rt}$, intent(in), dimension(:,:), target :: a
175+
${rt}$, intent(in), target :: a(:,:)
176176
#:if ei=='ggev'
177177
!> Generalized problem matrix B[n,n]
178-
${rt}$, intent(inout), dimension(:,:), target :: b
178+
${rt}$, intent(inout), target :: b(:,:)
179179
#:endif
180180
!> Array of eigenvalues
181181
complex(${rk}$), allocatable :: lambda(:)
182182

183183
!> Create
184-
${rt}$, pointer, dimension(:,:) :: amat#{if ei=='ggev'}#, bmat #{endif}#
184+
${rt}$, pointer :: amat(:,:)#{if ei=='ggev'}#, bmat(:,:) #{endif}#
185185
integer(ilp) :: m,n,k
186186

187187
!> Create an internal pointer so the intent of A won't affect the next call
@@ -205,10 +205,10 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
205205
!! Eigendecomposition of matrix A returning an array `lambda` of eigenvalues,
206206
!! and optionally right or left eigenvectors.
207207
!> Input matrix A[m,n]
208-
${rt}$, intent(inout), dimension(:,:), target :: a
208+
${rt}$, intent(inout), target :: a(:,:)
209209
#:if ei=='ggev'
210210
!> Generalized problem matrix B[n,n]
211-
${rt}$, intent(inout), dimension(:,:), target :: b
211+
${rt}$, intent(inout), target :: b(:,:)
212212
#:endif
213213
!> Array of eigenvalues
214214
complex(${rk}$), intent(out) :: lambda(:)
@@ -232,7 +232,7 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
232232
character :: task_u,task_v
233233
${rt}$, target :: work_dummy(1),u_dummy(1,1),v_dummy(1,1)
234234
${rt}$, allocatable :: work(:)
235-
${rt}$, dimension(:,:), pointer :: amat,umat,vmat#{if ei=='ggev'}#,bmat#{endif}#
235+
${rt}$, pointer :: amat(:,:),umat(:,:),vmat(:,:)#{if ei=='ggev'}#,bmat(:,:)#{endif}#
236236
#:if rt.startswith('complex')
237237
real(${rk}$), allocatable :: rwork(:)
238238
#:else
@@ -353,7 +353,7 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
353353

354354
! Compute workspace size
355355
#:if rt.startswith('complex')
356-
allocate(rwork(2*n))
356+
allocate(rwork( #{if ei=='ggev'}# 8*n #{else}# 2*n #{endif}# ))
357357
#:else
358358
allocate(lreal(n),limag(n))
359359
#:endif

‎test/linalg/test_linalg_eigenvalues.fypp

Lines changed: 34 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
module test_linalg_eigenvalues
44
use stdlib_linalg_constants
55
use stdlib_linalg_state
6-
use stdlib_linalg, only: eig, eigh, eigvals, eigvalsh, diag
6+
use stdlib_linalg, only: eig, eigh, eigvals, eigvalsh, diag, eye
77
use testdrive, only: error_type, check, new_unittest, unittest_type
88

99
implicit none (type,external)
@@ -21,27 +21,23 @@ module test_linalg_eigenvalues
2121
allocate(tests(0))
2222

2323
#:for rk,rt,ri in REAL_KINDS_TYPES
24-
#:if rk!="xdp"
2524
tests = [tests,new_unittest("test_eig_real_${ri}$",test_eig_real_${ri}$), &
2625
new_unittest("test_eigvals_identity_${ri}$",test_eigvals_identity_${ri}$), &
2726
new_unittest("test_eigvals_diagonal_B_${ri}$",test_eigvals_diagonal_B_${ri}$), &
2827
new_unittest("test_eigvals_nondiagonal_B_${ri}$",test_eigvals_nondiagonal_B_${ri}$), &
2928
new_unittest("test_eigh_real_${ri}$",test_eigh_real_${ri}$)]
30-
#:endif
3129
#: endfor
3230

3331
#:for ck,ct,ci in CMPLX_KINDS_TYPES
34-
#:if ck!="xdp"
3532
tests = [tests,new_unittest("test_eig_complex_${ci}$",test_eig_complex_${ci}$), &
36-
new_unittest("test_eig_generalized_complex_${ci}$",test_eigvals_generalized_complex_${ci}$)]
37-
#:endif
33+
new_unittest("test_eig_generalized_complex_${ci}$",test_eigvals_generalized_complex_${ci}$), &
34+
new_unittest("test_eig_issue_927_${ci}$",test_issue_927_${ci}$)]
3835
#: endfor
3936

4037
end subroutine test_eig_eigh
4138

4239
!> Simple real matrix eigenvalues
4340
#:for rk,rt,ri in REAL_KINDS_TYPES
44-
#:if rk!="xdp"
4541
subroutine test_eig_real_${ri}$(error)
4642
type(error_type), allocatable, intent(out) :: error
4743

@@ -239,12 +235,10 @@ module test_linalg_eigenvalues
239235
if (allocated(error)) return
240236
end subroutine test_eigvals_nondiagonal_B_${ri}$
241237

242-
#:endif
243238
#:endfor
244239

245240
!> Simple complex matrix eigenvalues
246241
#:for ck,ct,ci in CMPLX_KINDS_TYPES
247-
#:if ck!="xdp"
248242
subroutine test_eig_complex_${ci}$(error)
249243
type(error_type), allocatable, intent(out) :: error
250244

@@ -309,8 +303,6 @@ module test_linalg_eigenvalues
309303

310304
lambda = eigvals(A, B, err=state)
311305

312-
print *, 'lambda = ',lambda
313-
314306
!> Expected eigenvalues
315307
lres(1) = czero
316308
lres(2) = 2*cone
@@ -324,10 +316,40 @@ module test_linalg_eigenvalues
324316

325317
end subroutine test_eigvals_generalized_complex_${ci}$
326318

327-
#:endif
319+
! Generalized eigenvalues should not crash
320+
subroutine test_issue_927_${ci}$(error)
321+
type(error_type), allocatable, intent(out) :: error
322+
323+
${ct}$ :: A_Z(3,3),S_Z(3,3),vecs_r(3,3),eigs(3)
324+
real(${ck}$) :: A_D(3,3),S_D(3,3)
325+
type(linalg_state_type) :: state
326+
integer :: i
327+
328+
! Set matrix
329+
A_Z = reshape( [ [1, 6, 3], &
330+
[9, 2, 1], &
331+
[8, 3, 4] ], [3,3] )
332+
333+
S_Z = eye(3, mold=0.0_${ck}$)
334+
335+
A_D = real(A_Z)
336+
S_D = real(S_Z)
337+
338+
call eig(A_D,S_D,eigs,right=vecs_r,err=state)
339+
call check(error, state%ok(), 'test issue 927 (${ct}$): '//state%print())
340+
if (allocated(error)) return
341+
342+
call eig(A_Z,S_Z,eigs,right=vecs_r,err=state) !Fails
343+
call check(error, state%ok(), 'test issue 927 (${ct}$): '//state%print())
344+
if (allocated(error)) return
345+
346+
end subroutine test_issue_927_${ci}$
347+
328348
#:endfor
329349

330350

351+
352+
331353
end module test_linalg_eigenvalues
332354

333355
program test_eigenvalues

0 commit comments

Comments
 (0)