fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-06 22:55:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
BLACS takeout.
This commit is contained in:
Salvatore Filippone
2010-04-29 12:43:34 +00:00
parent 5ffbc8ca82
commit 7530cafc83
25 changed files with 1030 additions and 5686 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Make.inc.in
-1
View File
@@ -35,7 +35,6 @@ LIBS=@LIBS@
# BLAS, BLACS and METIS libraries.
BLAS=@BLAS_LIBS@
BLACS=@BLACS_LIBS@
METIS_LIB=@METIS_LIBS@
LAPACK=@LAPACK_LIBS@
EXTRA_COBJS=@FAKEMPI@
base/internals/psi_cswapdata.F90
+16 -16
View File
@@ -107,7 +107,7 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
@@ -115,13 +115,13 @@ subroutine psi_cswapdatam(flag,n,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -192,13 +192,13 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -355,7 +355,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_complex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_complex,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -378,7 +378,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag=psb_complex_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
@@ -411,7 +411,7 @@ subroutine psi_cswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_complex_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -597,20 +597,20 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -684,13 +684,13 @@ subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -844,7 +844,7 @@ subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_complex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_complex,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -866,7 +866,7 @@ subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_complex_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
@@ -898,7 +898,7 @@ subroutine psi_cswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_complex_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/internals/psi_cswaptran.F90
+16 -16
View File
@@ -112,7 +112,7 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
@@ -121,13 +121,13 @@ subroutine psi_cswaptranm(flag,n,beta,y,desc_a,work,info,data)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -197,13 +197,13 @@ subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -363,7 +363,7 @@ subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_complex_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_complex,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -386,7 +386,7 @@ subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_complex_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_complex,prcid(i),&
@@ -417,7 +417,7 @@ subroutine psi_ctranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_complex_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -601,7 +601,7 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tranv'
call psb_erractionsave(err_act)
@@ -609,13 +609,13 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -687,13 +687,13 @@ subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -852,7 +852,7 @@ subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_complex_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_complex,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -875,7 +875,7 @@ subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_complex_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_complex,prcid(i),&
@@ -905,7 +905,7 @@ subroutine psi_ctranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_complex_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/internals/psi_dswapdata.F90
+16 -16
View File
@@ -108,7 +108,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
@@ -116,13 +116,13 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -193,13 +193,13 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -356,7 +356,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -379,7 +379,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag=psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
@@ -412,7 +412,7 @@ subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -597,20 +597,20 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -684,13 +684,13 @@ subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -844,7 +844,7 @@ subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_double_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -866,7 +866,7 @@ subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag=psb_double_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
@@ -898,7 +898,7 @@ subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag =psb_double_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/internals/psi_dswaptran.F90
+16 -16
View File
@@ -112,7 +112,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
@@ -121,13 +121,13 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -197,13 +197,13 @@ subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -363,7 +363,7 @@ subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -386,7 +386,7 @@ subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag=psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_precision,prcid(i),&
@@ -417,7 +417,7 @@ subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -601,7 +601,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tranv'
call psb_erractionsave(err_act)
@@ -609,13 +609,13 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -684,13 +684,13 @@ subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
real(psb_dpk_), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -849,7 +849,7 @@ subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_double_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_precision,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -872,7 +872,7 @@ subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag=psb_double_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_precision,prcid(i),&
@@ -902,7 +902,7 @@ subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_double_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/internals/psi_iswapdata.F90
+16 -16
View File
@@ -107,7 +107,7 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
@@ -115,13 +115,13 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -192,13 +192,13 @@ subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -355,7 +355,7 @@ subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_int_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -378,7 +378,7 @@ subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_int_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
@@ -411,7 +411,7 @@ subroutine psi_iswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_int_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -597,20 +597,20 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -684,13 +684,13 @@ subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -844,7 +844,7 @@ subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_int_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_integer,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -866,7 +866,7 @@ subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_int_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
@@ -898,7 +898,7 @@ subroutine psi_iswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_int_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/internals/psi_iswaptran.F90
+16 -16
View File
@@ -112,7 +112,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
@@ -121,13 +121,13 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -197,13 +197,13 @@ subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -363,7 +363,7 @@ subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_int_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -386,7 +386,7 @@ subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_int_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_integer,prcid(i),&
@@ -417,7 +417,7 @@ subroutine psi_itranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_int_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -601,7 +601,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tranv'
call psb_erractionsave(err_act)
@@ -609,13 +609,13 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -687,13 +687,13 @@ subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -852,7 +852,7 @@ subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_int_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_integer,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -875,7 +875,7 @@ subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_int_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_integer,prcid(i),&
@@ -905,7 +905,7 @@ subroutine psi_itranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_int_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/internals/psi_sswapdata.F90
+16 -16
View File
@@ -108,7 +108,7 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
@@ -116,13 +116,13 @@ subroutine psi_sswapdatam(flag,n,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -193,13 +193,13 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -356,7 +356,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_real_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_real,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -379,7 +379,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_real_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
@@ -412,7 +412,7 @@ subroutine psi_sswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_real_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -597,20 +597,20 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -684,13 +684,13 @@ subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -844,7 +844,7 @@ subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_real_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_real,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -866,7 +866,7 @@ subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_real_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
@@ -898,7 +898,7 @@ subroutine psi_sswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_real_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/internals/psi_sswaptran.F90
+16 -16
View File
@@ -112,7 +112,7 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
@@ -121,13 +121,13 @@ subroutine psi_sswaptranm(flag,n,beta,y,desc_a,work,info,data)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -197,13 +197,13 @@ subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -363,7 +363,7 @@ subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_real_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_real,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -386,7 +386,7 @@ subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_real_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_real,prcid(i),&
@@ -417,7 +417,7 @@ subroutine psi_stranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_real_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -601,7 +601,7 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tranv'
call psb_erractionsave(err_act)
@@ -609,13 +609,13 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -684,13 +684,13 @@ subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
real(psb_spk_), pointer, dimension(:) :: sndbuf, rcvbuf
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -849,7 +849,7 @@ subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_real_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_real,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -872,7 +872,7 @@ subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_real_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_real,prcid(i),&
@@ -902,7 +902,7 @@ subroutine psi_stranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_real_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/internals/psi_zswapdata.F90
+16 -16
View File
@@ -107,7 +107,7 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
@@ -115,13 +115,13 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -192,13 +192,13 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_data'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -355,7 +355,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -378,7 +378,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_dcomplex_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
call mpi_rsend(sndbuf(snd_pt),n*nesd,&
@@ -411,7 +411,7 @@ subroutine psi_zswapidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_dcomplex_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -597,20 +597,20 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
integer, pointer :: d_idx(:)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -684,13 +684,13 @@ subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_datav'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -844,7 +844,7 @@ subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),&
& p2ptag, icomm,rvhd(i),iret)
@@ -866,7 +866,7 @@ subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_dcomplex_swap_tag
if ((nesd>0).and.(proc_to_comm /= me)) then
if (usersend) then
@@ -898,7 +898,7 @@ subroutine psi_zswapidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_dcomplex_swap_tag
if ((proc_to_comm /= me).and.(nerv>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/internals/psi_zswaptran.F90
+16 -16
View File
@@ -112,7 +112,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
@@ -121,13 +121,13 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -197,13 +197,13 @@ subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -363,7 +363,7 @@ subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(sndbuf(snd_pt),n*nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -386,7 +386,7 @@ subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_dcomplex_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),n*nerv,&
& mpi_double_complex,prcid(i),&
@@ -417,7 +417,7 @@ subroutine psi_ztranidxm(ictxt,icomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,work
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_dcomplex_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
@@ -601,7 +601,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: int_err(5)
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tranv'
call psb_erractionsave(err_act)
@@ -609,13 +609,13 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
icomm = psb_cd_get_mpic(desc_a)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_
info=psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
@@ -687,13 +687,13 @@ subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
#endif
character(len=20) :: name
info = psb_success_
info=psb_success_
name='psi_swap_tran'
call psb_erractionsave(err_act)
call psb_info(ictxt,me,np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -852,7 +852,7 @@ subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
call psb_get_rank(prcid(i),ictxt,proc_to_comm)
if ((nesd>0).and.(proc_to_comm /= me)) then
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_dcomplex_swap_tag
call mpi_irecv(sndbuf(snd_pt),nesd,&
& mpi_double_complex,prcid(i),&
& p2ptag,icomm,rvhd(i),iret)
@@ -875,7 +875,7 @@ subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
nesd = idx(pnti+nerv+psb_n_elem_send_)
if ((nerv>0).and.(proc_to_comm /= me)) then
p2ptag=ksendid(ictxt,proc_to_comm,me)
p2ptag= psb_dcomplex_swap_tag
if (usersend) then
call mpi_rsend(rcvbuf(rcv_pt),nerv,&
& mpi_double_complex,prcid(i),&
@@ -905,7 +905,7 @@ subroutine psi_ztranidxv(ictxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,i
proc_to_comm = idx(pnti+psb_proc_id_)
nerv = idx(pnti+psb_n_elem_recv_)
nesd = idx(pnti+nerv+psb_n_elem_send_)
p2ptag = krecvid(ictxt,proc_to_comm,me)
p2ptag = psb_dcomplex_swap_tag
if ((proc_to_comm /= me).and.(nesd>0)) then
call mpi_wait(rvhd(i),p2pstat,iret)
base/modules/Makefile
+13 -7
View File
@@ -2,11 +2,11 @@ include ../../Make.inc
BASIC_MODS= psb_const_mod.o psb_error_mod.o psb_realloc_mod.o
UTIL_MODS = psb_string_mod.o \
psb_desc_type.o psb_sort_mod.o psb_penv_mod.o \
psb_serial_mod.o \
psb_desc_type.o psb_sort_mod.o psb_serial_mod.o \
psb_base_tools_mod.o psb_s_tools_mod.o psb_d_tools_mod.o\
psb_c_tools_mod.o psb_z_tools_mod.o psb_tools_mod.o \
psb_blacs_mod.o \
psi_comm_buffers_mod.o psi_penv_mod.o psi_bcast_mod.o \
psi_reduce_mod.o psi_p2p_mod.o psb_error_impl.o \
psb_linmap_type_mod.o psb_linmap_mod.o psb_comm_mod.o\
psb_s_psblas_mod.o psb_c_psblas_mod.o \
psb_d_psblas_mod.o psb_z_psblas_mod.o psb_psblas_mod.o \
@@ -28,13 +28,17 @@ CINCLUDES=-I.
FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). $(FIFLAG).
lib: $(BASIC_MODS) blacsmod $(UTIL_MODS) $(OBJS) $(LIBMOD)
lib: $(BASIC_MODS) penvmod $(UTIL_MODS) $(OBJS) $(LIBMOD)
$(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
/bin/cp -p $(LIBMOD) $(LIBDIR)
/bin/cp -p *$(.mod) $(LIBDIR)
psi_penv_mod.o: psi_comm_buffers_mod.o psb_const_mod.o psb_realloc_mod.o
psi_bcast_mod.o psi_reduce_mod.o psi_p2p_mod.o penvmod.o: psi_penv_mod.o
psb_penv_mod.o: psi_bcast_mod.o psi_reduce_mod.o psi_p2p_mod.o
psb_base_mat_mod.o: psb_string_mod.o psb_sort_mod.o psb_ip_reord_mod.o\
psb_error_mod.o psi_serial_mod.o
psb_s_base_mat_mod.o psb_d_base_mat_mod.o psb_c_base_mat_mod.o psb_z_base_mat_mod.o: psb_base_mat_mod.o
@@ -51,7 +55,6 @@ psb_realloc_mod.o : psb_error_mod.o
psb_spmat_type.o : psb_realloc_mod.o psb_error_mod.o psb_const_mod.o psb_string_mod.o psb_sort_mod.o
psb_error_mod.o: psb_const_mod.o
psb_ip_reord_mod.o: psb_const_mod.o
psb_penv_mod.o: psb_const_mod.o psb_error_mod.o psb_realloc_mod.o psb_blacs_mod.o
psb_blacs_mod.o: psb_const_mod.o
psi_serial_mod.o: psb_const_mod.o psb_realloc_mod.o
psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o psb_const_mod.o psi_serial_mod.o psb_serial_mod.o
@@ -75,8 +78,11 @@ psb_sparse_mod.o: $(MODULES)
newmods: $(BASIC_MODS)
(cd ../newserial; make lib LIBNAME=$(LIBNAME))
blacsmod:
(make psb_blacs_mod.o psb_penv_mod.o F90COPT="$(F90COPT) $(EXTRA_OPT)")
penvmod:
(make psb_penv_mod.o F90COPT="$(F90COPT) $(EXTRA_OPT)")
clean:
base/modules/psb_const_mod.F90
+5
View File
@@ -32,7 +32,11 @@
module psb_const_mod
! This is the default integer
#if defined(LONG_INTEGERS)
integer, parameter :: ndig=12
#else
integer, parameter :: ndig=8
#endif
integer, parameter :: psb_int_k_ = selected_int_kind(ndig)
! This is an 8-byte integer, and normally different from default integer.
integer, parameter :: longndig=12
@@ -45,6 +49,7 @@ module psb_const_mod
integer, parameter :: psb_spk_ = kind(1.e0)
integer, save :: psb_sizeof_dp, psb_sizeof_sp
integer, save :: psb_sizeof_int, psb_sizeof_long_int
integer, save :: psb_mpi_integer
!
! Handy & miscellaneous constants
base/modules/psb_error_mod.F90
+88 -189
View File
@@ -30,25 +30,38 @@
!!$
!!$
module psb_error_mod
use psb_const_mod
integer, parameter, public :: psb_act_ret_=0, psb_act_abort_=1, psb_no_err_=0
integer, parameter, public :: psb_debug_ext_=1, psb_debug_outer_=2
integer, parameter, public :: psb_debug_comp_=3, psb_debug_inner_=4
integer, parameter, public :: psb_debug_serial_=8, psb_debug_serial_comp_=9
!
! Error handling
!
public psb_errpush, psb_error, psb_get_errstatus,&
& psb_get_errverbosity, psb_set_errverbosity,psb_errcomm, &
& psb_errpop, psb_errmsg, psb_errcomm, psb_get_numerr, &
& psb_get_errverbosity, psb_set_errverbosity, &
& psb_erractionsave, psb_erractionrestore, &
& psb_get_erraction, psb_set_erraction, &
& psb_get_debug_level, psb_set_debug_level,&
& psb_get_debug_unit, psb_set_debug_unit,&
& psb_get_serial_debug_level, psb_set_serial_debug_level
interface psb_error
module procedure psb_serror
module procedure psb_perror
subroutine psb_serror()
end subroutine psb_serror
subroutine psb_perror(ictxt)
integer, intent(in) :: ictxt
end subroutine psb_perror
end interface
interface
subroutine psb_errcomm(ictxt, err)
integer, intent(in) :: ictxt
integer, intent(inout):: err
end subroutine psb_errcomm
end interface
@@ -163,20 +176,6 @@ contains
end subroutine psb_set_serial_debug_level
! checks wether an error has occurred on one of the porecesses in the execution pool
subroutine psb_errcomm(ictxt, err)
integer, intent(in) :: ictxt
integer, intent(inout):: err
integer :: temp(2)
integer, parameter :: ione=1
! Cannot use psb_amx or otherwise we have a recursion in module usage
#if !defined(SERIAL_MPI)
call igamx2d(ictxt, 'A', ' ', ione, ione, err, ione,&
&temp ,temp,-ione ,-ione,-ione)
#endif
end subroutine psb_errcomm
! sets verbosity of the error message
subroutine psb_set_errverbosity(v)
@@ -186,6 +185,14 @@ contains
! returns number of errors
function psb_get_numerr()
integer :: psb_get_numerr
psb_get_numerr = error_stack%n_elems
end function psb_get_numerr
! returns verbosity of the error message
function psb_get_errverbosity()
integer :: psb_get_errverbosity
@@ -259,97 +266,6 @@ contains
! handles the occurence of an error in a parallel routine
subroutine psb_perror(ictxt)
integer, intent(in) :: ictxt
integer :: err_c
character(len=20) :: r_name
character(len=40) :: a_e_d
integer :: i_e_d(5)
integer :: nprow, npcol, me, mypcol
integer, parameter :: ione=1, izero=0
#if defined(SERIAL_MPI)
me = -1
#else
call blacs_gridinfo(ictxt,nprow,npcol,me,mypcol)
#endif
if(error_status > 0) then
if(verbosity_level > 1) then
do while (error_stack%n_elems > izero)
write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
! write(0,'(50("="))')
end do
#if defined(SERIAL_MPI)
stop
#else
call blacs_abort(ictxt,-1)
#endif
else
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
do while (error_stack%n_elems > 0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
#if defined(SERIAL_MPI)
stop
#else
call blacs_abort(ictxt,-1)
#endif
end if
end if
if(error_status > izero) then
#if defined(SERIAL_MPI)
stop
#else
call blacs_abort(ictxt,err_c)
#endif
end if
end subroutine psb_perror
! handles the occurence of an error in a serial routine
subroutine psb_serror()
integer :: err_c
character(len=20) :: r_name
character(len=40) :: a_e_d
integer :: i_e_d(5)
integer, parameter :: ione=1, izero=0
if(error_status > 0) then
if(verbosity_level > 1) then
do while (error_stack%n_elems > izero)
write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
! write(0,'(50("="))')
end do
else
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
do while (error_stack%n_elems > 0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
end if
end if
end subroutine psb_serror
! prints the error msg associated to a specific error code
subroutine psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
@@ -367,164 +283,147 @@ contains
select case (err_c)
case(:0)
case(:psb_success_)
write (0,'("error on calling sperror. err_c must be greater than 0")')
case(2)
case(psb_err_pivot_too_small_)
write (0,'("pivot too small: ",i0,1x,a)')i_e_d(1),a_e_d
case(3)
case(psb_err_invalid_ovr_num_)
write (0,'("Invalid number of ovr:",i0)')i_e_d(1)
case(5)
case(psb_err_invalid_input_)
write (0,'("Invalid input")')
case(10)
case(psb_err_iarg_neg_)
write (0,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1)
write (0,'("current value is ",i0)')i_e_d(2)
case(20)
case(psb_err_iarg_pos_)
write (0,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1)
write (0,'("current value is ",i0)')i_e_d(2)
case(30)
case(psb_err_input_value_invalid_i_)
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write (0,'("current value is ",i0)')i_e_d(2)
case(31)
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write (0,'("current value is ",a)')a_e_d
case(35)
case(psb_err_input_asize_invalid_i_)
write (0,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1)
write (0,'("Current value is ",i0)')i_e_d(2)
case(36)
write (0,'("Size of input array argument n. ",i0," must be ")')i_e_d(1)
write (0,'("at least ",i0)')i_e_d(2)
case(40)
case(psb_err_iarg_invalid_i_)
write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1)
write (0,'("current value is ",a)')a_e_d(2:2)
case(50)
case(psb_err_iarg_not_gtia_ii_)
write (0,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') i_e_d(1), i_e_d(3)
write (0,'("current values are ",i0," < ",i0)') i_e_d(2),i_e_d(5)
case(60)
case(psb_err_iarg_not_gteia_ii_)
write (0,'("input argument n. ",i0," must be greater than or equal to ",i0)')i_e_d(1),i_e_d(2)
write (0,'("current value is ",i0," < ",i0)')i_e_d(3), i_e_d(2)
case(70)
case(psb_err_iarg_invalid_value_)
write (0,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')i_e_d(1:2)
write (0,'("current value is ",a)')a_e_d
case(71)
case(psb_err_asb_nrc_error_)
write (0,'("Impossible error in ASB: nrow>ncol,")')
write (0,'("Actual values are ",i0," > ",i0)')i_e_d(1:2)
! ... csr format error ...
case(80)
case(psb_err_iarg2_neg_)
write (0,'("input argument ia2(1) is less than 0")')
write (0,'("current value is ",i0)')i_e_d(1)
! ... csr format error ...
case(90)
case(psb_err_ia2_not_increasing_)
write (0,'("indices in ia2 array are not in increasing order")')
case(91)
case(psb_err_ia1_not_increasing_)
write (0,'("indices in ia1 array are not in increasing order")')
! ... csr format error ...
case(100)
case(psb_err_ia1_badindices_)
write (0,'("indices in ia1 array are not within problem dimension")')
write (0,'("problem dimension is ",i0)')i_e_d(1)
case(110)
case(psb_err_invalid_args_combination_)
write (0,'("invalid combination of input arguments")')
case(115)
case(psb_err_invalid_pid_arg_)
write (0,'("Invalid process identifier in input array argument n. ",i0,".")')i_e_d(1)
write (0,'("Current value is ",i0)')i_e_d(2)
case(120)
case(psb_err_iarg_n_mbgtian_)
write (0,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2)
write (0,'("current values are ",i0," < ",i0)') i_e_d(3:4)
! ... coo format error ...
case(130)
case(psb_err_duplicate_coo)
write (0,'("there are duplicated elements in coo format")')
write (0,'("and you have chosen psb_dupl_err_ ")')
case(134)
case(psb_err_invalid_input_format_)
write (0,'("Invalid input format ",a3)')a_e_d(1:3)
case(135)
case(psb_err_unsupported_format_)
write (0,'("Format ",a3," not yet supported here")')a_e_d(1:3)
case(136)
case(psb_err_format_unknown_)
write (0,'("Format ",a3," is unknown")')a_e_d(1:3)
case(140)
case(psb_err_iarray_outside_bounds_)
write (0,'("indices in input array are not within problem dimension ",2(i0,2x))')i_e_d(1:2)
case(150)
case(psb_err_iarray_outside_process_)
write (0,'("indices in input array are not belonging to the calling process ",i0)')i_e_d(1)
case(290)
case(psb_err_forgot_geall_)
write (0,'("To call this routine you must first call psb_geall on the same matrix")')
case(295)
case(psb_err_forgot_spall_)
write (0,'("To call this routine you must first call psb_spall on the same matrix")')
case(300)
case(psb_err_iarg_mbeeiarra_i_)
write (0,'("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') &
& i_e_d(1),i_e_d(4),i_e_d(3)
write (0,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5)
case(400)
case(psb_err_mpi_error_)
write (0,'("MPI error:",i0)')i_e_d(1)
case(550)
case(psb_err_parm_differs_among_procs_)
write (0,'("Parameter n. ",i0," must be equal on all processes. ",i0)')i_e_d(1)
case(551)
case(psb_err_entry_out_of_bounds_)
write (0,'("Entry n. ",i0," out of ",i0," should be between 1 and ",i0," but is ",i0)')i_e_d(1),i_e_d(3),i_e_d(4),i_e_d(2)
case(552)
case(psb_err_inconsistent_index_lists_)
write (0,'("Index lists are inconsistent: some indices are orphans")')
case(570)
case(psb_err_partfunc_toomuchprocs_)
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
write (0,'("greater than No of grid s processes on global point ",i0,". Actual number of grid s ")')i_e_d(4)
write (0,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3)
case(575)
case(psb_err_partfunc_toofewprocs_)
write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1)
write (0,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')i_e_d(3),i_e_d(2)
case(580)
case(psb_err_partfunc_wrong_pid_)
write (0,'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')i_e_d(1)
write (0,'("on global point ",i0,". Current value returned is : ",i0)')i_e_d(3),i_e_d(2)
case(581)
case(psb_err_no_optional_arg_)
write (0,'("Exactly one of the optional arguments ",a," must be present")')a_e_d
case(582)
case(psb_err_arg_m_required_)
write (0,'("Argument M is required when argument PARTS is specified")')
case(583)
write (0,'("No more than one of the optional arguments ",a," must be present")')a_e_d
case(600)
case(psb_err_spmat_invalid_state_)
write (0,'("Sparse Matrix and descriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1)
case(700)
write (0,'("The base version of subroutine ''",a,"'' has been called.",/,&
&"The class implementation for ''",a,"'' may be incomplete!")') &
& trim(r_name), trim(a_e_d)
case (1121)
write (0,'("Invalid state for sparse matrix A")')
case (1122)
case (psb_err_invalid_cd_state_)
write (0,'("Invalid state for communication descriptor")')
case (1123)
case (psb_err_invalid_a_and_cd_state_)
write (0,'("Invalid combined state for A and DESC_A")')
case (1124)
write (0,'("Invalid state for object:",a)') trim(a_e_d)
case(1125:1999)
case(1124:1999)
write (0,'("computational error. code: ",i0)')err_c
case(2010)
case(psb_err_blacs_error_)
write (0,'("BLACS error. Number of processes=-1")')
case(2011)
case(psb_err_initerror_neugh_procs_)
write (0,'("Initialization error: not enough processes available in the parallel environment")')
case(2030)
case(psb_err_blacs_err_gridcols_not_1_)
write (0,'("BLACS ERROR: Number of grid columns must be equal to 1\nCurrent value is ",i4," != 1.")')i_e_d(1)
case(2231)
case(psb_err_invalid_matrix_input_state_)
write (0,'("Invalid input state for matrix.")')
case(2232)
case(psb_err_input_no_regen_)
write (0,'("Input state for matrix is not adequate for regeneration.")')
case (2233:2999)
write(0,'("resource error. code: ",i0)')err_c
case(3000:3009)
write (0,'("sparse matrix representation ",a3," not yet implemented")')a_e_d(1:3)
case(3010)
case(psb_err_lld_case_not_implemented_)
write (0,'("Case lld not equal matrix_data[N_COL_] is not yet implemented.")')
case(3015)
case(psb_err_transpose_unsupported_)
write (0,'("transpose option for sparse matrix representation ",a3," not implemented")')a_e_d(1:3)
case(3020)
case(psb_err_transpose_c_unsupported_)
write (0,'("Case trans = C is not yet implemented.")')
case(3021)
case(psb_err_transpose_not_n_unsupported_)
write (0,'("Case trans /= N is not yet implemented.")')
case(3022)
case(psb_err_only_unit_diag_)
write (0,'("Only unit diagonal so far for triangular matrices. ")')
case(3023)
write (0,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")')
case(3024)
write (0,'("Cases DESCRA(1:1)=G not yet implemented. ")')
case(3030)
case(psb_err_ja_nix_ia_niy_unsupported_)
write (0,'("Case ja /= ix or ia/=iy is not yet implemented.")')
case(3040)
case(psb_err_ix_n1_iy_n1_unsupported_)
write (0,'("Case ix /= 1 or iy /= 1 is not yet implemented.")')
case(3050)
write (0,'("Case ix /= iy is not yet implemented.")')
@@ -539,7 +438,7 @@ contains
case(3100)
write (0,'("Error on index. Element has not been inserted")')
write (0,'("local index is: ",i0," and global index is:",i0)')i_e_d(1:2)
case(3110)
case(psb_err_input_matrix_unassembled_)
write (0,'("Before you call this routine, you must assembly sparse matrix")')
case(3111)
write (0,'("Before you call this routine, you must initialize the preconditioner")')
@@ -547,23 +446,23 @@ contains
write (0,'("Before you call this routine, you must build the preconditioner")')
case(3113:3999)
write(0,'("miscellaneus error. code: ",i0)')err_c
case(4000)
case(psb_err_alloc_dealloc_)
write(0,'("Allocation/deallocation error")')
case(4001)
case(psb_err_internal_error_)
write(0,'("Internal error: ",a)')a_e_d
case(4010)
case(psb_err_from_subroutine_)
write (0,'("Error from call to subroutine ",a)')a_e_d
case(4011)
case(psb_err_from_subroutine_non_)
write (0,'("Error from call to a subroutine ")')
case(4012)
case(psb_err_from_subroutine_i_)
write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1)
case(4013)
case(psb_err_from_subroutine_ai_)
write (0,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1)
case(4025)
case(psb_err_alloc_request_)
write (0,'("Error on allocation request for ",i0," items of type ",a)')i_e_d(1),a_e_d
case(4110)
write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d
case (5001)
case (psb_err_invalid_istop_)
write (0,'("Invalid ISTOP: ",i0)')i_e_d(1)
case (5002)
write (0,'("Invalid PREC: ",i0)')i_e_d(1)
base/modules/psb_penv_mod.F90
+6 -3566
View File
File diff suppressed because it is too large Load Diff
base/modules/psb_realloc_mod.F90
+640 -149
View File
File diff suppressed because it is too large Load Diff
base/psblas/Makefile
-1
View File
@@ -3,7 +3,6 @@ include ../../Make.inc
#FCOPT=-O2
OBJS= psb_ddot.o psb_damax.o psb_dasum.o psb_daxpby.o\
psb_dnrm2.o psb_dnrmi.o psb_dspmm.o psb_dspsm.o\
pdtreecomb.o pstreecomb.o\
psb_zamax.o psb_zasum.o psb_zaxpby.o psb_zdot.o \
psb_znrm2.o psb_znrmi.o psb_zspmm.o psb_zspsm.o\
psb_saxpby.o psb_sdot.o psb_sasum.o psb_samax.o\
base/psblas/pdtreecomb.F
-396
View File
@@ -1,396 +0,0 @@
C
C Parallel Sparse BLAS version 2.2
C (C) Copyright 2006/2007/2008
C Salvatore Filippone University of Rome Tor Vergata
C Alfredo Buttari University of Rome Tor Vergata
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
C
C This file imported from ScaLAPACK.
C
C
SUBROUTINE PDTREECOMB( ICTXT, SCOPE, N, MINE, RDEST0, CDEST0,
$ SUBPTR )
*
* -- ScaLAPACK tools routine (version 1.0) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* February 28, 1995
*
* .. Scalar Arguments ..
CHARACTER SCOPE
INTEGER CDEST0, ICTXT, N, RDEST0
* ..
* .. Array Arguments ..
DOUBLE PRECISION MINE( * )
* ..
* .. Subroutine Arguments ..
EXTERNAL SUBPTR
* ..
*
* Purpose
* == = ====
*
* PDTREECOMB does a 1-tree parallel combine operation on scalars,
* using the subroutine indicated by SUBPTR to perform the required
* computation.
*
* Arguments
* == = ======
*
* ICTXT (global input) INTEGER
* The BLACS context handle, indicating the global context of
* the operation. The context itself is global.
*
* SCOPE (global input) CHARACTER
* The scope of the operation: 'Rowwise', 'Columnwise', or
* 'All'.
*
* N (global input) INTEGER
* The number of elements in MINE. N = 1 for the norm-2
* computation and 2 for the sum of square.
*
* MINE (local input/global output) DOUBLE PRECISION array of
* dimension at least equal to N. The local data to use in the
* combine.
*
* RDEST0 (global input) INTEGER
* The process row to receive the answer. If RDEST0 = -1,
* every process in the scope gets the answer.
*
* CDEST0 (global input) INTEGER
* The process column to receive the answer. If CDEST0 = -1,
* every process in the scope gets the answer.
*
* SUBPTR (local input) Pointer to the subroutine to call to perform
* the required combine.
*
* == = ==================================================================
*
* .. Local Scalars ..
LOGICAL BCAST, RSCOPE, CSCOPE
INTEGER CMSSG, DEST, DIST, HISDIST, I, IAM, MYCOL,
$ MYROW, MYDIST, MYDIST2, NP, NPCOL, NPROW,
$ RMSSG, TCDEST, TRDEST
* ..
* .. Local Arrays ..
DOUBLE PRECISION HIS( 2 )
* ..
* .. External Subroutines ..
#if !defined(SERIAL_MPI)
EXTERNAL BLACS_GRIDINFO, DGEBR2D, DGEBS2D,
$ DGERV2D, DGESD2D
#endif
* ..
* .. External Functions ..
LOGICAL PSB_LSAME
EXTERNAL PSB_LSAME
* ..
* .. Intrinsic Functions ..
INTRINSIC MOD
* ..
* .. Executable Statements ..
*
* See if everyone wants the answer (need to broadcast the answer)
*
BCAST = ( ( RDEST0.EQ.-1 ).OR.( CDEST0.EQ.-1 ) )
IF( BCAST ) THEN
TRDEST = 0
TCDEST = 0
ELSE
TRDEST = RDEST0
TCDEST = CDEST0
END IF
#if !defined(SERIAL_MPI)
*
* Get grid parameters.
*
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
*
* Figure scope-dependant variables, or report illegal scope
*
RSCOPE = PSB_LSAME( SCOPE, 'R' )
CSCOPE = PSB_LSAME( SCOPE, 'C' )
*
IF( RSCOPE ) THEN
IF( BCAST ) THEN
TRDEST = MYROW
ELSE IF( MYROW.NE.TRDEST ) THEN
RETURN
END IF
NP = NPCOL
MYDIST = MOD( NPCOL + MYCOL - TCDEST, NPCOL )
ELSE IF( CSCOPE ) THEN
IF( BCAST ) THEN
TCDEST = MYCOL
ELSE IF( MYCOL.NE.TCDEST ) THEN
RETURN
END IF
NP = NPROW
MYDIST = MOD( NPROW + MYROW - TRDEST, NPROW )
ELSE IF( PSB_LSAME( SCOPE, 'A' ) ) THEN
NP = NPROW * NPCOL
IAM = MYROW*NPCOL + MYCOL
DEST = TRDEST*NPCOL + TCDEST
MYDIST = MOD( NP + IAM - DEST, NP )
ELSE
RETURN
END IF
*
IF( NP.LT.2 )
$ RETURN
*
MYDIST2 = MYDIST
RMSSG = MYROW
CMSSG = MYCOL
I = 1
*
10 CONTINUE
*
IF( MOD( MYDIST, 2 ).NE.0 ) THEN
*
* If I am process that sends information
*
DIST = I * ( MYDIST - MOD( MYDIST, 2 ) )
*
* Figure coordinates of dest of message
*
IF( RSCOPE ) THEN
CMSSG = MOD( TCDEST + DIST, NP )
ELSE IF( CSCOPE ) THEN
RMSSG = MOD( TRDEST + DIST, NP )
ELSE
CMSSG = MOD( DEST + DIST, NP )
RMSSG = CMSSG / NPCOL
CMSSG = MOD( CMSSG, NPCOL )
END IF
*
CALL DGESD2D( ICTXT, N, 1, MINE, N, RMSSG, CMSSG )
*
GO TO 20
*
ELSE
*
* If I am a process receiving information, figure coordinates
* of source of message
*
DIST = MYDIST2 + I
IF( RSCOPE ) THEN
CMSSG = MOD( TCDEST + DIST, NP )
HISDIST = MOD( NP + CMSSG - TCDEST, NP )
ELSE IF( CSCOPE ) THEN
RMSSG = MOD( TRDEST + DIST, NP )
HISDIST = MOD( NP + RMSSG - TRDEST, NP )
ELSE
CMSSG = MOD( DEST + DIST, NP )
RMSSG = CMSSG / NPCOL
CMSSG = MOD( CMSSG, NPCOL )
HISDIST = MOD( NP + RMSSG*NPCOL+CMSSG - DEST, NP )
END IF
*
IF( MYDIST2.LT.HISDIST ) THEN
*
* If I have anyone sending to me
*
CALL DGERV2D( ICTXT, N, 1, HIS, N, RMSSG, CMSSG )
CALL SUBPTR( MINE, HIS )
*
END IF
MYDIST = MYDIST / 2
*
END IF
I = I * 2
*
IF( I.LT.NP )
$ GO TO 10
*
20 CONTINUE
*
IF( BCAST ) THEN
IF( MYDIST2.EQ.0 ) THEN
CALL DGEBS2D( ICTXT, SCOPE, ' ', N, 1, MINE, N )
ELSE
CALL DGEBR2D( ICTXT, SCOPE, ' ', N, 1, MINE, N,
$ TRDEST, TCDEST )
END IF
END IF
#endif
*
RETURN
*
* End of PDTREECOMB
*
END
*
SUBROUTINE DCOMBAMAX( V1, V2 )
*
* -- ScaLAPACK tools routine (version 1.0) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* February 28, 1995
*
* .. Array Arguments ..
DOUBLE PRECISION V1( 2 ), V2( 2 )
* ..
*
* Purpose
* == = ====
*
* DCOMBAMAX finds the element having max. absolute value as well
* as its corresponding globl index.
*
* Arguments
* == = ======
*
* V1 (local input/local output) DOUBLE PRECISION array of
* dimension 2. The first maximum absolute value element and
* its global index. V1(1) = AMAX, V1(2) = INDX.
*
* V2 (local input) DOUBLE PRECISION array of dimension 2.
* The second maximum absolute value element and its global
* index. V2(1) = AMAX, V2(2) = INDX.
*
* == = ==================================================================
*
* .. Intrinsic Functions ..
INTRINSIC ABS
* ..
* .. Executable Statements ..
*
IF( ABS( V1( 1 ) ).LT.ABS( V2( 1 ) ) ) THEN
V1( 1 ) = V2( 1 )
V1( 2 ) = V2( 2 )
END IF
*
RETURN
*
* End of DCOMBAMAX
*
END
*
SUBROUTINE DCOMBSSQ( V1, V2 )
*
* -- ScaLAPACK tools routine (version 1.0) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* February 28, 1995
*
* .. Array Arguments ..
DOUBLE PRECISION V1( 2 ), V2( 2 )
* ..
*
* Purpose
* == = ====
*
* DCOMBSSQ does a scaled sum of squares on two scalars.
*
* Arguments
* == = ======
*
* V1 (local input/local output) DOUBLE PRECISION array of
* dimension 2. The first scaled sum. V1(1) = SCALE,
* V1(2) = SUMSQ.
*
* V2 (local input) DOUBLE PRECISION array of dimension 2.
* The second scaled sum. V2(1) = SCALE, V2(2) = SUMSQ.
*
* == = ==================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D+0 )
* ..
* .. Executable Statements ..
*
IF( V1( 1 ).GE.V2( 1 ) ) THEN
IF( V1( 1 ).NE.ZERO )
$ V1( 2 ) = V1( 2 ) + ( V2( 1 ) / V1( 1 ) )**2 * V2( 2 )
ELSE
V1( 2 ) = V2( 2 ) + ( V1( 1 ) / V2( 1 ) )**2 * V1( 2 )
V1( 1 ) = V2( 1 )
END IF
*
RETURN
*
* End of DCOMBSSQ
*
END
*
SUBROUTINE DCOMBNRM2( X, Y )
*
* -- ScaLAPACK tools routine (version 1.0) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* February 28, 1995
*
* .. Scalar Arguments ..
DOUBLE PRECISION X, Y
* ..
*
* Purpose
* == = ====
*
* DCOMBNRM2 combines local norm 2 results, taking care not to cause
* unnecessary overflow.
*
* Arguments
* == = ======
*
* X (local input) DOUBLE PRECISION
* Y (local input) DOUBLE PRECISION
* X and Y specify the values x and y. X and Y are supposed to
* be >= 0.
*
* == = ==================================================================
*
* .. Parameters ..
DOUBLE PRECISION ONE, ZERO
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
DOUBLE PRECISION W, Z
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, SQRT
* ..
* .. Executable Statements ..
*
W = MAX( X, Y )
Z = MIN( X, Y )
*
IF( Z.EQ.ZERO ) THEN
X = W
ELSE
X = W*SQRT( ONE+( Z / W )**2 )
END IF
*
RETURN
*
* End of DCOMBNRM2
*
END
base/psblas/psb_cnrm2.f90
+25 -14
View File
@@ -45,7 +45,10 @@
! jx - integer(optional). The column offset for sub( X ).
!
function psb_cnrm2(x, desc_a, info, jx)
use psb_sparse_mod, psb_protect_name => psb_cnrm2
use psb_descriptor_type
use psb_check_mod
use psb_error_mod
use psb_penv_mod
implicit none
complex(psb_spk_), intent(in) :: x(:,:)
@@ -59,7 +62,7 @@ function psb_cnrm2(x, desc_a, info, jx)
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm
real(psb_spk_) :: nrm2, scnrm2, dd
external scombnrm2
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_cnrm2'
@@ -71,7 +74,7 @@ function psb_cnrm2(x, desc_a, info, jx)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -116,8 +119,9 @@ function psb_cnrm2(x, desc_a, info, jx)
nrm2 = dzero
end if
call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
!!$ call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
call psb_nrm2(ictxt,nrm2)
psb_cnrm2 = nrm2
call psb_erractionrestore(err_act)
@@ -178,7 +182,10 @@ end function psb_cnrm2
! info - integer. Return code
!
function psb_cnrm2v(x, desc_a, info)
use psb_sparse_mod, psb_protect_name => psb_cnrm2v
use psb_descriptor_type
use psb_check_mod
use psb_error_mod
use psb_penv_mod
implicit none
complex(psb_spk_), intent(in) :: x(:)
@@ -191,7 +198,7 @@ function psb_cnrm2v(x, desc_a, info)
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm
real(psb_spk_) :: nrm2, scnrm2, dd
external scombnrm2
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_cnrm2v'
@@ -203,7 +210,7 @@ function psb_cnrm2v(x, desc_a, info)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -243,7 +250,8 @@ function psb_cnrm2v(x, desc_a, info)
nrm2 = dzero
end if
call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
!!$ call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
call psb_nrm2(ictxt,nrm2)
psb_cnrm2v = nrm2
@@ -307,7 +315,10 @@ end function psb_cnrm2v
! info - integer. Return code
!
subroutine psb_cnrm2vs(res, x, desc_a, info)
use psb_sparse_mod, psb_protect_name => psb_cnrm2vs
use psb_descriptor_type
use psb_check_mod
use psb_error_mod
use psb_penv_mod
implicit none
complex(psb_spk_), intent(in) :: x(:)
@@ -320,7 +331,7 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm
real(psb_spk_) :: nrm2, scnrm2, dd
external scombnrm2
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_cnrm2'
@@ -332,7 +343,7 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -372,8 +383,8 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
nrm2 = dzero
end if
call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
!!$ call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
call psb_nrm2(ictxt,nrm2)
res = nrm2
call psb_erractionrestore(err_act)
base/psblas/psb_dnrm2.f90
+16 -10
View File
@@ -61,7 +61,7 @@ function psb_dnrm2(x, desc_a, info, jx)
integer :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm
real(psb_dpk_) :: nrm2, dnrm2, dd
external dcombnrm2
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_dnrm2'
@@ -73,7 +73,7 @@ function psb_dnrm2(x, desc_a, info, jx)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -118,7 +118,8 @@ function psb_dnrm2(x, desc_a, info, jx)
nrm2 = dzero
end if
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
!!$ call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
call psb_nrm2(ictxt,nrm2)
psb_dnrm2 = nrm2
@@ -195,7 +196,7 @@ function psb_dnrm2v(x, desc_a, info)
integer :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm
real(psb_dpk_) :: nrm2, dnrm2, dd
external dcombnrm2
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_dnrm2v'
@@ -207,7 +208,7 @@ function psb_dnrm2v(x, desc_a, info)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -247,7 +248,8 @@ function psb_dnrm2v(x, desc_a, info)
nrm2 = dzero
end if
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
!!$ call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
call psb_nrm2(ictxt,nrm2)
psb_dnrm2v = nrm2
@@ -311,7 +313,10 @@ end function psb_dnrm2v
! info - integer. Return code
!
subroutine psb_dnrm2vs(res, x, desc_a, info)
use psb_sparse_mod, psb_protect_name => psb_dnrm2vs
use psb_descriptor_type
use psb_check_mod
use psb_error_mod
use psb_penv_mod
implicit none
real(psb_dpk_), intent(in) :: x(:)
@@ -323,7 +328,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
integer :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm
real(psb_dpk_) :: nrm2, dnrm2, dd
external dcombnrm2
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_dnrm2'
@@ -335,7 +340,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -375,7 +380,8 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
nrm2 = dzero
end if
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
!!$ call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
call psb_nrm2(ictxt,nrm2)
res = nrm2
base/psblas/psb_snrm2.f90
+17 -11
View File
@@ -61,7 +61,7 @@ function psb_snrm2(x, desc_a, info, jx)
integer :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm
real(psb_spk_) :: nrm2, snrm2, dd
external scombnrm2
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_snrm2'
@@ -73,7 +73,7 @@ function psb_snrm2(x, desc_a, info, jx)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -118,7 +118,8 @@ function psb_snrm2(x, desc_a, info, jx)
nrm2 = szero
end if
call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
!!$ call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
call psb_nrm2(ictxt,nrm2)
psb_snrm2 = nrm2
@@ -195,8 +196,8 @@ function psb_snrm2v(x, desc_a, info)
integer :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm
real(psb_spk_) :: nrm2, snrm2, dd
external scombnrm2
character(len=20) :: name, ch_err
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_snrm2v'
if(psb_get_errstatus() /= 0) return
@@ -207,7 +208,7 @@ function psb_snrm2v(x, desc_a, info)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -247,7 +248,8 @@ function psb_snrm2v(x, desc_a, info)
nrm2 = szero
end if
call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
!!$ call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
call psb_nrm2(ictxt,nrm2)
psb_snrm2v = nrm2
@@ -311,7 +313,10 @@ end function psb_snrm2v
! info - integer. Return code
!
subroutine psb_snrm2vs(res, x, desc_a, info)
use psb_sparse_mod, psb_protect_name => psb_snrm2vs
use psb_descriptor_type
use psb_check_mod
use psb_error_mod
use psb_penv_mod
implicit none
real(psb_spk_), intent(in) :: x(:)
@@ -323,7 +328,7 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
integer :: ictxt, np, me,&
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm
real(psb_spk_) :: nrm2, snrm2, dd
external scombnrm2
!!$ external scombnrm2
character(len=20) :: name, ch_err
name='psb_snrm2'
@@ -335,7 +340,7 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -375,7 +380,8 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
nrm2 = szero
end if
call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
!!$ call pstreecomb(ictxt,'All',1,nrm2,-1,-1,scombnrm2)
call psb_nrm2(ictxt,nrm2)
res = nrm2
base/psblas/psb_znrm2.f90
+16 -10
View File
@@ -62,7 +62,7 @@ function psb_znrm2(x, desc_a, info, jx)
& err_act, iix, jjx, ndim, ix, ijx, i, m, id, idx, ndm
real(psb_dpk_) :: nrm2, dznrm2, dd
external dcombnrm2
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_znrm2'
@@ -74,7 +74,7 @@ function psb_znrm2(x, desc_a, info, jx)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -119,7 +119,8 @@ function psb_znrm2(x, desc_a, info, jx)
nrm2 = dzero
end if
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
!!$ call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
call psb_nrm2(ictxt,nrm2)
psb_znrm2 = nrm2
@@ -197,7 +198,7 @@ function psb_znrm2v(x, desc_a, info)
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm
real(psb_dpk_) :: nrm2, dznrm2, dd
external dcombnrm2
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_znrm2v'
@@ -209,7 +210,7 @@ function psb_znrm2v(x, desc_a, info)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -249,7 +250,8 @@ function psb_znrm2v(x, desc_a, info)
nrm2 = dzero
end if
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
!!$ call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
call psb_nrm2(ictxt,nrm2)
psb_znrm2v = nrm2
@@ -313,7 +315,10 @@ end function psb_znrm2v
! info - integer. Return code
!
subroutine psb_znrm2vs(res, x, desc_a, info)
use psb_sparse_mod, psb_protect_name => psb_znrm2vs
use psb_descriptor_type
use psb_check_mod
use psb_error_mod
use psb_penv_mod
implicit none
complex(psb_dpk_), intent(in) :: x(:)
@@ -326,7 +331,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
& err_act, iix, jjx, ndim, ix, jx, i, m, id, idx, ndm
real(psb_dpk_) :: nrm2, dznrm2, dd
external dcombnrm2
!!$ external dcombnrm2
character(len=20) :: name, ch_err
name='psb_znrm2'
@@ -338,7 +343,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_blacs_error_
info=psb_err_blacs_error_
call psb_errpush(info,name)
goto 9999
endif
@@ -378,7 +383,8 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
nrm2 = dzero
end if
call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
!!$ call pdtreecomb(ictxt,'All',1,nrm2,-1,-1,dcombnrm2)
call psb_nrm2(ictxt,nrm2)
res = nrm2
base/psblas/pstreecomb.F
-396
View File
@@ -1,396 +0,0 @@
C
C Parallel Sparse BLAS version 2.2
C (C) Copyright 2006/2007/2008
C Salvatore Filippone University of Rome Tor Vergata
C Alfredo Buttari University of Rome Tor Vergata
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
C
C This file imported from ScaLAPACK.
C
C
SUBROUTINE PSTREECOMB( ICTXT, SCOPE, N, MINE, RDEST0, CDEST0,
$ SUBPTR )
*
* -- ScaLAPACK tools routine (version 1.5) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* May 1, 1997
*
* .. Scalar Arguments ..
CHARACTER SCOPE
INTEGER CDEST0, ICTXT, N, RDEST0
* ..
* .. Array Arguments ..
REAL MINE( * )
* ..
* .. Subroutine Arguments ..
EXTERNAL SUBPTR
* ..
*
* Purpose
* == = ====
*
* PSTREECOMB does a 1-tree parallel combine operation on scalars,
* using the subroutine indicated by SUBPTR to perform the required
* computation.
*
* Arguments
* == = ======
*
* ICTXT (global input) INTEGER
* The BLACS context handle, indicating the global context of
* the operation. The context itself is global.
*
* SCOPE (global input) CHARACTER
* The scope of the operation: 'Rowwise', 'Columnwise', or
* 'All'.
*
* N (global input) INTEGER
* The number of elements in MINE. N = 1 for the norm-2
* computation and 2 for the sum of square.
*
* MINE (local input/global output) REAL array of
* dimension at least equal to N. The local data to use in the
* combine.
*
* RDEST0 (global input) INTEGER
* The process row to receive the answer. If RDEST0 = -1,
* every process in the scope gets the answer.
*
* CDEST0 (global input) INTEGER
* The process column to receive the answer. If CDEST0 = -1,
* every process in the scope gets the answer.
*
* SUBPTR (local input) Pointer to the subroutine to call to perform
* the required combine.
*
* == = ==================================================================
*
* .. Local Scalars ..
LOGICAL BCAST, RSCOPE, CSCOPE
INTEGER CMSSG, DEST, DIST, HISDIST, I, IAM, MYCOL,
$ MYROW, MYDIST, MYDIST2, NP, NPCOL, NPROW,
$ RMSSG, TCDEST, TRDEST
* ..
* .. Local Arrays ..
REAL HIS( 2 )
* ..
* .. External Subroutines ..
#if !defined(SERIAL_MPI)
EXTERNAL BLACS_GRIDINFO, SGEBR2D, SGEBS2D,
$ SGERV2D, SGESD2D
#endif
* ..
* .. External Functions ..
LOGICAL PSB_LSAME
EXTERNAL PSB_LSAME
* ..
* .. Intrinsic Functions ..
INTRINSIC MOD
* ..
* .. Executable Statements ..
*
* See if everyone wants the answer (need to broadcast the answer)
*
BCAST = ( ( RDEST0.EQ.-1 ).OR.( CDEST0.EQ.-1 ) )
IF( BCAST ) THEN
TRDEST = 0
TCDEST = 0
ELSE
TRDEST = RDEST0
TCDEST = CDEST0
END IF
#if !defined(SERIAL_MPI)
*
* Get grid parameters.
*
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
*
* Figure scope-dependant variables, or report illegal scope
*
RSCOPE = PSB_LSAME( SCOPE, 'R' )
CSCOPE = PSB_LSAME( SCOPE, 'C' )
*
IF( RSCOPE ) THEN
IF( BCAST ) THEN
TRDEST = MYROW
ELSE IF( MYROW.NE.TRDEST ) THEN
RETURN
END IF
NP = NPCOL
MYDIST = MOD( NPCOL + MYCOL - TCDEST, NPCOL )
ELSE IF( CSCOPE ) THEN
IF( BCAST ) THEN
TCDEST = MYCOL
ELSE IF( MYCOL.NE.TCDEST ) THEN
RETURN
END IF
NP = NPROW
MYDIST = MOD( NPROW + MYROW - TRDEST, NPROW )
ELSE IF( PSB_LSAME( SCOPE, 'A' ) ) THEN
NP = NPROW * NPCOL
IAM = MYROW*NPCOL + MYCOL
DEST = TRDEST*NPCOL + TCDEST
MYDIST = MOD( NP + IAM - DEST, NP )
ELSE
RETURN
END IF
*
IF( NP.LT.2 )
$ RETURN
*
MYDIST2 = MYDIST
RMSSG = MYROW
CMSSG = MYCOL
I = 1
*
10 CONTINUE
*
IF( MOD( MYDIST, 2 ).NE.0 ) THEN
*
* If I am process that sends information
*
DIST = I * ( MYDIST - MOD( MYDIST, 2 ) )
*
* Figure coordinates of dest of message
*
IF( RSCOPE ) THEN
CMSSG = MOD( TCDEST + DIST, NP )
ELSE IF( CSCOPE ) THEN
RMSSG = MOD( TRDEST + DIST, NP )
ELSE
CMSSG = MOD( DEST + DIST, NP )
RMSSG = CMSSG / NPCOL
CMSSG = MOD( CMSSG, NPCOL )
END IF
*
CALL SGESD2D( ICTXT, N, 1, MINE, N, RMSSG, CMSSG )
*
GO TO 20
*
ELSE
*
* If I am a process receiving information, figure coordinates
* of source of message
*
DIST = MYDIST2 + I
IF( RSCOPE ) THEN
CMSSG = MOD( TCDEST + DIST, NP )
HISDIST = MOD( NP + CMSSG - TCDEST, NP )
ELSE IF( CSCOPE ) THEN
RMSSG = MOD( TRDEST + DIST, NP )
HISDIST = MOD( NP + RMSSG - TRDEST, NP )
ELSE
CMSSG = MOD( DEST + DIST, NP )
RMSSG = CMSSG / NPCOL
CMSSG = MOD( CMSSG, NPCOL )
HISDIST = MOD( NP + RMSSG*NPCOL+CMSSG - DEST, NP )
END IF
*
IF( MYDIST2.LT.HISDIST ) THEN
*
* If I have anyone sending to me
*
CALL SGERV2D( ICTXT, N, 1, HIS, N, RMSSG, CMSSG )
CALL SUBPTR( MINE, HIS )
*
END IF
MYDIST = MYDIST / 2
*
END IF
I = I * 2
*
IF( I.LT.NP )
$ GO TO 10
*
20 CONTINUE
*
IF( BCAST ) THEN
IF( MYDIST2.EQ.0 ) THEN
CALL SGEBS2D( ICTXT, SCOPE, ' ', N, 1, MINE, N )
ELSE
CALL SGEBR2D( ICTXT, SCOPE, ' ', N, 1, MINE, N,
$ TRDEST, TCDEST )
END IF
END IF
#endif
*
RETURN
*
* End of PSTREECOMB
*
END
*
SUBROUTINE SCOMBAMAX( V1, V2 )
*
* -- ScaLAPACK tools routine (version 1.5) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* May 1, 1997
*
* .. Array Arguments ..
REAL V1( 2 ), V2( 2 )
* ..
*
* Purpose
* == = ====
*
* SCOMBAMAX finds the element having max. absolute value as well
* as its corresponding globl index.
*
* Arguments
* == = ======
*
* V1 (local input/local output) REAL array of
* dimension 2. The first maximum absolute value element and
* its global index. V1(1) = AMAX, V1(2) = INDX.
*
* V2 (local input) REAL array of dimension 2.
* The second maximum absolute value element and its global
* index. V2(1) = AMAX, V2(2) = INDX.
*
* == = ==================================================================
*
* .. Intrinsic Functions ..
INTRINSIC ABS
* ..
* .. Executable Statements ..
*
IF( ABS( V1( 1 ) ).LT.ABS( V2( 1 ) ) ) THEN
V1( 1 ) = V2( 1 )
V1( 2 ) = V2( 2 )
END IF
*
RETURN
*
* End of SCOMBAMAX
*
END
*
SUBROUTINE SCOMBSSQ( V1, V2 )
*
* -- ScaLAPACK tools routine (version 1.5) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* May 1, 1997
*
* .. Array Arguments ..
REAL V1( 2 ), V2( 2 )
* ..
*
* Purpose
* == = ====
*
* SCOMBSSQ does a scaled sum of squares on two scalars.
*
* Arguments
* == = ======
*
* V1 (local input/local output) REAL array of
* dimension 2. The first scaled sum. V1(1) = SCALE,
* V1(2) = SUMSQ.
*
* V2 (local input) REAL array of dimension 2.
* The second scaled sum. V2(1) = SCALE, V2(2) = SUMSQ.
*
* == = ==================================================================
*
* .. Parameters ..
REAL ZERO
PARAMETER ( ZERO = 0.0E+0 )
* ..
* .. Executable Statements ..
*
IF( V1( 1 ).GE.V2( 1 ) ) THEN
IF( V1( 1 ).NE.ZERO )
$ V1( 2 ) = V1( 2 ) + ( V2( 1 ) / V1( 1 ) )**2 * V2( 2 )
ELSE
V1( 2 ) = V2( 2 ) + ( V1( 1 ) / V2( 1 ) )**2 * V1( 2 )
V1( 1 ) = V2( 1 )
END IF
*
RETURN
*
* End of SCOMBSSQ
*
END
*
SUBROUTINE SCOMBNRM2( X, Y )
*
* -- ScaLAPACK tools routine (version 1.5) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* May 1, 1997
*
* .. Scalar Arguments ..
REAL X, Y
* ..
*
* Purpose
* == = ====
*
* SCOMBNRM2 combines local norm 2 results, taking care not to cause
* unnecessary overflow.
*
* Arguments
* == = ======
*
* X (local input) REAL
* Y (local input) REAL
* X and Y specify the values x and y. X and Y are supposed to
* be >= 0.
*
* == = ==================================================================
*
* .. Parameters ..
REAL ONE, ZERO
PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
* ..
* .. Local Scalars ..
REAL W, Z
* ..
* .. Intrinsic Functions ..
INTRINSIC MAX, MIN, SQRT
* ..
* .. Executable Statements ..
*
W = MAX( X, Y )
Z = MIN( X, Y )
*
IF( Z.EQ.ZERO ) THEN
X = W
ELSE
X = W*SQRT( ONE+( Z / W )**2 )
END IF
*
RETURN
*
* End of SCOMBNRM2
*
END
configure
Vendored
+30 -762
View File
@@ -649,7 +649,6 @@ PSBLASRULES
FINCLUDES
CINCLUDES
METIS_LIBS
BLACS_LIBS
INSTALL_DOCSDIR
INSTALL_INCLUDEDIR
INSTALL_LIBDIR
@@ -785,7 +784,6 @@ with_module_path
enable_dependency_tracking
with_blas
with_lapack
with_blacs
with_metis
'
ac_precious_vars='build_alias
@@ -1459,8 +1457,6 @@ Optional Packages:
prepend to MODULE_PATH
--with-blas=<lib> use BLAS library <lib>
--with-lapack=<lib> use LAPACK library <lib>
--with-blacs=LIB Specify BLACSLIBNAME or -lBLACSLIBNAME or the
absolute library filename.
--with-metis=LIB Specify -lMETISLIBNAME or the absolute library
filename.
@@ -7001,7 +6997,7 @@ if test "X$CCOPT" == "X" ; then
CCOPT="-O2 $CCOPT"
fi
fi
CFLAGS="${CCOPT}"
#CFLAGS="${CCOPT}"
if test "X$FCOPT" == "X" ; then
if test "X$psblas_cv_fc" == "Xgcc" ; then
@@ -7010,7 +7006,7 @@ if test "X$FCOPT" == "X" ; then
FCOPT="-O3 $FCOPT"
elif test "X$psblas_cv_fc" == X"xlf" ; then
# XL compiler : consider using -qarch=auto
FCOPT="-O3 -qarch=auto $FCOPT"
FCOPT="-O3 -qarch=auto -qfixed -qsuffix=f=f:cpp=F $FCOPT"
elif test "X$psblas_cv_fc" == X"ifc" ; then
# other compilers ..
FCOPT="-O3 $FCOPT"
@@ -7033,7 +7029,7 @@ if test "X$psblas_cv_fc" == X"nag" ; then
# Add needed options
FCOPT="$FCOPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
fi
FFLAGS="${FCOPT}"
#FFLAGS="${FCOPT}"
if test "X$F90COPT" == "X" ; then
if test "X$psblas_cv_fc" == "Xgcc" ; then
@@ -7042,7 +7038,7 @@ if test "X$F90COPT" == "X" ; then
F90COPT="-O3 $F90COPT"
elif test "X$psblas_cv_fc" == X"xlf" ; then
# XL compiler : consider using -qarch=auto
F90COPT="-O3 -qarch=auto $F90COPT"
F90COPT="-O3 -qarch=auto -qsuffix=f=f90:cpp=F90 $F90COPT"
elif test "X$psblas_cv_fc" == X"ifc" ; then
# other compilers ..
F90COPT="-O3 $F90COPT"
@@ -7067,59 +7063,30 @@ if test "X$psblas_cv_fc" == X"nag" ; then
F90COPT="$F90COPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
EXTRA_OPT="-mismatch_all"
F03COPT="${F90COPT}"
F03="nagfor"
elif test "X$psblas_cv_fc" == X"xlf" ; then
F03="xlf2003_r"
F03COPT="-O3 -qarch=auto -qsuffix=f=f03:cpp=F03 $F03COPT"
else
F03=${FC}
F03COPT="${F90COPT}"
fi
FCFLAGS="${F90COPT}"
#FCFLAGS="${F90COPT}"
# COPT,FCOPT, F90COPT are aliases for FFLAGS,CFLAGS,FCFLAGS .
##############################################################################
# Compilers variables selection
##############################################################################
if test "X$psblas_cv_fc" == X"xlf" ; then
# WARNING : this is EVIL : specifying a pathname prefixed compiler will be ignored!
# But this is necessary since :
# - if called from some script, xlf could behave strangely
# - it is not said that mpxlf95 gets chosen by the configure script.
F90="xlf95 -qsuffix=f=f90:cpp=F90"
F03="xlf2003_r -qsuffix=f=f03:cpp=F03"
# F90="xlf95"
# FC="xlf"
F90=${FC}
F03=${F03}
MPF90=${MPIFC}
FC=${FC}
MPF77=${MPIFC}
CC=${CC}
MPCC=${MPICC}
# Note : this gives problems in base/serial/aux/isaperm.f
# FC="mpxlf -qsuffix=f=f90:cpp=F90"
# Note : this is the cure
FC="xlf -qsuffix=f=f:cpp=F"
# Note : maybe we will want xlf -qsuffix=cpp=F
F77="xlf"
CC="xlc"
if test x"$pac_cv_serial_mpi" == x"yes" ; then
MPF90="xlf2003_r -qsuffix=f=f90:cpp=F90"
MPF77="xlf95 -qfixed -qsuffix=f=f:cpp=F"
MPCC="xlc"
else
MPF90="mpxlf2003_r -qsuffix=f=f90:cpp=F90"
MPF77="mpxlf95 -qfixed -qsuffix=f=f:cpp=F"
MPCC="mpcc"
fi
#MPFCC="mpxlc"
# Note : -qfixed should be not specified in the environment FFLAGS or things will break.
# This fact should be documented somewhere.
else
# We really think about the GCC here but this is our idea for other compilers, too.
# If the user wishes to, she should specify MPICC, MPIF77 after ./configure.
# Note: this behavious should be documented.
F90=${FC}
F03=${FC}
MPF90=${MPIFC}
FC=${FC}
MPF77=${MPIFC}
CC=${CC}
MPCC=${MPICC}
fi
##############################################################################
@@ -10257,713 +10224,16 @@ fi
###############################################################################
# BLACS library presence checks
###############################################################################
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
if test x"$pac_cv_serial_mpi" == x"no" ; then
save_FC="$FC";
save_CC="$CC";
FC="$MPIFC";
CC="$MPICC";
# Check whether --with-blacs was given.
if test "${with_blacs+set}" = set; then
withval=$with_blacs; psblas_cv_blacs=$withval
else
psblas_cv_blacs=''
fi
case $psblas_cv_blacs in
yes | "") ;;
-* | */* | *.a | *.so | *.so.* | *.o)
BLACS_LIBS="$psblas_cv_blacs" ;;
*) BLACS_LIBS="-l$psblas_cv_blacs" ;;
esac
#
# Test user-defined BLACS
#
if test x"$psblas_cv_blacs" != "x" ; then
save_LIBS="$LIBS";
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
LIBS="$BLACS_LIBS $LIBS"
{ $as_echo "$as_me:$LINENO: checking for dgesd2d in $BLACS_LIBS" >&5
$as_echo_n "checking for dgesd2d in $BLACS_LIBS... " >&6; }
cat >conftest.$ac_ext <<_ACEOF
program main
call dgesd2d
end
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_fc_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
}; then
psblas_cv_blacs_ok=yes
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
psblas_cv_blacs_ok=no;BLACS_LIBS=""
fi
rm -rf conftest.dSYM
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
{ $as_echo "$as_me:$LINENO: result: $psblas_cv_blacs_ok" >&5
$as_echo "$psblas_cv_blacs_ok" >&6; }
if test x"$psblas_cv_blacs_ok" == x"yes"; then
{ $as_echo "$as_me:$LINENO: checking for blacs_pinfo in $BLACS_LIBS" >&5
$as_echo_n "checking for blacs_pinfo in $BLACS_LIBS... " >&6; }
cat >conftest.$ac_ext <<_ACEOF
program main
call blacs_pinfo
end
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_fc_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
}; then
psblas_cv_blacs_ok=yes
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
psblas_cv_blacs_ok=no;BLACS_LIBS=""
fi
rm -rf conftest.dSYM
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
{ $as_echo "$as_me:$LINENO: result: $psblas_cv_blacs_ok" >&5
$as_echo "$psblas_cv_blacs_ok" >&6; }
fi
LIBS="$save_LIBS";
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
######################################
# System BLACS with PESSL default names.
######################################
if test x"$BLACS_LIBS" == "x" ; then
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
pac_check_libs_ok=no
for pac_check_libs_f in dgesd2d
do
for pac_check_libs_l in blacssmp blacsp2 blacs
do
if test x"$pac_check_libs_ok" == xno ; then
as_ac_Lib=`$as_echo "ac_cv_lib_$pac_check_libs_l''_$pac_check_libs_f" | $as_tr_sh`
{ $as_echo "$as_me:$LINENO: checking for $pac_check_libs_f in -l$pac_check_libs_l" >&5
$as_echo_n "checking for $pac_check_libs_f in -l$pac_check_libs_l... " >&6; }
if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-l$pac_check_libs_l $LIBS"
cat >conftest.$ac_ext <<_ACEOF
program main
call $pac_check_libs_f
end
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_fc_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
}; then
eval "$as_ac_Lib=yes"
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
eval "$as_ac_Lib=no"
fi
rm -rf conftest.dSYM
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
ac_res=`eval 'as_val=${'$as_ac_Lib'}
$as_echo "$as_val"'`
{ $as_echo "$as_me:$LINENO: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
as_val=`eval 'as_val=${'$as_ac_Lib'}
$as_echo "$as_val"'`
if test "x$as_val" = x""yes; then
pac_check_libs_ok=yes; pac_check_libs_LIBS="-l$pac_check_libs_l"
fi
fi
done
done
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x"$pac_check_libs_ok" = xyes ; then
psblas_cv_blacs_ok=yes; LIBS="$LIBS $pac_check_libs_LIBS "
BLACS_LIBS="$pac_check_libs_LIBS"
{ $as_echo "$as_me:$LINENO: BLACS libraries detected." >&5
$as_echo "$as_me: BLACS libraries detected." >&6;}
else
pac_check_libs_ok=no
fi
if test x"$BLACS_LIBS" != "x"; then
save_LIBS="$LIBS";
LIBS="$BLACS_LIBS $LIBS"
{ $as_echo "$as_me:$LINENO: checking for blacs_pinfo in $BLACS_LIBS" >&5
$as_echo_n "checking for blacs_pinfo in $BLACS_LIBS... " >&6; }
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
cat >conftest.$ac_ext <<_ACEOF
program main
call blacs_pinfo
end
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_fc_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
}; then
psblas_cv_blacs_ok=yes
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
psblas_cv_blacs_ok=no;BLACS_LIBS=""
fi
rm -rf conftest.dSYM
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
{ $as_echo "$as_me:$LINENO: result: $psblas_cv_blacs_ok" >&5
$as_echo "$psblas_cv_blacs_ok" >&6; }
LIBS="$save_LIBS";
fi
fi
######################################
# Maybe we're looking at PESSL BLACS?#
######################################
if test x"$BLACS_LIBS" != "x" ; then
save_LIBS="$LIBS";
LIBS="$BLACS_LIBS $LIBS"
{ $as_echo "$as_me:$LINENO: checking for PESSL BLACS" >&5
$as_echo_n "checking for PESSL BLACS... " >&6; }
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
cat >conftest.$ac_ext <<_ACEOF
program main
call esvemonp
end
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_fc_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
}; then
psblas_cv_pessl_blacs=yes
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
psblas_cv_pessl_blacs=no
fi
rm -rf conftest.dSYM
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
{ $as_echo "$as_me:$LINENO: result: $psblas_cv_pessl_blacs" >&5
$as_echo "$psblas_cv_pessl_blacs" >&6; }
LIBS="$save_LIBS";
fi
if test "x$psblas_cv_pessl_blacs" == "xyes"; then
FDEFINES="$psblas_cv_define_prepend-DHAVE_ESSL_BLACS $FDEFINES"
fi
##############################################################################
# Netlib BLACS library with default names
##############################################################################
if test x"$BLACS_LIBS" == "x" ; then
save_LIBS="$LIBS";
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
pac_check_libs_ok=no
for pac_check_libs_f in dgesd2d
do
for pac_check_libs_l in blacs_MPI-LINUX-0 blacs_MPI-SP5-0 blacs_MPI-SP4-0 blacs_MPI-SP3-0 blacs_MPI-SP2-0 blacsCinit_MPI-ALPHA-0 blacsCinit_MPI-IRIX64-0 blacsCinit_MPI-RS6K-0 blacsCinit_MPI-SPP-0 blacsCinit_MPI-SUN4-0 blacsCinit_MPI-SUN4SOL2-0 blacsCinit_MPI-T3D-0 blacsCinit_MPI-T3E-0
do
if test x"$pac_check_libs_ok" == xno ; then
as_ac_Lib=`$as_echo "ac_cv_lib_$pac_check_libs_l''_$pac_check_libs_f" | $as_tr_sh`
{ $as_echo "$as_me:$LINENO: checking for $pac_check_libs_f in -l$pac_check_libs_l" >&5
$as_echo_n "checking for $pac_check_libs_f in -l$pac_check_libs_l... " >&6; }
if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-l$pac_check_libs_l $LIBS"
cat >conftest.$ac_ext <<_ACEOF
program main
call $pac_check_libs_f
end
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_fc_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
}; then
eval "$as_ac_Lib=yes"
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
eval "$as_ac_Lib=no"
fi
rm -rf conftest.dSYM
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
ac_res=`eval 'as_val=${'$as_ac_Lib'}
$as_echo "$as_val"'`
{ $as_echo "$as_me:$LINENO: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
as_val=`eval 'as_val=${'$as_ac_Lib'}
$as_echo "$as_val"'`
if test "x$as_val" = x""yes; then
pac_check_libs_ok=yes; pac_check_libs_LIBS="-l$pac_check_libs_l"
fi
fi
done
done
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x"$pac_check_libs_ok" = xyes ; then
psblas_cv_blacs_ok=yes; LIBS="$LIBS $pac_check_libs_LIBS "
psblas_have_netlib_blacs=yes;
BLACS_LIBS="$pac_check_libs_LIBS"
{ $as_echo "$as_me:$LINENO: BLACS libraries detected." >&5
$as_echo "$as_me: BLACS libraries detected." >&6;}
else
pac_check_libs_ok=no
fi
if test x"$BLACS_LIBS" != "x" ; then
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
pac_check_libs_ok=no
for pac_check_libs_f in blacs_pinfo
do
for pac_check_libs_l in blacsF77init_MPI-LINUX-0 blacsF77init_MPI-SP5-0 blacsF77init_MPI-SP4-0 blacsF77init_MPI-SP3-0 blacsF77init_MPI-SP2-0 blacsF77init_MPI-ALPHA-0 blacsF77init_MPI-IRIX64-0 blacsF77init_MPI-RS6K-0 blacsF77init_MPI-SPP-0 blacsF77init_MPI-SUN4-0 blacsF77init_MPI-SUN4SOL2-0 blacsF77init_MPI-T3D-0 blacsF77init_MPI-T3E-0
do
if test x"$pac_check_libs_ok" == xno ; then
as_ac_Lib=`$as_echo "ac_cv_lib_$pac_check_libs_l''_$pac_check_libs_f" | $as_tr_sh`
{ $as_echo "$as_me:$LINENO: checking for $pac_check_libs_f in -l$pac_check_libs_l" >&5
$as_echo_n "checking for $pac_check_libs_f in -l$pac_check_libs_l... " >&6; }
if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-l$pac_check_libs_l $LIBS"
cat >conftest.$ac_ext <<_ACEOF
program main
call $pac_check_libs_f
end
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_fc_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
}; then
eval "$as_ac_Lib=yes"
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
eval "$as_ac_Lib=no"
fi
rm -rf conftest.dSYM
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
ac_res=`eval 'as_val=${'$as_ac_Lib'}
$as_echo "$as_val"'`
{ $as_echo "$as_me:$LINENO: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
as_val=`eval 'as_val=${'$as_ac_Lib'}
$as_echo "$as_val"'`
if test "x$as_val" = x""yes; then
pac_check_libs_ok=yes; pac_check_libs_LIBS="-l$pac_check_libs_l"
fi
fi
done
done
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x"$pac_check_libs_ok" = xyes ; then
psblas_cv_blacs_ok=yes; LIBS="$pac_check_libs_LIBS $LIBS"
BLACS_LIBS="$pac_check_libs_LIBS $BLACS_LIBS"
{ $as_echo "$as_me:$LINENO: Netlib BLACS Fortran initialization libraries detected." >&5
$as_echo "$as_me: Netlib BLACS Fortran initialization libraries detected." >&6;}
else
pac_check_libs_ok=no
fi
fi
if test x"$BLACS_LIBS" != "x" ; then
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
pac_check_libs_ok=no
for pac_check_libs_f in Cblacs_pinfo
do
for pac_check_libs_l in blacsCinit_MPI-LINUX-0 blacsCinit_MPI-SP5-0 blacsCinit_MPI-SP4-0 blacsCinit_MPI-SP3-0 blacsCinit_MPI-SP2-0 blacsCinit_MPI-ALPHA-0 blacsCinit_MPI-IRIX64-0 blacsCinit_MPI-RS6K-0 blacsCinit_MPI-SPP-0 blacsCinit_MPI-SUN4-0 blacsCinit_MPI-SUN4SOL2-0 blacsCinit_MPI-T3D-0 blacsCinit_MPI-T3E-0
do
if test x"$pac_check_libs_ok" == xno ; then
as_ac_Lib=`$as_echo "ac_cv_lib_$pac_check_libs_l''_$pac_check_libs_f" | $as_tr_sh`
{ $as_echo "$as_me:$LINENO: checking for $pac_check_libs_f in -l$pac_check_libs_l" >&5
$as_echo_n "checking for $pac_check_libs_f in -l$pac_check_libs_l... " >&6; }
if { as_var=$as_ac_Lib; eval "test \"\${$as_var+set}\" = set"; }; then
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-l$pac_check_libs_l $LIBS"
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $pac_check_libs_f ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $pac_check_libs_f ();
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_c_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
}; then
eval "$as_ac_Lib=yes"
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
eval "$as_ac_Lib=no"
fi
rm -rf conftest.dSYM
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
ac_res=`eval 'as_val=${'$as_ac_Lib'}
$as_echo "$as_val"'`
{ $as_echo "$as_me:$LINENO: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
as_val=`eval 'as_val=${'$as_ac_Lib'}
$as_echo "$as_val"'`
if test "x$as_val" = x""yes; then
pac_check_libs_ok=yes; pac_check_libs_LIBS="-l$pac_check_libs_l"
fi
fi
done
done
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x"$pac_check_libs_ok" = xyes ; then
psblas_cv_blacs_ok=yes; LIBS="$pac_check_libs_LIBS $LIBS"
BLACS_LIBS="$BLACS_LIBS $pac_check_libs_LIBS"
{ $as_echo "$as_me:$LINENO: Netlib BLACS C initialization libraries detected." >&5
$as_echo "$as_me: Netlib BLACS C initialization libraries detected." >&6;}
else
pac_check_libs_ok=no
fi
fi
LIBS="$save_LIBS";
fi
if test x"$BLACS_LIBS" == "x" ; then
{ { $as_echo "$as_me:$LINENO: error:
No BLACS library detected! $PACKAGE_NAME will be unusable.
Please make sure a BLACS implementation is accessible (ex.: --with-blacs=\"-lblacsname -L/blacs/dir\" )
" >&5
$as_echo "$as_me: error:
No BLACS library detected! $PACKAGE_NAME will be unusable.
Please make sure a BLACS implementation is accessible (ex.: --with-blacs=\"-lblacsname -L/blacs/dir\" )
" >&2;}
{ (exit 1); exit 1; }; }
else
save_LIBS="$LIBS";
LIBS="$BLACS_LIBS $LIBS"
{ $as_echo "$as_me:$LINENO: checking for ksendid in $BLACS_LIBS" >&5
$as_echo_n "checking for ksendid in $BLACS_LIBS... " >&6; }
ac_ext=${ac_fc_srcext-f}
ac_compile='$FC -c $FCFLAGS $ac_fcflags_srcext conftest.$ac_ext >&5'
ac_link='$FC -o conftest$ac_exeext $FCFLAGS $LDFLAGS $ac_fcflags_srcext conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_fc_compiler_gnu
cat >conftest.$ac_ext <<_ACEOF
program main
call ksendid
end
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""
$as_echo "$ac_try_echo") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_fc_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
}; then
psblas_cv_have_sendid=yes
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
psblas_cv_have_sendid=no
fi
rm -rf conftest.dSYM
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
{ $as_echo "$as_me:$LINENO: result: $psblas_cv_have_sendid" >&5
$as_echo "$psblas_cv_have_sendid" >&6; }
LIBS="$save_LIBS"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
if test "x$psblas_cv_have_sendid" == "xyes"; then
FDEFINES="$psblas_cv_define_prepend-DHAVE_KSENDID $FDEFINES"
fi
fi
FC="$save_FC";
CC="$save_CC";
fi
#AC_LANG([C])
#if test x"$pac_cv_serial_mpi" == x"no" ; then
#save_FC="$FC";
#save_CC="$CC";
#FC="$MPIFC";
#CC="$MPICC";
#PAC_CHECK_BLACS
#FC="$save_FC";
#CC="$save_CC";
#fi
{ $as_echo "$as_me:$LINENO: checking for gnumake" >&5
@@ -11229,7 +10499,7 @@ UTILLIBNAME=libpsb_util.a
#AC_SUBST(BLACS_LIBS)
@@ -11238,7 +10508,7 @@ UTILLIBNAME=libpsb_util.a
if test "X$psblas_make_gnumake" == "Xyes" ; then
PSBLASRULES='
PSBLDLIBS=$(BLACS) $(LAPACK) $(BLAS) $(METIS_LIB) $(LIBS)
PSBLDLIBS=$(LAPACK) $(BLAS) $(METIS_LIB) $(LIBS)
CDEFINES=$(PSBCDEFINES)
FDEFINES=$(PSBFDEFINES)
# Warning : these rules are only valid with GNU make!
@@ -11276,7 +10546,7 @@ $(.mod).o:
else
PSBLASRULES='
PSBLDLIBS=$(BLACS) $(LAPACK) $(BLAS) $(METIS_LIB) $(LIBS)
PSBLDLIBS=$(LAPACK) $(BLAS) $(METIS_LIB) $(LIBS)
CDEFINES=$(PSBCDEFINES)
FDEFINES=$(PSBFDEFINES)
@@ -12644,7 +11914,6 @@ fi
BLAS : ${BLAS_LIBS}
BLACS : ${BLACS_LIBS}
METIS detected : ${psblas_cv_have_metis}
@@ -12678,7 +11947,6 @@ $as_echo "$as_me:
BLAS : ${BLAS_LIBS}
BLACS : ${BLACS_LIBS}
METIS detected : ${psblas_cv_have_metis}
configure.ac
+14 -14
View File
@@ -605,16 +605,16 @@ PAC_LAPACK(
###############################################################################
# BLACS library presence checks
###############################################################################
AC_LANG([C])
if test x"$pac_cv_serial_mpi" == x"no" ; then
save_FC="$FC";
save_CC="$CC";
FC="$MPIFC";
CC="$MPICC";
PAC_CHECK_BLACS
FC="$save_FC";
CC="$save_CC";
fi
#AC_LANG([C])
#if test x"$pac_cv_serial_mpi" == x"no" ; then
#save_FC="$FC";
#save_CC="$CC";
#FC="$MPIFC";
#CC="$MPICC";
#PAC_CHECK_BLACS
#FC="$save_FC";
#CC="$save_CC";
#fi
PAC_MAKE_IS_GNUMAKE
@@ -705,7 +705,7 @@ AC_SUBST(INSTALL_INCLUDEDIR)
AC_SUBST(INSTALL_DOCSDIR)
AC_SUBST(BLAS_LIBS)
AC_SUBST(BLACS_LIBS)
#AC_SUBST(BLACS_LIBS)
AC_SUBST(METIS_LIBS)
AC_SUBST(LAPACK_LIBS)
@@ -714,7 +714,7 @@ AC_SUBST(FINCLUDES)
if test "X$psblas_make_gnumake" == "Xyes" ; then
PSBLASRULES='
PSBLDLIBS=$(BLACS) $(LAPACK) $(BLAS) $(METIS_LIB) $(LIBS)
PSBLDLIBS=$(LAPACK) $(BLAS) $(METIS_LIB) $(LIBS)
CDEFINES=$(PSBCDEFINES)
FDEFINES=$(PSBFDEFINES)
# Warning : these rules are only valid with GNU make!
@@ -752,7 +752,7 @@ $(.mod).o:
else
PSBLASRULES='
PSBLDLIBS=$(BLACS) $(LAPACK) $(BLAS) $(METIS_LIB) $(LIBS)
PSBLDLIBS=$(LAPACK) $(BLAS) $(METIS_LIB) $(LIBS)
CDEFINES=$(PSBCDEFINES)
FDEFINES=$(PSBFDEFINES)
@@ -828,7 +828,7 @@ dnl FCFLAGS : ${FCFLAGS}
dnl ESSL/PESSL : ${psblas_cv_have_essl} / ${psblas_cv_have_pessl}
BLAS : ${BLAS_LIBS}
BLACS : ${BLACS_LIBS}
dnl BLACS : ${BLACS_LIBS}
METIS detected : ${psblas_cv_have_metis}
dnl SuperLU detected : ${psblas_cv_have_superlu}