diff --git a/input/basis b/input/basis index 0a75001..6796e3b 100644 --- a/input/basis +++ b/input/basis @@ -1,7 +1,9 @@ -1 2 +1 3 S 3 - 1 38.4216340 0.0237660 - 2 5.7780300 0.1546790 - 3 1.2417740 0.4696300 + 1 38.3600000 0.0238090 + 2 5.7700000 0.1548910 + 3 1.2400000 0.4699870 S 1 - 1 0.2979640 1.0000000 + 1 0.2976000 1.0000000 +P 1 + 1 1.2750000 1.0000000 diff --git a/input/dft b/input/dft index 8cd4192..f3deb40 100644 --- a/input/dft +++ b/input/dft @@ -1,24 +1,24 @@ # Restricted or unrestricted KS calculation - LIM-RKS + eDFT-UKS # exchange rung: # Hartree = 0 # LDA = 1: RS51,RMFL20 # GGA = 2: RB88 # Hybrid = 4 # Hartree-Fock = 666 - 1 RCC + 1 S51 # correlation rung: # Hartree = 0 # LDA = 1: RVWN5,RMFL20 # GGA = 2: # Hybrid = 4: # Hartree-Fock = 666 - 1 RVWN5 + 0 H # quadrature grid SG-n 1 # Number of states in ensemble (nEns) 3 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.33333 0.33333 + 1.0 0.0 # GOK-DFT: maxSCF thresh DIIS n_diis guess_type ortho_type 32 0.00001 T 5 1 1 diff --git a/input/weight b/input/weight index 5dc5a6c..6796e3b 100644 --- a/input/weight +++ b/input/weight @@ -1,174 +1,9 @@ -1 14 -S 8 - 1 8236.0000000 0.0005310 - 2 1235.0000000 0.0041080 - 3 280.8000000 0.0210870 - 4 79.2700000 0.0818530 - 5 25.5900000 0.2348170 - 6 8.9970000 0.4344010 - 7 3.3190000 0.3461290 - 8 0.3643000 -0.0089830 -S 8 - 1 8236.0000000 -0.0001130 - 2 1235.0000000 -0.0008780 - 3 280.8000000 -0.0045400 - 4 79.2700000 -0.0181330 - 5 25.5900000 -0.0557600 - 6 8.9970000 -0.1268950 - 7 3.3190000 -0.1703520 - 8 0.3643000 0.5986840 -S 1 - 1 0.9059000 1.0000000 -S 1 - 1 0.1285000 1.0000000 -S 1 - 1 0.0440200 1.0000000 -P 3 - 1 18.7100000 0.0140310 - 2 4.1330000 0.0868660 - 3 1.2000000 0.2902160 -P 1 - 1 0.3827000 1.0000000 -P 1 - 1 0.1209000 1.0000000 -P 1 - 1 0.0356900 1.0000000 -D 1 - 1 1.0970000 1.0000000 -D 1 - 1 0.3180000 1.0000000 -D 1 - 1 0.1000000 1.0000000 -F 1 - 1 0.7610000 1.0000000 -F 1 - 1 0.2680000 1.0000000 -2 14 -S 8 - 1 8236.0000000 0.0005310 - 2 1235.0000000 0.0041080 - 3 280.8000000 0.0210870 - 4 79.2700000 0.0818530 - 5 25.5900000 0.2348170 - 6 8.9970000 0.4344010 - 7 3.3190000 0.3461290 - 8 0.3643000 -0.0089830 -S 8 - 1 8236.0000000 -0.0001130 - 2 1235.0000000 -0.0008780 - 3 280.8000000 -0.0045400 - 4 79.2700000 -0.0181330 - 5 25.5900000 -0.0557600 - 6 8.9970000 -0.1268950 - 7 3.3190000 -0.1703520 - 8 0.3643000 0.5986840 -S 1 - 1 0.9059000 1.0000000 -S 1 - 1 0.1285000 1.0000000 -S 1 - 1 0.0440200 1.0000000 -P 3 - 1 18.7100000 0.0140310 - 2 4.1330000 0.0868660 - 3 1.2000000 0.2902160 -P 1 - 1 0.3827000 1.0000000 -P 1 - 1 0.1209000 1.0000000 -P 1 - 1 0.0356900 1.0000000 -D 1 - 1 1.0970000 1.0000000 -D 1 - 1 0.3180000 1.0000000 -D 1 - 1 0.1000000 1.0000000 -F 1 - 1 0.7610000 1.0000000 -F 1 - 1 0.2680000 1.0000000 -3 9 +1 3 S 3 - 1 33.8700000 0.0060680 - 2 5.0950000 0.0453080 - 3 1.1590000 0.2028220 + 1 38.3600000 0.0238090 + 2 5.7700000 0.1548910 + 3 1.2400000 0.4699870 S 1 - 1 0.3258000 1.0000000 -S 1 - 1 0.1027000 1.0000000 -S 1 - 1 0.0252600 1.0000000 + 1 0.2976000 1.0000000 P 1 - 1 1.4070000 1.0000000 -P 1 - 1 0.3880000 1.0000000 -P 1 - 1 0.1020000 1.0000000 -D 1 - 1 1.0570000 1.0000000 -D 1 - 1 0.2470000 1.0000000 -4 9 -S 3 - 1 33.8700000 0.0060680 - 2 5.0950000 0.0453080 - 3 1.1590000 0.2028220 -S 1 - 1 0.3258000 1.0000000 -S 1 - 1 0.1027000 1.0000000 -S 1 - 1 0.0252600 1.0000000 -P 1 - 1 1.4070000 1.0000000 -P 1 - 1 0.3880000 1.0000000 -P 1 - 1 0.1020000 1.0000000 -D 1 - 1 1.0570000 1.0000000 -D 1 - 1 0.2470000 1.0000000 -5 9 -S 3 - 1 33.8700000 0.0060680 - 2 5.0950000 0.0453080 - 3 1.1590000 0.2028220 -S 1 - 1 0.3258000 1.0000000 -S 1 - 1 0.1027000 1.0000000 -S 1 - 1 0.0252600 1.0000000 -P 1 - 1 1.4070000 1.0000000 -P 1 - 1 0.3880000 1.0000000 -P 1 - 1 0.1020000 1.0000000 -D 1 - 1 1.0570000 1.0000000 -D 1 - 1 0.2470000 1.0000000 -6 9 -S 3 - 1 33.8700000 0.0060680 - 2 5.0950000 0.0453080 - 3 1.1590000 0.2028220 -S 1 - 1 0.3258000 1.0000000 -S 1 - 1 0.1027000 1.0000000 -S 1 - 1 0.0252600 1.0000000 -P 1 - 1 1.4070000 1.0000000 -P 1 - 1 0.3880000 1.0000000 -P 1 - 1 0.1020000 1.0000000 -D 1 - 1 1.0570000 1.0000000 -D 1 - 1 0.2470000 1.0000000 + 1 1.2750000 1.0000000 diff --git a/src/eDFT/eDFT.f90 b/src/eDFT/eDFT.f90 index f8240a5..48a0d7c 100644 --- a/src/eDFT/eDFT.f90 +++ b/src/eDFT/eDFT.f90 @@ -29,7 +29,7 @@ program eDFT double precision,allocatable :: ERI(:,:,:,:) double precision,allocatable :: c(:,:) - character(len=7) :: method + character(len=8) :: method integer :: x_rung,c_rung character(len=12) :: x_DFA ,c_DFA logical :: LDA_centered = .true. @@ -226,6 +226,23 @@ program eDFT end if +!------------------------------------------------------------------------ +! Compute N-centered UKS energy (UNBROKEN) +!------------------------------------------------------------------------ + + if(method == 'eDFT-UKS') then + + call cpu_time(start_KS) + call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),maxSCF,thresh,max_diis,guess_type, & + nBas,AO(:,:),dAO(:,:,:),nO(:),nV(:),S(:,:),T(:,:),V(:,:),Hc(:,:),ERI(:,:,:,:),X(:,:),ENuc,Ew) + call cpu_time(end_KS) + + t_KS = end_KS - start_KS + write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for UKS = ',t_KS,' seconds' + write(*,*) + + end if + !------------------------------------------------------------------------ ! End of eDFT !------------------------------------------------------------------------ diff --git a/src/eDFT/eDFT_UKS.f90 b/src/eDFT/eDFT_UKS.f90 new file mode 100644 index 0000000..8e89843 --- /dev/null +++ b/src/eDFT/eDFT_UKS.f90 @@ -0,0 +1,372 @@ +subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nGrid,weight,maxSCF,thresh,max_diis,guess_type, & + nBas,AO,dAO,nO,nV,S,T,V,Hc,ERI,X,ENuc,Ew) + +! Perform unrestricted Kohn-Sham calculation for ensembles + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: x_rung,c_rung + character(len=12),intent(in) :: x_DFA,c_DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: maxSCF,max_diis,guess_type + double precision,intent(in) :: thresh + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(ncart,nBas,nGrid) + + integer,intent(in) :: nO(nspin),nV(nspin) + double precision,intent(in) :: S(nBas,nBas) + double precision,intent(in) :: T(nBas,nBas) + double precision,intent(in) :: V(nBas,nBas) + double precision,intent(in) :: Hc(nBas,nBas) + double precision,intent(in) :: X(nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ENuc + +! Local variables + + integer :: xc_rung + logical :: LDA_centered = .false. + integer :: nSCF,nBasSq + integer :: n_diis + double precision :: conv + double precision :: rcond(nspin) + double precision :: ET(nspin) + double precision :: EV(nspin) + double precision :: EJ(nsp) + double precision :: Ex(nspin) + double precision :: Ec(nsp) + double precision :: Ew + + double precision,allocatable :: eps(:,:) + double precision,allocatable :: c(:,:,:) + double precision,allocatable :: cp(:,:,:) + double precision,allocatable :: J(:,:,:) + double precision,allocatable :: F(:,:,:) + double precision,allocatable :: Fp(:,:,:) + double precision,allocatable :: Fx(:,:,:) + double precision,allocatable :: FxHF(:,:,:) + double precision,allocatable :: Fc(:,:,:) + double precision,allocatable :: err(:,:,:) + double precision,allocatable :: err_diis(:,:,:) + double precision,allocatable :: F_diis(:,:,:) + double precision,external :: trace_matrix + double precision,external :: electron_number + + double precision,allocatable :: Pw(:,:,:) + double precision,allocatable :: rhow(:,:) + double precision,allocatable :: drhow(:,:,:) + double precision :: nEl(nspin) + + double precision,allocatable :: P(:,:,:,:) + double precision,allocatable :: rho(:,:,:) + double precision,allocatable :: drho(:,:,:,:) + + double precision :: E(nEns) + double precision :: Om(nEns) + + integer :: ispin,iEns + +! Hello world + + write(*,*) + write(*,*)'************************************************' + write(*,*)'* Unrestricted Kohn-Sham calculation *' + write(*,*)'* *** for ensembles *** *' + write(*,*)'************************************************' + write(*,*) + +! Useful stuff + + nBasSq = nBas*nBas + +!------------------------------------------------------------------------ +! Rung of Jacob's ladder +!------------------------------------------------------------------------ + +! Select rung for exchange + + write(*,*) + write(*,*) '*******************************************************************' + write(*,*) '* Exchange rung *' + write(*,*) '*******************************************************************' + + call select_rung(x_rung,x_DFA) + +! Select rung for correlation + + write(*,*) + write(*,*) '*******************************************************************' + write(*,*) '* Correlation rung *' + write(*,*) '*******************************************************************' + + call select_rung(c_rung,c_DFA) + +! Overall rung + + xc_rung = max(x_rung,c_rung) + +! Memory allocation + + allocate(eps(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin), & + J(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas,nspin), & + Fx(nBas,nBas,nspin),FxHF(nBas,nBas,nspin),Fc(nBas,nBas,nspin),err(nBas,nBas,nspin), & + Pw(nBas,nBas,nspin),rhow(nGrid,nspin),drhow(ncart,nGrid,nspin), & + err_diis(nBasSq,max_diis,nspin),F_diis(nBasSq,max_diis,nspin), & + P(nBas,nBas,nspin,nEns),rho(nGrid,nspin,nEns),drho(ncart,nGrid,nspin,nEns)) + +! Guess coefficients and eigenvalues + + + if(guess_type == 1) then + + do ispin=1,nspin + cp(:,:,ispin) = matmul(transpose(X(:,:)),matmul(Hc(:,:),X(:,:))) + call diagonalize_matrix(nBas,cp(:,:,ispin),eps(:,ispin)) + c(:,:,ispin) = matmul(X(:,:),cp(:,:,ispin)) + end do + + else if(guess_type == 2) then + + do ispin=1,nspin + call random_number(F(:,:,ispin)) + end do + + else + + print*,'Wrong guess option' + stop + + end if + +! Initialization + + nSCF = 0 + conv = 1d0 + + nEl(:) = 0d0 + Ex(:) = 0d0 + Ec(:) = 0d0 + + Fx(:,:,:) = 0d0 + FxHF(:,:,:) = 0d0 + Fc(:,:,:) = 0d0 + + n_diis = 0 + F_diis(:,:,:) = 0d0 + err_diis(:,:,:) = 0d0 + +!------------------------------------------------------------------------ +! Main SCF loop +!------------------------------------------------------------------------ + + write(*,*) + write(*,*)'------------------------------------------------------------------------------------------' + write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') & + '|','#','|','E(KS)','|','Ex(KS)','|','Ec(KS)','|','Conv','|','nEl','|' + write(*,*)'------------------------------------------------------------------------------------------' + + do while(conv > thresh .and. nSCF < maxSCF) + +! Increment + + nSCF = nSCF + 1 + +!------------------------------------------------------------------------ +! Compute density matrix +!------------------------------------------------------------------------ + + call unrestricted_density_matrix(nBas,nEns,nO(:),c(:,:,:),P(:,:,:,:)) + +! Weight-dependent density matrix + + Pw(:,:,:) = 0d0 + do iEns=1,nEns + Pw(:,:,:) = Pw(:,:,:) + wEns(iEns)*P(:,:,:,iEns) + end do + +!------------------------------------------------------------------------ +! Compute one-electron density and its gradient if necessary +!------------------------------------------------------------------------ + + do ispin=1,nspin + do iEns=1,nEns + call density(nGrid,nBas,P(:,:,ispin,iEns),AO(:,:),rho(:,ispin,iEns)) + end do + end do + +! Weight-dependent one-electron density + + rhow(:,:) = 0d0 + do iEns=1,nEns + rhow(:,:) = rhow(:,:) + wEns(iEns)*rho(:,:,iEns) + end do + + if(xc_rung > 1 .and. xc_rung /= 666) then + +! Ground state density + + do ispin=1,nspin + do iEns=1,nEns + call gradient_density(nGrid,nBas,P(:,:,ispin,iEns),AO(:,:),dAO(:,:,:),drho(:,:,ispin,iEns)) + end do + end do + +! Weight-dependent one-electron density + + drhow(:,:,:) = 0d0 + do iEns=1,nEns + drhow(:,:,:) = drhow(:,:,:) + wEns(iEns)*drho(:,:,:,iEns) + end do + + end if + +! Build Coulomb repulsion + + do ispin=1,nspin + call hartree_coulomb(nBas,Pw(:,:,ispin),ERI(:,:,:,:),J(:,:,ispin)) + end do + +! Compute exchange potential + + do ispin=1,nspin + call exchange_potential(x_rung,x_DFA,LDA_centered,nEns,wEns(:),nGrid,weight(:),nBas,Pw(:,:,ispin),ERI(:,:,:,:), & + AO(:,:),dAO(:,:,:),rhow(:,ispin),drhow(:,:,ispin),Fx(:,:,ispin),FxHF(:,:,ispin)) + end do + +! Compute correlation potential + + call correlation_potential(c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),nBas,AO(:,:),dAO(:,:,:),rhow(:,:),drhow(:,:,:),Fc(:,:,:)) + +! Build Fock operator + do ispin=1,nspin + F(:,:,ispin) = Hc(:,:) + J(:,:,ispin) + J(:,:,mod(ispin,2)+1) + Fx(:,:,ispin) + Fc(:,:,ispin) + end do + +! Check convergence + + do ispin=1,nspin + err(:,:,ispin) = matmul(F(:,:,ispin),matmul(Pw(:,:,ispin),S(:,:))) - matmul(matmul(S(:,:),Pw(:,:,ispin)),F(:,:,ispin)) + end do + + conv = maxval(abs(err(:,:,:))) + +! DIIS extrapolation + + n_diis = min(n_diis+1,max_diis) + do ispin=1,nspin + call DIIS_extrapolation(rcond(ispin),nBasSq,nBasSq,n_diis, & + err_diis(:,:,ispin),F_diis(:,:,ispin),err(:,:,ispin),F(:,:,ispin)) + end do + +! Reset DIIS if required + + if(minval(rcond(:)) < 1d-15) n_diis = 0 + +! Transform Fock matrix in orthogonal basis + + do ispin=1,nspin + Fp(:,:,ispin) = matmul(transpose(X(:,:)),matmul(F(:,:,ispin),X(:,:))) + end do + +! Diagonalize Fock matrix to get eigenvectors and eigenvalues + + cp(:,:,:) = Fp(:,:,:) + do ispin=1,nspin + call diagonalize_matrix(nBas,cp(:,:,ispin),eps(:,ispin)) + end do + +! Back-transform eigenvectors in non-orthogonal basis + + do ispin=1,nspin + c(:,:,ispin) = matmul(X(:,:),cp(:,:,ispin)) + end do + +!------------------------------------------------------------------------ +! Compute KS energy +!------------------------------------------------------------------------ + +! Kinetic energy + + do ispin=1,nspin + ET(ispin) = trace_matrix(nBas,matmul(Pw(:,:,ispin),T(:,:))) + end do + +! Potential energy + + do ispin=1,nspin + EV(ispin) = trace_matrix(nBas,matmul(Pw(:,:,ispin),V(:,:))) + end do + +! Coulomb energy + + EJ(1) = 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,1))) + EJ(2) = trace_matrix(nBas,matmul(Pw(:,:,1),J(:,:,2))) + EJ(3) = 0.5d0*trace_matrix(nBas,matmul(Pw(:,:,2),J(:,:,2))) + +! Exchange energy + + do ispin=1,nspin + call exchange_energy(x_rung,x_DFA,LDA_centered,nEns,wEns(:),nGrid,weight(:),nBas, & + Pw(:,:,ispin),FxHF(:,:,ispin),rhow(:,ispin),drhow(:,:,ispin),Ex(ispin)) + end do + +! Correlation energy + + call correlation_energy(c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),rhow(:,:),drhow(:,:,:),Ec) + +! Total energy + + Ew = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:)) + +! Check the grid accuracy by computing the number of electrons + + do ispin=1,nspin + nEl(ispin) = electron_number(nGrid,weight(:),rhow(:,ispin)) + end do + +! Dump results + + write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') & + '|',nSCF,'|',Ew + ENuc,'|',sum(Ex(:)),'|',sum(Ec(:)),'|',conv,'|',sum(nEl(:)),'|' + + end do + write(*,*)'------------------------------------------------------------------------------------------' +!------------------------------------------------------------------------ +! End of SCF loop +!------------------------------------------------------------------------ + +! Did it actually converge? + + if(nSCF == maxSCF) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + + stop + + end if + +! Compute final KS energy + + call print_UKS(nBas,nO(:),eps(:,:),c(:,:,:),ENuc,ET(:),EV(:),EJ(:),Ex(:),Ec(:),Ew) + +!------------------------------------------------------------------------ +! Compute individual energies from ensemble energy +!------------------------------------------------------------------------ + +! call individual_energy(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),nBas, & +! AO(:,:),dAO(:,:,:),nO(:),nV(:),T(:,:),V(:,:),ERI(:,:,:,:),ENuc, & +! Pw(:,:,:),rhow(:,:),drhow(:,:,:),J(:,:,:),Fx(:,:,:),FxHF(:,:,:), & +! Fc(:,:,:),P(:,:,:,:),rho(:,:,:),drho(:,:,:,:),E(:),Om(:)) + +end subroutine eDFT_UKS diff --git a/src/eDFT/read_options.f90 b/src/eDFT/read_options.f90 index 080485e..bbe35e8 100644 --- a/src/eDFT/read_options.f90 +++ b/src/eDFT/read_options.f90 @@ -12,7 +12,7 @@ subroutine read_options(method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,th ! Output variables - character(len=7),intent(out) :: method + character(len=8),intent(out) :: method integer,intent(out) :: x_rung,c_rung character(len=12),intent(out) :: x_DFA, c_DFA integer,intent(out) :: SGn diff --git a/src/eDFT/unrestricted_density_matrix.f90 b/src/eDFT/unrestricted_density_matrix.f90 index 0978142..922b06d 100644 --- a/src/eDFT/unrestricted_density_matrix.f90 +++ b/src/eDFT/unrestricted_density_matrix.f90 @@ -22,26 +22,23 @@ subroutine unrestricted_density_matrix(nBas,nEns,nO,c,P) double precision,intent(out) :: P(nBas,nBas,nspin,nEns) -! Ground state density matrix +! N-electron ground state iEns = 1 do ispin=1,nspin P(:,:,ispin,iEns) = matmul(c(:,1:nO(ispin),ispin),transpose(c(:,1:nO(ispin),ispin))) end do -! Singly-excited state density matrix +! (N-1)-electron state: remove spin-down electrons iEns = 2 - P(:,:,1,iEns) = matmul(c(:,1:nO(1)-1,1),transpose(c(:,1:nO(1)-1,1))) & - + matmul(c(:,nO(1)+1:nO(1)+1,1),transpose(c(:,nO(1)+1:nO(1)+1,1))) - P(:,:,2,iEns) = matmul(c(:,1:nO(2),2),transpose(c(:,1:nO(2),2))) + P(:,:,1,iEns) = matmul(c(:,1:nO(1) ,1),transpose(c(:,1:nO(1) ,1))) + P(:,:,2,iEns) = matmul(c(:,1:nO(2)-1,2),transpose(c(:,1:nO(2)-1,2))) -! Doubly-excited state density matrix +! (N+1)-electron state: remove spin-up electrons iEns = 3 - do ispin=1,nspin - P(:,:,ispin,iEns) = matmul(c(:,1:nO(ispin)-1,ispin),transpose(c(:,1:nO(ispin)-1,ispin))) & - + matmul(c(:,nO(ispin)+1:nO(ispin)+1,ispin),transpose(c(:,nO(ispin)+1:nO(ispin)+1,ispin))) - end do + P(:,:,1,iEns) = matmul(c(:,1:nO(1)+1,1),transpose(c(:,1:nO(1)+1,1))) + P(:,:,2,iEns) = matmul(c(:,1:nO(2) ,2),transpose(c(:,1:nO(2) ,2))) end subroutine unrestricted_density_matrix