Fix use of errstatus.

mlprec/impl/aggregator/mld_c_dec_aggregator_mat_asb.f90

@@ -155,8 +155,10 @@ subroutine  mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
   integer(psb_ipk_)            :: debug_level, debug_unit
 
   name='mld_c_dec_aggregator_mat_asb'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90

@@ -93,8 +93,10 @@ subroutine  mld_c_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
   integer(psb_ipk_)           :: debug_level, debug_unit
 
   name='mld_c_dec_aggregator_tprol'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_c_map_to_tprol.f90

@@ -106,10 +106,12 @@ subroutine mld_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
   integer(psb_lpk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if(psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_map_to_tprol'
   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()
   !

mlprec/impl/aggregator/mld_c_soc1_map_bld.f90

@@ -96,10 +96,12 @@ subroutine mld_c_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_soc1_map_bld'
   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()
   !

mlprec/impl/aggregator/mld_c_soc2_map_bld.f90

@@ -96,10 +96,12 @@ subroutine mld_c_soc2_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_soc2_map_bld'
   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()
   !

mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90

@@ -98,8 +98,10 @@ subroutine  mld_c_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
   integer(psb_ipk_)           :: debug_level, debug_unit
 
   name='mld_c_symdec_aggregator_tprol'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_caggrmat_biz_asb.f90

@@ -112,9 +112,11 @@ subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
   real(psb_spk_)     :: anorm, omega, tmp, dg, theta
 
   name='mld_aggrmat_biz_asb'
-  if(psb_get_errstatus().ne.0) return 
   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()
 

mlprec/impl/aggregator/mld_caggrmat_minnrg_asb.f90

@@ -146,9 +146,11 @@ subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   complex(psb_spk_)            :: tmp, alpha, beta, ommx
 
   name='mld_aggrmat_minnrg'
-  if(psb_get_errstatus().ne.0) return 
   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()
 

mlprec/impl/aggregator/mld_caggrmat_nosmth_asb.f90

@@ -124,10 +124,11 @@ subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
        & naggr, nzt, naggrm1, naggrp1, i, k
 
   name='mld_aggrmat_nosmth_asb'
-  if(psb_get_errstatus().ne.0) return 
   info=psb_success_
   call psb_erractionsave(err_act)
-
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
 
   ictxt = desc_a%get_context()
   icomm = desc_a%get_mpic()

mlprec/impl/aggregator/mld_d_dec_aggregator_mat_asb.f90

@@ -155,8 +155,10 @@ subroutine  mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
   integer(psb_ipk_)            :: debug_level, debug_unit
 
   name='mld_d_dec_aggregator_mat_asb'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90

@@ -93,8 +93,10 @@ subroutine  mld_d_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
   integer(psb_ipk_)           :: debug_level, debug_unit
 
   name='mld_d_dec_aggregator_tprol'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_d_map_to_tprol.f90

@@ -106,10 +106,12 @@ subroutine mld_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
   integer(psb_lpk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if(psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_map_to_tprol'
   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()
   !

mlprec/impl/aggregator/mld_d_soc1_map_bld.f90

@@ -96,10 +96,12 @@ subroutine mld_d_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_soc1_map_bld'
   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()
   !

mlprec/impl/aggregator/mld_d_soc2_map_bld.f90

@@ -96,10 +96,12 @@ subroutine mld_d_soc2_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_soc2_map_bld'
   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()
   !

mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90

@@ -98,8 +98,10 @@ subroutine  mld_d_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
   integer(psb_ipk_)           :: debug_level, debug_unit
 
   name='mld_d_symdec_aggregator_tprol'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_daggrmat_biz_asb.f90

@@ -112,9 +112,11 @@ subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
   real(psb_dpk_)     :: anorm, omega, tmp, dg, theta
 
   name='mld_aggrmat_biz_asb'
-  if(psb_get_errstatus().ne.0) return 
   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()
 

mlprec/impl/aggregator/mld_daggrmat_minnrg_asb.f90

@@ -146,9 +146,11 @@ subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   real(psb_dpk_)            :: tmp, alpha, beta, ommx
 
   name='mld_aggrmat_minnrg'
-  if(psb_get_errstatus().ne.0) return 
   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()
 

mlprec/impl/aggregator/mld_daggrmat_nosmth_asb.f90

@@ -124,10 +124,11 @@ subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
        & naggr, nzt, naggrm1, naggrp1, i, k
 
   name='mld_aggrmat_nosmth_asb'
-  if(psb_get_errstatus().ne.0) return 
   info=psb_success_
   call psb_erractionsave(err_act)
-
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
 
   ictxt = desc_a%get_context()
   icomm = desc_a%get_mpic()

mlprec/impl/aggregator/mld_s_dec_aggregator_mat_asb.f90

@@ -155,8 +155,10 @@ subroutine  mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
   integer(psb_ipk_)            :: debug_level, debug_unit
 
   name='mld_s_dec_aggregator_mat_asb'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90

@@ -93,8 +93,10 @@ subroutine  mld_s_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
   integer(psb_ipk_)           :: debug_level, debug_unit
 
   name='mld_s_dec_aggregator_tprol'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_s_map_to_tprol.f90

@@ -106,10 +106,12 @@ subroutine mld_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
   integer(psb_lpk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if(psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_map_to_tprol'
   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()
   !

mlprec/impl/aggregator/mld_s_soc1_map_bld.f90

@@ -96,10 +96,12 @@ subroutine mld_s_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_soc1_map_bld'
   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()
   !

mlprec/impl/aggregator/mld_s_soc2_map_bld.f90

@@ -96,10 +96,12 @@ subroutine mld_s_soc2_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_soc2_map_bld'
   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()
   !

mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90

@@ -98,8 +98,10 @@ subroutine  mld_s_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
   integer(psb_ipk_)           :: debug_level, debug_unit
 
   name='mld_s_symdec_aggregator_tprol'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_saggrmat_biz_asb.f90

@@ -112,9 +112,11 @@ subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
   real(psb_spk_)     :: anorm, omega, tmp, dg, theta
 
   name='mld_aggrmat_biz_asb'
-  if(psb_get_errstatus().ne.0) return 
   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()
 

mlprec/impl/aggregator/mld_saggrmat_minnrg_asb.f90

@@ -146,9 +146,11 @@ subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   real(psb_spk_)            :: tmp, alpha, beta, ommx
 
   name='mld_aggrmat_minnrg'
-  if(psb_get_errstatus().ne.0) return 
   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()
 

mlprec/impl/aggregator/mld_saggrmat_nosmth_asb.f90

@@ -124,10 +124,11 @@ subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
        & naggr, nzt, naggrm1, naggrp1, i, k
 
   name='mld_aggrmat_nosmth_asb'
-  if(psb_get_errstatus().ne.0) return 
   info=psb_success_
   call psb_erractionsave(err_act)
-
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
 
   ictxt = desc_a%get_context()
   icomm = desc_a%get_mpic()

mlprec/impl/aggregator/mld_z_dec_aggregator_mat_asb.f90

@@ -155,8 +155,10 @@ subroutine  mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
   integer(psb_ipk_)            :: debug_level, debug_unit
 
   name='mld_z_dec_aggregator_mat_asb'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90

@@ -93,8 +93,10 @@ subroutine  mld_z_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
   integer(psb_ipk_)           :: debug_level, debug_unit
 
   name='mld_z_dec_aggregator_tprol'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_z_map_to_tprol.f90

@@ -106,10 +106,12 @@ subroutine mld_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
   integer(psb_lpk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if(psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_map_to_tprol'
   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()
   !

mlprec/impl/aggregator/mld_z_soc1_map_bld.f90

@@ -96,10 +96,12 @@ subroutine mld_z_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_soc1_map_bld'
   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()
   !

mlprec/impl/aggregator/mld_z_soc2_map_bld.f90

@@ -96,10 +96,12 @@ subroutine mld_z_soc2_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
   integer(psb_ipk_) :: nrow, ncol, n_ne
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus() /= 0) return 
   info=psb_success_
   name = 'mld_soc2_map_bld'
   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()
   !

mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90

@@ -98,8 +98,10 @@ subroutine  mld_z_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
   integer(psb_ipk_)           :: debug_level, debug_unit
 
   name='mld_z_symdec_aggregator_tprol'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_

mlprec/impl/aggregator/mld_zaggrmat_biz_asb.f90

@@ -112,9 +112,11 @@ subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
   real(psb_dpk_)     :: anorm, omega, tmp, dg, theta
 
   name='mld_aggrmat_biz_asb'
-  if(psb_get_errstatus().ne.0) return 
   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()
 

mlprec/impl/aggregator/mld_zaggrmat_minnrg_asb.f90

@@ -146,9 +146,11 @@ subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
   complex(psb_dpk_)            :: tmp, alpha, beta, ommx
 
   name='mld_aggrmat_minnrg'
-  if(psb_get_errstatus().ne.0) return 
   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()
 

mlprec/impl/aggregator/mld_zaggrmat_nosmth_asb.f90

@@ -124,10 +124,11 @@ subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
        & naggr, nzt, naggrm1, naggrp1, i, k
 
   name='mld_aggrmat_nosmth_asb'
-  if(psb_get_errstatus().ne.0) return 
   info=psb_success_
   call psb_erractionsave(err_act)
-
+  if (psb_errstatus_fatal()) then
+    info = psb_err_internal_error_; goto 9999
+  end if
 
   ictxt = desc_a%get_context()
   icomm = desc_a%get_mpic()

mlprec/impl/level/mld_c_base_onelev_build.f90

@@ -53,10 +53,12 @@ subroutine mld_c_base_onelev_build(lv,info,amold,vmold,imold)
   character(len=20)  :: name, ch_err
 
   name = 'mld_onelev_build'
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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 (.not.associated(lv%base_desc)) then

mlprec/impl/level/mld_c_base_onelev_mat_asb.f90

@@ -114,8 +114,10 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
   integer(psb_ipk_)            :: debug_level, debug_unit
 
   name='mld_c_onelev_mat_asb'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_
@@ -140,7 +142,7 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
   ! the mapping defined by mld_aggrmap_bld and applying the aggregation
   ! algorithm specified by lv%iprcparm(mld_aggr_prol_)
   !
-  !  call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
+  call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

mlprec/impl/level/mld_d_base_onelev_build.f90

@@ -53,10 +53,12 @@ subroutine mld_d_base_onelev_build(lv,info,amold,vmold,imold)
   character(len=20)  :: name, ch_err
 
   name = 'mld_onelev_build'
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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 (.not.associated(lv%base_desc)) then

mlprec/impl/level/mld_d_base_onelev_mat_asb.f90

@@ -114,8 +114,10 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
   integer(psb_ipk_)            :: debug_level, debug_unit
 
   name='mld_d_onelev_mat_asb'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_
@@ -140,7 +142,7 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
   ! the mapping defined by mld_aggrmap_bld and applying the aggregation
   ! algorithm specified by lv%iprcparm(mld_aggr_prol_)
   !
-  !  call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
+  call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

mlprec/impl/level/mld_s_base_onelev_build.f90

@@ -53,10 +53,12 @@ subroutine mld_s_base_onelev_build(lv,info,amold,vmold,imold)
   character(len=20)  :: name, ch_err
 
   name = 'mld_onelev_build'
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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 (.not.associated(lv%base_desc)) then

mlprec/impl/level/mld_s_base_onelev_mat_asb.f90

@@ -114,8 +114,10 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
   integer(psb_ipk_)            :: debug_level, debug_unit
 
   name='mld_s_onelev_mat_asb'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_
@@ -140,7 +142,7 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
   ! the mapping defined by mld_aggrmap_bld and applying the aggregation
   ! algorithm specified by lv%iprcparm(mld_aggr_prol_)
   !
-  !  call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
+  call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

mlprec/impl/level/mld_z_base_onelev_build.f90

@@ -53,10 +53,12 @@ subroutine mld_z_base_onelev_build(lv,info,amold,vmold,imold)
   character(len=20)  :: name, ch_err
 
   name = 'mld_onelev_build'
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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 (.not.associated(lv%base_desc)) then

mlprec/impl/level/mld_z_base_onelev_mat_asb.f90

@@ -114,8 +114,10 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
   integer(psb_ipk_)            :: debug_level, debug_unit
 
   name='mld_z_onelev_mat_asb'
-  if (psb_get_errstatus().ne.0) return 
   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()
   info  = psb_success_
@@ -140,7 +142,7 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
   ! the mapping defined by mld_aggrmap_bld and applying the aggregation
   ! algorithm specified by lv%iprcparm(mld_aggr_prol_)
   !
-  !  call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
+  call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
 
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

mlprec/impl/mld_c_extprol_bld.F90

@@ -108,10 +108,12 @@ subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
   character(len=20)  :: name, ch_err
   logical, parameter :: debug=.false.
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 
@@ -362,8 +364,10 @@ contains
     logical, parameter :: debug=.false.
 
     name='mld_c_extaggr_bld'
-    if (psb_get_errstatus().ne.0) return 
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     info = psb_success_
     ictxt = desc_a%get_context()
     call psb_info(ictxt,me,np)

mlprec/impl/mld_c_hierarchy_bld.f90

@@ -93,10 +93,12 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_c_smoothers_bld.f90

@@ -104,10 +104,12 @@ subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_cmlprec_bld.f90

@@ -102,10 +102,12 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_cprecaply.f90

@@ -415,7 +415,7 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
              & nswps,work_,wv,info)
       end if
     end associate
-    if (psb_get_errstatus() /=0)   info = psb_err_internal_error_
+    if (psb_errstatus_fatal())   info = psb_err_internal_error_
     if (info /= 0) then
       info = psb_err_from_subroutine_ai_
       call psb_errpush(info,name,a_err='Smoother application',&
@@ -561,7 +561,7 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
         if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info)
       end if
 
-      if (psb_get_errstatus() /=0)   info = psb_err_internal_error_
+      if (psb_errstatus_fatal())   info = psb_err_internal_error_
       if (info /=0) then
         info = psb_err_internal_error_
         call psb_errpush(info,name,a_err='Smoother application',&

mlprec/impl/mld_cprecbld.f90

@@ -83,10 +83,12 @@ subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
   integer(psb_ipk_)   :: debug_level, debug_unit
   character(len=20)   :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_d_extprol_bld.F90

@@ -108,10 +108,12 @@ subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
   character(len=20)  :: name, ch_err
   logical, parameter :: debug=.false.
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 
@@ -362,8 +364,10 @@ contains
     logical, parameter :: debug=.false.
 
     name='mld_d_extaggr_bld'
-    if (psb_get_errstatus().ne.0) return 
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     info = psb_success_
     ictxt = desc_a%get_context()
     call psb_info(ictxt,me,np)

mlprec/impl/mld_d_hierarchy_bld.f90

@@ -93,10 +93,12 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_d_smoothers_bld.f90

@@ -104,10 +104,12 @@ subroutine mld_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_dmlprec_bld.f90

@@ -102,10 +102,12 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_dprecaply.f90

@@ -415,7 +415,7 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
              & nswps,work_,wv,info)
       end if
     end associate
-    if (psb_get_errstatus() /=0)   info = psb_err_internal_error_
+    if (psb_errstatus_fatal())   info = psb_err_internal_error_
     if (info /= 0) then
       info = psb_err_from_subroutine_ai_
       call psb_errpush(info,name,a_err='Smoother application',&
@@ -561,7 +561,7 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
         if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info)
       end if
 
-      if (psb_get_errstatus() /=0)   info = psb_err_internal_error_
+      if (psb_errstatus_fatal())   info = psb_err_internal_error_
       if (info /=0) then
         info = psb_err_internal_error_
         call psb_errpush(info,name,a_err='Smoother application',&

mlprec/impl/mld_dprecbld.f90

@@ -83,10 +83,12 @@ subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
   integer(psb_ipk_)   :: debug_level, debug_unit
   character(len=20)   :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_s_extprol_bld.F90

@@ -108,10 +108,12 @@ subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
   character(len=20)  :: name, ch_err
   logical, parameter :: debug=.false.
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 
@@ -362,8 +364,10 @@ contains
     logical, parameter :: debug=.false.
 
     name='mld_s_extaggr_bld'
-    if (psb_get_errstatus().ne.0) return 
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     info = psb_success_
     ictxt = desc_a%get_context()
     call psb_info(ictxt,me,np)

mlprec/impl/mld_s_hierarchy_bld.f90

@@ -93,10 +93,12 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_s_smoothers_bld.f90

@@ -104,10 +104,12 @@ subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_smlprec_bld.f90

@@ -102,10 +102,12 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_sprecaply.f90

@@ -415,7 +415,7 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
              & nswps,work_,wv,info)
       end if
     end associate
-    if (psb_get_errstatus() /=0)   info = psb_err_internal_error_
+    if (psb_errstatus_fatal())   info = psb_err_internal_error_
     if (info /= 0) then
       info = psb_err_from_subroutine_ai_
       call psb_errpush(info,name,a_err='Smoother application',&
@@ -561,7 +561,7 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
         if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info)
       end if
 
-      if (psb_get_errstatus() /=0)   info = psb_err_internal_error_
+      if (psb_errstatus_fatal())   info = psb_err_internal_error_
       if (info /=0) then
         info = psb_err_internal_error_
         call psb_errpush(info,name,a_err='Smoother application',&

mlprec/impl/mld_sprecbld.f90

@@ -83,10 +83,12 @@ subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
   integer(psb_ipk_)   :: debug_level, debug_unit
   character(len=20)   :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_z_extprol_bld.F90

@@ -108,10 +108,12 @@ subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
   character(len=20)  :: name, ch_err
   logical, parameter :: debug=.false.
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 
@@ -362,8 +364,10 @@ contains
     logical, parameter :: debug=.false.
 
     name='mld_z_extaggr_bld'
-    if (psb_get_errstatus().ne.0) return 
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     info = psb_success_
     ictxt = desc_a%get_context()
     call psb_info(ictxt,me,np)

mlprec/impl/mld_z_hierarchy_bld.f90

@@ -93,10 +93,12 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_z_smoothers_bld.f90

@@ -104,10 +104,12 @@ subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_zmlprec_bld.f90

@@ -102,10 +102,12 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
   integer(psb_ipk_)  :: debug_level, debug_unit
   character(len=20)  :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/mld_zprecaply.f90

@@ -415,7 +415,7 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
              & nswps,work_,wv,info)
       end if
     end associate
-    if (psb_get_errstatus() /=0)   info = psb_err_internal_error_
+    if (psb_errstatus_fatal())   info = psb_err_internal_error_
     if (info /= 0) then
       info = psb_err_from_subroutine_ai_
       call psb_errpush(info,name,a_err='Smoother application',&
@@ -561,7 +561,7 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
         if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info)
       end if
 
-      if (psb_get_errstatus() /=0)   info = psb_err_internal_error_
+      if (psb_errstatus_fatal())   info = psb_err_internal_error_
       if (info /=0) then
         info = psb_err_internal_error_
         call psb_errpush(info,name,a_err='Smoother application',&

mlprec/impl/mld_zprecbld.f90

@@ -83,10 +83,12 @@ subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold,imold)
   integer(psb_ipk_)   :: debug_level, debug_unit
   character(len=20)   :: name, ch_err
 
-  if (psb_get_errstatus().ne.0) return 
   info=psb_success_
   err=0
   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()
 

mlprec/impl/solver/mld_cilu0_fact.f90

@@ -304,9 +304,11 @@ contains
     character(len=20)   :: name, ch_err
 
     name='mld_cilu0_factint'
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     ma = a%get_nrows()
     mb = b%get_nrows()
 
@@ -569,9 +571,11 @@ contains
     character(len=20), parameter  :: name='ilu_copyin'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     if (psb_toupper(upd) == 'F') then 
 
       select type(aa => a%a) 

mlprec/impl/solver/mld_ciluk_fact.f90

@@ -289,9 +289,11 @@ contains
     character(len=20), parameter :: name='mld_ciluk_factint'
     character(len=20)            :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
 
     select case(ialg)
@@ -503,9 +505,11 @@ contains
     character(len=20), parameter  :: name='iluk_copyin'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     call heap%init(info) 
 
     select type (aa=> a%a) 
@@ -829,9 +833,11 @@ contains
     character(len=20), parameter  :: name='mld_ciluk_factint'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     d(i) = czero
 

mlprec/impl/solver/mld_cilut_fact.f90

@@ -311,9 +311,11 @@ contains
     character(len=20), parameter :: name='mld_cilut_factint'
     character(len=20)            :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
 
     ma = a%get_nrows()
@@ -524,9 +526,11 @@ contains
     real(psb_spk_), external    :: dnrm2
     character(len=20), parameter  :: name='mld_cilut_factint'
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     call heap%init(info)
     if (info /= psb_success_) then
@@ -907,9 +911,11 @@ contains
     character(len=20)             :: ch_err
     logical                       :: fndmaxup
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     !
     ! Here we need to apply also the dropping rule base on the fill-in. 

mlprec/impl/solver/mld_dilu0_fact.f90

@@ -304,9 +304,11 @@ contains
     character(len=20)   :: name, ch_err
 
     name='mld_dilu0_factint'
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     ma = a%get_nrows()
     mb = b%get_nrows()
 
@@ -569,9 +571,11 @@ contains
     character(len=20), parameter  :: name='ilu_copyin'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     if (psb_toupper(upd) == 'F') then 
 
       select type(aa => a%a) 

mlprec/impl/solver/mld_diluk_fact.f90

@@ -289,9 +289,11 @@ contains
     character(len=20), parameter :: name='mld_diluk_factint'
     character(len=20)            :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
 
     select case(ialg)
@@ -503,9 +505,11 @@ contains
     character(len=20), parameter  :: name='iluk_copyin'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     call heap%init(info) 
 
     select type (aa=> a%a) 
@@ -829,9 +833,11 @@ contains
     character(len=20), parameter  :: name='mld_diluk_factint'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     d(i) = dzero
 

mlprec/impl/solver/mld_dilut_fact.f90

@@ -311,9 +311,11 @@ contains
     character(len=20), parameter :: name='mld_dilut_factint'
     character(len=20)            :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
 
     ma = a%get_nrows()
@@ -524,9 +526,11 @@ contains
     real(psb_dpk_), external    :: dnrm2
     character(len=20), parameter  :: name='mld_dilut_factint'
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     call heap%init(info)
     if (info /= psb_success_) then
@@ -907,9 +911,11 @@ contains
     character(len=20)             :: ch_err
     logical                       :: fndmaxup
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     !
     ! Here we need to apply also the dropping rule base on the fill-in. 

mlprec/impl/solver/mld_silu0_fact.f90

@@ -304,9 +304,11 @@ contains
     character(len=20)   :: name, ch_err
 
     name='mld_silu0_factint'
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     ma = a%get_nrows()
     mb = b%get_nrows()
 
@@ -569,9 +571,11 @@ contains
     character(len=20), parameter  :: name='ilu_copyin'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     if (psb_toupper(upd) == 'F') then 
 
       select type(aa => a%a) 

mlprec/impl/solver/mld_siluk_fact.f90

@@ -289,9 +289,11 @@ contains
     character(len=20), parameter :: name='mld_siluk_factint'
     character(len=20)            :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
 
     select case(ialg)
@@ -503,9 +505,11 @@ contains
     character(len=20), parameter  :: name='iluk_copyin'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     call heap%init(info) 
 
     select type (aa=> a%a) 
@@ -829,9 +833,11 @@ contains
     character(len=20), parameter  :: name='mld_siluk_factint'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     d(i) = szero
 

mlprec/impl/solver/mld_silut_fact.f90

@@ -311,9 +311,11 @@ contains
     character(len=20), parameter :: name='mld_silut_factint'
     character(len=20)            :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
 
     ma = a%get_nrows()
@@ -524,9 +526,11 @@ contains
     real(psb_spk_), external    :: dnrm2
     character(len=20), parameter  :: name='mld_silut_factint'
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     call heap%init(info)
     if (info /= psb_success_) then
@@ -907,9 +911,11 @@ contains
     character(len=20)             :: ch_err
     logical                       :: fndmaxup
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     !
     ! Here we need to apply also the dropping rule base on the fill-in. 

mlprec/impl/solver/mld_zilu0_fact.f90

@@ -304,9 +304,11 @@ contains
     character(len=20)   :: name, ch_err
 
     name='mld_zilu0_factint'
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     ma = a%get_nrows()
     mb = b%get_nrows()
 
@@ -569,9 +571,11 @@ contains
     character(len=20), parameter  :: name='ilu_copyin'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     if (psb_toupper(upd) == 'F') then 
 
       select type(aa => a%a) 

mlprec/impl/solver/mld_ziluk_fact.f90

@@ -289,9 +289,11 @@ contains
     character(len=20), parameter :: name='mld_ziluk_factint'
     character(len=20)            :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
 
     select case(ialg)
@@ -503,9 +505,11 @@ contains
     character(len=20), parameter  :: name='iluk_copyin'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     call heap%init(info) 
 
     select type (aa=> a%a) 
@@ -829,9 +833,11 @@ contains
     character(len=20), parameter  :: name='mld_ziluk_factint'
     character(len=20)             :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     d(i) = zzero
 

mlprec/impl/solver/mld_zilut_fact.f90

@@ -311,9 +311,11 @@ contains
     character(len=20), parameter :: name='mld_zilut_factint'
     character(len=20)            :: ch_err
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
 
     ma = a%get_nrows()
@@ -524,9 +526,11 @@ contains
     real(psb_dpk_), external    :: dnrm2
     character(len=20), parameter  :: name='mld_zilut_factint'
 
-    if (psb_get_errstatus() /= 0) return 
     info = psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     call heap%init(info)
     if (info /= psb_success_) then
@@ -907,9 +911,11 @@ contains
     character(len=20)             :: ch_err
     logical                       :: fndmaxup
 
-    if (psb_get_errstatus() /= 0) return 
     info=psb_success_
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     !
     ! Here we need to apply also the dropping rule base on the fill-in. 

mlprec/mld_c_prec_type.f90

@@ -534,10 +534,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_cprecfree'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     
     me=-1
     
@@ -560,10 +562,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_cprecfree'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     
     me=-1
     call prec%free_wrk(info)
@@ -848,10 +852,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i,j,level,nlev, nc2l
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_c_allocate_wrk'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     nlev   = size(prec%precv)  
     level = 1
     do level = 1, nlev
@@ -887,10 +893,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i,j,level, nlev, nc2l
     character(len=20)   :: name
 
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_c_free_wrk'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     nlev   = size(prec%precv)  
     do level = 1, nlev

mlprec/mld_d_prec_type.f90

@@ -534,10 +534,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_dprecfree'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     
     me=-1
     
@@ -560,10 +562,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_dprecfree'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     
     me=-1
     call prec%free_wrk(info)
@@ -848,10 +852,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i,j,level,nlev, nc2l
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_d_allocate_wrk'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     nlev   = size(prec%precv)  
     level = 1
     do level = 1, nlev
@@ -887,10 +893,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i,j,level, nlev, nc2l
     character(len=20)   :: name
 
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_d_free_wrk'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     nlev   = size(prec%precv)  
     do level = 1, nlev

mlprec/mld_s_prec_type.f90

@@ -534,10 +534,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_sprecfree'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     
     me=-1
     
@@ -560,10 +562,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_sprecfree'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     
     me=-1
     call prec%free_wrk(info)
@@ -848,10 +852,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i,j,level,nlev, nc2l
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_s_allocate_wrk'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     nlev   = size(prec%precv)  
     level = 1
     do level = 1, nlev
@@ -887,10 +893,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i,j,level, nlev, nc2l
     character(len=20)   :: name
 
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_s_free_wrk'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     nlev   = size(prec%precv)  
     do level = 1, nlev

mlprec/mld_z_prec_type.f90

@@ -534,10 +534,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_zprecfree'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     
     me=-1
     
@@ -560,10 +562,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_zprecfree'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     
     me=-1
     call prec%free_wrk(info)
@@ -848,10 +852,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i,j,level,nlev, nc2l
     character(len=20)   :: name
     
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_z_allocate_wrk'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
     nlev   = size(prec%precv)  
     level = 1
     do level = 1, nlev
@@ -887,10 +893,12 @@ contains
     integer(psb_ipk_)   :: me,err_act,i,j,level, nlev, nc2l
     character(len=20)   :: name
 
-    if(psb_get_errstatus().ne.0) return 
     info=psb_success_
     name = 'mld_z_free_wrk'
     call psb_erractionsave(err_act)
+    if (psb_errstatus_fatal()) then
+      info = psb_err_internal_error_; goto 9999
+    end if
 
     nlev   = size(prec%precv)  
     do level = 1, nlev