Give up forcing the initial residual to be in the range of the operat…

…or OP after a restart (Closes: #142). (#143)

CHANGES

@@ -1,3 +1,6 @@
+ [ Marco Caliari ]
+ * Give up forcing the initial residual to be in the range of the operator OP after a restart (Closes: #142).
+
 arpack-ng - 3.6.2
 
  * Remove all trailing whitespaces

CMakeLists.txt

@@ -483,6 +483,14 @@ add_executable(bug_79_double_complex TESTS/bug_79_double_complex.f)
 target_link_libraries(bug_79_double_complex arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS})
 add_test(bug_79_double_complex_tst Tests/bug_79_double_complex)
 
+add_executable(bug_142 TESTS/bug_142.f)
+target_link_libraries(bug_142 arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS})
+add_test(bug_142_tst Tests/bug_142)
+
+add_executable(bug_142_gen TESTS/bug_142_gen.f)
+target_link_libraries(bug_142_gen arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS})
+add_test(bug_142_gen_tst Tests/bug_142_gen)
+
 if(MPI)
   add_executable(issue46 PARPACK/TESTS/MPI/issue46.f)
   target_link_libraries(issue46 parpack arpack ${BLAS_LIBRARIES} ${LAPACK_LIBRARIES} ${EXTRA_LDLAGS})

SRC/cgetv0.f

@@ -239,12 +239,16 @@ subroutine cgetv0
 c        %----------------------------------------------------------%
 c
          call arscnd (t2)
-         nopx = nopx + 1
-         ipntr(1) = 1
-         ipntr(2) = n + 1
-         call ccopy (n, resid, 1, workd, 1)
-         ido = -1
-         go to 9000
+         if (itry .eq. 1) then
+            nopx = nopx + 1
+            ipntr(1) = 1
+            ipntr(2) = n + 1
+            call ccopy (n, resid, 1, workd, 1)
+            ido = -1
+            go to 9000
+         else if (itry .gt. 1 .and. bmat .eq. 'G') then
+            call ccopy (n, resid, 1, workd(n + 1), 1)
+         end if
       end if
 c
 c     %----------------------------------------%
@@ -269,7 +273,7 @@ subroutine cgetv0
 c
       call arscnd (t2)
       first = .TRUE.
-      call ccopy (n, workd(n+1), 1, resid, 1)
+      if (itry .eq. 1) call ccopy (n, workd(n + 1), 1, resid, 1)
       if (bmat .eq. 'G') then
          nbx = nbx + 1
          ipntr(1) = n + 1

SRC/dgetv0.f

@@ -242,12 +242,16 @@ subroutine dgetv0
 c        %----------------------------------------------------------%
 c
          call arscnd (t2)
-         nopx = nopx + 1
-         ipntr(1) = 1
-         ipntr(2) = n + 1
-         call dcopy (n, resid, 1, workd, 1)
-         ido = -1
-         go to 9000
+         if (itry .eq. 1) then
+            nopx = nopx + 1
+            ipntr(1) = 1
+            ipntr(2) = n + 1
+            call dcopy (n, resid, 1, workd, 1)
+            ido = -1
+            go to 9000
+         else if (itry .gt. 1 .and. bmat .eq. 'G') then
+            call dcopy (n, resid, 1, workd(n + 1), 1)
+         end if
       end if
 c
 c     %-----------------------------------------%
@@ -274,7 +278,7 @@ subroutine dgetv0
 c
       call arscnd (t2)
       first = .TRUE.
-      call dcopy (n, workd(n+1), 1, resid, 1)
+      if (itry .eq. 1) call dcopy (n, workd(n + 1), 1, resid, 1)
       if (bmat .eq. 'G') then
          nbx = nbx + 1
          ipntr(1) = n + 1

SRC/sgetv0.f

@@ -242,12 +242,16 @@ subroutine sgetv0
 c        %----------------------------------------------------------%
 c
          call arscnd (t2)
-         nopx = nopx + 1
-         ipntr(1) = 1
-         ipntr(2) = n + 1
-         call scopy (n, resid, 1, workd, 1)
-         ido = -1
-         go to 9000
+         if (itry .eq. 1) then
+            nopx = nopx + 1
+            ipntr(1) = 1
+            ipntr(2) = n + 1
+            call scopy (n, resid, 1, workd, 1)
+            ido = -1
+            go to 9000
+         else if (itry .gt. 1 .and. bmat .eq. 'G') then
+            call scopy (n, resid, 1, workd(n + 1), 1)
+         end if
       end if
 c
 c     %-----------------------------------------%
@@ -274,7 +278,7 @@ subroutine sgetv0
 c
       call arscnd (t2)
       first = .TRUE.
-      call scopy (n, workd(n+1), 1, resid, 1)
+      if (itry .eq. 1) call scopy (n, workd(n + 1), 1, resid, 1)
       if (bmat .eq. 'G') then
          nbx = nbx + 1
          ipntr(1) = n + 1

SRC/zgetv0.f

@@ -239,12 +239,16 @@ subroutine zgetv0
 c        %----------------------------------------------------------%
 c
          call arscnd (t2)
-         nopx = nopx + 1
-         ipntr(1) = 1
-         ipntr(2) = n + 1
-         call zcopy (n, resid, 1, workd, 1)
-         ido = -1
-         go to 9000
+         if (itry .eq. 1) then
+            nopx = nopx + 1
+            ipntr(1) = 1
+            ipntr(2) = n + 1
+            call zcopy (n, resid, 1, workd, 1)
+            ido = -1
+            go to 9000
+         else if (itry .gt. 1 .and. bmat .eq. 'G') then
+            call zcopy (n, resid, 1, workd(n + 1), 1)
+         end if
       end if
 c
 c     %----------------------------------------%
@@ -269,7 +273,7 @@ subroutine zgetv0
 c
       call arscnd (t2)
       first = .TRUE.
-      call zcopy (n, workd(n+1), 1, resid, 1)
+      if (itry .eq. 1) call zcopy (n, workd(n + 1), 1, resid, 1)
       if (bmat .eq. 'G') then
          nbx = nbx + 1
          ipntr(1) = n + 1

TESTS/Makefile.am

@@ -1,6 +1,6 @@
 LDADD=$(top_builddir)/SRC/libarpack$(LIBSUFFIX).la $(LAPACK_LIBS) $(BLAS_LIBS)
 
-check_PROGRAMS = dnsimp bug_1323 bug_58_double bug_79_double_complex
+check_PROGRAMS = dnsimp bug_1323 bug_58_double bug_79_double_complex bug_142 bug_142_gen
 if ICB
 check_PROGRAMS += icb_arpack_c
 check_PROGRAMS += icb_arpack_cpp
@@ -21,6 +21,10 @@ bug_58_double_SOURCES = bug_58_double.f
 
 bug_79_double_complex_SOURCES = bug_79_double_complex.f
 
+bug_142_SOURCES = bug_142.f
+
+bug_142_gen_SOURCES = bug_142_gen.f
+
 if ICB
 icb_arpack_c_SOURCES = icb_arpack_c.c
 icb_arpack_c_LDADD = $(top_builddir)/SRC/libarpack$(LIBSUFFIX).la