diff --git a/src/cipsi_tc_bi_ortho/selection.irp.f b/src/cipsi_tc_bi_ortho/selection.irp.f index 633ca815..0c3f0451 100644 --- a/src/cipsi_tc_bi_ortho/selection.irp.f +++ b/src/cipsi_tc_bi_ortho/selection.irp.f @@ -464,15 +464,15 @@ subroutine select_singles_and_doubles(i_generator, hole_mask,particle_mask, fock do i = 1, fullinteresting(0) do k = 1, N_int - fullminilist(k,1,i) = psi_det_sorted_tc(k,1,fullinteresting(i)) - fullminilist(k,2,i) = psi_det_sorted_tc(k,2,fullinteresting(i)) + fullminilist(k,1,i) = psi_selectors(k,1,fullinteresting(i)) + fullminilist(k,2,i) = psi_selectors(k,2,fullinteresting(i)) enddo enddo do i = 1, interesting(0) do k = 1, N_int - minilist(k,1,i) = psi_det_sorted_tc(k,1,interesting(i)) - minilist(k,2,i) = psi_det_sorted_tc(k,2,interesting(i)) + minilist(k,1,i) = psi_selectors(k,1,interesting(i)) + minilist(k,2,i) = psi_selectors(k,2,interesting(i)) enddo enddo @@ -628,7 +628,10 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, intere negMask(i,2) = not(mask(i,2)) end do + print*,'in selection ' do i = 1, N_sel +! call debug_det(det(1,1,i),N_int) +! print*,i,dabs(psi_selectors_coef_transp_tc(1,2,i) * psi_selectors_coef_transp_tc(1,1,i)) if(interesting(i) < 0) then stop 'prefetch interesting(i) and det(i)' endif diff --git a/src/fci_tc_bi/generators.irp.f b/src/fci_tc_bi/generators.irp.f index 55c0cbb9..250a1f71 100644 --- a/src/fci_tc_bi/generators.irp.f +++ b/src/fci_tc_bi/generators.irp.f @@ -31,6 +31,14 @@ END_PROVIDER END_DOC psi_det_generators(1:N_int,1:2,1:N_det) = psi_det_sorted_tc(1:N_int,1:2,1:N_det) psi_coef_generators(1:N_det,1:N_states) = psi_coef_sorted_tc(1:N_det,1:N_states) + integer :: i +! print*,'generators ' + do i = 1, N_det + if(N_det.ne.1)then + print*,'writing generators' + write(33,*) psi_det_generators(1,1,i), psi_det_generators(1,2,i) + endif + enddo END_PROVIDER diff --git a/src/fci_tc_bi/selectors.irp.f b/src/fci_tc_bi/selectors.irp.f index 3830927b..3c12bb07 100644 --- a/src/fci_tc_bi/selectors.irp.f +++ b/src/fci_tc_bi/selectors.irp.f @@ -43,15 +43,27 @@ END_PROVIDER do k=1,N_int psi_selectors(k,1,i) = psi_det_sorted_tc(k,1,i) psi_selectors(k,2,i) = psi_det_sorted_tc(k,2,i) +! psi_selectors(k,2,i) = psi_det(k,2,i) +! psi_selectors(k,2,i) = psi_det(k,2,i) enddo enddo + print*,'selectors ' do k=1,N_states do i=1,N_det_selectors psi_selectors_coef(i,k) = psi_coef_sorted_tc_gen(i,k) +! psi_selectors_coef_tc(i,1,k) = psi_l_coef_bi_ortho(i,k) +! psi_selectors_coef_tc(i,2,k) = psi_r_coef_bi_ortho(i,k) psi_selectors_coef_tc(i,1,k) = psi_l_coef_sorted_bi_ortho(i,k) psi_selectors_coef_tc(i,2,k) = psi_r_coef_sorted_bi_ortho(i,k) +! call debug_det(psi_selectors(1,1,i),N_int) + if(N_det.ne.1)then + print*,'writing selectors' + write(34,*)psi_selectors(1,1,i),psi_selectors(1,2,i) + write(40,'(F10.7)')dabs(psi_selectors_coef_tc(i,1,1) * psi_selectors_coef_tc(i,2,1)) + endif ! psi_selectors_coef_tc(i,1,k) = 1.d0 ! psi_selectors_coef_tc(i,2,k) = 1.d0 + enddo enddo @@ -71,6 +83,9 @@ END_PROVIDER psi_selectors_coef_transp_tc(k,1,i) = psi_selectors_coef_tc(i,1,k) psi_selectors_coef_transp_tc(k,2,i) = psi_selectors_coef_tc(i,2,k) enddo + if(N_det.ne.1)then + write(41,'(F10.7)')dabs(psi_selectors_coef_transp_tc(1,1,i)*psi_selectors_coef_transp_tc(1,2,i)) + endif enddo END_PROVIDER diff --git a/src/tc_bi_ortho/psi_det_tc_sorted.irp.f b/src/tc_bi_ortho/psi_det_tc_sorted.irp.f index 42617557..e8477dec 100644 --- a/src/tc_bi_ortho/psi_det_tc_sorted.irp.f +++ b/src/tc_bi_ortho/psi_det_tc_sorted.irp.f @@ -34,13 +34,19 @@ END_PROVIDER END_DOC integer :: i,j,k integer, allocatable :: iorder(:) + print *, 'providing psi_det_sorted_tc' allocate ( iorder(N_det) ) + print*,'before ' do i=1,N_det psi_average_norm_contrib_sorted_tc(i) = -psi_average_norm_contrib_tc(i) iorder(i) = i + print*,i,iorder(i),psi_average_norm_contrib_sorted_tc(i) enddo -! call dsort(psi_average_norm_contrib_sorted_tc,iorder,N_det) + call dsort(psi_average_norm_contrib_sorted_tc,iorder,N_det) + print*,'after ' do i=1,N_det +! iorder(i) = i + print*,i,iorder(i),psi_average_norm_contrib_sorted_tc(i) do j=1,N_int psi_det_sorted_tc(j,1,i) = psi_det(j,1,iorder(i)) psi_det_sorted_tc(j,2,i) = psi_det(j,2,iorder(i)) @@ -67,6 +73,23 @@ END_PROVIDER psi_det_sorted_tc_order(N_det+1:psi_det_size) = 0 deallocate(iorder) + logical :: pouet + pouet = .true. + do i = 1, N_det + if(psi_average_norm_contrib_sorted_tc(i) == 0.d0)then + pouet = .False. + exit + endif + enddo + + if(pouet.and.N_det.ne.1)then + print*,'writing sorted' + do i = 1, N_det +! call debug_det(psi_det_sorted_tc(1,1,i),N_int) + print*,i,psi_average_norm_contrib_sorted_tc(i) + write(35,*)psi_det_sorted_tc(1,1,i),psi_det_sorted_tc(1,2,i) + enddo + endif END_PROVIDER @@ -84,6 +107,21 @@ END_PROVIDER psi_r_coef_sorted_bi_ortho(i,1) = psi_r_coef_bi_ortho(psi_det_sorted_tc_order(i),1) psi_l_coef_sorted_bi_ortho(i,1) = psi_l_coef_bi_ortho(psi_det_sorted_tc_order(i),1) enddo + logical :: pouet + pouet = .true. + do i = 1, N_det + if(psi_l_coef_sorted_bi_ortho(i,1) == 0.d0)then + pouet = .False. + exit + endif + enddo + if(pouet.and.N_det.ne.1)then + print*,'psi_r_coef_sorted_bi_ortho' + do i = 1, N_det + print*,psi_r_coef_bi_ortho(psi_det_sorted_tc_order(i),1) + write(42,'(F10.7)')dabs(psi_r_coef_sorted_bi_ortho(i,1)*psi_l_coef_sorted_bi_ortho(i,1)) + enddo + endif END_PROVIDER diff --git a/src/tc_bi_ortho/tc_h_eigvectors.irp.f b/src/tc_bi_ortho/tc_h_eigvectors.irp.f index d39b7a29..c66ff036 100644 --- a/src/tc_bi_ortho/tc_h_eigvectors.irp.f +++ b/src/tc_bi_ortho/tc_h_eigvectors.irp.f @@ -133,7 +133,10 @@ call bi_normalize(leigvec_tc_bi_orth,reigvec_tc_bi_orth,size(reigvec_tc_bi_orth,1),N_det,N_states) print*,'leigvec_tc_bi_orth(1,1),reigvec_tc_bi_orth(1,1) = ',leigvec_tc_bi_orth(1,1),reigvec_tc_bi_orth(1,1) norm_ground_left_right_bi_orth = 0.d0 + print*,'after diago' do j = 1, N_det + call debug_det(psi_det(1,1,j),N_int) + print*,j,dabs(leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1)) norm_ground_left_right_bi_orth += leigvec_tc_bi_orth(j,1) * reigvec_tc_bi_orth(j,1) enddo print*,'norm l/r = ',norm_ground_left_right_bi_orth