fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
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!!
psblas3-type-indexed
Salvatore Filippone 15 years ago
parent 18ecc8983c
commit de705a3dc6
35 changed files with 395 additions and 406 deletions
Show Stats Download Patch File Download Diff File

1
base/modules/psb_const_mod.F90
Unescape Escape View File

@ -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

2
base/modules/psb_error_mod.F90
Unescape Escape View File

@ -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_)

72
base/modules/psb_realloc_mod.F90
Unescape Escape View File

@ -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)

8
base/serial/f03/psb_c_base_mat_impl.f03
Unescape Escape View File

@ -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

22
base/serial/f03/psb_c_coo_impl.f03
Unescape Escape View File

@ -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)

20
base/serial/f03/psb_c_csc_impl.f03
Unescape Escape View File

@ -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

20
base/serial/f03/psb_c_csr_impl.f03
Unescape Escape View File

@ -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

82
base/serial/f03/psb_c_mat_impl.f03
Unescape Escape View File

@ -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

8
base/serial/f03/psb_d_base_mat_impl.f03
Unescape Escape View File

@ -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

22
base/serial/f03/psb_d_coo_impl.f03
Unescape Escape View File

@ -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)

20
base/serial/f03/psb_d_csc_impl.f03
Unescape Escape View File

@ -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

58
base/serial/f03/psb_d_csr_impl.f03
Unescape Escape View File

@ -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)

101
base/serial/f03/psb_d_mat_impl.f03
Unescape Escape View File

@ -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

8
base/serial/f03/psb_s_base_mat_impl.f03
Unescape Escape View File

@ -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

22
base/serial/f03/psb_s_coo_impl.f03
Unescape Escape View File

@ -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)

20
base/serial/f03/psb_s_csc_impl.f03
Unescape Escape View File

@ -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

20
base/serial/f03/psb_s_csr_impl.f03
Unescape Escape View File

@ -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

82
base/serial/f03/psb_s_mat_impl.f03
Unescape Escape View File

@ -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

8
base/serial/f03/psb_z_base_mat_impl.f03
Unescape Escape View File

@ -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

22
base/serial/f03/psb_z_coo_impl.f03
Unescape Escape View File

@ -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)

20
base/serial/f03/psb_z_csc_impl.f03
Unescape Escape View File

@ -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

20
base/serial/f03/psb_z_csr_impl.f03
Unescape Escape View File

@ -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

82
base/serial/f03/psb_z_mat_impl.f03
Unescape Escape View File

@ -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

4
base/serial/psb_cnumbmm.f90
Unescape Escape View File

@ -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

2
base/serial/psb_csymbmm.f90
Unescape Escape View File

@ -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

4
base/serial/psb_dnumbmm.f90
Unescape Escape View File

@ -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

2
base/serial/psb_dsymbmm.f90
Unescape Escape View File

@ -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

4
base/serial/psb_snumbmm.f90
Unescape Escape View File

@ -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

2
base/serial/psb_ssymbmm.f90
Unescape Escape View File

@ -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

4
base/serial/psb_znumbmm.f90
Unescape Escape View File

@ -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

2
base/serial/psb_zsymbmm.f90
Unescape Escape View File

@ -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

4
test/serial/Makefile
Unescape Escape View File

@ -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

3
test/serial/d_matgen.f03
Unescape Escape View File

@ -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)

18
test/serial/psb_d_cxx_impl.f03
Unescape Escape View File

@ -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)

12
test/serial/psb_d_cxx_mat_mod.f03
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save