fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-16 10:52:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

[UPDATE] Refactor after template update for RMA routines

Browse Source
This commit is contained in:
Stack-1
2026-05-26 13:15:31 +02:00
parent 4b8e4dd4a3
commit 29248d366f
971 changed files with 1844 additions and 1749 deletions
Download Patch File Download Diff File Expand all files Collapse all files
linsolve/impl/psb_cbicg.f90
+4 -8
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -187,11 +187,11 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,&
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=9_psb_ipk_)
call psb_geall(wwrk,desc_a,info,n=9_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v)
if(info /= psb_success_) then
info = psb_err_from_subroutine_non_
ch_err = 'psb_asb'
info=psb_err_from_subroutine_non_
ch_err='psb_asb'
err=info
call psb_errpush(info,name,a_err=ch_err)
goto 9999
@@ -313,10 +313,6 @@ subroutine psb_cbicg_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_ccg.F90
+4 -7
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -113,7 +113,7 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,&
integer(psb_ipk_), Optional, Intent(out) :: iter
Real(psb_spk_), Optional, Intent(out) :: err,cond
! = Local data
complex(psb_spk_), allocatable, target :: td(:),tu(:),eig(:),ewrk(:)
complex(psb_spk_), allocatable, target ::td(:),tu(:),eig(:),ewrk(:)
integer(psb_mpk_), allocatable :: ibl(:), ispl(:), iwrk(:)
type(psb_c_vect_type), allocatable, target :: wwrk(:)
type(psb_c_vect_type), pointer :: q, p, r, z, w
@@ -171,7 +171,8 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
@@ -283,10 +284,6 @@ subroutine psb_ccg_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_ccgs.f90
+2 -5
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -164,6 +164,7 @@ Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=11_psb_ipk_)
if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v)
if (info /= psb_success_) Then
@@ -307,10 +308,6 @@ Subroutine psb_ccgs_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_ccgstab.f90
+2 -9
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -113,7 +113,7 @@ Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
complex(psb_spk_), allocatable, target :: wwrk(:,:)
type(psb_c_vect_type) :: q, r, p, v, s, t, z, f
integer(psb_ipk_) :: itmax_, it,itrace_,&
integer(psb_ipk_) :: itmax_, it, itrace_,&
& n_row, n_col
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit
@@ -179,12 +179,6 @@ Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
call psb_errpush(info,name,a_err='psb_chkvect on B')
goto 9999
end if
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
End If
call psb_geasb(q,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(r,desc_a,info,mold=x%v,scratch=.true.)
@@ -364,7 +358,6 @@ Subroutine psb_ccgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter)
if (present(err)) err = derr
call x%sync()
call psb_gefree(q,desc_a,info)
call psb_gefree(r,desc_a,info)
linsolve/impl/psb_ccgstabl.f90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_cfcg.F90
+1 -2
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -176,7 +176,6 @@ subroutine psb_cfcg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (present(itmax)) then
itmax_ = itmax
else
linsolve/impl/psb_cgcr.f90
+2 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -342,6 +342,7 @@ subroutine psb_cgcr_vect(a,prec,b,x,eps,desc_a,info,&
if (info == psb_success_) call psb_gefree(c(i),desc_a,info)
end do
if (info == psb_success_) deallocate(h,c_scale,z,c,alpha,stat=info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
call psb_errpush(info,name)
linsolve/impl/psb_ckrylov.f90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_crgmres.f90
+2 -2
View File
@@ -18,7 +18,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -228,7 +228,6 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(v,desc_a,info,n=nl+1)
if (info == psb_success_) call psb_geall(w,desc_a,info)
if (info == psb_success_) call psb_geall(w1,desc_a,info)
@@ -485,6 +484,7 @@ subroutine psb_crgmres_vect(a,prec,b,x,eps,desc_a,info,&
if (info == psb_success_) call psb_gefree(w,desc_a,info)
if (info == psb_success_) call psb_gefree(w1,desc_a,info)
if (info == psb_success_) call psb_gefree(xt,desc_a,info)
if (info == psb_success_) deallocate(h,c,s,rs,rst, stat=info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
call psb_errpush(info,name)
linsolve/impl/psb_crichardson.f90
+2 -9
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -154,13 +154,6 @@ Subroutine psb_crichardson_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.)
if (info /= psb_success_) then
info = psb_err_from_subroutine_non_
call psb_errpush(info,name)
goto 9999
end if
p => wwrk(1)
q => wwrk(2)
r => wwrk(3)
@@ -170,7 +163,7 @@ Subroutine psb_crichardson_vect(a,prec,b,x,eps,desc_a,info,&
call psb_geaxpby(cone,b,czero,r,desc_a,info)
if (info == psb_success_) call psb_spmm(-cone,a,x,cone,r,desc_a,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_non_
info=psb_err_from_subroutine_non_
call psb_errpush(info,name)
goto 9999
end if
linsolve/impl/psb_dbicg.f90
+4 -9
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -187,8 +187,7 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,&
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=9_psb_ipk_)
call psb_geall(wwrk,desc_a,info,n=9_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v)
if(info /= psb_success_) then
info=psb_err_from_subroutine_non_
@@ -283,8 +282,8 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,&
call psb_geaxpby(done,zt,beta,pt,desc_a,info)
end if
call psb_spmm(done,a,p,dzero,q,desc_a,info)
call psb_spmm(done,a,pt,dzero,qt,desc_a,info,trans='c')
call psb_spmm(done,a,p,dzero,q,desc_a,info)
call psb_spmm(done,a,pt,dzero,qt,desc_a,info,trans='c')
sigma = psb_gedot(pt,q,desc_a,info)
if (sigma == dzero) then
@@ -314,10 +313,6 @@ subroutine psb_dbicg_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_dcg.F90
+4 -26
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -113,14 +113,13 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,&
integer(psb_ipk_), Optional, Intent(out) :: iter
Real(psb_dpk_), Optional, Intent(out) :: err,cond
! = Local data
real(psb_dpk_), allocatable, target :: td(:),tu(:),eig(:),ewrk(:)
real(psb_dpk_), allocatable, target ::td(:),tu(:),eig(:),ewrk(:)
integer(psb_mpk_), allocatable :: ibl(:), ispl(:), iwrk(:)
type(psb_d_vect_type), allocatable, target :: wwrk(:)
type(psb_d_vect_type), pointer :: q, p, r, z, w
real(psb_dpk_) :: alpha, beta, rho, rho_old, sigma,alpha_old,beta_old
integer(psb_ipk_) :: itmax_, istop_, it, itx, itrace_,&
& n_col, n_row,err_act, ieg,nspl, istebz
integer(psb_ipk_) :: i, swap_status
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit
type(psb_ctxt_type) :: ctxt
@@ -140,11 +139,6 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,&
ctxt = desc_a%get_context()
call psb_info(ctxt, me, np)
if (np == -ione) then
info = psb_err_context_error_
call psb_errpush(info,name,a_err='invalid desc_a context in psb_dcg_vect')
goto 9999
end if
if (.not.allocated(b%v)) then
info = psb_err_invalid_vect_state_
call psb_errpush(info,name)
@@ -177,21 +171,9 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.)
if ((info == psb_success_).and.allocated(x%v%comm_handle)) then
do i=1,size(wwrk)
if (allocated(wwrk(i)%v)) then
call psb_comm_set(x%v%comm_handle%comm_type,wwrk(i)%v%comm_handle,info)
if (info /= psb_success_) exit
wwrk(i)%v%comm_handle%id = x%v%comm_handle%id
call x%v%comm_handle%get_swap_status(swap_status,info)
if (info /= psb_success_) exit
call wwrk(i)%v%comm_handle%set_swap_status(swap_status,info)
if (info /= psb_success_) exit
end if
end do
end if
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
call psb_errpush(info,name)
@@ -335,10 +317,6 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_dcgs.f90
+2 -5
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -164,6 +164,7 @@ Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=11_psb_ipk_)
if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v)
if (info /= psb_success_) Then
@@ -307,10 +308,6 @@ Subroutine psb_dcgs_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_dcgstab.f90
+3 -10
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -113,7 +113,8 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
real(psb_dpk_), allocatable, target :: wwrk(:,:)
type(psb_d_vect_type) :: q, r, p, v, s, t, z, f
integer(psb_ipk_) :: itmax_, it, itrace_, n_row, n_col
integer(psb_ipk_) :: itmax_, it, itrace_,&
& n_row, n_col
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit
Logical, Parameter :: exchange=.True., noexchange=.False., debug1 = .False.
@@ -179,13 +180,6 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
goto 9999
end if
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
End If
call psb_geasb(q,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(r,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(p,desc_a,info,mold=x%v,scratch=.true.)
@@ -364,7 +358,6 @@ Subroutine psb_dcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
call psb_end_conv(methdname,itx,desc_a,stopdat,info,derr,iter)
if (present(err)) err = derr
call x%sync()
call psb_gefree(q,desc_a,info)
call psb_gefree(r,desc_a,info)
linsolve/impl/psb_dcgstabl.f90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_dfcg.F90
+1 -2
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -176,7 +176,6 @@ subroutine psb_dfcg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (present(itmax)) then
itmax_ = itmax
else
linsolve/impl/psb_dgcr.f90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_dkrylov.f90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_drgmres.f90
+1 -1
View File
@@ -18,7 +18,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_drichardson.f90
+3 -10
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -94,8 +94,8 @@ Subroutine psb_drichardson_vect(a,prec,b,x,eps,desc_a,info,&
type(psb_d_vect_type), allocatable, target :: wwrk(:)
type(psb_d_vect_type), pointer :: q, p, r, z, w
real(psb_dpk_) :: derr
integer(psb_ipk_) :: itmax_, istop_, it, itx, itrace_,&
& n_col, n_row,ieg,nspl, istebz
integer(psb_ipk_) :: itmax_, istop_, it, itx, itrace_,&
& n_col, n_row,ieg,nspl, istebz
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit
type(psb_itconv_type) :: stopdat
@@ -154,13 +154,6 @@ Subroutine psb_drichardson_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
call psb_errpush(info,name)
goto 9999
end if
p => wwrk(1)
q => wwrk(2)
r => wwrk(3)
linsolve/impl/psb_sbicg.f90
+3 -6
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -186,7 +186,8 @@ subroutine psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=9_psb_ipk_)
call psb_geall(wwrk,desc_a,info,n=9_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v)
if(info /= psb_success_) then
info=psb_err_from_subroutine_non_
@@ -312,10 +313,6 @@ subroutine psb_sbicg_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_scg.F90
+4 -7
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -113,7 +113,7 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,&
integer(psb_ipk_), Optional, Intent(out) :: iter
Real(psb_spk_), Optional, Intent(out) :: err,cond
! = Local data
real(psb_spk_), allocatable, target :: td(:),tu(:),eig(:),ewrk(:)
real(psb_spk_), allocatable, target ::td(:),tu(:),eig(:),ewrk(:)
integer(psb_mpk_), allocatable :: ibl(:), ispl(:), iwrk(:)
type(psb_s_vect_type), allocatable, target :: wwrk(:)
type(psb_s_vect_type), pointer :: q, p, r, z, w
@@ -171,7 +171,8 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
@@ -316,10 +317,6 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_scgs.f90
+2 -5
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -164,6 +164,7 @@ Subroutine psb_scgs_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=11_psb_ipk_)
if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v)
if (info /= psb_success_) Then
@@ -307,10 +308,6 @@ Subroutine psb_scgs_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_scgstab.f90
+2 -2
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -113,7 +113,7 @@ Subroutine psb_scgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
real(psb_spk_), allocatable, target :: wwrk(:,:)
type(psb_s_vect_type) :: q, r, p, v, s, t, z, f
integer(psb_ipk_) :: itmax_, it,itrace_,&
integer(psb_ipk_) :: itmax_, it, itrace_,&
& n_row, n_col
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit
linsolve/impl/psb_scgstabl.f90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_sfcg.F90
+1 -2
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -176,7 +176,6 @@ subroutine psb_sfcg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (present(itmax)) then
itmax_ = itmax
else
linsolve/impl/psb_sgcr.f90
+7 -3
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -222,9 +222,13 @@ subroutine psb_sgcr_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
endif
h = szero
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
call psb_errpush(info,name)
goto 9999
end if
call psb_geasb(r, desc_a,info, scratch=.true.,mold=x%v)
do i =1,nl+1
linsolve/impl/psb_skrylov.f90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_srgmres.f90
+1 -1
View File
@@ -18,7 +18,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_srichardson.f90
+1 -8
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -154,13 +154,6 @@ Subroutine psb_srichardson_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
call psb_errpush(info,name)
goto 9999
end if
p => wwrk(1)
q => wwrk(2)
r => wwrk(3)
linsolve/impl/psb_zbicg.f90
+2 -6
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -187,7 +187,7 @@ subroutine psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,&
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=9_psb_ipk_)
call psb_geall(wwrk,desc_a,info,n=9_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v)
if(info /= psb_success_) then
info=psb_err_from_subroutine_non_
@@ -313,10 +313,6 @@ subroutine psb_zbicg_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_zcg.F90
+4 -7
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -113,7 +113,7 @@ subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,&
integer(psb_ipk_), Optional, Intent(out) :: iter
Real(psb_dpk_), Optional, Intent(out) :: err,cond
! = Local data
complex(psb_dpk_), allocatable, target :: td(:),tu(:),eig(:),ewrk(:)
complex(psb_dpk_), allocatable, target ::td(:),tu(:),eig(:),ewrk(:)
integer(psb_mpk_), allocatable :: ibl(:), ispl(:), iwrk(:)
type(psb_z_vect_type), allocatable, target :: wwrk(:)
type(psb_z_vect_type), pointer :: q, p, r, z, w
@@ -171,7 +171,8 @@ subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
@@ -283,10 +284,6 @@ subroutine psb_zcg_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_zcgs.f90
+2 -5
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -164,6 +164,7 @@ Subroutine psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) Call psb_geall(wwrk,desc_a,info,n=11_psb_ipk_)
if (info == psb_success_) Call psb_geasb(wwrk,desc_a,info,mold=x%v)
if (info /= psb_success_) Then
@@ -307,10 +308,6 @@ Subroutine psb_zcgs_vect(a,prec,b,x,eps,desc_a,info,&
if (present(err)) err = derr
if (info == psb_success_) call psb_gefree(wwrk,desc_a,info)
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
linsolve/impl/psb_zcgstab.f90
+2 -3
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -113,7 +113,7 @@ Subroutine psb_zcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
complex(psb_dpk_), allocatable, target :: wwrk(:,:)
type(psb_z_vect_type) :: q, r, p, v, s, t, z, f
integer(psb_ipk_) :: itmax_, it,itrace_,&
integer(psb_ipk_) :: itmax_, it, itrace_,&
& n_row, n_col
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: debug_level, debug_unit
@@ -180,7 +180,6 @@ Subroutine psb_zcgstab_vect(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,ist
goto 9999
end if
call psb_geasb(q,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(r,desc_a,info,mold=x%v,scratch=.true.)
call psb_geasb(p,desc_a,info,mold=x%v,scratch=.true.)
linsolve/impl/psb_zcgstabl.f90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_zfcg.F90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_zgcr.f90
+6 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -223,6 +223,11 @@ subroutine psb_zgcr_vect(a,prec,b,x,eps,desc_a,info,&
endif
h = zzero
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
call psb_errpush(info,name)
goto 9999
end if
call psb_geasb(r, desc_a,info, scratch=.true.,mold=x%v)
linsolve/impl/psb_zkrylov.f90
+1 -1
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_zrgmres.f90
+1 -1
View File
@@ -18,7 +18,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
linsolve/impl/psb_zrichardson.f90
+1 -8
View File
@@ -14,7 +14,7 @@
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
! software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
@@ -154,13 +154,6 @@ Subroutine psb_zrichardson_vect(a,prec,b,x,eps,desc_a,info,&
goto 9999
end if
if (info == psb_success_) call psb_geall(wwrk,desc_a,info,n=5_psb_ipk_)
if (info == psb_success_) call psb_geasb(wwrk,desc_a,info,mold=x%v,scratch=.true.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_non_
call psb_errpush(info,name)
goto 9999
end if
p => wwrk(1)
q => wwrk(2)
r => wwrk(3)