From fa593049111c36d1393f45b1b2f6ce5efc5f3c4f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 30 Nov 2011 11:13:26 +0000 Subject: [PATCH] psblas3: base/serial/impl/psb_c_mat_impl.F90 base/serial/impl/psb_d_mat_impl.F90 base/serial/impl/psb_s_mat_impl.F90 base/serial/impl/psb_z_mat_impl.F90 Fixed error detected by GNU 47 --- base/serial/impl/psb_c_mat_impl.F90 | 23 +++++++++++------------ base/serial/impl/psb_d_mat_impl.F90 | 16 +++++++++++----- base/serial/impl/psb_s_mat_impl.F90 | 23 +++++++++++------------ base/serial/impl/psb_z_mat_impl.F90 | 19 +++++++------------ 4 files changed, 40 insertions(+), 41 deletions(-) diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index e0f067e9..552d8802 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -882,7 +882,8 @@ subroutine psb_c_csgetblk(imin,imax,a,b,info,& if (info == psb_success_) call a%a%csget(imin,imax,acoo,info,& & jmin,jmax,iren,append,rscale,cscale) - if (info == psb_success_) call move_alloc(acoo,b%a) +!!$ if (info == psb_success_) call move_alloc(acoo,b%a) + if (info == psb_success_) call b%mv_from(acoo) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -932,9 +933,10 @@ subroutine psb_c_csclip(a,b,info,& allocate(acoo,stat=info) if (info == psb_success_) call a%a%csclip(acoo,info,& & imin,imax,jmin,jmax,rscale,cscale) - if (info == psb_success_) call move_alloc(acoo,b%a) +!!$ if (info == psb_success_) call move_alloc(acoo,b%a) + if (info == psb_success_) call b%mv_from(acoo) if (info /= psb_success_) goto 9999 - + call psb_erractionrestore(err_act) return @@ -1022,13 +1024,6 @@ subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl) call psb_errpush(info,name) goto 9999 endif - if (present(dupl)) then - call b%set_dupl(dupl) - else if (a%is_bld()) then - ! Does this make sense at all?? Who knows.. - call b%set_dupl(psb_dupl_def_) - end if - if (count( (/present(mold),present(type) /)) > 1) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='TYPE, MOLD') @@ -1409,8 +1404,8 @@ subroutine psb_c_cp_from(a,b) use psb_string_mod use psb_c_mat_mod, psb_protect_name => psb_c_cp_from implicit none - class(psb_cspmat_type), intent(out) :: a - class(psb_c_base_sparse_mat), intent(inout), allocatable :: b + class(psb_cspmat_type), intent(out) :: a + class(psb_c_base_sparse_mat), intent(in) :: b Integer :: err_act, info character(len=20) :: name='clone' logical, parameter :: debug=.false. @@ -1428,6 +1423,7 @@ subroutine psb_c_cp_from(a,b) #else call b%mold(a%a,info) #endif + if (info /= psb_success_) info = psb_err_alloc_dealloc_ if (info == psb_success_) call a%a%cp_from_fmt(b, info) if (info /= psb_success_) goto 9999 @@ -2073,6 +2069,7 @@ function psb_c_csnmi(a) result(res) character(len=20) :: name='csnmi' logical, parameter :: debug=.false. + info = psb_success_ call psb_get_erraction(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ @@ -2294,6 +2291,7 @@ subroutine psb_c_get_diag(a,d,info) character(len=20) :: name='get_diag' logical, parameter :: debug=.false. + info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ @@ -2332,6 +2330,7 @@ subroutine psb_c_scal(d,a,info) character(len=20) :: name='scal' logical, parameter :: debug=.false. + info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index ab80b8f7..22f72001 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -882,7 +882,8 @@ subroutine psb_d_csgetblk(imin,imax,a,b,info,& if (info == psb_success_) call a%a%csget(imin,imax,acoo,info,& & jmin,jmax,iren,append,rscale,cscale) - if (info == psb_success_) call move_alloc(acoo,b%a) +!!$ if (info == psb_success_) call move_alloc(acoo,b%a) + if (info == psb_success_) call b%mv_from(acoo) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -932,9 +933,10 @@ subroutine psb_d_csclip(a,b,info,& allocate(acoo,stat=info) if (info == psb_success_) call a%a%csclip(acoo,info,& & imin,imax,jmin,jmax,rscale,cscale) - if (info == psb_success_) call move_alloc(acoo,b%a) +!!$ if (info == psb_success_) call move_alloc(acoo,b%a) + if (info == psb_success_) call b%mv_from(acoo) if (info /= psb_success_) goto 9999 - + call psb_erractionrestore(err_act) return @@ -1402,8 +1404,8 @@ subroutine psb_d_cp_from(a,b) use psb_string_mod use psb_d_mat_mod, psb_protect_name => psb_d_cp_from implicit none - class(psb_dspmat_type), intent(out) :: a - class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + class(psb_dspmat_type), intent(out) :: a + class(psb_d_base_sparse_mat), intent(in) :: b Integer :: err_act, info character(len=20) :: name='clone' logical, parameter :: debug=.false. @@ -2067,6 +2069,7 @@ function psb_d_csnmi(a) result(res) character(len=20) :: name='csnmi' logical, parameter :: debug=.false. + info = psb_success_ call psb_get_erraction(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ @@ -2288,6 +2291,7 @@ subroutine psb_d_get_diag(a,d,info) character(len=20) :: name='get_diag' logical, parameter :: debug=.false. + info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ @@ -2326,6 +2330,7 @@ subroutine psb_d_scal(d,a,info) character(len=20) :: name='scal' logical, parameter :: debug=.false. + info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ @@ -2364,6 +2369,7 @@ subroutine psb_d_scals(d,a,info) character(len=20) :: name='scal' logical, parameter :: debug=.false. + info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index b545632a..89eef2d5 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -882,7 +882,8 @@ subroutine psb_s_csgetblk(imin,imax,a,b,info,& if (info == psb_success_) call a%a%csget(imin,imax,acoo,info,& & jmin,jmax,iren,append,rscale,cscale) - if (info == psb_success_) call move_alloc(acoo,b%a) +!!$ if (info == psb_success_) call move_alloc(acoo,b%a) + if (info == psb_success_) call b%mv_from(acoo) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -932,9 +933,10 @@ subroutine psb_s_csclip(a,b,info,& allocate(acoo,stat=info) if (info == psb_success_) call a%a%csclip(acoo,info,& & imin,imax,jmin,jmax,rscale,cscale) - if (info == psb_success_) call move_alloc(acoo,b%a) +!!$ if (info == psb_success_) call move_alloc(acoo,b%a) + if (info == psb_success_) call b%mv_from(acoo) if (info /= psb_success_) goto 9999 - + call psb_erractionrestore(err_act) return @@ -1022,13 +1024,6 @@ subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl) call psb_errpush(info,name) goto 9999 endif - if (present(dupl)) then - call b%set_dupl(dupl) - else if (a%is_bld()) then - ! Does this make sense at all?? Who knows.. - call b%set_dupl(psb_dupl_def_) - end if - if (count( (/present(mold),present(type) /)) > 1) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='TYPE, MOLD') @@ -1409,8 +1404,8 @@ subroutine psb_s_cp_from(a,b) use psb_string_mod use psb_s_mat_mod, psb_protect_name => psb_s_cp_from implicit none - class(psb_sspmat_type), intent(out) :: a - class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + class(psb_sspmat_type), intent(out) :: a + class(psb_s_base_sparse_mat), intent(in) :: b Integer :: err_act, info character(len=20) :: name='clone' logical, parameter :: debug=.false. @@ -2074,6 +2069,7 @@ function psb_s_csnmi(a) result(res) character(len=20) :: name='csnmi' logical, parameter :: debug=.false. + info = psb_success_ call psb_get_erraction(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ @@ -2295,6 +2291,7 @@ subroutine psb_s_get_diag(a,d,info) character(len=20) :: name='get_diag' logical, parameter :: debug=.false. + info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ @@ -2333,6 +2330,7 @@ subroutine psb_s_scal(d,a,info) character(len=20) :: name='scal' logical, parameter :: debug=.false. + info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ @@ -2371,6 +2369,7 @@ subroutine psb_s_scals(d,a,info) character(len=20) :: name='scal' logical, parameter :: debug=.false. + info = psb_success_ call psb_erractionsave(err_act) if (.not.allocated(a%a)) then info = psb_err_invalid_mat_state_ diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index e096673d..f5102ed5 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -882,7 +882,8 @@ subroutine psb_z_csgetblk(imin,imax,a,b,info,& if (info == psb_success_) call a%a%csget(imin,imax,acoo,info,& & jmin,jmax,iren,append,rscale,cscale) - if (info == psb_success_) call move_alloc(acoo,b%a) +!!$ if (info == psb_success_) call move_alloc(acoo,b%a) + if (info == psb_success_) call b%mv_from(acoo) if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) @@ -932,9 +933,10 @@ subroutine psb_z_csclip(a,b,info,& allocate(acoo,stat=info) if (info == psb_success_) call a%a%csclip(acoo,info,& & imin,imax,jmin,jmax,rscale,cscale) - if (info == psb_success_) call move_alloc(acoo,b%a) +!!$ if (info == psb_success_) call move_alloc(acoo,b%a) + if (info == psb_success_) call b%mv_from(acoo) if (info /= psb_success_) goto 9999 - + call psb_erractionrestore(err_act) return @@ -1022,13 +1024,6 @@ subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl) call psb_errpush(info,name) goto 9999 endif - if (present(dupl)) then - call b%set_dupl(dupl) - else if (a%is_bld()) then - ! Does this make sense at all?? Who knows.. - call b%set_dupl(psb_dupl_def_) - end if - if (count( (/present(mold),present(type) /)) > 1) then info = psb_err_many_optional_arg_ call psb_errpush(info,name,a_err='TYPE, MOLD') @@ -1409,8 +1404,8 @@ subroutine psb_z_cp_from(a,b) use psb_string_mod use psb_z_mat_mod, psb_protect_name => psb_z_cp_from implicit none - class(psb_zspmat_type), intent(out) :: a - class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + class(psb_zspmat_type), intent(out) :: a + class(psb_z_base_sparse_mat), intent(in) :: b Integer :: err_act, info character(len=20) :: name='clone' logical, parameter :: debug=.false.