mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-24 21:21:47 +02:00
trying to work on natorb
This commit is contained in:
parent
413327188e
commit
a64d02ab42
@ -97,6 +97,8 @@ if [[ $dets -eq 1 ]] ; then
|
||||
rm --force -- ${ezfio}/determinants/psi_{det,coef}.gz
|
||||
rm --force -- ${ezfio}/determinants/n_det_qp_edit
|
||||
rm --force -- ${ezfio}/determinants/psi_{det,coef}_qp_edit.gz
|
||||
rm --force -- ${ezfio}/tc_bi_ortho/psi_{l,r}_coef_bi_ortho.gz
|
||||
|
||||
fi
|
||||
|
||||
if [[ $mos -eq 1 ]] ; then
|
||||
|
2
external/ezfio
vendored
2
external/ezfio
vendored
@ -1 +1 @@
|
||||
Subproject commit d5805497fa0ef30e70e055cde1ecec2963303e93
|
||||
Subproject commit dba01c4fe0ff7b84c5ecfb1c7c77ec68781311b3
|
@ -331,7 +331,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei
|
||||
!thr = 100d0
|
||||
thr = Im_thresh_tcscf
|
||||
do i = 1, n
|
||||
!print*, 'Re(i) + Im(i)', WR(i), WI(i)
|
||||
print*, 'Re(i) + Im(i)', WR(i), WI(i)
|
||||
if(dabs(WI(i)) .lt. thr) then
|
||||
n_good += 1
|
||||
else
|
||||
@ -405,7 +405,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei
|
||||
|
||||
if( (accu_nd .lt. thr_nd) .and. (dabs(accu_d-dble(n_real_eigv))/dble(n_real_eigv) .lt. thr_d) ) then
|
||||
|
||||
!print *, ' lapack vectors are normalized and bi-orthogonalized'
|
||||
print *, ' lapack vectors are normalized and bi-orthogonalized'
|
||||
deallocate(S)
|
||||
return
|
||||
|
||||
@ -422,7 +422,7 @@ subroutine non_hrmt_bieig(n, A, thr_d, thr_nd, leigvec, reigvec, n_real_eigv, ei
|
||||
|
||||
else
|
||||
|
||||
!print *, ' lapack vectors are not normalized neither bi-orthogonalized'
|
||||
print *, ' lapack vectors are not normalized neither bi-orthogonalized'
|
||||
|
||||
! ---
|
||||
|
||||
|
@ -1857,7 +1857,7 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_
|
||||
integer :: i, j
|
||||
double precision, allocatable :: SS(:,:)
|
||||
|
||||
!print *, ' check bi-orthogonality'
|
||||
print *, ' check bi-orthogonality'
|
||||
|
||||
! ---
|
||||
|
||||
@ -1865,10 +1865,10 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_
|
||||
, Vl, size(Vl, 1), Vr, size(Vr, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
!print *, ' overlap matrix:'
|
||||
!do i = 1, m
|
||||
! write(*,'(1000(F16.10,X))') S(i,:)
|
||||
!enddo
|
||||
print *, ' overlap matrix:'
|
||||
do i = 1, m
|
||||
write(*,'(1000(F16.10,X))') S(i,:)
|
||||
enddo
|
||||
|
||||
accu_d = 0.d0
|
||||
accu_nd = 0.d0
|
||||
@ -1883,8 +1883,8 @@ subroutine check_biorthog(n, m, Vl, Vr, accu_d, accu_nd, S, thr_d, thr_nd, stop_
|
||||
enddo
|
||||
accu_nd = dsqrt(accu_nd) / dble(m)
|
||||
|
||||
!print *, ' accu_nd = ', accu_nd
|
||||
!print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m)
|
||||
print *, ' accu_nd = ', accu_nd
|
||||
print *, ' accu_d = ', dabs(accu_d-dble(m))/dble(m)
|
||||
|
||||
! ---
|
||||
|
||||
@ -1987,11 +1987,11 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
!do i = 1, n
|
||||
! if(deg_num(i) .gt. 1) then
|
||||
! print *, ' degen on', i, deg_num(i), e0(i)
|
||||
! endif
|
||||
!enddo
|
||||
do i = 1, n
|
||||
if(deg_num(i) .gt. 1) then
|
||||
print *, ' degen on', i, deg_num(i), e0(i)
|
||||
endif
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
@ -2010,7 +2010,7 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0)
|
||||
|
||||
! ---
|
||||
|
||||
call impose_orthog_svd(n, m, L)
|
||||
! call impose_orthog_svd(n, m, L)
|
||||
call impose_orthog_svd(n, m, R)
|
||||
!call impose_orthog_GramSchmidt(n, m, L)
|
||||
!call impose_orthog_GramSchmidt(n, m, R)
|
||||
@ -2030,7 +2030,8 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0)
|
||||
!call bi_ortho_s_inv_half(m, L, R, S_inv_half)
|
||||
!deallocate(S, S_inv_half)
|
||||
|
||||
call impose_biorthog_svd(n, m, L, R)
|
||||
! call impose_biorthog_svd(n, m, L, R)
|
||||
! call impose_biorthog_inverse(n, m, L, R)
|
||||
|
||||
!call impose_biorthog_qr(n, m, thr_d, thr_nd, L, R)
|
||||
|
||||
@ -2045,6 +2046,7 @@ subroutine impose_biorthog_degen_eigvec(n, e0, L0, R0)
|
||||
|
||||
endif
|
||||
enddo
|
||||
call impose_biorthog_inverse(n, n, L0, R0)
|
||||
|
||||
end subroutine impose_biorthog_degen_eigvec
|
||||
|
||||
@ -2420,10 +2422,10 @@ subroutine impose_biorthog_svd(n, m, L, R)
|
||||
, L, size(L, 1), R, size(R, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
!print *, ' overlap bef SVD: '
|
||||
!do i = 1, m
|
||||
! write(*, '(1000(F16.10,X))') S(i,:)
|
||||
!enddo
|
||||
print *, ' overlap bef SVD: '
|
||||
do i = 1, m
|
||||
write(*, '(1000(F16.10,X))') S(i,:)
|
||||
enddo
|
||||
|
||||
! ---
|
||||
|
||||
@ -2495,10 +2497,10 @@ subroutine impose_biorthog_svd(n, m, L, R)
|
||||
, L, size(L, 1), R, size(R, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
!print *, ' overlap aft SVD: '
|
||||
!do i = 1, m
|
||||
! write(*, '(1000(F16.10,X))') S(i,:)
|
||||
!enddo
|
||||
print *, ' overlap aft SVD: '
|
||||
do i = 1, m
|
||||
write(*, '(1000(F16.10,X))') S(i,:)
|
||||
enddo
|
||||
|
||||
deallocate(S)
|
||||
|
||||
@ -2506,6 +2508,50 @@ subroutine impose_biorthog_svd(n, m, L, R)
|
||||
|
||||
end subroutine impose_biorthog_svd
|
||||
|
||||
subroutine impose_biorthog_inverse(n, m, L, R)
|
||||
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: n, m
|
||||
double precision, intent(inout) :: L(n,m)
|
||||
double precision, intent(in) :: R(n,m)
|
||||
double precision, allocatable :: Lt(:,:),S(:,:)
|
||||
integer :: i,j
|
||||
allocate(Lt(m,n))
|
||||
allocate(S(m,m))
|
||||
|
||||
call dgemm( 'T', 'N', m, m, n, 1.d0 &
|
||||
, L, size(L, 1), R, size(R, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
print *, ' overlap bef SVD: '
|
||||
do i = 1, m
|
||||
write(*, '(1000(F16.10,X))') S(i,:)
|
||||
enddo
|
||||
|
||||
call get_pseudo_inverse(R,n,n,m,Lt,m,1.d-6)
|
||||
do i = 1, m
|
||||
do j = 1, n
|
||||
L(j,i) = Lt(i,j)
|
||||
enddo
|
||||
enddo
|
||||
! ---
|
||||
|
||||
call dgemm( 'T', 'N', m, m, n, 1.d0 &
|
||||
, L, size(L, 1), R, size(R, 1) &
|
||||
, 0.d0, S, size(S, 1) )
|
||||
|
||||
print *, ' overlap aft SVD: '
|
||||
do i = 1, m
|
||||
write(*, '(1000(F16.10,X))') S(i,:)
|
||||
enddo
|
||||
|
||||
deallocate(S,Lt)
|
||||
|
||||
|
||||
end subroutine impose_biorthog_svd
|
||||
|
||||
|
||||
! ---
|
||||
|
||||
subroutine impose_weighted_biorthog_qr(m, n, thr_d, thr_nd, Vl, W, Vr)
|
||||
|
@ -22,6 +22,7 @@ program tc_natorb_bi_ortho
|
||||
|
||||
call print_energy_and_mos()
|
||||
call save_tc_natorb()
|
||||
call print_angles_tc()
|
||||
!call minimize_tc_orb_angles()
|
||||
|
||||
end
|
||||
@ -35,9 +36,12 @@ subroutine save_tc_natorb()
|
||||
print*,'Saving the natorbs '
|
||||
|
||||
provide natorb_tc_leigvec_ao natorb_tc_reigvec_ao
|
||||
mo_l_coef = natorb_tc_leigvec_ao
|
||||
mo_r_coef = natorb_tc_reigvec_ao
|
||||
touch mo_l_coef mo_r_coef
|
||||
|
||||
call ezfio_set_bi_ortho_mos_mo_l_coef(natorb_tc_leigvec_ao)
|
||||
call ezfio_set_bi_ortho_mos_mo_r_coef(natorb_tc_reigvec_ao)
|
||||
call ezfio_set_bi_ortho_mos_mo_l_coef(mo_l_coef)
|
||||
call ezfio_set_bi_ortho_mos_mo_r_coef(mo_r_coef)
|
||||
call save_ref_determinant_nstates_1()
|
||||
call ezfio_set_determinants_read_wf(.False.)
|
||||
|
||||
|
@ -402,6 +402,7 @@ subroutine print_energy_and_mos(good_angles)
|
||||
print *, ' TC energy = ', TC_HF_energy
|
||||
print *, ' TC SCF energy gradient = ', grad_non_hermit
|
||||
print *, ' Max angle Left/right = ', max_angle_left_right
|
||||
call print_angles_tc()
|
||||
|
||||
if(max_angle_left_right .lt. thresh_lr_angle) then
|
||||
print *, ' Maximum angle BELOW 45 degrees, everthing is OK !'
|
||||
|
Loading…
Reference in New Issue
Block a user