diff --git a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f index 2f3d7f80..4331b0e0 100644 --- a/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f +++ b/src/dav_general_mat/dav_diag_dressed_ext_rout.irp.f @@ -27,7 +27,7 @@ subroutine davidson_general_ext_rout(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_d 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(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_d 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(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_d 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 ! += Dress_jj(i) * - 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(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_d ! -------------------------------------------------- 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(u_in,H_jj,Dress_jj,energies,sze,N_st,N_st_d 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 diff --git a/src/dav_general_mat/dav_double_dress_ext_rout.irp.f b/src/dav_general_mat/dav_double_dress_ext_rout.irp.f index 884fd672..e59d21d1 100644 --- a/src/dav_general_mat/dav_double_dress_ext_rout.irp.f +++ b/src/dav_general_mat/dav_double_dress_ext_rout.irp.f @@ -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> ! ----------------------------------- - 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 ! += Dress_jj(i) * - 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 diff --git a/src/dav_general_mat/dav_dressed_ext_rout.irp.f b/src/dav_general_mat/dav_dressed_ext_rout.irp.f index c3bfe91a..c045aa1a 100644 --- a/src/dav_general_mat/dav_dressed_ext_rout.irp.f +++ b/src/dav_general_mat/dav_dressed_ext_rout.irp.f @@ -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 diff --git a/src/dav_general_mat/dav_ext_rout.irp.f b/src/dav_general_mat/dav_ext_rout.irp.f index aee4ba09..a4c47c27 100644 --- a/src/dav_general_mat/dav_ext_rout.irp.f +++ b/src/dav_general_mat/dav_ext_rout.irp.f @@ -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 diff --git a/src/dav_general_mat/dav_general.irp.f b/src/dav_general_mat/dav_general.irp.f index 39cb68bb..96775c50 100644 --- a/src/dav_general_mat/dav_general.irp.f +++ b/src/dav_general_mat/dav_general.irp.f @@ -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