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

71
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_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), optional, pointer :: work(:)
complex(kind(1.d0)), optional, target :: work(:)
character, intent(in), optional :: trans
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(:)
character :: itrans
character(len=20) :: name, ch_err
logical :: aliw
name='psb_zspmm'
if(psb_get_errstatus().ne.0) return
@ -160,13 +161,8 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(trans)) then
if ((trans.eq.'N').or.(trans.eq.'T')&
& .or.(trans.eq.'n').or.(trans.eq.'t')) then
itrans = trans
else if ((trans.eq.'C').or.(trans.eq.'c')) then
info = 3020
call psb_errpush(info,name)
goto 9999
if ( (toupper(trans).eq.'N').or.(toupper(trans).eq.'T').or. (toupper(trans).eq.'C')) then
itrans = toupper(trans)
else
info = 70
call psb_errpush(info,name)
@ -188,17 +184,16 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
if (a%pr(1) /= 0) liwork = liwork + n * ik
if (a%pl(1) /= 0) liwork = liwork + m * ik
if (present(work)) then
if(size(work).lt.liwork) then
call psb_realloc(liwork,work,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (size(work) >= liwork) then
aliw =.false.
else
aliw=.true.
endif
iwork => work
else
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
@ -206,7 +201,10 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
endif
iwork(1)=zzero
! checking for matrix correctness
@ -342,7 +340,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
end if
if(.not.present(work)) deallocate(iwork)
if(aliw) deallocate(iwork)
nullify(iwork)
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_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), optional, pointer :: work(:)
complex(kind(1.d0)), optional, target :: work(:)
character, intent(in), optional :: trans
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(:)
character :: itrans
character(len=20) :: name, ch_err
logical :: aliw
name='psb_zspmv'
if(psb_get_errstatus().ne.0) return
@ -482,12 +481,8 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(trans)) then
if((trans.eq.'N').or.(trans.eq.'T')) then
itrans = trans
else if (trans.eq.'C') then
info = 3020
call psb_errpush(info,name)
goto 9999
if ( (toupper(trans).eq.'N').or.(toupper(trans).eq.'T') .or.(toupper(trans).eq.'C')) then
itrans = toupper(trans)
else
info = 70
call psb_errpush(info,name)
@ -504,25 +499,24 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
lldx = size(x)
lldy = size(y)
iwork => null()
! check for presence/size of a work area
liwork= 2*ncol
if (a%pr(1) /= 0) liwork = liwork + n * ik
if (a%pl(1) /= 0) liwork = liwork + m * ik
! write(0,*)'---->>>',work(1)
if (present(work)) then
if(size(work).ge.liwork) then
iwork => work
liwork=size(work)
if (size(work) >= liwork) then
aliw =.false.
else
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
aliw=.true.
endif
else
aliw=.true.
end if
aliw=.true.
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
@ -530,8 +524,11 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
endif
! checking for matrix correctness
call psb_chkmat(m,n,ia,ja,desc_a%matrix_data,info,iia,jja)
if(info.ne.0) then
@ -643,9 +640,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
end if
if(.not.present(work)) then
deallocate(iwork)
end if
if(aliw) deallocate(iwork)
nullify(iwork)
call psb_erractionrestore(err_act)

75
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
integer, intent(out) :: info
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
integer, intent(in), optional :: choice
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(:)
character :: itrans
character(len=20) :: name, ch_err
logical :: aliw
name='psb_zspsm'
if(psb_get_errstatus().ne.0) return
@ -159,16 +160,16 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(unitd)) then
lunitd = unitd
lunitd = toupper(unitd)
else
lunitd = 'U'
endif
if (present(trans)) then
if ((trans.eq.'N').or.(trans.eq.'T')&
& .or.(trans.eq.'n').or.(trans.eq.'t')) then
itrans = trans
else if ((trans.eq.'C').or.(trans.eq.'c')) then
itrans = toupper(trans)
if((itrans.eq.'N').or.(itrans.eq.'T')) then
! Ok
else if (itrans.eq.'C') then
info = 3020
call psb_errpush(info,name)
goto 9999
@ -194,21 +195,21 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
end if
! check for presence/size of a work area
iwork => null()
liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then
if(size(work).lt.liwork) then
call psb_realloc(liwork,work,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (size(work) >= liwork) then
aliw =.false.
else
aliw=.true.
endif
iwork => work
else
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
@ -216,7 +217,10 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
endif
iwork(1)=0.d0
if(present(d)) then
@ -301,7 +305,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
end select
end if
if(.not.present(work)) deallocate(iwork)
if(aliw) deallocate(iwork)
if(.not.present(d)) deallocate(id)
call psb_erractionrestore(err_act)
@ -388,6 +392,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
use psi_mod
use psb_check_mod
use psb_error_mod
use psb_string_mod
complex(kind(1.D0)), intent(in) :: alpha, beta
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
integer, intent(out) :: info
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
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(:)
character :: itrans
character(len=20) :: name, ch_err
logical :: aliw
name='psb_zspsv'
if(psb_get_errstatus().ne.0) return
@ -448,18 +454,15 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
endif
if (present(unitd)) then
lunitd = unitd
lunitd = toupper(unitd)
else
lunitd = 'U'
endif
if (present(trans)) then
if((trans.eq.'N').or.(trans.eq.'T')) then
itrans = trans
else if (trans.eq.'C') then
info = 3020
call psb_errpush(info,name)
goto 9999
itrans = toupper(trans)
if((itrans.eq.'N').or.(itrans.eq.'T').or.(itrans.eq.'C')) then
! Ok
else
info = 70
call psb_errpush(info,name)
@ -481,22 +484,23 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
goto 9999
end if
iwork => null()
! check for presence/size of a work area
liwork= 2*ncol
if (a%pr(1) /= 0) llwork = liwork + m * ik
if (a%pl(1) /= 0) llwork = llwork + m * ik
if (present(work)) then
if(size(work).lt.liwork) then
call psb_realloc(liwork,work,info)
if(info.ne.0) then
info=4010
ch_err='psb_realloc'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (size(work) >= liwork) then
aliw =.false.
else
aliw=.true.
endif
iwork => work
else
aliw=.true.
end if
if (aliw) then
call psb_realloc(liwork,iwork,info)
if(info.ne.0) then
info=4010
@ -504,7 +508,10 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
else
iwork => work
endif
iwork(1)=0.d0
if(present(d)) then
@ -588,7 +595,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
end select
end if
if(.not.present(work)) deallocate(iwork)
if (aliw) deallocate(iwork)
if(.not.present(d)) deallocate(id)
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_)
!!$ call blacs_barrier(icontxt,'All')
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)
tl = 0.0

Write Preview
Loading…
Cancel
Save