Added error check and defaults

amgprec/amg_base_prec_type.F90

@@ -136,6 +136,8 @@ module amg_base_prec_type
     integer(psb_lpk_)                  :: target_coarse_size
     ! 2. maximum number of levels.   Defaults to  20
     integer(psb_ipk_)                  :: max_levs    = 20_psb_ipk_
+  contains
+    procedure, pass(ag) :: default => i_ag_default
   end type amg_iaggr_data
 
   type, extends(amg_iaggr_data) :: amg_saggr_data
@@ -143,6 +145,8 @@ module amg_base_prec_type
     real(psb_spk_)                     :: min_cr_ratio   = 1.5_psb_spk_
     real(psb_spk_)                     :: op_complexity  = szero
     real(psb_spk_)                     :: avg_cr         = szero
+  contains
+    procedure, pass(ag) ::   default => s_ag_default
   end type amg_saggr_data
 
   type, extends(amg_iaggr_data) :: amg_daggr_data
@@ -150,6 +154,8 @@ module amg_base_prec_type
     real(psb_dpk_)                     :: min_cr_ratio   = 1.5_psb_dpk_
     real(psb_dpk_)                     :: op_complexity  = dzero
     real(psb_dpk_)                     :: avg_cr         = dzero
+  contains
+    procedure, pass(ag) ::   default => d_ag_default
   end type amg_daggr_data
 
 
@@ -1240,4 +1246,31 @@ contains
          & (parms1%aggr_thresh      == parms2%aggr_thresh     )
   end function amg_d_equal_aggregation
 
+  subroutine i_ag_default(ag)
+    class(amg_iaggr_data), intent(inout) :: ag
+
+    ag%min_coarse_size = -ione
+    ag%min_coarse_size_per_process = -ione
+    ag%max_levs    = 20_psb_ipk_
+  end subroutine i_ag_default
+
+  subroutine s_ag_default(ag)
+    class(amg_saggr_data), intent(inout) :: ag
+
+    call ag%amg_iaggr_data%default()
+    ag%min_cr_ratio   = 1.5_psb_spk_
+    ag%op_complexity  = szero
+    ag%avg_cr         = szero
+  end subroutine s_ag_default
+
+  subroutine d_ag_default(ag)
+    class(amg_daggr_data), intent(inout) :: ag
+
+    call ag%amg_iaggr_data%default()
+    ag%min_cr_ratio   = 1.5_psb_dpk_
+    ag%op_complexity  = dzero
+    ag%avg_cr         = dzero
+  end subroutine d_ag_default
+
+
 end module amg_base_prec_type

amgprec/impl/amg_cprecinit.F90

@@ -113,9 +113,17 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
 
   ! Local variables
   integer(psb_ipk_)            :: nlev_, ilev_
+  integer(psb_ipk_)            :: err_act
+  integer(psb_ipk_)            :: debug_level, debug_unit
   real(psb_spk_)               :: thr
   character(len=*), parameter  :: name='amg_precinit'
   info = psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
 
   if (allocated(prec%precv)) then
     call prec%free(info)
@@ -124,8 +132,7 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size             = -1
+  call prec%ag_data%default()
-  prec%ag_data%min_coarse_size_per_process = -1
 
   select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE')
@@ -213,6 +220,10 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
     nlev_ = prec%ag_data%max_levs
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
+    if (info /= psb_success_ ) then
+      call psb_errpush(info,name,a_err='Error from hierarchy init')
+      goto 9999
+    endif
 
     do ilev_ = 1, nlev_
       call prec%precv(ilev_)%default()
@@ -234,5 +245,10 @@ subroutine amg_cprecinit(ctxt,prec,ptype,info)
 
   end select
 
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
 
 end subroutine amg_cprecinit

amgprec/impl/amg_dprecinit.F90

@@ -116,9 +116,17 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
 
   ! Local variables
   integer(psb_ipk_)            :: nlev_, ilev_
+  integer(psb_ipk_)            :: err_act
+  integer(psb_ipk_)            :: debug_level, debug_unit
   real(psb_dpk_)               :: thr
   character(len=*), parameter  :: name='amg_precinit'
   info = psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
 
   if (allocated(prec%precv)) then
     call prec%free(info)
@@ -127,8 +135,7 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size             = -1
+  call prec%ag_data%default()
-  prec%ag_data%min_coarse_size_per_process = -1
 
   select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE')
@@ -216,6 +223,10 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
     nlev_ = prec%ag_data%max_levs
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
+    if (info /= psb_success_ ) then
+      call psb_errpush(info,name,a_err='Error from hierarchy init')
+      goto 9999
+    endif
 
     do ilev_ = 1, nlev_
       call prec%precv(ilev_)%default()
@@ -239,5 +250,10 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
 
   end select
 
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
 
 end subroutine amg_dprecinit

amgprec/impl/amg_sprecinit.F90

@@ -113,9 +113,17 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
 
   ! Local variables
   integer(psb_ipk_)            :: nlev_, ilev_
+  integer(psb_ipk_)            :: err_act
+  integer(psb_ipk_)            :: debug_level, debug_unit
   real(psb_spk_)               :: thr
   character(len=*), parameter  :: name='amg_precinit'
   info = psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
 
   if (allocated(prec%precv)) then
     call prec%free(info)
@@ -124,8 +132,7 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size             = -1
+  call prec%ag_data%default()
-  prec%ag_data%min_coarse_size_per_process = -1
 
   select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE')
@@ -213,6 +220,10 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
     nlev_ = prec%ag_data%max_levs
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
+    if (info /= psb_success_ ) then
+      call psb_errpush(info,name,a_err='Error from hierarchy init')
+      goto 9999
+    endif
 
     do ilev_ = 1, nlev_
       call prec%precv(ilev_)%default()
@@ -234,5 +245,10 @@ subroutine amg_sprecinit(ctxt,prec,ptype,info)
 
   end select
 
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
 
 end subroutine amg_sprecinit

amgprec/impl/amg_zprecinit.F90

@@ -116,9 +116,17 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
 
   ! Local variables
   integer(psb_ipk_)            :: nlev_, ilev_
+  integer(psb_ipk_)            :: err_act
+  integer(psb_ipk_)            :: debug_level, debug_unit
   real(psb_dpk_)               :: thr
   character(len=*), parameter  :: name='amg_precinit'
   info = psb_success_
+  call psb_erractionsave(err_act)
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
+  debug_unit  = psb_get_debug_unit()
+  debug_level = psb_get_debug_level()
 
   if (allocated(prec%precv)) then
     call prec%free(info)
@@ -127,8 +135,7 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
     endif
   endif
   prec%ctxt = ctxt
-  prec%ag_data%min_coarse_size             = -1
+  call prec%ag_data%default()
-  prec%ag_data%min_coarse_size_per_process = -1
 
   select case(psb_toupper(trim(ptype)))
   case ('NOPREC','NONE')
@@ -216,6 +223,10 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
     nlev_ = prec%ag_data%max_levs
     ilev_ = 1
     allocate(prec%precv(nlev_),stat=info)
+    if (info /= psb_success_ ) then
+      call psb_errpush(info,name,a_err='Error from hierarchy init')
+      goto 9999
+    endif
 
     do ilev_ = 1, nlev_
       call prec%precv(ilev_)%default()
@@ -239,5 +250,10 @@ subroutine amg_zprecinit(ctxt,prec,ptype,info)
 
   end select
 
+  call psb_erractionrestore(err_act)
+  return
+
+9999 call psb_error_handler(err_act)
+  return
 
 end subroutine amg_zprecinit