From 7717e402ec41614345393eb8e7d716135be4af1e Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 8 Apr 2007 17:45:04 +0000 Subject: [PATCH] Fixed bug in cdall, version with NL. --- base/modules/psb_penv_mod.F90 | 80 ++++++++++++++++++-------------- base/modules/psb_realloc_mod.F90 | 55 +++++++++------------- base/tools/psb_cd_inloc.f90 | 4 +- base/tools/psb_cdals.f90 | 12 ++--- 4 files changed, 74 insertions(+), 77 deletions(-) diff --git a/base/modules/psb_penv_mod.F90 b/base/modules/psb_penv_mod.F90 index fcf64dda..531f91ef 100644 --- a/base/modules/psb_penv_mod.F90 +++ b/base/modules/psb_penv_mod.F90 @@ -613,7 +613,7 @@ contains integer, intent(inout) :: dat integer, intent(in), optional :: root integer :: root_, dat_ - integer :: iam, np, icomm + integer :: iam, np, icomm,info #if !defined(SERIAL_MPI) @@ -626,10 +626,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_integer,mpi_max,icomm) + call mpi_allreduce(dat,dat_,1,mpi_integer,mpi_max,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_integer,mpi_max,root_,icomm) + call mpi_reduce(dat,dat_,1,mpi_integer,mpi_max,root_,icomm,info) dat = dat_ endif #endif @@ -661,13 +661,15 @@ contains endif if (root_ == -1) then call psb_realloc(size(dat),dat_,info) - if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_max,icomm) + dat_=dat + if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_max,icomm,info) else if (iam==root_) then call psb_realloc(size(dat),dat_,info) - call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_max,root_,icomm) + dat_=dat + call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_max,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_max,root_,icomm) + call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_max,root_,icomm,info) end if endif #endif @@ -699,13 +701,15 @@ contains endif if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,info) - if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_max,icomm) + dat_=dat + if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_max,icomm,info) else if (iam==root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,info) - call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_max,root_,icomm) + dat_=dat + call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_max,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_max,root_,icomm) + call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_max,root_,icomm,info) end if endif #endif @@ -723,7 +727,7 @@ contains integer, intent(in), optional :: root integer :: root_ real(kind(1.d0)) :: dat_ - integer :: iam, np, icomm + integer :: iam, np, icomm,info #if !defined(SERIAL_MPI) @@ -736,10 +740,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_max,icomm) + call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_max,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_max,root_,icomm) + call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_max,root_,icomm,info) dat = dat_ endif #endif @@ -773,14 +777,14 @@ contains call psb_realloc(size(dat),dat_,info) dat_ = dat if (info ==0) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,icomm) + & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,icomm,info) else if (iam==root_) then call psb_realloc(size(dat),dat_,info) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,root_,icomm) + call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_max,root_,icomm) + call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_max,root_,icomm,info) end if endif #endif @@ -814,14 +818,14 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,info) dat_ = dat if (info ==0)& - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,icomm) + & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,icomm,info) else if (iam==root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,info) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,root_,icomm) + call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_max,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_max,root_,icomm) + call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_max,root_,icomm,info) end if endif #endif @@ -839,7 +843,7 @@ contains integer, intent(inout) :: dat integer, intent(in), optional :: root integer :: root_, dat_ - integer :: iam, np, icomm + integer :: iam, np, icomm,info #if !defined(SERIAL_MPI) @@ -852,10 +856,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_integer,mpi_min,icomm) + call mpi_allreduce(dat,dat_,1,mpi_integer,mpi_min,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_integer,mpi_min,root_,icomm) + call mpi_reduce(dat,dat_,1,mpi_integer,mpi_min,root_,icomm,info) dat = dat_ endif #endif @@ -887,13 +891,15 @@ contains endif if (root_ == -1) then call psb_realloc(size(dat),dat_,info) - if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_min,icomm) + dat_=dat + if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_min,icomm,info) else if (iam==root_) then call psb_realloc(size(dat),dat_,info) - call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_min,root_,icomm) + dat_=dat + call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_min,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_min,root_,icomm) + call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_min,root_,icomm,info) end if endif #endif @@ -925,13 +931,15 @@ contains endif if (root_ == -1) then call psb_realloc(size(dat,1),size(dat,2),dat_,info) - if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_min,icomm) + dat_=dat + if (info ==0) call mpi_allreduce(dat_,dat,size(dat),mpi_integer,mpi_min,icomm,info) else if (iam==root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,info) - call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_min,root_,icomm) + dat_=dat + call mpi_reduce(dat_,dat,size(dat),mpi_integer,mpi_min,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_min,root_,icomm) + call mpi_reduce(dat,dat_,size(dat),mpi_integer,mpi_min,root_,icomm,info) end if endif #endif @@ -949,7 +957,7 @@ contains integer, intent(in), optional :: root integer :: root_ real(kind(1.d0)) :: dat_ - integer :: iam, np, icomm + integer :: iam, np, icomm,info #if !defined(SERIAL_MPI) @@ -962,10 +970,10 @@ contains root_ = -1 endif if (root_ == -1) then - call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_min,icomm) + call mpi_allreduce(dat,dat_,1,mpi_double_precision,mpi_min,icomm,info) dat = dat_ else - call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_min,root_,icomm) + call mpi_reduce(dat,dat_,1,mpi_double_precision,mpi_min,root_,icomm,info) dat = dat_ endif #endif @@ -999,14 +1007,14 @@ contains call psb_realloc(size(dat),dat_,info) dat_ = dat if (info ==0) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,icomm) + & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,icomm,info) else if (iam==root_) then call psb_realloc(size(dat),dat_,info) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,root_,icomm) + call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_min,root_,icomm) + call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_min,root_,icomm,info) end if endif #endif @@ -1040,14 +1048,14 @@ contains call psb_realloc(size(dat,1),size(dat,2),dat_,info) dat_ = dat if (info ==0) & - & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,icomm) + & call mpi_allreduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,icomm,info) else if (iam==root_) then call psb_realloc(size(dat,1),size(dat,2),dat_,info) dat_ = dat - call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,root_,icomm) + call mpi_reduce(dat_,dat,size(dat),mpi_double_precision,mpi_min,root_,icomm,info) else - call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_min,root_,icomm) + call mpi_reduce(dat,dat_,size(dat),mpi_double_precision,mpi_min,root_,icomm,info) end if endif #endif diff --git a/base/modules/psb_realloc_mod.F90 b/base/modules/psb_realloc_mod.F90 index 1b91c403..8e9f47f8 100644 --- a/base/modules/psb_realloc_mod.F90 +++ b/base/modules/psb_realloc_mod.F90 @@ -58,7 +58,7 @@ module psb_realloc_mod & psb_dcpy1d, psb_dcpy2d, psb_zcpy1d, psb_zcpy2d end Interface - Interface psb_check_size + Interface psb_ensure_size module procedure psb_icksz1d, psb_dcksz1d, psb_zcksz1d end Interface @@ -460,7 +460,7 @@ Contains logical, parameter :: debug=.false. integer :: isz, err_act - name='psb_check_size' + name='psb_ensure_size' call psb_erractionsave(err_act) if(psb_get_errstatus().ne.0) return @@ -468,16 +468,13 @@ Contains If (len > psb_size(v)) Then isz = max((3*psb_size(v))/2,(len+1)) - if (present(pad)) then - call psb_realloc(isz,v,info,pad=pad) - else - call psb_realloc(isz,v,info) - if (info /= 0) then - info=4010 - call psb_errpush(info,name,a_err='psb_realloc') - goto 9999 - end if - End If + call psb_realloc(isz,v,info,pad=pad) + + if (info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_realloc') + goto 9999 + end if end If call psb_erractionrestore(err_act) @@ -510,7 +507,7 @@ Contains logical, parameter :: debug=.false. integer :: isz, err_act - name='psb_check_size' + name='psb_ensure_size' call psb_erractionsave(err_act) if(psb_get_errstatus().ne.0) return @@ -518,15 +515,11 @@ Contains If (len > psb_size(v)) Then isz = max((3*psb_size(v))/2,(len+1)) - if (present(pad)) then - call psb_realloc(isz,v,info,pad=pad) - else - call psb_realloc(isz,v,info) - if (info /= 0) then - info=4010 - call psb_errpush(info,name,a_err='psb_realloc') - goto 9999 - end if + call psb_realloc(isz,v,info,pad=pad) + if (info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_realloc') + goto 9999 End If end If @@ -560,7 +553,7 @@ Contains logical, parameter :: debug=.false. integer :: isz, err_act - name='psb_check_size' + name='psb_ensure_size' call psb_erractionsave(err_act) if(psb_get_errstatus().ne.0) return @@ -568,16 +561,12 @@ Contains If (len > psb_size(v)) Then isz = max((3*psb_size(v))/2,(len+1)) - if (present(pad)) then - call psb_realloc(isz,v,info,pad=pad) - else - call psb_realloc(isz,v,info) - if (info /= 0) then - info=4010 - call psb_errpush(info,name,a_err='psb_realloc') - goto 9999 - end if - End If + call psb_realloc(isz,v,info,pad=pad) + if (info /= 0) then + info=4010 + call psb_errpush(info,name,a_err='psb_realloc') + goto 9999 + end if end If call psb_erractionrestore(err_act) diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index b7a89237..d09c0447 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -70,9 +70,9 @@ subroutine psb_cd_inloc(v, ictxt, desc_a, info) if (debug) write(*,*) 'psb_cdall: ',np,me + loc_row = size(v) if (.false.) then - loc_row = size(v) - m = loc_row + m = loc_row call psb_sum(ictxt,m) else m = maxval(v) diff --git a/base/tools/psb_cdals.f90 b/base/tools/psb_cdals.f90 index f48d4720..2c4974ac 100644 --- a/base/tools/psb_cdals.f90 +++ b/base/tools/psb_cdals.f90 @@ -200,19 +200,19 @@ subroutine psb_cdals(m, n, parts, ictxt, desc_a, info) if (prc_v(j) == me) then ! this point belongs to me k = k + 1 - call psb_check_size((k+1),desc_a%loc_to_glob,info,pad=-1) + call psb_ensure_size((k+1),desc_a%loc_to_glob,info,pad=-1) if (info /= 0) then info=4010 - call psb_errpush(info,name,a_err='psb_check_size') + call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if desc_a%loc_to_glob(k) = i call SearchInsKeyVal(desc_a%ptree,i,k,glx,info) if (nprocs > 1) then - call psb_check_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-1) + call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-1) if (info /= 0) then info=4010 - call psb_errpush(info,name,a_err='psb_check_size') + call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if itmpov = itmpov + 1 @@ -281,10 +281,10 @@ subroutine psb_cdals(m, n, parts, ictxt, desc_a, info) counter=counter+1 desc_a%glob_to_loc(i) = counter if (nprocs > 1) then - call psb_check_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-1) + call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-1) if (info /= 0) then info=4010 - call psb_errpush(info,name,a_err='psb_check_size') + call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if itmpov = itmpov + 1