comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-29 06:35:28 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

Syncronizing templates and instantiation files with source files! Again:

Browse source 
the files generated through templates must NEVER be modified. The corresponding
templates and instantiations are the ones to be changed..
Propagating error in few more routines..


svn-origin-rev: 6304
This commit is contained in:
Teodoro Laino 2007-08-18 08:42:05 +00:00
parent 8e420c5163
commit 96c8a68f4f
32 changed files with 628 additions and 626 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/_el_typename__list_types.instantiation
View file

@ -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)"""
}
]

8
src/_el_typename__list_types.template
View file

@ -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',&

4
src/atomic_kind_list_types.F
View file

@ -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"

2
src/cp__el_name__pool_types.instantiation
View file

@ -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,',

38
src/cp__el_name__pool_types.template
View file

@ -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

12
src/cp_array__nametype1__utils.template
View file

@ -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

94
src/cp_fm_pool_types.F
View file

@ -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)

26
src/cp_lbfgs_optimizer__nametype1_.template
View file

@ -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

92
src/cp_lbfgs_optimizer_gopt.F
View file

@ -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:

22
src/cp_linked_list_3d_r.F
View file

@ -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"

48
src/cp_linked_list__nametype1_.instantiation
View file

@ -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<el2%id_nr
#define CP_SLL_VAL_EQUAL_Q(el1,el2) ( el1%id_nr == el2%id_nr )
"""#define CP_SLL_VAL_LESS_Q(el1,el2,error) el1%id_nr<el2%id_nr
#define CP_SLL_VAL_EQUAL_Q(el1,el2,error) ( el1%id_nr == el2%id_nr )
""",# stupid orderig, and sameness, define something more useful?
'=':'=>',
'type1arrayEl':'type(val_p_type)',

66
src/cp_linked_list__nametype1_.template
View file

@ -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

24
src/cp_linked_list_char.F
View file

@ -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

22
src/cp_linked_list_fm.F
View file

@ -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"

22
src/cp_linked_list_int.F
View file

@ -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"

22
src/cp_linked_list_logical.F
View file

@ -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"

22
src/cp_linked_list_pw.F
View file

@ -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"

22
src/cp_linked_list_real.F
View file

@ -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"

22
src/cp_linked_list_rs.F
View file

@ -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"

164
src/cp_linked_list_sm.F
View file

@ -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"

162
src/cp_linked_list_val.F
View file

@ -3,8 +3,8 @@
! Copyright (C) 2000 - 2007 CP2K developers group !
!-----------------------------------------------------------------------------!
#define CP_SLL_VAL_LESS_Q(el1,el2) el1%id_nr<el2%id_nr
#define CP_SLL_VAL_EQUAL_Q(el1,el2) ( el1%id_nr == el2%id_nr )
#define CP_SLL_VAL_LESS_Q(el1,el2,error) el1%id_nr<el2%id_nr
#define CP_SLL_VAL_EQUAL_Q(el1,el2,error) ( el1%id_nr == el2%id_nr )
!!****h* cp2k/cp_linked_list_val [1.0] *
!!
@ -19,24 +19,24 @@
!! An empty list is represented by an unassociated pointer.
!!
!! NOTES
!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _
!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _
!! | _ \ ___ _ __ ( ) |_ | \/ | ___ __| (_)/ _|_ _ |_ _| |__ (_)___ | ___(_) | ___| |
!! | | | |/ _ \| '_ \|/| __| | |\/| |/ _ \ / _` | | |_| | | | | | | '_ \| / __| | |_ | | |/ _ \ |
!! | |_| | (_) | | | | | |_ | | | | (_) | (_| | | _| |_| | | | | | | | \__ \ | _| | | | __/_|
!! |____/ \___/|_| |_| \__| |_| |_|\___/ \__,_|_|_| \__, | |_| |_| |_|_|___/ |_| |_|_|\___(_)
!! |___/
!! ____ _ ___ _ _ _ _
!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _
!! |___/
!! ____ _ ___ _ _ _ _
!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _
!! | | | |/ _ \/ __|/ _ \ | || '_ ` _ \| '_ ` _ \ / _ \/ _` | |/ _` | __/ _ \ | | | |
!! | |___| | (_) \__ \ __/ | || | | | | | | | | | | __/ (_| | | (_| | || __/ | |_| |
!! \____|_|\___/|___/\___| |___|_| |_| |_|_| |_| |_|\___|\__,_|_|\__,_|\__\___|_|\__, |
!! |___/
!! _____ _ _ _____ _ _ _
!! |___/
!! _____ _ _ _____ _ _ _
!! |_ _| |__ (_)___ | ___(_) | ___| |
!! | | | '_ \| / __| | |_ | | |/ _ \ |
!! | | | | | | \__ \ | _| | | | __/_|
!! |_| |_| |_|_|___/ |_| |_|_|\___(_)
!!
!!
!! This is a template
!!
!! **** DO NOT MODIFY THE .F FILES ****
@ -47,7 +47,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
!!
@ -180,21 +180,21 @@ MODULE cp_linked_list_val
!! 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
!!
@ -261,8 +261,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
@ -316,8 +316,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
@ -352,8 +352,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
@ -388,7 +388,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
@ -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_nr<el2%id_nr
! #define CP_SLL_VAL_EQUAL_Q(el1,el2) ( el1%id_nr == el2%id_nr )
! defines =
! "#define CP_SLL_VAL_LESS_Q(el1,el2,error) el1%id_nr<el2%id_nr
! #define CP_SLL_VAL_EQUAL_Q(el1,el2,error) ( el1%id_nr == el2%id_nr )
! "
! equalQ = "CP_SLL_VAL_EQUAL_Q"
! lessQ = "CP_SLL_VAL_LESS_Q"

160
src/cp_linked_list_xc_deriv.F
View file

@ -3,8 +3,8 @@
! Copyright (C) 2000 - 2007 CP2K developers group !
!-----------------------------------------------------------------------------!
#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 )
!!****h* cp2k/cp_linked_list_xc_deriv [1.0] *
!!
@ -19,24 +19,24 @@
!! An empty list is represented by an unassociated pointer.
!!
!! NOTES
!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _
!! ____ _ _ __ __ _ _ __ _____ _ _ _____ _ _ _
!! | _ \ ___ _ __ ( ) |_ | \/ | ___ __| (_)/ _|_ _ |_ _| |__ (_)___ | ___(_) | ___| |
!! | | | |/ _ \| '_ \|/| __| | |\/| |/ _ \ / _` | | |_| | | | | | | '_ \| / __| | |_ | | |/ _ \ |
!! | |_| | (_) | | | | | |_ | | | | (_) | (_| | | _| |_| | | | | | | | \__ \ | _| | | | __/_|
!! |____/ \___/|_| |_| \__| |_| |_|\___/ \__,_|_|_| \__, | |_| |_| |_|_|___/ |_| |_|_|\___(_)
!! |___/
!! ____ _ ___ _ _ _ _
!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _
!! |___/
!! ____ _ ___ _ _ _ _
!! / ___| | ___ ___ ___ |_ _|_ __ ___ _ __ ___ ___ __| (_) __ _| |_ ___| |_ _
!! | | | |/ _ \/ __|/ _ \ | || '_ ` _ \| '_ ` _ \ / _ \/ _` | |/ _` | __/ _ \ | | | |
!! | |___| | (_) \__ \ __/ | || | | | | | | | | | | __/ (_| | | (_| | || __/ | |_| |
!! \____|_|\___/|___/\___| |___|_| |_| |_|_| |_| |_|\___|\__,_|_|\__,_|\__\___|_|\__, |
!! |___/
!! _____ _ _ _____ _ _ _
!! |___/
!! _____ _ _ _____ _ _ _
!! |_ _| |__ (_)___ | ___(_) | ___| |
!! | | | '_ \| / __| | |_ | | |/ _ \ |
!! | | | | | | \__ \ | _| | | | __/_|
!! |_| |_| |_|_|___/ |_| |_|_|\___(_)
!!
!!
!! This is a template
!!
!! **** DO NOT MODIFY THE .F FILES ****
@ -47,7 +47,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
!!
@ -181,21 +181,21 @@ MODULE cp_linked_list_xc_deriv
!! 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
!!
@ -278,8 +278,8 @@ END FUNCTION
!! 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
@ -335,8 +335,8 @@ END FUNCTION
!!
!! 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
@ -371,8 +371,8 @@ END FUNCTION
!!
!! 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
@ -407,7 +407,7 @@ END FUNCTION
!!
!! 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
@ -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)

90
src/cp_rs_pool_types.F
View file

@ -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)

4
src/force_fields_all.F
View file

@ -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)

36
src/mol_kind_new_list_types.F
View file

@ -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"

36
src/mol_new_list_types.F
View file

@ -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"

4
src/particle_list_types.F
View file

@ -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"

8
src/particle_types.F
View file

@ -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'

4
src/qmmm_types.F
View file

@ -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)

4
src/qs_localization.F
View file

@ -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

2
src/topology_coordinate_util.F
View file

@ -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)

4
src/topology_generate_util.F
View file

@ -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)