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

Fix map build for gen_linear.

Browse Source
merge-paraggr
Salvatore Filippone 6 years ago
parent 28620a7879
commit 300762ed29
4 changed files with 76 additions and 24 deletions
Show Stats Download Patch File Download Diff File

25
base/tools/psb_c_map.f90
Unescape Escape View File

@ -183,7 +183,7 @@ subroutine psb_c_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty)
ptx => xt ptx => xt
pty => yt pty => yt
end if end if
call psb_geaxpby(cone,x,czero,ptx,map%desc_X,info) call psb_geaxpby(cone,x,czero,ptx,map%desc_X,info)
if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work) if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work)
if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,ptx,czero,pty,info) if (info == psb_success_) call psb_csmm(cone,map%map_X2Y,ptx,czero,pty,info)
@ -364,7 +364,7 @@ subroutine psb_c_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty)
pty => yt pty => yt
end if end if
call psb_geaxpby(cone,x,czero,ptx,map%desc_X,info) call psb_geaxpby(cone,x,czero,ptx,map%desc_Y,info)
if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work) if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work)
if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,ptx,czero,pty,info) if (info == psb_success_) call psb_csmm(cone,map%map_Y2X,ptx,czero,pty,info)
@ -439,17 +439,30 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) &
case(psb_map_gen_linear_) case(psb_map_gen_linear_)
if (desc_X%is_ok()) then if (desc_X%is_ok()) then
call psb_cdcpy(desc_X, this%desc_X,info) call desc_X%clone(this%desc_X,info)
else else
info = psb_err_pivot_too_small_ info = psb_err_pivot_too_small_
endif endif
if (desc_Y%is_ok()) then if (desc_Y%is_ok()) then
call psb_cdcpy(desc_Y, this%desc_Y,info) call desc_Y%clone(this%desc_Y,info)
else else
info = psb_err_invalid_ovr_num_ info = psb_err_invalid_ovr_num_
endif endif
! For a general linear map ignore iaggr,naggr ! If iaggr/naggr are present, copy them anyway.
allocate(this%iaggr(0), this%naggr(0), stat=info) if (present(iaggr)) then
if (.not.present(naggr)) then
info = 7
else
allocate(this%iaggr(size(iaggr)),&
& this%naggr(size(naggr)), stat=info)
if (info == psb_success_) then
this%iaggr(:) = iaggr(:)
this%naggr(:) = naggr(:)
end if
end if
else
allocate(this%iaggr(0), this%naggr(0), stat=info)
end if
case default case default
write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind

25
base/tools/psb_d_map.f90
Unescape Escape View File

@ -183,7 +183,7 @@ subroutine psb_d_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty)
ptx => xt ptx => xt
pty => yt pty => yt
end if end if
call psb_geaxpby(done,x,dzero,ptx,map%desc_X,info) call psb_geaxpby(done,x,dzero,ptx,map%desc_X,info)
if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work) if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work)
if (info == psb_success_) call psb_csmm(done,map%map_X2Y,ptx,dzero,pty,info) if (info == psb_success_) call psb_csmm(done,map%map_X2Y,ptx,dzero,pty,info)
@ -364,7 +364,7 @@ subroutine psb_d_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty)
pty => yt pty => yt
end if end if
call psb_geaxpby(done,x,dzero,ptx,map%desc_X,info) call psb_geaxpby(done,x,dzero,ptx,map%desc_Y,info)
if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work) if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work)
if (info == psb_success_) call psb_csmm(done,map%map_Y2X,ptx,dzero,pty,info) if (info == psb_success_) call psb_csmm(done,map%map_Y2X,ptx,dzero,pty,info)
@ -439,17 +439,30 @@ function psb_d_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) &
case(psb_map_gen_linear_) case(psb_map_gen_linear_)
if (desc_X%is_ok()) then if (desc_X%is_ok()) then
call psb_cdcpy(desc_X, this%desc_X,info) call desc_X%clone(this%desc_X,info)
else else
info = psb_err_pivot_too_small_ info = psb_err_pivot_too_small_
endif endif
if (desc_Y%is_ok()) then if (desc_Y%is_ok()) then
call psb_cdcpy(desc_Y, this%desc_Y,info) call desc_Y%clone(this%desc_Y,info)
else else
info = psb_err_invalid_ovr_num_ info = psb_err_invalid_ovr_num_
endif endif
! For a general linear map ignore iaggr,naggr ! If iaggr/naggr are present, copy them anyway.
allocate(this%iaggr(0), this%naggr(0), stat=info) if (present(iaggr)) then
if (.not.present(naggr)) then
info = 7
else
allocate(this%iaggr(size(iaggr)),&
& this%naggr(size(naggr)), stat=info)
if (info == psb_success_) then
this%iaggr(:) = iaggr(:)
this%naggr(:) = naggr(:)
end if
end if
else
allocate(this%iaggr(0), this%naggr(0), stat=info)
end if
case default case default
write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind

25
base/tools/psb_s_map.f90
Unescape Escape View File

@ -183,7 +183,7 @@ subroutine psb_s_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty)
ptx => xt ptx => xt
pty => yt pty => yt
end if end if
call psb_geaxpby(sone,x,szero,ptx,map%desc_X,info) call psb_geaxpby(sone,x,szero,ptx,map%desc_X,info)
if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work) if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work)
if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,ptx,szero,pty,info) if (info == psb_success_) call psb_csmm(sone,map%map_X2Y,ptx,szero,pty,info)
@ -364,7 +364,7 @@ subroutine psb_s_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty)
pty => yt pty => yt
end if end if
call psb_geaxpby(sone,x,szero,ptx,map%desc_X,info) call psb_geaxpby(sone,x,szero,ptx,map%desc_Y,info)
if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work) if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work)
if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,ptx,szero,pty,info) if (info == psb_success_) call psb_csmm(sone,map%map_Y2X,ptx,szero,pty,info)
@ -439,17 +439,30 @@ function psb_s_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) &
case(psb_map_gen_linear_) case(psb_map_gen_linear_)
if (desc_X%is_ok()) then if (desc_X%is_ok()) then
call psb_cdcpy(desc_X, this%desc_X,info) call desc_X%clone(this%desc_X,info)
else else
info = psb_err_pivot_too_small_ info = psb_err_pivot_too_small_
endif endif
if (desc_Y%is_ok()) then if (desc_Y%is_ok()) then
call psb_cdcpy(desc_Y, this%desc_Y,info) call desc_Y%clone(this%desc_Y,info)
else else
info = psb_err_invalid_ovr_num_ info = psb_err_invalid_ovr_num_
endif endif
! For a general linear map ignore iaggr,naggr ! If iaggr/naggr are present, copy them anyway.
allocate(this%iaggr(0), this%naggr(0), stat=info) if (present(iaggr)) then
if (.not.present(naggr)) then
info = 7
else
allocate(this%iaggr(size(iaggr)),&
& this%naggr(size(naggr)), stat=info)
if (info == psb_success_) then
this%iaggr(:) = iaggr(:)
this%naggr(:) = naggr(:)
end if
end if
else
allocate(this%iaggr(0), this%naggr(0), stat=info)
end if
case default case default
write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind

25
base/tools/psb_z_map.f90
Unescape Escape View File

@ -183,7 +183,7 @@ subroutine psb_z_map_X2Y_vect(alpha,x,beta,y,map,info,work,vtx,vty)
ptx => xt ptx => xt
pty => yt pty => yt
end if end if
call psb_geaxpby(zone,x,zzero,ptx,map%desc_X,info) call psb_geaxpby(zone,x,zzero,ptx,map%desc_X,info)
if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work) if (info == psb_success_) call psb_halo(ptx,map%desc_X,info,work=work)
if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,ptx,zzero,pty,info) if (info == psb_success_) call psb_csmm(zone,map%map_X2Y,ptx,zzero,pty,info)
@ -364,7 +364,7 @@ subroutine psb_z_map_Y2X_vect(alpha,x,beta,y,map,info,work,vtx,vty)
pty => yt pty => yt
end if end if
call psb_geaxpby(zone,x,zzero,ptx,map%desc_X,info) call psb_geaxpby(zone,x,zzero,ptx,map%desc_Y,info)
if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work) if (info == psb_success_) call psb_halo(ptx,map%desc_Y,info,work=work)
if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,ptx,zzero,pty,info) if (info == psb_success_) call psb_csmm(zone,map%map_Y2X,ptx,zzero,pty,info)
@ -439,17 +439,30 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) &
case(psb_map_gen_linear_) case(psb_map_gen_linear_)
if (desc_X%is_ok()) then if (desc_X%is_ok()) then
call psb_cdcpy(desc_X, this%desc_X,info) call desc_X%clone(this%desc_X,info)
else else
info = psb_err_pivot_too_small_ info = psb_err_pivot_too_small_
endif endif
if (desc_Y%is_ok()) then if (desc_Y%is_ok()) then
call psb_cdcpy(desc_Y, this%desc_Y,info) call desc_Y%clone(this%desc_Y,info)
else else
info = psb_err_invalid_ovr_num_ info = psb_err_invalid_ovr_num_
endif endif
! For a general linear map ignore iaggr,naggr ! If iaggr/naggr are present, copy them anyway.
allocate(this%iaggr(0), this%naggr(0), stat=info) if (present(iaggr)) then
if (.not.present(naggr)) then
info = 7
else
allocate(this%iaggr(size(iaggr)),&
& this%naggr(size(naggr)), stat=info)
if (info == psb_success_) then
this%iaggr(:) = iaggr(:)
this%naggr(:) = naggr(:)
end if
end if
else
allocate(this%iaggr(0), this%naggr(0), stat=info)
end if
case default case default
write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind write(psb_err_unit,*) 'Bad map kind into psb_linmap ',map_kind

Write Preview
Loading…
Cancel
Save