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
|
2021-07-02 18:12:37 +02:00
|
|
|
!!!! 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
|
2021-07-02 18:12:37 +02:00
|
|
|
!!! 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
|
2021-07-02 16:48:20 +02:00
|
|
|
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)
|
2021-07-02 16:48:20 +02:00
|
|
|
print*,'energies = ',energies
|
2021-07-02 18:12:37 +02:00
|
|
|
!!! 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)
|
2021-07-02 16:48:20 +02:00
|
|
|
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
|