19 USE dbcsr_api,
ONLY: dbcsr_csr_type
26 #include "./base/base_uses.f90"
32 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_active_space_utils'
46 TYPE(cp_fm_type),
INTENT(IN) :: source_matrix
47 REAL(kind=
dp),
DIMENSION(:),
INTENT(OUT) :: target_array
48 INTEGER,
DIMENSION(:),
INTENT(IN) :: row_index, col_index
50 INTEGER :: i, i_sub, j, j_sub, max_col, max_row, &
54 CALL cp_fm_get_info(source_matrix, nrow_global=max_row, ncol_global=max_col)
55 nrows =
SIZE(row_index)
56 ncols =
SIZE(col_index)
58 cpassert(maxval(row_index) <= max_row)
59 cpassert(maxval(col_index) <= max_col)
60 cpassert(minval(row_index) > 0)
61 cpassert(minval(col_index) > 0)
62 cpassert(nrows <= max_row)
63 cpassert(ncols <= max_col)
65 cpassert(
SIZE(target_array) == nrows*ncols)
72 target_array(i + (j - 1)*nrows) = mval
85 SUBROUTINE eri_to_array(eri_env, array, active_orbitals, spin1, spin2)
86 TYPE(eri_type),
INTENT(IN) :: eri_env
87 REAL(kind=
dp),
DIMENSION(:),
INTENT(INOUT) :: array
88 INTEGER,
DIMENSION(:, :),
INTENT(IN) :: active_orbitals
89 INTEGER,
INTENT(IN) :: spin1, spin2
91 INTEGER :: i, i1, i12, i12l, i2, i3, i34, i34l, i4, &
92 ijkl, ijlk, irptr, j, jikl, jilk, k, &
93 klij, klji, l, lkij, lkji, nindex, &
95 INTEGER,
DIMENSION(2) :: irange
96 REAL(kind=
dp) :: erival
97 TYPE(dbcsr_csr_type),
POINTER :: eri
98 TYPE(mp_comm_type) :: mp_group
100 nmo_active =
SIZE(active_orbitals, 1)
101 nmo_max = eri_env%norb
102 nindex = (nmo_max*(nmo_max + 1))/2
103 IF (spin1 == 1 .AND. spin2 == 1)
THEN
104 eri => eri_env%eri(1)%csr_mat
105 ELSE IF ((spin1 == 1 .AND. spin2 == 2) .OR. (spin1 == 2 .AND. spin2 == 1))
THEN
106 eri => eri_env%eri(2)%csr_mat
108 eri => eri_env%eri(3)%csr_mat
111 CALL mp_group%set_handle(eri%mp_group%get_handle())
117 i1 = active_orbitals(i, spin1)
119 i2 = active_orbitals(j, spin1)
121 IF (i12 >= irange(1) .AND. i12 <= irange(2))
THEN
122 i12l = i12 - irange(1) + 1
123 irptr = eri%rowptr_local(i12l) - 1
124 DO i34l = 1, eri%nzerow_local(i12l)
125 i34 = eri%colind_local(irptr + i34l)
130 k = cp_findloc(active_orbitals(:, spin2), i3)
131 l = cp_findloc(active_orbitals(:, spin2), i4)
133 k = findloc(active_orbitals(:, spin2), i3, dim=1)
134 l = findloc(active_orbitals(:, spin2), i4, dim=1)
136 erival = eri%nzval_local%r_dp(irptr + i34l)
139 ijkl = i + (j - 1)*nmo_active + (k - 1)*nmo_active**2 + (l - 1)*nmo_active**3
140 jikl = j + (i - 1)*nmo_active + (k - 1)*nmo_active**2 + (l - 1)*nmo_active**3
141 ijlk = i + (j - 1)*nmo_active + (l - 1)*nmo_active**2 + (k - 1)*nmo_active**3
142 jilk = j + (i - 1)*nmo_active + (l - 1)*nmo_active**2 + (k - 1)*nmo_active**3
147 IF (spin1 == spin2)
THEN
148 klij = k + (l - 1)*nmo_active + (i - 1)*nmo_active**2 + (j - 1)*nmo_active**3
149 lkij = l + (k - 1)*nmo_active + (i - 1)*nmo_active**2 + (j - 1)*nmo_active**3
150 klji = k + (l - 1)*nmo_active + (j - 1)*nmo_active**2 + (i - 1)*nmo_active**3
151 lkji = l + (k - 1)*nmo_active + (j - 1)*nmo_active**2 + (i - 1)*nmo_active**3
161 CALL mp_group%sum(array)
173 PURE INTEGER FUNCTION cp_findloc(array, value)
RESULT(loc)
174 INTEGER,
DIMENSION(:),
INTENT(IN) :: array
175 INTEGER,
INTENT(IN) :: value
181 DO idx = 1,
SIZE(array)
182 IF (array(
idx) ==
value)
THEN
188 END FUNCTION cp_findloc
static GRID_HOST_DEVICE int idx(const orbital a)
Return coset index of given orbital angular momentum.
represent a full matrix distributed on many processors
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
subroutine, public cp_fm_get_element(matrix, irow_global, icol_global, alpha, local)
returns an element of a fm this value is valid on every cpu using this call is expensive
Defines the basic variable types.
integer, parameter, public dp
Interface to the message passing library MPI.
The types needed for the calculation of active space Hamiltonians.
subroutine, public csr_idx_from_combined(ij, n, i, j)
extracts indices i and j from combined index ij
integer function, public csr_idx_to_combined(i, j, n)
calculates combined index (ij)
integer function, dimension(2), public get_irange_csr(nindex, mp_group)
calculates index range for processor in group mp_group
Contains utility routines for the active space module.
subroutine, public eri_to_array(eri_env, array, active_orbitals, spin1, spin2)
Copy the eri tensor for spins isp1 and isp2 to a standard 1D Fortran array.
subroutine, public subspace_matrix_to_array(source_matrix, target_array, row_index, col_index)
Copy a (square portion) of a cp_fm_type matrix to a standard 1D Fortran array.