Added Hartree-Fock in MO basis

src/Hartree_Fock/Fock_matrix_mo.irp.f

@@ -0,0 +1,127 @@
+ BEGIN_PROVIDER [ double precision, Fock_matrix_mo, (mo_tot_num,mo_tot_num) ]
+&BEGIN_PROVIDER [ double precision, Fock_matrix_diag_mo, (mo_tot_num)]
+   implicit none
+   BEGIN_DOC
+   ! Fock matrix on the MO basis.
+   ! For open shells, the ROHF Fock Matrix is
+   !
+   !  |   F-K    |  F + K/2  |    F     |
+   !  |---------------------------------|
+   !  | F + K/2  |     F     |  F - K/2 |
+   !  |---------------------------------|
+   !  |    F     |  F - K/2  |  F + K   |
+   !
+   ! F = 1/2 (Fa + Fb)
+   !
+   ! K = Fb - Fa
+   !
+   END_DOC
+   integer                        :: i,j,n
+   double precision               :: get_mo_bielec_integral
+   if (elec_alpha_num == elec_beta_num) then
+     Fock_matrix_mo = Fock_matrix_alpha_mo
+   else
+     
+     do j=1,elec_beta_num
+       ! F-K
+       do i=1,elec_beta_num
+         Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
+             - (Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
+       enddo
+       ! F+K/2
+       do i=elec_beta_num+1,elec_alpha_num
+         Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
+             + 0.5d0*(Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
+       enddo
+       ! F
+       do i=elec_alpha_num+1, mo_tot_num
+         Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))
+       enddo
+     enddo
+
+     do j=elec_beta_num+1,elec_alpha_num
+       ! F+K/2
+       do i=1,elec_beta_num
+         Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
+             + 0.5d0*(Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
+       enddo
+       ! F
+       do i=elec_beta_num+1,elec_alpha_num
+         Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))
+       enddo
+       ! F-K/2
+       do i=elec_alpha_num+1, mo_tot_num
+         Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
+             - 0.5d0*(Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
+       enddo
+     enddo
+
+     do j=elec_alpha_num+1, mo_tot_num
+       ! F
+       do i=1,elec_beta_num
+         Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))
+       enddo
+       ! F-K/2
+       do i=elec_beta_num+1,elec_alpha_num
+         Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j))&
+             - 0.5d0*(Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
+       enddo
+       ! F+K
+       do i=elec_alpha_num+1,mo_tot_num
+         Fock_matrix_mo(i,j) = 0.5d0*(Fock_matrix_alpha_mo(i,j)+Fock_matrix_beta_mo(i,j)) &
+             + (Fock_matrix_beta_mo(i,j) - Fock_matrix_alpha_mo(i,j))
+       enddo
+     enddo
+     
+   endif
+   do i = 1, mo_tot_num
+     Fock_matrix_diag_mo(i) = Fock_matrix_mo(i,i)
+   enddo
+END_PROVIDER
+ 
+ 
+BEGIN_PROVIDER [ double precision, Fock_matrix_alpha_mo, (mo_tot_num,mo_tot_num) ]
+   implicit none
+   BEGIN_DOC
+   ! Fock matrix on the MO basis
+   END_DOC
+   integer                        :: i,j,n
+   double precision               :: get_mo_bielec_integral
+   do j=1,mo_tot_num
+     do i=1,mo_tot_num
+       Fock_matrix_alpha_mo(i,j) = mo_mono_elec_integral(i,j)
+       do n=1,elec_beta_num
+         Fock_matrix_alpha_mo(i,j) += 2.d0*get_mo_bielec_integral(i,n,j,n,mo_integrals_map) -&
+             get_mo_bielec_integral(i,n,n,j,mo_integrals_map)
+       enddo
+       do n=elec_beta_num+1,elec_alpha_num
+         Fock_matrix_alpha_mo(i,j) += get_mo_bielec_integral(i,n,j,n,mo_integrals_map) -&
+             get_mo_bielec_integral(i,n,n,j,mo_integrals_map)
+       enddo
+     enddo
+   enddo
+END_PROVIDER
+ 
+ 
+BEGIN_PROVIDER [ double precision, Fock_matrix_beta_mo, (mo_tot_num,mo_tot_num) ]
+   implicit none
+   BEGIN_DOC
+   ! Fock matrix on the MO basis
+   END_DOC
+   integer                        :: i,j,n
+   double precision               :: get_mo_bielec_integral
+   do j=1,mo_tot_num
+     do i=1,mo_tot_num
+       Fock_matrix_beta_mo(i,j) = mo_mono_elec_integral(i,j)
+       do n=1,elec_beta_num
+         Fock_matrix_beta_mo(i,j) += 2.d0*get_mo_bielec_integral(i,n,j,n,mo_integrals_map) -&
+             get_mo_bielec_integral(i,n,n,j,mo_integrals_map)
+       enddo
+       do n=elec_beta_num+1,elec_alpha_num
+         Fock_matrix_beta_mo(i,j) += get_mo_bielec_integral(i,n,j,n,mo_integrals_map)
+       enddo
+     enddo
+   enddo
+END_PROVIDER
+ 
+ 

src/Hartree_Fock/Makefile

@@ -0,0 +1,8 @@
+default: all
+
+# Define here all new external source files and objects.Don't forget to prefix the
+# object files with IRPF90_temp/
+SRC=
+OBJ=
+
+include $(QPACKAGE_ROOT)/src/Makefile.common

src/Hartree_Fock/NEEDED_MODULES

@@ -0,0 +1 @@
+AOs BiInts Bitmask Electrons Ezfio_files MonoInts MOs Nuclei Output Utils

src/Hartree_Fock/README.rst

@@ -1,3 +1,8 @@
+===================
+Hartree-Fock Module
+===================
+
+
 Needed Modules
 ==============
 

src/Hartree_Fock/diagonalize_fock.irp.f

@@ -0,0 +1,20 @@
+subroutine diagonalize_fock()
+  implicit none
+
+  double precision, allocatable :: mo_coef_new(:,:), R(:,:),eigvalues(:)
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN ::  mo_coef_new, R
+
+  allocate(R(mo_tot_num,mo_tot_num))
+  allocate(mo_coef_new(ao_num_align,mo_tot_num),eigvalues(mo_tot_num))
+  mo_coef_new = mo_coef
+
+  call lapack_diag(eigvalues,R,Fock_matrix_mo,mo_tot_num,mo_tot_num)
+
+  call dgemm('N','N',ao_num,mo_tot_num,mo_tot_num,1.d0,mo_coef_new,size(mo_coef_new,1),R,size(R,1),0.d0,mo_coef,size(mo_coef,1))
+  deallocate(mo_coef_new,R,eigvalues)
+
+  mo_label = "Canonical"
+  SOFT_TOUCH mo_coef mo_label
+  call clear_mo_map
+end
+

src/Hartree_Fock/hartree_fock.ezfio_config

@@ -0,0 +1,4 @@
+hartree_fock
+  thresh_scf       double precision
+  n_it_scf_max     integer
+

src/Hartree_Fock/mo_SCF_iterations.irp.f

@@ -0,0 +1,33 @@
+program scf_iteration
+  use bitmasks
+  implicit none
+  double precision               :: SCF_energy_before,SCF_energy_after,diag_H_mat_elem,get_mo_bielec_integral
+  double precision               :: E0
+  integer                        :: i_it
+  
+  E0 = ref_bitmask_energy + nuclear_repulsion
+  i_it = 0
+  n_it_scf_max = 100
+  SCF_energy_before = huge(1.d0)
+  SCF_energy_after = E0
+  print *,  E0
+  do while (dabs(SCF_energy_before - SCF_energy_after) > thresh_SCF)
+    SCF_energy_before = SCF_energy_after
+    call diagonalize_fock()
+    SCF_energy_after = ref_bitmask_energy + nuclear_repulsion
+    print*,SCF_energy_after
+    i_it +=1
+    if(i_it > n_it_scf_max)exit
+  enddo
+  
+  if (i_it == n_it_scf_max) then
+    stop 'Failed'
+  endif
+  if (SCF_energy_after - E0 > thresh_SCF) then
+    stop 'Failed'
+  endif
+  mo_label = "Canonical"
+  TOUCH mo_label mo_coef
+  call save_mos
+  
+end

src/Hartree_Fock/options.irp.f

@@ -0,0 +1,36 @@
+BEGIN_PROVIDER [ double precision,thresh_SCF ]
+  implicit none
+  BEGIN_DOC  
+!  Threshold on the convergence of the Hartree Fock energy
+  END_DOC
+
+  logical :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_Hartree_Fock_thresh_SCF(has)
+  if (has) then
+    call ezfio_get_Hartree_Fock_thresh_SCF(thresh_SCF)
+  else
+    thresh_SCF = 1.d-10
+    call ezfio_set_Hartree_Fock_thresh_SCF(thresh_SCF)
+  endif
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer ,n_it_scf_max]
+  implicit none
+  BEGIN_DOC  
+!  Maximum number of SCF iterations
+  END_DOC
+
+  logical :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_Hartree_Fock_n_it_scf_max (has)
+  if (has) then
+    call ezfio_get_Hartree_Fock_n_it_scf_max(n_it_scf_max)
+  else
+    n_it_scf_max = 30
+    call ezfio_set_Hartree_Fock_n_it_scf_max(n_it_scf_max)
+  endif
+
+END_PROVIDER
+

src/Hartree_Fock/ref_bitmask.irp.f

@@ -0,0 +1,57 @@
+ BEGIN_PROVIDER [ double precision, ref_bitmask_energy ]
+&BEGIN_PROVIDER [ double precision, mono_elec_ref_bitmask_energy ]
+&BEGIN_PROVIDER [ double precision, kinetic_ref_bitmask_energy ]
+&BEGIN_PROVIDER [ double precision, nucl_elec_ref_bitmask_energy ]
+&BEGIN_PROVIDER [ double precision, bi_elec_ref_bitmask_energy ]
+  use bitmasks
+  implicit none
+  BEGIN_DOC
+  ! Energy of the reference bitmask used in Slater rules
+  END_DOC
+  
+  integer                        :: occ(N_int*bit_kind_size,2)
+  integer                        :: i,j
+  
+  call bitstring_to_list(ref_bitmask(1,1), occ(1,1), i, N_int)
+  call bitstring_to_list(ref_bitmask(1,2), occ(1,2), i, N_int)
+  
+  
+  ref_bitmask_energy = 0.d0
+  mono_elec_ref_bitmask_energy = 0.d0
+  kinetic_ref_bitmask_energy   = 0.d0
+  nucl_elec_ref_bitmask_energy = 0.d0
+  bi_elec_ref_bitmask_energy = 0.d0
+  
+  do i = 1, elec_beta_num
+    ref_bitmask_energy += mo_mono_elec_integral(occ(i,1),occ(i,1)) + mo_mono_elec_integral(occ(i,2),occ(i,2))
+    kinetic_ref_bitmask_energy += mo_kinetic_integral(occ(i,1),occ(i,1)) + mo_kinetic_integral(occ(i,2),occ(i,2))
+    nucl_elec_ref_bitmask_energy += mo_nucl_elec_integral(occ(i,1),occ(i,1)) + mo_nucl_elec_integral(occ(i,2),occ(i,2))
+  enddo
+
+  do i = elec_beta_num+1,elec_alpha_num
+    ref_bitmask_energy += mo_mono_elec_integral(occ(i,1),occ(i,1))
+    kinetic_ref_bitmask_energy += mo_kinetic_integral(occ(i,1),occ(i,1)) 
+    nucl_elec_ref_bitmask_energy += mo_nucl_elec_integral(occ(i,1),occ(i,1)) 
+  enddo
+  
+  do j= 1, elec_alpha_num
+    do i = j+1, elec_alpha_num
+      bi_elec_ref_bitmask_energy += mo_bielec_integral_jj_anti(occ(i,1),occ(j,1))
+      ref_bitmask_energy += mo_bielec_integral_jj_anti(occ(i,1),occ(j,1))
+    enddo
+  enddo
+  
+  do j= 1, elec_beta_num
+    do i = j+1, elec_beta_num
+      bi_elec_ref_bitmask_energy += mo_bielec_integral_jj_anti(occ(i,2),occ(j,2))
+      ref_bitmask_energy += mo_bielec_integral_jj_anti(occ(i,2),occ(j,2))
+    enddo
+    do i= 1, elec_alpha_num
+      bi_elec_ref_bitmask_energy += mo_bielec_integral_jj(occ(i,1),occ(j,2))
+      ref_bitmask_energy += mo_bielec_integral_jj(occ(i,1),occ(j,2))
+    enddo
+  enddo
+  mono_elec_ref_bitmask_energy = kinetic_ref_bitmask_energy +   nucl_elec_ref_bitmask_energy
+  
+END_PROVIDER
+

src/Hartree_Fock/tests/Makefile

@@ -0,0 +1,33 @@
+OPENMP  =1
+PROFILE =0
+DEBUG  = 0
+
+IRPF90+= -I tests
+
+REF_FILES=$(subst %.irp.f, %.ref, $(wildcard *.irp.f))
+
+.PHONY: clean executables serial_tests parallel_tests
+
+all: clean executables serial_tests parallel_tests
+
+parallel_tests: $(REF_FILES)
+	@echo ; echo "   ----  Running parallel tests ----" ; echo
+	@OMP_NUM_THREADS=10 ${QPACKAGE_ROOT}/scripts/run_tests.py
+
+serial_tests: $(REF_FILES)
+	@echo ; echo "   ----  Running serial tests ----" ; echo
+	@OMP_NUM_THREADS=1 ${QPACKAGE_ROOT}/scripts/run_tests.py
+
+executables: $(wildcard *.irp.f) veryclean
+	$(MAKE) -C ..
+
+%.ref: $(wildcard $(QPACKAGE_ROOT)/data/inputs/*.md5) executables
+	$(QPACKAGE_ROOT)/scripts/create_test_ref.sh $*
+
+clean:
+	$(MAKE) -C .. clean
+
+veryclean:
+	$(MAKE) -C .. veryclean
+
+