diff --git a/src/csf/configuration_CI_sigma_helpers.irp.f b/src/csf/configuration_CI_sigma_helpers.irp.f index 1af81ae4..0e06817a 100644 --- a/src/csf/configuration_CI_sigma_helpers.irp.f +++ b/src/csf/configuration_CI_sigma_helpers.irp.f @@ -1,6 +1,6 @@ use bitmasks - BEGIN_PROVIDER [ integer(bit_kind), alphasIcfg_list , (N_int,2,N_configuration,N_configuration*mo_num*mo_num)] + BEGIN_PROVIDER [ integer(bit_kind), alphasIcfg_list , (N_int,2,N_configuration,mo_num*mo_num)] &BEGIN_PROVIDER [ integer, NalphaIcfg_list, (N_configuration) ] implicit none !use bitmasks @@ -13,7 +13,6 @@ use bitmasks integer :: idxI ! The id of the Ith CFG integer(bit_kind) :: Icfg(N_int,2) integer :: NalphaIcfg - integer(bit_kind) :: alphasIcfg(N_int,2,N_configuration*mo_num*mo_num) logical,dimension(:,:),allocatable :: tableUniqueAlphas integer :: listholes(mo_num) integer :: holetype(mo_num) ! 1-> SOMO 2->DOMO @@ -101,11 +100,10 @@ use bitmasks if(Nsomo_I .EQ. 0) then kstart = 1 else - kstart = cfg_seniority_index(Nsomo_I-2) + kstart = cfg_seniority_index(max(0,Nsomo_I-2)) endif kend = idxI-1 - ! TODO cfg_seniority_index do i = 1,nholes p = listholes(i) do j = 1,nvmos @@ -116,14 +114,14 @@ use bitmasks Jsomo = IBCLR(Isomo,p-1) Jsomo = IBSET(Jsomo,q-1) Jdomo = Idomo - kstart = max(0,cfg_seniority_index(Nsomo_I-2)) + kstart = max(0,cfg_seniority_index(max(0,Nsomo_I-2))) kend = idxI-1 else if(holetype(i) .EQ. 1 .AND. vmotype(j) .EQ. 2) then ! SOMO -> SOMO Jsomo = IBCLR(Isomo,p-1) Jsomo = IBCLR(Jsomo,q-1) Jdomo = IBSET(Idomo,q-1) - kstart = max(0,cfg_seniority_index(Nsomo_I-4)) + kstart = max(0,cfg_seniority_index(max(0,Nsomo_I-4))) kend = idxI-1 else if(holetype(i) .EQ. 2 .AND. vmotype(j) .EQ. 1) then ! DOMO -> VMO @@ -138,7 +136,7 @@ use bitmasks Jsomo = IBCLR(Jsomo,q-1) Jdomo = IBCLR(Idomo,p-1) Jdomo = IBSET(Jdomo,q-1) - kstart = max(0,cfg_seniority_index(Nsomo_I-2)) + kstart = max(0,cfg_seniority_index(max(0,Nsomo_I-2))) kend = idxI-1 else print*,"Something went wrong in obtain_associated_alphaI" @@ -224,9 +222,8 @@ use bitmasks ! SOMO NalphaIcfg += 1 !print *,i,j,"|",NalphaIcfg - alphasIcfg(1,1,NalphaIcfg) = Jsomo - alphasIcfg(1,2,NalphaIcfg) = IOR(Jdomo,ISHFT(1_8,n_core_orb)-1) - alphasIcfg_list(1:N_int,1:2,idxI,NalphaIcfg) = alphasIcfg(1:N_int,1:2,NalphaIcfg) + alphasIcfg_list(1,1,idxI,NalphaIcfg) = Jsomo + alphasIcfg_list(1,2,idxI,NalphaIcfg) = IOR(Jdomo,ISHFT(1_8,n_core_orb)-1) NalphaIcfg_list(idxI) = NalphaIcfg endif end do @@ -252,9 +249,8 @@ use bitmasks if(nholes > 0 .AND. (.NOT. ppExistsQ))then ! SOMO NalphaIcfg += 1 - alphasIcfg(1,1,NalphaIcfg) = Icfg(1,1) - alphasIcfg(1,2,NalphaIcfg) = Icfg(1,2) - alphasIcfg_list(1:N_int,1:2,idxI,NalphaIcfg) = alphasIcfg(1:N_int,1:2,NalphaIcfg) + alphasIcfg_list(1,1,idxI,NalphaIcfg) = Icfg(1,1) + alphasIcfg_list(1,2,idxI,NalphaIcfg) = Icfg(1,2) NalphaIcfg_list(idxI) = NalphaIcfg endif @@ -365,7 +361,7 @@ END_PROVIDER if(Nsomo_I .EQ. 0) then kstart = 1 else - kstart = cfg_seniority_index(Nsomo_I-2) + kstart = cfg_seniority_index(max(0,Nsomo_I-2)) endif kend = idxI-1 !print *,"Isomo" @@ -380,7 +376,6 @@ END_PROVIDER ! print *,i,"->",listvmos(i) !enddo - ! TODO cfg_seniority_index do i = 1,nholes p = listholes(i) do j = 1,nvmos @@ -391,14 +386,14 @@ END_PROVIDER Jsomo = IBCLR(Isomo,p-1) Jsomo = IBSET(Jsomo,q-1) Jdomo = Idomo - kstart = max(0,cfg_seniority_index(Nsomo_I-2)) + kstart = max(0,cfg_seniority_index(max(0,Nsomo_I-2))) kend = idxI-1 else if(holetype(i) .EQ. 1 .AND. vmotype(j) .EQ. 2) then ! SOMO -> SOMO Jsomo = IBCLR(Isomo,p-1) Jsomo = IBCLR(Jsomo,q-1) Jdomo = IBSET(Idomo,q-1) - kstart = max(0,cfg_seniority_index(Nsomo_I-4)) + kstart = max(0,cfg_seniority_index(max(0,Nsomo_I-4))) kend = idxI-1 else if(holetype(i) .EQ. 2 .AND. vmotype(j) .EQ. 1) then ! DOMO -> VMO @@ -413,7 +408,7 @@ END_PROVIDER Jsomo = IBCLR(Jsomo,q-1) Jdomo = IBCLR(Idomo,p-1) Jdomo = IBSET(Jdomo,q-1) - kstart = max(0,cfg_seniority_index(Nsomo_I-2)) + kstart = max(0,cfg_seniority_index(max(0,Nsomo_I-2))) kend = idxI-1 else print*,"Something went wrong in obtain_associated_alphaI" diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index 5a01ac2d..377740b2 100644 --- a/src/csf/sigma_vector.irp.f +++ b/src/csf/sigma_vector.irp.f @@ -216,7 +216,7 @@ end subroutine get_phase_qp_to_cfg END_PROVIDER - BEGIN_PROVIDER [ integer, AIJpqMatrixDimsList, (0:NSOMOMax,0:NSOMOMax,4,NSOMOMax+1,NSOMOMax+1,2)] + BEGIN_PROVIDER [ integer, AIJpqMatrixDimsList, (0:NSOMOMax,4,NSOMOMax+1,NSOMOMax+1,2)] &BEGIN_PROVIDER [ integer, rowsmax] &BEGIN_PROVIDER [ integer, colsmax] use cfunctions @@ -244,8 +244,8 @@ end subroutine get_phase_qp_to_cfg ! Type ! 1. SOMO -> SOMO !print *,"Doing SOMO->SOMO" - AIJpqMatrixDimsList(0,0,1,1,1,1) = 1 - AIJpqMatrixDimsList(0,0,1,1,1,2) = 1 + AIJpqMatrixDimsList(0,1,1,1,1) = 1 + AIJpqMatrixDimsList(0,1,1,1,2) = 1 do i = 2-iand(nsomomin,1), NSOMOMax, 2 Isomo = ISHFT(1_8,i)-1 do j = i-2,i-2, 2 @@ -281,8 +281,8 @@ end subroutine get_phase_qp_to_cfg colsmax = cols end if ! i -> j - AIJpqMatrixDimsList(nsomoi,nsomoj,1,k,l,1) = rows - AIJpqMatrixDimsList(nsomoi,nsomoj,1,k,l,2) = cols + AIJpqMatrixDimsList(nsomoi,1,k,l,1) = rows + AIJpqMatrixDimsList(nsomoi,1,k,l,2) = cols end do end do end do @@ -290,8 +290,8 @@ end subroutine get_phase_qp_to_cfg ! Type ! 2. DOMO -> VMO !print *,"Doing DOMO->VMO" - AIJpqMatrixDimsList(0,0,2,1,1,1) = 1 - AIJpqMatrixDimsList(0,0,2,1,1,2) = 1 + AIJpqMatrixDimsList(0,2,1,1,1) = 1 + AIJpqMatrixDimsList(0,2,1,1,2) = 1 do i = 0+iand(nsomomin,1), NSOMOMax, 2 Isomo = ISHFT(1_8,i)-1 tmpsomo = ISHFT(1_8,i+2)-1 @@ -333,8 +333,8 @@ end subroutine get_phase_qp_to_cfg colsmax = cols end if ! i -> j - AIJpqMatrixDimsList(nsomoi,nsomoj,2,k,l,1) = rows - AIJpqMatrixDimsList(nsomoi,nsomoj,2,k,l,2) = cols + AIJpqMatrixDimsList(nsomoi,2,k,l,1) = rows + AIJpqMatrixDimsList(nsomoi,2,k,l,2) = cols end do end do end do @@ -342,8 +342,8 @@ end subroutine get_phase_qp_to_cfg ! Type ! 3. SOMO -> VMO !print *,"Doing SOMO->VMO" - AIJpqMatrixDimsList(0,0,3,1,1,1) = 1 - AIJpqMatrixDimsList(0,0,3,1,1,2) = 1 + AIJpqMatrixDimsList(0,3,1,1,1) = 1 + AIJpqMatrixDimsList(0,3,1,1,2) = 1 do i = 2-iand(nsomomin,1), NSOMOMax, 2 Isomo = ISHFT(1_8,i)-1 do j = i,i, 2 @@ -375,8 +375,8 @@ end subroutine get_phase_qp_to_cfg colsmax = cols end if ! i -> j - AIJpqMatrixDimsList(i,j,3,k,l,1) = rows - AIJpqMatrixDimsList(i,j,3,k,l,2) = cols + AIJpqMatrixDimsList(i,3,k,l,1) = rows + AIJpqMatrixDimsList(i,3,k,l,2) = cols end do end do end do @@ -384,8 +384,8 @@ end subroutine get_phase_qp_to_cfg ! Type ! 4. DOMO -> SOMO !print *,"Doing DOMO->SOMO" - AIJpqMatrixDimsList(0,0,4,1,1,1) = 1 - AIJpqMatrixDimsList(0,0,4,1,1,2) = 1 + AIJpqMatrixDimsList(0,4,1,1,1) = 1 + AIJpqMatrixDimsList(0,4,1,1,2) = 1 do i = 2-iand(nsomomin,1), NSOMOMax, 2 do j = i,i, 2 if(j .GT. NSOMOMax .OR. j .LE. 0) then @@ -415,8 +415,8 @@ end subroutine get_phase_qp_to_cfg colsmax = cols end if ! i -> j - AIJpqMatrixDimsList(i,j,4,k,l,1) = rows - AIJpqMatrixDimsList(i,j,4,k,l,2) = cols + AIJpqMatrixDimsList(i,4,k,l,1) = rows + AIJpqMatrixDimsList(i,4,k,l,2) = cols end do end do end do @@ -424,7 +424,7 @@ end subroutine get_phase_qp_to_cfg print *,"Rowsmax=",rowsmax," Colsmax=",colsmax END_PROVIDER - BEGIN_PROVIDER [ real*8, AIJpqContainer, (0:NSOMOMax,0:NSOMOMax,4,NSOMOMax+1,NSOMOMax+1,NBFMax,NBFMax)] + BEGIN_PROVIDER [ real*8, AIJpqContainer, (0:NSOMOMax,4,NSOMOMax+1,NSOMOMax+1,NBFMax,NBFMax)] !BEGIN_PROVIDER [ real*8, AIJpqContainer, (0:NSOMOMax,-1:1,4,NSOMOMax+1,-1:1,NBFMax,NBFMax)] use cfunctions implicit none @@ -463,11 +463,10 @@ end subroutine get_phase_qp_to_cfg ! allocate matrix !print *,"rowsmax =",rowsmax," colsmax=",colsmax !print *,"NSOMOMax = ",NSOMOMax - !allocate(AIJpqMatrixDimsList(NSOMOMax,NSOMOMax,4,NSOMOMax,NSOMOMax,2)) ! Type ! 1. SOMO -> SOMO !print *,"Doing SOMO -> SOMO" - AIJpqContainer(0,0,1,1,1,1,1) = 1.0d0 + AIJpqContainer(0,1,1,1,1,1) = 1.0d0 do i = 2, NSOMOMax, 2 Isomo = ISHFT(1_8,i)-1 do j = i-2,i-2, 2 @@ -493,7 +492,7 @@ end subroutine get_phase_qp_to_cfg !call debug_spindet(Jsomo,1) !call debug_spindet(Isomo,1) - AIJpqContainer(nsomoi,nsomoj,1,k,l,:,:) = 0.0d0 + AIJpqContainer(nsomoi,1,k,l,:,:) = 0.0d0 call getApqIJMatrixDims(Isomo, & Jsomo, & MS, & @@ -519,7 +518,7 @@ end subroutine get_phase_qp_to_cfg ! i -> j do ri = 1,rows do ci = 1,cols - AIJpqContainer(nsomoi,nsomoj,1,k,l,ri,ci) = meMatrix(ri, ci) + AIJpqContainer(nsomoi,1,k,l,ri,ci) = meMatrix(ri, ci) end do end do deallocate(meMatrix) @@ -530,7 +529,7 @@ end subroutine get_phase_qp_to_cfg ! Type ! 2. DOMO -> VMO !print *,"Doing DOMO -> VMO" - AIJpqContainer(0,0,2,1,1,1,1) = 1.0d0 + AIJpqContainer(0,2,1,1,1,1) = 1.0d0 do i = 0, NSOMOMax, 2 Isomo = ISHFT(1_8,i)-1 tmpsomo = ISHFT(1_8,i+2)-1 @@ -560,7 +559,7 @@ end subroutine get_phase_qp_to_cfg !call debug_spindet(Jsomo,1) !call debug_spindet(Isomo,1) - AIJpqContainer(nsomoi,nsomoj,2,k,l,:,:) = 0.0d0 + AIJpqContainer(nsomoi,2,k,l,:,:) = 0.0d0 call getApqIJMatrixDims(Isomo, & Jsomo, & MS, & @@ -586,7 +585,7 @@ end subroutine get_phase_qp_to_cfg ! i -> j do ri = 1,rows do ci = 1,cols - AIJpqContainer(nsomoi,nsomoj,2,k,l,ri,ci) = meMatrix(ri, ci) + AIJpqContainer(nsomoi,2,k,l,ri,ci) = meMatrix(ri, ci) end do end do deallocate(meMatrix) @@ -618,7 +617,7 @@ end subroutine get_phase_qp_to_cfg !call debug_spindet(Jsomo,1) !call debug_spindet(Isomo,1) - AIJpqContainer(i,j,3,k,l,:,:) = 0.0d0 + AIJpqContainer(i,3,k,l,:,:) = 0.0d0 call getApqIJMatrixDims(Isomo, & Jsomo, & MS, & @@ -644,7 +643,7 @@ end subroutine get_phase_qp_to_cfg ! i -> j do ri = 1,rows do ci = 1,cols - AIJpqContainer(i,j,3,k,l,ri,ci) = meMatrix(ri, ci) + AIJpqContainer(i,3,k,l,ri,ci) = meMatrix(ri, ci) end do end do deallocate(meMatrix) @@ -655,7 +654,7 @@ end subroutine get_phase_qp_to_cfg ! Type ! 4. DOMO -> SOMO !print *,"Doing DOMO -> SOMO" - AIJpqContainer(0,0,4,1,1,1,1) = 1.0d0 + AIJpqContainer(0,4,1,1,1,1) = 1.0d0 do i = 2, NSOMOMax, 2 Isomo = ISHFT(1_8,i)-1 do j = i,i, 2 @@ -673,7 +672,7 @@ end subroutine get_phase_qp_to_cfg Jsomo = ISHFT(1_8,j)-1 endif - AIJpqContainer(i,j,4,k,l,:,:) = 0.0d0 + AIJpqContainer(i,4,k,l,:,:) = 0.0d0 call getApqIJMatrixDims(Isomo, & Jsomo, & MS, & @@ -700,7 +699,7 @@ end subroutine get_phase_qp_to_cfg ! i -> j do ri = 1,rows do ci = 1,cols - AIJpqContainer(i,j,4,k,l,ri,ci) = meMatrix(ri, ci) + AIJpqContainer(i,4,k,l,ri,ci) = meMatrix(ri, ci) end do end do deallocate(meMatrix) @@ -1031,7 +1030,7 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze cntj = 0 do jj = startj, endj cntj += 1 - meCC1 = AIJpqContainer(NSOMOI,NSOMOJ,extype,pmodel,qmodel,cnti,cntj) + meCC1 = AIJpqContainer(NSOMOI,extype,pmodel,qmodel,cnti,cntj) psi_out(jj,kk) += meCC1 * psi_in(ii,kk) * h_core_ri(p,q) enddo enddo @@ -1092,8 +1091,8 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze if(p.EQ.q) then NSOMOalpha = NSOMOI endif - rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,1) - colsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,2) + rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,1) + colsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,2) totcolsTKI += colsikpq if(rowsTKI .LT. rowsikpq .AND. rowsTKI .NE. -1) then print *,">",j,"Something is wrong in sigma-vector", rowsTKI, rowsikpq, "(p,q)=",pmodel,qmodel,"ex=",extype,"na=",NSOMOalpha," nI=",NSOMOI @@ -1117,12 +1116,12 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze q = excitationIds(2,j) extype = excitationTypes(j) call convertOrbIdsToModelSpaceIds(alphas_Icfg(:,:,k), connectedI_alpha(:,:,j), p, q, extype, pmodel, qmodel) - rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,1) - colsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,2) + rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,1) + colsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,2) do kk = 1,n_st do l = 1,rowsTKI do m = 1,colsikpq - TKI(l,kk,totcolsTKI+m) = AIJpqContainer(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,l,m) * psi_in(idxs_connectedI_alpha(j)+m-1,kk) + TKI(l,kk,totcolsTKI+m) = AIJpqContainer(NSOMOalpha,extype,pmodel,qmodel,l,m) * psi_in(idxs_connectedI_alpha(j)+m-1,kk) enddo enddo enddo @@ -1184,13 +1183,13 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze q = excitationIds(2,j) extype = excitationTypes(j) call convertOrbIdsToModelSpaceIds(alphas_Icfg(:,:,k), connectedI_alpha(:,:,j), p, q, extype, pmodel, qmodel) - rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,1) - colsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,2) + rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,1) + colsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,2) !print *,">j=",j,rowsikpq,colsikpq, ">>",totcolsTKI,",",idxs_connectedI_alpha(j) do kk = 1,n_st do m = 1,colsikpq do l = 1,rowsTKI - psi_out(idxs_connectedI_alpha(j)+m-1,kk) += AIJpqContainer(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,l,m) * TKIGIJ(l,kk,j) + psi_out(idxs_connectedI_alpha(j)+m-1,kk) += AIJpqContainer(NSOMOalpha,extype,pmodel,qmodel,l,m) * TKIGIJ(l,kk,j) enddo enddo enddo @@ -1399,7 +1398,7 @@ subroutine calculate_sigma_vector_cfg_nst(psi_out, psi_in, n_st, sze, istart, ie cntj = 0 do jj = startj, endj cntj += 1 - meCC1 = AIJpqContainer(NSOMOI,NSOMOJ,extype,pmodel,qmodel,cnti,cntj) + meCC1 = AIJpqContainer(NSOMOI,extype,pmodel,qmodel,cnti,cntj) psi_out(jj,kk) += meCC1 * psi_in(ii,kk) * h_core_ri(p,q) enddo enddo @@ -1457,8 +1456,8 @@ subroutine calculate_sigma_vector_cfg_nst(psi_out, psi_in, n_st, sze, istart, ie if(p.EQ.q) then NSOMOalpha = NSOMOI endif - rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,1) - colsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,2) + rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,1) + colsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,2) totcolsTKI += colsikpq if(rowsTKI .LT. rowsikpq .AND. rowsTKI .NE. -1) then print *,">",j,"Something is wrong in sigma-vector", rowsTKI, rowsikpq, "(p,q)=",pmodel,qmodel,"ex=",extype,"na=",NSOMOalpha," nI=",NSOMOI @@ -1482,12 +1481,12 @@ subroutine calculate_sigma_vector_cfg_nst(psi_out, psi_in, n_st, sze, istart, ie q = excitationIds(2,j) extype = excitationTypes(j) call convertOrbIdsToModelSpaceIds(alphas_Icfg(:,:,k), connectedI_alpha(:,:,j), p, q, extype, pmodel, qmodel) - rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,1) - colsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,2) + rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,1) + colsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,2) do kk = 1,n_st do l = 1,rowsTKI do m = 1,colsikpq - TKI(l,kk,totcolsTKI+m) = AIJpqContainer(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,l,m) * psi_in(idxs_connectedI_alpha(j)+m-1,kk) + TKI(l,kk,totcolsTKI+m) = AIJpqContainer(NSOMOalpha,extype,pmodel,qmodel,l,m) * psi_in(idxs_connectedI_alpha(j)+m-1,kk) enddo enddo enddo @@ -1532,13 +1531,13 @@ subroutine calculate_sigma_vector_cfg_nst(psi_out, psi_in, n_st, sze, istart, ie q = excitationIds(2,j) extype = excitationTypes(j) call convertOrbIdsToModelSpaceIds(alphas_Icfg(:,:,k), connectedI_alpha(:,:,j), p, q, extype, pmodel, qmodel) - rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,1) - colsikpq = AIJpqMatrixDimsList(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,2) + rowsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,1) + colsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,2) !print *,">j=",j,rowsikpq,colsikpq, ">>",totcolsTKI,",",idxs_connectedI_alpha(j) do kk = 1,n_st do m = 1,colsikpq do l = 1,rowsTKI - psi_out(idxs_connectedI_alpha(j)+m-1,kk) += AIJpqContainer(NSOMOalpha,NSOMOI,extype,pmodel,qmodel,l,m) * TKIGIJ(l,kk,j) + psi_out(idxs_connectedI_alpha(j)+m-1,kk) += AIJpqContainer(NSOMOalpha,extype,pmodel,qmodel,l,m) * TKIGIJ(l,kk,j) enddo enddo enddo diff --git a/src/davidson/diagonalization_hcsf_dressed.irp.f b/src/davidson/diagonalization_hcsf_dressed.irp.f index 3735a227..ddfce72b 100644 --- a/src/davidson/diagonalization_hcsf_dressed.irp.f +++ b/src/davidson/diagonalization_hcsf_dressed.irp.f @@ -321,7 +321,7 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N tmpU(ii,kk) = U_csf(ii,shift+kk) enddo enddo - call calculate_sigma_vector_cfg_nst(tmpW,tmpU,N_st_diag,sze_csf,1,sze_csf,0,1) + call calculate_sigma_vector_cfg_nst_naive_store(tmpW,tmpU,N_st_diag,sze_csf,1,sze_csf,0,1) do kk=1,N_st_diag do ii=1,sze_csf W_csf(ii,shift+kk)=tmpW(ii,kk) @@ -346,7 +346,7 @@ subroutine davidson_diag_csf_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,sze_csf,N tmpU(ii,kk) = U_csf(ii,shift+kk) enddo enddo - call calculate_sigma_vector_cfg_nst(tmpW,tmpU,N_st_diag,sze_csf,1,sze_csf,0,1) + call calculate_sigma_vector_cfg_nst_naive_store(tmpW,tmpU,N_st_diag,sze_csf,1,sze_csf,0,1) do kk=1,N_st_diag do ii=1,sze_csf W_csf(ii,shift+kk)=tmpW(ii,kk)