(git:374b731)
Loading...
Searching...
No Matches
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! **************************************************************************************************
12MODULE 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
101CONTAINS
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
648END MODULE qs_o3c_types
qs_neighbor_list_types::nl_sub_iterate
Definition qs_neighbor_list_types.F:96
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::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
basis_set_types::gto_basis_set_p_type
Definition basis_set_types.F:93
qs_neighbor_list_types::neighbor_list_iterator_p_type
Definition qs_neighbor_list_types.F:117
qs_neighbor_list_types::neighbor_list_set_p_type
Definition qs_neighbor_list_types.F:67
qs_o3c_types::o3c_container_type
Definition qs_o3c_types.F:56
qs_o3c_types::o3c_iterator_type
Definition qs_o3c_types.F:75
qs_o3c_types::o3c_vec_type
Definition qs_o3c_types.F:86