Moved handle_geqrf_info

Author: loiseaujc

src/lapack/stdlib_linalg_lapack_aux.fypp

@@ -45,6 +45,7 @@ module stdlib_linalg_lapack_aux
      public :: handle_gesdd_info
      public :: handle_gesv_info
      public :: handle_gees_info
+     public :: handle_geqrf_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. 
@@ -1433,4 +1434,27 @@ module stdlib_linalg_lapack_aux
 
     end subroutine handle_gees_info
 
+   elemental subroutine handle_geqrf_info(this,info,m,n,lwork,err)
+         character(len=*), intent(in) :: this
+         integer(ilp), intent(in) :: info,m,n,lwork
+         type(linalg_state_type), intent(out) :: err
+
+         ! Process output
+         select case (info)
+            case (0)
+                ! Success
+            case (-1)
+                err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size m=',m)
+            case (-2)
+                err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size n=',n)
+            case (-4)
+                err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size a=',[m,n])
+            case (-7)
+                err = linalg_state_type(this,LINALG_ERROR,'invalid input for lwork=',lwork)
+            case default
+                err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'catastrophic error')
+         end select
+
+     end subroutine handle_geqrf_info
+
 end module stdlib_linalg_lapack_aux

src/stdlib_linalg_qr.fypp

@@ -3,6 +3,7 @@
 submodule (stdlib_linalg) stdlib_linalg_qr
      use stdlib_linalg_constants
      use stdlib_linalg_lapack, only: geqrf, orgqr, ungqr
+     use stdlib_linalg_lapack_aux, only: handle_geqrf_info
      use stdlib_linalg_state, only: linalg_state_type, linalg_error_handling, LINALG_ERROR, &
          LINALG_INTERNAL_ERROR, LINALG_VALUE_ERROR     
      implicit none
@@ -64,29 +65,7 @@ submodule (stdlib_linalg) stdlib_linalg_qr
                 err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'catastrophic error')
          end select
 
-     end subroutine handle_orgqr_info
-     
-     elemental subroutine handle_geqrf_info(info,m,n,lwork,err)
-         integer(ilp), intent(in) :: info,m,n,lwork
-         type(linalg_state_type), intent(out) :: err
-
-         ! Process output
-         select case (info)
-            case (0)
-                ! Success
-            case (-1)
-                err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size m=',m)
-            case (-2)
-                err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size n=',n)
-            case (-4)
-                err = linalg_state_type(this,LINALG_VALUE_ERROR,'invalid matrix size a=',[m,n])
-            case (-7)
-                err = linalg_state_type(this,LINALG_ERROR,'invalid input for lwork=',lwork)
-            case default
-                err = linalg_state_type(this,LINALG_INTERNAL_ERROR,'catastrophic error')
-         end select
-
-     end subroutine handle_geqrf_info
+     end subroutine handle_orgqr_info     
 
      #:for rk,rt,ri in RC_KINDS_TYPES
 
@@ -113,7 +92,7 @@ submodule (stdlib_linalg) stdlib_linalg_qr
          ! QR space
          lwork_qr = -1_ilp
          call geqrf(m,n,a_dummy,m,tau_dummy,work_dummy,lwork_qr,info)    
-         call handle_geqrf_info(info,m,n,lwork_qr,err0)
+         call handle_geqrf_info(this,info,m,n,lwork_qr,err0)
          if (err0%error()) then 
             call linalg_error_handling(err0,err)
             return
@@ -224,7 +203,7 @@ submodule (stdlib_linalg) stdlib_linalg_qr
 
              ! Compute factorization. 
              call geqrf(m,n,amat,m,tau,work,lwork,info) 
-             call handle_geqrf_info(info,m,n,lwork,err0)
+             call handle_geqrf_info(this,info,m,n,lwork,err0)
 
              if (err0%ok()) then