-
Notifications
You must be signed in to change notification settings - Fork 1
/
qs_integral_utils.F
172 lines (131 loc) · 7.69 KB
/
qs_integral_utils.F
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
!--------------------------------------------------------------------------------------------------!
! CP2K: A general program to perform molecular dynamics simulations !
! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
! !
! SPDX-License-Identifier: GPL-2.0-or-later !
!--------------------------------------------------------------------------------------------------!
! **************************************************************************************************
!> \brief Some utility functions for the calculation of integrals
!> \par History
!> JGH: initial version
!> \author JGH (10.07.2014)
! **************************************************************************************************
MODULE qs_integral_utils
USE basis_set_types, ONLY: gto_basis_set_p_type,&
gto_basis_set_type
USE orbital_pointers, ONLY: init_orbital_pointers
USE qs_kind_types, ONLY: get_qs_kind,&
get_qs_kind_set,&
qs_kind_type
#include "./base/base_uses.f90"
IMPLICIT NONE
PRIVATE
! *** Global parameters ***
CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_integral_utils'
! *** Interfaces ***
INTERFACE get_memory_usage
MODULE PROCEDURE get_memory_usage_a, get_memory_usage_ab, &
get_memory_usage_abc, get_memory_usage_abcd
END INTERFACE
! *** Public subroutines ***
PUBLIC :: get_memory_usage, basis_set_list_setup
CONTAINS
! **************************************************************************************************
!> \brief Return the maximum memory usage in integral calculations
!> \param qs_kind_set The info for all atomic kinds
!> \param basis_type_a Type of basis
!> \return Result
! **************************************************************************************************
FUNCTION get_memory_usage_a(qs_kind_set, basis_type_a) RESULT(ldmem)
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
CHARACTER(LEN=*), INTENT(IN) :: basis_type_a
INTEGER :: ldmem
INTEGER :: maxc, maxl, maxs
CALL get_qs_kind_set(qs_kind_set=qs_kind_set, &
maxco=maxc, maxlgto=maxl, maxsgf=maxs, &
basis_type=basis_type_a)
ldmem = MAX(maxc, maxs)
CALL init_orbital_pointers(maxl + 2)
END FUNCTION get_memory_usage_a
! **************************************************************************************************
!> \brief Return the maximum memory usage in integral calculations
!> \param qs_kind_set The info for all atomic kinds
!> \param basis_type_a Type of basis
!> \param basis_type_b Type of basis
!> \return Result
! **************************************************************************************************
FUNCTION get_memory_usage_ab(qs_kind_set, basis_type_a, basis_type_b) RESULT(ldmem)
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
CHARACTER(LEN=*), INTENT(IN) :: basis_type_a, basis_type_b
INTEGER :: ldmem
INTEGER :: lda, ldb
lda = get_memory_usage_a(qs_kind_set, basis_type_a)
ldb = get_memory_usage_a(qs_kind_set, basis_type_b)
ldmem = MAX(lda, ldb)
END FUNCTION get_memory_usage_ab
! **************************************************************************************************
!> \brief Return the maximum memory usage in integral calculations
!> \param qs_kind_set The info for all atomic kinds
!> \param basis_type_a Type of basis
!> \param basis_type_b Type of basis
!> \param basis_type_c Type of basis
!> \return Result
! **************************************************************************************************
FUNCTION get_memory_usage_abc(qs_kind_set, basis_type_a, &
basis_type_b, basis_type_c) RESULT(ldmem)
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
CHARACTER(LEN=*), INTENT(IN) :: basis_type_a, basis_type_b, basis_type_c
INTEGER :: ldmem
INTEGER :: lda, ldb, ldc
lda = get_memory_usage_a(qs_kind_set, basis_type_a)
ldb = get_memory_usage_a(qs_kind_set, basis_type_b)
ldc = get_memory_usage_a(qs_kind_set, basis_type_c)
ldmem = MAX(lda, ldb, ldc)
END FUNCTION get_memory_usage_abc
! **************************************************************************************************
!> \brief Return the maximum memory usage in integral calculations
!> \param qs_kind_set The info for all atomic kinds
!> \param basis_type_a Type of basis
!> \param basis_type_b Type of basis
!> \param basis_type_c Type of basis
!> \param basis_type_d Type of basis
!> \return Result
! **************************************************************************************************
FUNCTION get_memory_usage_abcd(qs_kind_set, basis_type_a, &
basis_type_b, basis_type_c, basis_type_d) RESULT(ldmem)
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
CHARACTER(LEN=*), INTENT(IN) :: basis_type_a, basis_type_b, &
basis_type_c, basis_type_d
INTEGER :: ldmem
INTEGER :: lda, ldb, ldc, ldd
lda = get_memory_usage_a(qs_kind_set, basis_type_a)
ldb = get_memory_usage_a(qs_kind_set, basis_type_b)
ldc = get_memory_usage_a(qs_kind_set, basis_type_c)
ldd = get_memory_usage_a(qs_kind_set, basis_type_d)
ldmem = MAX(lda, ldb, ldc, ldd)
END FUNCTION get_memory_usage_abcd
! **************************************************************************************************
! **************************************************************************************************
!> \brief Set up an easy accessible list of the basis sets for all kinds
!> \param basis_set_list The basis set list
!> \param basis_type ...
!> \param qs_kind_set Kind information, the basis is used
! **************************************************************************************************
SUBROUTINE basis_set_list_setup(basis_set_list, basis_type, qs_kind_set)
TYPE(gto_basis_set_p_type), DIMENSION(:) :: basis_set_list
CHARACTER(len=*), INTENT(IN) :: basis_type
TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
INTEGER :: ikind
TYPE(gto_basis_set_type), POINTER :: basis_set
TYPE(qs_kind_type), POINTER :: qs_kind
! set up basis sets
DO ikind = 1, SIZE(qs_kind_set)
qs_kind => qs_kind_set(ikind)
CALL get_qs_kind(qs_kind=qs_kind, basis_set=basis_set, &
basis_type=basis_type)
NULLIFY (basis_set_list(ikind)%gto_basis_set)
IF (ASSOCIATED(basis_set)) basis_set_list(ikind)%gto_basis_set => basis_set
END DO
END SUBROUTINE basis_set_list_setup
! **************************************************************************************************
END MODULE qs_integral_utils