mld2p4-2

mlprec/impl/mld_c_bld_mlhier_aggsize.f90
 mlprec/impl/mld_cprecinit.F90
 mlprec/impl/mld_d_bld_mlhier_aggsize.f90
 mlprec/impl/mld_dprecinit.F90
 mlprec/impl/mld_s_bld_mlhier_aggsize.f90
 mlprec/impl/mld_sprecinit.F90
 mlprec/impl/mld_z_bld_mlhier_aggsize.f90
 mlprec/impl/mld_zprecinit.F90
 tests/fileread/mld_cf_sample.f90
 tests/fileread/mld_df_sample.f90
 tests/fileread/mld_sf_sample.f90
 tests/fileread/mld_zf_sample.f90

Use kind in initialization of threshold/scale.
Fix use of SCALE in mlhier_aggsize
Fix precset for thresh and scale in mld_Xf_sample.

mlprec/impl/mld_c_bld_mlhier_aggsize.f90

@@ -124,7 +124,8 @@ subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
     newnode%prev => current
     newsz        = newsz + 1
     newnode%item%parms             = medparms
-    newnode%item%parms%aggr_thresh = current%item%parms%aggr_thresh/2
+    newnode%item%parms%aggr_thresh = &
+         & (current%item%parms%aggr_thresh)*(current%item%parms%aggr_scale)
     call mld_coarse_bld(current%item%base_a, current%item%base_desc, &
          & newnode%item,info)
     if (info /= psb_success_) then 
@@ -166,21 +167,27 @@ subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
 
   end do list_build_loop
   !
-  ! At this point, we are at  the list tail,
-  ! and it needs to be rebuilt in case the parms were
-  ! different.
-  !
-  ! But the threshold has to be fixed before rebuliding
+  ! At this point, we are at  the list tail.
+  ! If the top aggregation parameters were different, then we need to rebuild;
+  ! the threshold has to be fixed before rebuliding, and the parms must be
+  ! copied anyway since they'll be used later for the smoother build.
+  ! 
   coarseparms%aggr_thresh = current%item%parms%aggr_thresh
-  current%item%parms      = coarseparms
-  call mld_coarse_bld(current%prev%item%base_a,&
-       & current%prev%item%base_desc, &
-       & current%item,info)
-  if (info /= psb_success_) then 
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='build next level'); goto 9999
+  
+  if (.not.mld_equal_aggregation(current%item%parms, coarseparms)) then
+    ! Need to rebuild.
+    current%item%parms      = coarseparms
+    call mld_coarse_bld(current%prev%item%base_a,&
+         & current%prev%item%base_desc, &
+         & current%item,info)
+    if (info /= psb_success_) then 
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='build next level'); goto 9999
+    end if
+  else
+    ! Need only copy the parms.
+    current%item%parms      = coarseparms
   end if
-
   !
   ! Ok, now allocate the output vector and fix items. 
   !

mlprec/impl/mld_cprecinit.F90

@@ -202,8 +202,8 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
     call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
     call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
 
-    thr   = 0.05
-    scale = 1.0
+    thr   = 0.05_psb_spk_
+    scale = 1.0_psb_spk_
     do ilev_=1,nlev_
       call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
       call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)

mlprec/impl/mld_d_bld_mlhier_aggsize.f90

@@ -124,7 +124,8 @@ subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
     newnode%prev => current
     newsz        = newsz + 1
     newnode%item%parms             = medparms
-    newnode%item%parms%aggr_thresh = current%item%parms%aggr_thresh/2
+    newnode%item%parms%aggr_thresh = &
+         & (current%item%parms%aggr_thresh)*(current%item%parms%aggr_scale)
     call mld_coarse_bld(current%item%base_a, current%item%base_desc, &
          & newnode%item,info)
     if (info /= psb_success_) then 
@@ -166,21 +167,27 @@ subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
 
   end do list_build_loop
   !
-  ! At this point, we are at  the list tail,
-  ! and it needs to be rebuilt in case the parms were
-  ! different.
-  !
-  ! But the threshold has to be fixed before rebuliding
+  ! At this point, we are at  the list tail.
+  ! If the top aggregation parameters were different, then we need to rebuild;
+  ! the threshold has to be fixed before rebuliding, and the parms must be
+  ! copied anyway since they'll be used later for the smoother build.
+  ! 
   coarseparms%aggr_thresh = current%item%parms%aggr_thresh
-  current%item%parms      = coarseparms
-  call mld_coarse_bld(current%prev%item%base_a,&
-       & current%prev%item%base_desc, &
-       & current%item,info)
-  if (info /= psb_success_) then 
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='build next level'); goto 9999
+  
+  if (.not.mld_equal_aggregation(current%item%parms, coarseparms)) then
+    ! Need to rebuild.
+    current%item%parms      = coarseparms
+    call mld_coarse_bld(current%prev%item%base_a,&
+         & current%prev%item%base_desc, &
+         & current%item,info)
+    if (info /= psb_success_) then 
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='build next level'); goto 9999
+    end if
+  else
+    ! Need only copy the parms.
+    current%item%parms      = coarseparms
   end if
-
   !
   ! Ok, now allocate the output vector and fix items. 
   !

mlprec/impl/mld_dprecinit.F90

@@ -207,8 +207,8 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
     call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
     call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
 
-    thr   = 0.05
-    scale = 1.0
+    thr   = 0.05_psb_dpk_
+    scale = 1.0_psb_dpk_
     do ilev_=1,nlev_
       call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
       call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)

mlprec/impl/mld_s_bld_mlhier_aggsize.f90

@@ -124,7 +124,8 @@ subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
     newnode%prev => current
     newsz        = newsz + 1
     newnode%item%parms             = medparms
-    newnode%item%parms%aggr_thresh = current%item%parms%aggr_thresh/2
+    newnode%item%parms%aggr_thresh = &
+         & (current%item%parms%aggr_thresh)*(current%item%parms%aggr_scale)
     call mld_coarse_bld(current%item%base_a, current%item%base_desc, &
          & newnode%item,info)
     if (info /= psb_success_) then 
@@ -166,21 +167,27 @@ subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
 
   end do list_build_loop
   !
-  ! At this point, we are at  the list tail,
-  ! and it needs to be rebuilt in case the parms were
-  ! different.
-  !
-  ! But the threshold has to be fixed before rebuliding
+  ! At this point, we are at  the list tail.
+  ! If the top aggregation parameters were different, then we need to rebuild;
+  ! the threshold has to be fixed before rebuliding, and the parms must be
+  ! copied anyway since they'll be used later for the smoother build.
+  ! 
   coarseparms%aggr_thresh = current%item%parms%aggr_thresh
-  current%item%parms      = coarseparms
-  call mld_coarse_bld(current%prev%item%base_a,&
-       & current%prev%item%base_desc, &
-       & current%item,info)
-  if (info /= psb_success_) then 
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='build next level'); goto 9999
+  
+  if (.not.mld_equal_aggregation(current%item%parms, coarseparms)) then
+    ! Need to rebuild.
+    current%item%parms      = coarseparms
+    call mld_coarse_bld(current%prev%item%base_a,&
+         & current%prev%item%base_desc, &
+         & current%item,info)
+    if (info /= psb_success_) then 
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='build next level'); goto 9999
+    end if
+  else
+    ! Need only copy the parms.
+    current%item%parms      = coarseparms
   end if
-
   !
   ! Ok, now allocate the output vector and fix items. 
   !

mlprec/impl/mld_sprecinit.F90

@@ -202,8 +202,8 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
     call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
     call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
 
-    thr   = 0.05
-    scale = 1.0
+    thr   = 0.05_psb_spk_
+    scale = 1.0_psb_spk_
     do ilev_=1,nlev_
       call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
       call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)

mlprec/impl/mld_z_bld_mlhier_aggsize.f90

@@ -124,7 +124,8 @@ subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
     newnode%prev => current
     newsz        = newsz + 1
     newnode%item%parms             = medparms
-    newnode%item%parms%aggr_thresh = current%item%parms%aggr_thresh/2
+    newnode%item%parms%aggr_thresh = &
+         & (current%item%parms%aggr_thresh)*(current%item%parms%aggr_scale)
     call mld_coarse_bld(current%item%base_a, current%item%base_desc, &
          & newnode%item,info)
     if (info /= psb_success_) then 
@@ -166,21 +167,27 @@ subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
 
   end do list_build_loop
   !
-  ! At this point, we are at  the list tail,
-  ! and it needs to be rebuilt in case the parms were
-  ! different.
-  !
-  ! But the threshold has to be fixed before rebuliding
+  ! At this point, we are at  the list tail.
+  ! If the top aggregation parameters were different, then we need to rebuild;
+  ! the threshold has to be fixed before rebuliding, and the parms must be
+  ! copied anyway since they'll be used later for the smoother build.
+  ! 
   coarseparms%aggr_thresh = current%item%parms%aggr_thresh
-  current%item%parms      = coarseparms
-  call mld_coarse_bld(current%prev%item%base_a,&
-       & current%prev%item%base_desc, &
-       & current%item,info)
-  if (info /= psb_success_) then 
-    info = psb_err_internal_error_
-    call psb_errpush(info,name,a_err='build next level'); goto 9999
+  
+  if (.not.mld_equal_aggregation(current%item%parms, coarseparms)) then
+    ! Need to rebuild.
+    current%item%parms      = coarseparms
+    call mld_coarse_bld(current%prev%item%base_a,&
+         & current%prev%item%base_desc, &
+         & current%item,info)
+    if (info /= psb_success_) then 
+      info = psb_err_internal_error_
+      call psb_errpush(info,name,a_err='build next level'); goto 9999
+    end if
+  else
+    ! Need only copy the parms.
+    current%item%parms      = coarseparms
   end if
-
   !
   ! Ok, now allocate the output vector and fix items. 
   !

mlprec/impl/mld_zprecinit.F90

@@ -207,8 +207,8 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
     call p%precv(ilev_)%set(mld_sub_prol_,psb_none_,info)
     call p%precv(ilev_)%set(mld_sub_ovr_,izero,info)
 
-    thr   = 0.05
-    scale = 1.0
+    thr   = 0.05_psb_dpk_
+    scale = 1.0_psb_dpk_
     do ilev_=1,nlev_
       call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
       call p%precv(ilev_)%set(mld_aggr_scale_,scale,info)

tests/fileread/mld_cf_sample.f90

@@ -260,6 +260,8 @@ program mld_cf_sample
     call mld_precset(prec,'aggr_kind',       prec_choice%aggrkind,info)
     call mld_precset(prec,'aggr_alg',        prec_choice%aggr_alg,info)
     call mld_precset(prec,'aggr_ord',        prec_choice%aggr_ord,info)
+    call mld_precset(prec,'aggr_scale',      prec_choice%ascale,  info)
+    call mld_precset(prec,'aggr_thresh',     prec_choice%athres,  info)
     call psb_barrier(ictxt)
     t1 = psb_wtime()
     call mld_hierarchy_bld(a,desc_a,prec,info)
@@ -279,8 +281,6 @@ program mld_cf_sample
     call mld_precset(prec,'sub_iluthrs',     prec_choice%thr,     info)
     call mld_precset(prec,'ml_type',         prec_choice%mltype,  info)
     call mld_precset(prec,'smoother_pos',    prec_choice%smthpos, info)
-    call mld_precset(prec,'aggr_scale',      prec_choice%ascale,  info)
-    call mld_precset(prec,'aggr_thresh',     prec_choice%athres,  info)
     call mld_precset(prec,'coarse_solve',    prec_choice%csolve,  info)
     call mld_precset(prec,'coarse_subsolve', prec_choice%csbsolve,info)
     call mld_precset(prec,'coarse_mat',      prec_choice%cmat,    info)

tests/fileread/mld_df_sample.f90

@@ -260,6 +260,8 @@ program mld_df_sample
     call mld_precset(prec,'aggr_kind',       prec_choice%aggrkind,info)
     call mld_precset(prec,'aggr_alg',        prec_choice%aggr_alg,info)
     call mld_precset(prec,'aggr_ord',        prec_choice%aggr_ord,info)
+    call mld_precset(prec,'aggr_scale',      prec_choice%ascale,  info)
+    call mld_precset(prec,'aggr_thresh',     prec_choice%athres,  info)
     call psb_barrier(ictxt)
     t1 = psb_wtime()
     call mld_hierarchy_bld(a,desc_a,prec,info)
@@ -279,8 +281,6 @@ program mld_df_sample
     call mld_precset(prec,'sub_iluthrs',     prec_choice%thr,     info)
     call mld_precset(prec,'ml_type',         prec_choice%mltype,  info)
     call mld_precset(prec,'smoother_pos',    prec_choice%smthpos, info)
-    call mld_precset(prec,'aggr_scale',      prec_choice%ascale,  info)
-    call mld_precset(prec,'aggr_thresh',     prec_choice%athres,  info)
     call mld_precset(prec,'coarse_solve',    prec_choice%csolve,  info)
     call mld_precset(prec,'coarse_subsolve', prec_choice%csbsolve,info)
     call mld_precset(prec,'coarse_mat',      prec_choice%cmat,    info)

tests/fileread/mld_sf_sample.f90

@@ -260,6 +260,8 @@ program mld_sf_sample
     call mld_precset(prec,'aggr_kind',       prec_choice%aggrkind,info)
     call mld_precset(prec,'aggr_alg',        prec_choice%aggr_alg,info)
     call mld_precset(prec,'aggr_ord',        prec_choice%aggr_ord,info)
+    call mld_precset(prec,'aggr_scale',      prec_choice%ascale,  info)
+    call mld_precset(prec,'aggr_thresh',     prec_choice%athres,  info)
     call psb_barrier(ictxt)
     t1 = psb_wtime()
     call mld_hierarchy_bld(a,desc_a,prec,info)
@@ -279,8 +281,6 @@ program mld_sf_sample
     call mld_precset(prec,'sub_iluthrs',     prec_choice%thr,     info)
     call mld_precset(prec,'ml_type',         prec_choice%mltype,  info)
     call mld_precset(prec,'smoother_pos',    prec_choice%smthpos, info)
-    call mld_precset(prec,'aggr_scale',      prec_choice%ascale,  info)
-    call mld_precset(prec,'aggr_thresh',     prec_choice%athres,  info)
     call mld_precset(prec,'coarse_solve',    prec_choice%csolve,  info)
     call mld_precset(prec,'coarse_subsolve', prec_choice%csbsolve,info)
     call mld_precset(prec,'coarse_mat',      prec_choice%cmat,    info)

tests/fileread/mld_zf_sample.f90

@@ -260,6 +260,8 @@ program mld_zf_sample
     call mld_precset(prec,'aggr_kind',       prec_choice%aggrkind,info)
     call mld_precset(prec,'aggr_alg',        prec_choice%aggr_alg,info)
     call mld_precset(prec,'aggr_ord',        prec_choice%aggr_ord,info)
+    call mld_precset(prec,'aggr_scale',      prec_choice%ascale,  info)
+    call mld_precset(prec,'aggr_thresh',     prec_choice%athres,  info)
     call psb_barrier(ictxt)
     t1 = psb_wtime()
     call mld_hierarchy_bld(a,desc_a,prec,info)
@@ -279,8 +281,6 @@ program mld_zf_sample
     call mld_precset(prec,'sub_iluthrs',     prec_choice%thr,     info)
     call mld_precset(prec,'ml_type',         prec_choice%mltype,  info)
     call mld_precset(prec,'smoother_pos',    prec_choice%smthpos, info)
-    call mld_precset(prec,'aggr_scale',      prec_choice%ascale,  info)
-    call mld_precset(prec,'aggr_thresh',     prec_choice%athres,  info)
     call mld_precset(prec,'coarse_solve',    prec_choice%csolve,  info)
     call mld_precset(prec,'coarse_subsolve', prec_choice%csbsolve,info)
     call mld_precset(prec,'coarse_mat',      prec_choice%cmat,    info)