10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-13 09:34:02 +01:00
quantum_package/plugins/Dressed_Ref_Hamiltonian/print_CAS_effective_Hamiltonian.irp.f
2016-02-17 12:22:45 +01:00

109 lines
3.1 KiB
Fortran
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

program print
read_wf = .True.
touch read_wf
call provide_all_stuffs
end
subroutine provide_all_stuffs
implicit none
provide ref_hamiltonian_matrix dressing_ref_hamiltonian
integer :: i,j,istate
double precision, allocatable :: psi_restart_ref_normalized(:),psi_ref_zeroth_order(:),psi_ref_dressed(:)
double precision, allocatable :: eigvalues(:),eigvectors(:,:)
double precision, allocatable :: H_dressed(:,:)
double precision, allocatable :: H_print(:,:)
double precision :: accu_norm
allocate (H_dressed(N_det_ref,N_det_ref))
allocate (H_print(N_det_ref,N_det_ref))
allocate (psi_restart_ref_normalized(N_det_ref))
allocate (psi_ref_zeroth_order(N_det_ref))
print*,'# nuclear_repulsion = ',nuclear_repulsion
allocate (psi_ref_dressed(N_det_ref))
allocate (eigvalues(N_det_ref))
allocate (eigvectors(N_det_ref,N_det_ref))
do istate= 1, N_states
do i = 1, N_det_ref
do j = 1, N_det_ref
H_print(i,j) = ref_hamiltonian_matrix(j,i)
enddo
enddo
do i = 1, N_det_ref
H_print(i,i) -= ref_hamiltonian_matrix(1,1)
enddo
print*,'Ref Hamiltonian matrix emelent = ',ref_hamiltonian_matrix(1,1)
print*,'ISTATE = ',istate
accu_norm = 0.d0
do i = 1, N_det_ref
accu_norm += psi_ref_coef(i,1) * psi_ref_coef(i,1)
enddo
print*,'accu_norm = ',accu_norm
accu_norm = 1.d0/dsqrt(accu_norm)
do i = 1, N_det_ref
psi_restart_ref_normalized(i) = psi_ref_coef(i,istate)* accu_norm
enddo
print*,'-------------------'
print*,'-------------------'
print*,'CAS MATRIX '
print*,''
do i = 1, N_det_ref
write(*,'(10(F8.5 ,4X))') H_print(i,:)
enddo
print*,''
print*,'-------------------'
print*,'-------------------'
print*,'CAS MATRIX DRESSING'
print*,''
do i = 1, N_det_ref
write(*,'(10(F8.5 ,4X))') dressing_ref_hamiltonian(i,:,istate)
enddo
print*,''
print*,'-------------------'
print*,'-------------------'
do i = 1, N_det_ref
do j = 1, N_det_ref
H_dressed(j,i) = ref_hamiltonian_matrix(j,i) + dressing_ref_hamiltonian(j,i,istate)
H_print(i,j) += dressing_ref_hamiltonian(j,i,istate)
enddo
enddo
print*,''
print*,'-------------------'
print*,'-------------------'
print*,'TOTAL DRESSED H MATRIX '
print*,''
do i = 1, N_det_ref
write(*,'(10(F8.5 ,4X))') H_print(i,:)
enddo
print*,''
print*,''
print*,''
call lapack_diagd(eigvalues,eigvectors,ref_hamiltonian_matrix,n_det_ref,n_det_ref)
do i = 1, N_det_ref
psi_ref_zeroth_order(i) = eigvectors(i,istate)
enddo
call lapack_diagd(eigvalues,eigvectors,H_dressed,n_det_ref,n_det_ref)
do i = 1, N_det_ref
psi_ref_dressed(i) = eigvectors(i,istate)
enddo
print*,'E+PT2 = ',eigvalues(istate) + nuclear_repulsion
do i = 1, N_det_ref
write(*,'(10(F10.7 ,4X))') psi_ref_coef(i,istate)/psi_ref_coef(1,istate), psi_ref_dressed(i)/psi_ref_dressed(1),psi_ref_zeroth_order(i)/psi_ref_zeroth_order(1)
enddo
enddo
deallocate (H_dressed)
deallocate (H_print)
deallocate (psi_restart_ref_normalized)
deallocate (psi_ref_zeroth_order)
deallocate (psi_ref_dressed)
deallocate (eigvalues)
deallocate (eigvectors)
end