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

Added support for reopening a matrix, needed for operator tools.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent e5ca6e13ae
commit f22e2ee76c
14 changed files with 71 additions and 37 deletions
Show Stats Download Patch File Download Diff File

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

@ -310,21 +310,23 @@ module psb_serial_mod
end interface end interface
interface psb_coins interface psb_coins
subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info,rebuild)
use psb_spmat_type use psb_spmat_type
integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:),gtl(:) integer, intent(in) :: ia(:),ja(:),gtl(:)
real(kind(1.d0)), intent(in) :: val(:) real(kind(1.d0)), intent(in) :: val(:)
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional, intent(in) :: rebuild
end subroutine psb_dcoins end subroutine psb_dcoins
subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info,rebuild)
use psb_spmat_type use psb_spmat_type
integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:),gtl(:) integer, intent(in) :: ia(:),ja(:),gtl(:)
complex(kind(1.d0)), intent(in) :: val(:) complex(kind(1.d0)), intent(in) :: val(:)
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional, intent(in) :: rebuild
end subroutine psb_zcoins end subroutine psb_zcoins
end interface end interface

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

@ -535,7 +535,7 @@ Module psb_tools_mod
interface psb_spins interface psb_spins
subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js) subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js,rebuild)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
@ -544,6 +544,7 @@ Module psb_tools_mod
real(kind(1.d0)), intent(in) :: val(:) real(kind(1.d0)), intent(in) :: val(:)
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: is,js integer, intent(in), optional :: is,js
logical, intent(in), optional :: rebuild
end subroutine psb_dspins end subroutine psb_dspins
subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js) subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js)
use psb_descriptor_type use psb_descriptor_type

1
src/serial/Makefile
Unescape Escape View File

@ -14,7 +14,6 @@ FOBJS = psb_cest.o psb_dcoins.o psb_dcsdp.o psb_dcsmm.o psb_dcsmv.o \
psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspinfo.o psb_zspscal.o\ psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspinfo.o psb_zspscal.o\
psb_getifield.o psb_setifield.o psb_update_mod.o psb_getifield.o psb_setifield.o psb_update_mod.o
INCDIRS = -I ../../lib -I . INCDIRS = -I ../../lib -I .
LIBDIR = ../../lib LIBDIR = ../../lib

12
src/serial/dp/dcocr.f
Unescape Escape View File

@ -94,18 +94,18 @@ C
ELSE IF (LARN.LT.NNZ) THEN ELSE IF (LARN.LT.NNZ) THEN
IERROR = 60 IERROR = 60
INT_VAL(1) = 18 INT_VAL(1) = 18
INT_VAL(2) = NNZ+2 INT_VAL(2) = NNZ
INT_VAL(3) = LAUX INT_VAL(3) = LARN
ELSE IF (LIAN1.LT.NNZ) THEN ELSE IF (LIAN1.LT.NNZ) THEN
IERROR = 60 IERROR = 60
INT_VAL(1) = 19 INT_VAL(1) = 19
INT_VAL(2) = NNZ+2 INT_VAL(2) = NNZ
INT_VAL(3) = LAUX INT_VAL(3) = LIAN1
ELSE IF (LIAN2.LT.M+1) THEN ELSE IF (LIAN2.LT.M+1) THEN
IERROR = 60 IERROR = 60
INT_VAL(1) = 20 INT_VAL(1) = 20
INT_VAL(2) = NNZ+2 INT_VAL(2) = M+1
INT_VAL(3) = LAUX INT_VAL(3) = LIAN2
ENDIF ENDIF
C C

24
src/serial/psb_dcoins.f90
Unescape Escape View File

@ -31,7 +31,7 @@
! File: psbdcoins.f90 ! File: psbdcoins.f90
! Subroutine: ! Subroutine:
! Parameters: ! Parameters:
subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info,rebuild)
use psb_spmat_type use psb_spmat_type
use psb_const_mod use psb_const_mod
@ -47,6 +47,7 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
real(kind(1.d0)), intent(in) :: val(:) real(kind(1.d0)), intent(in) :: val(:)
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, intent(in), optional :: rebuild
character(len=5) :: ufida character(len=5) :: ufida
integer :: i,j,ir,ic,nr,nc, ng, nza, isza,spstate, nnz,& integer :: i,j,ir,ic,nr,nc, ng, nza, isza,spstate, nnz,&
@ -87,11 +88,11 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
goto 9999 goto 9999
end if end if
!!$ if (present(rebuild)) then if (present(rebuild)) then
!!$ rebuild_ = rebuild rebuild_ = rebuild
!!$ else else
rebuild_ = .false. rebuild_ = .false.
!!$ end if end if
call touppers(a%fida,ufida) call touppers(a%fida,ufida)
ng = size(gtl) ng = size(gtl)
@ -178,12 +179,16 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
& imin,imax,jmin,jmax,nzl,info) & imin,imax,jmin,jmax,nzl,info)
if (info > 0) then if (info > 0) then
if (rebuild_) then if (rebuild_) then
write(0,*) 'COINS: Going through rebuild_ fingers crossed!' if (debug) write(0,*)&
& 'COINS: Going through rebuild_ fingers crossed!'
irst = info irst = info
call psb_nullify_sp(tmp) call psb_nullify_sp(tmp)
tmp%fida='COO' tmp%fida='COO'
call psb_csdp(a,tmp,info) call psb_csdp(a,tmp,info)
call psb_setifield(psb_spmat_bld_,psb_state_,tmp,info) call psb_sp_setifld(psb_spmat_bld_,psb_state_,tmp,info)
if (debug) then
write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst
endif
call psb_sp_transfer(tmp,a,info) call psb_sp_transfer(tmp,a,info)
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_spinfo(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_spinfo(psb_nzsizereq_,a,isza,info)
@ -194,6 +199,8 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
goto 9999 goto 9999
endif endif
if (debug) write(0,*)&
& 'COINS: Reinserting',a%fida,nza,isza
if ((nza+nz)>isza) then if ((nza+nz)>isza) then
call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info) call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info)
if(info /= izero) then if(info /= izero) then
@ -206,6 +213,8 @@ subroutine psb_dcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
if (irst <= nz) then if (irst <= nz) then
call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),& call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),&
& nza,a%ia1,a%ia2,a%aspk,gtl,ng,imin,imax,jmin,jmax,info) & nza,a%ia1,a%ia2,a%aspk,gtl,ng,imin,imax,jmin,jmax,info)
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
call psb_sp_setifld(nza,psb_nnz_,a,info)
end if end if
else else
@ -292,7 +301,6 @@ contains
real(kind(1.d0)), intent(in) :: val(*) real(kind(1.d0)), intent(in) :: val(*)
real(kind(1.d0)), intent(inout) :: aspk(*) real(kind(1.d0)), intent(inout) :: aspk(*)
integer, intent(out) :: info integer, intent(out) :: info
integer :: i,ir,ic integer :: i,ir,ic
info = 0 info = 0

23
src/serial/psb_zcoins.f90
Unescape Escape View File

@ -31,7 +31,7 @@
! File: psbzcoins.f90 ! File: psbzcoins.f90
! Subroutine: ! Subroutine:
! Parameters: ! Parameters:
subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info) subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info,rebuild)
use psb_spmat_type use psb_spmat_type
use psb_const_mod use psb_const_mod
@ -47,6 +47,7 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
complex(kind(1.d0)), intent(in) :: val(:) complex(kind(1.d0)), intent(in) :: val(:)
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional, intent(in) :: rebuild
character(len=5) :: ufida character(len=5) :: ufida
integer :: i,j,ir,ic,nr,nc, ng, nza, isza,spstate, nnz,& integer :: i,j,ir,ic,nr,nc, ng, nza, isza,spstate, nnz,&
@ -87,11 +88,11 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
goto 9999 goto 9999
end if end if
!!$ if (present(rebuild)) then if (present(rebuild)) then
!!$ rebuild_ = rebuild rebuild_ = rebuild
!!$ else else
rebuild_ = .false. rebuild_ = .false.
!!$ end if end if
call touppers(a%fida,ufida) call touppers(a%fida,ufida)
ng = size(gtl) ng = size(gtl)
@ -178,12 +179,16 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
& imin,imax,jmin,jmax,nzl,info) & imin,imax,jmin,jmax,nzl,info)
if (info > 0) then if (info > 0) then
if (rebuild_) then if (rebuild_) then
write(0,*) 'COINS: Going through rebuild_ fingers crossed!' if (debug) write(0,*)&
& 'COINS: Going through rebuild_ fingers crossed!'
irst = info irst = info
call psb_nullify_sp(tmp) call psb_nullify_sp(tmp)
tmp%fida='COO' tmp%fida='COO'
call psb_csdp(a,tmp,info) call psb_csdp(a,tmp,info)
call psb_setifield(psb_spmat_bld_,psb_state_,tmp,info) call psb_sp_setifld(psb_spmat_bld_,psb_state_,tmp,info)
if (debug) then
write(0,*) 'COINS Rebuild: size',tmp%infoa(psb_nnz_) ,irst
endif
call psb_sp_transfer(tmp,a,info) call psb_sp_transfer(tmp,a,info)
call psb_spinfo(psb_nztotreq_,a,nza,info) call psb_spinfo(psb_nztotreq_,a,nza,info)
call psb_spinfo(psb_nzsizereq_,a,isza,info) call psb_spinfo(psb_nzsizereq_,a,isza,info)
@ -194,6 +199,8 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
goto 9999 goto 9999
endif endif
if (debug) write(0,*)&
& 'COINS: Reinserting',a%fida,nza,isza
if ((nza+nz)>isza) then if ((nza+nz)>isza) then
call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info) call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info)
if(info /= izero) then if(info /= izero) then
@ -206,6 +213,8 @@ subroutine psb_zcoins(nz,ia,ja,val,a,gtl,imin,imax,jmin,jmax,info)
if (irst <= nz) then if (irst <= nz) then
call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),& call psb_inner_ins((nz-irst+1),ia(irst:nz),ja(irst:nz),val(irst:nz),&
& nza,a%ia1,a%ia2,a%aspk,gtl,ng,imin,imax,jmin,jmax,info) & nza,a%ia1,a%ia2,a%aspk,gtl,ng,imin,imax,jmin,jmax,info)
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
call psb_sp_setifld(nza,psb_nnz_,a,info)
end if end if
else else

2
src/tools/psb_cdins.f90
Unescape Escape View File

@ -51,7 +51,7 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js)
!....PARAMETERS... !....PARAMETERS...
Type(psb_desc_type), intent(inout) :: desc_a Type(psb_desc_type), intent(inout) :: desc_a
Integer, intent(in) :: nz,IA(:),JA(:) Integer, intent(in) :: nz,ia(:),ja(:)
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: is,js integer, intent(in), optional :: is,js

2
src/tools/psb_dspalloc.f90
Unescape Escape View File

@ -133,7 +133,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
if (debug) write(0,*) 'spall: ', & if (debug) write(0,*) 'spall: ', &
&desc_a%matrix_data(psb_dec_type_),psb_desc_bld_ &desc_a%matrix_data(psb_dec_type_),psb_desc_bld_
!!$ desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_
return return
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

13
src/tools/psb_dspins.f90
Unescape Escape View File

@ -44,7 +44,7 @@
! is - integer(optional). The row offset. ! is - integer(optional). The row offset.
! js - integer(optional). The column offset. ! js - integer(optional). The column offset.
! !
subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js) subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js,rebuild)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
@ -60,7 +60,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js)
real(kind(1.d0)), intent(in) :: val(:) real(kind(1.d0)), intent(in) :: val(:)
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: is,js integer, intent(in), optional :: is,js
logical, intent(in), optional :: rebuild
!locals..... !locals.....
integer :: i,icontxt,nprocs ,glob_row,row,k,start_row,end_row,& integer :: i,icontxt,nprocs ,glob_row,row,k,start_row,end_row,&
@ -70,6 +70,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js)
integer :: nprow,npcol, myrow ,mycol, iflag, isize, irlc integer :: nprow,npcol, myrow ,mycol, iflag, isize, irlc
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer, parameter :: relocsz=200 integer, parameter :: relocsz=200
logical :: rebuild_
interface psb_cdins interface psb_cdins
subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js) subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js)
@ -127,6 +128,11 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js)
goto 9999 goto 9999
end if end if
if (present(rebuild)) then
rebuild_ = rebuild
else
rebuild_ = .false.
endif
spstate = a%infoa(psb_state_) spstate = a%infoa(psb_state_)
if (psb_is_bld_dec(dectype)) then if (psb_is_bld_dec(dectype)) then
@ -156,7 +162,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,is,js)
else if (psb_is_asb_dec(dectype)) then else if (psb_is_asb_dec(dectype)) then
nrow = desc_a%matrix_data(psb_n_row_) nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_) ncol = desc_a%matrix_data(psb_n_col_)
call psb_coins(nz,ia,ja,val,a,desc_a%glob_to_loc,1,nrow,1,ncol,info) call psb_coins(nz,ia,ja,val,a,desc_a%glob_to_loc,1,nrow,1,ncol,&
& info,rebuild=rebuild_)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='psb_coins' ch_err='psb_coins'

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

@ -53,6 +53,7 @@ Subroutine psb_dsprn(a, desc_a,info,clear)
integer, intent(out) :: info integer, intent(out) :: info
logical, intent(in), optional :: clear logical, intent(in), optional :: clear
!locals !locals
Integer :: icontxt Integer :: icontxt
Integer :: nprow,npcol,myrow,mycol,err,err_act Integer :: nprow,npcol,myrow,mycol,err,err_act

2
src/tools/psb_zspalloc.f90
Unescape Escape View File

@ -133,7 +133,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
if (debug) write(0,*) 'spall: ', & if (debug) write(0,*) 'spall: ', &
&desc_a%matrix_data(psb_dec_type_),psb_desc_bld_ &desc_a%matrix_data(psb_dec_type_),psb_desc_bld_
!!$ desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_
return return
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

13
src/tools/psb_zspins.f90
Unescape Escape View File

@ -44,7 +44,7 @@
! is - integer(optional). The row offset. ! is - integer(optional). The row offset.
! js - integer(optional). The column offset. ! js - integer(optional). The column offset.
! !
subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js) subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js,rebuild)
use psb_descriptor_type use psb_descriptor_type
use psb_spmat_type use psb_spmat_type
@ -60,7 +60,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js)
complex(kind(1.d0)), intent(in) :: val(:) complex(kind(1.d0)), intent(in) :: val(:)
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: is,js integer, intent(in), optional :: is,js
logical, intent(in), optional :: rebuild
!locals..... !locals.....
integer :: i,icontxt,nprocs ,glob_row,row,k,start_row,end_row,& integer :: i,icontxt,nprocs ,glob_row,row,k,start_row,end_row,&
@ -70,6 +70,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js)
integer :: nprow,npcol, myrow ,mycol, iflag, isize, irlc integer :: nprow,npcol, myrow ,mycol, iflag, isize, irlc
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer, parameter :: relocsz=200 integer, parameter :: relocsz=200
logical :: rebuild_
interface psb_cdins interface psb_cdins
subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js) subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js)
@ -127,6 +128,11 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js)
goto 9999 goto 9999
end if end if
if (present(rebuild)) then
rebuild_ = rebuild
else
rebuild_ = .false.
endif
spstate = a%infoa(psb_state_) spstate = a%infoa(psb_state_)
if (psb_is_bld_dec(dectype)) then if (psb_is_bld_dec(dectype)) then
@ -156,7 +162,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js)
else if (psb_is_asb_dec(dectype)) then else if (psb_is_asb_dec(dectype)) then
nrow = desc_a%matrix_data(psb_n_row_) nrow = desc_a%matrix_data(psb_n_row_)
ncol = desc_a%matrix_data(psb_n_col_) ncol = desc_a%matrix_data(psb_n_col_)
call psb_coins(nz,ia,ja,val,a,desc_a%glob_to_loc,1,nrow,1,ncol,info) call psb_coins(nz,ia,ja,val,a,desc_a%glob_to_loc,1,nrow,1,ncol,&
& info,rebuild=rebuild_)
if (info /= 0) then if (info /= 0) then
info=4010 info=4010
ch_err='psb_coins' ch_err='psb_coins'

Write Preview
Loading…
Cancel
Save