diff --git a/src/_el_typename__list_types.instantiation b/src/_el_typename__list_types.instantiation index 46466a95f9..7c567d7849 100644 --- a/src/_el_typename__list_types.instantiation +++ b/src/_el_typename__list_types.instantiation @@ -3,24 +3,24 @@ 'el_type':'type(particle_type)', 'USE':"""use particle_types, only: particle_type, deallocate_particle_set""", 'deallocate_els_code': -"""call deallocate_particle_set(list%els)""" +"""call deallocate_particle_set(list%els,error=error)""" }, {'el_typename':'atomic_kind', 'el_type':'type(atomic_kind_type)', 'USE':"""use atomic_kind_types, only: atomic_kind_type,deallocate_atomic_kind_set""", 'deallocate_els_code': -"""call deallocate_atomic_kind_set(list%els)""" +"""call deallocate_atomic_kind_set(list%els,error=error)""" }, {'el_typename':'mol_new', 'el_type':'type(molecule_type)', 'USE':"""use molecule_types_new, only: molecule_type, deallocate_molecule_set""", 'deallocate_els_code': -"""call deallocate_molecule_set(list%els)""" +"""call deallocate_molecule_set(list%els,error=error)""" }, {'el_typename':'mol_kind_new', 'el_type':'type(molecule_kind_type)', 'USE':"""use molecule_kind_types, only: molecule_kind_type, deallocate_molecule_kind_set""", 'deallocate_els_code': -"""call deallocate_molecule_kind_set(list%els)""" +"""call deallocate_molecule_kind_set(list%els,error=error)""" } ] diff --git a/src/_el_typename__list_types.template b/src/_el_typename__list_types.template index c85331e503..c99b4c81a8 100644 --- a/src/_el_typename__list_types.template +++ b/src/_el_typename__list_types.template @@ -1,6 +1,6 @@ !-----------------------------------------------------------------------------! ! CP2K: A general program to perform molecular dynamics simulations ! -! Copyright (C) 2002 CP2K developers group ! +! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! !!****h* cp2k/[el_typename]_list_types [1.0] * @@ -164,7 +164,7 @@ SUBROUTINE [el_typename]_list_create(list, els_ptr, & [el_type], DIMENSION(:), POINTER, OPTIONAL :: els_ptr LOGICAL, INTENT(in), OPTIONAL :: owns_els INTEGER, INTENT(in), OPTIONAL :: n_els - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineN='[el_typename]_list_create',& @@ -228,7 +228,7 @@ END SUBROUTINE [el_typename]_list_create !!*** ********************************************************************** SUBROUTINE [el_typename]_list_retain(list, error) TYPE([el_typename]_list_type), POINTER :: list - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineN='[el_typename]_list_retain',& @@ -269,7 +269,7 @@ END SUBROUTINE [el_typename]_list_retain !!*** ********************************************************************** SUBROUTINE [el_typename]_list_release(list, error) TYPE([el_typename]_list_type), POINTER :: list - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineN='[el_typename]_list_release',& diff --git a/src/atomic_kind_list_types.F b/src/atomic_kind_list_types.F index 32a060a233..42d4ad244a 100644 --- a/src/atomic_kind_list_types.F +++ b/src/atomic_kind_list_types.F @@ -291,7 +291,7 @@ SUBROUTINE atomic_kind_list_release(list, error) IF (list%ref_count==0) THEN IF (list%owns_els) THEN IF (ASSOCIATED(list%els)) THEN - CALL deallocate_atomic_kind_set(list%els,error) + CALL deallocate_atomic_kind_set(list%els,error=error) END IF END IF NULLIFY(list%els) @@ -308,7 +308,7 @@ END SUBROUTINE atomic_kind_list_release ! [template(el_typename,el_type,USE,deallocate_els_code)] ! ARGS: ! USE = "use atomic_kind_types, only: atomic_kind_type,deallocate_atomic_kind_set" -! deallocate_els_code = "call deallocate_atomic_kind_set(list%els)" +! deallocate_els_code = "call deallocate_atomic_kind_set(list%els,error=error)" ! el_type = "type(atomic_kind_type)" ! el_typename = "atomic_kind" diff --git a/src/cp__el_name__pool_types.instantiation b/src/cp__el_name__pool_types.instantiation index 44de019f42..72fe9b39c4 100644 --- a/src/cp__el_name__pool_types.instantiation +++ b/src/cp__el_name__pool_types.instantiation @@ -44,7 +44,7 @@ """ CALL cp_assert(pool%el_struct%id_nr==element%matrix_struct%id_nr,& cp_failure_level, cp_assertion_failed, routineP,& "pool cannot reuse matrixes with another structure "//& - CPSourceFileRef,& +CPSourceFileRef,& error=error,failure=failure)""", 'create_els-extra_args':'name,', diff --git a/src/cp__el_name__pool_types.template b/src/cp__el_name__pool_types.template index a561e902a7..597eb53081 100644 --- a/src/cp__el_name__pool_types.template +++ b/src/cp__el_name__pool_types.template @@ -1,6 +1,6 @@ !-----------------------------------------------------------------------------! ! CP2K: A general program to perform molecular dynamics simulations ! -! Copyright (C) 2002 CP2K developers group ! +! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! !!****h* cp2k/cp_[el_name]_pool_types [1.0] * @@ -170,7 +170,7 @@ CONTAINS [pool_create-extra_args] error) TYPE(cp_[el_name]_pool_type), POINTER :: pool [el_struct_type], POINTER :: el_struct - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error [pool_create-extra_args_types] LOGICAL :: failure @@ -218,7 +218,7 @@ CONTAINS !!*** ********************************************************************** SUBROUTINE [el_name]_pool_retain(pool,error) TYPE(cp_[el_name]_pool_type), POINTER :: pool - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineN='[el_name]_pool_retain',& @@ -259,7 +259,7 @@ CONTAINS !!*** ********************************************************************** SUBROUTINE [el_name]_pool_flush_cache(pool,error) TYPE(cp_[el_name]_pool_type), POINTER :: pool - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineN='[el_name]_pool_flush_cache',& @@ -273,7 +273,7 @@ CONTAINS IF (.NOT. failure) THEN iterator => pool%cache DO - IF (.NOT.cp_sll_[el_name]_next(iterator,el_att=el_att)) EXIT + IF (.NOT.cp_sll_[el_name]_next(iterator,el_att=el_att,error=error)) EXIT CALL [el_release](el_att,error=error) END DO CALL cp_sll_[el_name]_dealloc(pool%cache,error=error) @@ -306,7 +306,7 @@ CONTAINS !!*** ********************************************************************** SUBROUTINE [el_name]_pool_release(pool,error) TYPE(cp_[el_name]_pool_type), POINTER :: pool - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineN='cp_[el_name]_pool_release',& @@ -361,7 +361,7 @@ CONTAINS [create_el-extra_args] error) TYPE(cp_[el_name]_pool_type), POINTER :: pool [el_type], POINTER :: element - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error [create_el-extra_args_types] LOGICAL :: failure @@ -375,8 +375,8 @@ CONTAINS CPPrecondition(pool%ref_count>0,cp_failure_level,routineP,error,failure) IF (.NOT.failure) THEN IF (ASSOCIATED(pool%cache)) THEN - element => cp_sll_[el_name]_get_first_el(pool%cache) - CALL cp_sll_[el_name]_rm_first_el(pool%cache) + element => cp_sll_[el_name]_get_first_el(pool%cache,error=error) + CALL cp_sll_[el_name]_rm_first_el(pool%cache,error=error) [create_el-reuse_commands] ELSE NULLIFY(element) @@ -420,7 +420,7 @@ CONTAINS TYPE(cp_[el_name]_pool_type), POINTER :: pool INTEGER, INTENT(in) :: n_elements [el_array_type], DIMENSION(:), POINTER :: elements - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error [create_els-extra_args_types] LOGICAL :: failure @@ -474,7 +474,7 @@ CONTAINS SUBROUTINE [el_name]_pool_give_back_[el_name](pool, element, error) TYPE(cp_[el_name]_pool_type), POINTER :: pool [el_type], POINTER :: element - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure, did_insert CHARACTER(len=*), PARAMETER :: routineN='[el_name]_pool_give_back_[el_name]',& @@ -496,7 +496,7 @@ CONTAINS insert_equals=.FALSE., did_insert=did_insert, error=error) CPPostcondition(did_insert,cp_failure_level,routineP,error,failure) ELSE - CALL cp_sll_[el_name]_insert_el(pool%cache, el=element) + CALL cp_sll_[el_name]_insert_el(pool%cache, el=element,error=error) END IF END IF NULLIFY(element) @@ -533,7 +533,7 @@ CONTAINS SUBROUTINE [el_name]_pool_give_back_[el_name]_vect(pool, elements, error) TYPE(cp_[el_name]_pool_type), POINTER :: pool [el_array_type], DIMENSION(:), POINTER :: elements - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineN='[el_name]_pool_give_back_elements_vect',& @@ -585,7 +585,7 @@ CONTAINS FUNCTION [el_name]_pool_get_el_struct(pool,error) RESULT(res) [el_struct_type], POINTER :: res TYPE(cp_[el_name]_pool_type), POINTER :: pool - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineN='[el_name]_pool_get_el_struct',& @@ -631,7 +631,7 @@ END FUNCTION [el_name]_pool_get_el_struct SUBROUTINE [el_name]_pools_copy(source_pools, target_pools, error) TYPE(cp_[el_name]_pool_p_type), DIMENSION(:), POINTER :: source_pools,& target_pools - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: stat, i @@ -678,7 +678,7 @@ END SUBROUTINE [el_name]_pools_copy !!*** ********************************************************************** SUBROUTINE [el_name]_pools_dealloc(pools, error) TYPE(cp_[el_name]_pool_p_type), DIMENSION(:), POINTER :: pools - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: stat, i @@ -721,7 +721,7 @@ END SUBROUTINE [el_name]_pools_dealloc !!*** ********************************************************************** SUBROUTINE [el_name]_pools_flush_cache(pools, error) TYPE(cp_[el_name]_pool_p_type), DIMENSION(:), POINTER :: pools - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: stat,i @@ -766,7 +766,7 @@ SUBROUTINE [el_name]_pools_create_[el_name]_vect(pools,elements,& [create_els-extra_args]error) TYPE(cp_[el_name]_pool_p_type), DIMENSION(:), POINTER :: pools [el_array_type], DIMENSION(:), POINTER :: elements - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error [create_els-extra_args_types] LOGICAL :: failure @@ -823,7 +823,7 @@ END SUBROUTINE [el_name]_pools_create_[el_name]_vect SUBROUTINE [el_name]_pools_give_back_[el_name]_vect(pools,elements,error) TYPE(cp_[el_name]_pool_p_type), DIMENSION(:), POINTER :: pools [el_array_type], DIMENSION(:), POINTER :: elements - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: i, stat diff --git a/src/cp_array__nametype1__utils.template b/src/cp_array__nametype1__utils.template index f36bd4470c..7a6024ca48 100644 --- a/src/cp_array__nametype1__utils.template +++ b/src/cp_array__nametype1__utils.template @@ -1,6 +1,6 @@ !-----------------------------------------------------------------------------! ! CP2K: A general program to perform molecular dynamics simulations ! -! Copyright (C) 2002 CP2K developers group ! +! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! [defines] @@ -196,7 +196,7 @@ SUBROUTINE cp_1d_[nametype1]_write(array, unit_nr, el_format, error) [type1], DIMENSION(:), INTENT(in) :: array INTEGER, INTENT(in) :: unit_nr CHARACTER(len=*), INTENT(in), OPTIONAL :: el_format - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: iostat, i @@ -267,7 +267,7 @@ SUBROUTINE cp_2d_[nametype1]_write(array, unit_nr, el_format, error) [type1], DIMENSION(:,:), INTENT(in) :: array INTEGER, INTENT(in) :: unit_nr CHARACTER(len=*), INTENT(in), OPTIONAL :: el_format - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: iostat, i @@ -332,7 +332,7 @@ END SUBROUTINE cp_2d_[nametype1]_write [type1], DIMENSION(:), POINTER :: array INTEGER, INTENT(in) :: n [type1], INTENT(in), OPTIONAL :: init - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: stat @@ -395,7 +395,7 @@ END SUBROUTINE cp_2d_[nametype1]_write [type1], DIMENSION(:,:), POINTER :: array INTEGER, INTENT(in) :: n_rows, n_cols [type1], INTENT(in), OPTIONAL :: init - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: stat @@ -457,7 +457,7 @@ FUNCTION cp_1d_[nametype1]_bsearch(array, el, l_index, u_index, error)& [type1], DIMENSION(:), intent(in) :: array [type1], intent(in) :: el INTEGER, INTENT(in), OPTIONAL :: l_index, u_index - type(cp_error_type), optional, intent(inout) :: error + type(cp_error_type), intent(inout) :: error integer :: res logical :: failure diff --git a/src/cp_fm_pool_types.F b/src/cp_fm_pool_types.F index eb30783ebe..98b1278dd2 100644 --- a/src/cp_fm_pool_types.F +++ b/src/cp_fm_pool_types.F @@ -12,24 +12,24 @@ !! pool for for elements that are retained and released !! !! NOTES -!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ +!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ !! | _ \ ___ _ __ ( ) |_ | \/ | ___ __| (_)/ _|_ _ |_ _| |__ (_)___ | ___(_) | ___| | !! | | | |/ _ \| '_ \|/| __| | |\/| |/ _ \ / _` | | |_| | | | | | | '_ \| / __| | |_ | | |/ _ \ | !! | |_| | (_) | | | | | |_ | | | | (_) | (_| | | _| |_| | | | | | | | \__ \ | _| | | | __/_| !! |____/ \___/|_| |_| \__| |_| |_|\___/ \__,_|_|_| \__, | |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! |___/ -!! ____ _ ___ _ _ _ _ -!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ +!! |___/ +!! ____ _ ___ _ _ _ _ +!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ !! | | | |/ _ \/ __|/ _ \ | || '_ ` _ \| '_ ` _ \ / _ \/ _` | |/ _` | __/ _ \ | | | | !! | |___| | (_) \__ \ __/ | || | | | | | | | | | | __/ (_| | | (_| | || __/ | |_| | !! \____|_|\___/|___/\___| |___|_| |_| |_|_| |_| |_|\___|\__,_|_|\__,_|\__\___|_|\__, | -!! |___/ -!! _____ _ _ _____ _ _ _ +!! |___/ +!! _____ _ _ _____ _ _ _ !! |_ _| |__ (_)___ | ___(_) | ___| | !! | | | '_ \| / __| | |_ | | |/ _ \ | !! | | | | | | \__ \ | _| | | | __/_| !! |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! +!! !! This is a template !! !! **** DO NOT MODIFY THE .F FILES **** @@ -110,7 +110,7 @@ MODULE cp_fm_pool_types PRIVATE INTEGER :: ref_count, id_nr TYPE(cp_fm_struct_type), POINTER :: el_struct - + TYPE(cp_sll_fm_type), POINTER :: cache END TYPE cp_fm_pool_type !!*** @@ -162,8 +162,8 @@ CONTAINS !! - pool: the pool to create !! - el_struct: the structure of the elements that are stored in !! this pool -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -195,7 +195,7 @@ CONTAINS pool%id_nr=last_fm_pool_id_nr pool%ref_count=1 NULLIFY(pool%cache) - + END IF END SUBROUTINE fm_pool_create !*************************************************************************** @@ -213,8 +213,8 @@ CONTAINS !! !! INPUTS !! - pool: the pool to retain -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -256,8 +256,8 @@ CONTAINS !! !! INPUTS !! - pool: the pool to flush -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -305,8 +305,8 @@ CONTAINS !! !! INPUTS !! - pool: the pool to release -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -359,7 +359,7 @@ CONTAINS !! - pool: the pool from where you get the element !! - element: will contain the new element !! - name: the name for the new matrix (optional) -!! - error: variable to control error logging, stopping,... +!! - error: variable to control error logging, stopping,... !! see module cp_error_handling !! !! AUTHOR @@ -389,12 +389,12 @@ CONTAINS IF (ASSOCIATED(pool%cache)) THEN element => cp_sll_fm_get_first_el(pool%cache,error=error) CALL cp_sll_fm_rm_first_el(pool%cache,error=error) - + ELSE NULLIFY(element) CALL cp_fm_create(element,matrix_struct=pool%el_struct,error=error) END IF - + IF (PRESENT(name)) THEN element%name=name element%print_count=0 @@ -403,7 +403,7 @@ CONTAINS element%print_count=0 ! guarantee output unicity? END IF - + END IF CPPostcondition(ASSOCIATED(element),cp_failure_level,routineP,error,failure) CPPostcondition(element%ref_count==1,cp_warning_level,routineP,error,failure) @@ -427,8 +427,8 @@ CONTAINS !! - n_elements: the number of elements in the vector !! - elements: will contain the new vector !! - name: the name for the new matrixes (optional) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -471,7 +471,7 @@ CONTAINS END IF END DO - + END IF END SUBROUTINE fm_pool_create_fm_vect !*************************************************************************** @@ -492,8 +492,8 @@ CONTAINS !! INPUTS !! - pool: the pool where to cache the element !! - element: the element to give back -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -556,8 +556,8 @@ CPSourceFileRef,& !! INPUTS !! - pool: the pool where to cache the elements !! - elements: the elements to give back -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -611,8 +611,8 @@ CPSourceFileRef,& !! !! INPUTS !! - pool: the pool you are interested in -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -632,7 +632,7 @@ FUNCTION fm_pool_get_el_struct(pool,error) RESULT(res) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(pool),cp_failure_level,routineP,error,failure) CPPrecondition(pool%ref_count>0,cp_failure_level,routineP,error,failure) IF (.NOT. failure) THEN @@ -659,8 +659,8 @@ END FUNCTION fm_pool_get_el_struct !! INPUTS !! - source_pools: the pools to copy !! - target_pools: will contains the new pools -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -681,7 +681,7 @@ SUBROUTINE fm_pools_copy(source_pools, target_pools, error) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(source_pools),cp_failure_level,routineP,error,failure) IF (.NOT. failure) THEN ALLOCATE(target_pools(SIZE(source_pools)),stat=stat) @@ -709,8 +709,8 @@ END SUBROUTINE fm_pools_copy !! !! INPUTS !! - pools: the pools to release -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -731,7 +731,7 @@ SUBROUTINE fm_pools_dealloc(pools, error) LOGICAL :: failure failure=.FALSE. - + IF (ASSOCIATED(pools)) THEN DO i=1,SIZE(pools) CALL fm_pool_release(pools(i)%pool,error=error) @@ -755,8 +755,8 @@ END SUBROUTINE fm_pools_dealloc !! !! INPUTS !! - pools: the pools to flush -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -777,7 +777,7 @@ SUBROUTINE fm_pools_flush_cache(pools, error) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(pools),cp_failure_level,routineP,error,failure) IF (.NOT.failure) THEN DO i=1,SIZE(pools) @@ -802,8 +802,8 @@ END SUBROUTINE fm_pools_flush_cache !! - pools: the pools to create the elements from !! - elements: will contain the vector of elements !! - name: the name for the new matrixes (optional) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -830,7 +830,7 @@ SUBROUTINE fm_pools_create_fm_vect(pools,elements,& failure=.FALSE. NULLIFY(pool) - + CPPrecondition(ASSOCIATED(pools),cp_failure_level,routineP,error,failure) IF (.NOT. failure) THEN ALLOCATE(elements(SIZE(pools)),stat=stat) @@ -850,7 +850,7 @@ SUBROUTINE fm_pools_create_fm_vect(pools,elements,& END IF END DO - + END IF END SUBROUTINE fm_pools_create_fm_vect !*************************************************************************** @@ -870,8 +870,8 @@ END SUBROUTINE fm_pools_create_fm_vect !! INPUTS !! - pools: the pool where to give back the vector !! - elements: the vector of elements to give back -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -894,7 +894,7 @@ SUBROUTINE fm_pools_give_back_fm_vect(pools,elements,error) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(pools),cp_failure_level,routineP,error,failure) CPPrecondition(ASSOCIATED(elements),cp_failure_level,routineP,error,failure) CPPrecondition(SIZE(pools)==SIZE(elements),cp_failure_level,routineP,error,failure) diff --git a/src/cp_lbfgs_optimizer__nametype1_.template b/src/cp_lbfgs_optimizer__nametype1_.template index 08f03fc8c3..1f27fb9a24 100644 --- a/src/cp_lbfgs_optimizer__nametype1_.template +++ b/src/cp_lbfgs_optimizer__nametype1_.template @@ -1,6 +1,6 @@ !-----------------------------------------------------------------------------! ! CP2K: A general program to perform molecular dynamics simulations ! -! Copyright (C) 2001 CP2K developers group ! +! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! !!****h* cp2k/cp_lbfgs_optimizer_[nametype1] [1.0] * @@ -272,7 +272,7 @@ CONTAINS REAL(kind=dp), INTENT(in), DIMENSION(SIZE(x0)), OPTIONAL :: lower_bound,& upper_bound INTEGER, INTENT(in), DIMENSION(SIZE(x0)), OPTIONAL :: kind_of_bound - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: handle,n, lenwa, stat @@ -298,7 +298,7 @@ CONTAINS IF (PRESENT(m)) optimizer%m=m optimizer%master= para_env%source optimizer%para_env => para_env - CALL cp_para_env_retain(para_env) + CALL cp_para_env_retain(para_env,error=error) optimizer%obj_funct => obj_funct CALL [type1_retain](obj_funct, error=error) optimizer%max_f_per_iter=20 @@ -378,7 +378,7 @@ CONTAINS !!*** ********************************************************************** SUBROUTINE cp_opt_[nametype1]_retain(optimizer,error) TYPE(cp_lbfgs_opt_[nametype1]_type), POINTER :: optimizer - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error logical :: failure character(len=*), parameter :: routineN='cp_opt_[nametype1]_retain',& @@ -420,7 +420,7 @@ END SUBROUTINE cp_opt_[nametype1]_retain !!*** ********************************************************************** SUBROUTINE cp_opt_[nametype1]_release(optimizer,error) TYPE(cp_lbfgs_opt_[nametype1]_type), POINTER :: optimizer - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: handle, stat @@ -528,7 +528,7 @@ END SUBROUTINE cp_opt_[nametype1]_release REAL(kind=dp), POINTER, DIMENSION(:), OPTIONAL :: lower_bound,& upper_bound INTEGER, POINTER, DIMENSION(:), OPTIONAL :: kind_of_bound - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: handle @@ -621,7 +621,7 @@ CPSourceFileRef,& TYPE(section_vals_type), POINTER :: force_env_section, input LOGICAL, INTENT(out), OPTIONAL :: converged TYPE(force_env_type), POINTER :: force_env - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error TYPE(gopt_param_type), POINTER :: gopt_param LOGICAL :: failure, justEntred, is_master @@ -747,9 +747,9 @@ CPSourceFileRef,& IF (dataunit>0) THEN CALL force_env_get(force_env,& cell=cell,& - subsys=subsys) + subsys=subsys,error=error) CALL cp_subsys_get(subsys=subsys(1)%subsys,& - particles=particles) + particles=particles,error=error) particle_set => particles%els WRITE (UNIT=title,FMT="(A,I8,A,F20.10)") " i =",optimizer%isave(30),", E =",optimizer%f CALL write_particle_coordinates(particle_set,dataunit,& @@ -851,7 +851,7 @@ CPSourceFileRef,& CALL cp_opt_[nametype1]_bcast_res(optimizer,& n_iter=optimizer%n_iter,& f=optimizer%f, last_f=optimizer%last_f,& - projected_gradient=optimizer%projected_gradient) + projected_gradient=optimizer%projected_gradient,error=error) END IF DEALLOCATE(xold,stat=stat) CPPrecondition(stat==0,cp_failure_level,routineP,error,failure) @@ -897,7 +897,7 @@ CPSourceFileRef,& TYPE(cp_lbfgs_opt_[nametype1]_type), pointer :: optimizer INTEGER, OPTIONAL, INTENT(out) :: n_iter REAL(kind=dp), OPTIONAL, INTENT(inout) :: f, last_f, projected_gradient - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: handle @@ -963,7 +963,7 @@ CPSourceFileRef,& TYPE(force_env_type), POINTER :: force_env TYPE(gopt_param_type), POINTER :: gopt_param LOGICAL ::res - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: handle @@ -1015,7 +1015,7 @@ CPSourceFileRef,& !!*** ********************************************************************** SUBROUTINE cp_opt_[nametype1]_stop(optimizer, error) TYPE(cp_lbfgs_opt_[nametype1]_type), POINTER :: optimizer - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: handle diff --git a/src/cp_lbfgs_optimizer_gopt.F b/src/cp_lbfgs_optimizer_gopt.F index 29ed44632e..e97ae8c7cb 100644 --- a/src/cp_lbfgs_optimizer_gopt.F +++ b/src/cp_lbfgs_optimizer_gopt.F @@ -12,30 +12,30 @@ !! routines that optimize a functional using the limited memory bfgs !! quasi-newton method. !! The process set up so that a master runs the real optimizer and the -!! others help then to calculate the objective function. -!! The arguments for the objective function are physicaly present in +!! others help then to calculate the objective function. +!! The arguments for the objective function are physicaly present in !! every processor (nedeed in the actual implementation of pao). !! In the future tha arguments themselves could be distributed. !! !! NOTES -!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ +!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ !! | _ \ ___ _ __ ( ) |_ | \/ | ___ __| (_)/ _|_ _ |_ _| |__ (_)___ | ___(_) | ___| | !! | | | |/ _ \| '_ \|/| __| | |\/| |/ _ \ / _` | | |_| | | | | | | '_ \| / __| | |_ | | |/ _ \ | !! | |_| | (_) | | | | | |_ | | | | (_) | (_| | | _| |_| | | | | | | | \__ \ | _| | | | __/_| !! |____/ \___/|_| |_| \__| |_| |_|\___/ \__,_|_|_| \__, | |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! |___/ -!! ____ _ ___ _ _ _ _ -!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ +!! |___/ +!! ____ _ ___ _ _ _ _ +!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ !! | | | |/ _ \/ __|/ _ \ | || '_ ` _ \| '_ ` _ \ / _ \/ _` | |/ _` | __/ _ \ | | | | !! | |___| | (_) \__ \ __/ | || | | | | | | | | | | __/ (_| | | (_| | || __/ | |_| | !! \____|_|\___/|___/\___| |___|_| |_| |_|_| |_| |_|\___|\__,_|_|\__,_|\__\___|_|\__, | -!! |___/ -!! _____ _ _ _____ _ _ _ +!! |___/ +!! _____ _ _ _____ _ _ _ !! |_ _| |__ (_)___ | ___(_) | ___| | !! | | | '_ \| / __| | |_ | | |/ _ \ | !! | | | | | | \__ \ | _| | | | __/_| !! |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! +!! !! This is a template !! !! **** DO NOT MODIFY THE .F FILES **** @@ -105,7 +105,7 @@ MODULE cp_lbfgs_optimizer_gopt cp_opt_gopt_step, cp_opt_gopt_stop,& cp_opt_gopt_retain - ! initalize the object + ! initalize the object INTERFACE cp_create MODULE PROCEDURE cp_opt_gopt_create END INTERFACE @@ -150,10 +150,10 @@ MODULE cp_lbfgs_optimizer_gopt !! !! ATTRIBUTES !! - task: the actual task of the optimizer (in the master it is up to -!! date, in case of error also the slaves one get updated. +!! date, in case of error also the slaves one get updated. !! - csave: internal character string used by the lbfgs optimizer, -!! meaningful only in the master -!! - lsave: logical array used by the lbfgs optimizer, updated only +!! meaningful only in the master +!! - lsave: logical array used by the lbfgs optimizer, updated only !! in the master !! On exit with task = 'NEW_X', the following information is !! available: @@ -162,14 +162,14 @@ MODULE cp_lbfgs_optimizer_gopt !! lsave(3) = .true. each variable has upper and lower bounds. !! - ref_count: reference count (see doc/ReferenceCounting.html) !! - id_nr: identification number (unique) -!! - m: the dimension of the subspace used to approximate the second +!! - m: the dimension of the subspace used to approximate the second !! derivative !! - print_every: every how many iterations output should be written. !! if 0 only at end, if print_every<0 never !! - master: the pid of the master processor !! - max_f_per_iter: the maximum number of function evaluations per !! iteration -!! - status: 0: just initialized, 1: f g calculation, +!! - status: 0: just initialized, 1: f g calculation, !! 2: begin new iteration, 3: ended iteration, !! 4: normal (converged) exit, 5: abnormal (error) exit, !! 6: daellocated @@ -192,12 +192,12 @@ MODULE cp_lbfgs_optimizer_gopt !! - isave(39) = the number of active constraints at the current !! iteration; !! - f: the actual best value of the object function -!! - wanted_relative_f_delta: the wanted relative error on f +!! - wanted_relative_f_delta: the wanted relative error on f !! (to be multiplied by epsilon), 0.0 -> no check !! - wanted_projected_gradient: the wanted error on the projected !! gradient (hessian times the gradient), 0.0 -> no check !! - last_f: the value of f in the last iteration -!! - projected_gradient: the value of the sup norm of the projected +!! - projected_gradient: the value of the sup norm of the projected !! gradient !! - x: the actual evaluation point (best one if converged or stopped) !! - lower_bound: the lower bounds @@ -219,7 +219,7 @@ MODULE cp_lbfgs_optimizer_gopt !*************************************************************************** TYPE cp_lbfgs_opt_gopt_type CHARACTER (len=60) :: task - CHARACTER (len=60) :: csave + CHARACTER (len=60) :: csave LOGICAL :: lsave (4) INTEGER :: m, print_every, master, max_f_per_iter, status, n_iter INTEGER :: ref_count, id_nr @@ -245,11 +245,11 @@ CONTAINS !! initializes the optimizer !! !! NOTES -!! redirects the lbfgs output the the default unit +!! redirects the lbfgs output the the default unit !! !! INPUTS -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -371,8 +371,8 @@ CONTAINS !! !! INPUTS !! - optimizer: the optimizer to retain -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -391,7 +391,7 @@ SUBROUTINE cp_opt_gopt_retain(optimizer,error) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(optimizer),cp_failure_level,routineP,error,failure) IF (.NOT. failure) THEN CPPreconditionNoFail(optimizer%ref_count>0,cp_failure_level,routineP,error) @@ -413,8 +413,8 @@ END SUBROUTINE cp_opt_gopt_retain !! !! INPUTS !! optimizer: the object that should be released -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -504,8 +504,8 @@ END SUBROUTINE cp_opt_gopt_release !! - !! !! INPUTS -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -577,7 +577,7 @@ END SUBROUTINE cp_opt_gopt_release actual_projected_gradient=optimizer%projected_gradient IF (optimizer%master==optimizer%para_env%mepos) THEN IF (optimizer%isave(30)>1 .AND. (optimizer%task(1:5)=="NEW_X".OR.& - optimizer%task(1:4)=="STOP".AND.optimizer%task(7:9)=="CPU")) THEN + optimizer%task(1:4)=="STOP".AND.optimizer%task(7:9)=="CPU")) THEN ! nr iterations >1 .and. dsave contains the wanted data IF (PRESENT(last_f)) last_f = optimizer%dsave(2) IF (PRESENT(actual_projected_gradient))& @@ -612,8 +612,8 @@ CPSourceFileRef,& !! use directly mainlb in place of setulb ?? !! !! INPUTS -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -758,13 +758,13 @@ CPSourceFileRef,& IF (dataunit>0) THEN CALL force_env_get(force_env,& cell=cell,& - subsys=subsys,error=error) + subsys=subsys,error=error) CALL cp_subsys_get(subsys=subsys(1)%subsys,& particles=particles,error=error) - particle_set => particles%els + particle_set => particles%els WRITE (UNIT=title,FMT="(A,I8,A,F20.10)") " i =",optimizer%isave(30),", E =",optimizer%f CALL write_particle_coordinates(particle_set,dataunit,& - dump_xmol,"POS",TRIM(title)) + dump_xmol,"POS",TRIM(title)) CALL m_flush(dataunit) END IF CALL cp_print_key_finished_output(dataunit,logger,input,& @@ -797,8 +797,8 @@ CPSourceFileRef,& CALL mp_bcast(optimizer%x,optimizer%master,& optimizer%para_env%group) CASE (3) - !op=3 ended iter - wildcard = "LBFGS" + !op=3 ended iter + wildcard = "LBFGS" dataunit = cp_print_key_unit_nr(logger,input,& "MOTION%GEOOPT%PRINT%PROGRAM_RUN_INFO",extension=".geoLog",error=error) IF (dataunit>0) THEN @@ -841,17 +841,17 @@ CPSourceFileRef,& CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,& routineP,"step on a deallocated opt structure "//& CPSourceFileRef,& - error,failure) + error,failure) CASE default CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,& routineP,"unknown status "//cp_to_string(optimizer%status)//& - " in "//& + " in "//& CPSourceFileRef,& error,failure) optimizer%status=5 EXIT END SELECT - IF (optimizer%status == 1 .AND. justEntred) THEN + IF (optimizer%status == 1 .AND. justEntred) THEN optimizer%eold = optimizer%f optimizer%emin = optimizer%eold END IF @@ -892,8 +892,8 @@ CPSourceFileRef,& !! f: the actual value of the objective function (f) !! last_f: the last value of f !! projected_gradient: the infinity norm of the projected gradient -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -952,8 +952,8 @@ CPSourceFileRef,& !! !! INPUTS !! optimizer: the optimizer that goes to the next point -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1013,8 +1013,8 @@ CPSourceFileRef,& !! necessary??? !! !! INPUTS -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1056,7 +1056,7 @@ CPSourceFileRef,& END SUBROUTINE cp_opt_gopt_stop !*************************************************************************** - ! template def put here so that line numbers in template and derived + ! template def put here so that line numbers in template and derived ! files are almost the same (multi-line use change it a bit) ! [template(type1,nametype1,USE,type1_retain,type1_release,type1_eval_at)] ! ARGS: diff --git a/src/cp_linked_list_3d_r.F b/src/cp_linked_list_3d_r.F index d5f7185c33..925fe5a137 100644 --- a/src/cp_linked_list_3d_r.F +++ b/src/cp_linked_list_3d_r.F @@ -4,8 +4,8 @@ !-----------------------------------------------------------------------------! ! less not much meningful... and defines oly a partial ordering. -#define CP_SLL_R_LESS_Q(el1,el2) ( ALL(el1 < el2) ) -#define CP_SLL_R_EQUAL_Q(el1,el2) ( ALL(el1 == el2) ) +#define CP_SLL_R_LESS_Q(el1,el2,error) ( ALL(el1 < el2) ) +#define CP_SLL_R_EQUAL_Q(el1,el2,error) ( ALL(el1 == el2) ) !!****h* cp2k/cp_linked_list_3d_r [1.0] * !! @@ -1280,9 +1280,9 @@ SUBROUTINE cp_sll_3d_r_insert_ordered(sll,el,insert_equals,& CALL cp_sll_3d_r_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_R_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_R_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_R_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_R_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_3d_r_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1295,9 +1295,9 @@ SUBROUTINE cp_sll_3d_r_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_R_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_R_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_R_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_R_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_3d_r_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1461,15 +1461,15 @@ FUNCTION cp_sll_3d_r_contains(sll,el,ordered,error) RESULT(res) IF (ord) THEN DO IF (.NOT.cp_sll_3d_r_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_R_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_R_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_R_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_R_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_3d_r_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_R_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_R_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1570,8 +1570,8 @@ END FUNCTION cp_sll_3d_r_contains2 ! arrayEl = "%array" ! defines = ! "! less not much meningful... and defines oly a partial ordering. -! #define CP_SLL_R_LESS_Q(el1,el2) ( all(el1 < el2) ) -! #define CP_SLL_R_EQUAL_Q(el1,el2) ( all(el1 == el2) ) +! #define CP_SLL_R_LESS_Q(el1,el2,error) ( all(el1 < el2) ) +! #define CP_SLL_R_EQUAL_Q(el1,el2,error) ( all(el1 == el2) ) ! " ! equalQ = "CP_SLL_R_EQUAL_Q" ! lessQ = "CP_SLL_R_LESS_Q" diff --git a/src/cp_linked_list__nametype1_.instantiation b/src/cp_linked_list__nametype1_.instantiation index 329c8b2803..5a2b46bcb5 100644 --- a/src/cp_linked_list__nametype1_.instantiation +++ b/src/cp_linked_list__nametype1_.instantiation @@ -7,8 +7,8 @@ 'USE': """USE kinds, only: dp """, 'defines': -"""#define CP_SLL_I_LESS_Q(el1,el2) ( el1 < el2 ) -#define CP_SLL_I_EQUAL_Q(el1,el2) ( el1 == el2 ) +"""#define CP_SLL_I_LESS_Q(el1,el2,error) ( el1 < el2 ) +#define CP_SLL_I_EQUAL_Q(el1,el2,error) ( el1 == el2 ) """, '=':'=', 'type1arrayEl':'integer', @@ -27,8 +27,8 @@ 'USE': """USE kinds, only: dp""", 'defines': -"""#define CP_SLL_R_LESS_Q(el1,el2) ( el1 < el2 ) -#define CP_SLL_R_EQUAL_Q(el1,el2) ( el1 == el2 ) +"""#define CP_SLL_R_LESS_Q(el1,el2,error) ( el1 < el2 ) +#define CP_SLL_R_EQUAL_Q(el1,el2,error) ( el1 == el2 ) """, '=':'=', 'type1arrayEl':'real(kind=dp)', @@ -47,8 +47,8 @@ 'USE': """ """, 'defines': -"""#define CP_SLL_L_LESS_Q(el1,el2) ( .not.el1.and.el2 ) -#define CP_SLL_L_EQUAL_Q(el1,el2) ( el1.EQV.el2 ) +"""#define CP_SLL_L_LESS_Q(el1,el2,error) ( .not.el1.and.el2 ) +#define CP_SLL_L_EQUAL_Q(el1,el2,error) ( el1.EQV.el2 ) """, '=':'=', 'type1arrayEl':'logical', @@ -67,8 +67,8 @@ 'USE': """USE kinds, only: default_string_length""", 'defines': -"""#define CP_SLL_C_LESS_Q(el1,el2) ( el1 < el2 ) -#define CP_SLL_C_EQUAL_Q(el1,el2) ( el1 == el2 ) +"""#define CP_SLL_C_LESS_Q(el1,el2,error) ( el1 < el2 ) +#define CP_SLL_C_EQUAL_Q(el1,el2,error) ( el1 == el2 ) """, '=':'=', 'type1arrayEl':'character(len=default_string_length)', @@ -80,7 +80,7 @@ 'private_routines':"""subroutine write_string(str,unit_nr,error) character(len=*),intent(in) :: str integer, intent(in) :: unit_nr - type(cp_error_type), intent(inout), optional :: error + type(cp_error_type), intent(inout) :: error write(unit_nr,"(a,a,a)") '"',trim(str),'"' end subroutine write_string @@ -97,8 +97,8 @@ end subroutine write_string USE pw_types, ONLY: pw_type, pw_p_type, pw_write""", 'defines': """! less not much meaningful... -#define CP_SLL_PW_LESS_Q(el1,el2) ( el1 %id_nr < el2 %id_nr ) -#define CP_SLL_PW_EQUAL_Q(el1,el2) ( el1 %id_nr == el2 %id_nr ) +#define CP_SLL_PW_LESS_Q(el1,el2,error) ( el1 %id_nr < el2 %id_nr ) +#define CP_SLL_PW_EQUAL_Q(el1,el2,error) ( el1 %id_nr == el2 %id_nr ) """, '=':'=>', 'type1arrayEl':'type(pw_p_type)', @@ -120,8 +120,8 @@ USE pw_types, ONLY: pw_type, pw_p_type, pw_write""", USE cp_fm_types, ONLY: cp_fm_type, cp_fm_p_type""", 'defines': """! less not much meningful... -#define CP_SLL_FM_LESS_Q(el1,el2) ( el1 %id_nr < el2 %id_nr ) -#define CP_SLL_FM_EQUAL_Q(el1,el2) ( el1 %id_nr == el2 %id_nr ) +#define CP_SLL_FM_LESS_Q(el1,el2,error) ( el1 %id_nr < el2 %id_nr ) +#define CP_SLL_FM_EQUAL_Q(el1,el2,error) ( el1 %id_nr == el2 %id_nr ) """, '=':'=>', 'type1arrayEl':'type(cp_fm_p_type)', @@ -144,8 +144,8 @@ USE sparse_matrix_types, ONLY: real_matrix_type, real_matrix_p_type,& cp_sm_get_id_nr""", 'defines': """! less not much meningful... -#define CP_SLL_SM_LESS_Q(el1,el2) ( cp_sm_get_id_nr(el1) < cp_sm_get_id_nr(el2) ) -#define CP_SLL_SM_EQUAL_Q(el1,el2) ( cp_sm_get_id_nr(el1) == cp_sm_get_id_nr(el2) ) +#define CP_SLL_SM_LESS_Q(el1,el2,error) ( cp_sm_get_id_nr(el1,error) < cp_sm_get_id_nr(el2,error) ) +#define CP_SLL_SM_EQUAL_Q(el1,el2,error) ( cp_sm_get_id_nr(el1,error) == cp_sm_get_id_nr(el2,error) ) """, '=':'=>', 'type1arrayEl':'type(real_matrix_p_type)', @@ -167,8 +167,8 @@ USE sparse_matrix_types, ONLY: real_matrix_type, real_matrix_p_type,& USE realspace_grid_types, ONLY: realspace_grid_type, realspace_grid_p_type""", 'defines': """! less not much meningful... -#define CP_SLL_RS_LESS_Q(el1,el2) ( el1%id_nr < el2%id_nr ) -#define CP_SLL_RS_EQUAL_Q(el1,el2) ( el1%id_nr == el2%id_nr ) +#define CP_SLL_RS_LESS_Q(el1,el2,error) ( el1%id_nr < el2%id_nr ) +#define CP_SLL_RS_EQUAL_Q(el1,el2,error) ( el1%id_nr == el2%id_nr ) """, '=':'=>', 'type1arrayEl':'type(realspace_grid_p_type)', @@ -189,8 +189,8 @@ USE realspace_grid_types, ONLY: realspace_grid_type, realspace_grid_p_type""", USE cp_array_r_utils, only: cp_3d_r_p_type""", 'defines': """! less not much meningful... and defines oly a partial ordering. -#define CP_SLL_R_LESS_Q(el1,el2) ( all(el1 < el2) ) -#define CP_SLL_R_EQUAL_Q(el1,el2) ( all(el1 == el2) ) +#define CP_SLL_R_LESS_Q(el1,el2,error) ( all(el1 < el2) ) +#define CP_SLL_R_EQUAL_Q(el1,el2,error) ( all(el1 == el2) ) """, '=':'=>', 'type1arrayEl':'type(cp_3d_r_p_type)', @@ -210,8 +210,8 @@ USE cp_array_r_utils, only: cp_3d_r_p_type""", """USE kinds, only: dp USE xc_derivative_types, only: xc_derivative_type,xc_derivative_p_type""", 'defines': -"""#define CP_SLL_DERIV_LESS_Q(el1,el2) cp_sll_deriv_less_q(el1,el2,error) -#define CP_SLL_DERIV_EQUAL_Q(el1,el2) ( el1%desc == el2%desc ) +"""#define CP_SLL_DERIV_LESS_Q(el1,el2,error) cp_sll_deriv_less_q(el1,el2,error) +#define CP_SLL_DERIV_EQUAL_Q(el1,el2,error) ( el1%desc == el2%desc ) """, '=':'=>', 'type1arrayEl':'type(xc_derivative_p_type)', @@ -223,7 +223,7 @@ USE xc_derivative_types, only: xc_derivative_type,xc_derivative_p_type""", 'private_routines':"""!private compare function function cp_sll_deriv_less_q(el1,el2,error) result(res) type(xc_derivative_type), pointer :: el1,el2 - type(cp_error_type), intent(inout), optional :: error + type(cp_error_type), intent(inout) :: error logical :: res character(len=*),parameter :: routineN='cp_sll_deriv_less_q',& @@ -246,8 +246,8 @@ end function 'USE': """USE input_val_types, only: val_type, val_p_type""", 'defines': -"""#define CP_SLL_VAL_LESS_Q(el1,el2) el1%id_nr', 'type1arrayEl':'type(val_p_type)', diff --git a/src/cp_linked_list__nametype1_.template b/src/cp_linked_list__nametype1_.template index 7ed80134e9..8638a70e42 100644 --- a/src/cp_linked_list__nametype1_.template +++ b/src/cp_linked_list__nametype1_.template @@ -1,6 +1,6 @@ !-----------------------------------------------------------------------------! ! CP2K: A general program to perform molecular dynamics simulations ! -! Copyright (C) 2001 CP2K developers group ! +! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! [defines] @@ -271,7 +271,7 @@ CONTAINS TYPE(cp_sll_[nametype1]_type), POINTER :: sll [type1in], OPTIONAL :: first_el TYPE(cp_sll_[nametype1]_type), POINTER, OPTIONAL :: rest - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]:cp_sll_[nametype1]_create' @@ -321,7 +321,7 @@ CONTAINS !!*** ********************************************************************** SUBROUTINE cp_sll_[nametype1]_dealloc(sll,error) TYPE(cp_sll_[nametype1]_type), POINTER :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]/cp_sll_[nametype1]_dealloc' @@ -356,7 +356,7 @@ CONTAINS !!*** ********************************************************************** SUBROUTINE cp_sll_[nametype1]_dealloc_node(sll,error) TYPE(cp_sll_[nametype1]_type), POINTER :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]/cp_sll_[nametype1]_dealloc_node' @@ -401,7 +401,7 @@ CONTAINS TYPE(cp_sll_[nametype1]_type), POINTER :: sll [type1in], OPTIONAL :: first_el TYPE(cp_sll_[nametype1]_type), POINTER, OPTIONAL :: rest - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]:cp_set_sll_[nametype1]' @@ -452,7 +452,7 @@ CONTAINS TYPE(cp_sll_[nametype1]_type), OPTIONAL, POINTER :: rest LOGICAL, OPTIONAL, INTENT(out) :: empty INTEGER, INTENT(out), OPTIONAL :: length - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]:cp_sll_[nametype1]_get' @@ -498,7 +498,7 @@ CONTAINS !!*** ********************************************************************** FUNCTION cp_sll_[nametype1]_get_first_el(sll,error) RESULT(res) TYPE(cp_sll_[nametype1]_type), POINTER :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error [type1] :: res LOGICAL :: failure @@ -542,7 +542,7 @@ CONTAINS FUNCTION cp_sll_[nametype1]_get_rest(sll, iter, error) RESULT(res) TYPE(cp_sll_[nametype1]_type), POINTER :: sll INTEGER, OPTIONAL :: iter - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error TYPE(cp_sll_[nametype1]_type), POINTER :: res LOGICAL :: failure @@ -608,7 +608,7 @@ CPSourceFileRef,& FUNCTION cp_sll_[nametype1]_get_empty(sll,error) RESULT(res) LOGICAL :: res TYPE(cp_sll_[nametype1]_type), POINTER :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]:cp_sll_[nametype1]_get_empty' @@ -643,7 +643,7 @@ CPSourceFileRef,& !!*** ********************************************************************** FUNCTION cp_sll_[nametype1]_get_length(sll,error) RESULT(res) TYPE(cp_sll_[nametype1]_type), pointer :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error INTEGER ::res LOGICAL :: failure @@ -692,7 +692,7 @@ CPSourceFileRef,& [type1] :: res TYPE(cp_sll_[nametype1]_type), POINTER :: sll INTEGER, INTENT(in) :: index - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]/cp_sll_[nametype1]_get_el_at' @@ -744,7 +744,7 @@ CPSourceFileRef,& [type1in] :: value TYPE(cp_sll_[nametype1]_type), POINTER :: sll INTEGER, INTENT(in) :: index - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]/cp_sll_[nametype1]_set_el_at' @@ -792,7 +792,7 @@ CPSourceFileRef,& !!*** ********************************************************************** FUNCTION cp_sll_[nametype1]_next(iterator,el_att,error) RESULT(res) TYPE(cp_sll_[nametype1]_type), POINTER :: iterator - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error [type1out], OPTIONAL :: el_att LOGICAL :: res @@ -840,7 +840,7 @@ CPSourceFileRef,& SUBROUTINE cp_sll_[nametype1]_insert_el(sll,el,error) TYPE(cp_sll_[nametype1]_type), POINTER :: sll [type1in]:: el - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]:cp_sll_[nametype1]_add_el' @@ -880,7 +880,7 @@ CPSourceFileRef,& !!*** ********************************************************************** SUBROUTINE cp_sll_[nametype1]_rm_first_el(sll,error) TYPE(cp_sll_[nametype1]_type), POINTER :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]/cp_sll_[nametype1]_rm_first_el' @@ -930,7 +930,7 @@ CPSourceFileRef,& [type1in] :: el INTEGER, INTENT(in) :: index TYPE(cp_sll_[nametype1]_type), POINTER :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]/cp_sll_[nametype1]_insert_el_at' @@ -980,7 +980,7 @@ CPSourceFileRef,& !!*** ********************************************************************** SUBROUTINE cp_sll_[nametype1]_rm_el_at(sll,index,error) TYPE(cp_sll_[nametype1]_type), POINTER :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error INTEGER, INTENT(in)::index LOGICAL :: failure @@ -1032,7 +1032,7 @@ CPSourceFileRef,& !!*** ********************************************************************** SUBROUTINE cp_sll_[nametype1]_rm_all_el(sll,error) TYPE(cp_sll_[nametype1]_type), POINTER :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure CHARACTER(len=*), PARAMETER :: routineP='cp_linked_list_[nametype1]/cp_sll_[nametype1]_rm_all_el' @@ -1076,7 +1076,7 @@ CPSourceFileRef,& !!*** ********************************************************************** FUNCTION cp_sll_[nametype1]_to_array(sll,error) RESULT(res) TYPE(cp_sll_[nametype1]_type), POINTER :: sll - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error [type1arrayEl], DIMENSION(:), POINTER :: res LOGICAL :: failure @@ -1126,7 +1126,7 @@ END FUNCTION cp_sll_[nametype1]_to_array !!*** ********************************************************************** FUNCTION cp_sll_[nametype1]_from_array(array,error) RESULT(res) [type1arrayEl], DIMENSION(:), INTENT(in) :: array - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error TYPE(cp_sll_[nametype1]_type), POINTER :: res LOGICAL :: failure @@ -1188,7 +1188,7 @@ SUBROUTINE cp_sll_[nametype1]_insert_ordered(sll,el,insert_equals,& LOGICAL, OPTIONAL, INTENT(in) :: insert_equals LOGICAL, OPTIONAL, INTENT(out) :: did_insert TYPE(cp_sll_[nametype1]_type), POINTER, OPTIONAL :: pos - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure,i_eq CHARACTER(len=*), PARAMETER :: routineN='cp_sll_[nametype1]_insert_ordered',& @@ -1205,9 +1205,9 @@ SUBROUTINE cp_sll_[nametype1]_insert_ordered(sll,el,insert_equals,& CALL cp_sll_[nametype1]_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.[lessQ](sll%first_el,el)) THEN + ELSE IF (.NOT.[lessQ](sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.[lessQ](el,sll%first_el)) THEN + IF (i_eq.OR.[lessQ](el,sll%first_el,error=error)) THEN CALL cp_sll_[nametype1]_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1220,16 +1220,16 @@ SUBROUTINE cp_sll_[nametype1]_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.[lessQ](iter%rest%first_el,el)) THEN + ELSE IF (.NOT.[lessQ](iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. [lessQ](el,iter%rest%first_el)) THEN + IF (i_eq.OR. [lessQ](el,iter%rest%first_el,error=error)) THEN CALL cp_sll_[nametype1]_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest END IF EXIT END IF - CPInvariant(cp_sll_[nametype1]_next(iter),cp_failure_level,routineP,error,failure) + CPInvariant(cp_sll_[nametype1]_next(iter,error=error),cp_failure_level,routineP,error,failure) END DO CPAssert(ASSOCIATED(iter),cp_failure_level,routineP,error,failure) END IF @@ -1279,7 +1279,7 @@ SUBROUTINE cp_sll_[nametype1]_insert_ordered2(sll,el,compare_function,& LOGICAL, OPTIONAL, INTENT(in) :: insert_equals LOGICAL, OPTIONAL, INTENT(out) :: did_insert TYPE(cp_sll_[nametype1]_type), POINTER, OPTIONAL :: pos - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure,i_eq CHARACTER(len=*), PARAMETER :: routineN='cp_sll_[nametype1]_insert_ordered2',& @@ -1324,7 +1324,7 @@ SUBROUTINE cp_sll_[nametype1]_insert_ordered2(sll,el,compare_function,& END IF EXIT END IF - CPInvariant(cp_sll_[nametype1]_next(iter),cp_failure_level,routineP,error,failure) + CPInvariant(cp_sll_[nametype1]_next(iter,error=error),cp_failure_level,routineP,error,failure) END DO CPAssert(ASSOCIATED(iter),cp_failure_level,routineP,error,failure) END IF @@ -1362,7 +1362,7 @@ FUNCTION cp_sll_[nametype1]_contains(sll,el,ordered,error) RESULT(res) TYPE(cp_sll_[nametype1]_type), POINTER :: sll [type1in] :: el LOGICAL, INTENT(in), OPTIONAL :: ordered - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure,ord CHARACTER(len=*), PARAMETER :: routineN='cp_sll_[nametype1]_contains',& @@ -1377,15 +1377,15 @@ FUNCTION cp_sll_[nametype1]_contains(sll,el,ordered,error) RESULT(res) IF (ord) THEN DO IF (.NOT.cp_sll_[nametype1]_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.[lessQ](el_att,el)) THEN - res=.NOT.[lessQ](el,el_att) + IF (.NOT.[lessQ](el_att,el,error=error)) THEN + res=.NOT.[lessQ](el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_[nametype1]_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.[equalQ](el_att,el)) THEN + IF (.NOT.[equalQ](el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1436,7 +1436,7 @@ FUNCTION cp_sll_[nametype1]_contains2(sll,el,compare_function,ordered,error)& END FUNCTION compare_function END INTERFACE LOGICAL, INTENT(in), OPTIONAL :: ordered - TYPE(cp_error_type), OPTIONAL, INTENT(inout) :: error + TYPE(cp_error_type), INTENT(inout) :: error LOGICAL :: failure INTEGER :: comp diff --git a/src/cp_linked_list_char.F b/src/cp_linked_list_char.F index 5dad6a97cc..2c2dceabc9 100644 --- a/src/cp_linked_list_char.F +++ b/src/cp_linked_list_char.F @@ -3,8 +3,8 @@ ! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! -#define CP_SLL_C_LESS_Q(el1,el2) ( el1 < el2 ) -#define CP_SLL_C_EQUAL_Q(el1,el2) ( el1 == el2 ) +#define CP_SLL_C_LESS_Q(el1,el2,error) ( el1 < el2 ) +#define CP_SLL_C_EQUAL_Q(el1,el2,error) ( el1 == el2 ) !!****h* cp2k/cp_linked_list_char [1.0] * !! @@ -1283,9 +1283,9 @@ SUBROUTINE cp_sll_char_insert_ordered(sll,el,insert_equals,& CALL cp_sll_char_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_C_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_C_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_C_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_C_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_char_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1298,9 +1298,9 @@ SUBROUTINE cp_sll_char_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_C_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_C_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_C_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_C_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_char_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1462,15 +1462,15 @@ FUNCTION cp_sll_char_contains(sll,el,ordered,error) RESULT(res) IF (ord) THEN DO IF (.NOT.cp_sll_char_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_C_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_C_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_C_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_C_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_char_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_C_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_C_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1566,8 +1566,8 @@ END FUNCTION cp_sll_char_contains2 ! array= = "=" ! arrayEl = "" ! defines = -! "#define CP_SLL_C_LESS_Q(el1,el2) ( el1 < el2 ) -! #define CP_SLL_C_EQUAL_Q(el1,el2) ( el1 == el2 ) +! "#define CP_SLL_C_LESS_Q(el1,el2,error) ( el1 < el2 ) +! #define CP_SLL_C_EQUAL_Q(el1,el2,error) ( el1 == el2 ) ! " ! equalQ = "CP_SLL_C_EQUAL_Q" ! lessQ = "CP_SLL_C_LESS_Q" @@ -1576,7 +1576,7 @@ END FUNCTION cp_sll_char_contains2 ! "subroutine write_string(str,unit_nr,error) ! character(len=*),intent(in) :: str ! integer, intent(in) :: unit_nr -! type(cp_error_type), intent(inout), optional :: error +! type(cp_error_type), intent(inout) :: error ! ! write(unit_nr,"(a,a,a)") '"',trim(str),'"' ! end subroutine write_string diff --git a/src/cp_linked_list_fm.F b/src/cp_linked_list_fm.F index ab8896e820..b3825b3a27 100644 --- a/src/cp_linked_list_fm.F +++ b/src/cp_linked_list_fm.F @@ -4,8 +4,8 @@ !-----------------------------------------------------------------------------! ! less not much meningful... -#define CP_SLL_FM_LESS_Q(el1,el2) ( el1 %id_nr < el2 %id_nr ) -#define CP_SLL_FM_EQUAL_Q(el1,el2) ( el1 %id_nr == el2 %id_nr ) +#define CP_SLL_FM_LESS_Q(el1,el2,error) ( el1 %id_nr < el2 %id_nr ) +#define CP_SLL_FM_EQUAL_Q(el1,el2,error) ( el1 %id_nr == el2 %id_nr ) !!****h* cp2k/cp_linked_list_fm [1.0] * !! @@ -1267,9 +1267,9 @@ SUBROUTINE cp_sll_fm_insert_ordered(sll,el,insert_equals,& CALL cp_sll_fm_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_FM_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_FM_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_FM_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_FM_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_fm_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1282,9 +1282,9 @@ SUBROUTINE cp_sll_fm_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_FM_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_FM_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_FM_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_FM_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_fm_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1444,15 +1444,15 @@ FUNCTION cp_sll_fm_contains(sll,el,ordered,error) RESULT(res) IF (ord) THEN DO IF (.NOT.cp_sll_fm_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_FM_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_FM_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_FM_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_FM_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_fm_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_FM_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_FM_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1551,8 +1551,8 @@ END FUNCTION cp_sll_fm_contains2 ! arrayEl = "%matrix" ! defines = ! "! less not much meningful... -! #define CP_SLL_FM_LESS_Q(el1,el2) ( el1 %id_nr < el2 %id_nr ) -! #define CP_SLL_FM_EQUAL_Q(el1,el2) ( el1 %id_nr == el2 %id_nr ) +! #define CP_SLL_FM_LESS_Q(el1,el2,error) ( el1 %id_nr < el2 %id_nr ) +! #define CP_SLL_FM_EQUAL_Q(el1,el2,error) ( el1 %id_nr == el2 %id_nr ) ! " ! equalQ = "CP_SLL_FM_EQUAL_Q" ! lessQ = "CP_SLL_FM_LESS_Q" diff --git a/src/cp_linked_list_int.F b/src/cp_linked_list_int.F index 467685a8a8..d90ea6de97 100644 --- a/src/cp_linked_list_int.F +++ b/src/cp_linked_list_int.F @@ -3,8 +3,8 @@ ! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! -#define CP_SLL_I_LESS_Q(el1,el2) ( el1 < el2 ) -#define CP_SLL_I_EQUAL_Q(el1,el2) ( el1 == el2 ) +#define CP_SLL_I_LESS_Q(el1,el2,error) ( el1 < el2 ) +#define CP_SLL_I_EQUAL_Q(el1,el2,error) ( el1 == el2 ) !!****h* cp2k/cp_linked_list_int [1.0] * !! @@ -1260,9 +1260,9 @@ SUBROUTINE cp_sll_int_insert_ordered(sll,el,insert_equals,& CALL cp_sll_int_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_I_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_I_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_I_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_I_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_int_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1275,9 +1275,9 @@ SUBROUTINE cp_sll_int_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_I_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_I_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_I_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_I_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_int_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1436,15 +1436,15 @@ FUNCTION cp_sll_int_contains(sll,el,ordered,error) RESULT(res) IF (ord) THEN DO IF (.NOT.cp_sll_int_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_I_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_I_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_I_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_I_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_int_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_I_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_I_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1538,8 +1538,8 @@ END FUNCTION cp_sll_int_contains2 ! array= = "=" ! arrayEl = "" ! defines = -! "#define CP_SLL_I_LESS_Q(el1,el2) ( el1 < el2 ) -! #define CP_SLL_I_EQUAL_Q(el1,el2) ( el1 == el2 ) +! "#define CP_SLL_I_LESS_Q(el1,el2,error) ( el1 < el2 ) +! #define CP_SLL_I_EQUAL_Q(el1,el2,error) ( el1 == el2 ) ! " ! equalQ = "CP_SLL_I_EQUAL_Q" ! lessQ = "CP_SLL_I_LESS_Q" diff --git a/src/cp_linked_list_logical.F b/src/cp_linked_list_logical.F index 9d796f56c6..a1cd7d395d 100644 --- a/src/cp_linked_list_logical.F +++ b/src/cp_linked_list_logical.F @@ -3,8 +3,8 @@ ! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! -#define CP_SLL_L_LESS_Q(el1,el2) ( .not.el1.and.el2 ) -#define CP_SLL_L_EQUAL_Q(el1,el2) ( el1.EQV.el2 ) +#define CP_SLL_L_LESS_Q(el1,el2,error) ( .not.el1.and.el2 ) +#define CP_SLL_L_EQUAL_Q(el1,el2,error) ( el1.EQV.el2 ) !!****h* cp2k/cp_linked_list_logical [1.0] * !! @@ -1266,9 +1266,9 @@ SUBROUTINE cp_sll_logical_insert_ordered(sll,el,insert_equals,& CALL cp_sll_logical_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_L_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_L_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_L_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_L_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_logical_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1281,9 +1281,9 @@ SUBROUTINE cp_sll_logical_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_L_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_L_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_L_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_L_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_logical_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1443,15 +1443,15 @@ FUNCTION cp_sll_logical_contains(sll,el,ordered,error) RESULT(res) IF (ord) THEN DO IF (.NOT.cp_sll_logical_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_L_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_L_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_L_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_L_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_logical_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_L_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_L_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1545,8 +1545,8 @@ END FUNCTION cp_sll_logical_contains2 ! array= = "=" ! arrayEl = "" ! defines = -! "#define CP_SLL_L_LESS_Q(el1,el2) ( .not.el1.and.el2 ) -! #define CP_SLL_L_EQUAL_Q(el1,el2) ( el1.EQV.el2 ) +! "#define CP_SLL_L_LESS_Q(el1,el2,error) ( .not.el1.and.el2 ) +! #define CP_SLL_L_EQUAL_Q(el1,el2,error) ( el1.EQV.el2 ) ! " ! equalQ = "CP_SLL_L_EQUAL_Q" ! lessQ = "CP_SLL_L_LESS_Q" diff --git a/src/cp_linked_list_pw.F b/src/cp_linked_list_pw.F index b7ceaefc16..7caa1806fb 100644 --- a/src/cp_linked_list_pw.F +++ b/src/cp_linked_list_pw.F @@ -4,8 +4,8 @@ !-----------------------------------------------------------------------------! ! less not much meaningful... -#define CP_SLL_PW_LESS_Q(el1,el2) ( el1 %id_nr < el2 %id_nr ) -#define CP_SLL_PW_EQUAL_Q(el1,el2) ( el1 %id_nr == el2 %id_nr ) +#define CP_SLL_PW_LESS_Q(el1,el2,error) ( el1 %id_nr < el2 %id_nr ) +#define CP_SLL_PW_EQUAL_Q(el1,el2,error) ( el1 %id_nr == el2 %id_nr ) !!****h* cp2k/cp_linked_list_pw [1.0] * !! @@ -1267,9 +1267,9 @@ SUBROUTINE cp_sll_pw_insert_ordered(sll,el,insert_equals,& CALL cp_sll_pw_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_PW_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_PW_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_PW_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_PW_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_pw_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1282,9 +1282,9 @@ SUBROUTINE cp_sll_pw_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_PW_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_PW_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_PW_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_PW_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_pw_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1444,15 +1444,15 @@ FUNCTION cp_sll_pw_contains(sll,el,ordered,error) RESULT(res) IF (ord) THEN DO IF (.NOT.cp_sll_pw_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_PW_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_PW_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_PW_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_PW_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_pw_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_PW_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_PW_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1551,8 +1551,8 @@ END FUNCTION cp_sll_pw_contains2 ! arrayEl = "%pw" ! defines = ! "! less not much meaningful... -! #define CP_SLL_PW_LESS_Q(el1,el2) ( el1 %id_nr < el2 %id_nr ) -! #define CP_SLL_PW_EQUAL_Q(el1,el2) ( el1 %id_nr == el2 %id_nr ) +! #define CP_SLL_PW_LESS_Q(el1,el2,error) ( el1 %id_nr < el2 %id_nr ) +! #define CP_SLL_PW_EQUAL_Q(el1,el2,error) ( el1 %id_nr == el2 %id_nr ) ! " ! equalQ = "CP_SLL_PW_EQUAL_Q" ! lessQ = "CP_SLL_PW_LESS_Q" diff --git a/src/cp_linked_list_real.F b/src/cp_linked_list_real.F index addf6e0e66..6b4656c607 100644 --- a/src/cp_linked_list_real.F +++ b/src/cp_linked_list_real.F @@ -3,8 +3,8 @@ ! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! -#define CP_SLL_R_LESS_Q(el1,el2) ( el1 < el2 ) -#define CP_SLL_R_EQUAL_Q(el1,el2) ( el1 == el2 ) +#define CP_SLL_R_LESS_Q(el1,el2,error) ( el1 < el2 ) +#define CP_SLL_R_EQUAL_Q(el1,el2,error) ( el1 == el2 ) !!****h* cp2k/cp_linked_list_real [1.0] * !! @@ -1266,9 +1266,9 @@ SUBROUTINE cp_sll_real_insert_ordered(sll,el,insert_equals,& CALL cp_sll_real_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_R_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_R_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_R_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_R_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_real_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1281,9 +1281,9 @@ SUBROUTINE cp_sll_real_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_R_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_R_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_R_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_R_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_real_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1443,15 +1443,15 @@ FUNCTION cp_sll_real_contains(sll,el,ordered,error) RESULT(res) IF (ord) THEN DO IF (.NOT.cp_sll_real_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_R_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_R_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_R_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_R_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_real_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_R_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_R_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1546,8 +1546,8 @@ END FUNCTION cp_sll_real_contains2 ! array= = "=" ! arrayEl = "" ! defines = -! "#define CP_SLL_R_LESS_Q(el1,el2) ( el1 < el2 ) -! #define CP_SLL_R_EQUAL_Q(el1,el2) ( el1 == el2 ) +! "#define CP_SLL_R_LESS_Q(el1,el2,error) ( el1 < el2 ) +! #define CP_SLL_R_EQUAL_Q(el1,el2,error) ( el1 == el2 ) ! " ! equalQ = "CP_SLL_R_EQUAL_Q" ! lessQ = "CP_SLL_R_LESS_Q" diff --git a/src/cp_linked_list_rs.F b/src/cp_linked_list_rs.F index 7d2bb97d18..3a61176e7d 100644 --- a/src/cp_linked_list_rs.F +++ b/src/cp_linked_list_rs.F @@ -4,8 +4,8 @@ !-----------------------------------------------------------------------------! ! less not much meningful... -#define CP_SLL_RS_LESS_Q(el1,el2) ( el1%id_nr < el2%id_nr ) -#define CP_SLL_RS_EQUAL_Q(el1,el2) ( el1%id_nr == el2%id_nr ) +#define CP_SLL_RS_LESS_Q(el1,el2,error) ( el1%id_nr < el2%id_nr ) +#define CP_SLL_RS_EQUAL_Q(el1,el2,error) ( el1%id_nr == el2%id_nr ) !!****h* cp2k/cp_linked_list_rs [1.0] * !! @@ -1271,9 +1271,9 @@ SUBROUTINE cp_sll_rs_insert_ordered(sll,el,insert_equals,& CALL cp_sll_rs_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_RS_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_RS_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_RS_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_RS_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_rs_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1286,9 +1286,9 @@ SUBROUTINE cp_sll_rs_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_RS_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_RS_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_RS_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_RS_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_rs_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1448,15 +1448,15 @@ FUNCTION cp_sll_rs_contains(sll,el,ordered,error) RESULT(res) IF (ord) THEN DO IF (.NOT.cp_sll_rs_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_RS_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_RS_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_RS_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_RS_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_rs_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_RS_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_RS_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1555,8 +1555,8 @@ END FUNCTION cp_sll_rs_contains2 ! arrayEl = "%rs_grid" ! defines = ! "! less not much meningful... -! #define CP_SLL_RS_LESS_Q(el1,el2) ( el1%id_nr < el2%id_nr ) -! #define CP_SLL_RS_EQUAL_Q(el1,el2) ( el1%id_nr == el2%id_nr ) +! #define CP_SLL_RS_LESS_Q(el1,el2,error) ( el1%id_nr < el2%id_nr ) +! #define CP_SLL_RS_EQUAL_Q(el1,el2,error) ( el1%id_nr == el2%id_nr ) ! " ! equalQ = "CP_SLL_RS_EQUAL_Q" ! lessQ = "CP_SLL_RS_LESS_Q" diff --git a/src/cp_linked_list_sm.F b/src/cp_linked_list_sm.F index b3b2ed8ef0..d12e2a2fde 100644 --- a/src/cp_linked_list_sm.F +++ b/src/cp_linked_list_sm.F @@ -4,8 +4,8 @@ !-----------------------------------------------------------------------------! ! less not much meningful... -#define CP_SLL_SM_LESS_Q(el1,el2) ( cp_sm_get_id_nr(el1,error=error) < cp_sm_get_id_nr(el2,error=error) ) -#define CP_SLL_SM_EQUAL_Q(el1,el2) ( cp_sm_get_id_nr(el1,error=error) == cp_sm_get_id_nr(el2,error=error) ) +#define CP_SLL_SM_LESS_Q(el1,el2,error) ( cp_sm_get_id_nr(el1,error) < cp_sm_get_id_nr(el2,error) ) +#define CP_SLL_SM_EQUAL_Q(el1,el2,error) ( cp_sm_get_id_nr(el1,error) == cp_sm_get_id_nr(el2,error) ) !!****h* cp2k/cp_linked_list_sm [1.0] * !! @@ -20,24 +20,24 @@ !! An empty list is represented by an unassociated pointer. !! !! NOTES -!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ +!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ !! | _ \ ___ _ __ ( ) |_ | \/ | ___ __| (_)/ _|_ _ |_ _| |__ (_)___ | ___(_) | ___| | !! | | | |/ _ \| '_ \|/| __| | |\/| |/ _ \ / _` | | |_| | | | | | | '_ \| / __| | |_ | | |/ _ \ | !! | |_| | (_) | | | | | |_ | | | | (_) | (_| | | _| |_| | | | | | | | \__ \ | _| | | | __/_| !! |____/ \___/|_| |_| \__| |_| |_|\___/ \__,_|_|_| \__, | |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! |___/ -!! ____ _ ___ _ _ _ _ -!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ +!! |___/ +!! ____ _ ___ _ _ _ _ +!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ !! | | | |/ _ \/ __|/ _ \ | || '_ ` _ \| '_ ` _ \ / _ \/ _` | |/ _` | __/ _ \ | | | | !! | |___| | (_) \__ \ __/ | || | | | | | | | | | | __/ (_| | | (_| | || __/ | |_| | !! \____|_|\___/|___/\___| |___|_| |_| |_|_| |_| |_|\___|\__,_|_|\__,_|\__\___|_|\__, | -!! |___/ -!! _____ _ _ _____ _ _ _ +!! |___/ +!! _____ _ _ _____ _ _ _ !! |_ _| |__ (_)___ | ___(_) | ___| | !! | | | '_ \| / __| | |_ | | |/ _ \ | !! | | | | | | \__ \ | _| | | | __/_| !! |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! +!! !! This is a template !! !! **** DO NOT MODIFY THE .F FILES **** @@ -48,7 +48,7 @@ !! !! MODIFICATION HISTORY !! 1.2002 created -!! 4.2002 changed most of the methods, by making access to the list +!! 4.2002 changed most of the methods, by making access to the list !! always through pointers (identifying pointer, list and iterators) !! 6.2004 removed %initialized from list elements !! @@ -183,21 +183,21 @@ MODULE cp_linked_list_sm !! represent a single linked list that stores pointers to the elements !! !! NOTES -!! List are alway accessed through pointers, so every node of the +!! List are alway accessed through pointers, so every node of the !! linked list can be seen as a list, its first element !! a pointer to the position before itself, in a very natural way: -!! all the insertions take place before the actual element, and +!! all the insertions take place before the actual element, and !! you still can insert an element at the end. !! This way I could identify nodes, lists and pointers between the !! elements of the list. !! Indexing is 1 based. !! !! ATTRIBUTES -!! first_el: the element that is stored in this node. +!! first_el: the element that is stored in this node. !! rest: the rest of the list !! !! empty: true if the list pointer is not associated, if it points to -!! to a not it is always false (as there is at least the +!! to a not it is always false (as there is at least the !! first_el in the list) !! length: the number of elements in the list !! @@ -264,8 +264,8 @@ CONTAINS !! sll: the single linked list to initialize !! first_el: the first element of this list !! rest: the following elements (if not given: empty) -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -320,8 +320,8 @@ CONTAINS !! !! INPUTS !! sll: the list to be deallocated -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -356,8 +356,8 @@ CONTAINS !! !! INPUTS !! sll: the node to be deallocated -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -392,7 +392,7 @@ CONTAINS !! !! FUNCTION !! sets tha various attributes of a single linked list -!! It is an error to set the rest of an empty list without setting +!! It is an error to set the rest of an empty list without setting !! the first_el (change and make it simply a sll=>rest ?) !! !! NOTES @@ -402,8 +402,8 @@ CONTAINS !! sll: the single linked list to change !! first_el: the element to replace the first element of this list !! rest: the rest of the list (can be unassociated) -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -455,8 +455,8 @@ CONTAINS !! first_el: the first element of this list (can be unassociated) !! rest: the rest of the list (can be unassociated) !! length: the length of the list -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -509,8 +509,8 @@ CONTAINS !! !! INPUTS !! sll: the single linked list to get the element from -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -555,8 +555,8 @@ CONTAINS !! sll: the single linked list to get the rest from !! iter: how many times the call to rest should be iterated, !! defaults to 1; -1 means till end of the list. -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -624,8 +624,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the single linked list to get the rest from -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -663,8 +663,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list you want to know the length of -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -713,8 +713,8 @@ CPSourceFileRef,& !! INPUTS !! sll: the list you get the element from !! index: the position of the element (stating at 1) -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -768,8 +768,8 @@ CPSourceFileRef,& !! index: the position of the element (stating at 1) !! -1 means at the end !! value: the new element -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -820,8 +820,8 @@ CPSourceFileRef,& !! !! INPUTS !! iterator: iterator that moves along the list -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! el_att: the actual element (valid only if the function returns true) !! !! AUTHOR @@ -869,11 +869,11 @@ CPSourceFileRef,& !! fast (O(1)) !! !! INPUTS -!! sll: the single linked list point at the beginning of which +!! sll: the single linked list point at the beginning of which !! you want to add the element !! el: the element to add -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -915,8 +915,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list whose first element has to be removed -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -963,11 +963,11 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list you get the element from -!! index: the position of the element (stating at 1). +!! index: the position of the element (stating at 1). !! If it is -1, it means at end !! el: the new element -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1021,8 +1021,8 @@ CPSourceFileRef,& !! sll: the list you get the element from !! index: the position of the element (stating at 1) !! el: the new element -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1043,7 +1043,7 @@ CPSourceFileRef,& TYPE(cp_sll_sm_type), POINTER :: pos failure=.FALSE. - + IF (cp_debug) THEN CPPrecondition(index>0.OR.index==-1,cp_failure_level,routineP,error,failure) END IF @@ -1076,8 +1076,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list that should be removed -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1123,8 +1123,8 @@ CPSourceFileRef,& !! !! INPUTS !! - sll: the list to trasform in array -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1147,7 +1147,7 @@ FUNCTION cp_sll_sm_to_array(sll,error) RESULT(res) TYPE(cp_sll_sm_type), POINTER :: iter failure=.FALSE. - + len=cp_sll_sm_get_length(sll,error) ALLOCATE(res(len),stat=stat) CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) @@ -1176,8 +1176,8 @@ END FUNCTION cp_sll_sm_to_array !! !! INPUTS !! - array: the array you want to copy -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1200,7 +1200,7 @@ FUNCTION cp_sll_sm_from_array(array,error) RESULT(res) TYPE(cp_sll_sm_type), POINTER :: last_el failure=.FALSE. - + NULLIFY(res,last_el) IF (SIZE(array)>0) THEN CALL cp_sll_sm_create(res,& @@ -1236,8 +1236,8 @@ END FUNCTION cp_sll_sm_from_array !! - did_insert: true if it did insert the element !! - pos: node where the element has been inserted (or of the same !! element that was already in the list) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1263,7 +1263,7 @@ SUBROUTINE cp_sll_sm_insert_ordered(sll,el,insert_equals,& failure=.FALSE. i_eq=.FALSE. - + IF (PRESENT(did_insert)) did_insert=.FALSE. IF (PRESENT(pos)) NULLIFY(pos) @@ -1272,9 +1272,9 @@ SUBROUTINE cp_sll_sm_insert_ordered(sll,el,insert_equals,& CALL cp_sll_sm_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_SM_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_SM_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_SM_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_SM_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_sm_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1287,9 +1287,9 @@ SUBROUTINE cp_sll_sm_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_SM_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_SM_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_SM_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_SM_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_sm_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1322,8 +1322,8 @@ END SUBROUTINE cp_sll_sm_insert_ordered !! than the second, 0 if they are equal, otherwise a positive number !! - insert_equals: if equal elements should be inserted !! (defaults to false) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1359,7 +1359,7 @@ USE sparse_matrix_types, ONLY: real_matrix_type, real_matrix_p_type,& failure=.FALSE. i_eq=.FALSE. - + IF (PRESENT(did_insert)) did_insert=.FALSE. IF (PRESENT(pos)) NULLIFY(pos) @@ -1418,8 +1418,8 @@ END SUBROUTINE cp_sll_sm_insert_ordered2 !! - el: the element to control !! - ordered: if true assumes that the list is ordered in growing order. !! (defaults to false) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1444,21 +1444,21 @@ FUNCTION cp_sll_sm_contains(sll,el,ordered,error) RESULT(res) failure=.FALSE.; ord=.FALSE. res=.FALSE. - + iter => sll IF (PRESENT(ordered)) ord=ordered IF (ord) THEN DO IF (.NOT.cp_sll_sm_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_SM_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_SM_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_SM_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_SM_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_sm_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_SM_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_SM_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1486,8 +1486,8 @@ END FUNCTION cp_sll_sm_contains !! than the second, 0 if they are equal, otherwise a positive number !! - ordered: if true assumes that the list is ordered in growing order. !! (defaults to false) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1523,7 +1523,7 @@ USE sparse_matrix_types, ONLY: real_matrix_type, real_matrix_p_type,& failure=.FALSE. res=.FALSE. - + iter => sll IF (ordered) THEN DO @@ -1546,21 +1546,21 @@ USE sparse_matrix_types, ONLY: real_matrix_type, real_matrix_p_type,& END FUNCTION cp_sll_sm_contains2 !*************************************************************************** -! template def put here so that line numbers in template and derived +! template def put here so that line numbers in template and derived ! files are almost the same (multi-line use change it a bit) ! [template(defines,nametype1,type1,type1in,type1out,type1arrayEl,arrayEl,array=,=,USE,write_el,lessQ,equalQ,private_routines)] ! ARGS: ! = = "=>" -! USE = +! USE = ! "USE kinds, only: dp ! USE sparse_matrix_types, ONLY: real_matrix_type, real_matrix_p_type,& ! cp_sm_get_id_nr" ! array= = "=>" ! arrayEl = "%matrix" -! defines = +! defines = ! "! less not much meningful... -! #define CP_SLL_SM_LESS_Q(el1,el2) ( cp_sm_get_id_nr(el1) < cp_sm_get_id_nr(el2) ) -! #define CP_SLL_SM_EQUAL_Q(el1,el2) ( cp_sm_get_id_nr(el1) == cp_sm_get_id_nr(el2) ) +! #define CP_SLL_SM_LESS_Q(el1,el2,error) ( cp_sm_get_id_nr(el1,error) < cp_sm_get_id_nr(el2,error) ) +! #define CP_SLL_SM_EQUAL_Q(el1,el2,error) ( cp_sm_get_id_nr(el1,error) == cp_sm_get_id_nr(el2,error) ) ! " ! equalQ = "CP_SLL_SM_EQUAL_Q" ! lessQ = "CP_SLL_SM_LESS_Q" diff --git a/src/cp_linked_list_val.F b/src/cp_linked_list_val.F index c6185494cd..a93b2564d9 100644 --- a/src/cp_linked_list_val.F +++ b/src/cp_linked_list_val.F @@ -3,8 +3,8 @@ ! Copyright (C) 2000 - 2007 CP2K developers group ! !-----------------------------------------------------------------------------! -#define CP_SLL_VAL_LESS_Q(el1,el2) el1%id_nrrest ?) !! !! NOTES @@ -398,8 +398,8 @@ CONTAINS !! sll: the single linked list to change !! first_el: the element to replace the first element of this list !! rest: the rest of the list (can be unassociated) -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -450,8 +450,8 @@ CONTAINS !! first_el: the first element of this list (can be unassociated) !! rest: the rest of the list (can be unassociated) !! length: the length of the list -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -503,8 +503,8 @@ CONTAINS !! !! INPUTS !! sll: the single linked list to get the element from -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -549,8 +549,8 @@ CONTAINS !! sll: the single linked list to get the rest from !! iter: how many times the call to rest should be iterated, !! defaults to 1; -1 means till end of the list. -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -618,8 +618,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the single linked list to get the rest from -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -657,8 +657,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list you want to know the length of -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -707,8 +707,8 @@ CPSourceFileRef,& !! INPUTS !! sll: the list you get the element from !! index: the position of the element (stating at 1) -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -762,8 +762,8 @@ CPSourceFileRef,& !! index: the position of the element (stating at 1) !! -1 means at the end !! value: the new element -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -814,8 +814,8 @@ CPSourceFileRef,& !! !! INPUTS !! iterator: iterator that moves along the list -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! el_att: the actual element (valid only if the function returns true) !! !! AUTHOR @@ -862,11 +862,11 @@ CPSourceFileRef,& !! fast (O(1)) !! !! INPUTS -!! sll: the single linked list point at the beginning of which +!! sll: the single linked list point at the beginning of which !! you want to add the element !! el: the element to add -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -908,8 +908,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list whose first element has to be removed -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -956,11 +956,11 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list you get the element from -!! index: the position of the element (stating at 1). +!! index: the position of the element (stating at 1). !! If it is -1, it means at end !! el: the new element -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1014,8 +1014,8 @@ CPSourceFileRef,& !! sll: the list you get the element from !! index: the position of the element (stating at 1) !! el: the new element -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1036,7 +1036,7 @@ CPSourceFileRef,& TYPE(cp_sll_val_type), POINTER :: pos failure=.FALSE. - + IF (cp_debug) THEN CPPrecondition(index>0.OR.index==-1,cp_failure_level,routineP,error,failure) END IF @@ -1069,8 +1069,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list that should be removed -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1116,8 +1116,8 @@ CPSourceFileRef,& !! !! INPUTS !! - sll: the list to trasform in array -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1139,7 +1139,7 @@ FUNCTION cp_sll_val_to_array(sll,error) RESULT(res) TYPE(cp_sll_val_type), POINTER :: iter failure=.FALSE. - + len=cp_sll_val_get_length(sll,error) ALLOCATE(res(len),stat=stat) CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) @@ -1168,8 +1168,8 @@ END FUNCTION cp_sll_val_to_array !! !! INPUTS !! - array: the array you want to copy -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1192,7 +1192,7 @@ FUNCTION cp_sll_val_from_array(array,error) RESULT(res) TYPE(cp_sll_val_type), POINTER :: last_el failure=.FALSE. - + NULLIFY(res,last_el) IF (SIZE(array)>0) THEN CALL cp_sll_val_create(res,& @@ -1228,8 +1228,8 @@ END FUNCTION cp_sll_val_from_array !! - did_insert: true if it did insert the element !! - pos: node where the element has been inserted (or of the same !! element that was already in the list) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1255,7 +1255,7 @@ SUBROUTINE cp_sll_val_insert_ordered(sll,el,insert_equals,& failure=.FALSE. i_eq=.FALSE. - + IF (PRESENT(did_insert)) did_insert=.FALSE. IF (PRESENT(pos)) NULLIFY(pos) @@ -1264,9 +1264,9 @@ SUBROUTINE cp_sll_val_insert_ordered(sll,el,insert_equals,& CALL cp_sll_val_create(sll,first_el=el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll - ELSE IF (.NOT.CP_SLL_VAL_LESS_Q(sll%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_VAL_LESS_Q(sll%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>sll - IF (i_eq.OR.CP_SLL_VAL_LESS_Q(el,sll%first_el)) THEN + IF (i_eq.OR.CP_SLL_VAL_LESS_Q(el,sll%first_el,error=error)) THEN CALL cp_sll_val_insert_el(sll,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>sll @@ -1279,9 +1279,9 @@ SUBROUTINE cp_sll_val_insert_ordered(sll,el,insert_equals,& IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest EXIT - ELSE IF (.NOT.CP_SLL_VAL_LESS_Q(iter%rest%first_el,el)) THEN + ELSE IF (.NOT.CP_SLL_VAL_LESS_Q(iter%rest%first_el,el,error=error)) THEN IF (PRESENT(pos)) pos=>iter - IF (i_eq.OR. CP_SLL_VAL_LESS_Q(el,iter%rest%first_el)) THEN + IF (i_eq.OR. CP_SLL_VAL_LESS_Q(el,iter%rest%first_el,error=error)) THEN CALL cp_sll_val_insert_el(iter%rest,el,error=error) IF (PRESENT(did_insert)) did_insert=.TRUE. IF (PRESENT(pos)) pos=>iter%rest @@ -1314,8 +1314,8 @@ END SUBROUTINE cp_sll_val_insert_ordered !! than the second, 0 if they are equal, otherwise a positive number !! - insert_equals: if equal elements should be inserted !! (defaults to false) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1349,7 +1349,7 @@ SUBROUTINE cp_sll_val_insert_ordered2(sll,el,compare_function,& failure=.FALSE. i_eq=.FALSE. - + IF (PRESENT(did_insert)) did_insert=.FALSE. IF (PRESENT(pos)) NULLIFY(pos) @@ -1408,8 +1408,8 @@ END SUBROUTINE cp_sll_val_insert_ordered2 !! - el: the element to control !! - ordered: if true assumes that the list is ordered in growing order. !! (defaults to false) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1434,21 +1434,21 @@ FUNCTION cp_sll_val_contains(sll,el,ordered,error) RESULT(res) failure=.FALSE.; ord=.FALSE. res=.FALSE. - + iter => sll IF (PRESENT(ordered)) ord=ordered IF (ord) THEN DO IF (.NOT.cp_sll_val_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_VAL_LESS_Q(el_att,el)) THEN - res=.NOT.CP_SLL_VAL_LESS_Q(el,el_att) + IF (.NOT.CP_SLL_VAL_LESS_Q(el_att,el,error=error)) THEN + res=.NOT.CP_SLL_VAL_LESS_Q(el,el_att,error=error) RETURN END IF END DO ELSE DO IF (.NOT.cp_sll_val_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_VAL_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_VAL_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1476,8 +1476,8 @@ END FUNCTION cp_sll_val_contains !! than the second, 0 if they are equal, otherwise a positive number !! - ordered: if true assumes that the list is ordered in growing order. !! (defaults to false) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1511,7 +1511,7 @@ FUNCTION cp_sll_val_contains2(sll,el,compare_function,ordered,error)& failure=.FALSE. res=.FALSE. - + iter => sll IF (ordered) THEN DO @@ -1534,7 +1534,7 @@ FUNCTION cp_sll_val_contains2(sll,el,compare_function,ordered,error)& END FUNCTION cp_sll_val_contains2 !*************************************************************************** -! template def put here so that line numbers in template and derived +! template def put here so that line numbers in template and derived ! files are almost the same (multi-line use change it a bit) ! [template(defines,nametype1,type1,type1in,type1out,type1arrayEl,arrayEl,array=,=,USE,write_el,lessQ,equalQ,private_routines)] ! ARGS: @@ -1542,9 +1542,9 @@ END FUNCTION cp_sll_val_contains2 ! USE = "USE input_val_types, only: val_type, val_p_type" ! array= = "=>" ! arrayEl = "%val" -! defines = -! "#define CP_SLL_VAL_LESS_Q(el1,el2) el1%id_nrrest ?) !! !! NOTES @@ -417,8 +417,8 @@ END FUNCTION !! sll: the single linked list to change !! first_el: the element to replace the first element of this list !! rest: the rest of the list (can be unassociated) -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -471,8 +471,8 @@ END FUNCTION !! first_el: the first element of this list (can be unassociated) !! rest: the rest of the list (can be unassociated) !! length: the length of the list -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -526,8 +526,8 @@ END FUNCTION !! !! INPUTS !! sll: the single linked list to get the element from -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -572,8 +572,8 @@ END FUNCTION !! sll: the single linked list to get the rest from !! iter: how many times the call to rest should be iterated, !! defaults to 1; -1 means till end of the list. -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -641,8 +641,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the single linked list to get the rest from -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -680,8 +680,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list you want to know the length of -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -730,8 +730,8 @@ CPSourceFileRef,& !! INPUTS !! sll: the list you get the element from !! index: the position of the element (stating at 1) -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -785,8 +785,8 @@ CPSourceFileRef,& !! index: the position of the element (stating at 1) !! -1 means at the end !! value: the new element -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -837,8 +837,8 @@ CPSourceFileRef,& !! !! INPUTS !! iterator: iterator that moves along the list -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! el_att: the actual element (valid only if the function returns true) !! !! AUTHOR @@ -886,11 +886,11 @@ CPSourceFileRef,& !! fast (O(1)) !! !! INPUTS -!! sll: the single linked list point at the beginning of which +!! sll: the single linked list point at the beginning of which !! you want to add the element !! el: the element to add -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -932,8 +932,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list whose first element has to be removed -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -980,11 +980,11 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list you get the element from -!! index: the position of the element (stating at 1). +!! index: the position of the element (stating at 1). !! If it is -1, it means at end !! el: the new element -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1038,8 +1038,8 @@ CPSourceFileRef,& !! sll: the list you get the element from !! index: the position of the element (stating at 1) !! el: the new element -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1060,7 +1060,7 @@ CPSourceFileRef,& TYPE(cp_sll_xc_deriv_type), POINTER :: pos failure=.FALSE. - + IF (cp_debug) THEN CPPrecondition(index>0.OR.index==-1,cp_failure_level,routineP,error,failure) END IF @@ -1093,8 +1093,8 @@ CPSourceFileRef,& !! !! INPUTS !! sll: the list that should be removed -!! error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! @author Fawzi Mohamed @@ -1140,8 +1140,8 @@ CPSourceFileRef,& !! !! INPUTS !! - sll: the list to trasform in array -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1164,7 +1164,7 @@ FUNCTION cp_sll_xc_deriv_to_array(sll,error) RESULT(res) TYPE(cp_sll_xc_deriv_type), POINTER :: iter failure=.FALSE. - + len=cp_sll_xc_deriv_get_length(sll,error) ALLOCATE(res(len),stat=stat) CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) @@ -1193,8 +1193,8 @@ END FUNCTION cp_sll_xc_deriv_to_array !! !! INPUTS !! - array: the array you want to copy -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1217,7 +1217,7 @@ FUNCTION cp_sll_xc_deriv_from_array(array,error) RESULT(res) TYPE(cp_sll_xc_deriv_type), POINTER :: last_el failure=.FALSE. - + NULLIFY(res,last_el) IF (SIZE(array)>0) THEN CALL cp_sll_xc_deriv_create(res,& @@ -1253,8 +1253,8 @@ END FUNCTION cp_sll_xc_deriv_from_array !! - did_insert: true if it did insert the element !! - pos: node where the element has been inserted (or of the same !! element that was already in the list) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1282,7 +1282,7 @@ SUBROUTINE cp_sll_xc_deriv_insert_ordered(sll,el,insert_equals,& failure=.FALSE. i_eq=.FALSE. - + IF (PRESENT(did_insert)) did_insert=.FALSE. IF (PRESENT(pos)) NULLIFY(pos) @@ -1341,8 +1341,8 @@ END SUBROUTINE cp_sll_xc_deriv_insert_ordered !! than the second, 0 if they are equal, otherwise a positive number !! - insert_equals: if equal elements should be inserted !! (defaults to false) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1379,7 +1379,7 @@ USE xc_derivative_types, ONLY: xc_derivative_type,xc_derivative_p_type failure=.FALSE. i_eq=.FALSE. - + IF (PRESENT(did_insert)) did_insert=.FALSE. IF (PRESENT(pos)) NULLIFY(pos) @@ -1438,8 +1438,8 @@ END SUBROUTINE cp_sll_xc_deriv_insert_ordered2 !! - el: the element to control !! - ordered: if true assumes that the list is ordered in growing order. !! (defaults to false) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1464,7 +1464,7 @@ FUNCTION cp_sll_xc_deriv_contains(sll,el,ordered,error) RESULT(res) failure=.FALSE.; ord=.FALSE. res=.FALSE. - + iter => sll IF (PRESENT(ordered)) ord=ordered IF (ord) THEN @@ -1478,7 +1478,7 @@ FUNCTION cp_sll_xc_deriv_contains(sll,el,ordered,error) RESULT(res) ELSE DO IF (.NOT.cp_sll_xc_deriv_next(iter,el_att=el_att,error=error)) EXIT - IF (.NOT.CP_SLL_DERIV_EQUAL_Q(el_att,el)) THEN + IF (.NOT.CP_SLL_DERIV_EQUAL_Q(el_att,el,error)) THEN res=.TRUE. RETURN END IF @@ -1506,8 +1506,8 @@ END FUNCTION cp_sll_xc_deriv_contains !! than the second, 0 if they are equal, otherwise a positive number !! - ordered: if true assumes that the list is ordered in growing order. !! (defaults to false) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -1542,7 +1542,7 @@ USE xc_derivative_types, ONLY: xc_derivative_type,xc_derivative_p_type failure=.FALSE. res=.FALSE. - + iter => sll IF (ordered) THEN DO @@ -1565,33 +1565,33 @@ USE xc_derivative_types, ONLY: xc_derivative_type,xc_derivative_p_type END FUNCTION cp_sll_xc_deriv_contains2 !*************************************************************************** -! template def put here so that line numbers in template and derived +! template def put here so that line numbers in template and derived ! files are almost the same (multi-line use change it a bit) ! [template(defines,nametype1,type1,type1in,type1out,type1arrayEl,arrayEl,array=,=,USE,write_el,lessQ,equalQ,private_routines)] ! ARGS: ! = = "=>" -! USE = +! USE = ! "USE kinds, only: dp ! USE xc_derivative_types, only: xc_derivative_type,xc_derivative_p_type" ! array= = "=>" ! arrayEl = "%deriv" -! defines = -! "#define CP_SLL_DERIV_LESS_Q(el1,el2) cp_sll_deriv_less_q(el1,el2,error) -! #define CP_SLL_DERIV_EQUAL_Q(el1,el2) ( el1%desc == el2%desc ) +! defines = +! "#define CP_SLL_DERIV_LESS_Q(el1,el2,error) cp_sll_deriv_less_q(el1,el2,error) +! #define CP_SLL_DERIV_EQUAL_Q(el1,el2,error) ( el1%desc == el2%desc ) ! " ! equalQ = "CP_SLL_DERIV_EQUAL_Q" ! lessQ = "cp_sll_deriv_less_q" ! nametype1 = "xc_deriv" -! private_routines = +! private_routines = ! "!private compare function ! function cp_sll_deriv_less_q(el1,el2,error) result(res) ! type(xc_derivative_type), pointer :: el1,el2 -! type(cp_error_type), intent(inout), optional :: error +! type(cp_error_type), intent(inout) :: error ! logical :: res -! +! ! character(len=*),parameter :: routineN='cp_sll_deriv_less_q',& ! routineP=moduleN//':'//routineN -! +! ! CPPreconditionNoFail(associated(el1),cp_failure_level,routineP,error) ! CPPreconditionNoFail(associated(el1%split_desc),cp_failure_level,routineP,error) ! CPPreconditionNoFail(associated(el2),cp_failure_level,routineP,error) diff --git a/src/cp_rs_pool_types.F b/src/cp_rs_pool_types.F index db8ca63052..d2f83f4193 100644 --- a/src/cp_rs_pool_types.F +++ b/src/cp_rs_pool_types.F @@ -12,24 +12,24 @@ !! pool for for elements that are retained and released !! !! NOTES -!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ +!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ !! | _ \ ___ _ __ ( ) |_ | \/ | ___ __| (_)/ _|_ _ |_ _| |__ (_)___ | ___(_) | ___| | !! | | | |/ _ \| '_ \|/| __| | |\/| |/ _ \ / _` | | |_| | | | | | | '_ \| / __| | |_ | | |/ _ \ | !! | |_| | (_) | | | | | |_ | | | | (_) | (_| | | _| |_| | | | | | | | \__ \ | _| | | | __/_| !! |____/ \___/|_| |_| \__| |_| |_|\___/ \__,_|_|_| \__, | |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! |___/ -!! ____ _ ___ _ _ _ _ -!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ +!! |___/ +!! ____ _ ___ _ _ _ _ +!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ !! | | | |/ _ \/ __|/ _ \ | || '_ ` _ \| '_ ` _ \ / _ \/ _` | |/ _` | __/ _ \ | | | | !! | |___| | (_) \__ \ __/ | || | | | | | | | | | | __/ (_| | | (_| | || __/ | |_| | !! \____|_|\___/|___/\___| |___|_| |_| |_|_| |_| |_|\___|\__,_|_|\__,_|\__\___|_|\__, | -!! |___/ -!! _____ _ _ _____ _ _ _ +!! |___/ +!! _____ _ _ _____ _ _ _ !! |_ _| |__ (_)___ | ___(_) | ___| | !! | | | '_ \| / __| | |_ | | |/ _ \ | !! | | | | | | \__ \ | _| | | | __/_| !! |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! +!! !! This is a template !! !! **** DO NOT MODIFY THE .F FILES **** @@ -162,8 +162,8 @@ CONTAINS !! - pool: the pool to create !! - el_struct: the structure of the elements that are stored in !! this pool -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -214,8 +214,8 @@ CONTAINS !! !! INPUTS !! - pool: the pool to retain -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -257,8 +257,8 @@ CONTAINS !! !! INPUTS !! - pool: the pool to flush -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -306,8 +306,8 @@ CONTAINS !! !! INPUTS !! - pool: the pool to release -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -359,7 +359,7 @@ CONTAINS !! INPUTS !! - pool: the pool from where you get the element !! - element: will contain the new element -!! - error: variable to control error logging, stopping,... +!! - error: variable to control error logging, stopping,... !! see module cp_error_handling !! !! AUTHOR @@ -388,13 +388,13 @@ CONTAINS IF (ASSOCIATED(pool%cache)) THEN element => cp_sll_rs_get_first_el(pool%cache,error=error) CALL cp_sll_rs_rm_first_el(pool%cache,error=error) - + ELSE NULLIFY(element) CALL rs_grid_create(element,pw_grid=pool%el_struct,& nsmax=pool%nsmax,error=error) END IF - + END IF CPPostcondition(ASSOCIATED(element),cp_failure_level,routineP,error,failure) CPPostcondition(element%ref_count==1,cp_warning_level,routineP,error,failure) @@ -417,8 +417,8 @@ CONTAINS !! - pool: the pool from where you get the elements !! - n_elements: the number of elements in the vector !! - elements: will contain the new vector -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -454,7 +454,7 @@ CONTAINS error=error) END DO - + END IF END SUBROUTINE rs_pool_create_rs_vect !*************************************************************************** @@ -475,8 +475,8 @@ CONTAINS !! INPUTS !! - pool: the pool where to cache the element !! - element: the element to give back -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -504,7 +504,7 @@ CONTAINS CALL cp_assert(pool%el_struct%id_nr==element%grid_id,& cp_failure_level, cp_assertion_failed, routineP,& "pool cannot reuse rs grids of another pw_grid "//& -CPSourceFileRef,& + CPSourceFileRef,& error=error,failure=failure) END IF @@ -539,8 +539,8 @@ CPSourceFileRef,& !! INPUTS !! - pool: the pool where to cache the elements !! - elements: the elements to give back -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -594,8 +594,8 @@ CPSourceFileRef,& !! !! INPUTS !! - pool: the pool you are interested in -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -615,7 +615,7 @@ FUNCTION rs_pool_get_el_struct(pool,error) RESULT(res) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(pool),cp_failure_level,routineP,error,failure) CPPrecondition(pool%ref_count>0,cp_failure_level,routineP,error,failure) IF (.NOT. failure) THEN @@ -642,8 +642,8 @@ END FUNCTION rs_pool_get_el_struct !! INPUTS !! - source_pools: the pools to copy !! - target_pools: will contains the new pools -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -664,7 +664,7 @@ SUBROUTINE rs_pools_copy(source_pools, target_pools, error) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(source_pools),cp_failure_level,routineP,error,failure) IF (.NOT. failure) THEN ALLOCATE(target_pools(SIZE(source_pools)),stat=stat) @@ -692,8 +692,8 @@ END SUBROUTINE rs_pools_copy !! !! INPUTS !! - pools: the pools to release -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -714,7 +714,7 @@ SUBROUTINE rs_pools_dealloc(pools, error) LOGICAL :: failure failure=.FALSE. - + IF (ASSOCIATED(pools)) THEN DO i=1,SIZE(pools) CALL rs_pool_release(pools(i)%pool,error=error) @@ -738,8 +738,8 @@ END SUBROUTINE rs_pools_dealloc !! !! INPUTS !! - pools: the pools to flush -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -760,7 +760,7 @@ SUBROUTINE rs_pools_flush_cache(pools, error) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(pools),cp_failure_level,routineP,error,failure) IF (.NOT.failure) THEN DO i=1,SIZE(pools) @@ -784,8 +784,8 @@ END SUBROUTINE rs_pools_flush_cache !! INPUTS !! - pools: the pools to create the elements from !! - elements: will contain the vector of elements -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -811,7 +811,7 @@ SUBROUTINE rs_pools_create_rs_vect(pools,elements,& failure=.FALSE. NULLIFY(pool) - + CPPrecondition(ASSOCIATED(pools),cp_failure_level,routineP,error,failure) IF (.NOT. failure) THEN ALLOCATE(elements(SIZE(pools)),stat=stat) @@ -825,7 +825,7 @@ SUBROUTINE rs_pools_create_rs_vect(pools,elements,& error=error) END DO - + END IF END SUBROUTINE rs_pools_create_rs_vect !*************************************************************************** @@ -845,8 +845,8 @@ END SUBROUTINE rs_pools_create_rs_vect !! INPUTS !! - pools: the pool where to give back the vector !! - elements: the vector of elements to give back -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -869,7 +869,7 @@ SUBROUTINE rs_pools_give_back_rs_vect(pools,elements,error) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(pools),cp_failure_level,routineP,error,failure) CPPrecondition(ASSOCIATED(elements),cp_failure_level,routineP,error,failure) CPPrecondition(SIZE(pools)==SIZE(elements),cp_failure_level,routineP,error,failure) diff --git a/src/force_fields_all.F b/src/force_fields_all.F index 8139f172a2..ddfa87a879 100644 --- a/src/force_fields_all.F +++ b/src/force_fields_all.F @@ -2127,8 +2127,8 @@ CPSourceFileRef,& IF(shell_adiabatic .AND. null_massfrac) THEN CALL stop_program(TRIM(routineN),"Shell-model adiabatic: at least one shell_kind has mass=0 Abort..") END IF - CALL allocate_particle_set(shell_particle_set,nshell_tot) - CALL allocate_particle_set(core_particle_set,nshell_tot) + CALL allocate_particle_set(shell_particle_set,nshell_tot,error) + CALL allocate_particle_set(core_particle_set,nshell_tot,error) counter = 0 DO i = 1,SIZE(particle_set) NULLIFY(atomic_kind,shell) diff --git a/src/mol_kind_new_list_types.F b/src/mol_kind_new_list_types.F index ee9d4f1c27..7f37cbe5bc 100644 --- a/src/mol_kind_new_list_types.F +++ b/src/mol_kind_new_list_types.F @@ -12,24 +12,24 @@ !! represent a simple array based list of the given type !! !! NOTES -!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ +!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ !! | _ \ ___ _ __ ( ) |_ | \/ | ___ __| (_)/ _|_ _ |_ _| |__ (_)___ | ___(_) | ___| | !! | | | |/ _ \| '_ \|/| __| | |\/| |/ _ \ / _` | | |_| | | | | | | '_ \| / __| | |_ | | |/ _ \ | !! | |_| | (_) | | | | | |_ | | | | (_) | (_| | | _| |_| | | | | | | | \__ \ | _| | | | __/_| !! |____/ \___/|_| |_| \__| |_| |_|\___/ \__,_|_|_| \__, | |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! |___/ -!! ____ _ ___ _ _ _ _ -!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ +!! |___/ +!! ____ _ ___ _ _ _ _ +!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ !! | | | |/ _ \/ __|/ _ \ | || '_ ` _ \| '_ ` _ \ / _ \/ _` | |/ _` | __/ _ \ | | | | !! | |___| | (_) \__ \ __/ | || | | | | | | | | | | __/ (_| | | (_| | || __/ | |_| | !! \____|_|\___/|___/\___| |___|_| |_| |_|_| |_| |_|\___|\__,_|_|\__,_|\__\___|_|\__, | -!! |___/ -!! _____ _ _ _____ _ _ _ +!! |___/ +!! _____ _ _ _____ _ _ _ !! |_ _| |__ (_)___ | ___(_) | ___| | !! | | | '_ \| / __| | |_ | | |/ _ \ | !! | | | | | | \__ \ | _| | | | __/_| !! |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! +!! !! This is a template !! !! **** DO NOT MODIFY THE .F FILES **** @@ -61,7 +61,7 @@ MODULE mol_kind_new_list_types PUBLIC :: mol_kind_new_list_type, mol_kind_new_list_p_type PUBLIC :: mol_kind_new_list_create, mol_kind_new_list_retain,& mol_kind_new_list_release - + !*** !**************************************************************************** @@ -150,8 +150,8 @@ CONTAINS !! will deallocate it (defaults to true) !! - n_els: number of elements in the list (at least one els_ptr or !! n_els should be given) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -221,8 +221,8 @@ END SUBROUTINE mol_kind_new_list_create !! !! INPUTS !! - list: the list to retain -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -241,7 +241,7 @@ SUBROUTINE mol_kind_new_list_retain(list, error) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(list),cp_failure_level,routineP,error,failure) IF (.NOT. failure) THEN CPPrecondition(list%ref_count>0,cp_failure_level,routineP,error,failure) @@ -263,8 +263,8 @@ END SUBROUTINE mol_kind_new_list_retain !! !! INPUTS !! - list: the list to release -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -284,7 +284,7 @@ SUBROUTINE mol_kind_new_list_release(list, error) LOGICAL :: failure failure=.FALSE. - + IF (ASSOCIATED(list)) THEN CPPrecondition(list%ref_count>0,cp_failure_level,routineP,error,failure) list%ref_count=list%ref_count-1 @@ -303,12 +303,12 @@ SUBROUTINE mol_kind_new_list_release(list, error) END SUBROUTINE mol_kind_new_list_release !*************************************************************************** -! template def put here so that line numbers in template and derived +! template def put here so that line numbers in template and derived ! files are almost the same (multi-line use change it a bit) ! [template(el_typename,el_type,USE,deallocate_els_code)] ! ARGS: ! USE = "use molecule_kind_types, only: molecule_kind_type, deallocate_molecule_kind_set" -! deallocate_els_code = "call deallocate_molecule_kind_set(list%els)" +! deallocate_els_code = "call deallocate_molecule_kind_set(list%els,error=error)" ! el_type = "type(molecule_kind_type)" ! el_typename = "mol_kind_new" diff --git a/src/mol_new_list_types.F b/src/mol_new_list_types.F index fe12c134e7..0b8bb90932 100644 --- a/src/mol_new_list_types.F +++ b/src/mol_new_list_types.F @@ -12,24 +12,24 @@ !! represent a simple array based list of the given type !! !! NOTES -!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ +!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _ !! | _ \ ___ _ __ ( ) |_ | \/ | ___ __| (_)/ _|_ _ |_ _| |__ (_)___ | ___(_) | ___| | !! | | | |/ _ \| '_ \|/| __| | |\/| |/ _ \ / _` | | |_| | | | | | | '_ \| / __| | |_ | | |/ _ \ | !! | |_| | (_) | | | | | |_ | | | | (_) | (_| | | _| |_| | | | | | | | \__ \ | _| | | | __/_| !! |____/ \___/|_| |_| \__| |_| |_|\___/ \__,_|_|_| \__, | |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! |___/ -!! ____ _ ___ _ _ _ _ -!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ +!! |___/ +!! ____ _ ___ _ _ _ _ +!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _ !! | | | |/ _ \/ __|/ _ \ | || '_ ` _ \| '_ ` _ \ / _ \/ _` | |/ _` | __/ _ \ | | | | !! | |___| | (_) \__ \ __/ | || | | | | | | | | | | __/ (_| | | (_| | || __/ | |_| | !! \____|_|\___/|___/\___| |___|_| |_| |_|_| |_| |_|\___|\__,_|_|\__,_|\__\___|_|\__, | -!! |___/ -!! _____ _ _ _____ _ _ _ +!! |___/ +!! _____ _ _ _____ _ _ _ !! |_ _| |__ (_)___ | ___(_) | ___| | !! | | | '_ \| / __| | |_ | | |/ _ \ | !! | | | | | | \__ \ | _| | | | __/_| !! |_| |_| |_|_|___/ |_| |_|_|\___(_) -!! +!! !! This is a template !! !! **** DO NOT MODIFY THE .F FILES **** @@ -61,7 +61,7 @@ MODULE mol_new_list_types PUBLIC :: mol_new_list_type, mol_new_list_p_type PUBLIC :: mol_new_list_create, mol_new_list_retain,& mol_new_list_release - + !*** !**************************************************************************** @@ -150,8 +150,8 @@ CONTAINS !! will deallocate it (defaults to true) !! - n_els: number of elements in the list (at least one els_ptr or !! n_els should be given) -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -221,8 +221,8 @@ END SUBROUTINE mol_new_list_create !! !! INPUTS !! - list: the list to retain -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -241,7 +241,7 @@ SUBROUTINE mol_new_list_retain(list, error) LOGICAL :: failure failure=.FALSE. - + CPPrecondition(ASSOCIATED(list),cp_failure_level,routineP,error,failure) IF (.NOT. failure) THEN CPPrecondition(list%ref_count>0,cp_failure_level,routineP,error,failure) @@ -263,8 +263,8 @@ END SUBROUTINE mol_new_list_retain !! !! INPUTS !! - list: the list to release -!! - error: variable to control error logging, stopping,... -!! see module cp_error_handling +!! - error: variable to control error logging, stopping,... +!! see module cp_error_handling !! !! AUTHOR !! Fawzi Mohamed @@ -284,7 +284,7 @@ SUBROUTINE mol_new_list_release(list, error) LOGICAL :: failure failure=.FALSE. - + IF (ASSOCIATED(list)) THEN CPPrecondition(list%ref_count>0,cp_failure_level,routineP,error,failure) list%ref_count=list%ref_count-1 @@ -303,12 +303,12 @@ SUBROUTINE mol_new_list_release(list, error) END SUBROUTINE mol_new_list_release !*************************************************************************** -! template def put here so that line numbers in template and derived +! template def put here so that line numbers in template and derived ! files are almost the same (multi-line use change it a bit) ! [template(el_typename,el_type,USE,deallocate_els_code)] ! ARGS: ! USE = "use molecule_types_new, only: molecule_type, deallocate_molecule_set" -! deallocate_els_code = "call deallocate_molecule_set(list%els)" +! deallocate_els_code = "call deallocate_molecule_set(list%els,error=error)" ! el_type = "type(molecule_type)" ! el_typename = "mol_new" diff --git a/src/particle_list_types.F b/src/particle_list_types.F index 5575002c8f..975140c39a 100644 --- a/src/particle_list_types.F +++ b/src/particle_list_types.F @@ -291,7 +291,7 @@ SUBROUTINE particle_list_release(list, error) IF (list%ref_count==0) THEN IF (list%owns_els) THEN IF (ASSOCIATED(list%els)) THEN - CALL deallocate_particle_set(list%els) + CALL deallocate_particle_set(list%els,error=error) END IF END IF NULLIFY(list%els) @@ -308,7 +308,7 @@ END SUBROUTINE particle_list_release ! [template(el_typename,el_type,USE,deallocate_els_code)] ! ARGS: ! USE = "use particle_types, only: particle_type, deallocate_particle_set" -! deallocate_els_code = "call deallocate_particle_set(list%els)" +! deallocate_els_code = "call deallocate_particle_set(list%els,error=error)" ! el_type = "type(particle_type)" ! el_typename = "particle" diff --git a/src/particle_types.F b/src/particle_types.F index 262c28a20a..22db9fa293 100644 --- a/src/particle_types.F +++ b/src/particle_types.F @@ -160,7 +160,7 @@ END SUBROUTINE clone_particle ! ***************************************************************************** - SUBROUTINE allocate_particle_set(particle_set,nparticle) + SUBROUTINE allocate_particle_set(particle_set,nparticle,error) ! Purpose: Allocate a particle set. @@ -171,6 +171,7 @@ END SUBROUTINE clone_particle TYPE(particle_type), DIMENSION(:), & POINTER :: particle_set INTEGER, INTENT(IN) :: nparticle + TYPE(cp_error_type), INTENT(INOUT) :: error CHARACTER(LEN=*), PARAMETER :: routineN = 'allocate_particle_set' @@ -178,7 +179,7 @@ END SUBROUTINE clone_particle ! --------------------------------------------------------------------------- - IF (ASSOCIATED(particle_set)) CALL deallocate_particle_set(particle_set) + IF (ASSOCIATED(particle_set)) CALL deallocate_particle_set(particle_set,error=error) ALLOCATE (particle_set(nparticle),STAT=istat) IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,& @@ -199,7 +200,7 @@ END SUBROUTINE clone_particle ! ***************************************************************************** - SUBROUTINE deallocate_particle_set(particle_set) + SUBROUTINE deallocate_particle_set(particle_set,error) ! Purpose: Deallocate a particle set. @@ -209,6 +210,7 @@ END SUBROUTINE clone_particle TYPE(particle_type), DIMENSION(:), & POINTER :: particle_set + TYPE(cp_error_type), INTENT(INOUT) :: error CHARACTER(LEN=*), PARAMETER :: routineN = 'deallocate_particle_set' diff --git a/src/qmmm_types.F b/src/qmmm_types.F index 09025c1c3c..576e40c1f8 100644 --- a/src/qmmm_types.F +++ b/src/qmmm_types.F @@ -827,7 +827,7 @@ SUBROUTINE add_set_release(added_charges, error) CPPostconditionNoFail(stat==0,cp_failure_level,routineP,error) END IF IF (ASSOCIATED(added_charges%added_particles)) THEN - CALL deallocate_particle_set(added_charges%added_particles) + CALL deallocate_particle_set(added_charges%added_particles,error) END IF IF (ASSOCIATED(added_charges%mm_atom_index)) THEN DEALLOCATE(added_charges%mm_atom_index, stat=stat) @@ -919,7 +919,7 @@ SUBROUTINE create_add_set_type(added_charges, ndim, error) ! ALLOCATE(added_charges%add_env(ndim),stat=stat) CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) - CALL allocate_particle_set(added_charges%added_particles,ndim) + CALL allocate_particle_set(added_charges%added_particles,ndim,error) ALLOCATE(added_charges%mm_atom_index(ndim), stat=stat) CPPostcondition(stat==0,cp_failure_level,routineP,error,Failure) ALLOCATE(added_charges%mm_atom_chrg(ndim), stat=stat) diff --git a/src/qs_localization.F b/src/qs_localization.F index 8838f07c3c..420e88a689 100644 --- a/src/qs_localization.F +++ b/src/qs_localization.F @@ -702,7 +702,7 @@ CONTAINS logger => cp_error_get_logger(error) natom = SIZE(qs_loc_env%particle_set) ntot = natom + SIZE(center,1) - CALL allocate_particle_set(particle_set, ntot) + CALL allocate_particle_set(particle_set, ntot,error) CALL allocate_atomic_kind_set(atomic_kind_set,1,error) atomic_kind => atomic_kind_set(1) CALL set_atomic_kind(atomic_kind=atomic_kind,kind_number=0,& @@ -739,7 +739,7 @@ CONTAINS END IF CALL write_particle_coordinates(particle_set,iunit,outformat,"POS",title,qs_loc_env%cell) CALL m_flush(iunit) - CALL deallocate_particle_set(particle_set) + CALL deallocate_particle_set(particle_set,error) CALL deallocate_atomic_kind_set(atomic_kind_set,error) END SUBROUTINE print_wannier_traj diff --git a/src/topology_coordinate_util.F b/src/topology_coordinate_util.F index 1b44cfc42d..a234bc6ae7 100644 --- a/src/topology_coordinate_util.F +++ b/src/topology_coordinate_util.F @@ -245,7 +245,7 @@ CONTAINS !----------------------------------------------------------------------------- CALL timeset(routineN//'_3',handle2) NULLIFY(particle_set) - CALL allocate_particle_set(particle_set,topology%natoms) + CALL allocate_particle_set(particle_set,topology%natoms,error) CALL timestop(0.0_dp,handle2) diff --git a/src/topology_generate_util.F b/src/topology_generate_util.F index bae505f27d..384ddfd0a3 100644 --- a/src/topology_generate_util.F +++ b/src/topology_generate_util.F @@ -560,7 +560,7 @@ CONTAINS ! Initialize fake particle_set and atomic_kinds to generate the bond list ! using the neighboring list routine CALL allocate_atomic_kind_set(atomic_kind_set,1,error) - CALL allocate_particle_set(particle_set,natom) + CALL allocate_particle_set(particle_set,natom,error) ! my_maxrad = MAXVAL(radius)*2.0_dp atomic_kind => atomic_kind_set(1) @@ -806,7 +806,7 @@ CONTAINS CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) DEALLOCATE(list,STAT=stat) CPPostcondition(stat==0,cp_failure_level,routineP,error,failure) - CALL deallocate_particle_set(particle_set) + CALL deallocate_particle_set(particle_set,error) CALL deallocate_atomic_kind_set(atomic_kind_set,error) ! CALL timestop(0.0_dp,handle2)