From de705a3dc6602b475969ecdd7b462ce7ce771cdb Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 16 Jul 2010 15:43:34 +0000 Subject: [PATCH] psblas3: base/modules/psb_const_mod.F90 base/modules/psb_error_mod.F90 base/modules/psb_realloc_mod.F90 base/serial/f03/psb_c_base_mat_impl.f03 base/serial/f03/psb_c_coo_impl.f03 base/serial/f03/psb_c_csc_impl.f03 base/serial/f03/psb_c_csr_impl.f03 base/serial/f03/psb_c_mat_impl.f03 base/serial/f03/psb_d_base_mat_impl.f03 base/serial/f03/psb_d_coo_impl.f03 base/serial/f03/psb_d_csc_impl.f03 base/serial/f03/psb_d_csr_impl.f03 base/serial/f03/psb_d_mat_impl.f03 base/serial/f03/psb_s_base_mat_impl.f03 base/serial/f03/psb_s_coo_impl.f03 base/serial/f03/psb_s_csc_impl.f03 base/serial/f03/psb_s_csr_impl.f03 base/serial/f03/psb_s_mat_impl.f03 base/serial/f03/psb_z_base_mat_impl.f03 base/serial/f03/psb_z_coo_impl.f03 base/serial/f03/psb_z_csc_impl.f03 base/serial/f03/psb_z_csr_impl.f03 base/serial/f03/psb_z_mat_impl.f03 base/serial/psb_cnumbmm.f90 base/serial/psb_csymbmm.f90 base/serial/psb_dnumbmm.f90 base/serial/psb_dsymbmm.f90 base/serial/psb_snumbmm.f90 base/serial/psb_ssymbmm.f90 base/serial/psb_znumbmm.f90 base/serial/psb_zsymbmm.f90 test/serial/Makefile test/serial/d_matgen.f03 test/serial/psb_d_cxx_impl.f03 test/serial/psb_d_cxx_mat_mod.f03 New psb_err_invalid_mat_state_ and error message. Debug statements REMEMBER TO TAKE THEM OUT!! --- base/modules/psb_const_mod.F90 | 1 + base/modules/psb_error_mod.F90 | 2 + base/modules/psb_realloc_mod.F90 | 72 +++++------------ base/serial/f03/psb_c_base_mat_impl.f03 | 8 +- base/serial/f03/psb_c_coo_impl.f03 | 22 +++--- base/serial/f03/psb_c_csc_impl.f03 | 20 ++--- base/serial/f03/psb_c_csr_impl.f03 | 20 ++--- base/serial/f03/psb_c_mat_impl.f03 | 82 +++++++++---------- base/serial/f03/psb_d_base_mat_impl.f03 | 8 +- base/serial/f03/psb_d_coo_impl.f03 | 22 +++--- base/serial/f03/psb_d_csc_impl.f03 | 20 ++--- base/serial/f03/psb_d_csr_impl.f03 | 58 ++++++++------ base/serial/f03/psb_d_mat_impl.f03 | 101 +++++++++++++----------- base/serial/f03/psb_s_base_mat_impl.f03 | 8 +- base/serial/f03/psb_s_coo_impl.f03 | 22 +++--- base/serial/f03/psb_s_csc_impl.f03 | 20 ++--- base/serial/f03/psb_s_csr_impl.f03 | 20 ++--- base/serial/f03/psb_s_mat_impl.f03 | 82 +++++++++---------- base/serial/f03/psb_z_base_mat_impl.f03 | 8 +- base/serial/f03/psb_z_coo_impl.f03 | 22 +++--- base/serial/f03/psb_z_csc_impl.f03 | 20 ++--- base/serial/f03/psb_z_csr_impl.f03 | 20 ++--- base/serial/f03/psb_z_mat_impl.f03 | 82 +++++++++---------- base/serial/psb_cnumbmm.f90 | 4 +- base/serial/psb_csymbmm.f90 | 2 +- base/serial/psb_dnumbmm.f90 | 4 +- base/serial/psb_dsymbmm.f90 | 2 +- base/serial/psb_snumbmm.f90 | 4 +- base/serial/psb_ssymbmm.f90 | 2 +- base/serial/psb_znumbmm.f90 | 4 +- base/serial/psb_zsymbmm.f90 | 2 +- test/serial/Makefile | 4 +- test/serial/d_matgen.f03 | 3 + test/serial/psb_d_cxx_impl.f03 | 18 ++--- test/serial/psb_d_cxx_mat_mod.f03 | 12 +-- 35 files changed, 395 insertions(+), 406 deletions(-) diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index e4cd16a0..eb2f77cd 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -170,6 +170,7 @@ module psb_const_mod integer, parameter, public :: psb_err_many_optional_arg_=583 integer, parameter, public :: psb_err_spmat_invalid_state_=600 integer, parameter, public :: psb_err_missing_override_method_=700 + integer, parameter, public :: psb_err_invalid_mat_state_=1121 integer, parameter, public :: psb_err_invalid_cd_state_=1122 integer, parameter, public :: psb_err_invalid_a_and_cd_state_=1123 integer, parameter, public :: psb_err_context_error_=2010 diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index db4323b8..2ed7f948 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -428,6 +428,8 @@ contains write(psb_err_unit,& & '("Base class method ",a," called: the class for ",a," is missing an overriding implementation")')& & trim(r_name), trim(a_e_d) + case (psb_err_invalid_mat_state_) + write(psb_err_unit,'("Invalid state for sparse matrix")') case (psb_err_invalid_cd_state_) write(psb_err_unit,'("Invalid state for communication descriptor")') case (psb_err_invalid_a_and_cd_state_) diff --git a/base/modules/psb_realloc_mod.F90 b/base/modules/psb_realloc_mod.F90 index c7d68c00..afa1a128 100644 --- a/base/modules/psb_realloc_mod.F90 +++ b/base/modules/psb_realloc_mod.F90 @@ -2913,12 +2913,7 @@ Contains info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then call move_alloc(vin,vout) - else if (allocated(vout)) then -!!$ write(psb_err_unit,*) 'move_alloc: Clearing output' - deallocate(vout) - end if #else if (allocated(vout)) then @@ -2940,11 +2935,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) @@ -2968,12 +2961,7 @@ Contains info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then call move_alloc(vin,vout) - else if (allocated(vout)) then -!!$ write(psb_err_unit,*) 'move_alloc: Clearing output' - deallocate(vout) - end if #else if (allocated(vout)) then @@ -2995,11 +2983,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) @@ -3022,11 +3008,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) @@ -3047,11 +3031,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) @@ -3074,11 +3056,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) @@ -3099,11 +3079,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) @@ -3126,12 +3104,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then -!!$ write(psb_err_unit,*) 'move_alloc: Clearing output' - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) @@ -3152,11 +3127,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) @@ -3180,12 +3153,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then -!!$ write(psb_err_unit,*) 'move_alloc: Clearing output' - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) @@ -3206,11 +3176,9 @@ Contains ! info=psb_success_ #ifdef HAVE_MOVE_ALLOC - if (allocated(vin)) then + call move_alloc(vin,vout) - else if (allocated(vout)) then - deallocate(vout) - end if + #else if (allocated(vout)) then deallocate(vout,stat=info) diff --git a/base/serial/f03/psb_c_base_mat_impl.f03 b/base/serial/f03/psb_c_base_mat_impl.f03 index e9be8cab..91b30d35 100644 --- a/base/serial/f03/psb_c_base_mat_impl.f03 +++ b/base/serial/f03/psb_c_base_mat_impl.f03 @@ -689,7 +689,7 @@ subroutine psb_c_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -709,7 +709,7 @@ subroutine psb_c_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -825,7 +825,7 @@ subroutine psb_c_base_cssv(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -845,7 +845,7 @@ subroutine psb_c_base_cssv(alpha,a,x,beta,y,info,trans,scale,d) end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_c_coo_impl.f03 b/base/serial/f03/psb_c_coo_impl.f03 index b370ab21..8010f302 100644 --- a/base/serial/f03/psb_c_coo_impl.f03 +++ b/base/serial/f03/psb_c_coo_impl.f03 @@ -187,7 +187,7 @@ subroutine psb_c_coo_reinit(a,clear) if (clear_) a%val(:) = zzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -454,14 +454,14 @@ subroutine psb_c_coo_cssm(alpha,a,x,beta,y,info,trans) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -567,7 +567,7 @@ contains if (.not.sorted) then - info = 1121 + info = psb_err_invalid_mat_state_ return end if @@ -815,7 +815,7 @@ subroutine psb_c_coo_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -834,7 +834,7 @@ subroutine psb_c_coo_cssv(alpha,a,x,beta,y,info,trans) goto 9999 end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -912,7 +912,7 @@ contains info = psb_success_ if (.not.sorted) then - info = 1121 + info = psb_err_invalid_mat_state_ return end if @@ -1155,7 +1155,7 @@ subroutine psb_c_coo_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1353,7 +1353,7 @@ subroutine psb_c_coo_csmm(alpha,a,x,beta,y,info,trans) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -2212,12 +2212,12 @@ subroutine psb_c_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call c_coo_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) diff --git a/base/serial/f03/psb_c_csc_impl.f03 b/base/serial/f03/psb_c_csc_impl.f03 index d3ba85c7..34fbb342 100644 --- a/base/serial/f03/psb_c_csc_impl.f03 +++ b/base/serial/f03/psb_c_csc_impl.f03 @@ -40,7 +40,7 @@ subroutine psb_c_csc_csmv(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -456,7 +456,7 @@ subroutine psb_c_csc_csmm(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -878,7 +878,7 @@ subroutine psb_c_csc_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -889,7 +889,7 @@ subroutine psb_c_csc_cssv(alpha,a,x,beta,y,info,trans) m = a%get_nrows() if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1144,7 +1144,7 @@ subroutine psb_c_csc_cssm(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1170,7 +1170,7 @@ subroutine psb_c_csc_cssm(alpha,a,x,beta,y,info,trans) if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1998,7 +1998,7 @@ subroutine psb_c_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_bld()) then ! Build phase should only ever be in COO - info = 1121 + info = psb_err_invalid_mat_state_ else if (a%is_upd()) then call psb_c_csc_srch_upd(nz,ia,ja,val,a,& @@ -2006,12 +2006,12 @@ subroutine psb_c_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) @@ -2726,7 +2726,7 @@ subroutine psb_c_csc_reinit(a,clear) if (clear_) a%val(:) = czero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_c_csr_impl.f03 b/base/serial/f03/psb_c_csr_impl.f03 index 7d0a916d..fe8bd83a 100644 --- a/base/serial/f03/psb_c_csr_impl.f03 +++ b/base/serial/f03/psb_c_csr_impl.f03 @@ -41,7 +41,7 @@ subroutine psb_c_csr_csmv(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -387,7 +387,7 @@ subroutine psb_c_csr_csmm(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -735,7 +735,7 @@ subroutine psb_c_csr_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -745,7 +745,7 @@ subroutine psb_c_csr_cssv(alpha,a,x,beta,y,info,trans) m = a%get_nrows() if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1001,7 +1001,7 @@ subroutine psb_c_csr_cssm(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1014,7 +1014,7 @@ subroutine psb_c_csr_cssm(alpha,a,x,beta,y,info,trans) nc = min(size(x,2) , size(y,2)) if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1974,7 +1974,7 @@ subroutine psb_c_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_bld()) then ! Build phase should only ever be in COO - info = 1121 + info = psb_err_invalid_mat_state_ else if (a%is_upd()) then call psb_c_csr_srch_upd(nz,ia,ja,val,a,& @@ -1982,12 +1982,12 @@ subroutine psb_c_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) @@ -2237,7 +2237,7 @@ subroutine psb_c_csr_reinit(a,clear) if (clear_) a%val(:) = dzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_c_mat_impl.f03 b/base/serial/f03/psb_c_mat_impl.f03 index 0fa8bd66..8d78ace6 100644 --- a/base/serial/f03/psb_c_mat_impl.f03 +++ b/base/serial/f03/psb_c_mat_impl.f03 @@ -24,7 +24,7 @@ subroutine psb_c_set_nrows(m,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -58,7 +58,7 @@ subroutine psb_c_set_ncols(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -92,7 +92,7 @@ subroutine psb_c_set_state(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -126,7 +126,7 @@ subroutine psb_c_set_dupl(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -159,7 +159,7 @@ subroutine psb_c_set_null(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -192,7 +192,7 @@ subroutine psb_c_set_bld(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -224,7 +224,7 @@ subroutine psb_c_set_upd(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -257,7 +257,7 @@ subroutine psb_c_set_asb(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -290,7 +290,7 @@ subroutine psb_c_set_sorted(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -323,7 +323,7 @@ subroutine psb_c_set_triangle(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -356,7 +356,7 @@ subroutine psb_c_set_unit(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -389,7 +389,7 @@ subroutine psb_c_set_lower(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -422,7 +422,7 @@ subroutine psb_c_set_upper(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -476,7 +476,7 @@ subroutine psb_c_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) info = psb_success_ call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -516,7 +516,7 @@ subroutine psb_c_get_neigh(a,idx,neigh,n,info,lev) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -592,7 +592,7 @@ subroutine psb_c_reallocate_nz(nz,a) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -638,7 +638,7 @@ subroutine psb_c_trim(a) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -677,7 +677,7 @@ subroutine psb_c_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) info = psb_success_ call psb_erractionsave(err_act) if (.not.a%is_bld()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -726,7 +726,7 @@ subroutine psb_c_csgetptn(imin,imax,a,nz,ia,ja,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -777,7 +777,7 @@ subroutine psb_c_csgetrow(imin,imax,a,nz,ia,ja,val,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -830,7 +830,7 @@ subroutine psb_c_csgetblk(imin,imax,a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -881,7 +881,7 @@ subroutine psb_c_csclip(a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -928,7 +928,7 @@ subroutine psb_c_b_csclip(a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -975,7 +975,7 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1072,7 +1072,7 @@ subroutine psb_c_cscnv_ip(a,info,type,mold,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1166,7 +1166,7 @@ subroutine psb_c_cscnv_base(a,b,info,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1222,7 +1222,7 @@ subroutine psb_c_clip_d(a,b,info) info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1284,7 +1284,7 @@ subroutine psb_c_clip_d_ip(a,info) info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1474,7 +1474,7 @@ subroutine psb_c_transp_1mat(a) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1511,7 +1511,7 @@ subroutine psb_c_transp_2mat(a,b) call psb_erractionsave(err_act) if (b%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1551,7 +1551,7 @@ subroutine psb_c_transc_1mat(a) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1588,7 +1588,7 @@ subroutine psb_c_transc_2mat(a,b) call psb_erractionsave(err_act) if (b%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1628,7 +1628,7 @@ subroutine psb_c_reinit(a,clear) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1681,7 +1681,7 @@ subroutine psb_c_csmm(alpha,a,x,beta,y,info,trans) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1719,7 +1719,7 @@ subroutine psb_c_csmv(alpha,a,x,beta,y,info,trans) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1758,7 +1758,7 @@ subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1798,7 +1798,7 @@ subroutine psb_c_cssv(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1837,7 +1837,7 @@ function psb_c_csnmi(a) result(res) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1871,7 +1871,7 @@ subroutine psb_c_get_diag(a,d,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1909,7 +1909,7 @@ subroutine psb_c_scal(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1947,7 +1947,7 @@ subroutine psb_c_scals(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif diff --git a/base/serial/f03/psb_d_base_mat_impl.f03 b/base/serial/f03/psb_d_base_mat_impl.f03 index ad5845a6..dbbb5b43 100644 --- a/base/serial/f03/psb_d_base_mat_impl.f03 +++ b/base/serial/f03/psb_d_base_mat_impl.f03 @@ -689,7 +689,7 @@ subroutine psb_d_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -709,7 +709,7 @@ subroutine psb_d_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -825,7 +825,7 @@ subroutine psb_d_base_cssv(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -845,7 +845,7 @@ subroutine psb_d_base_cssv(alpha,a,x,beta,y,info,trans,scale,d) end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_d_coo_impl.f03 b/base/serial/f03/psb_d_coo_impl.f03 index 446df8bf..7184956b 100644 --- a/base/serial/f03/psb_d_coo_impl.f03 +++ b/base/serial/f03/psb_d_coo_impl.f03 @@ -187,7 +187,7 @@ subroutine psb_d_coo_reinit(a,clear) if (clear_) a%val(:) = dzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -454,14 +454,14 @@ subroutine psb_d_coo_cssm(alpha,a,x,beta,y,info,trans) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -566,7 +566,7 @@ contains if (.not.sorted) then - info = 1121 + info = psb_err_invalid_mat_state_ return end if @@ -745,7 +745,7 @@ subroutine psb_d_coo_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -763,7 +763,7 @@ subroutine psb_d_coo_cssv(alpha,a,x,beta,y,info,trans) goto 9999 end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -841,7 +841,7 @@ contains info = psb_success_ if (.not.sorted) then - info = 1121 + info = psb_err_invalid_mat_state_ return end if @@ -1015,7 +1015,7 @@ subroutine psb_d_coo_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1183,7 +1183,7 @@ subroutine psb_d_coo_csmm(alpha,a,x,beta,y,info,trans) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -2259,12 +2259,12 @@ subroutine psb_d_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call d_coo_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) diff --git a/base/serial/f03/psb_d_csc_impl.f03 b/base/serial/f03/psb_d_csc_impl.f03 index cbe998ff..5553b0d5 100644 --- a/base/serial/f03/psb_d_csc_impl.f03 +++ b/base/serial/f03/psb_d_csc_impl.f03 @@ -41,7 +41,7 @@ subroutine psb_d_csc_csmv(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -319,7 +319,7 @@ subroutine psb_d_csc_csmm(alpha,a,x,beta,y,info,trans) tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -601,7 +601,7 @@ subroutine psb_d_csc_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -610,7 +610,7 @@ subroutine psb_d_csc_cssv(alpha,a,x,beta,y,info,trans) m = a%get_nrows() if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -822,7 +822,7 @@ subroutine psb_d_csc_cssm(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -846,7 +846,7 @@ subroutine psb_d_csc_cssm(alpha,a,x,beta,y,info,trans) nc = min(size(x,2) , size(y,2)) if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1871,7 +1871,7 @@ subroutine psb_d_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_bld()) then ! Build phase should only ever be in COO - info = 1121 + info = psb_err_invalid_mat_state_ else if (a%is_upd()) then call psb_d_csc_srch_upd(nz,ia,ja,val,a,& @@ -1879,12 +1879,12 @@ subroutine psb_d_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) @@ -2599,7 +2599,7 @@ subroutine psb_d_csc_reinit(a,clear) if (clear_) a%val(:) = dzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_d_csr_impl.f03 b/base/serial/f03/psb_d_csr_impl.f03 index 508680b2..caad45b0 100644 --- a/base/serial/f03/psb_d_csr_impl.f03 +++ b/base/serial/f03/psb_d_csr_impl.f03 @@ -41,7 +41,7 @@ subroutine psb_d_csr_csmv(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -339,7 +339,7 @@ subroutine psb_d_csr_csmm(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -640,7 +640,7 @@ subroutine psb_d_csr_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -649,7 +649,7 @@ subroutine psb_d_csr_cssv(alpha,a,x,beta,y,info,trans) m = a%get_nrows() if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -857,7 +857,7 @@ subroutine psb_d_csr_cssm(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -869,7 +869,7 @@ subroutine psb_d_csr_cssm(alpha,a,x,beta,y,info,trans) nc = min(size(x,2) , size(y,2)) if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -2024,7 +2024,7 @@ subroutine psb_d_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_bld()) then ! Build phase should only ever be in COO - info = 1121 + info = psb_err_invalid_mat_state_ else if (a%is_upd()) then call psb_d_csr_srch_upd(nz,ia,ja,val,a,& @@ -2032,12 +2032,12 @@ subroutine psb_d_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) @@ -2287,7 +2287,7 @@ subroutine psb_d_csr_reinit(a,clear) if (clear_) a%val(:) = dzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -2442,10 +2442,12 @@ subroutine psb_d_cp_csr_from_coo(a,b,info) integer :: debug_level, debug_unit character(len=20) :: name - info = psb_success_ - ! This is to have fix_coo called behind the scenes - call tmp%cp_from_coo(b,info) - if (info == psb_success_) call a%mv_from_coo(tmp,info) + info = psb_success_ + ! This is to have fix_coo called behind the scenes + write(0,*) 'In cp_from_coo: ',allocated(a%irp),allocated(a%ja),allocated(a%val) + + call tmp%cp_from_coo(b,info) + if (info == psb_success_) call a%mv_from_coo(tmp,info) end subroutine psb_d_cp_csr_from_coo @@ -2556,23 +2558,28 @@ subroutine psb_d_mv_csr_from_coo(a,b,info) character(len=20) :: name info = psb_success_ + write(0,*) 'In mv_from_coo 1 : ',allocated(a%irp),allocated(a%ja),allocated(a%val) call b%fix(info) if (info /= psb_success_) return - + write(0,*) 'In mv_from_coo 2 : ',allocated(a%irp),allocated(a%ja),allocated(a%val) nr = b%get_nrows() nc = b%get_ncols() nza = b%get_nzeros() - + write(0,*) 'In mv_from_coo 3 : ',allocated(a%irp),allocated(a%ja),allocated(a%val) call a%psb_d_base_sparse_mat%mv_from(b%psb_d_base_sparse_mat) - + write(0,*) 'In mv_from_coo 4 : ',allocated(a%irp),allocated(a%ja),allocated(a%val) ! Dirty trick: call move_alloc to have the new data allocated just once. + write(psb_err_unit,*) 'itemp ',allocated(itemp),& + & ' a%ja ', allocated(a%ja),& + & ' a%val ', allocated(a%val) call move_alloc(b%ia,itemp) call move_alloc(b%ja,a%ja) call move_alloc(b%val,a%val) call psb_realloc(max(nr+1,nc+1),a%irp,info) + call b%free() - + if (info /= psb_success_) return if (nza <= 0) then a%irp(:) = 1 else @@ -2667,6 +2674,7 @@ end subroutine psb_d_mv_csr_to_fmt subroutine psb_d_cp_csr_to_fmt(a,b,info) use psb_const_mod + use psb_realloc_mod use psb_d_base_mat_mod use psb_d_csr_mat_mod, psb_protect_name => psb_d_cp_csr_to_fmt implicit none @@ -2692,9 +2700,9 @@ subroutine psb_d_cp_csr_to_fmt(a,b,info) type is (psb_d_csr_sparse_mat) call b%psb_d_base_sparse_mat%cp_from(a%psb_d_base_sparse_mat) - b%irp = a%irp - b%ja = a%ja - b%val = a%val + call psb_safe_cpy( a%irp, b%irp , info) + call psb_safe_cpy( a%ja , b%ja , info) + call psb_safe_cpy( a%val, b%val , info) class default call tmp%cp_from_fmt(a,info) @@ -2746,6 +2754,7 @@ end subroutine psb_d_mv_csr_from_fmt subroutine psb_d_cp_csr_from_fmt(a,b,info) use psb_const_mod + use psb_realloc_mod use psb_d_base_mat_mod use psb_d_csr_mat_mod, psb_protect_name => psb_d_cp_csr_from_fmt implicit none @@ -2764,15 +2773,16 @@ subroutine psb_d_cp_csr_from_fmt(a,b,info) info = psb_success_ + write(0,*) 'In cp_from_fmt: ',allocated(a%irp),allocated(a%ja),allocated(a%val) select type (b) type is (psb_d_coo_sparse_mat) call a%cp_from_coo(b,info) type is (psb_d_csr_sparse_mat) call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat) - a%irp = b%irp - a%ja = b%ja - a%val = b%val + call psb_safe_cpy( b%irp, a%irp , info) + call psb_safe_cpy( b%ja , a%ja , info) + call psb_safe_cpy( b%val, a%val , info) class default call tmp%cp_from_fmt(b,info) diff --git a/base/serial/f03/psb_d_mat_impl.f03 b/base/serial/f03/psb_d_mat_impl.f03 index 9105389d..0db620dd 100644 --- a/base/serial/f03/psb_d_mat_impl.f03 +++ b/base/serial/f03/psb_d_mat_impl.f03 @@ -24,7 +24,7 @@ subroutine psb_d_set_nrows(m,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -58,7 +58,7 @@ subroutine psb_d_set_ncols(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -92,7 +92,7 @@ subroutine psb_d_set_state(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -126,7 +126,7 @@ subroutine psb_d_set_dupl(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -159,7 +159,7 @@ subroutine psb_d_set_null(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -192,7 +192,7 @@ subroutine psb_d_set_bld(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -224,7 +224,7 @@ subroutine psb_d_set_upd(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -257,7 +257,7 @@ subroutine psb_d_set_asb(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -290,7 +290,7 @@ subroutine psb_d_set_sorted(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -323,7 +323,7 @@ subroutine psb_d_set_triangle(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -356,7 +356,7 @@ subroutine psb_d_set_unit(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -389,7 +389,7 @@ subroutine psb_d_set_lower(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -422,7 +422,7 @@ subroutine psb_d_set_upper(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -476,7 +476,7 @@ subroutine psb_d_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) info = psb_success_ call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -516,7 +516,7 @@ subroutine psb_d_get_neigh(a,idx,neigh,n,info,lev) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -592,7 +592,7 @@ subroutine psb_d_reallocate_nz(nz,a) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -638,7 +638,7 @@ subroutine psb_d_trim(a) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -677,7 +677,7 @@ subroutine psb_d_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) info = psb_success_ call psb_erractionsave(err_act) if (.not.a%is_bld()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -726,7 +726,7 @@ subroutine psb_d_csgetptn(imin,imax,a,nz,ia,ja,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -777,7 +777,7 @@ subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -830,7 +830,7 @@ subroutine psb_d_csgetblk(imin,imax,a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -881,7 +881,7 @@ subroutine psb_d_csclip(a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -928,7 +928,7 @@ subroutine psb_d_b_csclip(a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -975,7 +975,7 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1072,7 +1072,7 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1119,8 +1119,13 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl) if (debug) write(psb_err_unit,*) 'Converting in-place from ',& & a%get_fmt(),' to ',altmp%get_fmt() - - call altmp%mv_from_fmt(a%a, info) +!!$ select type(aa=>altmp) +!!$ type is (psb_d_csr_sparse_mat) +!!$ write(psb_err_unit,*) 'From ALTMP allocation: aa%irp ',allocated(aa%irp),& +!!$ & ' aa%ja ', allocated(aa%ja),& +!!$ & ' aa%val ', allocated(aa%val) +!!$ end select + call altmp%cp_from_fmt(a%a, info) if (info /= psb_success_) then info = psb_err_from_subroutine_ @@ -1166,7 +1171,7 @@ subroutine psb_d_cscnv_base(a,b,info,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1222,7 +1227,7 @@ subroutine psb_d_clip_d(a,b,info) info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1284,7 +1289,7 @@ subroutine psb_d_clip_d_ip(a,info) info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1474,7 +1479,7 @@ subroutine psb_d_transp_1mat(a) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1511,7 +1516,7 @@ subroutine psb_d_transp_2mat(a,b) call psb_erractionsave(err_act) if (b%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1551,7 +1556,7 @@ subroutine psb_d_transc_1mat(a) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1588,7 +1593,7 @@ subroutine psb_d_transc_2mat(a,b) call psb_erractionsave(err_act) if (b%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1628,7 +1633,7 @@ subroutine psb_d_reinit(a,clear) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1681,7 +1686,7 @@ subroutine psb_d_csmm(alpha,a,x,beta,y,info,trans) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1719,7 +1724,7 @@ subroutine psb_d_csmv(alpha,a,x,beta,y,info,trans) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1758,7 +1763,7 @@ subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1798,7 +1803,7 @@ subroutine psb_d_cssv(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1837,7 +1842,7 @@ function psb_d_csnmi(a) result(res) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1870,7 +1875,7 @@ function psb_d_csnm1(a) result(res) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1904,7 +1909,7 @@ subroutine psb_d_rowsum(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1941,7 +1946,7 @@ subroutine psb_d_arwsum(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1978,7 +1983,7 @@ subroutine psb_d_colsum(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -2015,7 +2020,7 @@ subroutine psb_d_aclsum(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -2052,7 +2057,7 @@ subroutine psb_d_get_diag(a,d,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -2090,7 +2095,7 @@ subroutine psb_d_scal(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -2128,7 +2133,7 @@ subroutine psb_d_scals(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif diff --git a/base/serial/f03/psb_s_base_mat_impl.f03 b/base/serial/f03/psb_s_base_mat_impl.f03 index e17c7645..a7b31ffc 100644 --- a/base/serial/f03/psb_s_base_mat_impl.f03 +++ b/base/serial/f03/psb_s_base_mat_impl.f03 @@ -689,7 +689,7 @@ subroutine psb_s_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -709,7 +709,7 @@ subroutine psb_s_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -825,7 +825,7 @@ subroutine psb_s_base_cssv(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -845,7 +845,7 @@ subroutine psb_s_base_cssv(alpha,a,x,beta,y,info,trans,scale,d) end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_s_coo_impl.f03 b/base/serial/f03/psb_s_coo_impl.f03 index fd826d11..03ee681b 100644 --- a/base/serial/f03/psb_s_coo_impl.f03 +++ b/base/serial/f03/psb_s_coo_impl.f03 @@ -187,7 +187,7 @@ subroutine psb_s_coo_reinit(a,clear) if (clear_) a%val(:) = szero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -454,14 +454,14 @@ subroutine psb_s_coo_cssm(alpha,a,x,beta,y,info,trans) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -566,7 +566,7 @@ contains if (.not.sorted) then - info = 1121 + info = psb_err_invalid_mat_state_ return end if @@ -745,7 +745,7 @@ subroutine psb_s_coo_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -763,7 +763,7 @@ subroutine psb_s_coo_cssv(alpha,a,x,beta,y,info,trans) goto 9999 end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -841,7 +841,7 @@ contains info = psb_success_ if (.not.sorted) then - info = 1121 + info = psb_err_invalid_mat_state_ return end if @@ -1015,7 +1015,7 @@ subroutine psb_s_coo_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1183,7 +1183,7 @@ subroutine psb_s_coo_csmm(alpha,a,x,beta,y,info,trans) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -2012,12 +2012,12 @@ subroutine psb_s_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call s_coo_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) diff --git a/base/serial/f03/psb_s_csc_impl.f03 b/base/serial/f03/psb_s_csc_impl.f03 index 87f6c3d2..d1550f31 100644 --- a/base/serial/f03/psb_s_csc_impl.f03 +++ b/base/serial/f03/psb_s_csc_impl.f03 @@ -41,7 +41,7 @@ subroutine psb_s_csc_csmv(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -319,7 +319,7 @@ subroutine psb_s_csc_csmm(alpha,a,x,beta,y,info,trans) tra = (psb_toupper(trans_) == 'T').or.(psb_toupper(trans_)=='C') if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -601,7 +601,7 @@ subroutine psb_s_csc_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -610,7 +610,7 @@ subroutine psb_s_csc_cssv(alpha,a,x,beta,y,info,trans) m = a%get_nrows() if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -823,7 +823,7 @@ subroutine psb_s_csc_cssm(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -847,7 +847,7 @@ subroutine psb_s_csc_cssm(alpha,a,x,beta,y,info,trans) nc = min(size(x,2) , size(y,2)) if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1636,7 +1636,7 @@ subroutine psb_s_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_bld()) then ! Build phase should only ever be in COO - info = 1121 + info = psb_err_invalid_mat_state_ else if (a%is_upd()) then call psb_s_csc_srch_upd(nz,ia,ja,val,a,& @@ -1644,12 +1644,12 @@ subroutine psb_s_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) @@ -2364,7 +2364,7 @@ subroutine psb_s_csc_reinit(a,clear) if (clear_) a%val(:) = dzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_s_csr_impl.f03 b/base/serial/f03/psb_s_csr_impl.f03 index c1ed05e5..ce1c72eb 100644 --- a/base/serial/f03/psb_s_csr_impl.f03 +++ b/base/serial/f03/psb_s_csr_impl.f03 @@ -41,7 +41,7 @@ subroutine psb_s_csr_csmv(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -339,7 +339,7 @@ subroutine psb_s_csr_csmm(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -640,7 +640,7 @@ subroutine psb_s_csr_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -649,7 +649,7 @@ subroutine psb_s_csr_cssv(alpha,a,x,beta,y,info,trans) m = a%get_nrows() if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -857,7 +857,7 @@ subroutine psb_s_csr_cssm(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -869,7 +869,7 @@ subroutine psb_s_csr_cssm(alpha,a,x,beta,y,info,trans) nc = min(size(x,2) , size(y,2)) if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1782,7 +1782,7 @@ subroutine psb_s_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_bld()) then ! Build phase should only ever be in COO - info = 1121 + info = psb_err_invalid_mat_state_ else if (a%is_upd()) then call psb_s_csr_srch_upd(nz,ia,ja,val,a,& @@ -1790,12 +1790,12 @@ subroutine psb_s_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) @@ -2045,7 +2045,7 @@ subroutine psb_s_csr_reinit(a,clear) if (clear_) a%val(:) = dzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_s_mat_impl.f03 b/base/serial/f03/psb_s_mat_impl.f03 index 618f31ee..25b54d35 100644 --- a/base/serial/f03/psb_s_mat_impl.f03 +++ b/base/serial/f03/psb_s_mat_impl.f03 @@ -24,7 +24,7 @@ subroutine psb_s_set_nrows(m,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -58,7 +58,7 @@ subroutine psb_s_set_ncols(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -92,7 +92,7 @@ subroutine psb_s_set_state(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -126,7 +126,7 @@ subroutine psb_s_set_dupl(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -159,7 +159,7 @@ subroutine psb_s_set_null(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -192,7 +192,7 @@ subroutine psb_s_set_bld(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -224,7 +224,7 @@ subroutine psb_s_set_upd(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -257,7 +257,7 @@ subroutine psb_s_set_asb(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -290,7 +290,7 @@ subroutine psb_s_set_sorted(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -323,7 +323,7 @@ subroutine psb_s_set_triangle(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -356,7 +356,7 @@ subroutine psb_s_set_unit(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -389,7 +389,7 @@ subroutine psb_s_set_lower(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -422,7 +422,7 @@ subroutine psb_s_set_upper(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -476,7 +476,7 @@ subroutine psb_s_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) info = psb_success_ call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -516,7 +516,7 @@ subroutine psb_s_get_neigh(a,idx,neigh,n,info,lev) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -592,7 +592,7 @@ subroutine psb_s_reallocate_nz(nz,a) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -639,7 +639,7 @@ subroutine psb_s_trim(a) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -678,7 +678,7 @@ subroutine psb_s_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) info = psb_success_ call psb_erractionsave(err_act) if (.not.a%is_bld()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -727,7 +727,7 @@ subroutine psb_s_csgetptn(imin,imax,a,nz,ia,ja,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -778,7 +778,7 @@ subroutine psb_s_csgetrow(imin,imax,a,nz,ia,ja,val,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -831,7 +831,7 @@ subroutine psb_s_csgetblk(imin,imax,a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -882,7 +882,7 @@ subroutine psb_s_csclip(a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -929,7 +929,7 @@ subroutine psb_s_b_csclip(a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -976,7 +976,7 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1073,7 +1073,7 @@ subroutine psb_s_cscnv_ip(a,info,type,mold,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1167,7 +1167,7 @@ subroutine psb_s_cscnv_base(a,b,info,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1223,7 +1223,7 @@ subroutine psb_s_clip_d(a,b,info) info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1285,7 +1285,7 @@ subroutine psb_s_clip_d_ip(a,info) info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1475,7 +1475,7 @@ subroutine psb_s_transp_1mat(a) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1512,7 +1512,7 @@ subroutine psb_s_transp_2mat(a,b) call psb_erractionsave(err_act) if (b%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1552,7 +1552,7 @@ subroutine psb_s_transc_1mat(a) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1589,7 +1589,7 @@ subroutine psb_s_transc_2mat(a,b) call psb_erractionsave(err_act) if (b%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1629,7 +1629,7 @@ subroutine psb_s_reinit(a,clear) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1682,7 +1682,7 @@ subroutine psb_s_csmm(alpha,a,x,beta,y,info,trans) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1720,7 +1720,7 @@ subroutine psb_s_csmv(alpha,a,x,beta,y,info,trans) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1759,7 +1759,7 @@ subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1799,7 +1799,7 @@ subroutine psb_s_cssv(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1838,7 +1838,7 @@ function psb_s_csnmi(a) result(res) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1872,7 +1872,7 @@ subroutine psb_s_get_diag(a,d,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1910,7 +1910,7 @@ subroutine psb_s_scal(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1948,7 +1948,7 @@ subroutine psb_s_scals(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif diff --git a/base/serial/f03/psb_z_base_mat_impl.f03 b/base/serial/f03/psb_z_base_mat_impl.f03 index 7a8403ba..f6cd267e 100644 --- a/base/serial/f03/psb_z_base_mat_impl.f03 +++ b/base/serial/f03/psb_z_base_mat_impl.f03 @@ -689,7 +689,7 @@ subroutine psb_z_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -709,7 +709,7 @@ subroutine psb_z_base_cssm(alpha,a,x,beta,y,info,trans,scale,d) end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -825,7 +825,7 @@ subroutine psb_z_base_cssv(alpha,a,x,beta,y,info,trans,scale,d) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -845,7 +845,7 @@ subroutine psb_z_base_cssv(alpha,a,x,beta,y,info,trans,scale,d) end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_z_coo_impl.f03 b/base/serial/f03/psb_z_coo_impl.f03 index 22637654..ede643f4 100644 --- a/base/serial/f03/psb_z_coo_impl.f03 +++ b/base/serial/f03/psb_z_coo_impl.f03 @@ -187,7 +187,7 @@ subroutine psb_z_coo_reinit(a,clear) if (clear_) a%val(:) = zzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -454,14 +454,14 @@ subroutine psb_z_coo_cssm(alpha,a,x,beta,y,info,trans) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -567,7 +567,7 @@ contains if (.not.sorted) then - info = 1121 + info = psb_err_invalid_mat_state_ return end if @@ -815,7 +815,7 @@ subroutine psb_z_coo_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -834,7 +834,7 @@ subroutine psb_z_coo_cssv(alpha,a,x,beta,y,info,trans) goto 9999 end if if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -912,7 +912,7 @@ contains info = psb_success_ if (.not.sorted) then - info = 1121 + info = psb_err_invalid_mat_state_ return end if @@ -1155,7 +1155,7 @@ subroutine psb_z_coo_csmv(alpha,a,x,beta,y,info,trans) call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1353,7 +1353,7 @@ subroutine psb_z_coo_csmm(alpha,a,x,beta,y,info,trans) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -2212,12 +2212,12 @@ subroutine psb_z_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call z_coo_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) diff --git a/base/serial/f03/psb_z_csc_impl.f03 b/base/serial/f03/psb_z_csc_impl.f03 index 33a273f0..dab4af3e 100644 --- a/base/serial/f03/psb_z_csc_impl.f03 +++ b/base/serial/f03/psb_z_csc_impl.f03 @@ -41,7 +41,7 @@ subroutine psb_z_csc_csmv(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -457,7 +457,7 @@ subroutine psb_z_csc_csmm(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -879,7 +879,7 @@ subroutine psb_z_csc_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -890,7 +890,7 @@ subroutine psb_z_csc_cssv(alpha,a,x,beta,y,info,trans) m = a%get_nrows() if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1145,7 +1145,7 @@ subroutine psb_z_csc_cssm(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1171,7 +1171,7 @@ subroutine psb_z_csc_cssm(alpha,a,x,beta,y,info,trans) if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1999,7 +1999,7 @@ subroutine psb_z_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_bld()) then ! Build phase should only ever be in COO - info = 1121 + info = psb_err_invalid_mat_state_ else if (a%is_upd()) then call psb_z_csc_srch_upd(nz,ia,ja,val,a,& @@ -2007,12 +2007,12 @@ subroutine psb_z_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) @@ -2727,7 +2727,7 @@ subroutine psb_z_csc_reinit(a,clear) if (clear_) a%val(:) = zzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_z_csr_impl.f03 b/base/serial/f03/psb_z_csr_impl.f03 index bd2931ce..5abf4112 100644 --- a/base/serial/f03/psb_z_csr_impl.f03 +++ b/base/serial/f03/psb_z_csr_impl.f03 @@ -41,7 +41,7 @@ subroutine psb_z_csr_csmv(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -387,7 +387,7 @@ subroutine psb_z_csr_csmm(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -735,7 +735,7 @@ subroutine psb_z_csr_cssv(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -745,7 +745,7 @@ subroutine psb_z_csr_cssv(alpha,a,x,beta,y,info,trans) m = a%get_nrows() if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1001,7 +1001,7 @@ subroutine psb_z_csr_cssm(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1014,7 +1014,7 @@ subroutine psb_z_csr_cssm(alpha,a,x,beta,y,info,trans) nc = min(size(x,2) , size(y,2)) if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1974,7 +1974,7 @@ subroutine psb_z_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_bld()) then ! Build phase should only ever be in COO - info = 1121 + info = psb_err_invalid_mat_state_ else if (a%is_upd()) then call psb_z_csr_srch_upd(nz,ia,ja,val,a,& @@ -1982,12 +1982,12 @@ subroutine psb_z_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) @@ -2237,7 +2237,7 @@ subroutine psb_z_csr_reinit(a,clear) if (clear_) a%val(:) = dzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if diff --git a/base/serial/f03/psb_z_mat_impl.f03 b/base/serial/f03/psb_z_mat_impl.f03 index 5eeaab74..21192f26 100644 --- a/base/serial/f03/psb_z_mat_impl.f03 +++ b/base/serial/f03/psb_z_mat_impl.f03 @@ -24,7 +24,7 @@ subroutine psb_z_set_nrows(m,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -58,7 +58,7 @@ subroutine psb_z_set_ncols(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -92,7 +92,7 @@ subroutine psb_z_set_state(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -126,7 +126,7 @@ subroutine psb_z_set_dupl(n,a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -159,7 +159,7 @@ subroutine psb_z_set_null(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -192,7 +192,7 @@ subroutine psb_z_set_bld(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -224,7 +224,7 @@ subroutine psb_z_set_upd(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -257,7 +257,7 @@ subroutine psb_z_set_asb(a) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -290,7 +290,7 @@ subroutine psb_z_set_sorted(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -323,7 +323,7 @@ subroutine psb_z_set_triangle(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -356,7 +356,7 @@ subroutine psb_z_set_unit(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -389,7 +389,7 @@ subroutine psb_z_set_lower(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -422,7 +422,7 @@ subroutine psb_z_set_upper(a,val) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -476,7 +476,7 @@ subroutine psb_z_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) info = psb_success_ call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -516,7 +516,7 @@ subroutine psb_z_get_neigh(a,idx,neigh,n,info,lev) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -592,7 +592,7 @@ subroutine psb_z_reallocate_nz(nz,a) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -638,7 +638,7 @@ subroutine psb_z_trim(a) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -677,7 +677,7 @@ subroutine psb_z_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) info = psb_success_ call psb_erractionsave(err_act) if (.not.a%is_bld()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -726,7 +726,7 @@ subroutine psb_z_csgetptn(imin,imax,a,nz,ia,ja,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -777,7 +777,7 @@ subroutine psb_z_csgetrow(imin,imax,a,nz,ia,ja,val,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -830,7 +830,7 @@ subroutine psb_z_csgetblk(imin,imax,a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -881,7 +881,7 @@ subroutine psb_z_csclip(a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -928,7 +928,7 @@ subroutine psb_z_b_csclip(a,b,info,& info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -975,7 +975,7 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1072,7 +1072,7 @@ subroutine psb_z_cscnv_ip(a,info,type,mold,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1166,7 +1166,7 @@ subroutine psb_z_cscnv_base(a,b,info,dupl) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1222,7 +1222,7 @@ subroutine psb_z_clip_d(a,b,info) info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1284,7 +1284,7 @@ subroutine psb_z_clip_d_ip(a,info) info = psb_success_ call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1474,7 +1474,7 @@ subroutine psb_z_transp_1mat(a) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1511,7 +1511,7 @@ subroutine psb_z_transp_2mat(a,b) call psb_erractionsave(err_act) if (b%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1551,7 +1551,7 @@ subroutine psb_z_transc_1mat(a) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1588,7 +1588,7 @@ subroutine psb_z_transc_2mat(a,b) call psb_erractionsave(err_act) if (b%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1628,7 +1628,7 @@ subroutine psb_z_reinit(a,clear) call psb_erractionsave(err_act) if (a%is_null()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1681,7 +1681,7 @@ subroutine psb_z_csmm(alpha,a,x,beta,y,info,trans) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1719,7 +1719,7 @@ subroutine psb_z_csmv(alpha,a,x,beta,y,info,trans) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1758,7 +1758,7 @@ subroutine psb_z_cssm(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1798,7 +1798,7 @@ subroutine psb_z_cssv(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1837,7 +1837,7 @@ function psb_z_csnmi(a) result(res) call psb_get_erraction(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1871,7 +1871,7 @@ subroutine psb_z_get_diag(a,d,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1909,7 +1909,7 @@ subroutine psb_z_scal(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1947,7 +1947,7 @@ subroutine psb_z_scals(d,a,info) call psb_erractionsave(err_act) if (.not.allocated(a%a)) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif diff --git a/base/serial/psb_cnumbmm.f90 b/base/serial/psb_cnumbmm.f90 index 2769fc0d..22417c2b 100644 --- a/base/serial/psb_cnumbmm.f90 +++ b/base/serial/psb_cnumbmm.f90 @@ -54,7 +54,7 @@ subroutine psb_cnumbmm(a,b,c) info = psb_success_ if ((a%is_null()) .or.(b%is_null()).or.(c%is_null())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -63,7 +63,7 @@ subroutine psb_cnumbmm(a,b,c) type is (psb_c_csr_sparse_mat) call psb_numbmm(a%a,b%a,aa) class default - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end select diff --git a/base/serial/psb_csymbmm.f90 b/base/serial/psb_csymbmm.f90 index 15ef8cbf..93420a6e 100644 --- a/base/serial/psb_csymbmm.f90 +++ b/base/serial/psb_csymbmm.f90 @@ -53,7 +53,7 @@ subroutine psb_csymbmm(a,b,c,info) info = psb_success_ if ((a%is_null()) .or.(b%is_null())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif diff --git a/base/serial/psb_dnumbmm.f90 b/base/serial/psb_dnumbmm.f90 index 55ec1215..15fa06cf 100644 --- a/base/serial/psb_dnumbmm.f90 +++ b/base/serial/psb_dnumbmm.f90 @@ -54,7 +54,7 @@ subroutine psb_dnumbmm(a,b,c) info = psb_success_ if ((a%is_null()) .or.(b%is_null()).or.(c%is_null())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -63,7 +63,7 @@ subroutine psb_dnumbmm(a,b,c) type is (psb_d_csr_sparse_mat) call psb_numbmm(a%a,b%a,aa) class default - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end select diff --git a/base/serial/psb_dsymbmm.f90 b/base/serial/psb_dsymbmm.f90 index a0a6290c..435c9d02 100644 --- a/base/serial/psb_dsymbmm.f90 +++ b/base/serial/psb_dsymbmm.f90 @@ -53,7 +53,7 @@ subroutine psb_dsymbmm(a,b,c,info) info = psb_success_ if ((a%is_null()) .or.(b%is_null())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif diff --git a/base/serial/psb_snumbmm.f90 b/base/serial/psb_snumbmm.f90 index 128db590..117f7697 100644 --- a/base/serial/psb_snumbmm.f90 +++ b/base/serial/psb_snumbmm.f90 @@ -54,7 +54,7 @@ subroutine psb_snumbmm(a,b,c) info = psb_success_ if ((a%is_null()) .or.(b%is_null()).or.(c%is_null())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -63,7 +63,7 @@ subroutine psb_snumbmm(a,b,c) type is (psb_s_csr_sparse_mat) call psb_numbmm(a%a,b%a,aa) class default - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end select diff --git a/base/serial/psb_ssymbmm.f90 b/base/serial/psb_ssymbmm.f90 index 9f79ea83..d73806dc 100644 --- a/base/serial/psb_ssymbmm.f90 +++ b/base/serial/psb_ssymbmm.f90 @@ -53,7 +53,7 @@ subroutine psb_ssymbmm(a,b,c,info) info = psb_success_ if ((a%is_null()) .or.(b%is_null())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif diff --git a/base/serial/psb_znumbmm.f90 b/base/serial/psb_znumbmm.f90 index 3e4742bc..717055d5 100644 --- a/base/serial/psb_znumbmm.f90 +++ b/base/serial/psb_znumbmm.f90 @@ -54,7 +54,7 @@ subroutine psb_znumbmm(a,b,c) info = psb_success_ if ((a%is_null()) .or.(b%is_null()).or.(c%is_null())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -63,7 +63,7 @@ subroutine psb_znumbmm(a,b,c) type is (psb_z_csr_sparse_mat) call psb_numbmm(a%a,b%a,aa) class default - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end select diff --git a/base/serial/psb_zsymbmm.f90 b/base/serial/psb_zsymbmm.f90 index fb9eb1f8..6bf56802 100644 --- a/base/serial/psb_zsymbmm.f90 +++ b/base/serial/psb_zsymbmm.f90 @@ -53,7 +53,7 @@ subroutine psb_zsymbmm(a,b,c,info) info = psb_success_ if ((a%is_null()) .or.(b%is_null())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif diff --git a/test/serial/Makefile b/test/serial/Makefile index 52c8f304..f1faa379 100644 --- a/test/serial/Makefile +++ b/test/serial/Makefile @@ -17,10 +17,10 @@ EXEDIR=./runs all: d_coo_matgen d_matgen d_coo_matgen: d_coo_matgen.o - $(F90LINK) d_coo_matgen.o -o d_coo_matgen $(PSBLAS_LIB) $(LDLIBS) + $(F90LINK) $(LINKOPT) d_coo_matgen.o -o d_coo_matgen $(PSBLAS_LIB) $(LDLIBS) /bin/mv d_coo_matgen $(EXEDIR) d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o - $(F90LINK) d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o -o d_matgen $(PSBLAS_LIB) $(LDLIBS) + $(F90LINK) $(LINKOPT) d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o -o d_matgen $(PSBLAS_LIB) $(LDLIBS) /bin/mv d_matgen $(EXEDIR) d_matgen.o: psb_d_cxx_mat_mod.o diff --git a/test/serial/d_matgen.f03 b/test/serial/d_matgen.f03 index 5f320a5f..f431fbe4 100644 --- a/test/serial/d_matgen.f03 +++ b/test/serial/d_matgen.f03 @@ -212,6 +212,8 @@ contains goto 9999 end if + write(0,*) 'After allocate ',a_n%is_null() + ! we build an auxiliary matrix consisting of one row at a ! time; just a small matrix. might be extended to generate ! a bunch of rows per call. @@ -368,6 +370,7 @@ contains call psb_errpush(info,name,a_err=ch_err) goto 9999 end if + write(0,*) 'After insert ',a_n%is_null() !!$ call a_n%print(19) t1 = psb_wtime() call a_n%cscnv(info,mold=acsr) diff --git a/test/serial/psb_d_cxx_impl.f03 b/test/serial/psb_d_cxx_impl.f03 index 51898f14..296086c6 100644 --- a/test/serial/psb_d_cxx_impl.f03 +++ b/test/serial/psb_d_cxx_impl.f03 @@ -41,7 +41,7 @@ subroutine d_cxx_csmv_impl(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -326,7 +326,7 @@ subroutine d_cxx_csmm_impl(alpha,a,x,beta,y,info,trans) end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -615,7 +615,7 @@ subroutine d_cxx_cssv_impl(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -624,7 +624,7 @@ subroutine d_cxx_cssv_impl(alpha,a,x,beta,y,info,trans) m = a%get_nrows() if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -832,7 +832,7 @@ subroutine d_cxx_cssm_impl(alpha,a,x,beta,y,info,trans) trans_ = 'N' end if if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -844,7 +844,7 @@ subroutine d_cxx_cssm_impl(alpha,a,x,beta,y,info,trans) nc = min(size(x,2) , size(y,2)) if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1439,7 +1439,7 @@ subroutine d_cxx_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (a%is_bld()) then ! Build phase should only ever be in COO - info = 1121 + info = psb_err_invalid_mat_state_ else if (a%is_upd()) then call d_cxx_srch_upd(nz,ia,ja,val,a,& @@ -1447,12 +1447,12 @@ subroutine d_cxx_csput_impl(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) if (info /= psb_success_) then - info = 1121 + info = psb_err_invalid_mat_state_ end if else ! State is wrong. - info = 1121 + info = psb_err_invalid_mat_state_ end if if (info /= psb_success_) then call psb_errpush(info,name) diff --git a/test/serial/psb_d_cxx_mat_mod.f03 b/test/serial/psb_d_cxx_mat_mod.f03 index 9b7bad43..0faa350f 100644 --- a/test/serial/psb_d_cxx_mat_mod.f03 +++ b/test/serial/psb_d_cxx_mat_mod.f03 @@ -726,7 +726,7 @@ contains if (clear_) a%val(:) = dzero call a%set_upd() else - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1290,7 +1290,7 @@ contains call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif @@ -1375,14 +1375,14 @@ contains call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if @@ -1428,14 +1428,14 @@ contains call psb_erractionsave(err_act) if (.not.a%is_asb()) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 endif if (.not. (a%is_triangle())) then - info = 1121 + info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 end if