20230702 21:49:25 +02:00







! 





20230410 17:53:09 +02:00



program test_tc

20230702 21:49:25 +02:00







implicit none








my_grid_becke = .True.




PROVIDE tc_grid1_a tc_grid1_r




my_n_pt_r_grid = tc_grid1_r




my_n_pt_a_grid = tc_grid1_a




touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid








read_wf = .True.




touch read_wf





20230915 01:06:32 +02:00



call provide_all_three_ints_bi_ortho()




call routine_h_triple_left




call routine_h_triple_right




! call routine_test_s2_davidson

20230702 21:49:25 +02:00




20230410 17:53:09 +02:00



end





20230915 01:06:32 +02:00



subroutine routine_h_triple_right

20230410 17:53:09 +02:00



implicit none




logical :: do_right




integer :: sze ,i, N_st, j




double precision :: sij, accu_e, accu_s, accu_e_0, accu_s_0




double precision, allocatable :: v_0_ref(:,:),u_0(:,:),s_0_ref(:,:)




double precision, allocatable :: v_0_new(:,:),s_0_new(:,:)




sze = N_det




N_st = 1




allocate(v_0_ref(N_det,1),u_0(N_det,1),s_0_ref(N_det,1),s_0_new(N_det,1),v_0_new(N_det,1))

20230915 01:06:32 +02:00



print*,'Checking first the Right '

20230410 17:53:09 +02:00



do i = 1, sze

20230915 01:06:32 +02:00



u_0(i,1) = psi_r_coef_bi_ortho(i,1)

20230410 17:53:09 +02:00



enddo

20230915 01:06:32 +02:00



double precision :: wall0,wall1




call wall_time(wall0)




call H_tc_s2_u_0_with_pure_three_omp(v_0_ref,s_0_ref, u_0,N_st,sze)




call wall_time(wall1)




print*,'time for omp',wall1  wall0




call wall_time(wall0)




call H_tc_s2_u_0_with_pure_three(v_0_new, s_0_new, u_0, N_st, sze)




call wall_time(wall1)




print*,'time serial ',wall1  wall0

20230410 17:53:09 +02:00



accu_e = 0.d0




accu_s = 0.d0




do i = 1, sze




accu_e += dabs(v_0_ref(i,1)  v_0_new(i,1))




accu_s += dabs(s_0_ref(i,1)  s_0_new(i,1))




enddo




print*,'accu_e = ',accu_e




print*,'accu_s = ',accu_s





20230915 01:06:32 +02:00



end








subroutine routine_h_triple_left




implicit none




logical :: do_right




integer :: sze ,i, N_st, j




double precision :: sij, accu_e, accu_s, accu_e_0, accu_s_0




double precision, allocatable :: v_0_ref(:,:),u_0(:,:),s_0_ref(:,:)




double precision, allocatable :: v_0_new(:,:),s_0_new(:,:)




sze = N_det




N_st = 1




allocate(v_0_ref(N_det,1),u_0(N_det,1),s_0_ref(N_det,1),s_0_new(N_det,1),v_0_new(N_det,1))




print*,'Checking the Left '

20230410 17:53:09 +02:00



do i = 1, sze

20230915 01:06:32 +02:00



u_0(i,1) = psi_l_coef_bi_ortho(i,1)

20230410 17:53:09 +02:00



enddo

20230915 01:06:32 +02:00



double precision :: wall0,wall1




call wall_time(wall0)




call H_tc_s2_dagger_u_0_with_pure_three_omp(v_0_ref,s_0_ref, u_0,N_st,sze)




call wall_time(wall1)




print*,'time for omp',wall1  wall0




call wall_time(wall0)




call H_tc_s2_dagger_u_0_with_pure_three(v_0_new, s_0_new, u_0, N_st, sze)




call wall_time(wall1)




print*,'time serial ',wall1  wall0

20230410 17:53:09 +02:00



accu_e = 0.d0




accu_s = 0.d0




do i = 1, sze




accu_e += dabs(v_0_ref(i,1)  v_0_new(i,1))




accu_s += dabs(s_0_ref(i,1)  s_0_new(i,1))




enddo




print*,'accu_e = ',accu_e




print*,'accu_s = ',accu_s








end





20230915 01:06:32 +02:00




20230410 17:53:09 +02:00



subroutine routine_test_s2_davidson




implicit none

20230410 19:37:54 +02:00



double precision, allocatable :: H_jj(:),vec_tmp(:,:), energies(:) , s2(:)

20230410 17:53:09 +02:00



integer :: i,istate




logical :: converged




external H_tc_s2_dagger_u_0_opt




external H_tc_s2_u_0_opt

20230410 19:37:54 +02:00



allocate(H_jj(N_det),vec_tmp(N_det,n_states_diag),energies(n_states_diag), s2(n_states_diag))

20230410 17:53:09 +02:00



do i = 1, N_det

20230522 18:17:17 +02:00



call htilde_mu_mat_bi_ortho_tot_slow(psi_det(1,1,i), psi_det(1,1,i), N_int, H_jj(i))

20230410 17:53:09 +02:00



enddo




! Preparing the lefteigenvector




print*,'Computing the lefteigenvector '




vec_tmp = 0.d0




do istate = 1, N_states




vec_tmp(1:N_det,istate) = psi_l_coef_bi_ortho(1:N_det,istate)




enddo




do istate = N_states+1, n_states_diag




vec_tmp(istate,istate) = 1.d0




enddo




do istate = 1, N_states




leigvec_tc_bi_orth(1:N_det,istate) = vec_tmp(1:N_det,istate)




enddo

20230412 17:10:06 +02:00



integer :: n_it_max




n_it_max = 1




call davidson_hs2_nonsym_b1space(vec_tmp, H_jj, s2, energies, N_det, n_states, n_states_diag, n_it_max, converged, H_tc_s2_dagger_u_0_opt)

20230410 17:53:09 +02:00



double precision, allocatable :: v_0_new(:,:),s_0_new(:,:)




integer :: sze,N_st




logical :: do_right




sze = N_det




N_st = 1




do_right = .False.




allocate(s_0_new(N_det,1),v_0_new(N_det,1))




call H_tc_s2_u_0_nstates_openmp(v_0_new,s_0_new,vec_tmp,N_st,sze, do_right)




double precision :: accu_e_0, accu_s_0




accu_e_0 = 0.d0




accu_s_0 = 0.d0




do i = 1, sze




accu_e_0 += v_0_new(i,1) * vec_tmp(i,1)




accu_s_0 += s_0_new(i,1) * vec_tmp(i,1)




enddo

20230410 19:37:54 +02:00



print*,'energies = ',energies




print*,'s2 = ',s2

20230410 17:53:09 +02:00



print*,'accu_e_0',accu_e_0




print*,'accu_s_0',accu_s_0








! Preparing the righteigenvector




print*,'Computing the righteigenvector '




vec_tmp = 0.d0




do istate = 1, N_states




vec_tmp(1:N_det,istate) = psi_r_coef_bi_ortho(1:N_det,istate)




enddo




do istate = N_states+1, n_states_diag




vec_tmp(istate,istate) = 1.d0




enddo




do istate = 1, N_states




leigvec_tc_bi_orth(1:N_det,istate) = vec_tmp(1:N_det,istate)




enddo

20230412 17:10:06 +02:00



n_it_max = 1




call davidson_hs2_nonsym_b1space(vec_tmp, H_jj, s2, energies, N_det, n_states, n_states_diag, n_it_max, converged, H_tc_s2_u_0_opt)

20230410 17:53:09 +02:00



sze = N_det




N_st = 1




do_right = .True.




v_0_new = 0.d0




s_0_new = 0.d0




call H_tc_s2_u_0_nstates_openmp(v_0_new,s_0_new,vec_tmp,N_st,sze, do_right)




accu_e_0 = 0.d0




accu_s_0 = 0.d0




do i = 1, sze




accu_e_0 += v_0_new(i,1) * vec_tmp(i,1)




accu_s_0 += s_0_new(i,1) * vec_tmp(i,1)




enddo

20230410 19:37:54 +02:00



print*,'energies = ',energies




print*,'s2 = ',s2

20230410 17:53:09 +02:00



print*,'accu_e_0',accu_e_0




print*,'accu_s_0',accu_s_0








end
