Moved handle_gesdd_info and signature.

Author: loiseaujc

src/lapack/stdlib_linalg_lapack_aux.fypp

@@ -4,7 +4,7 @@ module stdlib_linalg_lapack_aux
  use stdlib_linalg_constants
  use stdlib_linalg_blas
  use stdlib_linalg_state, only: linalg_state_type, linalg_error_handling, LINALG_ERROR, &
- LINALG_INTERNAL_ERROR, LINALG_VALUE_ERROR
+ LINALG_INTERNAL_ERROR, LINALG_VALUE_ERROR, LINALG_SUCCESS
  use ieee_arithmetic, only: ieee_support_inf, ieee_support_nan
  implicit none
  private
@@ -42,6 +42,7 @@ module stdlib_linalg_lapack_aux
  #:endfor 
  public :: handle_potrf_info
  public :: handle_getri_info
+ public :: handle_gesdd_info
 
  ! SELCTG is a LOGICAL FUNCTION of three DOUBLE PRECISION arguments 
  ! used to select eigenvalues to sort to the top left of the Schur form. 
@@ -1331,4 +1332,35 @@ module stdlib_linalg_lapack_aux
  end select
  end subroutine handle_getri_info
 
+ elemental subroutine handle_gesdd_info(this,err,info,m,n)
+ character(len=*), intent(in) :: this
+ !> Error handler
+ type(linalg_state_type), intent(inout) :: err
+ !> GESDD return flag
+ integer(ilp), intent(in) :: info
+ !> Input matrix size
+ integer(ilp), intent(in) :: m,n
+
+ select case (info)
+ case (0)
+ ! Success!
+ err%state = LINALG_SUCCESS
+ case (-1)
+ err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'Invalid task ID on input to GESDD.')
+ case (-5,-3:-2)
+ err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size: a=',[m,n])
+ case (-8)
+ err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix U size, with a=',[m,n])
+ case (-10)
+ err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix V size, with a=',[m,n])
+ case (-4)
+ err = linalg_state_type(this,LINALG_VALUE_ERROR,'A contains invalid/NaN values.')
+ case (1:)
+ err = linalg_state_type(this,LINALG_ERROR,'SVD computation did not converge.')
+ case default
+ err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'Unknown error returned by GESDD.')
+ end select
+
+ end subroutine handle_gesdd_info
+
 end module stdlib_linalg_lapack_aux

src/stdlib_linalg_svd.fypp

@@ -4,6 +4,7 @@ submodule(stdlib_linalg) stdlib_linalg_svd
 !! Singular-Value Decomposition 
  use stdlib_linalg_constants
  use stdlib_linalg_lapack, only: gesdd
+ use stdlib_linalg_lapack_aux, only: handle_gesdd_info
  use stdlib_linalg_state, only: linalg_state_type, linalg_error_handling, LINALG_ERROR, &
  LINALG_INTERNAL_ERROR, LINALG_VALUE_ERROR, LINALG_SUCCESS
  implicit none
@@ -26,38 +27,6 @@ submodule(stdlib_linalg) stdlib_linalg_svd
 
  contains
 
- !> Process GESDD output flag
- elemental subroutine handle_gesdd_info(err,info,m,n)
- !> Error handler
- type(linalg_state_type), intent(inout) :: err
- !> GESDD return flag
- integer(ilp), intent(in) :: info
- !> Input matrix size
- integer(ilp), intent(in) :: m,n
-
- select case (info)
- case (0)
- ! Success!
- err%state = LINALG_SUCCESS
- case (-1)
- err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'Invalid task ID on input to GESDD.')
- case (-5,-3:-2)
- err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size: a=',[m,n])
- case (-8)
- err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix U size, with a=',[m,n])
- case (-10)
- err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix V size, with a=',[m,n])
- case (-4)
- err = linalg_state_type(this,LINALG_VALUE_ERROR,'A contains invalid/NaN values.')
- case (1:)
- err = linalg_state_type(this,LINALG_ERROR,'SVD computation did not converge.')
- case default
- err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'Unknown error returned by GESDD.')
- end select
-
- end subroutine handle_gesdd_info
-
-
  #:for rk,rt,ri in RC_KINDS_TYPES
 
  !> Singular values of matrix A
@@ -265,7 +234,7 @@ submodule(stdlib_linalg) stdlib_linalg_svd
  lwork = -1_ilp
  call gesdd(task,m,n,amat,lda,s,umat,ldu,vtmat,ldvt,&
  work_dummy,lwork,#{if rt.startswith('complex')}#rwork,#{endif}#iwork,info)
- call handle_gesdd_info(err0,info,m,n)
+ call handle_gesdd_info(this,err0,info,m,n)
 
  ! Compute SVD
  if (info==0) then
@@ -281,7 +250,7 @@ submodule(stdlib_linalg) stdlib_linalg_svd
  !> Compute SVD
  call gesdd(task,m,n,amat,lda,s,umat,ldu,vtmat,ldvt,&
  work,lwork,#{if rt.startswith('complex')}#rwork,#{endif}#iwork,info)
- call handle_gesdd_info(err0,info,m,n)
+ call handle_gesdd_info(this,err0,info,m,n)
 
  endif