Debug intel classic

Author: loiseaujc

test/linalg/test_linalg_pivoting_qr.fypp

@@ -61,51 +61,51 @@ module test_linalg_pivoting_qr
         call check(error,state%ok(),state%print())
         if (allocated(error)) return        
 
-        ! Check solution
-        call check(error, all(abs(a(:, pivots)-matmul(q,r))<tol), 'converged solution (full)')
-        if (allocated(error)) return        
-
-        ! ! 2) QR factorization with reduced matrices
-        ! call qr(a, qred, rred, pivots, err=state)
-        !
-        ! ! Check return code
-        ! call check(error,state%ok(),state%print())
+        ! ! Check solution
+        ! call check(error, all(abs(a(:, pivots)-matmul(q,r))<tol), 'converged solution (full)')
         ! if (allocated(error)) return        
         !
+        ! 2) QR factorization with reduced matrices
+        call qr(a, qred, rred, pivots, err=state)
+
+        ! Check return code
+        call check(error,state%ok(),state%print())
+        if (allocated(error)) return        
+        !
         ! ! Check solution
         ! call check(error, all(abs(a(:, pivots)-matmul(qred,rred))<tol), 'converged solution (reduced)')
         ! if (allocated(error)) return        
         !
-        ! ! 3) overwrite A
-        ! call qr(a, qred, rred, pivots, overwrite_a=.true., err=state)
-        !
-        ! ! Check return code
-        ! call check(error,state%ok(),state%print())
-        ! if (allocated(error)) return        
+        ! 3) overwrite A
+        call qr(a, qred, rred, pivots, overwrite_a=.true., err=state)
+
+        ! Check return code
+        call check(error,state%ok(),state%print())
+        if (allocated(error)) return        
         !
         ! ! Check solution
         ! call check(error, all(abs(aorig(:, pivots)-matmul(qred,rred))<tol), 'converged solution (overwrite A)')
         ! if (allocated(error)) return                
         !
-        ! ! 4) External storage option   
-        ! a = aorig
-        ! call qr_space(a, lwork, pivoting=.true.)
-        ! allocate(work(lwork))
-        ! call qr(a, q, r, pivots, storage=work, err=state)
-        !
-        ! ! Check return code
-        ! call check(error,state%ok(),state%print())
-        ! if (allocated(error)) return        
+        ! 4) External storage option   
+        a = aorig
+        call qr_space(a, lwork, pivoting=.true.)
+        allocate(work(lwork))
+        call qr(a, q, r, pivots, storage=work, err=state)
+
+        ! Check return code
+        call check(error,state%ok(),state%print())
+        if (allocated(error)) return        
         !
         ! ! Check solution
         ! call check(error, all(abs(a(:, pivots)-matmul(q,r))<tol), 'converged solution (external storage)')
         ! if (allocated(error)) return          
         !
-        ! ! Check that an invalid problem size returns an error
-        ! a = aorig        
-        ! call qr(a, qerr, rerr, pivots, err=state)
-        ! call check(error,state%error(),'invalid matrix sizes')
-        ! if (allocated(error)) return             
+        ! Check that an invalid problem size returns an error
+        a = aorig        
+        call qr(a, qerr, rerr, pivots, err=state)
+        call check(error,state%error(),'invalid matrix sizes')
+        if (allocated(error)) return             
     end subroutine test_pivoting_qr_random_tall_matrix_${ri}$
 
     subroutine test_pivoting_qr_random_rank_deficient_${ri}$(error)