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

Fixes for spmat init in complex data.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 9045cfb288
commit 66955001f2
4 changed files with 108 additions and 110 deletions
Show Stats Download Patch File Download Diff File

9
src/psblas/psb_dspsm.f90
Unescape Escape View File

@ -168,12 +168,8 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
if (present(trans)) then if (present(trans)) then
itrans = toupper(trans) itrans = toupper(trans)
if((itrans.eq.'N').or.(itrans.eq.'T')) then if((itrans.eq.'N').or.(itrans.eq.'T').or. (itrans.eq.'C')) then
! Ok ! OK
else if (itrans.eq.'C') then
info = 3020
call psb_errpush(info,name)
goto 9999
else else
info = 70 info = 70
call psb_errpush(info,name) call psb_errpush(info,name)
@ -505,7 +501,6 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
aliw=.true. aliw=.true.
end if end if
aliw=.true.
if (aliw) then if (aliw) then
call psb_realloc(liwork,iwork,info) call psb_realloc(liwork,iwork,info)
if(info.ne.0) then if(info.ne.0) then

105
src/psblas/psb_zspmm.f90
Unescape Escape View File

@ -95,7 +95,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
complex(kind(1.d0)), optional, pointer :: work(:) complex(kind(1.d0)), optional, target :: work(:)
character, intent(in), optional :: trans character, intent(in), optional :: trans
integer, intent(in), optional :: k, jx, jy,doswap integer, intent(in), optional :: k, jx, jy,doswap
@ -108,6 +108,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
complex(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:), iwork(:) complex(kind(1.d0)),pointer :: tmpx(:), xp(:,:), yp(:,:), iwork(:)
character :: itrans character :: itrans
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw
name='psb_zspmm' name='psb_zspmm'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -160,13 +161,8 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
endif endif
if (present(trans)) then if (present(trans)) then
if ((trans.eq.'N').or.(trans.eq.'T')& if ( (toupper(trans).eq.'N').or.(toupper(trans).eq.'T').or. (toupper(trans).eq.'C')) then
& .or.(trans.eq.'n').or.(trans.eq.'t')) then itrans = toupper(trans)
itrans = trans
else if ((trans.eq.'C').or.(trans.eq.'c')) then
info = 3020
call psb_errpush(info,name)
goto 9999
else else
info = 70 info = 70
call psb_errpush(info,name) call psb_errpush(info,name)
@ -187,26 +183,28 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) liwork = liwork + n * ik if (a%pr(1) /= 0) liwork = liwork + n * ik
if (a%pl(1) /= 0) liwork = liwork + m * ik if (a%pl(1) /= 0) liwork = liwork + m * ik
if (present(work)) then if (present(work)) then
if(size(work).lt.liwork) then if (size(work) >= liwork) then
call psb_realloc(liwork,work,info) aliw =.false.
else
aliw=.true.
endif
else
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
end if
iwork => work
else else
call psb_realloc(liwork,iwork,info) iwork => work
if(info.ne.0) then endif
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
iwork(1)=zzero iwork(1)=zzero
! checking for matrix correctness ! checking for matrix correctness
@ -342,7 +340,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
end if end if
if(.not.present(work)) deallocate(iwork) if(aliw) deallocate(iwork)
nullify(iwork) nullify(iwork)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -432,7 +430,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
complex(kind(1.d0)), optional, pointer :: work(:) complex(kind(1.d0)), optional, target :: work(:)
character, intent(in), optional :: trans character, intent(in), optional :: trans
integer, intent(in), optional :: doswap integer, intent(in), optional :: doswap
@ -445,6 +443,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
complex(kind(1.d0)),pointer :: tmpx(:), iwork(:), xp(:), yp(:) complex(kind(1.d0)),pointer :: tmpx(:), iwork(:), xp(:), yp(:)
character :: itrans character :: itrans
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw
name='psb_zspmv' name='psb_zspmv'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -482,17 +481,13 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
endif endif
if (present(trans)) then if (present(trans)) then
if((trans.eq.'N').or.(trans.eq.'T')) then if ( (toupper(trans).eq.'N').or.(toupper(trans).eq.'T') .or.(toupper(trans).eq.'C')) then
itrans = trans itrans = toupper(trans)
else if (trans.eq.'C') then else
info = 3020 info = 70
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
else end if
info = 70
call psb_errpush(info,name)
goto 9999
end if
else else
itrans = 'N' itrans = 'N'
endif endif
@ -504,33 +499,35 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
lldx = size(x) lldx = size(x)
lldy = size(y) lldy = size(y)
iwork => null()
! check for presence/size of a work area ! check for presence/size of a work area
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) liwork = liwork + n * ik if (a%pr(1) /= 0) liwork = liwork + n * ik
if (a%pl(1) /= 0) liwork = liwork + m * ik if (a%pl(1) /= 0) liwork = liwork + m * ik
! write(0,*)'---->>>',work(1) ! write(0,*)'---->>>',work(1)
if (present(work)) then if (present(work)) then
if(size(work).ge.liwork) then if (size(work) >= liwork) then
iwork => work aliw =.false.
liwork=size(work) else
else aliw=.true.
call psb_realloc(liwork,iwork,info) endif
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
else else
call psb_realloc(liwork,iwork,info) aliw=.true.
if(info.ne.0) then end if
aliw=.true.
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
end if else
iwork => work
endif
! checking for matrix correctness ! checking for matrix correctness
call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja) call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja)
@ -643,9 +640,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
end if end if
if(.not.present(work)) then if(aliw) deallocate(iwork)
deallocate(iwork)
end if
nullify(iwork) nullify(iwork)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

103
src/psblas/psb_zspsm.f90
Unescape Escape View File

@ -90,7 +90,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
complex(kind(1.d0)), intent(in), optional, target :: d(:) complex(kind(1.d0)), intent(in), optional, target :: d(:)
complex(kind(1.d0)), optional, pointer :: work(:) complex(kind(1.d0)), optional, target :: work(:)
character, intent(in), optional :: trans, unitd character, intent(in), optional :: trans, unitd
integer, intent(in), optional :: choice integer, intent(in), optional :: choice
integer, intent(in), optional :: k, jx, jy integer, intent(in), optional :: k, jx, jy
@ -106,6 +106,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
complex(kind(1.d0)),pointer :: iwork(:), xp(:,:), yp(:,:), id(:) complex(kind(1.d0)),pointer :: iwork(:), xp(:,:), yp(:,:), id(:)
character :: itrans character :: itrans
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw
name='psb_zspsm' name='psb_zspsm'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -159,16 +160,16 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
endif endif
if (present(unitd)) then if (present(unitd)) then
lunitd = unitd lunitd = toupper(unitd)
else else
lunitd = 'U' lunitd = 'U'
endif endif
if (present(trans)) then if (present(trans)) then
if ((trans.eq.'N').or.(trans.eq.'T')& itrans = toupper(trans)
& .or.(trans.eq.'n').or.(trans.eq.'t')) then if((itrans.eq.'N').or.(itrans.eq.'T')) then
itrans = trans ! Ok
else if ((trans.eq.'C').or.(trans.eq.'c')) then else if (itrans.eq.'C') then
info = 3020 info = 3020
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
@ -194,29 +195,32 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
end if end if
! check for presence/size of a work area ! check for presence/size of a work area
iwork => null()
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then if (present(work)) then
if(size(work).lt.liwork) then if (size(work) >= liwork) then
call psb_realloc(liwork,work,info) aliw =.false.
else
aliw=.true.
endif
else
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
end if
iwork => work
else else
call psb_realloc(liwork,iwork,info) iwork => work
if(info.ne.0) then endif
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
iwork(1)=0.d0 iwork(1)=0.d0
if(present(d)) then if(present(d)) then
@ -301,7 +305,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
end select end select
end if end if
if(.not.present(work)) deallocate(iwork) if(aliw) deallocate(iwork)
if(.not.present(d)) deallocate(id) if(.not.present(d)) deallocate(id)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -388,6 +392,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
use psi_mod use psi_mod
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
use psb_string_mod
complex(kind(1.D0)), intent(in) :: alpha, beta complex(kind(1.D0)), intent(in) :: alpha, beta
complex(kind(1.d0)), intent(in), target :: x(:) complex(kind(1.d0)), intent(in), target :: x(:)
@ -396,7 +401,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info integer, intent(out) :: info
complex(kind(1.d0)), intent(in), optional, target :: d(:) complex(kind(1.d0)), intent(in), optional, target :: d(:)
complex(kind(1.d0)), optional, pointer :: work(:) complex(kind(1.d0)), optional, target :: work(:)
character, intent(in), optional :: trans, unitd character, intent(in), optional :: trans, unitd
integer, intent(in), optional :: choice integer, intent(in), optional :: choice
@ -411,6 +416,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
complex(kind(1.d0)),pointer :: iwork(:), xp(:), yp(:), id(:) complex(kind(1.d0)),pointer :: iwork(:), xp(:), yp(:), id(:)
character :: itrans character :: itrans
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
logical :: aliw
name='psb_zspsv' name='psb_zspsv'
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -448,23 +454,20 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
endif endif
if (present(unitd)) then if (present(unitd)) then
lunitd = unitd lunitd = toupper(unitd)
else else
lunitd = 'U' lunitd = 'U'
endif endif
if (present(trans)) then if (present(trans)) then
if((trans.eq.'N').or.(trans.eq.'T')) then itrans = toupper(trans)
itrans = trans if((itrans.eq.'N').or.(itrans.eq.'T').or.(itrans.eq.'C')) then
else if (trans.eq.'C') then ! Ok
info = 3020 else
call psb_errpush(info,name) info = 70
goto 9999 call psb_errpush(info,name)
else goto 9999
info = 70 end if
call psb_errpush(info,name)
goto 9999
end if
else else
itrans = 'N' itrans = 'N'
endif endif
@ -481,30 +484,34 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
goto 9999 goto 9999
end if end if
iwork => null()
! check for presence/size of a work area ! check for presence/size of a work area
liwork= 2*ncol liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then if (present(work)) then
if(size(work).lt.liwork) then if (size(work) >= liwork) then
call psb_realloc(liwork,work,info) aliw =.false.
if(info.ne.0) then else
info=4010 aliw=.true.
ch_err='psb_realloc' endif
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
iwork => work
else else
call psb_realloc(liwork,iwork,info) aliw=.true.
if(info.ne.0) then end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010 info=4010
ch_err='psb_realloc' ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
end if else
iwork => work
endif
iwork(1)=0.d0 iwork(1)=0.d0
if(present(d)) then if(present(d)) then
@ -588,7 +595,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
end select end select
end if end if
if(.not.present(work)) deallocate(iwork) if (aliw) deallocate(iwork)
if(.not.present(d)) deallocate(id) if(.not.present(d)) deallocate(id)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

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

@ -96,6 +96,7 @@ Subroutine psb_zcdovrbld(n_ovr,desc_p,desc_a,a,&
icontxt = desc_a%matrix_data(psb_ctxt_) icontxt = desc_a%matrix_data(psb_ctxt_)
!!$ call blacs_barrier(icontxt,'All') !!$ call blacs_barrier(icontxt,'All')
Call blacs_gridinfo(icontxt,np,npcol,myrow,mycol) Call blacs_gridinfo(icontxt,np,npcol,myrow,mycol)
call psb_nullify_sp(blk)
Allocate(brvindx(np+1),rvsz(np),sdsz(np),bsdindx(np+1),stat=info) Allocate(brvindx(np+1),rvsz(np),sdsz(np),bsdindx(np+1),stat=info)
tl = 0.0 tl = 0.0

Write Preview
Loading…
Cancel
Save