From dcaf505b772e371dec00eb1e30c4325d53babfa2 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 16 May 2010 11:28:02 +0000 Subject: [PATCH] psblas3: New symbolic name for error 700 --- base/modules/psb_const_mod.F90 | 1 + base/modules/psb_error_mod.F90 | 211 +++++++++++++++++---------------- 2 files changed, 108 insertions(+), 104 deletions(-) diff --git a/base/modules/psb_const_mod.F90 b/base/modules/psb_const_mod.F90 index df39e578..b0552c0d 100644 --- a/base/modules/psb_const_mod.F90 +++ b/base/modules/psb_const_mod.F90 @@ -153,6 +153,7 @@ module psb_const_mod integer, parameter, public :: psb_err_arg_m_required_=582 integer, parameter, public :: psb_err_many_optional_arg_=583 integer, parameter, public :: psb_err_spmat_invalid_state_=600 + integer, parameter, public :: psb_err_missing_override_method_=700 integer, parameter, public :: psb_err_invalid_cd_state_=1122 integer, parameter, public :: psb_err_invalid_a_and_cd_state_=1123 integer, parameter, public :: psb_err_blacs_error_=2010 diff --git a/base/modules/psb_error_mod.F90 b/base/modules/psb_error_mod.F90 index 0e952eaa..e44fb73a 100644 --- a/base/modules/psb_error_mod.F90 +++ b/base/modules/psb_error_mod.F90 @@ -100,6 +100,7 @@ module psb_error_mod integer, save :: verbosity_level=1 ! the verbosity level (maybe not here) integer, save :: err_action=psb_act_abort_ integer, save :: debug_level=0, debug_unit=0, serial_debug_level=0 + integer, save :: error_unit=0 contains @@ -276,202 +277,204 @@ contains integer, optional :: me if(present(me)) then - write(0,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')me,err_c,r_name + write(error_unit,'("Process: ",i0,". PSBLAS Error (",i0,") in subroutine: ",a20)')me,err_c,r_name else - write(0,'("PSBLAS Error (",i0,") in subroutine: ",a20)')err_c,r_name + write(error_unit,'("PSBLAS Error (",i0,") in subroutine: ",a20)')err_c,r_name end if select case (err_c) case(:psb_success_) - write (0,'("error on calling sperror. err_c must be greater than 0")') + write (error_unit,'("error on calling sperror. err_c must be greater than 0")') case(psb_err_pivot_too_small_) - write (0,'("pivot too small: ",i0,1x,a)')i_e_d(1),a_e_d + write (error_unit,'("pivot too small: ",i0,1x,a)')i_e_d(1),a_e_d case(psb_err_invalid_ovr_num_) - write (0,'("Invalid number of ovr:",i0)')i_e_d(1) + write (error_unit,'("Invalid number of ovr:",i0)')i_e_d(1) case(psb_err_invalid_input_) - write (0,'("Invalid input")') + write (error_unit,'("Invalid input")') case(psb_err_iarg_neg_) - write (0,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1) - write (0,'("current value is ",i0)')i_e_d(2) + write (error_unit,'("input argument n. ",i0," cannot be less than 0")')i_e_d(1) + write (error_unit,'("current value is ",i0)')i_e_d(2) case(psb_err_iarg_pos_) - write (0,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1) - write (0,'("current value is ",i0)')i_e_d(2) + write (error_unit,'("input argument n. ",i0," cannot be greater than 0")')i_e_d(1) + write (error_unit,'("current value is ",i0)')i_e_d(2) case(psb_err_input_value_invalid_i_) - write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1) - write (0,'("current value is ",i0)')i_e_d(2) + write (error_unit,'("input argument n. ",i0," has an invalid value")')i_e_d(1) + write (error_unit,'("current value is ",i0)')i_e_d(2) case(psb_err_input_asize_invalid_i_) - write (0,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1) - write (0,'("Current value is ",i0)')i_e_d(2) + write (error_unit,'("Size of input array argument n. ",i0," is invalid.")')i_e_d(1) + write (error_unit,'("Current value is ",i0)')i_e_d(2) case(psb_err_iarg_invalid_i_) - write (0,'("input argument n. ",i0," has an invalid value")')i_e_d(1) - write (0,'("current value is ",a)')a_e_d(2:2) + write (error_unit,'("input argument n. ",i0," has an invalid value")')i_e_d(1) + write (error_unit,'("current value is ",a)')a_e_d(2:2) case(psb_err_iarg_not_gtia_ii_) - write (0,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') i_e_d(1), i_e_d(3) - write (0,'("current values are ",i0," < ",i0)') i_e_d(2),i_e_d(5) + write (error_unit,'("input argument n. ",i0," must be equal or greater than input argument n. ",i0)') i_e_d(1), i_e_d(3) + write (error_unit,'("current values are ",i0," < ",i0)') i_e_d(2),i_e_d(5) case(psb_err_iarg_not_gteia_ii_) - write (0,'("input argument n. ",i0," must be greater than or equal to ",i0)')i_e_d(1),i_e_d(2) - write (0,'("current value is ",i0," < ",i0)')i_e_d(3), i_e_d(2) + write (error_unit,'("input argument n. ",i0," must be greater than or equal to ",i0)')i_e_d(1),i_e_d(2) + write (error_unit,'("current value is ",i0," < ",i0)')i_e_d(3), i_e_d(2) case(psb_err_iarg_invalid_value_) - write (0,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')i_e_d(1:2) - write (0,'("current value is ",a)')a_e_d + write (error_unit,'("input argument n. ",i0," in entry # ",i0," has an invalid value")')i_e_d(1:2) + write (error_unit,'("current value is ",a)')a_e_d case(psb_err_asb_nrc_error_) - write (0,'("Impossible error in ASB: nrow>ncol,")') - write (0,'("Actual values are ",i0," > ",i0)')i_e_d(1:2) + write (error_unit,'("Impossible error in ASB: nrow>ncol,")') + write (error_unit,'("Actual values are ",i0," > ",i0)')i_e_d(1:2) ! ... csr format error ... case(psb_err_iarg2_neg_) - write (0,'("input argument ia2(1) is less than 0")') - write (0,'("current value is ",i0)')i_e_d(1) + write (error_unit,'("input argument ia2(1) is less than 0")') + write (error_unit,'("current value is ",i0)')i_e_d(1) ! ... csr format error ... case(psb_err_ia2_not_increasing_) - write (0,'("indices in ia2 array are not in increasing order")') + write (error_unit,'("indices in ia2 array are not in increasing order")') case(psb_err_ia1_not_increasing_) - write (0,'("indices in ia1 array are not in increasing order")') + write (error_unit,'("indices in ia1 array are not in increasing order")') ! ... csr format error ... case(psb_err_ia1_badindices_) - write (0,'("indices in ia1 array are not within problem dimension")') - write (0,'("problem dimension is ",i0)')i_e_d(1) + write (error_unit,'("indices in ia1 array are not within problem dimension")') + write (error_unit,'("problem dimension is ",i0)')i_e_d(1) case(psb_err_invalid_args_combination_) - write (0,'("invalid combination of input arguments")') + write (error_unit,'("invalid combination of input arguments")') case(psb_err_invalid_pid_arg_) - write (0,'("Invalid process identifier in input array argument n. ",i0,".")')i_e_d(1) - write (0,'("Current value is ",i0)')i_e_d(2) + write (error_unit,'("Invalid process identifier in input array argument n. ",i0,".")')i_e_d(1) + write (error_unit,'("Current value is ",i0)')i_e_d(2) case(psb_err_iarg_n_mbgtian_) - write (0,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2) - write (0,'("current values are ",i0," < ",i0)') i_e_d(3:4) + write (error_unit,'("input argument n. ",i0," must be greater than input argument n. ",i0)')i_e_d(1:2) + write (error_unit,'("current values are ",i0," < ",i0)') i_e_d(3:4) ! ... coo format error ... case(psb_err_duplicate_coo) - write (0,'("there are duplicated elements in coo format")') - write (0,'("and you have chosen psb_dupl_err_ ")') + write (error_unit,'("there are duplicated elements in coo format")') + write (error_unit,'("and you have chosen psb_dupl_err_ ")') case(psb_err_invalid_input_format_) - write (0,'("Invalid input format ",a3)')a_e_d(1:3) + write (error_unit,'("Invalid input format ",a3)')a_e_d(1:3) case(psb_err_unsupported_format_) - write (0,'("Format ",a3," not yet supported here")')a_e_d(1:3) + write (error_unit,'("Format ",a3," not yet supported here")')a_e_d(1:3) case(psb_err_format_unknown_) - write (0,'("Format ",a3," is unknown")')a_e_d(1:3) + write (error_unit,'("Format ",a3," is unknown")')a_e_d(1:3) case(psb_err_iarray_outside_bounds_) - write (0,'("indices in input array are not within problem dimension ",2(i0,2x))')i_e_d(1:2) + write (error_unit,'("indices in input array are not within problem dimension ",2(i0,2x))')i_e_d(1:2) case(psb_err_iarray_outside_process_) - write (0,'("indices in input array are not belonging to the calling process ",i0)')i_e_d(1) + write (error_unit,'("indices in input array are not belonging to the calling process ",i0)')i_e_d(1) case(psb_err_forgot_geall_) - write (0,'("To call this routine you must first call psb_geall on the same matrix")') + write (error_unit,'("To call this routine you must first call psb_geall on the same matrix")') case(psb_err_forgot_spall_) - write (0,'("To call this routine you must first call psb_spall on the same matrix")') + write (error_unit,'("To call this routine you must first call psb_spall on the same matrix")') case(psb_err_iarg_mbeeiarra_i_) - write (0,'("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') & + write (error_unit,'("Input argument n. ",i0," must be equal to entry n. ",i0," in array input argument n.",i0)') & & i_e_d(1),i_e_d(4),i_e_d(3) - write (0,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5) + write (error_unit,'("Current values are ",i0," != ",i0)')i_e_d(2), i_e_d(5) case(psb_err_mpi_error_) - write (0,'("MPI error:",i0)')i_e_d(1) + write (error_unit,'("MPI error:",i0)')i_e_d(1) case(psb_err_parm_differs_among_procs_) - write (0,'("Parameter n. ",i0," must be equal on all processes. ",i0)')i_e_d(1) + write (error_unit,'("Parameter n. ",i0," must be equal on all processes. ",i0)')i_e_d(1) case(psb_err_entry_out_of_bounds_) - write (0,'("Entry n. ",i0," out of ",i0," should be between 1 and ",i0," but is ",i0)')i_e_d(1),i_e_d(3),i_e_d(4),i_e_d(2) + write (error_unit,'("Entry n. ",i0," out of ",i0," should be between 1 and ",i0," but is ",i0)')i_e_d(1),i_e_d(3),i_e_d(4),i_e_d(2) case(psb_err_inconsistent_index_lists_) - write (0,'("Index lists are inconsistent: some indices are orphans")') + write (error_unit,'("Index lists are inconsistent: some indices are orphans")') case(psb_err_partfunc_toomuchprocs_) - write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1) - write (0,'("greater than No of grid s processes on global point ",i0,". Actual number of grid s ")')i_e_d(4) - write (0,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3) + write (error_unit,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1) + write (error_unit,'("greater than No of grid s processes on global point ",i0,". Actual number of grid s ")')i_e_d(4) + write (error_unit,'("processes is ",i0,", number returned is ",i0)')i_e_d(2),i_e_d(3) case(psb_err_partfunc_toofewprocs_) - write (0,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1) - write (0,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')i_e_d(3),i_e_d(2) + write (error_unit,'("partition function passed as input argument n. ",i0," returns number of processes")')i_e_d(1) + write (error_unit,'("less or equal to 0 on global point ",i0,". Number returned is ",i0)')i_e_d(3),i_e_d(2) case(psb_err_partfunc_wrong_pid_) - write (0,'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')i_e_d(1) - write (0,'("on global point ",i0,". Current value returned is : ",i0)')i_e_d(3),i_e_d(2) + write (error_unit,'("partition function passed as input argument n. ",i0," returns wrong processes identifier")')i_e_d(1) + write (error_unit,'("on global point ",i0,". Current value returned is : ",i0)')i_e_d(3),i_e_d(2) case(psb_err_no_optional_arg_) - write (0,'("Exactly one of the optional arguments ",a," must be present")')a_e_d + write (error_unit,'("Exactly one of the optional arguments ",a," must be present")')a_e_d case(psb_err_arg_m_required_) - write (0,'("Argument M is required when argument PARTS is specified")') + write (error_unit,'("Argument M is required when argument PARTS is specified")') case(psb_err_spmat_invalid_state_) - write (0,'("Sparse Matrix and descriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1) + write (error_unit,'("Sparse Matrix and descriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1) + case(psb_err_missing_override_method_) + write (error_unit,'("Base class method ",a," called: the class for ",a," is missing an overriding implementation")')r_name, a_e_d case (psb_err_invalid_cd_state_) - write (0,'("Invalid state for communication descriptor")') + write (error_unit,'("Invalid state for communication descriptor")') case (psb_err_invalid_a_and_cd_state_) - write (0,'("Invalid combined state for A and DESC_A")') + write (error_unit,'("Invalid combined state for A and DESC_A")') case(1124:1999) - write (0,'("computational error. code: ",i0)')err_c + write (error_unit,'("computational error. code: ",i0)')err_c case(psb_err_blacs_error_) - write (0,'("BLACS error. Number of processes=-1")') + write (error_unit,'("BLACS error. Number of processes=-1")') case(psb_err_initerror_neugh_procs_) - write (0,'("Initialization error: not enough processes available in the parallel environment")') + write (error_unit,'("Initialization error: not enough processes available in the parallel environment")') case(psb_err_blacs_err_gridcols_not_1_) - write (0,'("BLACS ERROR: Number of grid columns must be equal to 1\nCurrent value is ",i4," != 1.")')i_e_d(1) + write (error_unit,'("BLACS ERROR: Number of grid columns must be equal to 1\nCurrent value is ",i4," != 1.")')i_e_d(1) case(psb_err_invalid_matrix_input_state_) - write (0,'("Invalid input state for matrix.")') + write (error_unit,'("Invalid input state for matrix.")') case(psb_err_input_no_regen_) - write (0,'("Input state for matrix is not adequate for regeneration.")') + write (error_unit,'("Input state for matrix is not adequate for regeneration.")') case (2233:2999) - write(0,'("resource error. code: ",i0)')err_c + write(error_unit,'("resource error. code: ",i0)')err_c case(3000:3009) - write (0,'("sparse matrix representation ",a3," not yet implemented")')a_e_d(1:3) + write (error_unit,'("sparse matrix representation ",a3," not yet implemented")')a_e_d(1:3) case(psb_err_lld_case_not_implemented_) - write (0,'("Case lld not equal matrix_data[N_COL_] is not yet implemented.")') + write (error_unit,'("Case lld not equal matrix_data[N_COL_] is not yet implemented.")') case(psb_err_transpose_unsupported_) - write (0,'("transpose option for sparse matrix representation ",a3," not implemented")')a_e_d(1:3) + write (error_unit,'("transpose option for sparse matrix representation ",a3," not implemented")')a_e_d(1:3) case(psb_err_transpose_c_unsupported_) - write (0,'("Case trans = C is not yet implemented.")') + write (error_unit,'("Case trans = C is not yet implemented.")') case(psb_err_transpose_not_n_unsupported_) - write (0,'("Case trans /= N is not yet implemented.")') + write (error_unit,'("Case trans /= N is not yet implemented.")') case(psb_err_only_unit_diag_) - write (0,'("Only unit diagonal so far for triangular matrices. ")') + write (error_unit,'("Only unit diagonal so far for triangular matrices. ")') case(3023) - write (0,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")') + write (error_unit,'("Cases DESCRA(1:1)=S DESCRA(1:1)=T not yet implemented. ")') case(3024) - write (0,'("Cases DESCRA(1:1)=G not yet implemented. ")') + write (error_unit,'("Cases DESCRA(1:1)=G not yet implemented. ")') case(psb_err_ja_nix_ia_niy_unsupported_) - write (0,'("Case ja /= ix or ia/=iy is not yet implemented.")') + write (error_unit,'("Case ja /= ix or ia/=iy is not yet implemented.")') case(psb_err_ix_n1_iy_n1_unsupported_) - write (0,'("Case ix /= 1 or iy /= 1 is not yet implemented.")') + write (error_unit,'("Case ix /= 1 or iy /= 1 is not yet implemented.")') case(3050) - write (0,'("Case ix /= iy is not yet implemented.")') + write (error_unit,'("Case ix /= iy is not yet implemented.")') case(3060) - write (0,'("Case ix /= 1 is not yet implemented.")') + write (error_unit,'("Case ix /= 1 is not yet implemented.")') case(3070) - write (0,'("This operation is only implemented with no overlap.")') + write (error_unit,'("This operation is only implemented with no overlap.")') case(3080) - write (0,'("Decompostion type ",i0," not yet supported.")')i_e_d(1) + write (error_unit,'("Decompostion type ",i0," not yet supported.")')i_e_d(1) case(3090) - write (0,'("Insert matrix mode not yet implemented.")') + write (error_unit,'("Insert matrix mode not yet implemented.")') case(3100) - write (0,'("Error on index. Element has not been inserted")') - write (0,'("local index is: ",i0," and global index is:",i0)')i_e_d(1:2) + write (error_unit,'("Error on index. Element has not been inserted")') + write (error_unit,'("local index is: ",i0," and global index is:",i0)')i_e_d(1:2) case(psb_err_input_matrix_unassembled_) - write (0,'("Before you call this routine, you must assembly sparse matrix")') + write (error_unit,'("Before you call this routine, you must assembly sparse matrix")') case(3111) - write (0,'("Before you call this routine, you must initialize the preconditioner")') + write (error_unit,'("Before you call this routine, you must initialize the preconditioner")') case(3112) - write (0,'("Before you call this routine, you must build the preconditioner")') + write (error_unit,'("Before you call this routine, you must build the preconditioner")') case(3113:3999) - write(0,'("miscellaneus error. code: ",i0)')err_c + write(error_unit,'("miscellaneus error. code: ",i0)')err_c case(psb_err_alloc_dealloc_) - write(0,'("Allocation/deallocation error")') + write(error_unit,'("Allocation/deallocation error")') case(psb_err_internal_error_) - write(0,'("Internal error: ",a)')a_e_d + write(error_unit,'("Internal error: ",a)')a_e_d case(psb_err_from_subroutine_) - write (0,'("Error from call to subroutine ",a)')a_e_d + write (error_unit,'("Error from call to subroutine ",a)')a_e_d case(psb_err_from_subroutine_non_) - write (0,'("Error from call to a subroutine ")') + write (error_unit,'("Error from call to a subroutine ")') case(psb_err_from_subroutine_i_) - write (0,'("Error ",i0," from call to a subroutine ")')i_e_d(1) + write (error_unit,'("Error ",i0," from call to a subroutine ")')i_e_d(1) case(psb_err_from_subroutine_ai_) - write (0,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1) + write (error_unit,'("Error from call to subroutine ",a," ",i0)')a_e_d,i_e_d(1) case(psb_err_alloc_request_) - write (0,'("Error on allocation request for ",i0," items of type ",a)')i_e_d(1),a_e_d + write (error_unit,'("Error on allocation request for ",i0," items of type ",a)')i_e_d(1),a_e_d case(4110) - write (0,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d + write (error_unit,'("Error ",i0," from call to an external package in subroutine ",a)')i_e_d(1),a_e_d case (psb_err_invalid_istop_) - write (0,'("Invalid ISTOP: ",i0)')i_e_d(1) + write (error_unit,'("Invalid ISTOP: ",i0)')i_e_d(1) case (5002) - write (0,'("Invalid PREC: ",i0)')i_e_d(1) + write (error_unit,'("Invalid PREC: ",i0)')i_e_d(1) case (5003) - write (0,'("Invalid PREC: ",a3)')a_e_d(1:3) + write (error_unit,'("Invalid PREC: ",a3)')a_e_d(1:3) case default - write(0,'("unknown error (",i0,") in subroutine ",a)')err_c,r_name - write(0,'(5(i0,2x))') i_e_d - write(0,'(a)') a_e_d + write(error_unit,'("unknown error (",i0,") in subroutine ",a)')err_c,r_name + write(error_unit,'(5(i0,2x))') i_e_d + write(error_unit,'(a)') a_e_d end select