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

Merged in sp_reinit new interfaces.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent aa376a22b7
commit 662a6ced02
6 changed files with 120 additions and 68 deletions
Show Stats Download Patch File Download Diff File

98
src/modules/psb_spmat_type.f90
Unescape Escape View File

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

6
src/modules/psb_tools_mod.f90
Unescape Escape View File

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

3
src/tools/psb_dsphalo.f90
Unescape Escape View File

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

40
src/tools/psb_dsprn.f90
Unescape Escape View File

@ -38,7 +38,7 @@
! desc_a - type(<psb_desc_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

3
src/tools/psb_zsphalo.f90
Unescape Escape View File

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

38
src/tools/psb_zsprn.f90
Unescape Escape View File

@ -38,7 +38,7 @@
! desc_a - type(<psb_desc_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

Write Preview
Loading…
Cancel
Save