ao ortho kpts

src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f

@@ -0,0 +1,146 @@
+!todo: add kpts
+
+BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num_per_kpt ]
+  implicit none
+  ao_cart_to_sphe_num_per_kpt = ao_cart_to_sphe_num / kpt_num
+END_PROVIDER
+
+BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_kpts, (ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt) ]
+ implicit none
+ BEGIN_DOC
+ ! complex version of ao_cart_to_sphe_coef for one k-point
+ END_DOC
+ call zlacp2('A',ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt, &
+        ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), &
+        ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1))
+END_PROVIDER
+
+BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_overlap_kpts, (ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,kpt_num) ]
+  implicit none
+  BEGIN_DOC
+  ! AO overlap matrix in the spherical basis set
+  END_DOC
+  integer :: k
+  complex*16, allocatable :: S(:,:)
+  allocate (S(ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt))
+
+  !todo: call with (:,:,k) vs (1,1,k)? is there a difference? does one create a temporary array?
+  do k=1, kpt_num
+   
+    call zgemm('T','N',ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), &
+      ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), &
+      ao_overlap_kpts(1,1,k),size(ao_overlap_kpts,1), (0.d0,0.d0), &
+      S, size(S,1))
+   
+    call zgemm('N','N',ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), &
+      S, size(S,1), &
+      ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), (0.d0,0.d0), &
+      ao_cart_to_sphe_overlap_kpts(1,1,k),size(ao_cart_to_sphe_overlap_kpts,1))
+  enddo 
+  deallocate(S)
+
+END_PROVIDER
+
+
+
+
+BEGIN_PROVIDER [ complex*16, ao_ortho_cano_coef_inv_kpts, (ao_num_per_kpt,ao_num_per_kpt, kpt_num)]
+ implicit none
+ BEGIN_DOC
+! ao_ortho_canonical_coef_complex^(-1)
+ END_DOC
+ integer :: k
+ do k=1, kpt_num
+   call get_inverse_complex(ao_ortho_canonical_coef_kpts,size(ao_ortho_canonical_coef_kpts,1),&
+     ao_num_per_kpt, ao_ortho_cano_coef_inv_kpts, size(ao_ortho_cano_coef_inv_kpts,1))
+ enddo
+END_PROVIDER
+
+ BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt)]
+&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt, (kpt_num) ]
+&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt_max ]
+  implicit none
+  BEGIN_DOC
+! TODO: ao_ortho_canonical_num_complex should be the same as the real version
+!       maybe if the providers weren't linked we could avoid making a complex one?
+! matrix of the coefficients of the mos generated by the
+! orthonormalization by the S^{-1/2} canonical transformation of the aos
+! ao_ortho_canonical_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital
+  END_DOC
+  integer :: i,k
+  ao_ortho_canonical_coef_kpts = (0.d0,0.d0)
+  do k=1,kpt_num
+    do i=1,ao_num
+      ao_ortho_canonical_coef_kpts(i,i,k) = (1.d0,0.d0)
+    enddo
+  enddo
+
+!call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num)
+!ao_ortho_canonical_num=ao_num
+!return
+
+  if (ao_cartesian) then
+
+    ao_ortho_canonical_num_per_kpt = ao_num_per_kpt
+    do k=1,kpt_num
+      call ortho_canonical_complex(ao_overlap_kpts(:,:,k),size(ao_overlap_kpts,1), &
+        ao_num_per_kpt,ao_ortho_canonical_coef_kpts(:,:,k),size(ao_ortho_canonical_coef_kpts,1), &
+        ao_ortho_canonical_num_per_kpt(k))
+    enddo
+
+
+  else
+
+    complex*16, allocatable :: S(:,:)
+
+    allocate(S(ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt))
+    do k=1,kpt_num
+      S = (0.d0,0.d0)
+      do i=1,ao_cart_to_sphe_num_per_kpt
+        S(i,i) = (1.d0,0.d0)
+      enddo
+
+      ao_ortho_canonical_num_per_kpt(k) = ao_cart_to_sphe_num_per_kpt
+      call ortho_canonical_complex(ao_cart_to_sphe_overlap_kpts, size(ao_cart_to_sphe_overlap_kpts,1), &
+        ao_cart_to_sphe_num_per_kpt, S, size(S,1), ao_ortho_canonical_num_per_kpt(k))
+
+      call zgemm('N','N', ao_num_per_kpt, ao_ortho_canonical_num_per_kpt(k), ao_cart_to_sphe_num_per_kpt, (1.d0,0.d0), &
+        ao_cart_to_sphe_coef_kpts(:,:,k), size(ao_cart_to_sphe_coef_kpts,1), &
+        S, size(S,1), &
+        (0.d0,0.d0), ao_ortho_canonical_coef_kpts(:,:,k), size(ao_ortho_canonical_coef_kpts,1))
+    enddo
+
+    deallocate(S)
+  endif
+  ao_ortho_canonical_num_per_kpt_max = max(ao_ortho_canonical_num_per_kpt)
+END_PROVIDER
+
+BEGIN_PROVIDER [complex*16, ao_ortho_canonical_overlap_kpts, (ao_ortho_canonical_num_per_kpt_max,ao_ortho_canonical_num_per_kpt_max,kpt_num)]
+  implicit none
+  BEGIN_DOC
+! overlap matrix of the ao_ortho_canonical.
+! Expected to be the Identity
+  END_DOC
+  integer                        :: i,j,k,l,kk
+  complex*16               :: c
+  do k=1,kpt_num
+    do j=1, ao_ortho_canonical_num_per_kpt_max
+      do i=1, ao_ortho_canonical_num_per_kpt_max
+        ao_ortho_canonical_overlap_complex(i,j,k) = (0.d0,0.d0)
+      enddo
+    enddo
+  enddo
+  do kk=1,kpt_num
+    do j=1, ao_ortho_canonical_num_per_kpt(kk)
+      do k=1, ao_num_per_kpt
+        c = (0.d0,0.d0)
+        do l=1, ao_num_per_kpt
+          c +=  conjg(ao_ortho_canonical_coef_kpts(l,j,kk)) * ao_overlap_kpts(l,k,kk)
+        enddo
+        do i=1, ao_ortho_canonical_num_per_kpt(kk)
+          ao_ortho_canonical_overlap_kpts(i,j,kk) += ao_ortho_canonical_coef_kpts(k,i,kk) * c
+        enddo
+      enddo
+    enddo
+  enddo
+END_PROVIDER