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