mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-22 19:43:32 +01:00
Merge pull request #1 from QuantumPackage/features_kpts
This commit is contained in:
commit
3e8404901c
@ -879,10 +879,11 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
|
|||||||
itertot = 0
|
itertot = 0
|
||||||
|
|
||||||
if (state_following) then
|
if (state_following) then
|
||||||
allocate(overlap(N_st_diag*itermax, N_st_diag*itermax), &
|
allocate(overlap(N_st_diag*itermax, N_st_diag*itermax))
|
||||||
y_tmp(N_st_diag*itermax, N_st_diag*itermax))
|
allocate(y_tmp(N_st_diag*itermax, N_st_diag*itermax))
|
||||||
else
|
else
|
||||||
allocate(overlap(1,1),y_tmp(1,1)) ! avoid 'if' for deallocate
|
allocate(overlap(1,1))
|
||||||
|
allocate(y_tmp(1,1)) ! avoid 'if' for deallocate
|
||||||
endif
|
endif
|
||||||
overlap = 0.d0
|
overlap = 0.d0
|
||||||
y_tmp = (0.d0,0.d0)
|
y_tmp = (0.d0,0.d0)
|
||||||
@ -1002,24 +1003,37 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
|
|||||||
call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/))
|
call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/))
|
||||||
call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/))
|
call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/))
|
||||||
else
|
else
|
||||||
allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax))
|
!allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax))
|
||||||
|
allocate(W(sze,N_st_diag*itermax))
|
||||||
|
allocate(S(sze,N_st_diag*itermax))
|
||||||
endif
|
endif
|
||||||
|
|
||||||
allocate( &
|
!allocate( &
|
||||||
! Large
|
! ! Large
|
||||||
U(sze,N_st_diag*itermax), &
|
! U(sze,N_st_diag*itermax), &
|
||||||
S_d(sze,N_st_diag), &
|
! S_d(sze,N_st_diag), &
|
||||||
|
|
||||||
! Small
|
! ! Small
|
||||||
h(N_st_diag*itermax,N_st_diag*itermax), &
|
! h(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
h_p(N_st_diag*itermax,N_st_diag*itermax), &
|
! h_p(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
y(N_st_diag*itermax,N_st_diag*itermax), &
|
! y(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
s_(N_st_diag*itermax,N_st_diag*itermax), &
|
! s_(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
s_tmp(N_st_diag*itermax,N_st_diag*itermax), &
|
! s_tmp(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
residual_norm(N_st_diag), &
|
! residual_norm(N_st_diag), &
|
||||||
s2(N_st_diag*itermax), &
|
! s2(N_st_diag*itermax), &
|
||||||
y_s(N_st_diag*itermax,N_st_diag*itermax), &
|
! y_s(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
lambda(N_st_diag*itermax))
|
! lambda(N_st_diag*itermax))
|
||||||
|
allocate(U(sze,N_st_diag*itermax))
|
||||||
|
allocate(S_d(sze,N_st_diag))
|
||||||
|
allocate(h(N_st_diag*itermax,N_st_diag*itermax))
|
||||||
|
allocate(h_p(N_st_diag*itermax,N_st_diag*itermax))
|
||||||
|
allocate(y(N_st_diag*itermax,N_st_diag*itermax))
|
||||||
|
allocate(s_(N_st_diag*itermax,N_st_diag*itermax))
|
||||||
|
allocate(s_tmp(N_st_diag*itermax,N_st_diag*itermax))
|
||||||
|
allocate(residual_norm(N_st_diag))
|
||||||
|
allocate(s2(N_st_diag*itermax))
|
||||||
|
allocate(y_s(N_st_diag*itermax,N_st_diag*itermax))
|
||||||
|
allocate(lambda(N_st_diag*itermax))
|
||||||
|
|
||||||
h = (0.d0,0.d0)
|
h = (0.d0,0.d0)
|
||||||
U = (0.d0,0.d0)
|
U = (0.d0,0.d0)
|
||||||
@ -1162,7 +1176,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
|
|||||||
do i=1,shift2
|
do i=1,shift2
|
||||||
s_(i,j) = (0.d0,0.d0)
|
s_(i,j) = (0.d0,0.d0)
|
||||||
do k=1,sze
|
do k=1,sze
|
||||||
s_(i,j) = s_(i,j) + dconjg(U(k,i)) * cmplx(S(k,j))
|
s_(i,j) = s_(i,j) + dconjg(U(k,i)) * dcmplx(S(k,j))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
@ -1174,7 +1188,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i
|
|||||||
!todo: why not size(h,1)?
|
!todo: why not size(h,1)?
|
||||||
call zgemm('C','N', shift2, shift2, sze, &
|
call zgemm('C','N', shift2, shift2, sze, &
|
||||||
(1.d0,0.d0), U, size(U,1), W, size(W,1), &
|
(1.d0,0.d0), U, size(U,1), W, size(W,1), &
|
||||||
(0.d0,0.d0), h, size(h_p,1))
|
(0.d0,0.d0), h, size(h,1))
|
||||||
|
|
||||||
! Penalty method
|
! Penalty method
|
||||||
! --------------
|
! --------------
|
||||||
|
@ -797,7 +797,9 @@ subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze)
|
|||||||
! istart, iend, ishift, istep are used in ZMQ parallelization.
|
! istart, iend, ishift, istep are used in ZMQ parallelization.
|
||||||
END_DOC
|
END_DOC
|
||||||
integer, intent(in) :: N_st,sze
|
integer, intent(in) :: N_st,sze
|
||||||
complex*16, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st)
|
complex*16, intent(out) :: v_0(sze,N_st), s_0(sze,N_st)
|
||||||
|
complex*16, intent(inout) :: u_0(sze,N_st)
|
||||||
|
!complex*16, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st)
|
||||||
integer :: k
|
integer :: k
|
||||||
complex*16, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:)
|
complex*16, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:)
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t
|
||||||
|
@ -224,18 +224,34 @@ subroutine ortho_qr_complex(A,LDA,m,n)
|
|||||||
call zgeqrf( m, n, A, LDA, tau, work, lwork, info )
|
call zgeqrf( m, n, A, LDA, tau, work, lwork, info )
|
||||||
lwork=int(work(1))
|
lwork=int(work(1))
|
||||||
deallocate(work)
|
deallocate(work)
|
||||||
|
if (info.ne.0) then
|
||||||
|
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
allocate(work(lwork))
|
allocate(work(lwork))
|
||||||
call zgeqrf(m, n, A, LDA, tau, work, lwork, info )
|
call zgeqrf(m, n, A, LDA, tau, work, lwork, info )
|
||||||
deallocate(work)
|
deallocate(work)
|
||||||
|
if (info.ne.0) then
|
||||||
|
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
|
||||||
|
stop 2
|
||||||
|
endif
|
||||||
|
|
||||||
lwork=-1
|
lwork=-1
|
||||||
allocate(work(1))
|
allocate(work(1))
|
||||||
call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
|
call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
|
||||||
lwork=int(work(1))
|
lwork=int(work(1))
|
||||||
deallocate(work)
|
deallocate(work)
|
||||||
|
if (info.ne.0) then
|
||||||
|
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
|
||||||
|
stop 3
|
||||||
|
endif
|
||||||
allocate(work(lwork))
|
allocate(work(lwork))
|
||||||
call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
|
call zungqr(m, n, n, A, LDA, tau, work, lwork, info)
|
||||||
deallocate(work,tau)
|
deallocate(work,tau)
|
||||||
|
if (info.ne.0) then
|
||||||
|
print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value'
|
||||||
|
stop 4
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine ortho_qr_unblocked_complex(A,LDA,m,n)
|
subroutine ortho_qr_unblocked_complex(A,LDA,m,n)
|
||||||
@ -260,7 +276,15 @@ subroutine ortho_qr_unblocked_complex(A,LDA,m,n)
|
|||||||
|
|
||||||
allocate(tau(n),work(n))
|
allocate(tau(n),work(n))
|
||||||
call zgeqr2(m,n,A,LDA,tau,work,info)
|
call zgeqr2(m,n,A,LDA,tau,work,info)
|
||||||
|
if (info.ne.0) then
|
||||||
|
print*,irp_here,' The ',-info,' argument to zgeqr2 had an illegal value'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
call zung2r(m,n,n,A,LDA,tau,work,info)
|
call zung2r(m,n,n,A,LDA,tau,work,info)
|
||||||
|
if (info.ne.0) then
|
||||||
|
print*,irp_here,' The ',-info,' argument to zung2r had an illegal value'
|
||||||
|
stop 2
|
||||||
|
endif
|
||||||
deallocate(work,tau)
|
deallocate(work,tau)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user