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

Fixed some bugs from merge.

Browse Source
This commit is contained in:
vijay gopal chilkuri 2021-03-17 15:50:12 +01:00
parent 5517506b9a
commit 267364fa0a
1 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -974,11 +974,12 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
!$OMP nsinglesI, singlesI,idxs_singlesI,excitationIds_single,& !$OMP nsinglesI, singlesI,idxs_singlesI,excitationIds_single,&
!$OMP excitationTypes_single, idxI, p, q, extype, pmodel, qmodel,& !$OMP excitationTypes_single, idxI, p, q, extype, pmodel, qmodel,&
!$OMP Jsomo, Jdomo, startj, endj, kk, jj, ii, cnti, cntj, meCC1,& !$OMP Jsomo, Jdomo, startj, endj, kk, jj, ii, cnti, cntj, meCC1,&
!$OMP nconnectedJ,listconnectedJ,idslistconnectedJ, &
!$OMP Nalphas_Icfg,alphas_Icfg,connectedI_alpha, & !$OMP Nalphas_Icfg,alphas_Icfg,connectedI_alpha, &
!$OMP idxs_connectedI_alpha,nconnectedI,excitationIds,excitationTypes,diagfactors,& !$OMP idxs_connectedI_alpha,nconnectedI,excitationIds,excitationTypes,diagfactors,&
!$OMP totcolsTKI,rowsTKI,NSOMOalpha,rowsikpq, & !$OMP totcolsTKI,rowsTKI,NSOMOalpha,rowsikpq, &
!$OMP colsikpq, GIJpqrs,TKIGIJ,j,l,m,TKI,CCmattmp, moi, moj, mok, mol,& !$OMP colsikpq, GIJpqrs,TKIGIJ,j,l,m,TKI,CCmattmp, moi, moj, mok, mol,&
!$OMP diagfac) & !$OMP diagfac, tmpvar) &
!$OMP shared(istart_cfg, iend_cfg, psi_configuration, mo_num, psi_config_data,& !$OMP shared(istart_cfg, iend_cfg, psi_configuration, mo_num, psi_config_data,&
!$OMP N_int, N_st, psi_out, psi_in, h_core_ri, AIJpqContainer,& !$OMP N_int, N_st, psi_out, psi_in, h_core_ri, AIJpqContainer,&
!$OMP sze, NalphaIcfg_list,alphasIcfg_list, & !$OMP sze, NalphaIcfg_list,alphasIcfg_list, &
@ -1114,12 +1115,14 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
deallocate(excitationIds_single) deallocate(excitationIds_single)
deallocate(excitationTypes_single) deallocate(excitationTypes_single)
allocate(listconnectedJ(N_INT,2,max(sze,100)))
allocate(alphas_Icfg(N_INT,2,max(sze,100))) allocate(alphas_Icfg(N_INT,2,max(sze,100)))
allocate(connectedI_alpha(N_INT,2,max(sze,100))) allocate(connectedI_alpha(N_INT,2,max(sze,100)))
allocate(idxs_connectedI_alpha(max(sze,100))) allocate(idxs_connectedI_alpha(max(sze,100)))
allocate(excitationIds(2,max(sze,100))) allocate(excitationIds(2,max(sze,100)))
allocate(excitationTypes(max(sze,100))) allocate(excitationTypes(max(sze,100)))
allocate(diagfactors(max(sze,100))) allocate(diagfactors(max(sze,100)))
allocate(idslistconnectedJ(max(sze,100)))
! Loop over all selected configurations ! Loop over all selected configurations
!$OMP DO SCHEDULE(dynamic,16) !$OMP DO SCHEDULE(dynamic,16)
@ -1286,8 +1289,10 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
!tmpvar = psi_out(kk,idxs_connectedI_alpha(j)+m-1) !tmpvar = psi_out(kk,idxs_connectedI_alpha(j)+m-1)
do l = 1,rowsTKI do l = 1,rowsTKI
do kk = 1,n_st do kk = 1,n_st
call omp_set_lock(lock(idxs_connectedI_alpha(j)+m-1))
!tmpvar += AIJpqContainer(NSOMOalpha,extype,pmodel,qmodel,l,m) * TKIGIJ(kk,l,j) !tmpvar += AIJpqContainer(NSOMOalpha,extype,pmodel,qmodel,l,m) * TKIGIJ(kk,l,j)
psi_out(kk,idxs_connectedI_alpha(j)+m-1) += AIJpqContainer(l,m,pmodel,qmodel,extype,NSOMOalpha) * TKIGIJ(kk,l,j) psi_out(kk,idxs_connectedI_alpha(j)+m-1) += AIJpqContainer(l,m,pmodel,qmodel,extype,NSOMOalpha) * TKIGIJ(kk,l,j)
call omp_unset_lock(lock(idxs_connectedI_alpha(j)+m-1))
enddo enddo
!psi_out(kk,idxs_connectedI_alpha(j)+m-1) = tmpvar !psi_out(kk,idxs_connectedI_alpha(j)+m-1) = tmpvar
enddo enddo
@ -1303,17 +1308,25 @@ subroutine calculate_sigma_vector_cfg_nst_naive_store(psi_out, psi_in, n_st, sze
enddo ! loop over alphas enddo ! loop over alphas
enddo ! loop over I enddo ! loop over I
!$OMP end master !$OMP END DO
!$OMP end parallel
call omp_set_max_active_levels(4) call omp_set_max_active_levels(4)
deallocate(connectedI_alpha)
deallocate(idxs_connectedI_alpha)
deallocate(excitationIds)
deallocate(excitationTypes)
deallocate(diagfactors)
! Add the diagonal contribution ! Add the diagonal contribution
!$OMP DO
do kk=1,n_st do kk=1,n_st
do i = 1,n_CSF do i = 1,n_CSF
psi_out(kk,i) += diag_energies(i)*psi_in(kk,i) psi_out(kk,i) += diag_energies(i)*psi_in(kk,i)
enddo enddo
enddo enddo
!$OMP END DO
!$OMP end parallel
end subroutine calculate_sigma_vector_cfg_nst_naive_store end subroutine calculate_sigma_vector_cfg_nst_naive_store
@ -1520,12 +1533,10 @@ subroutine calculate_sigma_vector_cfg_nst(psi_out, psi_in, n_st, sze, istart, ie
colsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,2) colsikpq = AIJpqMatrixDimsList(NSOMOalpha,extype,pmodel,qmodel,2)
do m = 1,colsikpq do m = 1,colsikpq
do l = 1,rowsTKI do l = 1,rowsTKI
call omp_set_lock(lock(idxs_connectedI_alpha(j)+m-1))
do kk = 1,n_st do kk = 1,n_st
psi_out(kk,idxs_connectedI_alpha(j)+m-1) = psi_out(kk,idxs_connectedI_alpha(j)+m-1) + & psi_out(kk,idxs_connectedI_alpha(j)+m-1) = psi_out(kk,idxs_connectedI_alpha(j)+m-1) + &
AIJpqContainer(l,m,pmodel,qmodel,extype,NSOMOalpha) * TKIGIJ(kk,l,j) AIJpqContainer(l,m,pmodel,qmodel,extype,NSOMOalpha) * TKIGIJ(kk,l,j)
enddo enddo
call omp_unset_lock(lock(idxs_connectedI_alpha(j)+m-1))
enddo enddo
enddo enddo
totcolsTKI += colsikpq totcolsTKI += colsikpq
@ -1539,7 +1550,6 @@ subroutine calculate_sigma_vector_cfg_nst(psi_out, psi_in, n_st, sze, istart, ie
enddo ! loop over alphas enddo ! loop over alphas
enddo ! loop over I enddo ! loop over I
!$OMP end do
deallocate(connectedI_alpha) deallocate(connectedI_alpha)
deallocate(idxs_connectedI_alpha) deallocate(idxs_connectedI_alpha)
deallocate(excitationIds) deallocate(excitationIds)
@ -1548,15 +1558,11 @@ subroutine calculate_sigma_vector_cfg_nst(psi_out, psi_in, n_st, sze, istart, ie
! Add the diagonal contribution ! Add the diagonal contribution
!$OMP DO
do i = 1,n_CSF do i = 1,n_CSF
do kk=1,n_st do kk=1,n_st
psi_out(kk,i) += diag_energies(i)*psi_in(kk,i) psi_out(kk,i) += diag_energies(i)*psi_in(kk,i)
enddo enddo
enddo enddo
!$OMP END DO
!$OMP end parallel
call omp_set_max_active_levels(4) call omp_set_max_active_levels(4)
end subroutine calculate_sigma_vector_cfg_nst_naive_store end subroutine calculate_sigma_vector_cfg_nst_naive_store