2016-08-24 16:43:01 +02:00
|
|
|
program MRPT_Utils
|
|
|
|
implicit none
|
|
|
|
read_wf = .True.
|
|
|
|
touch read_wf
|
|
|
|
! call routine
|
|
|
|
! call routine_2
|
|
|
|
call routine_3
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
|
|
subroutine routine_3
|
|
|
|
implicit none
|
2016-12-05 15:10:53 +01:00
|
|
|
integer :: i,j
|
2016-08-26 18:00:49 +02:00
|
|
|
!provide fock_virt_total_spin_trace
|
2016-08-30 14:10:52 +02:00
|
|
|
provide delta_ij
|
|
|
|
|
|
|
|
print *, 'N_det = ', N_det
|
|
|
|
print *, 'N_states = ', N_states
|
2016-11-25 19:23:09 +01:00
|
|
|
do i = 1, N_States
|
|
|
|
print*,'State',i
|
2017-03-16 21:21:27 +01:00
|
|
|
write(*,'(A12,X,I3,A3,XX,F20.16)') ' PT2 ', i,' = ', second_order_pt_new(i)
|
|
|
|
write(*,'(A12,X,I3,A3,XX,F22.16)') ' E ', i,' = ', psi_ref_average_value(i)
|
|
|
|
write(*,'(A12,X,I3,A3,XX,F22.16)') ' E+PT2 ', i,' = ', psi_ref_average_value(i)+second_order_pt_new(i)
|
|
|
|
write(*,'(A12,X,I3,A3,XX,F22.16)') ' E dressed ', i,' = ', CI_dressed_pt2_new_energy(i)
|
|
|
|
write(*,'(A12,X,I3,A3,XX,F20.16)') ' S^2 ', i,' = ', CI_dressed_pt2_new_eigenvectors_s2(i)
|
2016-12-05 15:10:53 +01:00
|
|
|
print*,'coef before and after'
|
|
|
|
do j = 1, N_det_ref
|
|
|
|
print*,psi_ref_coef(j,i),CI_dressed_pt2_new_eigenvectors(j,i)
|
|
|
|
enddo
|
2016-11-25 19:23:09 +01:00
|
|
|
enddo
|
2017-02-03 11:51:22 +01:00
|
|
|
if(save_heff_eigenvectors)then
|
|
|
|
call save_wavefunction_general(N_det_ref,N_states_diag_heff,psi_ref,N_det_ref,CI_dressed_pt2_new_eigenvectors)
|
|
|
|
endif
|
2017-03-17 16:20:37 +01:00
|
|
|
if(N_states.gt.1)then
|
|
|
|
print*, 'Energy differences : E(0) - E(i)'
|
|
|
|
do i = 2, N_States
|
|
|
|
print*,'State',i
|
|
|
|
write(*,'(A12,X,I3,A3,XX,F20.16)') ' S^2 ', i,' = ', CI_dressed_pt2_new_eigenvectors_s2(i)
|
|
|
|
write(*,'(A12,X,I3,A3,XX,F20.16)') 'Variational ', i,' = ', psi_ref_average_value(1) - psi_ref_average_value(i)
|
|
|
|
write(*,'(A12,X,I3,A3,XX,F20.16)') 'Perturbative', i,' = ', psi_ref_average_value(1)+second_order_pt_new(1) - (psi_ref_average_value(i)+second_order_pt_new(i))
|
|
|
|
write(*,'(A12,X,I3,A3,XX,F20.16)') 'Dressed ', i,' = ', CI_dressed_pt2_new_energy(1) - CI_dressed_pt2_new_energy(i)
|
|
|
|
enddo
|
|
|
|
endif
|
2016-08-24 16:43:01 +02:00
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
subroutine routine_2
|
|
|
|
implicit none
|
|
|
|
integer :: i
|
|
|
|
do i = 1, n_core_inact_orb
|
2016-09-01 17:43:33 +02:00
|
|
|
print*,fock_core_inactive_total(i,1,1),fock_core_inactive(i)
|
2016-08-24 16:43:01 +02:00
|
|
|
enddo
|
|
|
|
double precision :: accu
|
|
|
|
accu = 0.d0
|
|
|
|
do i = 1, n_act_orb
|
|
|
|
integer :: j_act_orb
|
|
|
|
j_act_orb = list_act(i)
|
2016-09-01 17:43:33 +02:00
|
|
|
accu += one_body_dm_mo_alpha(j_act_orb,j_act_orb,1)
|
|
|
|
print*,one_body_dm_mo_alpha(j_act_orb,j_act_orb,1),one_body_dm_mo_beta(j_act_orb,j_act_orb,1)
|
2016-08-24 16:43:01 +02:00
|
|
|
enddo
|
|
|
|
print*,'accu = ',accu
|
|
|
|
|
|
|
|
end
|
|
|
|
|