mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-10-30 10:18:07 +01:00
Merge branch 'master' into dev
This commit is contained in:
commit
7ac20eb88c
@ -27,7 +27,7 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
|
||||
double precision, intent(in) :: H_jj(sze),Dress_jj(sze)
|
||||
double precision, intent(inout) :: u_in(sze,N_st_diag_in)
|
||||
double precision, intent(out) :: energies(N_st)
|
||||
external hcalc
|
||||
external :: hcalc
|
||||
|
||||
integer :: iter, N_st_diag
|
||||
integer :: i,j,k,l,m
|
||||
@ -207,7 +207,7 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
|
||||
enddo
|
||||
! Normalize all states
|
||||
do k=1,N_st_diag
|
||||
call normalize(u_in(1,k),sze)
|
||||
call normalize(u_in(:,k),sze)
|
||||
enddo
|
||||
|
||||
! Copy from the guess input "u_in" to the working vectors "U"
|
||||
@ -238,10 +238,10 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
|
||||
call ortho_qr(U,size(U,1),sze,shift2)
|
||||
! it does W = H U with W(sze,N_st_diag),U(sze,N_st_diag)
|
||||
! where sze is the size of the vector, N_st_diag is the number of states
|
||||
call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag,sze)
|
||||
call hcalc(W(:,shift+1),U(:,shift+1),N_st_diag,sze)
|
||||
! Compute then the DIAGONAL PART OF THE DRESSING
|
||||
! <i|W_k> += Dress_jj(i) * <i|U>
|
||||
call dressing_diag_uv(W(1,shift+1),U(1,shift+1),Dress_jj,N_st_diag_in,sze)
|
||||
call dressing_diag_uv(W(:,shift+1),U(:,shift+1),Dress_jj,N_st_diag_in,sze)
|
||||
else
|
||||
! Already computed in update below
|
||||
continue
|
||||
@ -303,9 +303,9 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
|
||||
! --------------------------------------------------
|
||||
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
|
||||
|
||||
! Compute residual vector and davidson step
|
||||
! -----------------------------------------
|
||||
@ -319,7 +319,7 @@ subroutine davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,energies,sz
|
||||
enddo
|
||||
|
||||
if (k <= N_st) then
|
||||
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
|
||||
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
|
||||
to_print(1,k) = lambda(k)
|
||||
to_print(2,k) = residual_norm(k)
|
||||
endif
|
||||
|
@ -31,7 +31,8 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
|
||||
double precision, intent(inout) :: u_in(sze,N_st_diag)
|
||||
double precision, intent(out) :: energies(N_st_diag)
|
||||
logical, intent(out) :: converged
|
||||
external hcalc
|
||||
|
||||
external :: hcalc
|
||||
|
||||
double precision, allocatable :: H_jj_tmp(:)
|
||||
ASSERT (N_st > 0)
|
||||
@ -224,7 +225,7 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
|
||||
u_in(k,k) = u_in(k,k) + 10.d0
|
||||
enddo
|
||||
do k=1,N_st_diag_in
|
||||
call normalize(u_in(1,k),sze)
|
||||
call normalize(u_in(:,k),sze)
|
||||
enddo
|
||||
|
||||
do k=1,N_st_diag_in
|
||||
@ -248,10 +249,10 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
|
||||
if ((iter > 1).or.(itertot == 1)) then
|
||||
! Compute |W_k> = \sum_i |i><i|H|u_k>
|
||||
! -----------------------------------
|
||||
call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag_in,sze)
|
||||
call hcalc(W(:,shift+1),U(:,shift+1),N_st_diag_in,sze)
|
||||
! Compute then the DIAGONAL PART OF THE DRESSING
|
||||
! <i|W_k> += Dress_jj(i) * <i|U>
|
||||
call dressing_diag_uv(W(1,shift+1),U(1,shift+1),Dress_jj,N_st_diag_in,sze)
|
||||
call dressing_diag_uv(W(:,shift+1),U(:,shift+1),Dress_jj,N_st_diag_in,sze)
|
||||
else
|
||||
! Already computed in update below
|
||||
continue
|
||||
@ -275,20 +276,20 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
|
||||
!
|
||||
! call dgemm('T','N', N_st, N_st_diag_in, sze, 1.d0, &
|
||||
! psi_coef, size(psi_coef,1), &
|
||||
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||
! U(:,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||
!
|
||||
! call dgemm('N','N', sze, N_st_diag_in, N_st, 1.0d0, &
|
||||
! Dressing_vec, size(Dressing_vec,1), s_tmp, size(s_tmp,1), &
|
||||
! 1.d0, W(1,shift+1), size(W,1))
|
||||
! 1.d0, W(:,shift+1), size(W,1))
|
||||
!
|
||||
!
|
||||
! call dgemm('T','N', N_st, N_st_diag_in, sze, 1.d0, &
|
||||
! Dressing_vec, size(Dressing_vec,1), &
|
||||
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||
! U(:,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||
!
|
||||
! call dgemm('N','N', sze, N_st_diag_in, N_st, 1.0d0, &
|
||||
! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), &
|
||||
! 1.d0, W(1,shift+1), size(W,1))
|
||||
! 1.d0, W(:,shift+1), size(W,1))
|
||||
!
|
||||
endif
|
||||
|
||||
@ -376,9 +377,9 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
|
||||
! --------------------------------------------------
|
||||
|
||||
call dgemm('N','N', sze, N_st_diag_in, shift2, &
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
|
||||
call dgemm('N','N', sze, N_st_diag_in, shift2, &
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
|
||||
|
||||
! Compute residual vector and davidson step
|
||||
! -----------------------------------------
|
||||
@ -392,7 +393,7 @@ subroutine dav_double_dressed(u_in,H_jj,Dress_jj,Dressing_vec,idx_dress,energies
|
||||
enddo
|
||||
|
||||
if (k <= N_st) then
|
||||
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
|
||||
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
|
||||
to_print(1,k) = lambda(k)
|
||||
to_print(2,k) = residual_norm(k)
|
||||
endif
|
||||
|
@ -214,7 +214,7 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
|
||||
enddo
|
||||
! Normalize all states
|
||||
do k=1,N_st_diag
|
||||
call normalize(u_in(1,k),sze)
|
||||
call normalize(u_in(:,k),sze)
|
||||
enddo
|
||||
! Copy from the guess input "u_in" to the working vectors "U"
|
||||
|
||||
@ -244,7 +244,7 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
|
||||
call ortho_qr(U,size(U,1),sze,shift2)
|
||||
! it does W = H U with W(sze,N_st_diag),U(sze,N_st_diag)
|
||||
! where sze is the size of the vector, N_st_diag is the number of states
|
||||
call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag,sze)
|
||||
call hcalc(W(:,shift+1),U(:,shift+1),N_st_diag,sze)
|
||||
else
|
||||
! Already computed in update below
|
||||
continue
|
||||
@ -268,20 +268,20 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
|
||||
stop
|
||||
! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
|
||||
! psi_coef, size(psi_coef,1), &
|
||||
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||
! U(:,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||
!
|
||||
! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, &
|
||||
! dressing_vec, size(dressing_vec,1), s_tmp, size(s_tmp,1), &
|
||||
! 1.d0, W(1,shift+1), size(W,1))
|
||||
! 1.d0, W(:,shift+1), size(W,1))
|
||||
!
|
||||
!
|
||||
! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
|
||||
! dressing_vec, size(dressing_vec,1), &
|
||||
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||
! U(:,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||
!
|
||||
! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, &
|
||||
! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), &
|
||||
! 1.d0, W(1,shift+1), size(W,1))
|
||||
! 1.d0, W(:,shift+1), size(W,1))
|
||||
|
||||
endif
|
||||
endif
|
||||
@ -370,9 +370,9 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
|
||||
! --------------------------------------------------
|
||||
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
|
||||
|
||||
! Compute residual vector and davidson step
|
||||
! -----------------------------------------
|
||||
@ -386,7 +386,7 @@ subroutine davidson_general_ext_rout_dressed(u_in,H_jj,energies,sze,N_st,N_st_di
|
||||
enddo
|
||||
|
||||
if (k <= N_st) then
|
||||
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
|
||||
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
|
||||
to_print(1,k) = lambda(k)
|
||||
to_print(2,k) = residual_norm(k)
|
||||
endif
|
||||
|
@ -196,7 +196,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co
|
||||
enddo
|
||||
! Normalize all states
|
||||
do k=1,N_st_diag
|
||||
call normalize(u_in(1,k),sze)
|
||||
call normalize(u_in(:,k),sze)
|
||||
enddo
|
||||
|
||||
! Copy from the guess input "u_in" to the working vectors "U"
|
||||
@ -226,7 +226,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co
|
||||
call ortho_qr(U,size(U,1),sze,shift2)
|
||||
! it does W = H U with W(sze,N_st_diag),U(sze,N_st_diag)
|
||||
! where sze is the size of the vector, N_st_diag is the number of states
|
||||
call hcalc(W(1,shift+1),U(1,shift+1),N_st_diag,sze)
|
||||
call hcalc(W(:,shift+1),U(:,shift+1),N_st_diag,sze)
|
||||
else
|
||||
! Already computed in update below
|
||||
continue
|
||||
@ -288,9 +288,9 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co
|
||||
! --------------------------------------------------
|
||||
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
|
||||
|
||||
! Compute residual vector and davidson step
|
||||
! -----------------------------------------
|
||||
@ -304,7 +304,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,energies,sze,N_st,N_st_diag_in,co
|
||||
enddo
|
||||
|
||||
if (k <= N_st) then
|
||||
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
|
||||
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
|
||||
to_print(1,k) = lambda(k)
|
||||
to_print(2,k) = residual_norm(k)
|
||||
endif
|
||||
|
@ -206,7 +206,7 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
|
||||
enddo
|
||||
! Normalize all states
|
||||
do k=1,N_st_diag
|
||||
call normalize(u_in(1,k),sze)
|
||||
call normalize(u_in(:,k),sze)
|
||||
enddo
|
||||
|
||||
! Copy from the guess input "u_in" to the working vectors "U"
|
||||
@ -236,8 +236,8 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
|
||||
call ortho_qr(U,size(U,1),sze,shift2)
|
||||
call ortho_qr(U,size(U,1),sze,shift2)
|
||||
|
||||
! call H_S2_u_0_nstates_openmp(W(1,shift+1),U(1,shift+1),N_st_diag,sze)
|
||||
call hpsi(W(1,shift+1),U(1,shift+1),N_st_diag,sze,h_mat)
|
||||
! call H_S2_u_0_nstates_openmp(W(:,shift+1),U(:,shift+1),N_st_diag,sze)
|
||||
call hpsi(W(:,shift+1),U(:,shift+1),N_st_diag,sze,h_mat)
|
||||
else
|
||||
! Already computed in update below
|
||||
continue
|
||||
@ -299,9 +299,9 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
|
||||
! --------------------------------------------------
|
||||
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(1,shift2+1), size(U,1))
|
||||
1.d0, U, size(U,1), y, size(y,1), 0.d0, U(:,shift2+1), size(U,1))
|
||||
call dgemm('N','N', sze, N_st_diag, shift2, &
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(1,shift2+1), size(W,1))
|
||||
1.d0, W, size(W,1), y, size(y,1), 0.d0, W(:,shift2+1), size(W,1))
|
||||
|
||||
! Compute residual vector and davidson step
|
||||
! -----------------------------------------
|
||||
@ -315,7 +315,7 @@ subroutine davidson_general(u_in,H_jj,energies,dim_in,sze,N_st,N_st_diag_in,conv
|
||||
enddo
|
||||
|
||||
if (k <= N_st) then
|
||||
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
|
||||
residual_norm(k) = u_dot_u(U(:,shift2+k),sze)
|
||||
to_print(1,k) = lambda(k)
|
||||
to_print(2,k) = residual_norm(k)
|
||||
endif
|
||||
|
Loading…
Reference in New Issue
Block a user