From e2802ea5b9004a91c26ba9f16ebb510a3b61b3aa Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 7 May 2020 17:25:08 -0500 Subject: [PATCH 1/4] separate allocation calls for debugging --- .../diagonalization_hs2_dressed.irp.f | 50 ++++++++++++------- 1 file changed, 32 insertions(+), 18 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index d16445cc..9615f72c 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -879,10 +879,11 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i itertot = 0 if (state_following) then - allocate(overlap(N_st_diag*itermax, N_st_diag*itermax), & - y_tmp(N_st_diag*itermax, N_st_diag*itermax)) + allocate(overlap(N_st_diag*itermax, N_st_diag*itermax)) + allocate(y_tmp(N_st_diag*itermax, N_st_diag*itermax)) 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 overlap = 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_s, s, (/sze,N_st_diag*itermax/)) 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 - allocate( & - ! Large - U(sze,N_st_diag*itermax), & - S_d(sze,N_st_diag), & + !allocate( & + ! ! Large + ! U(sze,N_st_diag*itermax), & + ! S_d(sze,N_st_diag), & - ! Small - h(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), & - s_(N_st_diag*itermax,N_st_diag*itermax), & - s_tmp(N_st_diag*itermax,N_st_diag*itermax), & - residual_norm(N_st_diag), & - s2(N_st_diag*itermax), & - y_s(N_st_diag*itermax,N_st_diag*itermax), & - lambda(N_st_diag*itermax)) + ! ! Small + ! h(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), & + ! s_(N_st_diag*itermax,N_st_diag*itermax), & + ! s_tmp(N_st_diag*itermax,N_st_diag*itermax), & + ! residual_norm(N_st_diag), & + ! s2(N_st_diag*itermax), & + ! y_s(N_st_diag*itermax,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) U = (0.d0,0.d0) From c120ccf523d9ff74b5580658c0c7837a66ea1f21 Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 7 May 2020 17:27:32 -0500 Subject: [PATCH 2/4] more error checking --- src/utils/linear_algebra.irp.f | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/src/utils/linear_algebra.irp.f b/src/utils/linear_algebra.irp.f index 84985a53..778e59c7 100644 --- a/src/utils/linear_algebra.irp.f +++ b/src/utils/linear_algebra.irp.f @@ -224,18 +224,34 @@ subroutine ortho_qr_complex(A,LDA,m,n) call zgeqrf( m, n, A, LDA, tau, work, lwork, info ) lwork=int(work(1)) 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)) call zgeqrf(m, n, A, LDA, tau, work, lwork, info ) deallocate(work) + if (info.ne.0) then + print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value' + stop 2 + endif lwork=-1 allocate(work(1)) call zungqr(m, n, n, A, LDA, tau, work, lwork, info) lwork=int(work(1)) 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)) call zungqr(m, n, n, A, LDA, tau, work, lwork, info) deallocate(work,tau) + if (info.ne.0) then + print*,irp_here,' The ',-info,' argument to zgeqrf had an illegal value' + stop 4 + endif end 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)) 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) + if (info.ne.0) then + print*,irp_here,' The ',-info,' argument to zung2r had an illegal value' + stop 2 + endif deallocate(work,tau) end From 95294eaf14b3d203485afed95e9ba1e28f8f517e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 7 May 2020 17:29:16 -0500 Subject: [PATCH 3/4] minor fixes in davidson --- src/davidson/diagonalization_hs2_dressed.irp.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/davidson/diagonalization_hs2_dressed.irp.f b/src/davidson/diagonalization_hs2_dressed.irp.f index 9615f72c..2a7c93d6 100644 --- a/src/davidson/diagonalization_hs2_dressed.irp.f +++ b/src/davidson/diagonalization_hs2_dressed.irp.f @@ -1176,7 +1176,7 @@ subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_i do i=1,shift2 s_(i,j) = (0.d0,0.d0) 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 @@ -1188,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)? call zgemm('C','N', shift2, shift2, sze, & (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 ! -------------- From 6c64747bcb115d0b091a137e2901bc8b1c59dd1e Mon Sep 17 00:00:00 2001 From: Kevin Gasperich Date: Thu, 7 May 2020 17:30:53 -0500 Subject: [PATCH 4/4] fixed attributes --- src/davidson/u0_h_u0.irp.f | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/davidson/u0_h_u0.irp.f b/src/davidson/u0_h_u0.irp.f index 6142e828..0f12a8df 100644 --- a/src/davidson/u0_h_u0.irp.f +++ b/src/davidson/u0_h_u0.irp.f @@ -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. END_DOC 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 complex*16, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t