Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief sets the environment for optimization of exponents and contraction
10 : !> coefficients of the lri auxiliary
11 : !> lri : local resolution of the identity
12 : !> \par History
13 : !> created Dorothea Golze [12.2014]
14 : !> \authors Dorothea Golze
15 : ! **************************************************************************************************
16 : MODULE lri_optimize_ri_basis_types
17 :
18 : USE basis_set_types, ONLY: get_gto_basis_set,&
19 : gto_basis_set_type
20 : USE kinds, ONLY: dp
21 : USE mathconstants, ONLY: pi
22 : #include "./base/base_uses.f90"
23 :
24 : IMPLICIT NONE
25 :
26 : PRIVATE
27 :
28 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'lri_optimize_ri_basis_types'
29 : PUBLIC :: lri_opt_type
30 : PUBLIC :: create_lri_opt, deallocate_lri_opt, get_original_gcc, &
31 : orthonormalize_gcc
32 :
33 : ! **************************************************************************************************
34 :
35 : TYPE lri_gcc_p_type
36 : ! gcc without normalization factor
37 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: gcc_orig => NULL()
38 : END TYPE lri_gcc_p_type
39 :
40 : TYPE lri_subset_type
41 : ! amount of l quantum numbers per set
42 : INTEGER :: nl = -1
43 : ! number of contraction per l quantum number for a given set
44 : INTEGER, DIMENSION(:), POINTER :: ncont_l => NULL()
45 : END TYPE lri_subset_type
46 :
47 : TYPE lri_opt_type
48 : LOGICAL :: opt_exps = .FALSE.
49 : LOGICAL :: opt_coeffs = .FALSE.
50 : LOGICAL :: use_condition_number = .FALSE.
51 : LOGICAL :: use_geometric_seq = .FALSE.
52 : LOGICAL :: use_constraints = .FALSE.
53 : INTEGER :: nexp = -1
54 : INTEGER :: ncoeff = -1
55 : REAL(KIND=dp) :: cond_weight = 0.0_dp
56 : REAL(KIND=dp) :: scale_exp = 0.0_dp
57 : REAL(KIND=dp) :: fermi_exp = 0.0_dp
58 : REAL(KIND=dp) :: rho_diff = 0.0_dp
59 : ! array holding the variables that are optimized
60 : REAL(KIND=dp), DIMENSION(:), POINTER :: x => NULL()
61 : ! initial exponents
62 : REAL(KIND=dp), DIMENSION(:), POINTER :: zet_init => NULL()
63 : ! holds the original contraction coeff of the lri basis
64 : TYPE(lri_gcc_p_type), DIMENSION(:), POINTER :: ri_gcc_orig => NULL()
65 : TYPE(lri_subset_type), DIMENSION(:), POINTER :: subset => NULL()
66 : END TYPE lri_opt_type
67 :
68 : ! **************************************************************************************************
69 :
70 : CONTAINS
71 :
72 : ! **************************************************************************************************
73 : !> \brief creates lri_opt
74 : !> \param lri_opt optimization environment
75 : ! **************************************************************************************************
76 6 : SUBROUTINE create_lri_opt(lri_opt)
77 :
78 : TYPE(lri_opt_type), POINTER :: lri_opt
79 :
80 6 : ALLOCATE (lri_opt)
81 :
82 : NULLIFY (lri_opt%ri_gcc_orig)
83 : NULLIFY (lri_opt%subset)
84 : NULLIFY (lri_opt%x)
85 : NULLIFY (lri_opt%zet_init)
86 :
87 : lri_opt%opt_exps = .FALSE.
88 : lri_opt%opt_coeffs = .FALSE.
89 : lri_opt%use_condition_number = .FALSE.
90 : lri_opt%use_geometric_seq = .FALSE.
91 : lri_opt%use_constraints = .FALSE.
92 :
93 6 : lri_opt%nexp = 0
94 6 : lri_opt%ncoeff = 0
95 :
96 6 : END SUBROUTINE create_lri_opt
97 :
98 : ! **************************************************************************************************
99 : !> \brief deallocates lri_opt
100 : !> \param lri_opt optimization environment
101 : ! **************************************************************************************************
102 6 : SUBROUTINE deallocate_lri_opt(lri_opt)
103 :
104 : TYPE(lri_opt_type), POINTER :: lri_opt
105 :
106 : INTEGER :: i
107 :
108 6 : IF (ASSOCIATED(lri_opt)) THEN
109 6 : IF (ASSOCIATED(lri_opt%subset)) THEN
110 14 : DO i = 1, SIZE(lri_opt%subset)
111 14 : DEALLOCATE (lri_opt%subset(i)%ncont_l)
112 : END DO
113 2 : DEALLOCATE (lri_opt%subset)
114 : END IF
115 6 : IF (ASSOCIATED(lri_opt%x)) THEN
116 6 : DEALLOCATE (lri_opt%x)
117 : END IF
118 6 : IF (ASSOCIATED(lri_opt%zet_init)) THEN
119 2 : DEALLOCATE (lri_opt%zet_init)
120 : END IF
121 6 : IF (ASSOCIATED(lri_opt%ri_gcc_orig)) THEN
122 12 : DO i = 1, SIZE(lri_opt%ri_gcc_orig)
123 12 : DEALLOCATE (lri_opt%ri_gcc_orig(i)%gcc_orig)
124 : END DO
125 6 : DEALLOCATE (lri_opt%ri_gcc_orig)
126 : END IF
127 6 : DEALLOCATE (lri_opt)
128 : END IF
129 6 : END SUBROUTINE deallocate_lri_opt
130 :
131 : ! **************************************************************************************************
132 : !> \brief primitive Cartesian Gaussian functions are normalized. The normalization
133 : !> factor is included in the Gaussian contraction coefficients.
134 : !> Division by this factor to get the original gcc.
135 : !> \param gcc_orig original contraction coefficient
136 : !> \param gto_basis_set gaussian type basis set
137 : !> \param lri_opt optimization environment
138 : ! **************************************************************************************************
139 6 : SUBROUTINE get_original_gcc(gcc_orig, gto_basis_set, lri_opt)
140 :
141 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: gcc_orig
142 : TYPE(gto_basis_set_type), POINTER :: gto_basis_set
143 : TYPE(lri_opt_type), POINTER :: lri_opt
144 :
145 : INTEGER :: il, ipgf, iset, ishell, l, maxpgf, &
146 : maxshell, nl, nset
147 6 : INTEGER, DIMENSION(:), POINTER :: lmax, lmin, ncont_l
148 : REAL(KIND=dp) :: expzet, gcca, prefac, zeta
149 :
150 6 : maxpgf = SIZE(gto_basis_set%gcc, 1)
151 6 : maxshell = SIZE(gto_basis_set%gcc, 2)
152 6 : nset = SIZE(gto_basis_set%gcc, 3)
153 :
154 30 : ALLOCATE (gcc_orig(maxpgf, maxshell, nset))
155 558 : gcc_orig = 0.0_dp
156 :
157 46 : DO iset = 1, gto_basis_set%nset
158 136 : DO ishell = 1, gto_basis_set%nshell(iset)
159 90 : l = gto_basis_set%l(ishell, iset)
160 90 : expzet = 0.25_dp*REAL(2*l + 3, dp)
161 90 : prefac = 2.0_dp**l*(2.0_dp/pi)**0.75_dp
162 272 : DO ipgf = 1, gto_basis_set%npgf(iset)
163 142 : gcca = gto_basis_set%gcc(ipgf, ishell, iset)
164 142 : zeta = gto_basis_set%zet(ipgf, iset)
165 232 : gcc_orig(ipgf, ishell, iset) = gcca/(prefac*zeta**expzet)
166 : END DO
167 : END DO
168 : END DO
169 :
170 6 : IF (lri_opt%opt_coeffs) THEN
171 : ! **** get number of contractions per quantum number
172 : CALL get_gto_basis_set(gto_basis_set=gto_basis_set, &
173 2 : lmax=lmax, lmin=lmin)
174 18 : ALLOCATE (lri_opt%subset(nset))
175 14 : DO iset = 1, gto_basis_set%nset
176 12 : nl = lmax(iset) - lmin(iset) + 1
177 12 : lri_opt%subset(iset)%nl = nl
178 12 : il = 1
179 36 : ALLOCATE (lri_opt%subset(iset)%ncont_l(nl))
180 12 : ncont_l => lri_opt%subset(iset)%ncont_l
181 24 : ncont_l = 1
182 20 : DO ishell = 2, gto_basis_set%nshell(iset)
183 6 : l = gto_basis_set%l(ishell, iset)
184 18 : IF (l == gto_basis_set%l(ishell - 1, iset)) THEN
185 6 : ncont_l(il) = ncont_l(il) + 1
186 : ELSE
187 0 : il = il + 1
188 0 : ncont_l(il) = 1
189 : END IF
190 : END DO
191 : END DO
192 : END IF
193 :
194 6 : END SUBROUTINE get_original_gcc
195 :
196 : ! **************************************************************************************************
197 : !> \brief orthonormalize contraction coefficients using Gram-Schmidt
198 : !> \param gcc contraction coefficient
199 : !> \param gto_basis_set gaussian type basis set
200 : !> \param lri_opt optimization environment
201 : ! **************************************************************************************************
202 16 : SUBROUTINE orthonormalize_gcc(gcc, gto_basis_set, lri_opt)
203 :
204 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: gcc
205 : TYPE(gto_basis_set_type), POINTER :: gto_basis_set
206 : TYPE(lri_opt_type), POINTER :: lri_opt
207 :
208 : INTEGER :: il, iset, ishell, ishell1, ishell2, &
209 : istart, nset
210 16 : INTEGER, DIMENSION(:), POINTER :: nshell
211 : REAL(KIND=dp) :: gs_scale
212 :
213 16 : CALL get_gto_basis_set(gto_basis_set=gto_basis_set, nset=nset, nshell=nshell)
214 :
215 112 : DO iset = 1, nset
216 96 : istart = 1
217 192 : DO il = 1, lri_opt%subset(iset)%nl
218 144 : DO ishell1 = istart, istart + lri_opt%subset(iset)%ncont_l(il) - 2
219 208 : DO ishell2 = ishell1 + 1, istart + lri_opt%subset(iset)%ncont_l(il) - 1
220 : gs_scale = DOT_PRODUCT(gcc(:, ishell2, iset), gcc(:, ishell1, iset))/ &
221 960 : DOT_PRODUCT(gcc(:, ishell1, iset), gcc(:, ishell1, iset))
222 : gcc(:, ishell2, iset) = gcc(:, ishell2, iset) - &
223 560 : gs_scale*gcc(:, ishell1, iset)
224 : END DO
225 : END DO
226 192 : istart = istart + lri_opt%subset(iset)%ncont_l(il)
227 : END DO
228 :
229 256 : DO ishell = 1, gto_basis_set%nshell(iset)
230 : gcc(:, ishell, iset) = gcc(:, ishell, iset)/ &
231 2256 : SQRT(DOT_PRODUCT(gcc(:, ishell, iset), gcc(:, ishell, iset)))
232 : END DO
233 : END DO
234 :
235 16 : END SUBROUTINE orthonormalize_gcc
236 :
237 0 : END MODULE lri_optimize_ri_basis_types
|
