PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-23 04:43:45 +01:00
Code Releases Activity

Merge branch 'dev-stable-tc-scf' of https://github.com/AbdAmmar/qp2 into dev-stable-tc-scf

Browse Source
This commit is contained in:
AbdAmmar 2023-04-10 16:17:45 +02:00
commit d67861342a
1 changed files with 54 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
src/bi_ortho_mos/overlap.irp.f
View File

@ -12,32 +12,27 @@
double precision :: accu_d, accu_nd double precision :: accu_d, accu_nd
double precision, allocatable :: tmp(:,:) double precision, allocatable :: tmp(:,:)
! TODO : re do the DEGEMM ! overlap_bi_ortho = 0.d0
! do i = 1, mo_num
! do k = 1, mo_num
! do m = 1, ao_num
! do n = 1, ao_num
! overlap_bi_ortho(k,i) += ao_overlap(n,m) * mo_l_coef(n,k) * mo_r_coef(m,i)
! enddo
! enddo
! enddo
! enddo
overlap_bi_ortho = 0.d0 allocate( tmp(mo_num,ao_num) )
do i = 1, mo_num ! tmp <-- L.T x S_ao
do k = 1, mo_num call dgemm( "T", "N", mo_num, ao_num, ao_num, 1.d0 &
do m = 1, ao_num , mo_l_coef(1,1), size(mo_l_coef, 1), ao_overlap(1,1), size(ao_overlap, 1) &
do n = 1, ao_num , 0.d0, tmp(1,1), size(tmp, 1) )
overlap_bi_ortho(k,i) += ao_overlap(n,m) * mo_l_coef(n,k) * mo_r_coef(m,i) ! S <-- tmp x R
enddo call dgemm( "N", "N", mo_num, mo_num, ao_num, 1.d0 &
enddo , tmp(1,1), size(tmp, 1), mo_r_coef(1,1), size(mo_r_coef, 1) &
enddo , 0.d0, overlap_bi_ortho(1,1), size(overlap_bi_ortho, 1) )
enddo deallocate(tmp)
! allocate( tmp(mo_num,ao_num) )
!
! ! tmp <-- L.T x S_ao
! call dgemm( "T", "N", mo_num, ao_num, ao_num, 1.d0 &
! , mo_l_coef, size(mo_l_coef, 1), ao_overlap, size(ao_overlap, 1) &
! , 0.d0, tmp, size(tmp, 1) )
!
! ! S <-- tmp x R
! call dgemm( "N", "N", mo_num, mo_num, ao_num, 1.d0 &
! , tmp, size(tmp, 1), mo_r_coef, size(mo_r_coef, 1) &
! , 0.d0, overlap_bi_ortho, size(overlap_bi_ortho, 1) )
!
! deallocate( tmp )
do i = 1, mo_num do i = 1, mo_num
overlap_diag_bi_ortho(i) = overlap_bi_ortho(i,i) overlap_diag_bi_ortho(i) = overlap_bi_ortho(i,i)
@ -84,20 +79,41 @@ END_PROVIDER
END_DOC END_DOC
implicit none implicit none
integer :: i, j, p, q integer :: i, j, p, q
double precision, allocatable :: tmp(:,:)
overlap_mo_r = 0.d0 !overlap_mo_r = 0.d0
overlap_mo_l = 0.d0 !overlap_mo_l = 0.d0
do i = 1, mo_num !do i = 1, mo_num
do j = 1, mo_num ! do j = 1, mo_num
do p = 1, ao_num ! do p = 1, ao_num
do q = 1, ao_num ! do q = 1, ao_num
overlap_mo_r(j,i) += mo_r_coef(q,i) * mo_r_coef(p,j) * ao_overlap(q,p) ! overlap_mo_r(j,i) += mo_r_coef(q,i) * mo_r_coef(p,j) * ao_overlap(q,p)
overlap_mo_l(j,i) += mo_l_coef(q,i) * mo_l_coef(p,j) * ao_overlap(q,p) ! overlap_mo_l(j,i) += mo_l_coef(q,i) * mo_l_coef(p,j) * ao_overlap(q,p)
enddo ! enddo
enddo ! enddo
enddo ! enddo
enddo !enddo
allocate( tmp(mo_num,ao_num) )
tmp = 0.d0
call dgemm( "T", "N", mo_num, ao_num, ao_num, 1.d0 &
, mo_r_coef(1,1), size(mo_r_coef, 1), ao_overlap(1,1), size(ao_overlap, 1) &
, 0.d0, tmp(1,1), size(tmp, 1) )
call dgemm( "N", "N", mo_num, mo_num, ao_num, 1.d0 &
, tmp(1,1), size(tmp, 1), mo_r_coef(1,1), size(mo_r_coef, 1) &
, 0.d0, overlap_mo_r(1,1), size(overlap_mo_r, 1) )
tmp = 0.d0
call dgemm( "T", "N", mo_num, ao_num, ao_num, 1.d0 &
, mo_l_coef(1,1), size(mo_l_coef, 1), ao_overlap(1,1), size(ao_overlap, 1) &
, 0.d0, tmp(1,1), size(tmp, 1) )
call dgemm( "N", "N", mo_num, mo_num, ao_num, 1.d0 &
, tmp(1,1), size(tmp, 1), mo_l_coef(1,1), size(mo_l_coef, 1) &
, 0.d0, overlap_mo_l(1,1), size(overlap_mo_l, 1) )
deallocate(tmp)
END_PROVIDER END_PROVIDER