LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-22 03:23:29 +01:00
Code Releases Activity

normal ordering: aab-DGEMM OK

Browse Source
This commit is contained in:
Abdallah Ammar 2023-06-05 16:08:46 +02:00
parent 3a5dd05d7e
commit b0da0ac04d
1 changed files with 51 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
src/tc_bi_ortho/normal_ordered.irp.f
View File

@ -398,7 +398,7 @@ BEGIN_PROVIDER [ double precision, no_aba_contraction, (mo_num,mo_num,mo_num,mo_
enddo !i enddo !i
endif endif
deallocate(tmp_3d) deallocate(tmp_2d, tmp_3d)
deallocate(tmp1, tmp2) deallocate(tmp1, tmp2)
deallocate(tmpval_1, tmpval_2) deallocate(tmpval_1, tmpval_2)
deallocate(tmpvec_1, tmpvec_2) deallocate(tmpvec_1, tmpvec_2)
@ -446,12 +446,12 @@ BEGIN_PROVIDER [ double precision, no_aab_contraction, (mo_num,mo_num,mo_num,mo_
call bitstring_to_list_ab(ref_bitmask, occ, Ne, N_int) call bitstring_to_list_ab(ref_bitmask, occ, Ne, N_int)
endif endif
allocate(tmp_2d(mo_num,mo_num))
allocate(tmp_3d(mo_num,mo_num,mo_num)) allocate(tmp_3d(mo_num,mo_num,mo_num))
allocate(tmp1(n_points_final_grid,3,mo_num)) allocate(tmp1(n_points_final_grid,3,mo_num))
allocate(tmp2(n_points_final_grid,mo_num)) allocate(tmp2(n_points_final_grid,mo_num))
allocate(tmpval_1(n_points_final_grid)) allocate(tmpval_1(n_points_final_grid))
allocate(tmpvec_1(n_points_final_grid,3)) allocate(tmpvec_1(n_points_final_grid,3))
allocate(tmp_2d(mo_num,mo_num))
! purely closed shell part ! purely closed shell part
@ -567,9 +567,38 @@ BEGIN_PROVIDER [ double precision, no_aab_contraction, (mo_num,mo_num,mo_num,mo_
deallocate(tmpval_1) deallocate(tmpval_1)
deallocate(tmpvec_1) deallocate(tmpvec_1)
no_aab_contraction = 0.5d0 * no_aab_contraction no_aab_contraction = -0.5d0 * no_aab_contraction
call sub_A_At(no_aab_contraction(1,1,1,1), mo_num*mo_num)
!$OMP PARALLEL &
!$OMP DEFAULT (NONE) &
!$OMP PRIVATE (h1, h2, p1, p2) &
!$OMP SHARED (no_aab_contraction, mo_num)
!$OMP DO
do h1 = 1, mo_num
do h2 = 1, mo_num
do p1 = 1, mo_num
do p2 = p1, mo_num
no_aab_contraction(p2,h2,p1,h1) -= no_aab_contraction(p1,h2,p2,h1)
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP DO
do h1 = 1, mo_num
do h2 = 1, mo_num
do p1 = 2, mo_num
do p2 = 1, p1-1
no_aab_contraction(p2,h2,p1,h1) = -no_aab_contraction(p1,h2,p2,h1)
enddo
enddo
enddo
enddo
!$OMP END DO
!$OMP DO
do h1 = 1, mo_num-1 do h1 = 1, mo_num-1
do h2 = h1+1, mo_num do h2 = h1+1, mo_num
do p1 = 2, mo_num do p1 = 2, mo_num
@ -579,11 +608,11 @@ BEGIN_PROVIDER [ double precision, no_aab_contraction, (mo_num,mo_num,mo_num,mo_
enddo enddo
enddo enddo
enddo enddo
!$OMP END PARALLEL
call wall_time(wall1) call wall_time(wall1)
print*,' Wall time for no_aab_contraction', wall1-wall0 print*,' Wall time for no_aab_contraction', wall1-wall0
END_PROVIDER END_PROVIDER
! --- ! ---