Skip to content

Commit d19425a

Browse files
committed
fix intel module subroutine error
1 parent f232a76 commit d19425a

File tree

1 file changed

+41
-41
lines changed

1 file changed

+41
-41
lines changed

src/stdlib_linalg_eigenvalues.fypp

Lines changed: 41 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -309,47 +309,6 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
309309

310310
end subroutine stdlib_linalg_eig_${ri}$
311311

312-
module subroutine stdlib_linalg_real_eig_${ri}$(a,lambda,right,left,overwrite_a,err)
313-
!! Eigendecomposition of matrix A returning an array `lambda` of real eigenvalues,
314-
!! and optionally right or left eigenvectors. Returns an error if the eigenvalues had
315-
!! non-trivial imaginary parts.
316-
!> Input matrix A[m,n]
317-
${rt}$, intent(inout), target :: a(:,:)
318-
!> Array of real eigenvalues
319-
real(${rk}$), intent(out) :: lambda(:)
320-
!> The columns of RIGHT contain the right eigenvectors of A
321-
complex(${rk}$), optional, intent(out), target :: right(:,:)
322-
!> The columns of LEFT contain the left eigenvectors of A
323-
complex(${rk}$), optional, intent(out), target :: left(:,:)
324-
!> [optional] Can A data be overwritten and destroyed?
325-
logical(lk), optional, intent(in) :: overwrite_a
326-
!> [optional] state return flag. On error if not requested, the code will stop
327-
type(linalg_state_type), optional, intent(out) :: err
328-
329-
type(linalg_state_type) :: err0
330-
integer(ilp) :: n
331-
complex(${rk}$), allocatable :: clambda(:)
332-
real(${rk}$), parameter :: rtol = epsilon(0.0_${rk}$)
333-
real(${rk}$), parameter :: atol = tiny(0.0_${rk}$)
334-
335-
n = size(lambda,dim=1,kind=ilp)
336-
allocate(clambda(n))
337-
338-
call stdlib_linalg_eig_${ri}$(a,clambda,right,left,overwrite_a,err0)
339-
340-
! Check that no eigenvalues have meaningful imaginary part
341-
if (err0%ok() .and. any(aimag(clambda)>atol+rtol*abs(abs(clambda)))) then
342-
err0 = linalg_state_type(this,LINALG_VALUE_ERROR, &
343-
'complex eigenvalues detected: max(imag(lambda))=',maxval(aimag(clambda)))
344-
endif
345-
346-
! Return real components only
347-
lambda(:n) = real(clambda,kind=${rk}$)
348-
349-
call linalg_error_handling(err0,err)
350-
351-
end subroutine stdlib_linalg_real_eig_${ri}$
352-
353312
module function stdlib_linalg_eigvalsh_${ri}$(a,upper_a,err) result(lambda)
354313
!! Return an array of eigenvalues of real symmetric / complex hermitian A
355314
!> Input matrix A[m,n]
@@ -566,6 +525,47 @@ submodule (stdlib_linalg) stdlib_linalg_eigenvalues
566525

567526
end subroutine assign_real_eigenvectors_${rk}$
568527

528+
module subroutine stdlib_linalg_real_eig_${ri}$(a,lambda,right,left,overwrite_a,err)
529+
!! Eigendecomposition of matrix A returning an array `lambda` of real eigenvalues,
530+
!! and optionally right or left eigenvectors. Returns an error if the eigenvalues had
531+
!! non-trivial imaginary parts.
532+
!> Input matrix A[m,n]
533+
${rt}$, intent(inout), target :: a(:,:)
534+
!> Array of real eigenvalues
535+
real(${rk}$), intent(out) :: lambda(:)
536+
!> The columns of RIGHT contain the right eigenvectors of A
537+
complex(${rk}$), optional, intent(out), target :: right(:,:)
538+
!> The columns of LEFT contain the left eigenvectors of A
539+
complex(${rk}$), optional, intent(out), target :: left(:,:)
540+
!> [optional] Can A data be overwritten and destroyed?
541+
logical(lk), optional, intent(in) :: overwrite_a
542+
!> [optional] state return flag. On error if not requested, the code will stop
543+
type(linalg_state_type), optional, intent(out) :: err
544+
545+
type(linalg_state_type) :: err0
546+
integer(ilp) :: n
547+
complex(${rk}$), allocatable :: clambda(:)
548+
real(${rk}$), parameter :: rtol = epsilon(0.0_${rk}$)
549+
real(${rk}$), parameter :: atol = tiny(0.0_${rk}$)
550+
551+
n = size(lambda,dim=1,kind=ilp)
552+
allocate(clambda(n))
553+
554+
call stdlib_linalg_eig_${ri}$(a,clambda,right,left,overwrite_a,err0)
555+
556+
! Check that no eigenvalues have meaningful imaginary part
557+
if (err0%ok() .and. any(aimag(clambda)>atol+rtol*abs(abs(clambda)))) then
558+
err0 = linalg_state_type(this,LINALG_VALUE_ERROR, &
559+
'complex eigenvalues detected: max(imag(lambda))=',maxval(aimag(clambda)))
560+
endif
561+
562+
! Return real components only
563+
lambda(:n) = real(clambda,kind=${rk}$)
564+
565+
call linalg_error_handling(err0,err)
566+
567+
end subroutine stdlib_linalg_real_eig_${ri}$
568+
569569
#:endif
570570
#:endfor
571571

0 commit comments

Comments
 (0)