From e8847d1bb7dfa78637d29d1d1810aaf221f71925 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 15 Nov 2011 15:38:54 +0000 Subject: [PATCH] psblas3: base/modules/Makefile base/modules/psb_d_psblas_mod.f90 prec/psb_c_bjacprec.f90 prec/psb_c_prec_mod.f90 prec/psb_d_prec_mod.f90 prec/psb_s_bjacprec.f90 prec/psb_s_prec_mod.f90 prec/psb_z_bjacprec.f90 prec/psb_z_prec_mod.f90 Fixes from cross-checks with Nag compiler --- base/modules/Makefile | 18 +++++++++++++++++- base/modules/psb_d_psblas_mod.f90 | 4 ++-- prec/psb_c_bjacprec.f90 | 5 ++++- prec/psb_c_prec_mod.f90 | 9 +++++---- prec/psb_d_prec_mod.f90 | 9 +++++---- prec/psb_s_bjacprec.f90 | 12 ++++++++++-- prec/psb_s_prec_mod.f90 | 10 ++++++---- prec/psb_z_bjacprec.f90 | 5 ++++- prec/psb_z_prec_mod.f90 | 9 +++++---- 9 files changed, 58 insertions(+), 23 deletions(-) diff --git a/base/modules/Makefile b/base/modules/Makefile index 9f7647af..9cf2c9a6 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -52,11 +52,11 @@ psb_error_mod.o: psb_const_mod.o psb_realloc_mod.o: psb_error_mod.o $(UTILS_MODS): $(BASIC_MODS) - psi_comm_buffers_mod.o: psb_const_mod.o psi_penv_mod.o: psi_comm_buffers_mod.o psi_bcast_mod.o psi_reduce_mod.o psi_p2p_mod.o: psi_penv_mod.o + psb_ip_reord_mod.o psi_serial_mod.o psb_sort_mod.o: $(BASIC_MODS) psb_base_mat_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 @@ -132,9 +132,25 @@ psb_z_comm_mod.o: psb_z_vect_mod.o psb_desc_type.o psb_mat_mod.o psb_base_mod.o: $(MODULES) +psi_penv_mod.o: psi_penv_mod.F90 $(BASIC_MODS) + $(F90) -c psi_penv_mod.F90 $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) + psb_penv_mod.o: psb_penv_mod.F90 $(COMMINT) $(BASIC_MODS) $(F90) -c psb_penv_mod.F90 $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) +psi_comm_buffers_mod.o: psi_comm_buffers_mod.F90 $(BASIC_MODS) + $(F90) -c psi_comm_buffers_mod.F90 $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) + +psi_p2p_mod.o: psi_p2p_mod.F90 $(BASIC_MODS) + $(F90) -c psi_p2p_mod.F90 $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) + +psi_bcast_mod.o: psi_bcast_mod.F90 $(BASIC_MODS) + $(F90) -c psi_bcast_mod.F90 $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) + +psi_reduce_mod.o: psi_reduce_mod.F90 $(BASIC_MODS) + $(F90) -c psi_reduce_mod.F90 $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) + + clean: /bin/rm -f $(MODULES) $(OBJS) $(MPFOBJS) *$(.mod) diff --git a/base/modules/psb_d_psblas_mod.f90 b/base/modules/psb_d_psblas_mod.f90 index 45290f16..97ff6e95 100644 --- a/base/modules/psb_d_psblas_mod.f90 +++ b/base/modules/psb_d_psblas_mod.f90 @@ -341,8 +341,8 @@ module psb_d_psblas_mod use psb_d_vect_mod, only : psb_d_vect_type use psb_mat_mod, only : psb_dspmat_type type(psb_dspmat_type), intent(inout) :: t - type(psb_d_vect_type), intent(inout) :: x - type(psb_d_vect_type), intent(inout) :: y + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y real(psb_dpk_), intent(in) :: alpha, beta type(psb_desc_type), intent(in) :: desc_a character, optional, intent(in) :: trans, scale diff --git a/prec/psb_c_bjacprec.f90 b/prec/psb_c_bjacprec.f90 index b2483e04..77634e91 100644 --- a/prec/psb_c_bjacprec.f90 +++ b/prec/psb_c_bjacprec.f90 @@ -286,8 +286,11 @@ contains & trans=trans_,scale='U',choice=psb_none_,work=aux) case('C') +!!$ call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,& +!!$ & trans=trans_,scale='L',diag=conjg(prec%dv%v%v),choice=psb_none_, work=aux) call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=conjg(prec%dv%v%v),choice=psb_none_, work=aux) + & trans=trans_,scale='L',choice=psb_none_, work=aux) + ww(1:n_row) = ww(1:n_row)*conjg(prec%dv%v%v(1:n_row)) if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) diff --git a/prec/psb_c_prec_mod.f90 b/prec/psb_c_prec_mod.f90 index 511b1203..b5e1f2f7 100644 --- a/prec/psb_c_prec_mod.f90 +++ b/prec/psb_c_prec_mod.f90 @@ -34,9 +34,9 @@ module psb_c_prec_mod use psb_c_prec_type interface psb_precbld - subroutine psb_cprecbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_cprecbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod, only : psb_desc_type, psb_cspmat_type,& - & psb_c_base_sparse_mat, psb_spk_ + & psb_c_base_sparse_mat, psb_spk_, psb_c_base_vect_type use psb_prec_type, only : psb_cprec_type implicit none type(psb_cspmat_type), intent(in), target :: a @@ -44,8 +44,9 @@ module psb_c_prec_mod type(psb_cprec_type), intent(inout) :: prec integer, intent(out) :: info character, intent(in),optional :: upd - character(len=*), intent(in), optional :: afmt - class(psb_c_base_sparse_mat), intent(in), optional :: mold + character(len=*), intent(in), optional :: afmt + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold end subroutine psb_cprecbld end interface diff --git a/prec/psb_d_prec_mod.f90 b/prec/psb_d_prec_mod.f90 index 5d57a796..66fc3398 100644 --- a/prec/psb_d_prec_mod.f90 +++ b/prec/psb_d_prec_mod.f90 @@ -34,9 +34,9 @@ module psb_d_prec_mod use psb_d_prec_type interface psb_precbld - subroutine psb_dprecbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_dprecbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod, only : psb_desc_type, psb_dspmat_type,& - & psb_d_base_sparse_mat, psb_dpk_ + & psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type use psb_prec_type, only : psb_dprec_type implicit none type(psb_dspmat_type), intent(in), target :: a @@ -44,8 +44,9 @@ module psb_d_prec_mod type(psb_dprec_type), intent(inout) :: prec integer, intent(out) :: info character, intent(in),optional :: upd - character(len=*), intent(in), optional :: afmt - class(psb_d_base_sparse_mat), intent(in), optional :: mold + character(len=*), intent(in), optional :: afmt + class(psb_d_base_sparse_mat), intent(in), optional :: amold + class(psb_d_base_vect_type), intent(in), optional :: vmold end subroutine psb_dprecbld end interface diff --git a/prec/psb_s_bjacprec.f90 b/prec/psb_s_bjacprec.f90 index 6d5d865d..d5cdd557 100644 --- a/prec/psb_s_bjacprec.f90 +++ b/prec/psb_s_bjacprec.f90 @@ -134,7 +134,7 @@ contains if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),wv,& & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) - + case('C') call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,wv,desc_data,info,& & trans=trans_,scale='L',diag=prec%dv,choice=psb_none_, work=aux) @@ -143,6 +143,7 @@ contains & trans=trans_,scale='U',choice=psb_none_,work=aux) end select + if (info /= psb_success_) then ch_err="psb_spsm" goto 9999 @@ -278,7 +279,14 @@ contains & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_, work=aux) - case('T','C') + case('T') + call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,ww,desc_data,info,& + & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux) + if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& + & beta,y,desc_data,info,& + & trans=trans_,scale='U',choice=psb_none_,work=aux) + + case('C') call psb_spsm(sone,prec%av(psb_u_pr_),x,szero,ww,desc_data,info,& & trans=trans_,scale='L',diag=prec%dv%v%v,choice=psb_none_, work=aux) if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& diff --git a/prec/psb_s_prec_mod.f90 b/prec/psb_s_prec_mod.f90 index e47696a8..3c94d2f9 100644 --- a/prec/psb_s_prec_mod.f90 +++ b/prec/psb_s_prec_mod.f90 @@ -34,9 +34,9 @@ module psb_s_prec_mod use psb_s_prec_type interface psb_precbld - subroutine psb_sprecbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_sprecbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod, only : psb_desc_type, psb_sspmat_type,& - & psb_s_base_sparse_mat, psb_spk_ + & psb_s_base_sparse_mat, psb_spk_, psb_s_base_vect_type use psb_prec_type, only : psb_sprec_type implicit none type(psb_sspmat_type), intent(in), target :: a @@ -44,8 +44,10 @@ module psb_s_prec_mod type(psb_sprec_type), intent(inout) :: prec integer, intent(out) :: info character, intent(in),optional :: upd - character(len=*), intent(in), optional :: afmt - class(psb_s_base_sparse_mat), intent(in), optional :: mold + character(len=*), intent(in), optional :: afmt + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + end subroutine psb_sprecbld end interface diff --git a/prec/psb_z_bjacprec.f90 b/prec/psb_z_bjacprec.f90 index ca33f939..bf2cc19a 100644 --- a/prec/psb_z_bjacprec.f90 +++ b/prec/psb_z_bjacprec.f90 @@ -276,8 +276,11 @@ contains & trans=trans_,scale='U',choice=psb_none_,work=aux) case('C') +!!$ call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,& +!!$ & trans=trans_,scale='L',diag=conjg(prec%dv%v%v),choice=psb_none_, work=aux) call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,& - & trans=trans_,scale='L',diag=conjg(prec%dv%v%v),choice=psb_none_, work=aux) + & trans=trans_,scale='L',choice=psb_none_, work=aux) + ww(1:n_row) = ww(1:n_row)*conjg(prec%dv%v%v(1:n_row)) if(info == psb_success_) call psb_spsm(alpha,prec%av(psb_l_pr_),ww,& & beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) diff --git a/prec/psb_z_prec_mod.f90 b/prec/psb_z_prec_mod.f90 index d1dcf2d0..c7828630 100644 --- a/prec/psb_z_prec_mod.f90 +++ b/prec/psb_z_prec_mod.f90 @@ -34,9 +34,9 @@ module psb_z_prec_mod use psb_z_prec_type interface psb_precbld - subroutine psb_zprecbld(a,desc_a,prec,info,upd,mold,afmt) + subroutine psb_zprecbld(a,desc_a,prec,info,upd,amold,afmt,vmold) use psb_base_mod, only : psb_desc_type, psb_zspmat_type,& - & psb_z_base_sparse_mat, psb_dpk_ + & psb_z_base_sparse_mat, psb_dpk_, psb_z_base_vect_type use psb_prec_type, only : psb_zprec_type implicit none type(psb_zspmat_type), intent(in), target :: a @@ -44,8 +44,9 @@ module psb_z_prec_mod type(psb_zprec_type), intent(inout) :: prec integer, intent(out) :: info character, intent(in),optional :: upd - character(len=*), intent(in), optional :: afmt - class(psb_z_base_sparse_mat), intent(in), optional :: mold + character(len=*), intent(in), optional :: afmt + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold end subroutine psb_zprecbld end interface