(git:e7e05ae)
lri_optimize_ri_basis_types.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 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
38  END TYPE lri_gcc_p_type
39 
40  TYPE lri_subset_type
41  ! amount of l quantum numbers per set
42  INTEGER :: nl
43  ! number of contraction per l quantum number for a given set
44  INTEGER, DIMENSION(:), POINTER :: ncont_l
45  END TYPE lri_subset_type
46 
47  TYPE lri_opt_type
48  LOGICAL :: opt_exps
49  LOGICAL :: opt_coeffs
50  LOGICAL :: use_condition_number
51  LOGICAL :: use_geometric_seq
52  LOGICAL :: use_constraints
53  INTEGER :: nexp
54  INTEGER :: ncoeff
55  REAL(KIND=dp) :: cond_weight
56  REAL(KIND=dp) :: scale_exp
57  REAL(KIND=dp) :: fermi_exp
58  REAL(KIND=dp) :: rho_diff
59  ! array holding the variables that are optimized
60  REAL(KIND=dp), DIMENSION(:), POINTER :: x
61  ! initial exponents
62  REAL(KIND=dp), DIMENSION(:), POINTER :: zet_init
63  ! holds the original contraction coeff of the lri basis
64  TYPE(lri_gcc_p_type), DIMENSION(:), POINTER :: ri_gcc_orig
65  TYPE(lri_subset_type), DIMENSION(:), POINTER :: subset
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  SUBROUTINE create_lri_opt(lri_opt)
77 
78  TYPE(lri_opt_type), POINTER :: lri_opt
79 
80  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  lri_opt%nexp = 0
94  lri_opt%ncoeff = 0
95 
96  END SUBROUTINE create_lri_opt
97 
98 ! **************************************************************************************************
99 !> \brief deallocates lri_opt
100 !> \param lri_opt optimization environment
101 ! **************************************************************************************************
102  SUBROUTINE deallocate_lri_opt(lri_opt)
103 
104  TYPE(lri_opt_type), POINTER :: lri_opt
105 
106  INTEGER :: i
107 
108  IF (ASSOCIATED(lri_opt)) THEN
109  IF (ASSOCIATED(lri_opt%subset)) THEN
110  DO i = 1, SIZE(lri_opt%subset)
111  DEALLOCATE (lri_opt%subset(i)%ncont_l)
112  END DO
113  DEALLOCATE (lri_opt%subset)
114  END IF
115  IF (ASSOCIATED(lri_opt%x)) THEN
116  DEALLOCATE (lri_opt%x)
117  END IF
118  IF (ASSOCIATED(lri_opt%zet_init)) THEN
119  DEALLOCATE (lri_opt%zet_init)
120  END IF
121  IF (ASSOCIATED(lri_opt%ri_gcc_orig)) THEN
122  DO i = 1, SIZE(lri_opt%ri_gcc_orig)
123  DEALLOCATE (lri_opt%ri_gcc_orig(i)%gcc_orig)
124  END DO
125  DEALLOCATE (lri_opt%ri_gcc_orig)
126  END IF
127  DEALLOCATE (lri_opt)
128  END IF
129  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  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  INTEGER, DIMENSION(:), POINTER :: lmax, lmin, ncont_l
148  REAL(kind=dp) :: expzet, gcca, prefac, zeta
149 
150  maxpgf = SIZE(gto_basis_set%gcc, 1)
151  maxshell = SIZE(gto_basis_set%gcc, 2)
152  nset = SIZE(gto_basis_set%gcc, 3)
153 
154  ALLOCATE (gcc_orig(maxpgf, maxshell, nset))
155  gcc_orig = 0.0_dp
156 
157  DO iset = 1, gto_basis_set%nset
158  DO ishell = 1, gto_basis_set%nshell(iset)
159  l = gto_basis_set%l(ishell, iset)
160  expzet = 0.25_dp*real(2*l + 3, dp)
161  prefac = 2.0_dp**l*(2.0_dp/pi)**0.75_dp
162  DO ipgf = 1, gto_basis_set%npgf(iset)
163  gcca = gto_basis_set%gcc(ipgf, ishell, iset)
164  zeta = gto_basis_set%zet(ipgf, iset)
165  gcc_orig(ipgf, ishell, iset) = gcca/(prefac*zeta**expzet)
166  END DO
167  END DO
168  END DO
169 
170  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  lmax=lmax, lmin=lmin)
174  ALLOCATE (lri_opt%subset(nset))
175  DO iset = 1, gto_basis_set%nset
176  nl = lmax(iset) - lmin(iset) + 1
177  lri_opt%subset(iset)%nl = nl
178  il = 1
179  ALLOCATE (lri_opt%subset(iset)%ncont_l(nl))
180  ncont_l => lri_opt%subset(iset)%ncont_l
181  ncont_l = 1
182  DO ishell = 2, gto_basis_set%nshell(iset)
183  l = gto_basis_set%l(ishell, iset)
184  IF (l == gto_basis_set%l(ishell - 1, iset)) THEN
185  ncont_l(il) = ncont_l(il) + 1
186  ELSE
187  il = il + 1
188  ncont_l(il) = 1
189  END IF
190  END DO
191  END DO
192  END IF
193 
194  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  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  INTEGER, DIMENSION(:), POINTER :: nshell
211  REAL(kind=dp) :: gs_scale
212 
213  CALL get_gto_basis_set(gto_basis_set=gto_basis_set, nset=nset, nshell=nshell)
214 
215  DO iset = 1, nset
216  istart = 1
217  DO il = 1, lri_opt%subset(iset)%nl
218  DO ishell1 = istart, istart + lri_opt%subset(iset)%ncont_l(il) - 2
219  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  dot_product(gcc(:, ishell1, iset), gcc(:, ishell1, iset))
222  gcc(:, ishell2, iset) = gcc(:, ishell2, iset) - &
223  gs_scale*gcc(:, ishell1, iset)
224  END DO
225  END DO
226  istart = istart + lri_opt%subset(iset)%ncont_l(il)
227  END DO
228 
229  DO ishell = 1, gto_basis_set%nshell(iset)
230  gcc(:, ishell, iset) = gcc(:, ishell, iset)/ &
231  sqrt(dot_product(gcc(:, ishell, iset), gcc(:, ishell, iset)))
232  END DO
233  END DO
234 
235  END SUBROUTINE orthonormalize_gcc
236 
237 END MODULE lri_optimize_ri_basis_types
basis_set_types
Definition: basis_set_types.F:15
basis_set_types::get_gto_basis_set
subroutine, public get_gto_basis_set(gto_basis_set, name, aliases, norm_type, kind_radius, ncgf, nset, nsgf, cgf_symbol, sgf_symbol, norm_cgf, set_radius, lmax, lmin, lx, ly, lz, m, ncgf_set, npgf, nsgf_set, nshell, cphi, pgf_radius, sphi, scon, zet, first_cgf, first_sgf, l, last_cgf, last_sgf, n, gcc, maxco, maxl, maxpgf, maxsgf_set, maxshell, maxso, nco_sum, npgf_sum, nshell_sum, maxder, short_kind_radius)
...
Definition: basis_set_types.F:615
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
lri_optimize_ri_basis_types
sets the environment for optimization of exponents and contraction coefficients of the lri auxiliary ...
Definition: lri_optimize_ri_basis_types.F:16
lri_optimize_ri_basis_types::orthonormalize_gcc
subroutine, public orthonormalize_gcc(gcc, gto_basis_set, lri_opt)
orthonormalize contraction coefficients using Gram-Schmidt
Definition: lri_optimize_ri_basis_types.F:203
lri_optimize_ri_basis_types::create_lri_opt
subroutine, public create_lri_opt(lri_opt)
creates lri_opt
Definition: lri_optimize_ri_basis_types.F:77
lri_optimize_ri_basis_types::deallocate_lri_opt
subroutine, public deallocate_lri_opt(lri_opt)
deallocates lri_opt
Definition: lri_optimize_ri_basis_types.F:103
lri_optimize_ri_basis_types::get_original_gcc
subroutine, public get_original_gcc(gcc_orig, gto_basis_set, lri_opt)
primitive Cartesian Gaussian functions are normalized. The normalization factor is included in the Ga...
Definition: lri_optimize_ri_basis_types.F:140
mathconstants
Definition of mathematical constants and functions.
Definition: mathconstants.F:16
mathconstants::pi
real(kind=dp), parameter, public pi
Definition: mathconstants.F:110