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

*** empty log message ***

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent e97cd11ce0
commit 62d596676a
2 changed files with 105 additions and 118 deletions
Show Stats Download Patch File Download Diff File

15
src/psblas/psb_damax.f90
Unescape Escape View File

@ -60,8 +60,7 @@ function psb_damax (x,desc_a, info, jx)
! locals ! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i, k, imax, idamax & err_act, n, iix, jjx, temp(2), ix, ijx, m, i, k, imax, idamax
real(kind(1.d0)) :: locmax(2), amax real(kind(1.d0)) :: amax
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_damax' name='psb_damax'
@ -69,7 +68,6 @@ function psb_damax (x,desc_a, info, jx)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
locmax(:)=0.d0
amax=0.d0 amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_) icontxt=desc_a%matrix_data(psb_ctxt_)
@ -194,8 +192,7 @@ function psb_damaxv (x,desc_a, info)
! locals ! locals
integer :: int_err(5), err, icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), err, icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, jx, temp(2), ix, ijx, m, imax, idamax & err_act, n, iix, jjx, jx, temp(2), ix, ijx, m, imax, idamax
real(kind(1.d0)) :: locmax(2), amax real(kind(1.d0)) :: amax
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_damaxv' name='psb_damaxv'
@ -203,7 +200,6 @@ function psb_damaxv (x,desc_a, info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
locmax(:)=0.d0
amax=0.d0 amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_) icontxt=desc_a%matrix_data(psb_ctxt_)
@ -325,7 +321,7 @@ subroutine psb_damaxvs (res,x,desc_a, info)
! locals ! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, imax, idamax & err_act, n, iix, jjx, temp(2), ix, ijx, m, imax, idamax
real(kind(1.d0)) :: locmax(2), amax real(kind(1.d0)) :: amax
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_damaxvs' name='psb_damaxvs'
@ -333,7 +329,6 @@ subroutine psb_damaxvs (res,x,desc_a, info)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
locmax(:)=0.d0
amax=0.d0 amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_) icontxt=desc_a%matrix_data(psb_ctxt_)
@ -454,8 +449,7 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
! locals ! locals
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, ix, temp(2), ijx, m, imax, i, k, idamax & err_act, n, iix, jjx, ix, temp(2), ijx, m, imax, i, k, idamax
real(kind(1.d0)) :: locmax(2), amax real(kind(1.d0)) :: amax
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dmamaxs' name='psb_dmamaxs'
@ -463,7 +457,6 @@ subroutine psb_dmamaxs (res,x,desc_a, info,jx)
info=0 info=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
locmax(:)=0.d0
amax=0.d0 amax=0.d0
icontxt=desc_a%matrix_data(psb_ctxt_) icontxt=desc_a%matrix_data(psb_ctxt_)

30
src/psblas/psb_dasum.f90
Unescape Escape View File

@ -49,6 +49,7 @@ function psb_dasum (x,desc_a, info, jx)
use psb_descriptor_type use psb_descriptor_type
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
use psb_blacs_mod
implicit none implicit none
real(kind(1.d0)), intent(in) :: x(:,:) real(kind(1.d0)), intent(in) :: x(:,:)
@ -61,7 +62,6 @@ function psb_dasum (x,desc_a, info, jx)
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, ijx, m, i & err_act, n, iix, jjx, temp(2), ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum real(kind(1.d0)) :: asum, dasum
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasum' name='psb_dasum'
@ -120,19 +120,17 @@ function psb_dasum (x,desc_a, info, jx)
do while (desc_a%ovrlap_elem(i).ne.-ione) do while (desc_a%ovrlap_elem(i).ne.-ione)
asum = asum -& asum = asum -&
& (desc_a%ovrlap_elem(i+1)-1)/desc_a%ovrlap_elem(i+1)*& & (desc_a%ovrlap_elem(i+1)-1)/desc_a%ovrlap_elem(i+1)*&
& tmpx(desc_a%ovrlap_elem(i)) & abs(x(desc_a%ovrlap_elem(i)-iix+1,jjx))
i = i+2 i = i+2
end do end do
! compute global sum ! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, asum,& call gsum2d(icontxt, 'A', asum)
& ione, mone ,mycol)
else else
asum=0.d0 asum=0.d0
! compute global sum ! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, asum,& call gsum2d(icontxt, 'A', asum)
& ione, mone ,mycol)
end if end if
else else
asum=0.d0 asum=0.d0
@ -201,6 +199,7 @@ function psb_dasumv (x,desc_a, info)
use psb_descriptor_type use psb_descriptor_type
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
use psb_blacs_mod
implicit none implicit none
real(kind(1.d0)), intent(in) :: x(:) real(kind(1.d0)), intent(in) :: x(:)
@ -212,7 +211,6 @@ function psb_dasumv (x,desc_a, info)
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i & err_act, n, iix, jjx, temp(2), jx, ix, ijx, m, i
real(kind(1.d0)) :: asum, dasum real(kind(1.d0)) :: asum, dasum
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasumv' name='psb_dasumv'
@ -267,19 +265,17 @@ function psb_dasumv (x,desc_a, info)
do while (desc_a%ovrlap_elem(i).ne.-ione) do while (desc_a%ovrlap_elem(i).ne.-ione)
asum = asum -& asum = asum -&
& (desc_a%ovrlap_elem(i+1)-1)/desc_a%ovrlap_elem(i+1)*& & (desc_a%ovrlap_elem(i+1)-1)/desc_a%ovrlap_elem(i+1)*&
& tmpx(desc_a%ovrlap_elem(i)) & abs(x(desc_a%ovrlap_elem(i)))
i = i+2 i = i+2
end do end do
! compute global sum ! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, asum,& call gsum2d(icontxt, 'A', asum)
& ione, mone ,mycol)
else else
asum=0.d0 asum=0.d0
! compute global sum ! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, asum,& call gsum2d(icontxt, 'A', asum)
& ione, mone ,mycol)
end if end if
else else
asum=0.d0 asum=0.d0
@ -348,6 +344,7 @@ subroutine psb_dasumvs (res,x,desc_a, info)
use psb_descriptor_type use psb_descriptor_type
use psb_check_mod use psb_check_mod
use psb_error_mod use psb_error_mod
use psb_blacs_mod
implicit none implicit none
real(kind(1.d0)), intent(in) :: x(:) real(kind(1.d0)), intent(in) :: x(:)
@ -359,7 +356,6 @@ subroutine psb_dasumvs (res,x,desc_a, info)
integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,& integer :: int_err(5), icontxt, nprow, npcol, myrow, mycol,&
& err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i & err_act, n, iix, jjx, temp(2), ix, jx, ijx, m, i
real(kind(1.d0)) :: asum, dasum real(kind(1.d0)) :: asum, dasum
real(kind(1.d0)),pointer :: tmpx(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
name='psb_dasumvs' name='psb_dasumvs'
@ -414,19 +410,17 @@ subroutine psb_dasumvs (res,x,desc_a, info)
do while (desc_a%ovrlap_elem(i).ne.-ione) do while (desc_a%ovrlap_elem(i).ne.-ione)
asum = asum -& asum = asum -&
& (desc_a%ovrlap_elem(i+1)-1)/desc_a%ovrlap_elem(i+1)*& & (desc_a%ovrlap_elem(i+1)-1)/desc_a%ovrlap_elem(i+1)*&
& tmpx(desc_a%ovrlap_elem(i)) & abs(x(desc_a%ovrlap_elem(i)))
i = i+2 i = i+2
end do end do
! compute global sum ! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, asum,& call gsum2d(icontxt, 'A',asum)
& ione, mone ,mycol)
else else
asum=0.d0 asum=0.d0
! compute global sum ! compute global sum
call dgsum2d(icontxt, 'A', ' ', ione, ione, asum,& call gsum2d(icontxt, 'A', asum)
& ione, mone ,mycol)
end if end if
else else
asum=0.d0 asum=0.d0

Write Preview
Loading…
Cancel
Save