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