LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-05-06 15:14:50 +02:00
Code Issues Releases Wiki Activity

Four index

Browse Source
This commit is contained in:
Anthony Scemama 2017-09-26 15:17:45 +02:00
parent 9e791e52d2
commit 2ac2853f5c
2 changed files with 13 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
plugins/FourIdx/four_idx.irp.f
View File

@ -18,6 +18,11 @@ program FourIdx
1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, &
1, 1, 1, 1, mo_tot_num, mo_tot_num, mo_tot_num, mo_tot_num)
! call four_index_transform(ao_integrals_map,test_map, &
! mo_coef, size(mo_coef,1), &
! 1, 1, 1, 1, ao_num, ao_num, ao_num, ao_num, &
! 1, 1, 1, 1, mo_tot_num, mo_tot_num, mo_tot_num, mo_tot_num)
integer :: i,j,k,l
real(integral_kind) :: integral1, integral2

11
plugins/FourIdx/four_index.irp.f
View File

@ -100,6 +100,7 @@ subroutine four_index_transform(map_a,map_c,matrix_B,LDB, &
deallocate(T)
allocate( T(a_start:a_end, k_start:k_end, b_start:d) )
! a=a_start,b
call DGEMM('N','N', (a_end-a_start+1)*(k_end-k_start+1), &
(d-b_start+1), &
(j_end-j_start+1), 1.d0, &
@ -122,9 +123,12 @@ subroutine four_index_transform(map_a,map_c,matrix_B,LDB, &
enddo
idx = 0_8
do b=b_start,d
do b=b_start,b_end
do c=c_start,c_end
do a=a_start,min(b,c)
do a=a_start,a_end
! if (a>b) cycle
! if (a>c) cycle
! if (b>d) cycle
if (dabs(U(a,c,b)) < 1.d-15) then
cycle
endif
@ -137,7 +141,8 @@ subroutine four_index_transform(map_a,map_c,matrix_B,LDB, &
!$OMP CRITICAL
call map_append(map_c, key, value, idx)
call map_sort(map_c)
call map_unique(map_c)
! call map_update(map_c, key, value, idx)
! call map_merge(map_c)
!$OMP END CRITICAL
enddo