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
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)
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