diff --git a/src/modules/psb_spmat_type.f90 b/src/modules/psb_spmat_type.f90 index f6bbbc67..4b0f7725 100644 --- a/src/modules/psb_spmat_type.f90 +++ b/src/modules/psb_spmat_type.f90 @@ -132,18 +132,53 @@ contains end subroutine psb_nullify_dsp - Subroutine psb_dspreinit(a) - implicit none + Subroutine psb_dspreinit(a,info,clear) + + Implicit None + !....Parameters... - Type(psb_dspmat_type), intent(inout) :: A + Type(psb_dspmat_type), intent(inout) :: a + integer, intent(out) :: info + logical, intent(in), optional :: clear !locals logical, parameter :: debug=.false. + logical :: clear_ + character(len=20) :: name, ch_err + + info = 0 + name = 'psb_sp_reinit' - if (debug) write(0,*) 'spreinit init ',a%fida,a%infoa(psb_nnz_) - if (a%fida=='COO') a%infoa(psb_nnz_) = 0 - if (associated(a%aspk)) a%aspk(:) = 0.d0 - if (debug) write(0,*) 'spreinit end ',a%fida,a%infoa(psb_nnz_) + if (present(clear)) then + clear_ = clear + else + clear_ = .true. + end if + + select case(psb_sp_getifld(psb_state_,a,info)) + case(psb_spmat_asb_) + + if (clear_) a%aspk(:) = dzero + + if (psb_sp_getifld(psb_upd_,a,info)==psb_upd_perm_) then + if(a%fida(1:3).eq.'JAD') then + a%ia1(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 + else + a%ia2(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 + endif + endif + a%infoa(psb_state_) = psb_spmat_upd_ + case(psb_spmat_bld_) + ! in this case do nothing. this allows sprn to be called + ! right after allocate, with spins doing the right thing. + ! hopefully :-) + + case( psb_spmat_upd_) + + case default + info=591 + call psb_errpush(info,name) + end select end Subroutine psb_dspreinit @@ -621,18 +656,53 @@ contains end subroutine psb_nullify_zsp - Subroutine psb_zspreinit(a) - implicit none + Subroutine psb_zspreinit(a,info,clear) + + Implicit None + !....Parameters... - Type(psb_zspmat_type), intent(inout) :: A + Type(psb_zspmat_type), intent(inout) :: a + integer, intent(out) :: info + logical, intent(in), optional :: clear !locals logical, parameter :: debug=.false. + logical :: clear_ + character(len=20) :: name, ch_err + + info = 0 + name = 'psb_sp_reinit' - if (debug) write(0,*) 'spreinit init ',a%fida,a%infoa(psb_nnz_) - if (a%fida=='COO') a%infoa(psb_nnz_) = 0 - if (associated(a%aspk)) a%aspk(:) = 0.d0 - if (debug) write(0,*) 'spreinit end ',a%fida,a%infoa(psb_nnz_) + if (present(clear)) then + clear_ = clear + else + clear_ = .true. + end if + + select case(psb_sp_getifld(psb_state_,a,info)) + case(psb_spmat_asb_) + + if (clear_) a%aspk(:) = zzero + + if (psb_sp_getifld(psb_upd_,a,info)==psb_upd_perm_) then + if(a%fida(1:3).eq.'JAD') then + a%ia1(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 + else + a%ia2(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 + endif + endif + a%infoa(psb_state_) = psb_spmat_upd_ + case(psb_spmat_bld_) + ! in this case do nothing. this allows sprn to be called + ! right after allocate, with spins doing the right thing. + ! hopefully :-) + + case( psb_spmat_upd_) + + case default + info=591 + call psb_errpush(info,name) + end select end Subroutine psb_zspreinit diff --git a/src/modules/psb_tools_mod.f90 b/src/modules/psb_tools_mod.f90 index 52ef1f24..36138a31 100644 --- a/src/modules/psb_tools_mod.f90 +++ b/src/modules/psb_tools_mod.f90 @@ -559,19 +559,21 @@ Module psb_tools_mod interface psb_sprn - subroutine psb_dsprn(a, desc_a,info) + subroutine psb_dsprn(a, desc_a,info,clear) use psb_descriptor_type use psb_spmat_type type(psb_desc_type), intent(in) :: desc_a type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info + logical, intent(in), optional :: clear end subroutine psb_dsprn - subroutine psb_zsprn(a, desc_a,info) + subroutine psb_zsprn(a, desc_a,info,clear) use psb_descriptor_type use psb_spmat_type type(psb_desc_type), intent(in) :: desc_a type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info + logical, intent(in), optional :: clear end subroutine psb_zsprn end interface diff --git a/src/tools/psb_dsphalo.f90 b/src/tools/psb_dsphalo.f90 index 8be5c7c4..f1326edb 100644 --- a/src/tools/psb_dsphalo.f90 +++ b/src/tools/psb_dsphalo.f90 @@ -203,7 +203,8 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt) ipx = 1 counter=1 idx = 0 - call psb_sp_reinit(tmp) + call psb_sp_reinit(tmp,info) + tmp%infoa(psb_nnz_) = 0 Do proc=desc_a%halo_index(counter) if (proc == -1) exit diff --git a/src/tools/psb_dsprn.f90 b/src/tools/psb_dsprn.f90 index 8f55e82a..02d986dd 100644 --- a/src/tools/psb_dsprn.f90 +++ b/src/tools/psb_dsprn.f90 @@ -38,7 +38,7 @@ ! desc_a - type(). The communication descriptor. ! info - integer. Eventually returns an error code. ! -Subroutine psb_dsprn(a, desc_a,info) +Subroutine psb_dsprn(a, desc_a,info,clear) use psb_descriptor_type use psb_spmat_type @@ -51,6 +51,7 @@ Subroutine psb_dsprn(a, desc_a,info) Type(psb_desc_type), intent(in) :: desc_a Type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info + logical, intent(in), optional :: clear !locals Integer :: icontxt @@ -59,6 +60,7 @@ Subroutine psb_dsprn(a, desc_a,info) integer :: int_err(5) real(kind(1.d0)) :: real_err(5) character(len=20) :: name, ch_err + logical :: clear_ info = 0 err = 0 @@ -79,37 +81,23 @@ Subroutine psb_dsprn(a, desc_a,info) endif if (debug) write(*,*) 'got through igamx2d ' - + + if (psb_is_bld_dec(desc_a%matrix_data(psb_dec_type_))) then + ! Should do nothing, we are called redundantly + return + endif if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then info=590 call psb_errpush(info,name) goto 9999 endif + if (present(clear)) then + clear_ = clear + else + clear_ = .true. + end if - select case(psb_sp_getifld(psb_state_,a,info)) - case(psb_spmat_asb_) - - a%aspk(:) = dzero - - if (psb_sp_getifld(psb_upd_,a,info)==psb_upd_perm_) then - if(a%fida(1:3).eq.'JAD') then - a%ia1(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 - else - a%ia2(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 - endif - endif - a%infoa(psb_state_) = psb_spmat_upd_ - case(psb_spmat_bld_) - ! in this case do nothing. this allows sprn to be called - ! right after allocate, with spins doing the right thing. - ! hopefully :-) - - case( psb_spmat_upd_) - - case default - info=591 - call psb_errpush(info,name) - end select + call psb_sp_reinit(a,info,clear=clear_) if (info /= 0) goto 9999 diff --git a/src/tools/psb_zsphalo.f90 b/src/tools/psb_zsphalo.f90 index 2656c291..25d4b569 100644 --- a/src/tools/psb_zsphalo.f90 +++ b/src/tools/psb_zsphalo.f90 @@ -203,7 +203,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rwcnv,clcnv,outfmt) ipx = 1 counter=1 idx = 0 - call psb_sp_reinit(tmp) + call psb_sp_reinit(tmp,info) + tmp%infoa(psb_nnz_) = 0 Do proc=desc_a%halo_index(counter) if (proc == -1) exit diff --git a/src/tools/psb_zsprn.f90 b/src/tools/psb_zsprn.f90 index a9880f5b..2d75b94a 100644 --- a/src/tools/psb_zsprn.f90 +++ b/src/tools/psb_zsprn.f90 @@ -38,7 +38,7 @@ ! desc_a - type(). The communication descriptor. ! info - integer. Eventually returns an error code. ! -Subroutine psb_zsprn(a, desc_a,info) +Subroutine psb_zsprn(a, desc_a,info,clear) use psb_descriptor_type use psb_spmat_type @@ -51,6 +51,7 @@ Subroutine psb_zsprn(a, desc_a,info) Type(psb_desc_type), intent(in) :: desc_a Type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info + logical, intent(in), optional :: clear !locals Integer :: icontxt @@ -59,6 +60,7 @@ Subroutine psb_zsprn(a, desc_a,info) integer :: int_err(5) real(kind(1.d0)) :: real_err(5) character(len=20) :: name, ch_err + logical :: clear_ info = 0 err = 0 @@ -79,39 +81,27 @@ Subroutine psb_zsprn(a, desc_a,info) endif if (debug) write(*,*) 'got through igamx2d ' - + + if (psb_is_bld_dec(desc_a%matrix_data(psb_dec_type_))) then + ! Should do nothing, we are called redundantly + return + endif if (.not.psb_is_asb_dec(desc_a%matrix_data(psb_dec_type_))) then info=590 call psb_errpush(info,name) goto 9999 endif - - if (a%infoa(psb_state_) == psb_spmat_asb_) then - - a%aspk(:) = zzero - if (psb_sp_getifld(psb_upd_,a,info)==psb_upd_perm_) then - if(a%fida(1:3).eq.'JAD') then - a%ia1(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 - else - a%ia2(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0 - endif - endif - a%infoa(psb_state_) = psb_spmat_upd_ - else if (a%infoa(psb_state_) == psb_spmat_bld_) then - ! in this case do nothing. this allows sprn to be called - ! right after allocate, with spins doing the right thing. - ! hopefully :-) - else if (a%infoa(psb_state_) == psb_spmat_upd_) then - + if (present(clear)) then + clear_ = clear else - info=591 - call psb_errpush(info,name) - endif + clear_ = .true. + end if + + call psb_sp_reinit(a,info,clear=clear_) if (info /= 0) goto 9999 call psb_erractionrestore(err_act) - return 9999 continue