From f53a40b39af1a9406319acfa67bae6199c62262f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 8 Jan 2008 09:29:17 +0000 Subject: [PATCH] Fixed doswap variable and internal action. --- base/modules/psb_psblas_mod.f90 | 10 ++-- base/psblas/psb_dspmm.f90 | 91 +++++++++++++++---------------- base/psblas/psb_zspmm.f90 | 95 +++++++++++++++++---------------- 3 files changed, 98 insertions(+), 98 deletions(-) diff --git a/base/modules/psb_psblas_mod.f90 b/base/modules/psb_psblas_mod.f90 index e8dd0bfa..1c5640f4 100644 --- a/base/modules/psb_psblas_mod.f90 +++ b/base/modules/psb_psblas_mod.f90 @@ -348,7 +348,8 @@ module psb_psblas_mod type(psb_desc_type), intent(in) :: desc_a character, optional, intent(in) :: trans real(kind(1.d0)), optional, intent(inout),target :: work(:) - integer, optional, intent(in) :: k, jx, jy,doswap + integer, optional, intent(in) :: k, jx, jy + logical, optional, intent(in) :: doswap integer, intent(out) :: info end subroutine psb_dspmm subroutine psb_dspmv(alpha, a, x, beta, y,& @@ -362,7 +363,7 @@ module psb_psblas_mod type(psb_desc_type), intent(in) :: desc_a character, optional, intent(in) :: trans real(kind(1.d0)), optional, intent(inout),target :: work(:) - integer, optional, intent(in) :: doswap + logical, optional, intent(in) :: doswap integer, intent(out) :: info end subroutine psb_dspmv subroutine psb_zspmm(alpha, a, x, beta, y, desc_a, info,& @@ -376,7 +377,8 @@ module psb_psblas_mod type(psb_desc_type), intent(in) :: desc_a character, optional, intent(in) :: trans complex(kind(1.d0)), optional, intent(inout),target :: work(:) - integer, optional, intent(in) :: k, jx, jy,doswap + integer, optional, intent(in) :: k, jx, jy + logical, optional, intent(in) :: doswap integer, intent(out) :: info end subroutine psb_zspmm subroutine psb_zspmv(alpha, a, x, beta, y,& @@ -390,7 +392,7 @@ module psb_psblas_mod type(psb_desc_type), intent(in) :: desc_a character, optional, intent(in) :: trans complex(kind(1.d0)), optional, intent(inout),target :: work(:) - integer, optional, intent(in) :: doswap + logical, optional, intent(in) :: doswap integer, intent(out) :: info end subroutine psb_zspmv end interface diff --git a/base/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 index beea0d7c..1151163d 100644 --- a/base/psblas/psb_dspmm.f90 +++ b/base/psblas/psb_dspmm.f90 @@ -59,7 +59,7 @@ ! jx - integer(optional). The column offset for ( X ). Default: 1 ! jy - integer(optional). The column offset for ( Y ). Default: 1 ! work(:) - real,(optional). Working area. -! doswap - integer(optional). Whether to performe halo updates. +! doswap - logical(optional). Whether to performe halo updates. ! subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& & trans, k, jx, jy, work, doswap) @@ -83,18 +83,19 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& integer, intent(out) :: info real(kind(1.d0)), optional, target :: work(:) character, intent(in), optional :: trans - integer, intent(in), optional :: k, jx, jy,doswap + integer, intent(in), optional :: k, jx, jy + logical, intent(in), optional :: doswap ! locals integer :: ictxt, np, me,& & err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,& - & idoswap, m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,& + & m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,& & i, ib, ib1 integer, parameter :: nb=4 real(kind(1.d0)),pointer :: xp(:,:), yp(:,:), iwork(:) - character :: itrans + character :: trans_ character(len=20) :: name, ch_err - logical :: aliw + logical :: aliw, doswap_ name='psb_dspmm' if(psb_get_errstatus() /= 0) return @@ -128,9 +129,9 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& endif if (present(doswap)) then - idoswap = doswap + doswap_ = doswap else - idoswap = 1 + doswap_ = .true. endif if (present(k)) then @@ -141,23 +142,22 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& endif if (present(trans)) then - if ( (toupper(trans) == 'N').or.(toupper(trans) == 'T')& - & .or.(toupper(trans) == 'C')) then - itrans = toupper(trans) - else - info = 70 - call psb_errpush(info,name) - goto 9999 - end if + trans_ = toupper(trans) else - itrans = 'N' + trans_ = 'N' endif + if ( (trans_ == 'N').or.(trans_ == 'T')& + & .or.(trans_ == 'C')) then + else + info = 70 + call psb_errpush(info,name) + goto 9999 + end if m = psb_cd_get_global_rows(desc_a) n = psb_cd_get_global_cols(desc_a) nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - lldx = size(x,1) lldy = size(y,1) @@ -199,7 +199,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& end if - if (itrans == 'N') then + if (trans_ == 'N') then ! Matrix is not transposed if((ja /= ix).or.(ia /= iy)) then ! this case is not yet implemented @@ -229,7 +229,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& ib1=min(nb,ik) xp => x(iix:lldx,jjx:jjx+ib1-1) - if(idoswap > 0)& + if (doswap_)& & call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& & ib1,dzero,xp,desc_a,iwork,info) @@ -238,7 +238,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& ib=ib1 ib1 = max(0,min(nb,(ik)-(i-1+ib))) xp => x(iix:lldx,jjx+i+ib-1:jjx+i+ib+ib1-2) - if((ib1 > 0).and.(idoswap > 0))& + if ((ib1 > 0).and.(doswap_)) & & call psi_swapdata(psb_swap_send_,ib1,& & dzero,xp,desc_a,iwork,info) @@ -246,11 +246,11 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& ! local Matrix-vector product call psb_csmm(alpha,a,x(iix:lldx,jjx:jjx+ib-1),& - & beta,y(iiy:lldy,jjy:jjy+ib-1),info,trans=itrans) + & beta,y(iiy:lldy,jjy:jjy+ib-1),info,trans=trans_) if(info /= 0) exit blk - if((ib1 > 0).and.(idoswap > 0))& + if((ib1 > 0).and.(doswap_))& & call psi_swapdata(psb_swap_send_,ib1,& & dzero,xp,desc_a,iwork,info) @@ -301,7 +301,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& ! local Matrix-vector product call psb_csmm(alpha,a,x(iix:lldx,jjx:jjx+ik-1),& - & beta,y(iiy:lldy,jjy:jjy+ik-1),info,trans=itrans) + & beta,y(iiy:lldy,jjy:jjy+ik-1),info,trans=trans_) if(info /= 0) then info = 4010 @@ -311,7 +311,7 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,& end if yp => y(iiy:lldy,jjy:jjy+ik-1) - if (idoswap/=0)& + if (doswap_) & & call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),& & ik,done,yp,desc_a,iwork,info) @@ -394,7 +394,7 @@ end subroutine psb_dspmm ! info - integer. Return code ! trans - character(optional). Whether A or A'. Default: 'N' ! work(:) - real,(optional). Working area. -! doswap - integer(optional). Whether to performe halo updates. +! doswap - logical(optional). Whether to performe halo updates. ! subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& & trans, work, doswap) @@ -419,18 +419,18 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& integer, intent(out) :: info real(kind(1.d0)), optional, target :: work(:) character, intent(in), optional :: trans - integer, intent(in), optional :: doswap + logical, intent(in), optional :: doswap ! locals integer :: ictxt, np, me,& & err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, & - & idoswap, m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,& + & m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,& & ib integer, parameter :: nb=4 real(kind(1.d0)),pointer :: iwork(:), xp(:), yp(:) - character :: itrans + character :: trans_ character(len=20) :: name, ch_err - logical :: aliw + logical :: aliw, doswap_ integer :: debug_level, debug_unit name='psb_dspmv' @@ -458,29 +458,28 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& ib = 1 if (present(doswap)) then - idoswap = doswap + doswap_ = doswap else - idoswap = 1 + doswap_ = 1 endif if (present(trans)) then - if ( (toupper(trans) == 'N').or.(toupper(trans) == 'T')& - & .or. (toupper(trans) == 'C')) then - itrans = toupper(trans) - else - info = 70 - call psb_errpush(info,name) - goto 9999 - end if + trans_ = toupper(trans) else - itrans = 'N' + trans_ = 'N' endif + if ( (trans_ == 'N').or.(trans_ == 'T')& + & .or.(trans_ == 'C')) then + else + info = 70 + call psb_errpush(info,name) + goto 9999 + end if m = psb_cd_get_global_rows(desc_a) n = psb_cd_get_global_cols(desc_a) nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - lldx = size(x) lldy = size(y) @@ -525,7 +524,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' Checkmat ', info - if (itrans == 'N') then + if (trans_ == 'N') then ! Matrix is not transposed if((ja /= ix).or.(ia /= iy)) then ! this case is not yet implemented @@ -552,9 +551,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& goto 9999 end if - if (idoswap == 0) then - x(nrow+1:ncol)=dzero - else + if (doswap_) then call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& & dzero,x,desc_a,iwork,info,data=psb_comm_halo_) end if @@ -608,7 +605,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' checkvect ', info ! local Matrix-vector product - call psb_csmm(alpha,a,xp,beta,yp,info,trans=itrans) + call psb_csmm(alpha,a,xp,beta,yp,info,trans=trans_) if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' csmm ', info if(info /= 0) then @@ -618,7 +615,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,& goto 9999 end if - if(idoswap /= 0)& + if (doswap_)& & call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),& & done,yp,desc_a,iwork,info) if (debug_level >= psb_debug_comp_) & diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index bf7adb26..d471e684 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -59,7 +59,7 @@ ! jx - integer(optional). The column offset for ( X ). Default: 1 ! jy - integer(optional). The column offset for ( Y ). Default: 1 ! work(:) - complex,(optional). Working area. -! doswap - integer(optional). Whether to performe halo updates. +! doswap - logical(optional). Whether to performe halo updates. ! subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& & trans, k, jx, jy, work, doswap) @@ -83,18 +83,19 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& integer, intent(out) :: info complex(kind(1.d0)), optional, target :: work(:) character, intent(in), optional :: trans - integer, intent(in), optional :: k, jx, jy,doswap + integer, intent(in), optional :: k, jx, jy + logical, intent(in), optional :: doswap ! locals integer :: ictxt, np, me,& & err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, ijx, ijy,& - & idoswap, m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,& + & m, nrow, ncol, lldx, lldy, liwork, iiy, jjy,& & i, ib, ib1 integer, parameter :: nb=4 complex(kind(1.d0)),pointer :: xp(:,:), yp(:,:), iwork(:) - character :: itrans + character :: trans_ character(len=20) :: name, ch_err - logical :: aliw + logical :: aliw, doswap_ name='psb_zspmm' if(psb_get_errstatus() /= 0) return @@ -102,6 +103,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& call psb_erractionsave(err_act) ictxt=psb_cd_get_context(desc_a) + call psb_info(ictxt, me, np) if (np == -1) then info = 2010 @@ -127,9 +129,9 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& endif if (present(doswap)) then - idoswap = doswap + doswap_ = doswap else - idoswap = 1 + doswap_ = .true. endif if (present(k)) then @@ -140,17 +142,17 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& endif if (present(trans)) then - if ( (toupper(trans) == 'N').or.(toupper(trans) == 'T').or.& - & (toupper(trans) == 'C')) then - itrans = toupper(trans) - else - info = 70 - call psb_errpush(info,name) - goto 9999 - end if + trans_ = toupper(trans) else - itrans = 'N' + trans_ = 'N' endif + if ( (trans_ == 'N').or.(trans_ == 'T')& + & .or.(trans_ == 'C')) then + else + info = 70 + call psb_errpush(info,name) + goto 9999 + end if m = psb_cd_get_global_rows(desc_a) n = psb_cd_get_global_cols(desc_a) @@ -197,7 +199,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& end if - if (itrans == 'N') then + if (trans_ == 'N') then ! Matrix is not transposed if((ja /= ix).or.(ia /= iy)) then ! this case is not yet implemented @@ -208,7 +210,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& ! checking for vectors correctness call psb_chkvect(n,ik,size(x,1),ix,ijx,desc_a,info,iix,jjx) - if (info == 0)& + if (info == 0) & & call psb_chkvect(m,ik,size(y,1),iy,ijy,desc_a,info,iiy,jjy) if(info /= 0) then info=4010 @@ -227,7 +229,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& ib1=min(nb,ik) xp => x(iix:lldx,jjx:jjx+ib1-1) - if(idoswap > 0)& + if (doswap_)& & call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& & ib1,zzero,xp,desc_a,iwork,info) @@ -236,7 +238,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& ib=ib1 ib1 = max(0,min(nb,(ik)-(i-1+ib))) xp => x(iix:lldx,jjx+i+ib-1:jjx+i+ib+ib1-2) - if((ib1 > 0).and.(idoswap > 0))& + if ((ib1 > 0).and.(doswap_)) & & call psi_swapdata(psb_swap_send_,ib1,& & zzero,xp,desc_a,iwork,info) @@ -244,11 +246,11 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& ! local Matrix-vector product call psb_csmm(alpha,a,x(iix:lldx,jjx:jjx+ib-1),& - & beta,y(iiy:lldy,jjy:jjy+ib-1),info,trans=itrans) + & beta,y(iiy:lldy,jjy:jjy+ib-1),info,trans=trans_) if(info /= 0) exit blk - if((ib1 > 0).and.(idoswap > 0))& + if((ib1 > 0).and.(doswap_))& & call psi_swapdata(psb_swap_send_,ib1,& & zzero,xp,desc_a,iwork,info) @@ -299,7 +301,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& ! local Matrix-vector product call psb_csmm(alpha,a,x(iix:lldx,jjx:jjx+ik-1),& - & beta,y(iiy:lldy,jjy:jjy+ik-1),info,trans=itrans) + & beta,y(iiy:lldy,jjy:jjy+ik-1),info,trans=trans_) if(info /= 0) then info = 4010 @@ -309,7 +311,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& end if yp => y(iiy:lldy,jjy:jjy+ik-1) - if (idoswap/=0)& + if (doswap_) & & call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),& & ik,zone,yp,desc_a,iwork,info) @@ -392,7 +394,7 @@ end subroutine psb_zspmm ! info - integer. Return code ! trans - character(optional). Whether A or A'. Default: 'N' ! work(:) - complex,(optional). Working area. -! doswap - integer(optional). Whether to performe halo updates. +! doswap - logical(optional). Whether to performe halo updates. ! subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& & trans, work, doswap) @@ -417,18 +419,18 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& integer, intent(out) :: info complex(kind(1.d0)), optional, target :: work(:) character, intent(in), optional :: trans - integer, intent(in), optional :: doswap + logical, intent(in), optional :: doswap ! locals integer :: ictxt, np, me,& & err_act, n, iix, jjx, ia, ja, iia, jja, ix, iy, ik, & - & idoswap, m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,& + & m, nrow, ncol, lldx, lldy, liwork, jx, jy, iiy, jjy,& & ib integer, parameter :: nb=4 complex(kind(1.d0)),pointer :: iwork(:), xp(:), yp(:) - character :: itrans + character :: trans_ character(len=20) :: name, ch_err - logical :: aliw + logical :: aliw, doswap_ integer :: debug_level, debug_unit name='psb_zspmv' @@ -456,23 +458,23 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& ib = 1 if (present(doswap)) then - idoswap = doswap + doswap_ = doswap else - idoswap = 1 + doswap_ = 1 endif if (present(trans)) then - if ( (toupper(trans) == 'N').or.(toupper(trans) == 'T') .or.& - & (toupper(trans) == 'C')) then - itrans = toupper(trans) - else - info = 70 - call psb_errpush(info,name) - goto 9999 - end if + trans_ = toupper(trans) else - itrans = 'N' + trans_ = 'N' endif + if ( (trans_ == 'N').or.(trans_ == 'T')& + & .or.(trans_ == 'C')) then + else + info = 70 + call psb_errpush(info,name) + goto 9999 + end if m = psb_cd_get_global_rows(desc_a) n = psb_cd_get_global_cols(desc_a) @@ -522,7 +524,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' Checkmat ', info - if (itrans == 'N') then + if (trans_ == 'N') then ! Matrix is not transposed if((ja /= ix).or.(ia /= iy)) then ! this case is not yet implemented @@ -549,9 +551,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& goto 9999 end if - if (idoswap == 0) then - x(nrow+1:ncol)=zzero - else + if (doswap_) then call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& & zzero,x,desc_a,iwork,info,data=psb_comm_halo_) end if @@ -605,8 +605,9 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' checkvect ', info ! local Matrix-vector product - call psb_csmm(alpha,a,xp,beta,yp,info,trans=itrans) - + call psb_csmm(alpha,a,xp,beta,yp,info,trans=trans_) + if (debug_level >= psb_debug_comp_) & + & write(debug_unit,*) me,' ',trim(name),' csmm ', info if(info /= 0) then info = 4010 ch_err='zcsmm' @@ -614,7 +615,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& goto 9999 end if - if(idoswap /= 0)& + if (doswap_)& & call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),& & zone,yp,desc_a,iwork,info) if (debug_level >= psb_debug_comp_) &