From 330b3549bc00e8a81483ef437858b921ae6d259c Mon Sep 17 00:00:00 2001 From: "Igor S. Gerasimov" Date: Fri, 25 Feb 2022 19:09:47 +0900 Subject: [PATCH 2/2] Copy fragments and MOs while dublication is --- sub.f90 | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/sub.f90 b/sub.f90 index 590b38b..de07ede 100644 --- a/sub.f90 +++ b/sub.f90 @@ -5,7 +5,7 @@ use util implicit real*8 (a-h,o-z) character seltmpc*10,selectyn,c1000tmp*1000,c2000tmp*2000 real*8 eigval(nbasis),eigvec(nbasis,nbasis),tmpmat(nbasis,nbasis) -real*8,allocatable :: tmparr(:) +real*8,allocatable :: tmparr(:), MOocc_tmp(:) integer orbarr(nmo) integer,allocatable :: exclfragatm(:),tmparrint(:),idxsel(:) character(len=3) :: orbtype(0:2)=(/ "A+B"," A "," B " /) @@ -852,20 +852,28 @@ do while(.true.) allocate(a_tmp(ncenter)) allocate(b_tmp(nprims)) allocate(CO_tmp(nmo,nprims)) + allocate(MOocc_tmp(nmo)) a_tmp=a b_tmp=b CO_tmp=CO - deallocate(a,b,CO) + MOocc_tmp=MOocc nprims_tmp=nprims ncenter_tmp=ncenter + nmo_tmp=nmo + deallocate(a,b,CO,MOocc,MOene) nprims=nprims*(numdup+1) ncenter=ncenter*(numdup+1) nelec=nelec*(numdup+1) naelec=naelec*(numdup+1) nbelec=nbelec*(numdup+1) + nmo=nmo*(numdup+1) allocate(a(ncenter)) allocate(b(nprims)) allocate(CO(nmo,nprims)) + allocate(MOocc(nmo)) + allocate(MOene(nmo)) + MOene = 0D0 ! no more physical meaning of orbital energies; please, solve inverse Kohn-Sham (iKS) equations + CO = 0D0 do idup=0,numdup a(ncenter_tmp*idup+1:ncenter_tmp*(idup+1))=a_tmp(1:ncenter_tmp) a(ncenter_tmp*idup+1:ncenter_tmp*(idup+1))%x=a_tmp(1:ncenter_tmp)%x+pbctransx*idup @@ -873,9 +881,10 @@ do while(.true.) a(ncenter_tmp*idup+1:ncenter_tmp*(idup+1))%z=a_tmp(1:ncenter_tmp)%z+pbctransz*idup b(nprims_tmp*idup+1:nprims_tmp*(idup+1))=b_tmp(1:nprims_tmp) b(nprims_tmp*idup+1:nprims_tmp*(idup+1))%center=b_tmp(1:nprims_tmp)%center+ncenter_tmp*idup - CO(:,nprims_tmp*idup+1:nprims_tmp*(idup+1))=CO_tmp(:,1:nprims_tmp) !Notice that the orbitals do not satisify normalization condition any more, and the orbital occupation number will be artifical + CO(nmo_tmp*idup+1:nmo_tmp*(idup+1),nprims_tmp*idup+1:nprims_tmp*(idup+1))=CO_tmp(:,1:nprims_tmp) !Here, only a sum of copied fragments are. iKS gives you real orbitals for that density + MOocc(nmo_tmp*idup+1:nmo_tmp*(idup+1))=MOocc_tmp(1:nmo_tmp) end do - deallocate(a_tmp,b_tmp,CO_tmp) + deallocate(a_tmp,b_tmp,CO_tmp,MOocc_tmp) imodwfn=1 call gendistmat !The number of atoms have changed, so we must update distance matrix -- 2.31.1