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

Fixed bug in cdall, version with NL.

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 4051a01439
commit 7717e402ec
4 changed files with 74 additions and 77 deletions
Show Stats Download Patch File Download Diff File

80
base/modules/psb_penv_mod.F90
Unescape Escape View File

@ -613,7 +613,7 @@ contains
integer, intent(inout) :: dat integer, intent(inout) :: dat
integer, intent(in), optional :: root integer, intent(in), optional :: root
integer :: root_, dat_ integer :: root_, dat_
integer :: iam, np, icomm integer :: iam, np, icomm,info
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -626,10 +626,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then 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_ dat = dat_
else 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_ dat = dat_
endif endif
#endif #endif
@ -661,13 +661,15 @@ contains
endif endif
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat),dat_,info) 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 else
if (iam==root_) then if (iam==root_) then
call psb_realloc(size(dat),dat_,info) 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 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 end if
endif endif
#endif #endif
@ -699,13 +701,15 @@ contains
endif endif
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info) 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 else
if (iam==root_) then if (iam==root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info) 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 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 end if
endif endif
#endif #endif
@ -723,7 +727,7 @@ contains
integer, intent(in), optional :: root integer, intent(in), optional :: root
integer :: root_ integer :: root_
real(kind(1.d0)) :: dat_ real(kind(1.d0)) :: dat_
integer :: iam, np, icomm integer :: iam, np, icomm,info
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -736,10 +740,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then 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_ dat = dat_
else 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_ dat = dat_
endif endif
#endif #endif
@ -773,14 +777,14 @@ contains
call psb_realloc(size(dat),dat_,info) call psb_realloc(size(dat),dat_,info)
dat_ = dat dat_ = dat
if (info ==0) & 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 else
if (iam==root_) then if (iam==root_) then
call psb_realloc(size(dat),dat_,info) call psb_realloc(size(dat),dat_,info)
dat_ = dat 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 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 end if
endif endif
#endif #endif
@ -814,14 +818,14 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,info) call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_ = dat dat_ = dat
if (info ==0)& 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 else
if (iam==root_) then if (iam==root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info) call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_ = dat 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 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 end if
endif endif
#endif #endif
@ -839,7 +843,7 @@ contains
integer, intent(inout) :: dat integer, intent(inout) :: dat
integer, intent(in), optional :: root integer, intent(in), optional :: root
integer :: root_, dat_ integer :: root_, dat_
integer :: iam, np, icomm integer :: iam, np, icomm,info
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -852,10 +856,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then 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_ dat = dat_
else 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_ dat = dat_
endif endif
#endif #endif
@ -887,13 +891,15 @@ contains
endif endif
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat),dat_,info) 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 else
if (iam==root_) then if (iam==root_) then
call psb_realloc(size(dat),dat_,info) 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 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 end if
endif endif
#endif #endif
@ -925,13 +931,15 @@ contains
endif endif
if (root_ == -1) then if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info) 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 else
if (iam==root_) then if (iam==root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info) 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 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 end if
endif endif
#endif #endif
@ -949,7 +957,7 @@ contains
integer, intent(in), optional :: root integer, intent(in), optional :: root
integer :: root_ integer :: root_
real(kind(1.d0)) :: dat_ real(kind(1.d0)) :: dat_
integer :: iam, np, icomm integer :: iam, np, icomm,info
#if !defined(SERIAL_MPI) #if !defined(SERIAL_MPI)
@ -962,10 +970,10 @@ contains
root_ = -1 root_ = -1
endif endif
if (root_ == -1) then 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_ dat = dat_
else 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_ dat = dat_
endif endif
#endif #endif
@ -999,14 +1007,14 @@ contains
call psb_realloc(size(dat),dat_,info) call psb_realloc(size(dat),dat_,info)
dat_ = dat dat_ = dat
if (info ==0) & 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 else
if (iam==root_) then if (iam==root_) then
call psb_realloc(size(dat),dat_,info) call psb_realloc(size(dat),dat_,info)
dat_ = dat 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 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 end if
endif endif
#endif #endif
@ -1040,14 +1048,14 @@ contains
call psb_realloc(size(dat,1),size(dat,2),dat_,info) call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_ = dat dat_ = dat
if (info ==0) & 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 else
if (iam==root_) then if (iam==root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info) call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_ = dat 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 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 end if
endif endif
#endif #endif

55
base/modules/psb_realloc_mod.F90
Unescape Escape View File

@ -58,7 +58,7 @@ module psb_realloc_mod
& psb_dcpy1d, psb_dcpy2d, psb_zcpy1d, psb_zcpy2d & psb_dcpy1d, psb_dcpy2d, psb_zcpy1d, psb_zcpy2d
end Interface end Interface
Interface psb_check_size Interface psb_ensure_size
module procedure psb_icksz1d, psb_dcksz1d, psb_zcksz1d module procedure psb_icksz1d, psb_dcksz1d, psb_zcksz1d
end Interface end Interface
@ -460,7 +460,7 @@ Contains
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer :: isz, err_act integer :: isz, err_act
name='psb_check_size' name='psb_ensure_size'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -468,16 +468,13 @@ Contains
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
isz = max((3*psb_size(v))/2,(len+1)) isz = max((3*psb_size(v))/2,(len+1))
if (present(pad)) then call psb_realloc(isz,v,info,pad=pad)
call psb_realloc(isz,v,info,pad=pad)
else if (info /= 0) then
call psb_realloc(isz,v,info) info=4010
if (info /= 0) then call psb_errpush(info,name,a_err='psb_realloc')
info=4010 goto 9999
call psb_errpush(info,name,a_err='psb_realloc') end if
goto 9999
end if
End If
end If end If
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -510,7 +507,7 @@ Contains
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer :: isz, err_act integer :: isz, err_act
name='psb_check_size' name='psb_ensure_size'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -518,15 +515,11 @@ Contains
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
isz = max((3*psb_size(v))/2,(len+1)) isz = max((3*psb_size(v))/2,(len+1))
if (present(pad)) then call psb_realloc(isz,v,info,pad=pad)
call psb_realloc(isz,v,info,pad=pad) if (info /= 0) then
else info=4010
call psb_realloc(isz,v,info) call psb_errpush(info,name,a_err='psb_realloc')
if (info /= 0) then goto 9999
info=4010
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
end if
End If End If
end If end If
@ -560,7 +553,7 @@ Contains
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer :: isz, err_act integer :: isz, err_act
name='psb_check_size' name='psb_ensure_size'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
@ -568,16 +561,12 @@ Contains
If (len > psb_size(v)) Then If (len > psb_size(v)) Then
isz = max((3*psb_size(v))/2,(len+1)) isz = max((3*psb_size(v))/2,(len+1))
if (present(pad)) then call psb_realloc(isz,v,info,pad=pad)
call psb_realloc(isz,v,info,pad=pad) if (info /= 0) then
else info=4010
call psb_realloc(isz,v,info) call psb_errpush(info,name,a_err='psb_realloc')
if (info /= 0) then goto 9999
info=4010 end if
call psb_errpush(info,name,a_err='psb_realloc')
goto 9999
end if
End If
end If end If
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

4
base/tools/psb_cd_inloc.f90
Unescape Escape View File

@ -70,9 +70,9 @@ subroutine psb_cd_inloc(v, ictxt, desc_a, info)
if (debug) write(*,*) 'psb_cdall: ',np,me if (debug) write(*,*) 'psb_cdall: ',np,me
loc_row = size(v)
if (.false.) then if (.false.) then
loc_row = size(v) m = loc_row
m = loc_row
call psb_sum(ictxt,m) call psb_sum(ictxt,m)
else else
m = maxval(v) m = maxval(v)

12
base/tools/psb_cdals.f90
Unescape Escape View File

@ -200,19 +200,19 @@ subroutine psb_cdals(m, n, parts, ictxt, desc_a, info)
if (prc_v(j) == me) then if (prc_v(j) == me) then
! this point belongs to me ! this point belongs to me
k = k + 1 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 if (info /= 0) then
info=4010 info=4010
call psb_errpush(info,name,a_err='psb_check_size') call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999 goto 9999
end if end if
desc_a%loc_to_glob(k) = i desc_a%loc_to_glob(k) = i
call SearchInsKeyVal(desc_a%ptree,i,k,glx,info) call SearchInsKeyVal(desc_a%ptree,i,k,glx,info)
if (nprocs > 1) then 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 if (info /= 0) then
info=4010 info=4010
call psb_errpush(info,name,a_err='psb_check_size') call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999 goto 9999
end if end if
itmpov = itmpov + 1 itmpov = itmpov + 1
@ -281,10 +281,10 @@ subroutine psb_cdals(m, n, parts, ictxt, desc_a, info)
counter=counter+1 counter=counter+1
desc_a%glob_to_loc(i) = counter desc_a%glob_to_loc(i) = counter
if (nprocs > 1) then 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 if (info /= 0) then
info=4010 info=4010
call psb_errpush(info,name,a_err='psb_check_size') call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999 goto 9999
end if end if
itmpov = itmpov + 1 itmpov = itmpov + 1

Write Preview
Loading…
Cancel
Save