LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-25 04:53:32 +01:00
Code Releases Activity

Reduced memory for prototype matrix containers.

Browse Source
This commit is contained in:
vijay gopal chilkuri 2021-03-12 15:50:54 +01:00
parent 49e5d57c40
commit 97a57594c3
3 changed files with 62 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/csf/configuration_CI_sigma_helpers.irp.f
View File

@ -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"

95
src/csf/sigma_vector.irp.f
View File

@ -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

4
src/davidson/diagonalization_hcsf_dressed.irp.f
View File

@ -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)