From 3f7a1d5b3856709c042d9e8e86d824e2ddc238e5 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 31 Oct 2016 14:59:00 +0000 Subject: [PATCH] mld2p4; mlprec/impl/mld_c_hierarchy_bld.f90 mlprec/impl/mld_cprecbld.f90 mlprec/impl/mld_d_hierarchy_bld.f90 mlprec/impl/mld_dprecbld.f90 mlprec/impl/mld_s_hierarchy_bld.f90 mlprec/impl/mld_sprecbld.f90 mlprec/impl/mld_z_hierarchy_bld.f90 mlprec/impl/mld_zprecbld.f90 mlprec/mld_c_prec_type.f90 mlprec/mld_d_prec_type.f90 mlprec/mld_s_prec_type.f90 mlprec/mld_z_prec_type.f90 Fix operator complexity computation. --- mlprec/impl/mld_c_hierarchy_bld.f90 | 2 ++ mlprec/impl/mld_cprecbld.f90 | 2 -- mlprec/impl/mld_d_hierarchy_bld.f90 | 2 ++ mlprec/impl/mld_dprecbld.f90 | 2 -- mlprec/impl/mld_s_hierarchy_bld.f90 | 2 ++ mlprec/impl/mld_sprecbld.f90 | 2 -- mlprec/impl/mld_z_hierarchy_bld.f90 | 2 ++ mlprec/impl/mld_zprecbld.f90 | 2 -- mlprec/mld_c_prec_type.f90 | 14 ++++++++------ mlprec/mld_d_prec_type.f90 | 8 +++++--- mlprec/mld_s_prec_type.f90 | 14 ++++++++------ mlprec/mld_z_prec_type.f90 | 8 +++++--- 12 files changed, 34 insertions(+), 26 deletions(-) diff --git a/mlprec/impl/mld_c_hierarchy_bld.f90 b/mlprec/impl/mld_c_hierarchy_bld.f90 index 2870d33b..532454fc 100644 --- a/mlprec/impl/mld_c_hierarchy_bld.f90 +++ b/mlprec/impl/mld_c_hierarchy_bld.f90 @@ -403,6 +403,8 @@ subroutine mld_c_hierarchy_bld(a,desc_a,p,info) iszv = size(p%precv) + call p%cmp_complexity() + if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Exiting with',iszv,' levels' diff --git a/mlprec/impl/mld_cprecbld.f90 b/mlprec/impl/mld_cprecbld.f90 index 708036c0..e6824b83 100644 --- a/mlprec/impl/mld_cprecbld.f90 +++ b/mlprec/impl/mld_cprecbld.f90 @@ -199,8 +199,6 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold) endif end if - call p%cmp_complexity() - call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_d_hierarchy_bld.f90 b/mlprec/impl/mld_d_hierarchy_bld.f90 index 5afd73ba..7701c9a1 100644 --- a/mlprec/impl/mld_d_hierarchy_bld.f90 +++ b/mlprec/impl/mld_d_hierarchy_bld.f90 @@ -403,6 +403,8 @@ subroutine mld_d_hierarchy_bld(a,desc_a,p,info) iszv = size(p%precv) + call p%cmp_complexity() + if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Exiting with',iszv,' levels' diff --git a/mlprec/impl/mld_dprecbld.f90 b/mlprec/impl/mld_dprecbld.f90 index 65238515..980d3910 100644 --- a/mlprec/impl/mld_dprecbld.f90 +++ b/mlprec/impl/mld_dprecbld.f90 @@ -199,8 +199,6 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold) endif end if - call p%cmp_complexity() - call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_s_hierarchy_bld.f90 b/mlprec/impl/mld_s_hierarchy_bld.f90 index 1a30dfee..d703bbb4 100644 --- a/mlprec/impl/mld_s_hierarchy_bld.f90 +++ b/mlprec/impl/mld_s_hierarchy_bld.f90 @@ -403,6 +403,8 @@ subroutine mld_s_hierarchy_bld(a,desc_a,p,info) iszv = size(p%precv) + call p%cmp_complexity() + if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Exiting with',iszv,' levels' diff --git a/mlprec/impl/mld_sprecbld.f90 b/mlprec/impl/mld_sprecbld.f90 index 2a29c0d4..f2f004bc 100644 --- a/mlprec/impl/mld_sprecbld.f90 +++ b/mlprec/impl/mld_sprecbld.f90 @@ -199,8 +199,6 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold) endif end if - call p%cmp_complexity() - call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_z_hierarchy_bld.f90 b/mlprec/impl/mld_z_hierarchy_bld.f90 index d952bd91..2d8fda64 100644 --- a/mlprec/impl/mld_z_hierarchy_bld.f90 +++ b/mlprec/impl/mld_z_hierarchy_bld.f90 @@ -403,6 +403,8 @@ subroutine mld_z_hierarchy_bld(a,desc_a,p,info) iszv = size(p%precv) + call p%cmp_complexity() + if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Exiting with',iszv,' levels' diff --git a/mlprec/impl/mld_zprecbld.f90 b/mlprec/impl/mld_zprecbld.f90 index 6171f11c..37396e8d 100644 --- a/mlprec/impl/mld_zprecbld.f90 +++ b/mlprec/impl/mld_zprecbld.f90 @@ -199,8 +199,6 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold) endif end if - call p%cmp_complexity() - call psb_erractionrestore(err_act) return diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index 3b9fc0f9..1148e783 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -391,12 +391,12 @@ contains implicit none class(mld_cprec_type), intent(inout) :: prec - real(psb_spk_) :: num,den + real(psb_spk_) :: num, den, nmin integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: il - num = -done - den = done + num = -sone + den = sone ictxt = prec%ictxt if (allocated(prec%precv)) then il = 1 @@ -408,9 +408,11 @@ contains end do end if end if - call psb_min(ictxt,num) - if (num < szero) then - den = done + nmin = num + call psb_min(ictxt,nmin) + if (nmin < szero) then + num = szero + den = sone else call psb_sum(ictxt,num) call psb_sum(ictxt,den) diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index f843ea0b..00505e83 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -391,7 +391,7 @@ contains implicit none class(mld_dprec_type), intent(inout) :: prec - real(psb_dpk_) :: num,den + real(psb_dpk_) :: num, den, nmin integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: il @@ -408,8 +408,10 @@ contains end do end if end if - call psb_min(ictxt,num) - if (num < dzero) then + nmin = num + call psb_min(ictxt,nmin) + if (nmin < dzero) then + num = dzero den = done else call psb_sum(ictxt,num) diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 692ed165..692e2e9e 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -391,12 +391,12 @@ contains implicit none class(mld_sprec_type), intent(inout) :: prec - real(psb_spk_) :: num,den + real(psb_spk_) :: num, den, nmin integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: il - num = -done - den = done + num = -sone + den = sone ictxt = prec%ictxt if (allocated(prec%precv)) then il = 1 @@ -408,9 +408,11 @@ contains end do end if end if - call psb_min(ictxt,num) - if (num < szero) then - den = done + nmin = num + call psb_min(ictxt,nmin) + if (nmin < szero) then + num = szero + den = sone else call psb_sum(ictxt,num) call psb_sum(ictxt,den) diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 6afcc2bb..d73d0a9b 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -391,7 +391,7 @@ contains implicit none class(mld_zprec_type), intent(inout) :: prec - real(psb_dpk_) :: num,den + real(psb_dpk_) :: num, den, nmin integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: il @@ -408,8 +408,10 @@ contains end do end if end if - call psb_min(ictxt,num) - if (num < dzero) then + nmin = num + call psb_min(ictxt,nmin) + if (nmin < dzero) then + num = dzero den = done else call psb_sum(ictxt,num)