9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-02 02:35:18 +02:00
qp2/src/dav_general_mat/test_dav.irp.f

80 lines
2.3 KiB
Fortran
Raw Permalink Normal View History

2021-07-02 16:18:13 +02:00
program test_dav
implicit none
BEGIN_DOC
! TODO : Put the documentation of the program here
END_DOC
print *, 'Hello world'
read_wf = .True.
touch read_wf
PROVIDE threshold_davidson nthreads_davidson
call routine
2021-09-28 00:30:10 +02:00
call test_dav_dress
2021-07-02 16:18:13 +02:00
end
subroutine routine
implicit none
double precision, allocatable :: u_in(:,:), H_jj(:), energies(:),h_mat(:,:)
2021-09-28 00:30:10 +02:00
integer :: dim_in,sze,N_st,N_st_diag_in
2021-07-02 16:18:13 +02:00
logical :: converged
integer :: i,j
external hcalc_template
N_st = N_states
N_st_diag_in = N_states_diag
sze = N_det
dim_in = sze
!!!! MARK THAT u_in mut dimensioned with "N_st_diag_in" as a second dimension
2021-09-28 00:30:10 +02:00
allocate(u_in(dim_in,N_st_diag_in),H_jj(sze),h_mat(sze,sze),energies(N_st_diag_in))
2021-07-02 16:18:13 +02:00
u_in = 0.d0
do i = 1, N_st
u_in(1,i) = 1.d0
enddo
!!! Matrix "h_mat" is the matrix we want to diagonalize with the first routine
!!! "davidson_general"
2021-07-02 16:18:13 +02:00
do i = 1, sze
do j = 1, sze
h_mat(j,i) = H_matrix_all_dets(j,i)
enddo
H_jj(i) = H_mat(i,i) + nuclear_repulsion
h_mat(i,i) = H_mat(i,i) + nuclear_repulsion
2021-07-02 16:18:13 +02:00
enddo
provide nthreads_davidson
call davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,converged,h_mat)
print*,'energies = ',energies
!!! hcalc_template is the routine that computes v = H u
!!! and you can use the routine "davidson_general_ext_rout"
2021-09-28 00:30:10 +02:00
call davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,converged,hcalc_template)
print*,'energies = ',energies
2021-07-02 16:18:13 +02:00
end
2021-09-28 00:30:10 +02:00
subroutine test_dav_dress
implicit none
double precision, allocatable :: u_in(:,:), H_jj(:), energies(:)
integer :: sze,N_st,N_st_diag_in,dressing_state
logical :: converged
integer :: i,j
external hcalc_template
double precision, allocatable :: dressing_vec(:)
integer :: idress
N_st = N_states
N_st_diag_in = N_states_diag
sze = N_det
dressing_state = 0
idress = 1
!!!! MARK THAT u_in mut dimensioned with "N_st_diag_in" as a second dimension
allocate(u_in(sze,N_st_diag_in),H_jj(sze),energies(N_st_diag_in))
allocate(dressing_vec(sze))
dressing_vec = 0.d0
u_in = 0.d0
do i = 1, N_st
u_in(1,i) = 1.d0
enddo
do i = 1, sze
H_jj(i) = H_matrix_all_dets(i,i) + nuclear_repulsion
enddo
print*,'dressing davidson '
call davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_diag_in,dressing_state,dressing_vec,idress,converged,hcalc_template)
print*,'energies(1) = ',energies(1)
end