fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-16 19:02:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Salvatore Filippone
2006-05-03 12:25:38 +00:00
parent e5ca6e13ae
commit f22e2ee76c
14 changed files with 71 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/modules/psb_serial_mod.f90
+4 -2
View File
@@ -310,21 +310,23 @@ module psb_serial_mod
end interface
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
integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:),gtl(:)
real(kind(1.d0)), intent(in) :: val(:)
type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info
logical, optional, intent(in) :: rebuild
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
integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:),gtl(:)
complex(kind(1.d0)), intent(in) :: val(:)
type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info
logical, optional, intent(in) :: rebuild
end subroutine psb_zcoins
end interface
src/modules/psb_spmat_type.f90
+1 -1
View File
@@ -173,7 +173,7 @@ contains
! right after allocate, with spins doing the right thing.
! hopefully :-)
case(psb_spmat_upd_)
case( psb_spmat_upd_)
case default
info=591
src/modules/psb_tools_mod.f90
+2 -1
View File
@@ -535,7 +535,7 @@ Module psb_tools_mod
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_spmat_type
type(psb_desc_type), intent(inout) :: desc_a
@@ -544,6 +544,7 @@ Module psb_tools_mod
real(kind(1.d0)), intent(in) :: val(:)
integer, intent(out) :: info
integer, intent(in), optional :: is,js
logical, intent(in), optional :: rebuild
end subroutine psb_dspins
subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,is,js)
use psb_descriptor_type
src/serial/Makefile
-1
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_getifield.o psb_setifield.o psb_update_mod.o
INCDIRS = -I ../../lib -I .
LIBDIR = ../../lib
src/serial/dp/dcocr.f
+6 -6
View File
@@ -94,18 +94,18 @@ C
ELSE IF (LARN.LT.NNZ) THEN
IERROR = 60
INT_VAL(1) = 18
INT_VAL(2) = NNZ+2
INT_VAL(3) = LAUX
INT_VAL(2) = NNZ
INT_VAL(3) = LARN
ELSE IF (LIAN1.LT.NNZ) THEN
IERROR = 60
INT_VAL(1) = 19
INT_VAL(2) = NNZ+2
INT_VAL(3) = LAUX
INT_VAL(2) = NNZ
INT_VAL(3) = LIAN1
ELSE IF (LIAN2.LT.M+1) THEN
IERROR = 60
INT_VAL(1) = 20
INT_VAL(2) = NNZ+2
INT_VAL(3) = LAUX
INT_VAL(2) = M+1
INT_VAL(3) = LIAN2
ENDIF
C
src/serial/f77/Makefile
+1 -1
View File
@@ -3,7 +3,7 @@ include ../../../Make.inc
#
# The object files
#
FOBJS = daxpby.o dcsmm.o dcsnmi.o dcsrp.o dcssm.o \
FOBJS = daxpby.o dcsmm.o dcsnmi.o dcsrp.o dcssm.o \
dgelp.o dlpupd.o dswmm.o dswprt.o \
dswsm.o smmp.o dcsrws.o \
zcsnmi.o zaxpby.o zcsmm.o zcssm.o zswmm.o zswsm.o\
src/serial/psb_dcoins.f90
+16 -8
View File
@@ -31,7 +31,7 @@
! File: psbdcoins.f90
! Subroutine:
! 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_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(:)
type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info
logical, intent(in), optional :: rebuild
character(len=5) :: ufida
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
end if
!!$ if (present(rebuild)) then
!!$ rebuild_ = rebuild
!!$ else
if (present(rebuild)) then
rebuild_ = rebuild
else
rebuild_ = .false.
!!$ end if
end if
call touppers(a%fida,ufida)
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)
if (info > 0) then
if (rebuild_) then
write(0,*) 'COINS: Going through rebuild_ fingers crossed!'
if (debug) write(0,*)&
& 'COINS: Going through rebuild_ fingers crossed!'
irst = info
call psb_nullify_sp(tmp)
tmp%fida='COO'
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_spinfo(psb_nztotreq_,a,nza,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
endif
if (debug) write(0,*)&
& 'COINS: Reinserting',a%fida,nza,isza
if ((nza+nz)>isza) then
call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info)
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
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)
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
call psb_sp_setifld(nza,psb_nnz_,a,info)
end if
else
@@ -292,7 +301,6 @@ contains
real(kind(1.d0)), intent(in) :: val(*)
real(kind(1.d0)), intent(inout) :: aspk(*)
integer, intent(out) :: info
integer :: i,ir,ic
info = 0
src/serial/psb_zcoins.f90
+16 -7
View File
@@ -31,7 +31,7 @@
! File: psbzcoins.f90
! Subroutine:
! 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_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(:)
type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info
logical, optional, intent(in) :: rebuild
character(len=5) :: ufida
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
end if
!!$ if (present(rebuild)) then
!!$ rebuild_ = rebuild
!!$ else
if (present(rebuild)) then
rebuild_ = rebuild
else
rebuild_ = .false.
!!$ end if
end if
call touppers(a%fida,ufida)
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)
if (info > 0) then
if (rebuild_) then
write(0,*) 'COINS: Going through rebuild_ fingers crossed!'
if (debug) write(0,*)&
& 'COINS: Going through rebuild_ fingers crossed!'
irst = info
call psb_nullify_sp(tmp)
tmp%fida='COO'
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_spinfo(psb_nztotreq_,a,nza,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
endif
if (debug) write(0,*)&
& 'COINS: Reinserting',a%fida,nza,isza
if ((nza+nz)>isza) then
call psb_sp_reall(a,max(nza+nz,int(1.5*isza)),info)
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
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)
call psb_sp_setifld(nza,psb_del_bnd_,a,info)
call psb_sp_setifld(nza,psb_nnz_,a,info)
end if
else
src/tools/psb_cdins.f90
+1 -1
View File
@@ -51,7 +51,7 @@ subroutine psb_cdins(nz,ia,ja,desc_a,info,is,js)
!....PARAMETERS...
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(in), optional :: is,js
src/tools/psb_dspalloc.f90
+2 -2
View File
@@ -69,7 +69,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
name = 'psb_dspalloc'
icontxt = desc_a%matrix_data(psb_ctxt_)
dectype=desc_a%matrix_data(psb_dec_type_)
dectype = desc_a%matrix_data(psb_dec_type_)
call blacs_gridinfo(icontxt, nprow, npcol, myrow, mycol)
! ....verify blacs grid correctness..
if (nprow.eq.-1) then
@@ -133,7 +133,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
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_
return
call psb_erractionrestore(err_act)
src/tools/psb_dspins.f90
+10 -3
View File
@@ -44,7 +44,7 @@
! is - integer(optional). The row 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_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(:)
integer, intent(out) :: info
integer, intent(in), optional :: is,js
logical, intent(in), optional :: rebuild
!locals.....
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
logical, parameter :: debug=.false.
integer, parameter :: relocsz=200
logical :: rebuild_
interface psb_cdins
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
end if
if (present(rebuild)) then
rebuild_ = rebuild
else
rebuild_ = .false.
endif
spstate = a%infoa(psb_state_)
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
nrow = desc_a%matrix_data(psb_n_row_)
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
info=4010
ch_err='psb_coins'
src/tools/psb_dsprn.f90
+1
View File
@@ -53,6 +53,7 @@ Subroutine psb_dsprn(a, desc_a,info,clear)
integer, intent(out) :: info
logical, intent(in), optional :: clear
!locals
Integer :: icontxt
Integer :: nprow,npcol,myrow,mycol,err,err_act
src/tools/psb_zspalloc.f90
+1 -1
View File
@@ -133,7 +133,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
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_
return
call psb_erractionrestore(err_act)
src/tools/psb_zspins.f90
+10 -3
View File
@@ -44,7 +44,7 @@
! is - integer(optional). The row 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_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(:)
integer, intent(out) :: info
integer, intent(in), optional :: is,js
logical, intent(in), optional :: rebuild
!locals.....
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
logical, parameter :: debug=.false.
integer, parameter :: relocsz=200
logical :: rebuild_
interface psb_cdins
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
end if
if (present(rebuild)) then
rebuild_ = rebuild
else
rebuild_ = .false.
endif
spstate = a%infoa(psb_state_)
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
nrow = desc_a%matrix_data(psb_n_row_)
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
info=4010
ch_err='psb_coins'