! First gradient subroutine first_gradient_list_opt(tmp_n,m,list,v_grad) include 'constants.h' implicit none !=================================================================== ! Compute the gradient of energy with respects to orbital rotations !=================================================================== ! Check if read_wf = true, else : ! qp set determinant read_wf true ! in integer, intent(in) :: tmp_n,m,list(m) ! n : integer, n = m*(m-1)/2 ! m = list_size ! out double precision, intent(out) :: v_grad(tmp_n) ! v_grad : double precision vector of length n containeing the gradient ! internal double precision, allocatable :: grad(:,:),A(:,:) double precision :: norm integer :: i,p,q,r,s,t,tmp_i,tmp_p,tmp_q,tmp_r,tmp_s,tmp_t ! grad : double precision matrix containing the gradient before the permutation ! A : double precision matrix containing the gradient after the permutation ! norm : double precision number, the norm of the vector gradient ! i,p,q,r,s,t : integer, indexes ! istate : integer, the electronic state ! Function double precision :: get_two_e_integral, norm2 ! get_two_e_integral : double precision function that gives the two e integrals ! norm2 : double precision function that gives the norm of a vector ! Provided : ! mo_one_e_integrals : mono e- integrals ! get_two_e_integral : two e- integrals ! one_e_dm_mo : one body density matrix (state average) ! two_e_dm_mo : two body density matrix (state average) print*,'---first_gradient_list---' !============ ! Allocation !============ allocate(grad(m,m),A(m,m)) !============= ! Calculation !============= v_grad = 0d0 grad = 0d0 do tmp_p = 1, m p = list(tmp_p) do tmp_q = 1, m q = list(tmp_q) !grad(tmp_p,tmp_q) = 0d0 do r = 1, mo_num grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) + mo_one_e_integrals(p,r) * one_e_dm_mo(r,q) & - mo_one_e_integrals(r,q) * one_e_dm_mo(p,r) enddo do r = 1, mo_num do s = 1, mo_num do t = 1, mo_num grad(tmp_p,tmp_q) = grad(tmp_p,tmp_q) & + get_two_e_integral(p,t,r,s,mo_integrals_map) * two_e_dm_mo(r,s,q,t) & - get_two_e_integral(r,s,q,t,mo_integrals_map) * two_e_dm_mo(p,t,r,s) enddo enddo enddo enddo enddo ! Conversion mo_num*mo_num matrix to mo_num(mo_num-1)/2 vector do tmp_i = 1, tmp_n call vec_to_mat_index(tmp_i,tmp_p,tmp_q) v_grad(tmp_i)=(grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p)) enddo ! Display, vector containing the gradient elements if (debug) then print*,'Vector containing the gradient :' write(*,'(100(F10.5))') v_grad(1:tmp_n) endif ! Norm of the vector norm = norm2(v_grad) print*, 'Norm : ', norm ! Matrix gradient A = 0d0 do tmp_q = 1, m do tmp_p = 1, m A(tmp_p,tmp_q) = grad(tmp_p,tmp_q) - grad(tmp_q,tmp_p) enddo enddo ! Display, matrix containting the gradient elements if (debug) then print*,'Matrix containing the gradient :' do tmp_i = 1, m write(*,'(100(E12.5))') A(tmp_i,1:m) enddo endif !============== ! Deallocation !============== deallocate(grad,A) print*,'---End first_gradient_list---' end subroutine