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

Inserted calls to new getters for descriptor. Fixed cd_transfer.

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 53193622ef
commit 264d07d678
22 changed files with 81 additions and 104 deletions
Show Stats Download Patch File Download Diff File

9
src/prec/psb_dasmatbld.f90
Unescape Escape View File

@ -190,12 +190,17 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
end if
Endif
if(debug) write(0,*) me,' From cdovr _:',desc_p%matrix_data(psb_n_row_),desc_p%matrix_data(psb_n_col_)
if(debug) write(0,*) me,' From cdovr _:',desc_p%matrix_data(psb_n_row_),&
& desc_p%matrix_data(psb_n_col_)
n_row = desc_p%matrix_data(psb_n_row_)
t2 = mpi_wtime()
!!$ open(60+me)
!!$ call psb_cdprt(60+me,desc_p,short=.false.)
!!$ call flush(60+me)
!!$ close(60+me)
!!$ call psb_barrier(ictxt)
if (debug) write(0,*) 'Before sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
!!$ ierr = MPE_Log_event( iovrb, 0, "st OVR" )
!!$ blk%m = n_row-nrow_a

3
src/prec/psb_dbaseprc_bld.f90
Unescape Escape View File

@ -131,10 +131,11 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering baseprc_bld'
info = 0
int_err(1) = 0
ictxt = psb_cd_get_context(desc_a)
ictxt = psb_cd_get_context(desc_a)
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_cd_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np)

11
src/prec/psb_dbldaggrmat.f90
Unescape Escape View File

@ -61,6 +61,7 @@ subroutine psb_dbldaggrmat(a,desc_a,ac,desc_ac,p,info)
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np)
select case (p%iprcparm(smth_kind_))
@ -156,6 +157,7 @@ contains
nzt = psb_sp_get_nnzeros(a)
call psb_sp_all(b,nzt,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spall')
@ -177,6 +179,7 @@ contains
end if
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
@ -217,13 +220,9 @@ contains
!!$ enddo
end if
call psb_fixcoo(b,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='fixcoo')
goto 9999
end if
irs = psb_sp_get_nnzeros(b)
call psb_sp_reall(b,irs,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spreall')
@ -403,6 +402,7 @@ contains
call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np)
call psb_nullify_sp(b)
@ -883,6 +883,7 @@ contains
if (np>1) then
nzl = psb_sp_get_nnzeros(am1)
call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I')
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_glob_to_loc')
goto 9999

7
src/prec/psb_ddiagsc_bld.f90
Unescape Escape View File

@ -76,9 +76,10 @@ subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info)
info = 0
int_err(1) = 0
ictxt = psb_cd_get_context(desc_a)
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_cd_get_global_rows(desc_a)
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_cd_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np)

1
src/prec/psb_dgenaggrmap.f90
Unescape Escape View File

@ -71,7 +71,6 @@ subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
nr = a%m
allocate(ilaggr(nr),neigh(nr),stat=info)
if(info.ne.0) then

1
src/prec/psb_dilu_fct.f90
Unescape Escape View File

@ -60,6 +60,7 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
type(psb_dspmat_type), pointer :: blck_
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
name='psb_dcsrlu'
info = 0
call psb_erractionsave(err_act)

2
src/prec/psb_dmlprc_aply.f90
Unescape Escape View File

@ -303,7 +303,6 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
!
n_col = desc_data%matrix_data(psb_n_col_)
nr2l = baseprecv(1)%desc_data%matrix_data(psb_n_col_)
@ -601,7 +600,6 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
mlprec_wrk(1)%tx(:) = dzero
mlprec_wrk(1)%ty(:) = dzero
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999

19
src/prec/psb_dmlprc_bld.f90
Unescape Escape View File

@ -42,6 +42,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
use psb_prec_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
type(psb_dspmat_type), intent(in), target :: a
@ -49,7 +50,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
type(psb_dbaseprc_type), intent(inout),target :: p
integer, intent(out) :: info
type(psb_desc_type), pointer :: desc_ac
type(psb_desc_type) :: desc_ac
integer :: i, nrg, nzg, err_act,k
character(len=20) :: name, ch_err
@ -99,8 +100,10 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
integer :: ictxt, np, me
name='psb_mlprec_bld'
if(psb_get_errstatus().ne.0) return
info=0
if (psb_get_errstatus().ne.0) return
info = 0
ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np)
call psb_erractionsave(err_act)
call psb_nullify_sp(ac)
@ -146,8 +149,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
end if
if (debug) write(0,*) 'Out from genaggrmap',p%nlaggr
nullify(desc_ac)
allocate(desc_ac)
call psb_nullify_desc(desc_ac)
call psb_bldaggrmat(a,desc_a,ac,desc_ac,p,info)
if(info /= 0) then
@ -180,6 +182,13 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
call psb_sp_transfer(ac,p%av(ac_),info)
p%base_a => p%av(ac_)
call psb_cdtransfer(desc_ac,p%desc_ac,info)
if (info /= 0) then
info=4010
ch_err='psb_cdtransfer'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
p%base_desc => p%desc_ac
call psb_erractionrestore(err_act)

35
src/prec/psb_dprecbld.f90
Unescape Escape View File

@ -46,6 +46,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
use psb_psblas_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
Implicit None
type(psb_dspmat_type), target :: a
@ -54,34 +55,6 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
integer, intent(out) :: info
character, intent(in), optional :: upd
interface psb_baseprc_bld
subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
Use psb_spmat_type
use psb_descriptor_type
use psb_prec_type
type(psb_dspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_dbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine psb_dbaseprc_bld
end interface
interface psb_mlprc_bld
subroutine psb_dmlprc_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_dbaseprc_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine psb_dmlprc_bld
end interface
! Local scalars
Integer :: err,i,j,k,ictxt, me,np,lw, err_act
integer :: int_err(5)
@ -150,6 +123,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
if (size(p%baseprecv) > 1) then
do i=2, size(p%baseprecv)
call init_baseprc_av(p%baseprecv(i),info)
if (info /= 0) then
info=4010
@ -157,7 +131,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
endif
call psb_mlprc_bld(p%baseprecv(i-1)%base_a,p%baseprecv(i-1)%base_desc,&
& p%baseprecv(i),info)
if (info /= 0) then
@ -168,7 +142,7 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
if (debug) then
write(0,*) 'Return from ',i-1,' call to mlprcbld ',info
endif
end do
endif
@ -197,6 +171,7 @@ contains
do k=1,size(p%av)
call psb_nullify_sp(p%av(k))
end do
end subroutine init_baseprc_av
end subroutine psb_dprecbld

16
src/prec/psb_dprecset.f90
Unescape Escape View File

@ -80,15 +80,10 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
return
endif
if (.not.allocated(p%baseprecv(ilev_)%iprcparm)) then
call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info)
if (info /= 0) then
write(0,*) 'Info from realloc ',info
return
end if
p%baseprecv(ilev_)%iprcparm(:) = 0
end if
call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info)
if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info)
if (info /= 0) return
p%baseprecv(ilev_)%iprcparm(:) = 0
select case(toupper(ptype(1:len_trim(ptype))))
case ('NONE','NOPREC')
@ -125,7 +120,7 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
case ('ASM','AS')
p%baseprecv(ilev_)%iprcparm(:) = 0
! Defaults first
p%baseprecv(ilev_)%iprcparm(p_type_) = asm_
p%baseprecv(ilev_)%iprcparm(p_type_) = asm_
p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_
p%baseprecv(ilev_)%iprcparm(restr_) = psb_halo_
p%baseprecv(ilev_)%iprcparm(prol_) = psb_none_
@ -133,6 +128,7 @@ subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
p%baseprecv(ilev_)%iprcparm(n_ovr_) = 1
p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0
p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1
if (present(iv)) then
isz = size(iv)
if (isz >= 1) p%baseprecv(ilev_)%iprcparm(n_ovr_) = iv(1)

1
src/prec/psb_dslu_bld.f90
Unescape Escape View File

@ -166,6 +166,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
goto 9999
end if
nzt = psb_sp_get_nnzeros(atmp)
if (Debug) then
write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,&
& atmp%k,p%desc_data%matrix_data(psb_n_row_)

2
src/prec/psb_dsp_renum.f90
Unescape Escape View File

@ -69,6 +69,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np)
!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A
@ -85,6 +86,7 @@ subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
! This is the renumbering coherent with global indices..
mglob = psb_cd_get_global_rows(desc_a)
!
! Remember: we have switched IA1=COLS and IA2=ROWS
! Now identify the set of distinct local column indices

1
src/prec/psb_dumf_bld.f90
Unescape Escape View File

@ -99,6 +99,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
end if
nza = psb_sp_get_nnzeros(atmp)
nzb = psb_sp_get_nnzeros(a)
if (Debug) then
write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb
call psb_barrier(ictxt)

8
src/prec/psb_zbaseprc_bld.f90
Unescape Escape View File

@ -131,10 +131,10 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
if (debug) write(0,*) 'Entering baseprc_bld'
info = 0
int_err(1) = 0
ictxt = psb_cd_get_context(desc_a)
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_cd_get_global_rows(desc_a)
ictxt = psb_cd_get_context(desc_a)
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_cd_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np)

6
src/prec/psb_zbldaggrmat.f90
Unescape Escape View File

@ -61,6 +61,7 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,desc_ac,p,info)
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np)
select case (p%iprcparm(smth_kind_))
@ -155,6 +156,7 @@ contains
nzt = psb_sp_get_nnzeros(a)
call psb_sp_all(b,nzt,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spall')
@ -176,6 +178,7 @@ contains
end if
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
@ -223,6 +226,7 @@ contains
end if
irs = psb_sp_get_nnzeros(b)
call psb_sp_reall(b,irs,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='spreall')
@ -402,6 +406,7 @@ contains
call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt, me, np)
call psb_nullify_sp(b)
@ -882,6 +887,7 @@ contains
if (np>1) then
nzl = psb_sp_get_nnzeros(am1)
call psb_glob_to_loc(am1%ia1(1:nzl),desc_ac,info,'I')
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_glob_to_loc')
goto 9999

9
src/prec/psb_zdiagsc_bld.f90
Unescape Escape View File

@ -75,10 +75,11 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info)
if (debug) write(0,*) 'Entering diagsc_bld'
info = 0
int_err(1) = 0
ictxt = psb_cd_get_context(desc_a)
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_cd_get_global_rows(desc_a)
ictxt = psb_cd_get_context(desc_a)
n_row = psb_cd_get_local_rows(desc_a)
n_col = psb_cd_get_local_cols(desc_a)
mglob = psb_cd_get_global_rows(desc_a)
if (debug) write(0,*) 'Preconditioner Blacs_gridinfo'
call psb_info(ictxt, me, np)

1
src/prec/psb_zgenaggrmap.f90
Unescape Escape View File

@ -71,7 +71,6 @@ subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
nr = a%m
allocate(ilaggr(nr),neigh(nr),stat=info)
if(info.ne.0) then

1
src/prec/psb_zilu_bld.f90
Unescape Escape View File

@ -232,6 +232,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
nztota = psb_sp_get_nnzeros(a)
nztotb = psb_sp_get_nnzeros(blck)
call psb_sp_all(atmp,nztota+nztotb,info)
if(info/=0) then
info=4011

4
src/prec/psb_zmlprc_aply.f90
Unescape Escape View File

@ -283,7 +283,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
case(post_smooth_)
!
! Post smoothing.
! 1. X(1) = Xext
@ -302,7 +301,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
!
!
n_col = desc_data%matrix_data(psb_n_col_)
nr2l = baseprecv(1)%desc_data%matrix_data(psb_n_col_)
@ -420,7 +418,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
case(pre_smooth_)
!
! Pre smoothing.
! 1. X(1) = Xext
@ -600,7 +597,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
mlprec_wrk(1)%tx(:) = zzero
mlprec_wrk(1)%ty(:) = zzero
if (info /= 0) then
call psb_errpush(4010,name,a_err='Allocate')
goto 9999

19
src/prec/psb_zmlprc_bld.f90
Unescape Escape View File

@ -42,6 +42,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
use psb_prec_type
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
type(psb_zspmat_type), intent(in), target :: a
@ -49,7 +50,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
type(psb_zbaseprc_type), intent(inout),target :: p
integer, intent(out) :: info
type(psb_desc_type), pointer :: desc_ac
type(psb_desc_type) :: desc_ac
integer :: i, nrg, nzg, err_act,k
character(len=20) :: name, ch_err
@ -99,8 +100,10 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
integer :: ictxt, np, me
name='psb_mlprec_bld'
if(psb_get_errstatus().ne.0) return
info=0
if (psb_get_errstatus().ne.0) return
info = 0
ictxt = psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np)
call psb_erractionsave(err_act)
call psb_nullify_sp(ac)
@ -146,8 +149,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
end if
if (debug) write(0,*) 'Out from genaggrmap',p%nlaggr
nullify(desc_ac)
allocate(desc_ac)
call psb_nullify_desc(desc_ac)
call psb_bldaggrmat(a,desc_a,ac,desc_ac,p,info)
if(info /= 0) then
@ -180,6 +182,13 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
call psb_sp_transfer(ac,p%av(ac_),info)
p%base_a => p%av(ac_)
call psb_cdtransfer(desc_ac,p%desc_ac,info)
if (info /= 0) then
info=4010
ch_err='psb_cdtransfer'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
p%base_desc => p%desc_ac
call psb_erractionrestore(err_act)

28
src/prec/psb_zprecbld.f90
Unescape Escape View File

@ -46,6 +46,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
use psb_psblas_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
Implicit None
type(psb_zspmat_type), target :: a
@ -54,33 +55,6 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd)
integer, intent(out) :: info
character, intent(in), optional :: upd
interface psb_baseprc_bld
subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
Use psb_spmat_type
use psb_descriptor_type
use psb_prec_type
type(psb_zspmat_type), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_zbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine psb_zbaseprc_bld
end interface
interface psb_mlprc_bld
subroutine psb_zmlprc_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_zbaseprc_type), intent(inout),target :: p
integer, intent(out) :: info
end subroutine psb_zmlprc_bld
end interface
! Local scalars
Integer :: err,i,j,k,ictxt, me,np,lw, err_act

1
src/prec/psb_zprecset.f90
Unescape Escape View File

@ -39,6 +39,7 @@ subroutine psb_zprecset(p,ptype,info,iv,rs,rv,ilev,nlev)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_string_mod
implicit none
type(psb_zprec_type), intent(inout) :: p

Write Preview
Loading…
Cancel
Save