(git:1f285aa)
qs_o3c_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 !> \brief 3-center overlap type integrals containers
9 !> \par History
10 !> - Added options to only keep (abc) triplet if b and c share the same center (2019 A.Bussy)
11 ! **************************************************************************************************
12 MODULE qs_o3c_types
13 
14  USE basis_set_types, ONLY: gto_basis_set_p_type
15  USE kinds, ONLY: dp
16  USE qs_neighbor_list_types, ONLY: &
17  get_iterator_info, get_neighbor_list_set_p, neighbor_list_iterate, &
18  neighbor_list_iterator_create, neighbor_list_iterator_p_type, &
19  neighbor_list_iterator_release, neighbor_list_set_p_type, nl_set_sub_iterator, &
20  nl_sub_iterate
21 #include "./base/base_uses.f90"
22 
23  IMPLICIT NONE
24 
25  PRIVATE
26 
27  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_o3c_types'
28 
29 ! **************************************************************************************************
30 ! O3C Integrals
31 ! **************************************************************************************************
32 
33  TYPE o3c_int_type
34  PRIVATE
35  INTEGER :: katom, kkind
36  INTEGER :: ni, nj, nk
37  REAL(KIND=dp), DIMENSION(3) :: rik
38  INTEGER, DIMENSION(3) :: cellk
39  REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: integral
40  REAL(KIND=dp), DIMENSION(:, :), POINTER :: tvec
41  REAL(KIND=dp), DIMENSION(:, :), POINTER :: force_i
42  REAL(KIND=dp), DIMENSION(:, :), POINTER :: force_j
43  REAL(KIND=dp), DIMENSION(:, :), POINTER :: force_k
44  END TYPE o3c_int_type
45 
46  TYPE o3c_pair_type
47  PRIVATE
48  INTEGER :: iatom, ikind
49  INTEGER :: jatom, jkind
50  REAL(KIND=dp), DIMENSION(3) :: rij
51  INTEGER, DIMENSION(3) :: cellj
52  INTEGER :: nklist
53  TYPE(o3c_int_type), DIMENSION(:), POINTER :: ijk
54  END TYPE o3c_pair_type
55 
56  TYPE o3c_container_type
57  PRIVATE
58  LOGICAL :: ijsymmetric
59  INTEGER :: nijpairs
60  INTEGER :: nspin
61  TYPE(o3c_pair_type), DIMENSION(:), POINTER :: ijpair
62  ! basis sets and neighbor lists are pointing to other resources
63  ! we don't keep track if the data is available and correct
64  TYPE(gto_basis_set_p_type), DIMENSION(:), &
65  POINTER :: basis_set_list_a, basis_set_list_b, &
66  basis_set_list_c
67  TYPE(neighbor_list_set_p_type), &
68  DIMENSION(:), POINTER :: sab_nl, sac_nl
69  END TYPE o3c_container_type
70 
71 ! **************************************************************************************************
72 ! O3C Iterator
73 ! **************************************************************************************************
74 
75  TYPE o3c_iterator_type
76  PRIVATE
77  TYPE(o3c_container_type), POINTER :: o3c
78  INTEGER :: ijp_last, k_last
79  INTEGER, DIMENSION(:), POINTER :: ijp_thread, k_thread
80  END TYPE o3c_iterator_type
81 
82 ! **************************************************************************************************
83 ! O3C vector
84 ! **************************************************************************************************
85 
86  TYPE o3c_vec_type
87  PRIVATE
88  INTEGER :: n
89  REAL(KIND=dp), DIMENSION(:), POINTER :: v
90  END TYPE o3c_vec_type
91 
92 ! **************************************************************************************************
93 
94  PUBLIC :: o3c_container_type
95  PUBLIC :: release_o3c_container, init_o3c_container, get_o3c_container, set_o3c_container
96  PUBLIC :: o3c_iterator_type
97  PUBLIC :: o3c_iterator_create, o3c_iterator_release, get_o3c_iterator_info, o3c_iterate
98  PUBLIC :: o3c_vec_type
99  PUBLIC :: o3c_vec_create, o3c_vec_release, get_o3c_vec
100 
101 CONTAINS
102 
103 ! **************************************************************************************************
104 !> \brief ...
105 !> \param o3c ...
106 !> \param nspin ...
107 !> \param basis_set_list_a ...
108 !> \param basis_set_list_b ...
109 !> \param basis_set_list_c ...
110 !> \param sab_nl ...
111 !> \param sac_nl ...
112 !> \param only_bc_same_center only consider a,b,c atoms if b and c share the same center
113 !> \par History: only_bc_same_cetner added by A.Bussy for XAS_TDP (04.2019)
114 ! **************************************************************************************************
115  SUBROUTINE init_o3c_container(o3c, nspin, basis_set_list_a, basis_set_list_b, basis_set_list_c, &
116  sab_nl, sac_nl, only_bc_same_center)
117  TYPE(o3c_container_type) :: o3c
118  INTEGER, INTENT(IN) :: nspin
119  TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: basis_set_list_a, basis_set_list_b, &
120  basis_set_list_c
121  TYPE(neighbor_list_set_p_type), DIMENSION(:), &
122  POINTER :: sab_nl, sac_nl
123  LOGICAL, INTENT(IN), OPTIONAL :: only_bc_same_center
124 
125  INTEGER :: kkind, nij, nk, nkind
126  LOGICAL :: my_sort_bc, symmetric
127  REAL(dp) :: rik(3), rjk(3)
128  TYPE(neighbor_list_iterator_p_type), &
129  DIMENSION(:), POINTER :: ac_iterator, nl_iterator
130  TYPE(o3c_int_type), POINTER :: ijk
131  TYPE(o3c_pair_type), POINTER :: ijpair
132 
133  CALL get_neighbor_list_set_p(sab_nl, symmetric=symmetric)
134  o3c%ijsymmetric = symmetric
135  cpassert(symmetric)
136 
137  o3c%nspin = nspin
138 
139  o3c%basis_set_list_a => basis_set_list_a
140  o3c%basis_set_list_b => basis_set_list_b
141  o3c%basis_set_list_c => basis_set_list_c
142 
143  o3c%sab_nl => sab_nl
144  o3c%sac_nl => sac_nl
145 
146  nkind = SIZE(basis_set_list_a)
147 
148  my_sort_bc = .false.
149  IF (PRESENT(only_bc_same_center)) my_sort_bc = only_bc_same_center
150 
151  ! determine the number of ij pairs
152  nij = 0
153  CALL neighbor_list_iterator_create(nl_iterator, sab_nl)
154  DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
155  nij = nij + 1
156  END DO
157  CALL neighbor_list_iterator_release(nl_iterator)
158  o3c%nijpairs = nij
159  NULLIFY (o3c%ijpair)
160  ALLOCATE (o3c%ijpair(nij))
161 
162  ! for each pair set up the ijk lists
163  nij = 0
164  CALL neighbor_list_iterator_create(nl_iterator, sab_nl)
165  CALL neighbor_list_iterator_create(ac_iterator, sac_nl, search=.true.)
166  DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
167  nij = nij + 1
168  ijpair => o3c%ijpair(nij)
169  CALL get_iterator_info(nl_iterator, ikind=ijpair%ikind, jkind=ijpair%jkind, &
170  iatom=ijpair%iatom, jatom=ijpair%jatom, &
171  r=ijpair%rij, cell=ijpair%cellj)
172  NULLIFY (ijpair%ijk)
173  nk = 0
174  DO kkind = 1, nkind
175  CALL nl_set_sub_iterator(ac_iterator, ijpair%ikind, kkind, ijpair%iatom)
176  DO WHILE (nl_sub_iterate(ac_iterator) == 0)
177  IF (my_sort_bc) THEN
178  !we only take ijk if rjk = 0 OR rik = 0 (because of symmetry)
179  CALL get_iterator_info(ac_iterator, r=rik)
180  rjk(:) = rik(:) - ijpair%rij(:)
181  IF (.NOT. (all(abs(rjk) .LE. 1.0e-4_dp) .OR. all(abs(rik) .LE. 1.0e-4_dp))) cycle
182  END IF
183  nk = nk + 1
184  END DO
185  END DO
186  ! ijk lists
187  ijpair%nklist = nk
188  ALLOCATE (ijpair%ijk(nk))
189  ! fill the ijk lists
190  nk = 0
191  DO kkind = 1, nkind
192  CALL nl_set_sub_iterator(ac_iterator, ijpair%ikind, kkind, ijpair%iatom)
193  DO WHILE (nl_sub_iterate(ac_iterator) == 0)
194  IF (my_sort_bc) THEN
195  !we only take ijk if rjk = 0 OR rik = 0 (because of symmetry)
196  CALL get_iterator_info(ac_iterator, r=rik)
197  rjk(:) = rik(:) - ijpair%rij(:)
198  IF (.NOT. (all(abs(rjk) .LE. 1.0e-4_dp) .OR. all(abs(rik) .LE. 1.0e-4_dp))) cycle
199  END IF
200 
201  nk = nk + 1
202  ijk => ijpair%ijk(nk)
203  CALL get_iterator_info(ac_iterator, jatom=ijk%katom, r=ijk%rik, cell=ijk%cellk)
204  ijk%kkind = kkind
205  ijk%ni = 0
206  ijk%nj = 0
207  ijk%nk = 0
208  NULLIFY (ijk%integral)
209  NULLIFY (ijk%tvec)
210  NULLIFY (ijk%force_i)
211  NULLIFY (ijk%force_j)
212  NULLIFY (ijk%force_k)
213  END DO
214  END DO
215  END DO
216  CALL neighbor_list_iterator_release(ac_iterator)
217  CALL neighbor_list_iterator_release(nl_iterator)
218 
219  END SUBROUTINE init_o3c_container
220 ! **************************************************************************************************
221 !> \brief ...
222 !> \param o3c_container ...
223 ! **************************************************************************************************
224  SUBROUTINE release_o3c_container(o3c_container)
225 
226  TYPE(o3c_container_type) :: o3c_container
227 
228  o3c_container%ijsymmetric = .false.
229  o3c_container%nijpairs = 0
230 
231  NULLIFY (o3c_container%basis_set_list_a)
232  NULLIFY (o3c_container%basis_set_list_b)
233  NULLIFY (o3c_container%basis_set_list_c)
234 
235  NULLIFY (o3c_container%sab_nl)
236  NULLIFY (o3c_container%sac_nl)
237 
238  IF (ASSOCIATED(o3c_container%ijpair)) THEN
239  CALL release_ijpair(o3c_container%ijpair)
240  DEALLOCATE (o3c_container%ijpair)
241  END IF
242 
243  END SUBROUTINE release_o3c_container
244 
245 ! **************************************************************************************************
246 !> \brief ...
247 !> \param ijpair ...
248 ! **************************************************************************************************
249  SUBROUTINE release_ijpair(ijpair)
250 
251  TYPE(o3c_pair_type), DIMENSION(:) :: ijpair
252 
253  INTEGER :: i
254 
255  DO i = 1, SIZE(ijpair)
256  ijpair(i)%iatom = 0
257  ijpair(i)%ikind = 0
258  ijpair(i)%jatom = 0
259  ijpair(i)%jkind = 0
260  ijpair(i)%nklist = 0
261  ijpair(i)%rij = 0.0_dp
262  ijpair(i)%cellj = 0
263  IF (ASSOCIATED(ijpair(i)%ijk)) THEN
264  CALL release_ijk(ijpair(i)%ijk)
265  DEALLOCATE (ijpair(i)%ijk)
266  END IF
267  END DO
268 
269  END SUBROUTINE release_ijpair
270 
271 ! **************************************************************************************************
272 !> \brief ...
273 !> \param ijk ...
274 ! **************************************************************************************************
275  SUBROUTINE release_ijk(ijk)
276 
277  TYPE(o3c_int_type), DIMENSION(:) :: ijk
278 
279  INTEGER :: i
280 
281  DO i = 1, SIZE(ijk)
282  ijk(i)%katom = 0
283  ijk(i)%kkind = 0
284  ijk(i)%ni = 0
285  ijk(i)%nj = 0
286  ijk(i)%nk = 0
287  ijk(i)%rik = 0.0_dp
288  ijk(i)%cellk = 0
289  IF (ASSOCIATED(ijk(i)%integral)) THEN
290  DEALLOCATE (ijk(i)%integral)
291  END IF
292  IF (ASSOCIATED(ijk(i)%tvec)) THEN
293  DEALLOCATE (ijk(i)%tvec)
294  END IF
295  IF (ASSOCIATED(ijk(i)%force_i)) THEN
296  DEALLOCATE (ijk(i)%force_i)
297  END IF
298  IF (ASSOCIATED(ijk(i)%force_j)) THEN
299  DEALLOCATE (ijk(i)%force_j)
300  END IF
301  IF (ASSOCIATED(ijk(i)%force_k)) THEN
302  DEALLOCATE (ijk(i)%force_k)
303  END IF
304  END DO
305 
306  END SUBROUTINE release_ijk
307 
308 ! **************************************************************************************************
309 !> \brief ...
310 !> \param o3c ...
311 !> \param ijsymmetric ...
312 !> \param nspin ...
313 !> \param nijpairs ...
314 !> \param ijpair ...
315 !> \param basis_set_list_a ...
316 !> \param basis_set_list_b ...
317 !> \param basis_set_list_c ...
318 !> \param sab_nl ...
319 !> \param sac_nl ...
320 ! **************************************************************************************************
321 
322  SUBROUTINE get_o3c_container(o3c, ijsymmetric, nspin, nijpairs, ijpair, &
323  basis_set_list_a, basis_set_list_b, basis_set_list_c, &
324  sab_nl, sac_nl)
325  TYPE(o3c_container_type) :: o3c
326  LOGICAL, OPTIONAL :: ijsymmetric
327  INTEGER, OPTIONAL :: nspin, nijpairs
328  TYPE(o3c_pair_type), DIMENSION(:), OPTIONAL, &
329  POINTER :: ijpair
330  TYPE(gto_basis_set_p_type), DIMENSION(:), &
331  OPTIONAL, POINTER :: basis_set_list_a, basis_set_list_b, &
332  basis_set_list_c
333  TYPE(neighbor_list_set_p_type), DIMENSION(:), &
334  OPTIONAL, POINTER :: sab_nl, sac_nl
335 
336  IF (PRESENT(ijsymmetric)) ijsymmetric = o3c%ijsymmetric
337  IF (PRESENT(nspin)) nspin = o3c%nspin
338  IF (PRESENT(nijpairs)) nijpairs = o3c%nijpairs
339  IF (PRESENT(ijpair)) ijpair => o3c%ijpair
340  IF (PRESENT(basis_set_list_a)) basis_set_list_a => o3c%basis_set_list_a
341  IF (PRESENT(basis_set_list_b)) basis_set_list_b => o3c%basis_set_list_b
342  IF (PRESENT(basis_set_list_c)) basis_set_list_c => o3c%basis_set_list_c
343  IF (PRESENT(sab_nl)) sab_nl => o3c%sab_nl
344  IF (PRESENT(sac_nl)) sac_nl => o3c%sac_nl
345 
346  END SUBROUTINE get_o3c_container
347 
348 ! **************************************************************************************************
349 ! O3C Iterator
350 ! **************************************************************************************************
351 !> \brief ...
352 !> \param o3c ...
353 !> \param o3c_iterator ...
354 !> \param nthread ...
355 ! **************************************************************************************************
356  SUBROUTINE o3c_iterator_create(o3c, o3c_iterator, nthread)
357  TYPE(o3c_container_type), POINTER :: o3c
358  TYPE(o3c_iterator_type) :: o3c_iterator
359  INTEGER, OPTIONAL :: nthread
360 
361  INTEGER :: n
362 
363  IF (PRESENT(nthread)) THEN
364  n = nthread
365  ELSE
366  n = 1
367  END IF
368 
369  o3c_iterator%o3c => o3c
370  o3c_iterator%ijp_last = 0
371  o3c_iterator%k_last = 0
372  ALLOCATE (o3c_iterator%ijp_thread(0:n - 1))
373  ALLOCATE (o3c_iterator%k_thread(0:n - 1))
374  o3c_iterator%ijp_thread = 0
375  o3c_iterator%k_thread = 0
376 
377  END SUBROUTINE o3c_iterator_create
378 
379 ! **************************************************************************************************
380 !> \brief ...
381 !> \param o3c_iterator ...
382 ! **************************************************************************************************
383  SUBROUTINE o3c_iterator_release(o3c_iterator)
384  TYPE(o3c_iterator_type) :: o3c_iterator
385 
386  NULLIFY (o3c_iterator%o3c)
387  o3c_iterator%ijp_last = 0
388  o3c_iterator%k_last = 0
389  DEALLOCATE (o3c_iterator%ijp_thread)
390  DEALLOCATE (o3c_iterator%k_thread)
391 
392  END SUBROUTINE o3c_iterator_release
393 
394 ! **************************************************************************************************
395 !> \brief ...
396 !> \param o3c_iterator ...
397 !> \param mepos ...
398 !> \param iatom ...
399 !> \param jatom ...
400 !> \param katom ...
401 !> \param ikind ...
402 !> \param jkind ...
403 !> \param kkind ...
404 !> \param rij ...
405 !> \param rik ...
406 !> \param cellj ...
407 !> \param cellk ...
408 !> \param integral ...
409 !> \param tvec ...
410 !> \param force_i ...
411 !> \param force_j ...
412 !> \param force_k ...
413 ! **************************************************************************************************
414  SUBROUTINE get_o3c_iterator_info(o3c_iterator, mepos, &
415  iatom, jatom, katom, ikind, jkind, kkind, &
416  rij, rik, cellj, cellk, &
417  integral, tvec, force_i, force_j, force_k)
418  TYPE(o3c_iterator_type) :: o3c_iterator
419  INTEGER, OPTIONAL :: mepos, iatom, jatom, katom, ikind, &
420  jkind, kkind
421  REAL(kind=dp), DIMENSION(3), OPTIONAL :: rij, rik
422  INTEGER, DIMENSION(3), OPTIONAL :: cellj, cellk
423  REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
424  POINTER :: integral
425  REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: tvec, force_i, force_j, force_k
426 
427  INTEGER :: ij, k, me
428  TYPE(o3c_container_type), POINTER :: o3c
429  TYPE(o3c_int_type), POINTER :: ijk
430  TYPE(o3c_pair_type), POINTER :: ijp
431 
432  IF (PRESENT(mepos)) THEN
433  me = mepos
434  ELSE
435  me = 0
436  END IF
437 
438  ij = o3c_iterator%ijp_thread(me)
439  k = o3c_iterator%k_thread(me)
440 
441  o3c => o3c_iterator%o3c
442  ijp => o3c%ijpair(ij)
443  ijk => ijp%ijk(k)
444 
445  IF (PRESENT(iatom)) iatom = ijp%iatom
446  IF (PRESENT(jatom)) jatom = ijp%jatom
447  IF (PRESENT(ikind)) ikind = ijp%ikind
448  IF (PRESENT(jkind)) jkind = ijp%jkind
449  IF (PRESENT(katom)) katom = ijk%katom
450  IF (PRESENT(kkind)) kkind = ijk%kkind
451 
452  IF (PRESENT(rij)) rij(1:3) = ijp%rij(1:3)
453  IF (PRESENT(rik)) rik(1:3) = ijk%rik(1:3)
454 
455  IF (PRESENT(cellj)) cellj(1:3) = ijp%cellj(1:3)
456  IF (PRESENT(cellk)) cellk(1:3) = ijk%cellk(1:3)
457 
458  IF (PRESENT(integral)) integral => ijk%integral
459  IF (PRESENT(tvec)) tvec => ijk%tvec
460  IF (PRESENT(force_i)) force_i => ijk%force_i
461  IF (PRESENT(force_j)) force_j => ijk%force_j
462  IF (PRESENT(force_k)) force_k => ijk%force_k
463 
464  END SUBROUTINE get_o3c_iterator_info
465 
466 ! **************************************************************************************************
467 !> \brief ...
468 !> \param o3c_iterator ...
469 !> \param mepos ...
470 !> \return ...
471 ! **************************************************************************************************
472  FUNCTION o3c_iterate(o3c_iterator, mepos) RESULT(istat)
473  TYPE(o3c_iterator_type) :: o3c_iterator
474  INTEGER, OPTIONAL :: mepos
475  INTEGER :: istat
476 
477  INTEGER :: ij, ijpair, klist, me
478  TYPE(o3c_container_type), POINTER :: o3c
479 
480  IF (PRESENT(mepos)) THEN
481  me = mepos
482  ELSE
483  me = 0
484  END IF
485 
486  !If the neighbors lists are restricted (XAS_TDP), might have nijpairs = 0 on some procs
487  IF (o3c_iterator%o3c%nijpairs == 0) THEN
488  istat = 1
489  RETURN
490  END IF
491 
492 !$OMP CRITICAL(o3c_iterate_critical)
493  o3c => o3c_iterator%o3c
494  ! we iterate from the last position
495  ijpair = o3c_iterator%ijp_last
496  klist = o3c_iterator%k_last
497 
498  IF (ijpair == 0 .AND. klist == 0) THEN
499  ! first step
500  istat = 1
501  DO ij = 1, o3c%nijpairs
502  IF (o3c%ijpair(ij)%nklist > 0) THEN
503  o3c_iterator%ijp_thread(me) = ij
504  o3c_iterator%k_thread(me) = 1
505  istat = 0
506  EXIT
507  END IF
508  END DO
509  ELSE IF (ijpair == o3c%nijpairs .AND. klist == o3c%ijpair(ijpair)%nklist) THEN
510  ! last step reached
511  istat = 1
512  ELSE IF (klist == o3c%ijpair(ijpair)%nklist) THEN
513  ! last step in this ij list
514  istat = 1
515  DO ij = ijpair + 1, o3c%nijpairs
516  IF (o3c%ijpair(ij)%nklist > 0) THEN
517  o3c_iterator%ijp_thread(me) = ij
518  o3c_iterator%k_thread(me) = 1
519  istat = 0
520  EXIT
521  END IF
522  END DO
523  ELSE
524  ! increase klist
525  o3c_iterator%ijp_thread(me) = ijpair
526  o3c_iterator%k_thread(me) = klist + 1
527  istat = 0
528  END IF
529 
530  IF (istat == 0) THEN
531  ! set last to this thread
532  o3c_iterator%ijp_last = o3c_iterator%ijp_thread(me)
533  o3c_iterator%k_last = o3c_iterator%k_thread(me)
534  ELSE
535  ! set last to final position
536  o3c_iterator%ijp_last = o3c%nijpairs
537  o3c_iterator%k_last = o3c%ijpair(o3c%nijpairs)%nklist
538  END IF
539 !$OMP END CRITICAL(o3c_iterate_critical)
540 
541  END FUNCTION o3c_iterate
542 
543 ! **************************************************************************************************
544 !> \brief ...
545 !> \param o3c_iterator ...
546 !> \param mepos ...
547 !> \param integral ...
548 !> \param tvec ...
549 !> \param force_i ...
550 !> \param force_j ...
551 !> \param force_k ...
552 ! **************************************************************************************************
553  SUBROUTINE set_o3c_container(o3c_iterator, mepos, integral, tvec, force_i, force_j, force_k)
554  TYPE(o3c_iterator_type) :: o3c_iterator
555  INTEGER, OPTIONAL :: mepos
556  REAL(kind=dp), DIMENSION(:, :, :), OPTIONAL, &
557  POINTER :: integral
558  REAL(kind=dp), DIMENSION(:, :), OPTIONAL, POINTER :: tvec, force_i, force_j, force_k
559 
560  INTEGER :: ij, k, me
561  TYPE(o3c_container_type), POINTER :: o3c
562  TYPE(o3c_int_type), POINTER :: ijk
563  TYPE(o3c_pair_type), POINTER :: ijp
564 
565  IF (PRESENT(mepos)) THEN
566  me = mepos
567  ELSE
568  me = 0
569  END IF
570 
571  ij = o3c_iterator%ijp_thread(me)
572  k = o3c_iterator%k_thread(me)
573 
574  o3c => o3c_iterator%o3c
575  ijp => o3c%ijpair(ij)
576  ijk => ijp%ijk(k)
577 
578  IF (PRESENT(integral)) ijk%integral => integral
579  IF (PRESENT(tvec)) ijk%tvec => tvec
580  IF (PRESENT(force_i)) ijk%force_i => force_i
581  IF (PRESENT(force_j)) ijk%force_j => force_j
582  IF (PRESENT(force_k)) ijk%force_k => force_k
583 
584  END SUBROUTINE set_o3c_container
585 
586 ! **************************************************************************************************
587 !> \brief ...
588 !> \param o3c_vec ...
589 !> \param nsize ...
590 ! **************************************************************************************************
591  SUBROUTINE o3c_vec_create(o3c_vec, nsize)
592  TYPE(o3c_vec_type), DIMENSION(:) :: o3c_vec
593  INTEGER, DIMENSION(:), INTENT(IN) :: nsize
594 
595  INTEGER :: i, m, n
596 
597  m = SIZE(o3c_vec)
598  cpassert(SIZE(nsize) == m)
599 
600  DO i = 1, m
601  n = nsize(i)
602  ALLOCATE (o3c_vec(i)%v(n))
603  o3c_vec(i)%v = 0.0_dp
604  o3c_vec(i)%n = n
605  END DO
606 
607  END SUBROUTINE o3c_vec_create
608 
609 ! **************************************************************************************************
610 !> \brief ...
611 !> \param o3c_vec ...
612 ! **************************************************************************************************
613  SUBROUTINE o3c_vec_release(o3c_vec)
614  TYPE(o3c_vec_type), DIMENSION(:) :: o3c_vec
615 
616  INTEGER :: i
617 
618  DO i = 1, SIZE(o3c_vec)
619  IF (ASSOCIATED(o3c_vec(i)%v)) THEN
620  DEALLOCATE (o3c_vec(i)%v)
621  END IF
622  END DO
623 
624  END SUBROUTINE o3c_vec_release
625 
626 ! **************************************************************************************************
627 !> \brief ...
628 !> \param o3c_vec ...
629 !> \param i ...
630 !> \param vec ...
631 !> \param n ...
632 ! **************************************************************************************************
633  SUBROUTINE get_o3c_vec(o3c_vec, i, vec, n)
634  TYPE(o3c_vec_type), DIMENSION(:) :: o3c_vec
635  INTEGER, INTENT(IN) :: i
636  REAL(kind=dp), DIMENSION(:), OPTIONAL, POINTER :: vec
637  INTEGER, OPTIONAL :: n
638 
639  cpassert(i > 0 .AND. i <= SIZE(o3c_vec))
640 
641  IF (PRESENT(vec)) vec => o3c_vec(i)%v
642  IF (PRESENT(n)) n = o3c_vec(i)%n
643 
644  END SUBROUTINE get_o3c_vec
645 
646 ! **************************************************************************************************
647 
648 END MODULE qs_o3c_types
basis_set_types
Definition: basis_set_types.F:15
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
qs_neighbor_list_types
Define the neighbor list data types and the corresponding functionality.
Definition: qs_neighbor_list_types.F:17
qs_neighbor_list_types::nl_sub_iterate
integer function, public nl_sub_iterate(iterator_set, mepos)
...
Definition: qs_neighbor_list_types.F:440
qs_neighbor_list_types::neighbor_list_iterator_create
subroutine, public neighbor_list_iterator_create(iterator_set, nl, search, nthread)
Neighbor list iterator functions.
Definition: qs_neighbor_list_types.F:165
qs_neighbor_list_types::nl_set_sub_iterator
subroutine, public nl_set_sub_iterator(iterator_set, ikind, jkind, iatom, mepos)
...
Definition: qs_neighbor_list_types.F:288
qs_neighbor_list_types::neighbor_list_iterator_release
subroutine, public neighbor_list_iterator_release(iterator_set)
...
Definition: qs_neighbor_list_types.F:251
qs_neighbor_list_types::get_neighbor_list_set_p
subroutine, public get_neighbor_list_set_p(neighbor_list_sets, nlist, symmetric)
Return the components of the first neighbor list set.
Definition: qs_neighbor_list_types.F:993
qs_neighbor_list_types::neighbor_list_iterate
integer function, public neighbor_list_iterate(iterator_set, mepos)
...
Definition: qs_neighbor_list_types.F:351
qs_neighbor_list_types::get_iterator_info
subroutine, public get_iterator_info(iterator_set, mepos, ikind, jkind, nkind, ilist, nlist, inode, nnode, iatom, jatom, r, cell)
...
Definition: qs_neighbor_list_types.F:549
qs_o3c_types
3-center overlap type integrals containers
Definition: qs_o3c_types.F:12
qs_o3c_types::o3c_vec_create
subroutine, public o3c_vec_create(o3c_vec, nsize)
...
Definition: qs_o3c_types.F:592
qs_o3c_types::set_o3c_container
subroutine, public set_o3c_container(o3c_iterator, mepos, integral, tvec, force_i, force_j, force_k)
...
Definition: qs_o3c_types.F:554
qs_o3c_types::get_o3c_iterator_info
subroutine, public get_o3c_iterator_info(o3c_iterator, mepos, iatom, jatom, katom, ikind, jkind, kkind, rij, rik, cellj, cellk, integral, tvec, force_i, force_j, force_k)
...
Definition: qs_o3c_types.F:418
qs_o3c_types::o3c_iterator_create
subroutine, public o3c_iterator_create(o3c, o3c_iterator, nthread)
...
Definition: qs_o3c_types.F:357
qs_o3c_types::release_o3c_container
subroutine, public release_o3c_container(o3c_container)
...
Definition: qs_o3c_types.F:225
qs_o3c_types::o3c_iterator_release
subroutine, public o3c_iterator_release(o3c_iterator)
...
Definition: qs_o3c_types.F:384
qs_o3c_types::get_o3c_vec
subroutine, public get_o3c_vec(o3c_vec, i, vec, n)
...
Definition: qs_o3c_types.F:634
qs_o3c_types::o3c_iterate
integer function, public o3c_iterate(o3c_iterator, mepos)
...
Definition: qs_o3c_types.F:473
qs_o3c_types::o3c_vec_release
subroutine, public o3c_vec_release(o3c_vec)
...
Definition: qs_o3c_types.F:614
qs_o3c_types::init_o3c_container
subroutine, public init_o3c_container(o3c, nspin, basis_set_list_a, basis_set_list_b, basis_set_list_c, sab_nl, sac_nl, only_bc_same_center)
...
Definition: qs_o3c_types.F:117
qs_o3c_types::get_o3c_container
subroutine, public get_o3c_container(o3c, ijsymmetric, nspin, nijpairs, ijpair, basis_set_list_a, basis_set_list_b, basis_set_list_c, sab_nl, sac_nl)
...
Definition: qs_o3c_types.F:325