From f4329480bac423005eb54089f413d434fcf9a0b9 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Wed, 13 Mar 2019 11:07:31 +0100 Subject: [PATCH] merging quack with eDFT --- input/geminal | 1 - src/IntPak/ReadGeminal.f90 | 25 - src/IntPak/ReadGeometry.f90 | 40 - src/IntPak/read_geometry.f90 | 68 + src/xcDFT/.DS_Store | Bin 0 -> 6148 bytes src/xcDFT/AO_values_grid.f90 | 101 + src/xcDFT/B88_gga_exchange_energy.f90 | 53 + src/xcDFT/B88_gga_exchange_potential.f90 | 68 + src/xcDFT/C16_lda_correlation_energy.f90 | 93 + src/xcDFT/C16_lda_correlation_potential.f90 | 131 + src/xcDFT/DIIS_extrapolation.f90 | 54 + src/xcDFT/G96_gga_exchange_energy.f90 | 52 + src/xcDFT/G96_gga_exchange_potential.f90 | 69 + src/xcDFT/Kohn_Sham.f90 | 362 ++ ...19_lda_correlation_Levy_Zahariev_shift.f90 | 82 + ...a_correlation_derivative_discontinuity.f90 | 63 + src/xcDFT/LF19_lda_correlation_energy.f90 | 84 + ...LF19_lda_correlation_individual_energy.f90 | 81 + src/xcDFT/LF19_lda_correlation_potential.f90 | 82 + src/xcDFT/Makefile | 35 + src/xcDFT/S51_lda_exchange_energy.f90 | 42 + src/xcDFT/S51_lda_exchange_potential.f90 | 50 + ...N5_lda_correlation_Levy_Zahariev_shift.f90 | 199 ++ src/xcDFT/VWN5_lda_correlation_energy.f90 | 137 + ...VWN5_lda_correlation_individual_energy.f90 | 204 ++ src/xcDFT/VWN5_lda_correlation_potential.f90 | 202 ++ ...38_lda_correlation_Levy_Zahariev_shift.f90 | 56 + src/xcDFT/W38_lda_correlation_energy.f90 | 52 + .../W38_lda_correlation_individual_energy.f90 | 62 + src/xcDFT/W38_lda_correlation_potential.f90 | 76 + src/xcDFT/correlation_Levy_Zahariev_shift.f90 | 69 + .../correlation_derivative_discontinuity.f90 | 65 + src/xcDFT/correlation_energy.f90 | 68 + src/xcDFT/correlation_individual_energy.f90 | 69 + src/xcDFT/correlation_potential.f90 | 75 + src/xcDFT/density.f90 | 38 + src/xcDFT/density_matrix.f90 | 43 + src/xcDFT/dft_grid.f | 3017 +++++++++++++++++ src/xcDFT/eDFT.f90 | 133 + .../elda_correlation_Levy_Zahariev_shift.f90 | 62 + src/xcDFT/elda_correlation_energy.f90 | 70 + .../elda_correlation_individual_energy.f90 | 58 + src/xcDFT/elda_correlation_potential.f90 | 71 + src/xcDFT/electron_number.f90 | 20 + src/xcDFT/elements.f90 | 170 + src/xcDFT/exchange_energy.f90 | 80 + src/xcDFT/exchange_potential.f90 | 81 + src/xcDFT/fock_exchange_energy.f90 | 25 + src/xcDFT/fock_exchange_potential.f90 | 34 + src/xcDFT/generate_shell.f90 | 32 + src/xcDFT/gga_correlation_energy.f90 | 42 + src/xcDFT/gga_correlation_potential.f90 | 31 + src/xcDFT/gga_exchange_energy.f90 | 44 + src/xcDFT/gga_exchange_potential.f90 | 48 + src/xcDFT/gradient_density.f90 | 45 + src/xcDFT/hartree_coulomb.f90 | 33 + src/xcDFT/individual_energy.f90 | 156 + .../lda_correlation_Levy_Zahariev_shift.f90 | 51 + ...a_correlation_derivative_discontinuity.f90 | 54 + src/xcDFT/lda_correlation_energy.f90 | 60 + .../lda_correlation_individual_energy.f90 | 51 + src/xcDFT/lda_correlation_potential.f90 | 64 + src/xcDFT/lda_exchange_energy.f90 | 38 + src/xcDFT/lda_exchange_potential.f90 | 41 + src/xcDFT/one_electron_density.f90 | 47 + src/xcDFT/orthogonalization_matrix.f90 | 63 + src/xcDFT/print_KS.f90 | 102 + src/xcDFT/print_individual_energy.f90 | 105 + src/xcDFT/quadrature_grid.f90 | 77 + src/xcDFT/read_basis.f90 | 119 + src/xcDFT/read_geometry.f90 | 68 + src/xcDFT/read_grid.f90 | 47 + src/xcDFT/read_integrals.f90 | 114 + src/xcDFT/read_molecule.f90 | 52 + src/xcDFT/read_options.f90 | 106 + src/xcDFT/select_rung.f90 | 53 + src/xcDFT/utils.f90 | 400 +++ src/xcDFT/wrap_lapack.f90 | 207 ++ 78 files changed, 9156 insertions(+), 66 deletions(-) delete mode 100644 input/geminal delete mode 100644 src/IntPak/ReadGeminal.f90 delete mode 100644 src/IntPak/ReadGeometry.f90 create mode 100644 src/IntPak/read_geometry.f90 create mode 100644 src/xcDFT/.DS_Store create mode 100644 src/xcDFT/AO_values_grid.f90 create mode 100644 src/xcDFT/B88_gga_exchange_energy.f90 create mode 100644 src/xcDFT/B88_gga_exchange_potential.f90 create mode 100644 src/xcDFT/C16_lda_correlation_energy.f90 create mode 100644 src/xcDFT/C16_lda_correlation_potential.f90 create mode 100644 src/xcDFT/DIIS_extrapolation.f90 create mode 100644 src/xcDFT/G96_gga_exchange_energy.f90 create mode 100644 src/xcDFT/G96_gga_exchange_potential.f90 create mode 100644 src/xcDFT/Kohn_Sham.f90 create mode 100644 src/xcDFT/LF19_lda_correlation_Levy_Zahariev_shift.f90 create mode 100644 src/xcDFT/LF19_lda_correlation_derivative_discontinuity.f90 create mode 100644 src/xcDFT/LF19_lda_correlation_energy.f90 create mode 100644 src/xcDFT/LF19_lda_correlation_individual_energy.f90 create mode 100644 src/xcDFT/LF19_lda_correlation_potential.f90 create mode 100644 src/xcDFT/Makefile create mode 100644 src/xcDFT/S51_lda_exchange_energy.f90 create mode 100644 src/xcDFT/S51_lda_exchange_potential.f90 create mode 100644 src/xcDFT/VWN5_lda_correlation_Levy_Zahariev_shift.f90 create mode 100644 src/xcDFT/VWN5_lda_correlation_energy.f90 create mode 100644 src/xcDFT/VWN5_lda_correlation_individual_energy.f90 create mode 100644 src/xcDFT/VWN5_lda_correlation_potential.f90 create mode 100644 src/xcDFT/W38_lda_correlation_Levy_Zahariev_shift.f90 create mode 100644 src/xcDFT/W38_lda_correlation_energy.f90 create mode 100644 src/xcDFT/W38_lda_correlation_individual_energy.f90 create mode 100644 src/xcDFT/W38_lda_correlation_potential.f90 create mode 100644 src/xcDFT/correlation_Levy_Zahariev_shift.f90 create mode 100644 src/xcDFT/correlation_derivative_discontinuity.f90 create mode 100644 src/xcDFT/correlation_energy.f90 create mode 100644 src/xcDFT/correlation_individual_energy.f90 create mode 100644 src/xcDFT/correlation_potential.f90 create mode 100644 src/xcDFT/density.f90 create mode 100644 src/xcDFT/density_matrix.f90 create mode 100644 src/xcDFT/dft_grid.f create mode 100644 src/xcDFT/eDFT.f90 create mode 100644 src/xcDFT/elda_correlation_Levy_Zahariev_shift.f90 create mode 100644 src/xcDFT/elda_correlation_energy.f90 create mode 100644 src/xcDFT/elda_correlation_individual_energy.f90 create mode 100644 src/xcDFT/elda_correlation_potential.f90 create mode 100644 src/xcDFT/electron_number.f90 create mode 100644 src/xcDFT/elements.f90 create mode 100644 src/xcDFT/exchange_energy.f90 create mode 100644 src/xcDFT/exchange_potential.f90 create mode 100644 src/xcDFT/fock_exchange_energy.f90 create mode 100644 src/xcDFT/fock_exchange_potential.f90 create mode 100644 src/xcDFT/generate_shell.f90 create mode 100644 src/xcDFT/gga_correlation_energy.f90 create mode 100644 src/xcDFT/gga_correlation_potential.f90 create mode 100644 src/xcDFT/gga_exchange_energy.f90 create mode 100644 src/xcDFT/gga_exchange_potential.f90 create mode 100644 src/xcDFT/gradient_density.f90 create mode 100644 src/xcDFT/hartree_coulomb.f90 create mode 100644 src/xcDFT/individual_energy.f90 create mode 100644 src/xcDFT/lda_correlation_Levy_Zahariev_shift.f90 create mode 100644 src/xcDFT/lda_correlation_derivative_discontinuity.f90 create mode 100644 src/xcDFT/lda_correlation_energy.f90 create mode 100644 src/xcDFT/lda_correlation_individual_energy.f90 create mode 100644 src/xcDFT/lda_correlation_potential.f90 create mode 100644 src/xcDFT/lda_exchange_energy.f90 create mode 100644 src/xcDFT/lda_exchange_potential.f90 create mode 100644 src/xcDFT/one_electron_density.f90 create mode 100644 src/xcDFT/orthogonalization_matrix.f90 create mode 100644 src/xcDFT/print_KS.f90 create mode 100644 src/xcDFT/print_individual_energy.f90 create mode 100644 src/xcDFT/quadrature_grid.f90 create mode 100644 src/xcDFT/read_basis.f90 create mode 100644 src/xcDFT/read_geometry.f90 create mode 100644 src/xcDFT/read_grid.f90 create mode 100644 src/xcDFT/read_integrals.f90 create mode 100644 src/xcDFT/read_molecule.f90 create mode 100644 src/xcDFT/read_options.f90 create mode 100644 src/xcDFT/select_rung.f90 create mode 100644 src/xcDFT/utils.f90 create mode 100644 src/xcDFT/wrap_lapack.f90 diff --git a/input/geminal b/input/geminal deleted file mode 100644 index d3827e7..0000000 --- a/input/geminal +++ /dev/null @@ -1 +0,0 @@ -1.0 diff --git a/src/IntPak/ReadGeminal.f90 b/src/IntPak/ReadGeminal.f90 deleted file mode 100644 index fcd2c70..0000000 --- a/src/IntPak/ReadGeminal.f90 +++ /dev/null @@ -1,25 +0,0 @@ -subroutine ReadGeminal(ExpS) - -! Read the geminal information - - implicit none - -! Input variables - double precision,intent(out) :: ExpS - -! Open file with geometry specification - open(unit=4,file='input/geminal') - -! Read exponent of Slater geminal - read(4,*) ExpS - - - write(*,'(A28)') '------------------' - write(*,'(A28,1X,F16.10)') 'Slater geminal exponent',ExpS - write(*,'(A28)') '------------------' - write(*,*) - -! Close file with geminal information - close(unit=4) - -end subroutine ReadGeminal diff --git a/src/IntPak/ReadGeometry.f90 b/src/IntPak/ReadGeometry.f90 deleted file mode 100644 index 8f51671..0000000 --- a/src/IntPak/ReadGeometry.f90 +++ /dev/null @@ -1,40 +0,0 @@ -subroutine ReadGeometry(NAtoms,ZNuc,XYZAtoms) - -! Read molecular geometry - - implicit none - -! Input variables - integer,intent(in) :: NAtoms - double precision,intent(out) :: ZNuc(NAtoms),XYZAtoms(NAtoms,3) - -! Local variables - integer :: i - -! Open file with geometry specification - open(unit=1,file='input/molecule') - -! Read number of atoms - read(1,*) - read(1,*) - read(1,*) - - do i=1,NAtoms - read(1,*) ZNuc(i),XYZAtoms(i,1),XYZAtoms(i,2),XYZAtoms(i,3) - enddo - -! Print geometry - write(*,'(A28)') 'Molecular geometry' - write(*,'(A28)') '------------------' - do i=1,NAtoms - write(*,'(A28,1X,I16)') 'Atom n. ',i - write(*,'(A28,1X,F16.10)') 'Z = ',ZNuc(i) - write(*,'(A28,1X,F16.10,F16.10,F16.10)') 'Atom coordinates:',XYZAtoms(i,1),XYZAtoms(i,2),XYZAtoms(i,3) - enddo - write(*,'(A28)') '------------------' - write(*,*) - -! Close file with geometry specification - close(unit=1) - -end subroutine ReadGeometry diff --git a/src/IntPak/read_geometry.f90 b/src/IntPak/read_geometry.f90 new file mode 100644 index 0000000..60c60b8 --- /dev/null +++ b/src/IntPak/read_geometry.f90 @@ -0,0 +1,68 @@ +subroutine read_geometry(nAt,ZNuc,rA,ENuc) + +! Read molecular geometry + + implicit none + + include 'parameters.h' + +! Ouput variables + + integer,intent(in) :: nAt + +! Local variables + + integer :: i,j + double precision :: RAB + character(len=2) :: El + integer,external :: element_number + +! Ouput variables + + double precision,intent(out) :: ZNuc(NAt),rA(nAt,ncart),ENuc + +! Open file with geometry specification + + open(unit=1,file='input/molecule') + +! Read geometry + + read(1,*) + read(1,*) + read(1,*) + + do i=1,nAt + read(1,*) El,rA(i,1),rA(i,2),rA(i,3) + ZNuc(i) = element_number(El) + enddo + +! Compute nuclear repulsion energy + + ENuc = 0 + + do i=1,nAt-1 + do j=i+1,nAt + RAB = (rA(i,1)-rA(j,1))**2 + (rA(i,2)-rA(j,2))**2 + (rA(i,3)-rA(j,3))**2 + ENuc = ENuc + ZNuc(i)*ZNuc(j)/sqrt(RAB) + enddo + enddo + +! Close file with geometry specification + close(unit=1) + +! Print geometry + write(*,'(A28)') '------------------' + write(*,'(A28)') 'Molecular geometry' + write(*,'(A28)') '------------------' + do i=1,NAt + write(*,'(A28,1X,I16)') 'Atom n. ',i + write(*,'(A28,1X,F16.10)') 'Z = ',ZNuc(i) + write(*,'(A28,1X,F16.10,F16.10,F16.10)') 'Atom coordinates:',(rA(i,j),j=1,ncart) + enddo + write(*,*) + write(*,'(A28)') '------------------' + write(*,'(A28,1X,F16.10)') 'Nuclear repulsion energy = ',ENuc + write(*,'(A28)') '------------------' + write(*,*) + +end subroutine read_geometry diff --git a/src/xcDFT/.DS_Store b/src/xcDFT/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..5008ddfcf53c02e82d7eee2e57c38e5672ef89f6 GIT binary patch literal 6148 zcmeH~Jr2S!425mzP>H1@V-^m;4Wg<&0T*E43hX&L&p$$qDprKhvt+--jT7}7np#A3 zem<@ulZcFPQ@L2!n>{z**++&mCkOWA81W14cNZlEfg7;MkzE(HCqgga^y>{tEnwC%0;vJ&^%eQ zLs35+`xjp>T0 0) dAO(1,iBas,iG) = dAO(1,iBas,iG) + dble(a(1))*xA**(a(1)-1)*yA**a(2)*zA**a(3)*AO(iBas,iG) + + dAO(2,iBas,iG) = xA**a(1)*yA**(a(2)+1)*zA**a(3)*dAO(2,iBas,iG) + if(a(2) > 0) dAO(2,iBas,iG) = dAO(2,iBas,iG) + dble(a(2))*xA**a(1)*yA**(a(2)-1)*zA**a(3)*AO(iBas,iG) + + dAO(3,iBas,iG) = xA**a(1)*yA**a(2)*zA**(a(3)+1)*dAO(3,iBas,iG) + if(a(3) > 0) dAO(3,iBas,iG) = dAO(3,iBas,iG) + dble(a(3))*xA**a(1)*yA**a(2)*zA**(a(3)-1)*AO(iBas,iG) + +! Calculate polynmial part + + AO(iBas,iG) = xA**a(1)*yA**a(2)*zA**a(3)*AO(iBas,iG) + + enddo + + enddo + deallocate(ShellFunction) + enddo +!------------------------------------------------------------------------ +! End loops over shells +!------------------------------------------------------------------------ + +end subroutine AO_values_grid diff --git a/src/xcDFT/B88_gga_exchange_energy.f90 b/src/xcDFT/B88_gga_exchange_energy.f90 new file mode 100644 index 0000000..439c220 --- /dev/null +++ b/src/xcDFT/B88_gga_exchange_energy.f90 @@ -0,0 +1,53 @@ +subroutine B88_gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) + +! Compute Becke's 96 GGA exchange energy + + implicit none + + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Local variables + + integer :: iG + double precision :: alpha,beta,gamma + double precision :: r,g,x + +! Output variables + + double precision :: Ex + +! Coefficients for B88 GGA exchange functional + + alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) + beta = 0.0042d0 + +! Compute GGA exchange energy + + Ex = 0d0 + + do iG=1,nGrid + + r = max(0d0,rho(iG)) + + if(r > threshold) then + g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 + x = sqrt(g)/r**(4d0/3d0) + + Ex = Ex + weight(iG)*alpha*r**(4d0/3d0) & + - weight(iG)*beta*x**2*r**(4d0/3d0)/(1d0 + 6d0*beta*x*asinh(x)) + + end if + + end do + +end subroutine B88_gga_exchange_energy diff --git a/src/xcDFT/B88_gga_exchange_potential.f90 b/src/xcDFT/B88_gga_exchange_potential.f90 new file mode 100644 index 0000000..e39e865 --- /dev/null +++ b/src/xcDFT/B88_gga_exchange_potential.f90 @@ -0,0 +1,68 @@ +subroutine B88_gga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + +! Compute Becke's GGA exchange potential + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(3,nBas,nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Local variables + + integer :: mu,nu,iG + double precision :: alpha,beta + double precision :: r,g,vAO,gAO + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas) + +! Coefficients for B88 GGA exchange functional + + alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) + beta = 0.0042d0 + +! Compute GGA exchange matrix in the AO basis + + Fx(:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + r = max(0d0,rho(iG)) + + if(r > threshold) then + + g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 + vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) + Fx(mu,nu) = Fx(mu,nu) & + + vAO*(4d0/3d0*r**(1d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) & + + 2d0*beta*g**(3d0/4d0)/r**(5d0/3d0)) + + gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) + + gAO = weight(iG)*gAO + + Fx(mu,nu) = Fx(mu,nu) - 2d0*gAO*3d0/4d0*beta*g**(-1d0/4d0)/r**(2d0/3d0) + + end if + + end do + end do + end do + +end subroutine B88_gga_exchange_potential diff --git a/src/xcDFT/C16_lda_correlation_energy.f90 b/src/xcDFT/C16_lda_correlation_energy.f90 new file mode 100644 index 0000000..1ea0d89 --- /dev/null +++ b/src/xcDFT/C16_lda_correlation_energy.f90 @@ -0,0 +1,93 @@ +subroutine C16_lda_correlation_energy(nGrid,weight,rho,Ec) + +! Compute Chachiyo's LDA correlation energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,rs + double precision :: a_p,b_p,ec_p + double precision :: a_f,b_f,ec_f + double precision :: z,fz,ec_z + +! Output variables + + double precision :: Ec(nsp) + +! Coefficients for Chachiyo's LDA correlation + + a_p = (log(2d0) - 1d0)/(2d0*pi**2) + b_p = 20.4562557d0 + + a_f = (log(2d0) - 1d0)/(4d0*pi**2) + b_f = 27.4203609d0 + +! Compute LDA correlation energy + + Ec(:) = 0d0 + + do iG=1,nGrid + +! Spin-up and spin-down densities + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! Total density + + r = ra + rb + +! Spin-up part contribution + + if(ra > threshold) then + + rs = (4d0*pi*ra/3d0)**(-1d0/3d0) + ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) + + Ec(1) = Ec(1) + weight(iG)*ec_f*ra + + endif + +! Opposite-spin contribution + + if(r > threshold) then + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + ec_p = a_p*log(1d0 + b_p/rs + b_p/rs**2) + ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) + + z = (ra-rb)/r + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + ec_z = ec_p + (ec_f - ec_p)*fz + + Ec(2) = Ec(2) + weight(iG)*ec_z*r + + endif + +! Spin-down contribution + + if(rb > threshold) then + + rs = (4d0*pi*rb/3d0)**(-1d0/3d0) + ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) + + Ec(3) = Ec(3) + weight(iG)*ec_f*rb + + endif + + enddo + + Ec(2) = Ec(2) - Ec(1) - Ec(3) + +end subroutine C16_lda_correlation_energy diff --git a/src/xcDFT/C16_lda_correlation_potential.f90 b/src/xcDFT/C16_lda_correlation_potential.f90 new file mode 100644 index 0000000..60d2c8d --- /dev/null +++ b/src/xcDFT/C16_lda_correlation_potential.f90 @@ -0,0 +1,131 @@ +subroutine C16_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) + +! Compute LDA correlation potential + + implicit none +include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: mu,nu,iG + double precision :: ra,rb,r,rs + double precision :: a_p,b_p,ec_p,decdrs_p,decdra_p,decdrb_p + double precision :: a_f,b_f,ec_f,decdrs_f,decdra_f,decdrb_f + double precision :: ec_z,decdra_z,decdrb_z + double precision :: z,dzdra,dzdrb,fz,dfzdz,dfzdra,dfzdrb + double precision :: drsdra,drsdrb,dFcdra,dFcdrb + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Coefficients for Chachiyo's LDA correlation + + a_p = (log(2d0) - 1d0)/(2d0*pi**2) + b_p = 20.4562557d0 + + a_f = (log(2d0) - 1d0)/(4d0*pi**2) + b_f = 27.4203609d0 + +! Compute LDA correlation matrix in the AO basis + + Fc(:,:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + +! Spin-up and spin-down densities + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! Total density + + r = ra + rb + +! Spin-up part contribution + + if(ra > threshold) then + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + + ec_p = a_p*log(1d0 + b_p/rs + b_p/rs**2) + ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) + + z = (ra-rb)/r + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + ec_z = ec_p + (ec_f - ec_p)*fz + + dzdra = (1d0 - z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdra = dzdra*dfzdz + + drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + + decdrs_p = - a_p/rs**2*(b_p + 2d0*b_p/rs)/(1d0 + b_p/rs + b_p/rs**2) + decdrs_f = - a_f/rs**2*(b_f + 2d0*b_f/rs)/(1d0 + b_f/rs + b_f/rs**2) + + decdra_p = drsdra*decdrs_p + decdra_f = drsdra*decdrs_f + + decdra_z = decdra_p + (decdra_f - decdra_p)*fz + (ec_f - ec_p)*dfzdra + + dFcdra = decdra_z*r + ec_z + + Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdra + + endif + +! Spin-down part contribution + + if(rb > threshold) then + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + + ec_p = a_p*log(1d0 + b_p/rs + b_p/rs**2) + ec_f = a_f*log(1d0 + b_f/rs + b_f/rs**2) + + z = (ra-rb)/r + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + ec_z = ec_p + (ec_f - ec_p)*fz + + dzdrb = - (1d0 + z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdrb = dzdrb*dfzdz + + drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + + decdrs_p = - a_p/rs**2*(b_p + 2d0*b_p/rs)/(1d0 + b_p/rs + b_p/rs**2) + decdrs_f = - a_f/rs**2*(b_f + 2d0*b_f/rs)/(1d0 + b_f/rs + b_f/rs**2) + + decdrb_p = drsdrb*decdrs_p + decdrb_f = drsdrb*decdrs_f + + decdrb_z = decdrb_p + (decdrb_f - decdrb_p)*fz + (ec_f - ec_p)*dfzdrb + + dFcdrb = decdrb_z*r + ec_z + + Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdrb + + endif + + enddo + enddo + enddo + +end subroutine C16_lda_correlation_potential diff --git a/src/xcDFT/DIIS_extrapolation.f90 b/src/xcDFT/DIIS_extrapolation.f90 new file mode 100644 index 0000000..e53db06 --- /dev/null +++ b/src/xcDFT/DIIS_extrapolation.f90 @@ -0,0 +1,54 @@ +subroutine DIIS_extrapolation(rcond,n_err,n_e,n_diis,error,e,error_in,e_inout) + +! Perform DIIS extrapolation + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: n_err,n_e + double precision,intent(in) :: error_in(n_err),error(n_err,n_diis),e(n_e,n_diis) + +! Local variables + + double precision,allocatable :: A(:,:),b(:),w(:) + +! Output variables + + double precision,intent(out) :: rcond + integer,intent(inout) :: n_diis + double precision,intent(inout):: e_inout(n_e) + +! Memory allocaiton + + allocate(A(n_diis+1,n_diis+1),b(n_diis+1),w(n_diis+1)) + +! Update DIIS "history" + + call prepend(n_err,n_diis,error,error_in) + call prepend(n_e,n_diis,e,e_inout) + +! Build A matrix + + A(1:n_diis,1:n_diis) = matmul(transpose(error),error) + + A(1:n_diis,n_diis+1) = -1d0 + A(n_diis+1,1:n_diis) = -1d0 + A(n_diis+1,n_diis+1) = +0d0 + +! Build x matrix + + b(1:n_diis) = +0d0 + b(n_diis+1) = -1d0 + +! Solve linear system + + call linear_solve(n_diis+1,A,b,w,rcond) + +! Extrapolate + + e_inout(:) = matmul(w(1:n_diis),transpose(e(:,1:n_diis))) + +end subroutine DIIS_extrapolation diff --git a/src/xcDFT/G96_gga_exchange_energy.f90 b/src/xcDFT/G96_gga_exchange_energy.f90 new file mode 100644 index 0000000..b9cb6c4 --- /dev/null +++ b/src/xcDFT/G96_gga_exchange_energy.f90 @@ -0,0 +1,52 @@ +subroutine G96_gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) + +! Compute Gill's 96 GGA exchange energy + + implicit none + + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Local variables + + integer :: iG + double precision :: alpha,beta + double precision :: r,g + +! Output variables + + double precision :: Ex + +! Coefficients for G96 GGA exchange functional + + alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) + beta = 1d0/137d0 + +! Compute GGA exchange energy + + Ex = 0d0 + + do iG=1,nGrid + + r = max(0d0,rho(iG)) + + if(r > threshold) then + + g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 + + Ex = Ex + weight(iG)*r**(4d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) + + end if + + end do + +end subroutine G96_gga_exchange_energy diff --git a/src/xcDFT/G96_gga_exchange_potential.f90 b/src/xcDFT/G96_gga_exchange_potential.f90 new file mode 100644 index 0000000..a164760 --- /dev/null +++ b/src/xcDFT/G96_gga_exchange_potential.f90 @@ -0,0 +1,69 @@ +subroutine G96_gga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + +! Compute Gill's GGA exchange poential + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(3,nBas,nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Local variables + + integer :: mu,nu,iG + double precision :: alpha,beta + double precision :: r,g,vAO,gAO + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas) + +! Coefficients for G96 GGA exchange functional + + alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) + beta = +1d0/137d0 + beta = 0d0 + +! Compute GGA exchange matrix in the AO basis + + Fx(:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + r = max(0d0,rho(iG)) + g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 + + if(r > threshold) then + + vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) + Fx(mu,nu) = Fx(mu,nu) & + + vAO*(4d0/3d0*r**(1d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) & + + 2d0*beta*g**(3d0/4d0)/r**(5d0/3d0)) + + gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) + + gAO = weight(iG)*gAO + + Fx(mu,nu) = Fx(mu,nu) - 2d0*gAO*3d0/4d0*beta*g**(-1d0/4d0)/r**(2d0/3d0) + + endif + + enddo + enddo + enddo + +end subroutine G96_gga_exchange_potential diff --git a/src/xcDFT/Kohn_Sham.f90 b/src/xcDFT/Kohn_Sham.f90 new file mode 100644 index 0000000..4010a5c --- /dev/null +++ b/src/xcDFT/Kohn_Sham.f90 @@ -0,0 +1,362 @@ +subroutine Kohn_Sham(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 + 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 + F(:,:,ispin) = Hc(:,:) + end do + + else if(guess_type == 2) then + + do ispin=1,nspin + call random_number(F(:,:,ispin)) + end do + + 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 + +! 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 density matrix +!------------------------------------------------------------------------ + + call 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,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 + +!------------------------------------------------------------------------ +! 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,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_KS(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 Kohn_Sham diff --git a/src/xcDFT/LF19_lda_correlation_Levy_Zahariev_shift.f90 b/src/xcDFT/LF19_lda_correlation_Levy_Zahariev_shift.f90 new file mode 100644 index 0000000..9b7b79b --- /dev/null +++ b/src/xcDFT/LF19_lda_correlation_Levy_Zahariev_shift.f90 @@ -0,0 +1,82 @@ +subroutine LF19_lda_correlation_Levy_Zahariev_shift(nEns,wEns,nGrid,weight,rho,EcLZ) + +! Compute Loos-Fromager's LDA contribution to Levy-Zahariev shift + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + logical :: LDA_centered = .false. + integer :: iEns + double precision :: EcLZLDA(nsp) + double precision,allocatable :: aLF(:,:) + double precision,allocatable :: EcLZeLDA(:,:) + +! Output variables + + double precision,intent(out) :: EcLZ(nsp) + + +! Allocation + + allocate(aLF(3,nEns),EcLZeLDA(nsp,nEns)) + +! Parameters for weight-dependent LDA correlation functional + + aLF(1,1) = -0.0238184d0 + aLF(2,1) = +0.00575719d0 + aLF(3,1) = +0.0830576d0 + + aLF(1,2) = -0.0282814d0 + aLF(2,2) = +0.00340758d0 + aLF(3,2) = +0.0663967d0 + + aLF(1,3) = -0.0144633d0 + aLF(2,3) = -0.0504501d0 + aLF(3,3) = +0.0331287d0 + +! Compute correlation energy for ground, singly-excited and doubly-excited states + + do iEns=1,nEns + + call elda_correlation_Levy_Zahariev_shift(nEns,aLF(:,iEns),nGrid,weight(:),rho(:,:),EcLZeLDA(:,iEns)) + + end do + +! LDA-centered functional + + EcLZLDA(:) = 0d0 + + if(LDA_centered) then + + call VWN5_lda_correlation_Levy_Zahariev_shift(nGrid,weight(:),rho(:,:),EcLZLDA(:)) + + do iEns=1,nEns + + EcLZeLDA(:,iEns) = EcLZeLDA(:,iEns) + EcLZLDA(:)- EcLZeLDA(:,1) + + end do + + end if + +! Weight-denpendent functional for ensembles + + EcLZ(:) = 0d0 + + do iEns=1,nEns + + EcLZ(:) = EcLZ(:) + wEns(iEns)*EcLZeLDA(:,iEns) + + enddo + +end subroutine LF19_lda_correlation_Levy_Zahariev_shift diff --git a/src/xcDFT/LF19_lda_correlation_derivative_discontinuity.f90 b/src/xcDFT/LF19_lda_correlation_derivative_discontinuity.f90 new file mode 100644 index 0000000..12f609c --- /dev/null +++ b/src/xcDFT/LF19_lda_correlation_derivative_discontinuity.f90 @@ -0,0 +1,63 @@ +subroutine LF19_lda_correlation_derivative_discontinuity(nEns,wEns,nGrid,weight,rhow,Ec) + +! Compute eLDA correlation part of the derivative discontinuity + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + +! Local variables + + integer :: iEns,jEns + double precision,allocatable :: aLF(:,:) + double precision :: dEc(nsp,nEns) + double precision,external :: Kronecker_delta + +! Output variables + + double precision,intent(out) :: Ec(nsp,nEns) + +! Allocation + + allocate(aLF(3,nEns)) + +! Parameters for weight-dependent LDA correlation functional + + aLF(1,1) = -0.0238184d0 + aLF(2,1) = +0.00575719d0 + aLF(3,1) = +0.0830576d0 + + aLF(1,2) = -0.0282814d0 + aLF(2,2) = +0.00340758d0 + aLF(3,2) = +0.0663967d0 + + aLF(1,3) = -0.0144633d0 + aLF(2,3) = -0.0504501d0 + aLF(3,3) = +0.0331287d0 + +! Compute correlation energy for ground, singly-excited and doubly-excited states + + do iEns=1,nEns + + call elda_correlation_energy(nEns,aLF(:,iEns),nGrid,weight(:),rhow(:,:),dEc(:,iEns)) + + end do + + Ec(:,:) = 0d0 + + do iEns=1,nEns + do jEns=1,nEns + + Ec(:,iEns) = Ec(:,iEns) + (Kronecker_delta(iEns,jEns) - wEns(jEns))*(dEc(:,jEns) - dEc(:,1)) + + end do + end do + +end subroutine LF19_lda_correlation_derivative_discontinuity diff --git a/src/xcDFT/LF19_lda_correlation_energy.f90 b/src/xcDFT/LF19_lda_correlation_energy.f90 new file mode 100644 index 0000000..e7713f3 --- /dev/null +++ b/src/xcDFT/LF19_lda_correlation_energy.f90 @@ -0,0 +1,84 @@ +subroutine LF19_lda_correlation_energy(nEns,wEns,nGrid,weight,rho,Ec) + +! Compute eLDA correlation energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + logical :: LDA_centered = .false. + integer :: iEns,isp + double precision :: EcLDA(nsp) + double precision,allocatable :: aLF(:,:) + double precision,allocatable :: EceLDA(:,:) + +! Output variables + + double precision :: Ec(nsp) + +! Allocation + + allocate(aLF(3,nEns),EceLDA(nsp,nEns)) + +! Parameters for weight-dependent LDA correlation functional + + aLF(1,1) = -0.0238184d0 + aLF(2,1) = +0.00575719d0 + aLF(3,1) = +0.0830576d0 + + aLF(1,2) = -0.0282814d0 + aLF(2,2) = +0.00340758d0 + aLF(3,2) = +0.0663967d0 + + aLF(1,3) = -0.0144633d0 + aLF(2,3) = -0.0504501d0 + aLF(3,3) = +0.0331287d0 + +! Compute correlation energy for ground, singly-excited and doubly-excited states + + do iEns=1,nEns + + call elda_correlation_energy(nEns,aLF(:,iEns),nGrid,weight(:),rho(:,:),EceLDA(:,iEns)) + + end do + +! LDA-centered functional + + EcLDA(:) = 0d0 + + if(LDA_centered) then + + call VWN5_lda_correlation_energy(nGrid,weight(:),rho(:,:),EcLDA(:)) + + do iEns=1,nEns + do isp=1,nsp + + EceLDA(isp,iEns) = EceLDA(isp,iEns) + EcLDA(isp) - EceLDA(isp,1) + + end do + end do + + end if + +! Weight-denpendent functional for ensembles + + Ec(:) = 0d0 + + do iEns=1,nEns + do isp=1,nsp + + Ec(isp) = Ec(isp) + wEns(iEns)*EceLDA(isp,iEns) + + end do + end do + +end subroutine LF19_lda_correlation_energy diff --git a/src/xcDFT/LF19_lda_correlation_individual_energy.f90 b/src/xcDFT/LF19_lda_correlation_individual_energy.f90 new file mode 100644 index 0000000..101edf9 --- /dev/null +++ b/src/xcDFT/LF19_lda_correlation_individual_energy.f90 @@ -0,0 +1,81 @@ +subroutine LF19_lda_correlation_individual_energy(nEns,wEns,nGrid,weight,rhow,rho,Ec) + +! Compute eLDA correlation energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + logical :: LDA_centered = .false. + integer :: iEns,isp + double precision :: EcLDA(nsp) + double precision,allocatable :: aLF(:,:) + double precision,allocatable :: EceLDA(:,:) + +! Output variables + + double precision :: Ec(nsp) + +! Allocation + + allocate(aLF(3,nEns),EceLDA(nsp,nEns)) + +! Parameters for weight-dependent LDA correlation functional + + aLF(1,1) = -0.0238184d0 + aLF(2,1) = +0.00575719d0 + aLF(3,1) = +0.0830576d0 + + aLF(1,2) = -0.0282814d0 + aLF(2,2) = +0.00340758d0 + aLF(3,2) = +0.0663967d0 + + aLF(1,3) = -0.0144633d0 + aLF(2,3) = -0.0504501d0 + aLF(3,3) = +0.0331287d0 + +! Compute correlation energy for ground, singly-excited and doubly-excited states + + do iEns=1,nEns + + call elda_correlation_individual_energy(nEns,aLF(:,iEns),nGrid,weight(:),rhow(:,:),rho(:,:),EceLDA(:,iEns)) + + end do + +! LDA-centered functional + + EcLDA(:) = 0d0 + + if(LDA_centered) then + + call W38_lda_correlation_individual_energy(nGrid,weight(:),rhow(:,:),rho(:,:),EcLDA(:)) + + do iEns=1,nEns + do isp=1,nsp + EceLDA(isp,iEns) = EceLDA(isp,iEns) + EcLDA(isp) - EceLDA(isp,1) + end do + end do + + end if + +! Weight-denpendent functional for ensembles + + Ec(:) = 0d0 + + do iEns=1,nEns + do isp=1,nsp + Ec(isp) = Ec(isp) + wEns(iEns)*EceLDA(isp,iEns) + enddo + enddo + +end subroutine LF19_lda_correlation_individual_energy diff --git a/src/xcDFT/LF19_lda_correlation_potential.f90 b/src/xcDFT/LF19_lda_correlation_potential.f90 new file mode 100644 index 0000000..c2e1a67 --- /dev/null +++ b/src/xcDFT/LF19_lda_correlation_potential.f90 @@ -0,0 +1,82 @@ +subroutine LF19_lda_correlation_potential(nEns,wEns,nGrid,weight,nBas,AO,rho,Fc) + +! Compute Loos-Fromager weight-dependent LDA correlation potential + + implicit none +include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + logical :: LDA_centered = .false. + integer :: iEns + double precision,allocatable :: aLF(:,:) + double precision,allocatable :: FcLDA(:,:,:) + double precision,allocatable :: FceLDA(:,:,:,:) + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Allocation + + allocate(aLF(3,nEns),FcLDA(nBas,nBas,nspin),FceLDA(nBas,nBas,nspin,nEns)) + +! Parameters for weight-dependent LDA correlation functional + + aLF(1,1) = -0.0238184d0 + aLF(2,1) = +0.00575719d0 + aLF(3,1) = +0.0830576d0 + + aLF(1,2) = -0.0282814d0 + aLF(2,2) = +0.00340758d0 + aLF(3,2) = +0.0663967d0 + + aLF(1,3) = -0.0144633d0 + aLF(2,3) = -0.0504501d0 + aLF(3,3) = +0.0331287d0 + +! Compute correlation energy for ground, singly-excited and doubly-excited states + + do iEns=1,nEns + + call elda_correlation_potential(nEns,aLF(:,iEns),nGrid,weight,nBas,AO,rho,FceLDA(:,:,:,iEns)) + + end do + +! LDA-centered functional + + FcLDA(:,:,:) = 0d0 + + if(LDA_centered) then + + call VWN5_lda_correlation_potential(nGrid,weight,nBas,AO,rho,FcLDA) + + do iEns=1,nEns + + FceLDA(:,:,:,iEns) = FceLDA(:,:,:,iEns) + FcLDA(:,:,:) - FceLDA(:,:,:,1) + + end do + + end if + +! Weight-denpendent functional for ensembles + + Fc(:,:,:) = 0d0 + + do iEns=1,nEns + + Fc(:,:,:) = Fc(:,:,:) + wEns(iEns)*FceLDA(:,:,:,iEns) + + enddo + +end subroutine LF19_lda_correlation_potential diff --git a/src/xcDFT/Makefile b/src/xcDFT/Makefile new file mode 100644 index 0000000..565b569 --- /dev/null +++ b/src/xcDFT/Makefile @@ -0,0 +1,35 @@ +IDIR =../../include +BDIR =../../bin +ODIR = obj +SDIR =. +FC = gfortran -I$(IDIR) +ifeq ($(DEBUG),1) +FFLAGS = -Wall -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant +else +FFLAGS = -Wall -Wno-unused -Wno-unused-dummy-argument -O2 +endif + +LIBS = ~/Dropbox/quack/lib/*.a +#LIBS = -lblas -llapack + +SRCF90 = $(wildcard *.f90) + +SRC = $(wildcard *.f) + +OBJ = $(patsubst %.f90,$(ODIR)/%.o,$(SRCF90)) $(patsubst %.f,$(ODIR)/%.o,$(SRC)) + +$(ODIR)/%.o: %.f90 + $(FC) -c -o $@ $< $(FFLAGS) + +$(ODIR)/%.o: %.f + $(FC) -c -o $@ $< $(FFLAGS) + +$(BDIR)/xcDFT: $(OBJ) + $(FC) -o $@ $^ $(FFLAGS) $(LIBS) + +debug: + DEBUG=1 make $(BDIR)/xcDFT +#DEBUG=1 make clean $(BDIR)/xcDFT + +clean: + rm -f $(ODIR)/*.o $(BDIR)/xcDFT $(BDIR)/debug diff --git a/src/xcDFT/S51_lda_exchange_energy.f90 b/src/xcDFT/S51_lda_exchange_energy.f90 new file mode 100644 index 0000000..a273bf5 --- /dev/null +++ b/src/xcDFT/S51_lda_exchange_energy.f90 @@ -0,0 +1,42 @@ +subroutine S51_lda_exchange_energy(nGrid,weight,rho,Ex) + +! Compute Slater's LDA exchange energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid) + +! Local variables + + integer :: iG + double precision :: alpha,r + +! Output variables + + double precision :: Ex + +! Cx coefficient for Slater LDA exchange + + alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) + +! Compute LDA exchange energy + + Ex = 0d0 + do iG=1,nGrid + + r = max(0d0,rho(iG)) + + if(r > threshold) then + + Ex = Ex + weight(iG)*alpha*r**(4d0/3d0) + + endif + + enddo + +end subroutine S51_lda_exchange_energy diff --git a/src/xcDFT/S51_lda_exchange_potential.f90 b/src/xcDFT/S51_lda_exchange_potential.f90 new file mode 100644 index 0000000..802332c --- /dev/null +++ b/src/xcDFT/S51_lda_exchange_potential.f90 @@ -0,0 +1,50 @@ +subroutine S51_lda_exchange_potential(nGrid,weight,nBas,AO,rho,Fx) + +! Compute Slater's LDA exchange potential + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid) + +! Local variables + + integer :: mu,nu,iG + double precision :: alpha + double precision :: r,vAO + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas) + +! Cx coefficient for Slater LDA exchange + + alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) + +! Compute LDA exchange matrix in the AO basis + + Fx(:,:) = 0d0 + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + r = max(0d0,rho(iG)) + + if(r > threshold) then + + vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) + Fx(mu,nu) = Fx(mu,nu) + vAO*4d0/3d0*alpha*r**(1d0/3d0) + + endif + + enddo + enddo + enddo + +end subroutine S51_lda_exchange_potential diff --git a/src/xcDFT/VWN5_lda_correlation_Levy_Zahariev_shift.f90 b/src/xcDFT/VWN5_lda_correlation_Levy_Zahariev_shift.f90 new file mode 100644 index 0000000..14f6201 --- /dev/null +++ b/src/xcDFT/VWN5_lda_correlation_Levy_Zahariev_shift.f90 @@ -0,0 +1,199 @@ +subroutine VWN5_lda_correlation_Levy_Zahariev_shift(nGrid,weight,rho,EcLZ) + +! Compute Wigner's LDA contribution to Levy-Zahariev shift + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,rs,x,z + double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p + double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f + double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a + double precision :: dfzdz,dxdrs,dxdx_p,dxdx_f,dxdx_a,decdx_p,decdx_f,decdx_a + double precision :: dzdra,dfzdra,drsdra,decdra_p,decdra_f,decdra_a,decdra + double precision :: dzdrb,dfzdrb,drsdrb,decdrb_p,decdrb_f,decdrb_a,decdrb + + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + +! Output variables + + double precision,intent(out) :: EcLZ(nsp) + +! Parameters of the functional + + a_p = +0.0621814D0/2D0 + x0_p = -0.10498d0 + b_p = +3.72744d0 + c_p = +12.9352d0 + + a_f = +0.0621814D0/4D0 + x0_f = -0.325d0 + b_f = +7.06042d0 + c_f = +18.0578d0 + + a_a = -1d0/(6d0*pi**2) + x0_a = -0.0047584D0 + b_a = +1.13107d0 + c_a = +13.0045d0 + +! Initialization + + EcLZ(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! spin-up contribution + + if(ra > threshold) then + + r = ra + rb + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdra = (1d0 - z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdra = dzdra*dfzdz + + drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_p = 2d0*x + b_p + dxdx_f = 2d0*x + b_f + dxdx_a = 2d0*x + b_a + + decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & + - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & + - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) + + decdra_p = drsdra*dxdrs*decdx_p + decdra_f = drsdra*dxdrs*decdx_f + decdra_a = drsdra*dxdrs*decdx_a + + decdra = decdra_p + decdra_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & + + (decdra_f - decdra_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 + + EcLZ(2) = EcLZ(2) + weight(iG)*decdra*r*r + + end if + +! spin-down contribution + + if(rb > threshold) then + + r = ra + rb + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdrb = -(1d0 + z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdrb = dzdrb*dfzdz + + drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_p = 2d0*x + b_p + dxdx_f = 2d0*x + b_f + dxdx_a = 2d0*x + b_a + + decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & + - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & + - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) + + decdrb_p = drsdrb*dxdrs*decdx_p + decdrb_f = drsdrb*dxdrs*decdx_f + decdrb_a = drsdrb*dxdrs*decdx_a + + decdrb = decdrb_p + decdrb_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & + + (decdrb_f - decdrb_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 + + EcLZ(2) = EcLZ(2) + weight(iG)*decdrb*r*r + + end if + + end do + +end subroutine VWN5_lda_correlation_Levy_Zahariev_shift diff --git a/src/xcDFT/VWN5_lda_correlation_energy.f90 b/src/xcDFT/VWN5_lda_correlation_energy.f90 new file mode 100644 index 0000000..0cff57e --- /dev/null +++ b/src/xcDFT/VWN5_lda_correlation_energy.f90 @@ -0,0 +1,137 @@ +subroutine VWN5_lda_correlation_energy(nGrid,weight,rho,Ec) + +! Compute VWN5 LDA correlation energy + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,rs,x,z + double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p + double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f + double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a + + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + +! Output variables + + double precision :: Ec(nsp) + +! Parameters of the functional + + a_p = +0.0621814D0/2D0 + x0_p = -0.10498d0 + b_p = +3.72744d0 + c_p = +12.9352d0 + + a_f = +0.0621814D0/4D0 + x0_f = -0.325d0 + b_f = +7.06042d0 + c_f = +18.0578d0 + + a_a = -1d0/(6d0*pi**2) + x0_a = -0.0047584D0 + b_a = 1.13107d0 + c_a = 13.0045d0 + +! Initialization + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! alpha-alpha contribution + + if(ra > threshold) then + + rs = (4d0*pi*ra/3d0)**(-1d0/3d0) + x = sqrt(rs) + + x_f = x*x + b_f*x + c_f + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + q_f = sqrt(4d0*c_f - b_f*b_f) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + Ec(1) = Ec(1) + weight(iG)*ec_f*ra + + end if + +! alpha-beta contribution + + if(ra > threshold .and. rb > threshold) then + + r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + Ec(2) = Ec(2) + weight(iG)*ec_z*r + + end if + +! beta-beta contribution + + if(rb > threshold) then + + rs = (4d0*pi*rb/3d0)**(-1d0/3d0) + x = sqrt(rs) + + x_f = x*x + b_f*x + c_f + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + q_f = sqrt(4d0*c_f - b_f*b_f) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + Ec(3) = Ec(3) + weight(iG)*ec_f*rb + + end if + + end do + + Ec(2) = Ec(2) - Ec(1) - Ec(3) + +end subroutine VWN5_lda_correlation_energy diff --git a/src/xcDFT/VWN5_lda_correlation_individual_energy.f90 b/src/xcDFT/VWN5_lda_correlation_individual_energy.f90 new file mode 100644 index 0000000..513354c --- /dev/null +++ b/src/xcDFT/VWN5_lda_correlation_individual_energy.f90 @@ -0,0 +1,204 @@ +subroutine VWN5_lda_correlation_individual_energy(nGrid,weight,rhow,rho,Ec) + +! Compute VWN5 LDA correlation potential + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,raI,rbI,rI,rs,x,z + double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p + double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f + double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a + double precision :: dfzdz,dxdrs,dxdx_p,dxdx_f,dxdx_a,decdx_p,decdx_f,decdx_a + double precision :: dzdra,dfzdra,drsdra,decdra_p,decdra_f,decdra_a,decdra + double precision :: dzdrb,dfzdrb,drsdrb,decdrb_p,decdrb_f,decdrb_a,decdrb + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + +! Output variables + + double precision :: Ec(nspin) + +! Parameters of the functional + + a_p = +0.0621814D0/2D0 + x0_p = -0.10498d0 + b_p = +3.72744d0 + c_p = +12.9352d0 + + a_f = +0.0621814D0/4D0 + x0_f = -0.325d0 + b_f = +7.06042d0 + c_f = +18.0578d0 + + a_a = -1d0/(6d0*pi**2) + x0_a = -0.0047584D0 + b_a = +1.13107d0 + c_a = +13.0045d0 + +! Initialization + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rhow(iG,1)) + rb = max(0d0,rhow(iG,2)) + + raI = max(0d0,rho(iG,1)) + rbI = max(0d0,rho(iG,2)) + +! spin-up contribution + + if(ra > threshold .and. raI > threshold) then + + r = ra + rb + rI = raI + rbI + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdra = (1d0 - z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdra = dzdra*dfzdz + + drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_p = 2d0*x + b_p + dxdx_f = 2d0*x + b_f + dxdx_a = 2d0*x + b_a + + decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & + - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & + - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) + + decdra_p = drsdra*dxdrs*decdx_p + decdra_f = drsdra*dxdrs*decdx_f + decdra_a = drsdra*dxdrs*decdx_a + + decdra = decdra_p + decdra_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & + + (decdra_f - decdra_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 + + Ec(2) = Ec(2) + weight(iG)*(ec_z + decdra*r)*rI + + end if + +! spin-down contribution + + if(rb > threshold .and. rbI > threshold) then + + r = ra + rb + rI = raI + rbI + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdrb = -(1d0 + z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdrb = dzdrb*dfzdz + + drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_p = 2d0*x + b_p + dxdx_f = 2d0*x + b_f + dxdx_a = 2d0*x + b_a + + decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & + - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & + - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) + + decdrb_p = drsdrb*dxdrs*decdx_p + decdrb_f = drsdrb*dxdrs*decdx_f + decdrb_a = drsdrb*dxdrs*decdx_a + + decdrb = decdrb_p + decdrb_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & + + (decdrb_f - decdrb_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 + + Ec(2) = Ec(2) + weight(iG)*(ec_z + decdrb*r)*rI + + end if + + end do + +end subroutine VWN5_lda_correlation_individual_energy diff --git a/src/xcDFT/VWN5_lda_correlation_potential.f90 b/src/xcDFT/VWN5_lda_correlation_potential.f90 new file mode 100644 index 0000000..2a11aaf --- /dev/null +++ b/src/xcDFT/VWN5_lda_correlation_potential.f90 @@ -0,0 +1,202 @@ +subroutine VWN5_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) + +! Compute VWN5 LDA correlation potential + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: mu,nu,iG + double precision :: ra,rb,r,rs,x,z + double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p + double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f + double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a + double precision :: dfzdz,dxdrs,dxdx_p,dxdx_f,dxdx_a,decdx_p,decdx_f,decdx_a + double precision :: dzdra,dfzdra,drsdra,decdra_p,decdra_f,decdra_a,decdra + double precision :: dzdrb,dfzdrb,drsdrb,decdrb_p,decdrb_f,decdrb_a,decdrb + + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + +! Output variables + + double precision :: Fc(nBas,nBas,nspin) + +! Parameters of the functional + + a_p = +0.0621814D0/2D0 + x0_p = -0.10498d0 + b_p = +3.72744d0 + c_p = +12.9352d0 + + a_f = +0.0621814D0/4D0 + x0_f = -0.325d0 + b_f = +7.06042d0 + c_f = +18.0578d0 + + a_a = -1d0/(6d0*pi**2) + x0_a = -0.0047584D0 + b_a = +1.13107d0 + c_a = +13.0045d0 + +! Initialization + + Fc(:,:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! spin-up contribution + + if(ra > threshold) then + + r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdra = (1d0 - z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdra = dzdra*dfzdz + + drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_p = 2d0*x + b_p + dxdx_f = 2d0*x + b_f + dxdx_a = 2d0*x + b_a + + decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & + - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & + - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) + + decdra_p = drsdra*dxdrs*decdx_p + decdra_f = drsdra*dxdrs*decdx_f + decdra_a = drsdra*dxdrs*decdx_a + + decdra = decdra_p + decdra_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & + + (decdra_f - decdra_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 + + Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdra*r) + + end if + +! spin-down contribution + + if(rb > threshold) then + + r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdrb = - (1d0 + z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdrb = dzdrb*dfzdz + + drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_p = 2d0*x + b_p + dxdx_f = 2d0*x + b_f + dxdx_a = 2d0*x + b_a + + decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & + - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & + - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) + + decdrb_p = drsdrb*dxdrs*decdx_p + decdrb_f = drsdrb*dxdrs*decdx_f + decdrb_a = drsdrb*dxdrs*decdx_a + + decdrb = decdrb_p + decdrb_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & + + (decdrb_f - decdrb_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 + Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdrb*r) + + end if + + end do + end do + end do + +end subroutine VWN5_lda_correlation_potential diff --git a/src/xcDFT/W38_lda_correlation_Levy_Zahariev_shift.f90 b/src/xcDFT/W38_lda_correlation_Levy_Zahariev_shift.f90 new file mode 100644 index 0000000..77852d7 --- /dev/null +++ b/src/xcDFT/W38_lda_correlation_Levy_Zahariev_shift.f90 @@ -0,0 +1,56 @@ +subroutine W38_lda_correlation_Levy_Zahariev_shift(nGrid,weight,rho,EcLZ) + +! Compute Wigner's LDA contribution to Levy-Zahariev shift + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r + double precision :: a,d,epsc + double precision :: dFcdra,dFcdrb + +! Output variables + + double precision,intent(out) :: EcLZ(nsp) + +! Coefficients for Wigner's LDA correlation + + a = 0.04918d0 + d = 0.349d0 + +! Compute LDA correlation matrix in the AO basis + + EcLZ(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + + r = ra + rb + + if(r > threshold) then + + epsc = ra*rb/(r + d*r**(2d0/3d0)) + dFcdra = epsc*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 2d0/r + 1d0/ra) + dFcdrb = epsc*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 2d0/r + 1d0/rb) + + EcLZ(2) = EcLZ(2) - weight(iG)*r*r*(dFcdra + dFcdrb) + + endif + + enddo + + EcLZ(:) = -4d0*a*EcLZ(:) + +end subroutine W38_lda_correlation_Levy_Zahariev_shift diff --git a/src/xcDFT/W38_lda_correlation_energy.f90 b/src/xcDFT/W38_lda_correlation_energy.f90 new file mode 100644 index 0000000..a13e806 --- /dev/null +++ b/src/xcDFT/W38_lda_correlation_energy.f90 @@ -0,0 +1,52 @@ +subroutine W38_lda_correlation_energy(nGrid,weight,rho,Ec) + +! Compute Wigner's LDA correlation energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r + double precision :: a,d,epsc + +! Output variables + + double precision :: Ec(nsp) + +! Coefficients for Wigner's LDA correlation + + a = 0.04918d0 + d = 0.349d0 + +! Compute LDA correlation energy + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + + if(ra > threshold .and. rb > threshold) then + + r = ra + rb + + epsc = ra*rb/(r + d*r**(2d0/3d0)) + + Ec(2) = Ec(2) + weight(iG)*epsc + + endif + + enddo + + Ec(2) = -4d0*a*Ec(2) + +end subroutine W38_lda_correlation_energy diff --git a/src/xcDFT/W38_lda_correlation_individual_energy.f90 b/src/xcDFT/W38_lda_correlation_individual_energy.f90 new file mode 100644 index 0000000..31f7bd8 --- /dev/null +++ b/src/xcDFT/W38_lda_correlation_individual_energy.f90 @@ -0,0 +1,62 @@ +subroutine W38_lda_correlation_individual_energy(nGrid,weight,rhow,rho,Ec) + +! Compute Wigner's LDA individual energy + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r + double precision :: raI,rbI,rI + double precision :: a,d,epsc + double precision :: dFcdra,dFcdrb + +! Output variables + + double precision,intent(out) :: Ec(nsp) + +! Coefficients for Wigner's LDA correlation + + a = 0.04918d0 + d = 0.349d0 + +! Compute LDA correlation individual energy + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rhow(iG,1)) + rb = max(0d0,rhow(iG,2)) + + raI = max(0d0,rho(iG,1)) + rbI = max(0d0,rho(iG,2)) + + r = ra + rb + rI = raI + rbI + + if(r > threshold .and. rI > threshold) then + + epsc = ra*rb/(r + d*r**(2d0/3d0)) + dFcdra = epsc*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 1d0/r + 1d0/ra) + dFcdrb = epsc*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 1d0/r + 1d0/rb) + + Ec(2) = Ec(2) + weight(iG)*rI*0.5d0*(dFcdra + dFcdrb) + + endif + + enddo + + Ec(2) = -4d0*a*Ec(2) + +end subroutine W38_lda_correlation_individual_energy diff --git a/src/xcDFT/W38_lda_correlation_potential.f90 b/src/xcDFT/W38_lda_correlation_potential.f90 new file mode 100644 index 0000000..755974b --- /dev/null +++ b/src/xcDFT/W38_lda_correlation_potential.f90 @@ -0,0 +1,76 @@ +subroutine W38_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) + +! Compute Wigner's LDA correlation potential + + implicit none +include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: mu,nu,iG + double precision :: ra,rb,r + double precision :: a,d,ec + double precision :: dFcdr + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Coefficients for Wigner's LDA correlation + + a = 0.04918d0 + d = 0.349d0 + +! Compute LDA correlation matrix in the AO basis + + Fc(:,:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! Spin-up part contribution + + if(ra > threshold) then + + r = ra + rb + + ec = ra*rb/(r + d*r**(2d0/3d0)) + dFcdr = ec*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 1d0/r + 1d0/ra) + + Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdr + + endif + +! Spin-down part contribution + + if(rb > threshold) then + + r = ra + rb + + ec = ra*rb/(r + d*r**(2d0/3d0)) + dFcdr = ec*(d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) - 1d0/r + 1d0/rb) + + Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdr + + endif + + enddo + + enddo + enddo + + Fc(:,:,:) = -4d0*a*Fc(:,:,:) + +end subroutine W38_lda_correlation_potential diff --git a/src/xcDFT/correlation_Levy_Zahariev_shift.f90 b/src/xcDFT/correlation_Levy_Zahariev_shift.f90 new file mode 100644 index 0000000..584bb74 --- /dev/null +++ b/src/xcDFT/correlation_Levy_Zahariev_shift.f90 @@ -0,0 +1,69 @@ +subroutine correlation_Levy_Zahariev_shift(rung,DFA,nEns,wEns,nGrid,weight,rho,drho,EcLZ) + +! Compute the correlation part of the Levy-Zahariev shift + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: rung + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + double precision :: EcLZLDA(nsp),EcLZGGA(nsp) + double precision :: aC + +! Output variables + + double precision,intent(out) :: EcLZ(nsp) + + select case (rung) + +! Hartree calculation + + case(0) + + EcLZ(:) = 0d0 + +! LDA functionals + + case(1) + + call lda_correlation_Levy_Zahariev_shift(DFA,nEns,wEns(:),nGrid,weight(:),rho(:,:),EcLZ(:)) + +! GGA functionals + + case(2) + + call print_warning('!!! Individual energies NYI for GGAs !!!') + stop + +! Hybrid functionals + + case(4) + + call print_warning('!!! Individual energies NYI for hybrids !!!') + stop + + aC = 0.81d0 + + EcLZ(:) = EcLZLDA(:) + aC*(EcLZGGA(:) - EcLZLDA(:)) + +! Hartree-Fock calculation + + case(666) + + EcLZ(:) = 0d0 + + end select + +end subroutine correlation_Levy_Zahariev_shift diff --git a/src/xcDFT/correlation_derivative_discontinuity.f90 b/src/xcDFT/correlation_derivative_discontinuity.f90 new file mode 100644 index 0000000..4cb46aa --- /dev/null +++ b/src/xcDFT/correlation_derivative_discontinuity.f90 @@ -0,0 +1,65 @@ +subroutine correlation_derivative_discontinuity(rung,DFA,nEns,wEns,nGrid,weight,rhow,drhow,Ec) + +! Compute the correlation part of the derivative discontinuity + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: rung + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + double precision,intent(in) :: drhow(ncart,nGrid,nspin) + +! Local variables + + double precision :: aC + +! Output variables + + double precision,intent(out) :: Ec(nsp,nEns) + + select case (rung) + +! Hartree calculation + + case(0) + + Ec(:,:) = 0d0 + +! LDA functionals + + case(1) + + call lda_correlation_derivative_discontinuity(DFA,nEns,wEns(:),nGrid,weight(:),rhow(:,:),Ec(:,:)) + +! GGA functionals + + case(2) + + call print_warning('!!! derivative discontinuity NYI for GGAs !!!') + stop + +! Hybrid functionals + + case(4) + + call print_warning('!!! derivative discontinuity NYI for hybrids !!!') + stop + + aC = 0.81d0 + +! Hartree-Fock calculation + + case(666) + + Ec(:,:) = 0d0 + + end select + +end subroutine correlation_derivative_discontinuity diff --git a/src/xcDFT/correlation_energy.f90 b/src/xcDFT/correlation_energy.f90 new file mode 100644 index 0000000..9326ba9 --- /dev/null +++ b/src/xcDFT/correlation_energy.f90 @@ -0,0 +1,68 @@ +subroutine correlation_energy(rung,DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) + +! Compute the correlation energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: rung + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(3,nGrid,nspin) + +! Local variables + + double precision :: EcLDA(nsp) + double precision :: EcGGA(nsp) + double precision :: aC + +! Output variables + + double precision,intent(out) :: Ec(nsp) + + select case (rung) + +! Hartree calculation + + case(0) + + Ec(:) = 0d0 + +! LDA functionals + + case(1) + + call lda_correlation_energy(DFA,nEns,wEns(:),nGrid,weight(:),rho(:,:),Ec(:)) + +! GGA functionals + + case(2) + + call gga_correlation_energy(DFA,nEns,wEns(:),nGrid,weight(:),rho(:,:),drho(:,:,:),Ec(:)) + +! Hybrid functionals + + case(4) + + aC = 0.81d0 + + call lda_correlation_energy(DFA,nEns,wEns(:),nGrid,weight(:),rho(:,:),EcLDA(:)) + call gga_correlation_energy(DFA,nEns,wEns(:),nGrid,weight(:),rho(:,:),drho(:,:,:),EcGGA(:)) + + Ec(:) = EcLDA(:) + aC*(EcGGA(:) - EcLDA(:)) + +! Hartree-Fock calculation + + case(666) + + Ec(:) = 0d0 + + end select + +end subroutine correlation_energy diff --git a/src/xcDFT/correlation_individual_energy.f90 b/src/xcDFT/correlation_individual_energy.f90 new file mode 100644 index 0000000..4fd9fbb --- /dev/null +++ b/src/xcDFT/correlation_individual_energy.f90 @@ -0,0 +1,69 @@ +subroutine correlation_individual_energy(rung,DFA,nEns,wEns,nGrid,weight,rhow,drhow,rho,drho,Ec) + +! Compute the correlation energy of individual states + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: rung + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + double precision,intent(in) :: drhow(ncart,nGrid,nspin) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + double precision :: EcLDA(nsp) + double precision :: EcGGA(nsp) + double precision :: aC + +! Output variables + + double precision,intent(out) :: Ec(nsp) + + select case (rung) + +! Hartree calculation + + case(0) + + Ec(:) = 0d0 + +! LDA functionals + + case(1) + + call lda_correlation_individual_energy(DFA,nEns,wEns(:),nGrid,weight(:),rhow(:,:),rho(:,:),Ec(:)) + +! GGA functionals + + case(2) + + call print_warning('!!! Individual energies NYI for GGAs !!!') + stop + +! Hybrid functionals + + case(4) + + call print_warning('!!! Individual energies NYI for hybrids !!!') + stop + + aC = 0.81d0 + +! Hartree-Fock calculation + + case(666) + + Ec(:) = 0d0 + + end select + +end subroutine correlation_individual_energy diff --git a/src/xcDFT/correlation_potential.f90 b/src/xcDFT/correlation_potential.f90 new file mode 100644 index 0000000..d79f47b --- /dev/null +++ b/src/xcDFT/correlation_potential.f90 @@ -0,0 +1,75 @@ +subroutine correlation_potential(rung,DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + +! Compute the correlation potential + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: rung + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(ncart,nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + double precision,allocatable :: FcLDA(:,:,:) + double precision,allocatable :: FcGGA(:,:,:) + double precision :: aC + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Memory allocation + + select case (rung) + +! Hartree calculation + + case(0) + + Fc(:,:,:) = 0d0 + +! LDA functionals + + case(1) + + call lda_correlation_potential(DFA,nEns,wEns(:),nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) + +! GGA functionals + + case(2) + + call gga_correlation_potential(DFA,nEns,wEns(:),nGrid,weight(:),nBas,AO(:,:),dAO(:,:,:),rho(:,:),drho(:,:,:),Fc(:,:,:)) + +! Hybrid functionals + + case(4) + + allocate(FcLDA(nBas,nBas,nspin),FcGGA(nBas,nBas,nspin)) + + aC = 0.81d0 + + call lda_correlation_potential(DFA,nEns,wEns(:),nGrid,weight(:),nBas,AO(:,:),rho(:,:),FcLDA(:,:,:)) + call gga_correlation_potential(DFA,nEns,wEns(:),nGrid,weight(:),nBas,AO(:,:),dAO(:,:,:),rho(:,:),drho(:,:,:),FcGGA(:,:,:)) + + Fc(:,:,:) = FcLDA(:,:,:) + aC*(FcGGA(:,:,:) - FcLDA(:,:,:)) + +! Hartree-Fock calculation + + case(666) + + Fc(:,:,:) = 0d0 + + end select + +end subroutine correlation_potential diff --git a/src/xcDFT/density.f90 b/src/xcDFT/density.f90 new file mode 100644 index 0000000..e6bfd22 --- /dev/null +++ b/src/xcDFT/density.f90 @@ -0,0 +1,38 @@ +subroutine density(nGrid,nBas,P,AO,rho) + +! Calculate one-electron density + + implicit none + include 'parameters.h' + +! Input variables + + double precision,parameter :: thresh = 1d-15 + + integer,intent(in) :: nGrid + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: AO(nBas,nGrid) + +! Local variables + + integer :: iG,mu,nu + +! Output variables + + double precision,intent(out) :: rho(nGrid) + + rho(:) = 0d0 + do iG=1,nGrid + do mu=1,nBas + do nu=1,nBas + rho(iG) = rho(iG) + AO(mu,iG)*P(mu,nu)*AO(nu,iG) + enddo + enddo + enddo + +! do iG=1,nGrid +! rho(iG) = max(rho(iG),thresh) +! enddo + +end subroutine density diff --git a/src/xcDFT/density_matrix.f90 b/src/xcDFT/density_matrix.f90 new file mode 100644 index 0000000..a37c1ea --- /dev/null +++ b/src/xcDFT/density_matrix.f90 @@ -0,0 +1,43 @@ +subroutine density_matrix(nBas,nEns,nO,c,P) + +! Calculate density matrices + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + integer,intent(in) :: nEns + integer,intent(in) :: nO(nspin) + double precision,intent(in) :: c(nBas,nBas,nspin) + +! Local variables + + integer :: ispin + +! Output variables + + double precision,intent(out) :: P(nBas,nBas,nspin,nEns) + +! Ground state density matrix + + do ispin=1,nspin + P(:,:,ispin,1) = matmul(c(:,1:nO(ispin),ispin),transpose(c(:,1:nO(ispin),ispin))) + end do + +! Singly-excited state density matrix + + P(:,:,1,2) = 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,2) = matmul(c(:,1:nO(2),2),transpose(c(:,1:nO(2),2))) + +! Doubly-excited state density matrix + + do ispin=1,nspin + P(:,:,ispin,3) = 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 + +end subroutine density_matrix diff --git a/src/xcDFT/dft_grid.f b/src/xcDFT/dft_grid.f new file mode 100644 index 0000000..66eb029 --- /dev/null +++ b/src/xcDFT/dft_grid.f @@ -0,0 +1,3017 @@ +c----------------------------------------------------------------------- + + SUBROUTINE EulMac(Pts,Wts,N,R) +c ****************************************************************** +c * * +c * EulMac constructs an Euler-Maclaurin quadrature formula for * +c * * +c * inf * +c * Integral [r**2 g(r)] dr * +c * 0 * +c * * +c * OUTPUT: * +c * Pts - Quadrature points * +c * Wts - Quadrature weights * +c * * +c * INPUT: * +c * N - Number of points desired * +c * R - Length scaling factor * +c * * +c ****************************************************************** + IMPLICIT REAL*8 (a-h,o-z) + REAL*8 Pts(N),Wts(N) + T = R**3 * FLOAT(N+1) + DO i = 1,N + U = FLOAT(i) + V = FLOAT(N-i+1) + Pts(i) = R * (U/V)**2 + Wts(i) = 2 * T * U**5 / V**7 + END DO + RETURN + END + +c----------------------------------------------------------------------- + + SUBROUTINE Lebdev(Pts,Wts,N) +c ****************************************************************** +c * * +c * Lebdev returns a Lebedev formula for quadrature on the * +c * surface of the unit sphere having the desired number * +c * of points. * +c * * +c * OUTPUT: * +c * Pts - Cartesian coordinates of quadrature points * +c * Wts - Quadrature weights * +c * * +c * INPUT: * +c * N - Number of quadrature points desired * +c * * +c * N Description * +c * --- ----------- * +c * 1 Debugging formula * +c * 4 2nd-degree, Tetrahedral formula * +c * 6 3rd-degree, Octahedral formula * +c * 18 5th-degree, Abramowitz & Stegun, p. 894 * +c * 26 7th-degree, Abramowitz & Stegun, p. 894 * +c * 38 9th-degree, Ref. 1 * +c * 50 11th-degree, Ref. 1 * +c * 86 15th-degree, Ref. 1 * +c * 110 17th-degree, Ref. 1 * +c * 146 19th-degree, Ref. 2 * +c * 194 23rd-degree, Ref. 2 * +c * 302 29th-degree, Ref. 3 * +c * * +c * Refs: 1) Zh. Vychisl. Mat. Mat. Fiz. 15, 48 (1975). * +c * 2) Zh. Vychisl. Mat. Mat. Fiz. 16, 293 (1976). * +c * 3) Sibirsk. Mat. Zh. 18, 132 (1977). * +c * * +c ****************************************************************** + IMPLICIT REAL*8 (a-h,o-z) + PARAMETER (NLeb=31,MaxB=30,MaxC=10,MaxD=90) + REAL*8 Pts(3,*),Wts(*),A(3,NLeb),B(MaxB,NLeb),C(MaxC,NLeb), + $ D(MaxD,NLeb),T(MaxB,NLeb),V(MaxC,NLeb),S(2,MaxD,NLeb), + $ mk,lk,r(3),Guess(3) + INTEGER SetTyp(6,NLeb),Pmt(3,6) + SAVE SetTyp,Pmt,Guess + SAVE A,B,C,D,T,V,S + DATA SetTyp / 1,0,0,0,0,0, + $ 1,1,0,0,0,0, + $ 1,1,1,0,0,0, + $ 1,0,1,0,1,0, + $ 1,1,1,1,0,0, + $ 1,1,1,1,1,0, + $ 1,0,1,2,1,0, + $ 1,0,1,3,1,0, + $ 1,1,1,3,0,1, + $ 1,1,1,3,1,1, + $ 1,1,1,4,1,1, + $ 1,0,1,5,2,1, + $ 1,1,1,5,1,2, + $ 1,0,1,6,2,2, + $ 1,0,1,6,2,3, + $ 1,1,1,7,2,4, + $ 1,0,1,9,3,6, + $ 1,1,1,10,3,9, + $ 1,0,1,12,4,12, + $ 1,1,1,13,4,16, + $ 1,0,1,15,5,20, + $ 1,1,1,16,5,25, + $ 1,0,1,18,6,30, + $ 1,1,1,19,6,36, + $ 1,0,1,21,7,42, + $ 1,1,1,22,7,49, + $ 1,0,1,24,8,56, + $ 1,1,1,25,8,64, + $ 1,0,1,27,9,72, + $ 1,1,1,28,9,81, + $ 1,0,1,30,10,90 / + DATA Pmt / 1,2,3, 2,3,1, 3,1,2, 2,1,3, 1,3,2, 3,2,1 / + DATA Guess / 0.15D0,0.5D0,0.85D0 / + + DATA A(1,1) + $ / 0.1666666666666666666666666666666667D+00 / + DATA (A(j,2),j=1,2) + $ / 0.3333333333333333333333333333333333D-01, + $ 0.6666666666666666666666666666666667D-01 / + DATA (A(j,3),j=1,3) + $ / 0.4761904761904761904761904761904762D-01, + $ 0.3809523809523809523809523809523810D-01, + $ 0.3214285714285714285714285714285714D-01 / + DATA (A(j,4),j=1,3) + $ / 0.9523809523809523809523809523809525D-02, 0D0, + $ 0.3214285714285714285714285714285714D-01 / + DATA (A(j,5),j=1,3) + $ / 0.1269841269841269841269841269841270D-01, + $ 0.2257495590828924162257495590828924D-01, + $ 0.2109375D-01 / + DATA (A(j,6),j=1,3) + $ / 5.130671797338D-04, + $ 1.660406956574D-02, + $ -2.958603896104D-02 / + DATA (A(j,7),j=1,3) + $ / 0.1154401154401154401154401154401154D-01, 0D0, + $ 0.1194390908585628232369892597364696D-01 / + DATA (A(j,8),j=1,3) + $ / 0.3828270494937161603828270494937183D-02, 0D0, + $ 0.9793737512487512487512487512487502D-02 / + DATA (A(j,9),j=1,3) + $ / 0.5996313688621380929073236765544457D-03, + $ 0.7372999718620756423057432684105612D-02, + $ 0.7210515360144487777633059968342821D-02 / + DATA (A(j,10),j=1,3) + $ / 5.544842902037D-03, + $ 6.071332770671D-03, + $ 6.383674773515D-03 / + DATA (A(j,11),j=1,3) + $ / 0.1782340447244611157367271048698676D-02, + $ 0.5716905949977101892992128388320993D-02, + $ 0.5573383178848737968367849584466468D-02 / + DATA (A(j,12),j=1,3) + $ / -5.522639919727D-02, + $ 0.000000000000D+00, + $ 4.450274607445D-03 / + DATA (A(j,13),j=1,3) + $ / -1.313769127327D-03, + $ -2.522728704859D-03, + $ 4.186853881701D-03 / + DATA (A(j,14),j=1,3) + $ / 0.8545911725128148134231210325881270D-03, 0D0, + $ 0.3599119285025571458863978589612291D-02 / + DATA (A(j,15),j=1,3) + $ / 3.006796749454D-03, + $ 0.000000000000D+00, + $ 3.050627745651D-03 / + DATA (A(j,16),j=1,3) + $ / 5.265897968224D-04, + $ 2.548219972003D-03, + $ 2.512317418927D-03 / + DATA (A(j,17),j=1,3) + $ / 3.095121295306D-04, + $ 0.000000000000D+00, + $ 1.852379698597D-03 / + DATA (A(j,18),j=1,3) + $ / 2.192942088181D-04, + $ 1.436433617319D-03, + $ 1.421940344336D-03 / + DATA (A(j,19),j=1,3) + $ / 1.438294190527D-04, + $ 0.000000000000D+00, + $ 1.125772288287D-03 / + DATA (A(j,20),j=1,3) + $ / 1.105189233268D-04, + $ 9.205232738091D-04, + $ 9.133159786444D-04 / + DATA (A(j,21),j=1,3) + $ / 7.777160743261D-05, + $ 0.000000000000D+00, + $ 7.557646413005D-04 / + DATA (A(j,22),j=1,3) + $ / 6.309049437421D-05, + $ 6.398287705572D-04, + $ 6.357185073531D-04 / + DATA (A(j,23),j=1,3) + $ / 4.656031899197D-05, + $ 0.000000000000D+00, + $ 5.421549195296D-04 / + DATA (A(j,24),j=1,3) + $ / 3.922616270665D-05, + $ 4.703831750854D-04, + $ 4.678202801282D-04 / + DATA (A(j,25),j=1,3) + $ / 2.998675149888D-05, + $ 0.000000000000D+00, + $ 4.077860529495D-04 / + DATA (A(j,26),j=1,3) + $ / 2.599095953755D-05, + $ 3.603134089688D-04, + $ 3.586067974412D-04 / + DATA (A(j,27),j=1,3) + $ / 2.040382730826D-05, + $ 0.000000000000D+00, + $ 3.178149703890D-04 / + DATA (A(j,28),j=1,3) + $ / 1.807395252197D-05, + $ 2.848008782239D-04, + $ 2.836065837531D-04 / + DATA (A(j,29),j=1,3) + $ / 1.449063022538D-05, + $ 0.000000000000D+00, + $ 2.546377329828D-04 / + DATA (A(j,30),j=1,3) + $ / 9.687521879421D-05, + $ 2.307897895368D-04, + $ 2.297310852499D-04 / + DATA (A(j,31),j=1,3) + $ / 9.080510764308D-05, + $ 0.000000000000D+00, + $ 2.084824361988D-04 / + DATA B(1,5) + $ / 0.2017333553791887125220458553791887D-01 / + DATA B(1,6) + $ / 2.657620708216D-02 / + DATA (B(j,7),j=1,2) + $ / 0.1111055571060340251094684821601397D-01, + $ 0.1187650129453714201378828059940252D-01 / + DATA (B(j,8),j=1,3) + $ / 0.8211737283191110975989934052273075D-02, + $ 0.9595471336070962849453181172902595D-02, + $ 0.9942814891178103281400658285264506D-02 / + DATA (B(j,9),j=1,3) + $ / 0.7574394159054033722687485747138069D-02, + $ 0.6753829486314477440735417324864531D-02, + $ 0.7116355493117555387600892849539733D-02 / + DATA (B(j,10),j=1,3) + $ / 5.183387587748D-03, + $ 6.317929009814D-03, + $ 6.201670006589D-03 / + DATA (B(j,11),j=1,4) + $ / 0.5518771467273613691727684601193794D-02, + $ 0.5158237711805383103249161547187927D-02, + $ 0.5608704082587996843749366738551845D-02, + $ 0.4106777028169394090728611285645817D-02 / + DATA (B(j,12),j=1,5) + $ / 4.496841067921D-03, + $ 5.049153450479D-03, + $ 3.976408018052D-03, + $ 4.401400650381D-03, + $ 1.724544350544D-02 / + DATA (B(j,13),j=1,5) + $ / 5.315167977811D-03, + $ 4.047142377086D-03, + $ 4.112482394407D-03, + $ 3.595584899759D-03, + $ 4.256131351428D-03 / + DATA (B(j,14),j=1,6) + $ / 0.3650045807677255428654332201126546D-02, + $ 0.3604822601419881711314809131043636D-02, + $ 0.3576729661743367075562081375609260D-02, + $ 0.3449788424305883310013027710484181D-02, + $ 0.3108953122413675254845876980830533D-02, + $ 0.2352101413689164378792171183376706D-02 / + DATA (B(j,15),j=1,6) + $ / 1.621104600289D-03, + $ 3.005701484902D-03, + $ 2.990992529654D-03, + $ 2.982170644108D-03, + $ 2.721564237311D-03, + $ 3.033513795811D-03 / + DATA (B(j,16),j=1,7) + $ / 2.530403801186D-03, + $ 2.014279020919D-03, + $ 2.501725168403D-03, + $ 2.513267174598D-03, + $ 2.302694782227D-03, + $ 1.462495621595D-03, + $ 2.445373437313D-03 / + DATA (B(j,17),j=1,9) + $ / 1.871790639278D-03, + $ 1.858812585438D-03, + $ 1.852028828296D-03, + $ 1.846715956151D-03, + $ 1.818471778163D-03, + $ 1.749564657281D-03, + $ 1.617210647254D-03, + $ 1.384737234852D-03, + $ 9.764331165051D-04 / + DATA (B(j,18),j=1,10) + $ / 6.798123511051D-04, + $ 9.913184235295D-04, + $ 1.180207833239D-03, + $ 1.296599602081D-03, + $ 1.365871427428D-03, + $ 1.402988604775D-03, + $ 1.418645563596D-03, + $ 1.421376741852D-03, + $ 1.423996475491D-03, + $ 1.431554042179D-03 / + DATA (B(j,19),j=1,12) + $ / 4.948029341949D-04, + $ 7.357990109125D-04, + $ 8.889132771304D-04, + $ 9.888347838921D-04, + $ 1.053299681709D-03, + $ 1.092778807015D-03, + $ 1.114389394063D-03, + $ 1.123724788052D-03, + $ 1.125239325244D-03, + $ 1.126153271816D-03, + $ 1.130286931124D-03, + $ 1.134986534364D-03 / + DATA (B(j,20),j=1,13) + $ / 3.690421898018D-04, + $ 5.603990928681D-04, + $ 6.865297629283D-04, + $ 7.720338551146D-04, + $ 8.301545958895D-04, + $ 8.686692550180D-04, + $ 8.927076285847D-04, + $ 9.060820238568D-04, + $ 9.119777254941D-04, + $ 9.128720138604D-04, + $ 9.130714935692D-04, + $ 9.152873784554D-04, + $ 9.187436274322D-04 / + DATA (B(j,21),j=1,15) + $ / 2.841633806091D-04, + $ 4.374419127054D-04, + $ 5.417174740872D-04, + $ 6.148000891359D-04, + $ 6.664394485801D-04, + $ 7.025039356923D-04, + $ 7.268511789250D-04, + $ 7.422637534209D-04, + $ 7.509545035841D-04, + $ 7.548535057718D-04, + $ 7.554088969774D-04, + $ 7.553147174443D-04, + $ 7.564767653292D-04, + $ 7.587991808519D-04, + $ 7.608261832033D-04 / + DATA (B(j,22),j=1,16) + $ / 2.221207162188D-04, + $ 3.475784022287D-04, + $ 4.350742443590D-04, + $ 4.978569136522D-04, + $ 5.435036221998D-04, + $ 5.765913388220D-04, + $ 6.001200359226D-04, + $ 6.162178172718D-04, + $ 6.265218152438D-04, + $ 6.323987160974D-04, + $ 6.350767851541D-04, + $ 6.354362775297D-04, + $ 6.352302462706D-04, + $ 6.358117881418D-04, + $ 6.373101590310D-04, + $ 6.390428961369D-04 / + DATA (B(j,23),j=1,18) + $ / 1.778522133347D-04, + $ 2.811325405683D-04, + $ 3.548896312631D-04, + $ 4.090310897173D-04, + $ 4.493286134170D-04, + $ 4.793728447963D-04, + $ 5.015415319164D-04, + $ 5.175127372678D-04, + $ 5.285522262081D-04, + $ 5.356832703714D-04, + $ 5.397914736175D-04, + $ 5.416899441600D-04, + $ 5.419308476890D-04, + $ 5.416936902031D-04, + $ 5.419544338703D-04, + $ 5.428983656631D-04, + $ 5.442286500098D-04, + $ 5.452250345057D-04 / + DATA (B(j,24),j=1,19) + $ / 1.437832228980D-04, + $ 2.303572493578D-04, + $ 2.933110752447D-04, + $ 3.402905998360D-04, + $ 3.759138466870D-04, + $ 4.030638447900D-04, + $ 4.236591432242D-04, + $ 4.390522656947D-04, + $ 4.502523466626D-04, + $ 4.580577727784D-04, + $ 4.631391616616D-04, + $ 4.660928953699D-04, + $ 4.674751807937D-04, + $ 4.676414903933D-04, + $ 4.674086492348D-04, + $ 4.674928539483D-04, + $ 4.680748979686D-04, + $ 4.690449806389D-04, + $ 4.699877075861D-04 / + DATA (B(j,25),j=1,21) + $ / 1.185349192521D-04, + $ 1.913408643426D-04, + $ 2.452886577210D-04, + $ 2.862408183289D-04, + $ 3.178032258257D-04, + $ 3.422945667634D-04, + $ 3.612790520236D-04, + $ 3.758638229819D-04, + $ 3.868711798860D-04, + $ 3.949429933190D-04, + $ 4.006068107541D-04, + $ 4.043192149673D-04, + $ 4.064947495808D-04, + $ 4.075245619813D-04, + $ 4.076423540894D-04, + $ 4.074280862252D-04, + $ 4.074163756012D-04, + $ 4.077647795071D-04, + $ 4.084517552783D-04, + $ 4.092468459224D-04, + $ 4.097872687241D-04 / + DATA (B(j,26),j=1,22) + $ / 9.831528474386D-05, + $ 1.605023107954D-04, + $ 2.072200131464D-04, + $ 2.431297618814D-04, + $ 2.711819064497D-04, + $ 2.932762038321D-04, + $ 3.107032514197D-04, + $ 3.243808058921D-04, + $ 3.349899091374D-04, + $ 3.430580688505D-04, + $ 3.490124109290D-04, + $ 3.532148948562D-04, + $ 3.559862669063D-04, + $ 3.576224317551D-04, + $ 3.584050533086D-04, + $ 3.584903581373D-04, + $ 3.582991879041D-04, + $ 3.582371187963D-04, + $ 3.584353631122D-04, + $ 3.589120166518D-04, + $ 3.595445704532D-04, + $ 3.600943557111D-04 / + DATA (B(j,27),j=1,24) + $ / 8.288115128076D-05, + $ 1.360883192523D-04, + $ 1.766854454543D-04, + $ 2.083153161230D-04, + $ 2.333279544657D-04, + $ 2.532809539930D-04, + $ 2.692472184211D-04, + $ 2.819949946812D-04, + $ 2.920953593973D-04, + $ 2.999889782948D-04, + $ 3.060292120497D-04, + $ 3.105109167522D-04, + $ 3.136902387550D-04, + $ 3.157984652455D-04, + $ 3.170516518425D-04, + $ 3.176568425634D-04, + $ 3.177198411207D-04, + $ 3.175519492395D-04, + $ 3.174654952635D-04, + $ 3.175676415468D-04, + $ 3.178923417835D-04, + $ 3.183788287532D-04, + $ 3.188755151919D-04, + $ 3.191916889314D-04 / + DATA (B(j,28),j=1,25) + $ / 7.013149266674D-05, + $ 1.162798021957D-04, + $ 1.518728583972D-04, + $ 1.798796108217D-04, + $ 2.022593385973D-04, + $ 2.203093105575D-04, + $ 2.349294234300D-04, + $ 2.467682058747D-04, + $ 2.563092683572D-04, + $ 2.639253896763D-04, + $ 2.699137479265D-04, + $ 2.745196420167D-04, + $ 2.779529197398D-04, + $ 2.803996086684D-04, + $ 2.820302356716D-04, + $ 2.830056747491D-04, + $ 2.834808950777D-04, + $ 2.835282339079D-04, + $ 2.833819267066D-04, + $ 2.832858336907D-04, + $ 2.833268235451D-04, + $ 2.835432677029D-04, + $ 2.839091722743D-04, + $ 2.843308178876D-04, + $ 2.846703550534D-04 / + DATA (B(j,29),j=1,27) + $ / 6.018432961087D-05, + $ 1.002286583264D-04, + $ 1.315222931028D-04, + $ 1.564213746877D-04, + $ 1.765118841508D-04, + $ 1.928737099311D-04, + $ 2.062658534263D-04, + $ 2.172395445954D-04, + $ 2.262076188876D-04, + $ 2.334885699462D-04, + $ 2.393355273179D-04, + $ 2.439559200469D-04, + $ 2.475251866060D-04, + $ 2.501965558159D-04, + $ 2.521081407926D-04, + $ 2.533881002388D-04, + $ 2.541582900848D-04, + $ 2.545365737526D-04, + $ 2.545726993067D-04, + $ 2.544456197466D-04, + $ 2.543481596881D-04, + $ 2.543506451429D-04, + $ 2.544905675494D-04, + $ 2.547611407344D-04, + $ 2.551060375449D-04, + $ 2.554291933816D-04, + $ 2.556255710686D-04 / + DATA (B(j,30),j=1,28) + $ / 7.386265944002D-05, + $ 8.257977698542D-05, + $ 9.706044762058D-05, + $ 1.302393847117D-04, + $ 1.541957004601D-04, + $ 1.704459770092D-04, + $ 1.827374890943D-04, + $ 1.926360817436D-04, + $ 2.008010239495D-04, + $ 2.075635983209D-04, + $ 2.131306638691D-04, + $ 2.176562329937D-04, + $ 2.212682262991D-04, + $ 2.240799515669D-04, + $ 2.261959816188D-04, + $ 2.277156368809D-04, + $ 2.287351772128D-04, + $ 2.293490814084D-04, + $ 2.296505312376D-04, + $ 2.296793832319D-04, + $ 2.295785443843D-04, + $ 2.295017931529D-04, + $ 2.295059638185D-04, + $ 2.296232343237D-04, + $ 2.298530178741D-04, + $ 2.301579790281D-04, + $ 2.304690404997D-04, + $ 2.307027995907D-04 / + DATA (B(j,31),j=1,30) + $ / 5.011105657240D-05, + $ 5.942520409684D-05, + $ 9.564394826110D-05, + $ 1.185530657126D-04, + $ 1.364510114230D-04, + $ 1.505828825605D-04, + $ 1.619298749867D-04, + $ 1.712450504268D-04, + $ 1.789891098165D-04, + $ 1.854474955630D-04, + $ 1.908148636674D-04, + $ 1.952377405282D-04, + $ 1.988349254282D-04, + $ 2.017079807160D-04, + $ 2.039473082709D-04, + $ 2.056360279289D-04, + $ 2.068525823067D-04, + $ 2.076724877534D-04, + $ 2.081694278238D-04, + $ 2.084157631219D-04, + $ 2.084381531129D-04, + $ 2.083476277129D-04, + $ 2.082686194460D-04, + $ 2.082475686112D-04, + $ 2.083139860290D-04, + $ 2.084745561831D-04, + $ 2.087091313376D-04, + $ 2.089718413298D-04, + $ 2.092003303480D-04, + $ 2.093336148263D-04 / + DATA C(1,4) + $ / 0.2857142857142857142857142857142857D-01 / + DATA C(1,6) + $ / 1.652217099372D-02 / + DATA C(1,7) + $ / 0.1181230374690447536447922630736498D-01 / + DATA C(1,8) + $ / 0.9694996361663028329694996361663027D-02 / + DATA C(1,10) + $ / 5.477143385137D-03 / + DATA C(1,11) + $ / 0.5051846064614808475989311960063897D-02 / + DATA (C(j,12),j=1,2) + $ / 4.231083095357D-03, + $ 5.198069864064D-03 / + DATA C(1,13) + $ / 4.229582700647D-03 / + DATA (C(j,14),j=1,2) + $ / 0.3600820932216460272799206341770999D-02, + $ 0.2982344963171803851951110469245206D-02 / + DATA (C(j,15),j=1,2) + $ / 3.007949555219D-03, + $ 2.881964603055D-03 / + DATA (C(j,16),j=1,2) + $ / 2.417442375639D-03, + $ 1.910951282180D-03 / + DATA (C(j,17),j=1,3) + $ / 1.857161196774D-03, + $ 1.705153996396D-03, + $ 1.300321685886D-03 / + DATA (C(j,18),j=1,3) + $ / 9.254401499865D-04, + $ 1.250239995054D-03, + $ 1.394365843329D-03 / + DATA (C(j,19),j=1,4) + $ / 6.823367927110D-04, + $ 9.454158160447D-04, + $ 1.074429975386D-03, + $ 1.129300086569D-03 / + DATA (C(j,20),j=1,4) + $ / 5.176977312966D-04, + $ 7.331143682101D-04, + $ 8.463232836380D-04, + $ 9.031122694254D-04 / + DATA (C(j,21),j=1,5) + $ / 4.021680447875D-04, + $ 5.804871793946D-04, + $ 6.792151955945D-04, + $ 7.336741211286D-04, + $ 7.581866300990D-04 / + DATA (C(j,22),j=1,5) + $ / 3.186913449947D-04, + $ 4.678028558592D-04, + $ 5.538829697599D-04, + $ 6.044475907190D-04, + $ 6.313575103509D-04 / + DATA (C(j,23),j=1,6) + $ / 2.568002497729D-04, + $ 3.827211700292D-04, + $ 4.579491561918D-04, + $ 5.042003969084D-04, + $ 5.312708889976D-04, + $ 5.438401790747D-04 / + DATA (C(j,24),j=1,6) + $ / 2.099942281069D-04, + $ 3.172269150713D-04, + $ 3.832051358547D-04, + $ 4.252193818147D-04, + $ 4.513807963755D-04, + $ 4.657797469114D-04 / + DATA (C(j,25),j=1,7) + $ / 1.738986811745D-04, + $ 2.659616045280D-04, + $ 3.240596008172D-04, + $ 3.621195964433D-04, + $ 3.868838330761D-04, + $ 4.018911532693D-04, + $ 4.089929432983D-04 / + DATA (C(j,26),j=1,7) + $ / 1.456447096742D-04, + $ 2.252370188284D-04, + $ 2.766135443475D-04, + $ 3.110729491501D-04, + $ 3.342506712303D-04, + $ 3.491981834027D-04, + $ 3.576003604349D-04 / + DATA (C(j,27),j=1,8) + $ / 1.231779611745D-04, + $ 1.924661373840D-04, + $ 2.380881867403D-04, + $ 2.693100663038D-04, + $ 2.908673382834D-04, + $ 3.053914619382D-04, + $ 3.143916684148D-04, + $ 3.187042244055D-04 / + DATA (C(j,28),j=1,8) + $ / 1.051193406972D-04, + $ 1.657871838797D-04, + $ 2.064648113714D-04, + $ 2.347942745820D-04, + $ 2.547775326598D-04, + $ 2.686876684847D-04, + $ 2.778665755516D-04, + $ 2.830996616783D-04 / + DATA (C(j,29),j=1,9) + $ / 9.041339695118D-05, + $ 1.438426330079D-04, + $ 1.802523089821D-04, + $ 2.060052290565D-04, + $ 2.245002248967D-04, + $ 2.377059847731D-04, + $ 2.468118955883D-04, + $ 2.525410872967D-04, + $ 2.553101409933D-04 / + DATA (C(j,30),j=1,9) + $ / 9.312274696671D-05, + $ 1.199919385877D-04, + $ 1.598039138878D-04, + $ 1.822253763575D-04, + $ 1.988579593655D-04, + $ 2.112620102533D-04, + $ 2.201594887699D-04, + $ 2.261622590895D-04, + $ 2.296458453436D-04 / + DATA (C(j,31),j=1,10) + $ / 7.591708117365D-05, + $ 1.083383968169D-04, + $ 1.403019395293D-04, + $ 1.615970179286D-04, + $ 1.771144187505D-04, + $ 1.887760022988D-04, + $ 1.973474670768D-04, + $ 2.033787661235D-04, + $ 2.072343626517D-04, + $ 2.091177834227D-04 / + DATA D(1,9) + $ / 0.6991087353303262394171485080575989D-02 / + DATA D(1,10) + $ / 5.968383987681D-03 / + DATA D(1,11) + $ / 0.5530248916233093701297682691433032D-02 / + DATA D(1,12) + $ / 4.695720972569D-03 / + DATA (D(j,13),j=1,2) + $ / 4.080914225781D-03, + $ 4.071467593831D-03 / + DATA (D(j,14),j=1,2) + $ / 0.3571540554273387081232979203123946D-02, + $ 0.3392312205006170181978826539456957D-02 / + DATA (D(j,15),j=1,3) + $ / 2.958357626536D-03, + $ 3.036020026407D-03, + $ 2.832187403926D-03 / + DATA (D(j,16),j=1,4) + $ / 2.416930044325D-03, + $ 2.512236854563D-03, + $ 2.496644054553D-03, + $ 2.236607760438D-03 / + DATA (D(j,17),j=1,6) + $ / 1.842866472905D-03, + $ 1.802658934377D-03, + $ 1.849830560444D-03, + $ 1.713904507107D-03, + $ 1.555213603397D-03, + $ 1.802239128009D-03 / + DATA (D(j,18),j=1,9) + $ / 1.127089094672D-03, + $ 1.345753760911D-03, + $ 1.424957283317D-03, + $ 1.261523341238D-03, + $ 1.392547106053D-03, + $ 1.418761677878D-03, + $ 1.338366684480D-03, + $ 1.393700862676D-03, + $ 1.415914757467D-03 / + DATA (D(j,19),j=1,12) + $ / 8.436884500902D-04, + $ 1.075255720449D-03, + $ 1.108577236864D-03, + $ 9.566475323783D-04, + $ 1.080663250717D-03, + $ 1.126797131196D-03, + $ 1.022568715358D-03, + $ 1.108960267713D-03, + $ 1.122790653436D-03, + $ 1.032401847117D-03, + $ 1.107249382284D-03, + $ 1.121780048520D-03 / + DATA (D(j,20),j=1,16) + $ / 6.485778453163D-04, + $ 7.435030910982D-04, + $ 7.998527891839D-04, + $ 8.101731497468D-04, + $ 8.483389574594D-04, + $ 8.556299257312D-04, + $ 8.803208679738D-04, + $ 8.811048182426D-04, + $ 8.850282341265D-04, + $ 9.021342299041D-04, + $ 9.010091677105D-04, + $ 9.022692938427D-04, + $ 9.158016174693D-04, + $ 9.131578003189D-04, + $ 9.107813579483D-04, + $ 9.105760258970D-04 / + DATA (D(j,21),j=1,20) + $ / 7.538257859801D-04, + $ 7.483517247053D-04, + $ 7.371763661112D-04, + $ 7.183448895757D-04, + $ 6.895815529822D-04, + $ 6.480105801793D-04, + $ 5.897558896595D-04, + $ 5.095708849247D-04, + $ 7.536906428910D-04, + $ 7.472505965575D-04, + $ 7.343017132280D-04, + $ 7.130871582177D-04, + $ 6.817022032113D-04, + $ 6.380941145604D-04, + $ 7.550381377920D-04, + $ 7.478646640145D-04, + $ 7.335918720601D-04, + $ 7.110120527658D-04, + $ 7.571363978690D-04, + $ 7.489908329079D-04 / + DATA (D(j,22),j=1,25) + $ / 4.078626431856D-04, + $ 4.759933057813D-04, + $ 5.268151186413D-04, + $ 5.643048560507D-04, + $ 5.914501076613D-04, + $ 6.104561257874D-04, + $ 6.230252860708D-04, + $ 6.305618761761D-04, + $ 6.343092767598D-04, + $ 5.176268945738D-04, + $ 5.564840313314D-04, + $ 5.856426671039D-04, + $ 6.066386925777D-04, + $ 6.208824962234D-04, + $ 6.296314297823D-04, + $ 6.340423756792D-04, + $ 5.829627677107D-04, + $ 6.048693376081D-04, + $ 6.202362317732D-04, + $ 6.299005328404D-04, + $ 6.347722390609D-04, + $ 6.203778981239D-04, + $ 6.308414671240D-04, + $ 6.362706466959D-04, + $ 6.375414170333D-04 / + DATA (D(j,23),j=1,30) + $ / 3.316041873197D-04, + $ 3.899113567154D-04, + $ 4.343343327201D-04, + $ 4.679415262319D-04, + $ 4.930847981631D-04, + $ 5.115031867540D-04, + $ 5.245217148457D-04, + $ 5.332041499895D-04, + $ 5.384583126022D-04, + $ 5.411067210799D-04, + $ 4.259797391469D-04, + $ 4.604931368460D-04, + $ 4.871814878255D-04, + $ 5.072242910075D-04, + $ 5.217069845235D-04, + $ 5.315785966280D-04, + $ 5.376833708759D-04, + $ 5.408032092070D-04, + $ 4.842744917905D-04, + $ 5.048926076188D-04, + $ 5.202607980478D-04, + $ 5.309932388326D-04, + $ 5.377419770895D-04, + $ 5.411696331678D-04, + $ 5.197996293282D-04, + $ 5.311120836623D-04, + $ 5.384309319957D-04, + $ 5.421859504052D-04, + $ 5.390948355046D-04, + $ 5.433312705028D-04 / + DATA (D(j,24),j=1,36) + $ / 2.733362800523D-04, + $ 3.235485368464D-04, + $ 3.624908726013D-04, + $ 3.925540070713D-04, + $ 4.156129781116D-04, + $ 4.330644984623D-04, + $ 4.459677725921D-04, + $ 4.551593004457D-04, + $ 4.613341462750D-04, + $ 4.651019618270D-04, + $ 4.670249536101D-04, + $ 3.549555576442D-04, + $ 3.856108245249D-04, + $ 4.098622845757D-04, + $ 4.286328604269D-04, + $ 4.427802198994D-04, + $ 4.530473511489D-04, + $ 4.600805475703D-04, + $ 4.644599059958D-04, + $ 4.667274455713D-04, + $ 4.069360518020D-04, + $ 4.260442819919D-04, + $ 4.408678508029D-04, + $ 4.518748115549D-04, + $ 4.595564875375D-04, + $ 4.643988774316D-04, + $ 4.668827491647D-04, + $ 4.400541823742D-04, + $ 4.514512890194D-04, + $ 4.596198627348D-04, + $ 4.648659016802D-04, + $ 4.675502017158D-04, + $ 4.598494476456D-04, + $ 4.654916955152D-04, + $ 4.684709779505D-04, + $ 4.691445539107D-04 / + DATA (D(j,25),j=1,42) + $ / 2.279907527706D-04, + $ 2.715205490579D-04, + $ 3.057917896704D-04, + $ 3.326913052453D-04, + $ 3.537334711890D-04, + $ 3.700567500783D-04, + $ 3.825245372589D-04, + $ 3.918125171518D-04, + $ 3.984720419938D-04, + $ 4.029746003338D-04, + $ 4.057428632157D-04, + $ 4.071719274115D-04, + $ 2.990236950664D-04, + $ 3.262951734213D-04, + $ 3.482634608242D-04, + $ 3.656596681701D-04, + $ 3.791740467794D-04, + $ 3.894034450157D-04, + $ 3.968600245508D-04, + $ 4.019931351420D-04, + $ 4.052108801279D-04, + $ 4.068978613941D-04, + $ 3.454275351320D-04, + $ 3.629963537008D-04, + $ 3.770187233890D-04, + $ 3.878608613694D-04, + $ 3.959065270221D-04, + $ 4.015286975464D-04, + $ 4.050866785615D-04, + $ 4.069320185052D-04, + $ 3.760120964063D-04, + $ 3.870969564418D-04, + $ 3.955287790534D-04, + $ 4.015361911303D-04, + $ 4.053836986720D-04, + $ 4.073578673299D-04, + $ 3.954628379231D-04, + $ 4.017645508848D-04, + $ 4.059030348651D-04, + $ 4.080565809485D-04, + $ 4.063018753665D-04, + $ 4.087191292800D-04 / + DATA (D(j,26),j=1,49) + $ / 1.921921305789D-04, + $ 2.301458216496D-04, + $ 2.604248549523D-04, + $ 2.845275425871D-04, + $ 3.036870897975D-04, + $ 3.188414832298D-04, + $ 3.307046414722D-04, + $ 3.398330969031D-04, + $ 3.466757899705D-04, + $ 3.516095923230D-04, + $ 3.549645184048D-04, + $ 3.570415969441D-04, + $ 3.581251798496D-04, + $ 2.543491329913D-04, + $ 2.786711051331D-04, + $ 2.985552361084D-04, + $ 3.145867929154D-04, + $ 3.273290662068D-04, + $ 3.372705511944D-04, + $ 3.448274437852D-04, + $ 3.503592783049D-04, + $ 3.541854792663D-04, + $ 3.565995517909D-04, + $ 3.578802078303D-04, + $ 2.958644592861D-04, + $ 3.119548129117D-04, + $ 3.250745225006D-04, + $ 3.355153415935D-04, + $ 3.435847568549D-04, + $ 3.495786831622D-04, + $ 3.537767805535D-04, + $ 3.564459815421D-04, + $ 3.578464061225D-04, + $ 3.239748762836D-04, + $ 3.345491784174D-04, + $ 3.429126177302D-04, + $ 3.492420343097D-04, + $ 3.537399050235D-04, + $ 3.566209152659D-04, + $ 3.581084321920D-04, + $ 3.426522117592D-04, + $ 3.491848770121D-04, + $ 3.539318235231D-04, + $ 3.570231438459D-04, + $ 3.586207335052D-04, + $ 3.541196205164D-04, + $ 3.574296911574D-04, + $ 3.591993279819D-04, + $ 3.595855034662D-04 / + DATA (D(j,27),j=1,56) + $ / 1.635219535870D-04, + $ 1.968109917696D-04, + $ 2.236754342250D-04, + $ 2.453186687017D-04, + $ 2.627551791581D-04, + $ 2.767654860152D-04, + $ 2.879467027766D-04, + $ 2.967639918919D-04, + $ 3.035900684660D-04, + $ 3.087338237298D-04, + $ 3.124608838860D-04, + $ 3.150084294227D-04, + $ 3.165958398598D-04, + $ 3.174320440957D-04, + $ 2.182188909813D-04, + $ 2.399727933921D-04, + $ 2.579796133515D-04, + $ 2.727114052624D-04, + $ 2.846327656281D-04, + $ 2.941491102051D-04, + $ 3.016049492136D-04, + $ 3.072949726176D-04, + $ 3.114768142886D-04, + $ 3.143823673666D-04, + $ 3.162269764662D-04, + $ 3.172164663760D-04, + $ 2.554575398967D-04, + $ 2.701704069136D-04, + $ 2.823693413469D-04, + $ 2.922898463214D-04, + $ 3.001829062162D-04, + $ 3.062890864543D-04, + $ 3.108328279265D-04, + $ 3.140243146201D-04, + $ 3.160638030977D-04, + $ 3.171462882206D-04, + $ 2.812388416032D-04, + $ 2.912137500288D-04, + $ 2.993241256502D-04, + $ 3.057101738984D-04, + $ 3.105319326251D-04, + $ 3.139565514428D-04, + $ 3.161543006806D-04, + $ 3.172985960613D-04, + $ 2.989400336901D-04, + $ 3.054555883948D-04, + $ 3.104764960808D-04, + $ 3.141015825978D-04, + $ 3.164520621160D-04, + $ 3.176652305912D-04, + $ 3.105097161024D-04, + $ 3.143014117891D-04, + $ 3.168172866287D-04, + $ 3.181401865571D-04, + $ 3.170663659156D-04, + $ 3.185447944626D-04 / + DATA (D(j,28),j=1,64) + $ / 1.403063340168D-04, + $ 1.696504125939D-04, + $ 1.935787242745D-04, + $ 2.130614510522D-04, + $ 2.289381265931D-04, + $ 2.418630292816D-04, + $ 2.523400495631D-04, + $ 2.607623973450D-04, + $ 2.674441032689D-04, + $ 2.726432360343D-04, + $ 2.765787685925D-04, + $ 2.794428690642D-04, + $ 2.814099002063D-04, + $ 2.826429531579D-04, + $ 2.832983542551D-04, + $ 1.886695565285D-04, + $ 2.081867882748D-04, + $ 2.245148680601D-04, + $ 2.380370491512D-04, + $ 2.491398041852D-04, + $ 2.581632405881D-04, + $ 2.653965506227D-04, + $ 2.710857216747D-04, + $ 2.754434093904D-04, + $ 2.786579932519D-04, + $ 2.809011080679D-04, + $ 2.823336184561D-04, + $ 2.831101175806D-04, + $ 2.221679970355D-04, + $ 2.356185734271D-04, + $ 2.469228344806D-04, + $ 2.562726348642D-04, + $ 2.638756726753D-04, + $ 2.699311157391D-04, + $ 2.746233268404D-04, + $ 2.781225674455D-04, + $ 2.805881254046D-04, + $ 2.821719877005D-04, + $ 2.830222502333D-04, + $ 2.457995956745D-04, + $ 2.551474407504D-04, + $ 2.629065335195D-04, + $ 2.691900449925D-04, + $ 2.741275485754D-04, + $ 2.778530970123D-04, + $ 2.805010567647D-04, + $ 2.822055834031D-04, + $ 2.831016901243D-04, + $ 2.624474901132D-04, + $ 2.688034163039D-04, + $ 2.738932751288D-04, + $ 2.777944791243D-04, + $ 2.806011661661D-04, + $ 2.824181456597D-04, + $ 2.833585216578D-04, + $ 2.738165236963D-04, + $ 2.778365208203D-04, + $ 2.807852940419D-04, + $ 2.827245949675D-04, + $ 2.837342344830D-04, + $ 2.809233907611D-04, + $ 2.829930809743D-04, + $ 2.841097874111D-04, + $ 2.843455206009D-04 / + DATA (D(j,29),j=1,72) + $ / 1.212879733669D-04, + $ 1.472872881271D-04, + $ 1.686846601011D-04, + $ 1.862698414660D-04, + $ 2.007430956992D-04, + $ 2.126568125395D-04, + $ 2.224394603372D-04, + $ 2.304264522673D-04, + $ 2.368854288424D-04, + $ 2.420352089462D-04, + $ 2.460597113081D-04, + $ 2.491181912258D-04, + $ 2.513528194206D-04, + $ 2.528943096693D-04, + $ 2.538660368488D-04, + $ 2.543868648299D-04, + $ 1.642595537825D-04, + $ 1.818246659849D-04, + $ 1.966565649492D-04, + $ 2.090677905658D-04, + $ 2.193820409511D-04, + $ 2.278870827662D-04, + $ 2.348283192282D-04, + $ 2.404139755581D-04, + $ 2.448227407761D-04, + $ 2.482110455593D-04, + $ 2.507192397774D-04, + $ 2.524765968535D-04, + $ 2.536052388539D-04, + $ 2.542230588033D-04, + $ 1.944817013048D-04, + $ 2.067862362747D-04, + $ 2.172440734649D-04, + $ 2.260125991723D-04, + $ 2.332655008690D-04, + $ 2.391699681532D-04, + $ 2.438801528274D-04, + $ 2.475370504261D-04, + $ 2.502707235641D-04, + $ 2.522031701054D-04, + $ 2.534511269979D-04, + $ 2.541284914955D-04, + $ 2.161509250688D-04, + $ 2.248778513438D-04, + $ 2.322388803405D-04, + $ 2.383265471001D-04, + $ 2.432476675020D-04, + $ 2.471122223751D-04, + $ 2.500291752487D-04, + $ 2.521055942765D-04, + $ 2.534472785576D-04, + $ 2.541599713080D-04, + $ 2.317380975863D-04, + $ 2.378550733720D-04, + $ 2.428884456739D-04, + $ 2.469002655757D-04, + $ 2.499657574266D-04, + $ 2.521676168486D-04, + $ 2.535935662645D-04, + $ 2.543356743363D-04, + $ 2.427353285202D-04, + $ 2.468258039744D-04, + $ 2.500060956440D-04, + $ 2.523238365421D-04, + $ 2.538399260253D-04, + $ 2.546255927268D-04, + $ 2.500583360048D-04, + $ 2.524777638260D-04, + $ 2.540951193861D-04, + $ 2.549524085027D-04, + $ 2.542569507009D-04, + $ 2.552114127580D-04 / + DATA (D(j,30),j=1,81) + $ / 1.006006990267D-04, + $ 1.227676689636D-04, + $ 1.467864280270D-04, + $ 1.644178912101D-04, + $ 1.777664890719D-04, + $ 1.884825664517D-04, + $ 1.973269246454D-04, + $ 2.046767775855D-04, + $ 2.107600125918D-04, + $ 2.157416362267D-04, + $ 2.197557816921D-04, + $ 2.229192611835D-04, + $ 2.253385110213D-04, + $ 2.271137107549D-04, + $ 2.283414092918D-04, + $ 2.291161673130D-04, + $ 2.295313908577D-04, + $ 1.438204721359D-04, + $ 1.607738025495D-04, + $ 1.741483853528D-04, + $ 1.851918467519D-04, + $ 1.944628638071D-04, + $ 2.022495446275D-04, + $ 2.087462382439D-04, + $ 2.141074754818D-04, + $ 2.184640913748D-04, + $ 2.219309165220D-04, + $ 2.246123118341D-04, + $ 2.266062766915D-04, + $ 2.280072952231D-04, + $ 2.289082025203D-04, + $ 2.294012695120D-04, + $ 1.722434488737D-04, + $ 1.830237421455D-04, + $ 1.923855349998D-04, + $ 2.004067861936D-04, + $ 2.071817297354D-04, + $ 2.128250834102D-04, + $ 2.174513719440D-04, + $ 2.211661839150D-04, + $ 2.240665257813D-04, + $ 2.262439516633D-04, + $ 2.277874557232D-04, + $ 2.287854314455D-04, + $ 2.293268499616D-04, + $ 1.912628201530D-04, + $ 1.992499672239D-04, + $ 2.061275533454D-04, + $ 2.119318215969D-04, + $ 2.167416581883D-04, + $ 2.206430730517D-04, + $ 2.237186938700D-04, + $ 2.260480075033D-04, + $ 2.277098884559D-04, + $ 2.287845715110D-04, + $ 2.293547268236D-04, + $ 2.056073839853D-04, + $ 2.114235865832D-04, + $ 2.163175629771D-04, + $ 2.203392158112D-04, + $ 2.235473176848D-04, + $ 2.260024141501D-04, + $ 2.277675929329D-04, + $ 2.289102112285D-04, + $ 2.295027954625D-04, + $ 2.161281589880D-04, + $ 2.201980477395D-04, + $ 2.234952066593D-04, + $ 2.260540098521D-04, + $ 2.279157981900D-04, + $ 2.291296918566D-04, + $ 2.297533752537D-04, + $ 2.234927356466D-04, + $ 2.261288012985D-04, + $ 2.280818160924D-04, + $ 2.293773295180D-04, + $ 2.300528767339D-04, + $ 2.281893855066D-04, + $ 2.295720444841D-04, + $ 2.303227649027D-04, + $ 2.304831913227D-04 / + DATA (D(j,31),j=1,90) + $ / 9.316684484676D-05, + $ 1.116193688683D-04, + $ 1.298623551559D-04, + $ 1.450236832456D-04, + $ 1.572719958150D-04, + $ 1.673234785867D-04, + $ 1.756860118725D-04, + $ 1.826776290439D-04, + $ 1.885116347993D-04, + $ 1.933457860171D-04, + $ 1.973060671902D-04, + $ 2.004987099616D-04, + $ 2.030170909281D-04, + $ 2.049461460119D-04, + $ 2.063653565200D-04, + $ 2.073507927381D-04, + $ 2.079764593256D-04, + $ 2.083150534969D-04, + $ 1.262715121591D-04, + $ 1.414386128546D-04, + $ 1.538740401314D-04, + $ 1.642434942331D-04, + $ 1.729790609237D-04, + $ 1.803505190261D-04, + $ 1.865475350080D-04, + $ 1.917182669679D-04, + $ 1.959851709034D-04, + $ 1.994529548118D-04, + $ 2.022138911147D-04, + $ 2.043518024209D-04, + $ 2.059450313018D-04, + $ 2.070685715318D-04, + $ 2.077955310694D-04, + $ 2.081980387825D-04, + $ 1.521318610378D-04, + $ 1.622772720186D-04, + $ 1.710498139421D-04, + $ 1.785911149449D-04, + $ 1.850125313688D-04, + $ 1.904229703933D-04, + $ 1.949259956122D-04, + $ 1.986161545364D-04, + $ 2.015790585641D-04, + $ 2.038934198707D-04, + $ 2.056334060538D-04, + $ 2.068705959462D-04, + $ 2.076753906106D-04, + $ 2.081179391735D-04, + $ 1.700345216229D-04, + $ 1.774906779990D-04, + $ 1.839659377003D-04, + $ 1.894987462975D-04, + $ 1.941548809453D-04, + $ 1.980078427252D-04, + $ 2.011296284744D-04, + $ 2.035888456967D-04, + $ 2.054516325352D-04, + $ 2.067831033093D-04, + $ 2.076485320285D-04, + $ 2.081141439525D-04, + $ 1.834383015469D-04, + $ 1.889540591778D-04, + $ 1.936677023597D-04, + $ 1.976176495067D-04, + $ 2.008536004561D-04, + $ 2.034280351712D-04, + $ 2.053944466028D-04, + $ 2.068077642882D-04, + $ 2.077250949662D-04, + $ 2.082062440705D-04, + $ 1.934374486547D-04, + $ 1.974107010484D-04, + $ 2.007129290389D-04, + $ 2.033736947471D-04, + $ 2.054287125902D-04, + $ 2.069184936819D-04, + $ 2.078883689809D-04, + $ 2.083886366116D-04, + $ 2.006593275471D-04, + $ 2.033728426135D-04, + $ 2.055008781378D-04, + $ 2.070651783519D-04, + $ 2.080953335094D-04, + $ 2.086284998989D-04, + $ 2.055549387645D-04, + $ 2.071871850268D-04, + $ 2.082856600432D-04, + $ 2.088705858819D-04, + $ 2.083995867536D-04, + $ 2.090509712890D-04 / + DATA T(1,5) + $ / 0.8181818181818181818181818181818182D+00 / + DATA T(1,6) + $ / 5.384615384615D-01 / + DATA (T(j,7),j=1,2) + $ / 0.7267874717859796704165651796807734D+00, + $ 0.3574502702964873455463383113455231D-01 / + DATA (T(j,8),j=1,3) + $ / 0.9314644031018293303224605304347612D+00, + $ 0.6868596818254220443790837922198527D+00, + $ 0.4663755190139312657722805586200992D-01 / + DATA (T(j,9),j=1,3) + $ / 0.9504078675707184426846816938057038D+00, + $ 0.6513939748997038757216963384831041D+00, + $ 0.8485503877651973792968123939638137D-01 / + DATA (T(j,10),j=1,3) + $ / 8.698222012652D-01, + $ 9.047678687586D-02, + $ 6.269402078753D-01 / + DATA (T(j,11),j=1,4) + $ / 0.6044957060804405750447234008859784D+00, + $ 0.8326728518658924875446408288494448D+00, + $ 0.9871975115337203051106504992126892D-01, + $ 0.9662345478896000071306665444955087D+00 / + DATA (T(j,12),j=1,5) + $ / 5.964306905285D-01, + $ 8.729497118674D-01, + $ 2.505958825460D-02, + $ 1.321218431685D-01, + $ 9.967380323911D-01 / + DATA (T(j,13),j=1,5) + $ / 8.944445076768D-03, + $ 9.794958119190D-01, + $ 5.680244067058D-01, + $ 7.851702770073D-01, + $ 1.234223195584D-01 / + DATA (T(j,14),j=1,6) + $ / 0.1670263452397559527894216050589478D-01, + $ 0.1376663615296993115240758106286862D+00, + $ 0.5527209402223704445129158599195226D+00, + $ 0.7528054592119942363108765505527784D+00, + $ 0.9014635004999312167764818860483434D+00, + $ 0.9814976282327591629905429780488349D+00 / + DATA (T(j,15),j=1,6) + $ / 5.945454002988D-04, + $ 5.402203703739D-01, + $ 9.256923187369D-01, + $ 3.940277055740D-02, + $ 7.396031168627D-01, + $ 1.553935521769D-01 / + DATA (T(j,16),j=1,7) + $ / 4.521867205820D-02, + $ 9.369991395852D-01, + $ 5.169847287690D-01, + $ 1.662296171180D-01, + $ 8.362605039899D-01, + $ 9.885448198023D-01, + $ 6.915326150206D-01 / + DATA (T(j,17),j=1,9) + $ / 8.499071157004D-03, + $ 7.309241451287D-02, + $ 1.878129101389D-01, + $ 4.910765962311D-01, + $ 6.445470516095D-01, + $ 7.798280397298D-01, + $ 8.862606172978D-01, + $ 9.574242528006D-01, + $ 9.925701118262D-01 / + DATA (T(j,18),j=1,10) + $ / 9.948240702572D-01, + $ 9.698305546361D-01, + $ 9.178342725293D-01, + $ 8.378069504767D-01, + $ 7.325681115488D-01, + $ 6.078094018620D-01, + $ 4.714805969587D-01, + $ 2.045860732578D-01, + $ 9.766956607994D-02, + $ 2.564988139436D-02 / + DATA (T(j,19),j=1,12) + $ / 9.963140927997D-01, + $ 9.778900314101D-01, + $ 9.387482592540D-01, + $ 8.772246746062D-01, + $ 7.943585455913D-01, + $ 6.932173043199D-01, + $ 5.784863558578D-01, + $ 4.561664690726D-01, + $ 2.179572378274D-01, + $ 1.187585706869D-01, + $ 4.492456248653D-02, + $ 5.130054883064D-03 / + DATA (T(j,20),j=1,13) + $ / 9.972432661185D-01, + $ 9.832918591320D-01, + $ 9.531160121935D-01, + $ 9.048709833904D-01, + $ 8.387022528272D-01, + $ 7.562335791706D-01, + $ 6.602760541723D-01, + $ 5.546219829385D-01, + $ 4.438787406634D-01, + $ 2.288483219154D-01, + $ 1.367748697861D-01, + $ 6.379865467742D-02, + $ 1.646761018263D-02 / + DATA (T(j,21),j=1,15) + $ / 9.979143363622D-01, + $ 9.870821836647D-01, + $ 9.633179740561D-01, + $ 9.248083829058D-01, + $ 8.712377374379D-01, + $ 8.034039688176D-01, + $ 7.230000705325D-01, + $ 6.324652733202D-01, + $ 5.348679212522D-01, + $ 4.338074285872D-01, + $ 2.378818655932D-01, + $ 1.522209580433D-01, + $ 8.135995958492D-02, + $ 3.030214670670D-02, + $ 3.428730539433D-03 / + DATA (T(j,22),j=1,16) + $ / 9.983630237732D-01, + $ 9.897967765640D-01, + $ 9.707567294011D-01, + $ 9.395403165681D-01, + $ 8.956079044098D-01, + $ 8.392773092892D-01, + $ 7.715552422867D-01, + $ 6.940259701211D-01, + $ 6.087661259570D-01, + $ 5.182736014735D-01, + $ 4.254066807507D-01, + $ 2.454906841822D-01, + $ 1.655487699575D-01, + $ 9.735443800302D-02, + $ 4.479239363750D-02, + $ 1.145055801973D-02 / + DATA (T(j,23),j=1,18) + $ / 9.987088311582D-01, + $ 9.918097335390D-01, + $ 9.763133912218D-01, + $ 9.506598648348D-01, + $ 9.142055993122D-01, + $ 8.669840470267D-01, + $ 8.095706458671D-01, + $ 7.429956925500D-01, + $ 6.686799248593D-01, + $ 5.883818288042D-01, + $ 5.041522063181D-01, + $ 4.182948169149D-01, + $ 2.519844086135D-01, + $ 1.771329459727D-01, + $ 1.117955803473D-01, + $ 5.903799592608D-02, + $ 2.178402115775D-02, + $ 2.451992741952D-03 / + DATA (T(j,24),j=1,19) + $ / 9.989511574237D-01, + $ 9.933204314931D-01, + $ 9.805438375683D-01, + $ 9.592074206194D-01, + $ 9.286352335000D-01, + $ 8.886937286268D-01, + $ 8.396828658238D-01, + $ 7.822665416652D-01, + $ 7.174223164050D-01, + $ 6.464012407924D-01, + $ 5.706935220112D-01, + $ 4.919983454862D-01, + $ 4.121975439374D-01, + $ 2.575898262997D-01, + $ 1.872756753374D-01, + $ 1.247993889749D-01, + $ 7.261765804749D-02, + $ 3.312137636649D-02, + $ 8.417236823685D-03 / + DATA (T(j,25),j=1,21) + $ / 9.991466902796D-01, + $ 9.944855716680D-01, + $ 9.838234632028D-01, + $ 9.658860301760D-01, + $ 9.399993362096D-01, + $ 9.059324566313D-01, + $ 8.638072400724D-01, + $ 8.140411316291D-01, + $ 7.573067651943D-01, + $ 6.945004533758D-01, + $ 6.267156986940D-01, + $ 5.552199298894D-01, + $ 4.814338171375D-01, + $ 4.069131375459D-01, + $ 2.624764638322D-01, + $ 1.962187240256D-01, + $ 1.365132316146D-01, + $ 8.535636714473D-02, + $ 4.471687997947D-02, + $ 1.640096644131D-02, + $ 1.840045732112D-03 / + DATA (T(j,26),j=1,22) + $ / 9.992885189311D-01, + $ 9.953915828809D-01, + $ 9.864042520502D-01, + $ 9.711803952656D-01, + $ 9.490701367673D-01, + $ 9.197889831582D-01, + $ 8.833431744669D-01, + $ 8.399822331704D-01, + $ 7.901657878871D-01, + $ 7.345382177116D-01, + $ 6.739077428303D-01, + $ 6.092282380884D-01, + $ 5.415829837787D-01, + $ 4.721701147608D-01, + $ 4.022898149774D-01, + $ 2.667735478837D-01, + $ 2.041557967831D-01, + $ 1.470855543505D-01, + $ 9.720572111608D-02, + $ 5.615089573608D-02, + $ 2.546158767116D-02, + $ 6.445772776470D-03 / + DATA (T(j,27),j=1,24) + $ / 9.994073420632D-01, + $ 9.961123635856D-01, + $ 9.884641646671D-01, + $ 9.754318546307D-01, + $ 9.563979477620D-01, + $ 9.310509351946D-01, + $ 8.993221205576D-01, + $ 8.613454952223D-01, + $ 8.174299827256D-01, + $ 7.680385836004D-01, + $ 7.137714962065D-01, + $ 6.553516400609D-01, + $ 5.936117744635D-01, + $ 5.294828626297D-01, + $ 4.639836046032D-01, + $ 3.982111946111D-01, + $ 2.705812594860D-01, + $ 2.112428880825D-01, + $ 1.566537859453D-01, + $ 1.081813807457D-01, + $ 6.719449812399D-02, + $ 3.500727310883D-02, + $ 1.278754655613D-02, + $ 1.431532615062D-03 / + DATA (T(j,28),j=1,25) + $ / 9.994957296951D-01, + $ 9.966883326993D-01, + $ 9.901273792384D-01, + $ 9.788850620034D-01, + $ 9.623820738475D-01, + $ 9.402970090556D-01, + $ 9.125132210219D-01, + $ 8.790847449096D-01, + $ 8.402127700885D-01, + $ 7.962281729465D-01, + $ 7.475776139174D-01, + $ 6.948117962164D-01, + $ 6.385751144432D-01, + $ 5.795963018215D-01, + $ 5.186799213004D-01, + $ 4.566986870675D-01, + $ 3.945866619032D-01, + $ 2.739783714988D-01, + $ 2.176064094230D-01, + $ 1.653403045802D-01, + $ 1.183298694951D-01, + $ 7.773098966363D-02, + $ 4.466798054937D-02, + $ 2.017192474359D-02, + $ 5.093170320417D-03 / + DATA (T(j,29),j=1,27) + $ / 9.995719869698D-01, + $ 9.971576600497D-01, + $ 9.914856530125D-01, + $ 9.817192019176D-01, + $ 9.673171465902D-01, + $ 9.479584191551D-01, + $ 9.234964401467D-01, + $ 8.939297875880D-01, + $ 8.593820093211D-01, + $ 8.200867705184D-01, + $ 7.763761965513D-01, + $ 7.286711767696D-01, + $ 6.774729173835D-01, + $ 6.233553492065D-01, + $ 5.669581965619D-01, + $ 5.089806415522D-01, + $ 4.501755926475D-01, + $ 3.913445897309D-01, + $ 2.770276760350D-01, + $ 2.233495933818D-01, + $ 1.732520657435D-01, + $ 1.277108517503D-01, + $ 8.770980631329D-02, + $ 5.421499904934D-02, + $ 2.813244088150D-02, + $ 1.024671752643D-02, + $ 1.145352939215D-03 / + DATA (T(j,30),j=1,28) + $ / 9.989088743731D-01, + $ 9.962102993790D-01, + $ 9.917073393298D-01, + $ 9.837857998144D-01, + $ 9.713578655261D-01, + $ 9.542943302118D-01, + $ 9.325833410688D-01, + $ 9.062484628251D-01, + $ 8.753788404822D-01, + $ 8.401387270275D-01, + $ 8.007691896507D-01, + $ 7.575863866917D-01, + $ 7.109771117958D-01, + $ 6.613927586878D-01, + $ 6.093429313239D-01, + $ 5.553894658468D-01, + $ 5.001411954546D-01, + $ 4.442495352346D-01, + $ 3.884048318656D-01, + $ 2.797945214663D-01, + $ 2.285783449909D-01, + $ 1.805015075513D-01, + $ 1.364013229385D-01, + $ 9.712474739578D-02, + $ 6.350928432754D-02, + $ 3.635223834954D-02, + $ 1.636637023025D-02, + $ 4.124219647904D-03 / + DATA (T(j,31),j=1,30) + $ / 9.989389971209D-01, + $ 9.971766766769D-01, + $ 9.932210680541D-01, + $ 9.858774895456D-01, + $ 9.747806632069D-01, + $ 9.596648815557D-01, + $ 9.403911068227D-01, + $ 9.169172562840D-01, + $ 8.892819476318D-01, + $ 8.575967401872D-01, + $ 8.220412264133D-01, + $ 7.828591148688D-01, + $ 7.403541401852D-01, + $ 6.948854820542D-01, + $ 6.468629521677D-01, + $ 5.967423110144D-01, + $ 5.450209571873D-01, + $ 4.922340999168D-01, + $ 4.389514398161D-01, + $ 3.857743293940D-01, + $ 2.822860252999D-01, + $ 2.333147039100D-01, + $ 1.871234394479D-01, + $ 1.444334326043D-01, + $ 1.059750740154D-01, + $ 7.247445615933D-02, + $ 4.463176524570D-02, + $ 2.308962476585D-02, + $ 8.391804478010D-03, + $ 9.369553857840D-04 / + DATA V(1,4) + $ / 0.1666666666666666666666666666666667D+00 / + DATA V(1,6) + $ / 9.230769230769D-02 / + DATA V(1,7) + $ / 0.1204416503145642398318048555452501D+00 / + DATA V(1,8) + $ / 0.1764705882352941176470588235294118D+00 / + DATA V(1,10) + $ / 6.365787851418D-02 / + DATA V(1,11) + $ / 0.1052631578947368421052631578947368D+00 / + DATA (V(j,12),j=1,2) + $ / 2.241341590046D-01, + $ 1.099238120099D-01 / + DATA V(1,13) + $ / 2.000000000000D-01 / + DATA (V(j,14),j=1,2) + $ / 0.2200933352980389748216629900695196D+00, + $ 0.6502727546573595539690409835852654D-01 / + DATA (V(j,15),j=1,2) + $ / 3.596678808994D-02, + $ 1.235753913415D-01 / + DATA (V(j,16),j=1,2) + $ / 1.729411966868D-01, + $ 4.225960886354D-02 / + DATA (V(j,17),j=1,3) + $ / 2.341637248281D-01, + $ 1.324832577106D-01, + $ 2.886374289129D-02 / + DATA (V(j,18),j=1,3) + $ / 2.049596194512D-02, + $ 1.017279217943D-01, + $ 2.036494032906D-01 / + DATA (V(j,19),j=1,4) + $ / 1.506003684306D-02, + $ 7.900261587096D-02, + $ 1.719853162752D-01, + $ 2.402517778395D-01 / + DATA (V(j,20),j=1,4) + $ / 1.136778532904D-02, + $ 6.222580539453D-02, + $ 1.438013602306D-01, + $ 2.193546368679D-01 / + DATA (V(j,21),j=1,5) + $ / 8.792305136058D-03, + $ 4.971678820596D-02, + $ 1.201226934566D-01, + $ 1.951924693303D-01, + $ 2.434103199047D-01 / + DATA (V(j,22),j=1,5) + $ / 6.931793227193D-03, + $ 4.026427008452D-02, + $ 1.006819324273D-01, + $ 1.715283250278D-01, + $ 2.283217882342D-01 / + DATA (V(j,23),j=1,6) + $ / 5.562298027336D-03, + $ 3.301750717439D-02, + $ 8.484487674046D-02, + $ 1.499289480598D-01, + $ 2.096284259050D-01, + $ 2.452528151503D-01 / + DATA (V(j,24),j=1,6) + $ / 4.527512122481D-03, + $ 2.738571398249D-02, + $ 7.194952348015D-02, + $ 1.308804820581D-01, + $ 1.901173218958D-01, + $ 2.338875244150D-01 / + DATA (V(j,25),j=1,7) + $ / 3.735731627098D-03, + $ 2.295065371381D-02, + $ 6.141474850635D-02, + $ 1.143710170433D-01, + $ 1.712602015573D-01, + $ 2.191192968469D-01, + $ 2.464193318434D-01 / + DATA (V(j,26),j=1,7) + $ / 3.116273598316D-03, + $ 1.941497033326D-02, + $ 5.276331953232D-02, + $ 1.001818528622D-01, + $ 1.537591183728D-01, + $ 2.029938620347D-01, + $ 2.375671797837D-01 / + DATA (V(j,27),j=1,8) + $ / 2.627354807340D-03, + $ 1.656404962657D-02, + $ 4.561529461067D-02, + $ 8.802772716296D-02, + $ 1.378848650427D-01, + $ 1.867467953993D-01, + $ 2.256575483187D-01, + $ 2.472038245618D-01 / + DATA (V(j,28),j=1,8) + $ / 2.234379876148D-03, + $ 1.424164112360D-02, + $ 3.967132880296D-02, + $ 7.762064909155D-02, + $ 1.236763051633D-01, + $ 1.710839672061D-01, + $ 2.122104053470D-01, + $ 2.401218883665D-01 / + DATA (V(j,29),j=1,9) + $ / 1.916700390235D-03, + $ 1.233154590152D-02, + $ 3.469648744997D-02, + $ 6.869692636008D-02, + $ 1.110548585874D-01, + $ 1.563770127604D-01, + $ 1.982285434988D-01, + $ 2.303388051827D-01, + $ 2.477564007390D-01 / + DATA (V(j,30),j=1,9) + $ / 2.107454820561D-03, + $ 1.088942170828D-02, + $ 3.046535458878D-02, + $ 6.119972584598D-02, + $ 1.000546103726D-01, + $ 1.428810642988D-01, + $ 1.843759068265D-01, + $ 2.190027552378D-01, + $ 2.419625136213D-01 / + DATA (V(j,31),j=1,10) + $ / 1.472668018817D-03, + $ 9.580098341667D-03, + $ 2.697810682946D-02, + $ 5.452463307450D-02, + $ 9.015147652015D-02, + $ 1.304525252537D-01, + $ 1.709907279210D-01, + $ 2.069300631045D-01, + $ 2.337963076105D-01, + $ 2.481595158077D-01 / + DATA (S(i,1,9),i=1,2) + $ / 1.403553811713D-01, + $ 4.493328323270D-01 / + DATA (S(i,1,10),i=1,2) + $ / 4.990453161796D-01, + $ 1.446630744325D-01 / + DATA (S(i,1,11),i=1,2) + $ / 1.590417105384D-01, + $ 8.360360154825D-01 / + DATA (S(i,1,12),i=1,2) + $ / 2.272181808998D-01, + $ 4.864661535887D-01 / + DATA ((S(i,j,13),i=1,2),j=1,2) + $ / 3.233484542693D-01, + $ 1.153112011010D-01, + $ 2.314790158713D-01, + $ 5.244939240922D-01 / + DATA ((S(i,j,14),i=1,2),j=1,2) + $ / 2.510034751770D-01, + $ 8.000727494074D-01, + $ 1.233548532583D-01, + $ 4.127724083169D-01 / + DATA ((S(i,j,15),i=1,2),j=1,3) + $ / 2.899558825500D-01, + $ 7.934537856582D-01, + $ 9.684121455104D-02, + $ 8.280801506687D-01, + $ 1.833434647042D-01, + $ 9.074658265305D-01 / + DATA ((S(i,j,16),i=1,2),j=1,4) + $ / 2.054823696403D-01, + $ 8.689460322872D-01, + $ 5.905157048925D-01, + $ 7.999278543857D-01, + $ 5.550152361077D-01, + $ 7.717462626916D-01, + $ 9.371809858554D-01, + $ 3.344363145343D-01 / + DATA ((S(i,j,17),i=1,2),j=1,6) + $ / 5.610263808622D-01, + $ 3.518280927734D-01, + $ 4.742392842552D-01, + $ 2.634716655938D-01, + $ 5.984126497885D-01, + $ 1.816640840360D-01, + $ 3.791035407696D-01, + $ 1.720795225657D-01, + $ 2.778673190586D-01, + $ 8.213021581933D-02, + $ 5.033564271075D-01, + $ 8.999205842075D-02 / + DATA ((S(i,j,18),i=1,2),j=1,9) + $ / 6.944024393349D-02, + $ 2.355187894242D-01, + $ 2.269004109529D-01, + $ 4.102182474046D-01, + $ 8.025574607775D-02, + $ 6.214302417482D-01, + $ 1.467999527897D-01, + $ 3.245284345717D-01, + $ 1.571507769825D-01, + $ 5.224482189697D-01, + $ 2.365702993157D-01, + $ 6.017546634090D-01, + $ 7.714815866766D-02, + $ 4.346575516141D-01, + $ 3.062936666211D-01, + $ 4.908826589038D-01, + $ 3.822477379525D-01, + $ 5.648768149100D-01 / + DATA ((S(i,j,19),i=1,2),j=1,12) + $ / 5.974048614181D-02, + $ 2.029128752778D-01, + $ 1.375760408474D-01, + $ 4.602621942484D-01, + $ 3.391016526336D-01, + $ 5.030673999662D-01, + $ 1.271675191440D-01, + $ 2.817606422442D-01, + $ 2.693120740414D-01, + $ 4.331561291720D-01, + $ 1.419786452602D-01, + $ 6.256167358581D-01, + $ 6.709284600738D-02, + $ 3.798395216859D-01, + $ 7.057738183256D-02, + $ 5.517505421424D-01, + $ 2.783888477882D-01, + $ 6.029619156159D-01, + $ 1.979578938917D-01, + $ 3.589606329589D-01, + $ 2.087307061103D-01, + $ 5.348666438135D-01, + $ 4.055122137873D-01, + $ 5.674997546074D-01 / + DATA ((S(i,j,20),i=1,2),j=1,16) + $ / 9.827986018264D-01, + $ 1.771774022615D-01, + $ 9.624249230326D-01, + $ 2.475716463426D-01, + $ 9.402007994129D-01, + $ 3.354616289066D-01, + $ 9.320822040143D-01, + $ 3.173615246612D-01, + $ 9.043674199393D-01, + $ 4.090268427085D-01, + $ 8.912407560075D-01, + $ 3.854291150669D-01, + $ 8.676435628463D-01, + $ 4.932221184851D-01, + $ 8.581979986042D-01, + $ 4.785320675922D-01, + $ 8.396753624050D-01, + $ 4.507422593157D-01, + $ 8.165288564022D-01, + $ 5.632123020762D-01, + $ 8.015469370784D-01, + $ 5.434303569694D-01, + $ 7.773563069070D-01, + $ 5.123518486420D-01, + $ 7.661621213900D-01, + $ 6.394279634749D-01, + $ 7.553584143534D-01, + $ 6.269805509024D-01, + $ 7.344305757560D-01, + $ 6.031161693096D-01, + $ 7.043837184022D-01, + $ 5.693702498468D-01 / + DATA ((S(i,j,21),i=1,2),j=1,20) + $ / 5.707522908892D-01, + $ 4.387028039890D-01, + $ 5.196463388403D-01, + $ 3.858908414763D-01, + $ 4.646337531215D-01, + $ 3.301937372344D-01, + $ 4.063901697558D-01, + $ 2.725423573564D-01, + $ 3.456329466643D-01, + $ 2.139510237495D-01, + $ 2.831395121050D-01, + $ 1.555922309787D-01, + $ 2.197682022925D-01, + $ 9.892878979686D-02, + $ 1.564696098650D-01, + $ 4.598642910676D-02, + $ 6.027356673721D-01, + $ 3.376625140173D-01, + $ 5.496032320255D-01, + $ 2.822301309728D-01, + $ 4.921707755235D-01, + $ 2.248632342593D-01, + $ 4.309422998598D-01, + $ 1.666224723456D-01, + $ 3.664108182314D-01, + $ 1.086964901822D-01, + $ 2.990189057758D-01, + $ 5.251989784120D-02, + $ 6.268724013145D-01, + $ 2.297523657550D-01, + $ 5.707324144835D-01, + $ 1.723080607094D-01, + $ 5.096360901960D-01, + $ 1.140238465391D-01, + $ 4.438729938312D-01, + $ 5.611522095883D-02, + $ 6.419978471082D-01, + $ 1.164174423141D-01, + $ 5.817218061803D-01, + $ 5.797589531445D-02 / + DATA ((S(i,j,22),i=1,2),j=1,25) + $ / 1.394983311832D-01, + $ 4.097581162050D-02, + $ 1.967999180485D-01, + $ 8.851987391293D-02, + $ 2.546183732549D-01, + $ 1.397680182970D-01, + $ 3.121281074714D-01, + $ 1.929452542227D-01, + $ 3.685981078502D-01, + $ 2.467898337062D-01, + $ 4.233760321548D-01, + $ 3.003104124785D-01, + $ 4.758671236059D-01, + $ 3.526684328175D-01, + $ 5.255178579796D-01, + $ 4.031134861146D-01, + $ 5.718025633735D-01, + $ 4.509426448342D-01, + $ 2.686927772723D-01, + $ 4.711322502423D-02, + $ 3.306006819905D-01, + $ 9.784487303943D-02, + $ 3.904906850595D-01, + $ 1.505395810025D-01, + $ 4.479957951904D-01, + $ 2.039728156296D-01, + $ 5.027076848920D-01, + $ 2.571529941121D-01, + $ 5.542087392260D-01, + $ 3.092191375816D-01, + $ 6.020850887375D-01, + $ 3.593807506130D-01, + $ 4.019851409180D-01, + $ 5.063389934379D-02, + $ 4.635614567450D-01, + $ 1.032422269161D-01, + $ 5.215860931592D-01, + $ 1.566322094006D-01, + $ 5.758202499099D-01, + $ 2.098082827491D-01, + $ 6.259893683877D-01, + $ 2.618824114553D-01, + $ 5.313795124812D-01, + $ 5.263245019339D-02, + $ 5.893317955932D-01, + $ 1.061059730982D-01, + $ 6.426246321216D-01, + $ 1.594171564034D-01, + $ 6.511904367376D-01, + $ 5.354789536566D-02 / + DATA ((S(i,j,23),i=1,2),j=1,30) + $ / 1.253901572367D-01, + $ 3.681917226440D-02, + $ 1.775721510384D-01, + $ 7.982487607213D-02, + $ 2.305693358216D-01, + $ 1.264640966592D-01, + $ 2.836502845992D-01, + $ 1.751585683419D-01, + $ 3.361794746233D-01, + $ 2.247995907633D-01, + $ 3.875979172265D-01, + $ 2.745299257422D-01, + $ 4.374019316999D-01, + $ 3.236373482441D-01, + $ 4.851275843340D-01, + $ 3.714967859437D-01, + $ 5.303391803807D-01, + $ 4.175353646322D-01, + $ 5.726197380596D-01, + $ 4.612084406355D-01, + $ 2.431520732565D-01, + $ 4.258040133044D-02, + $ 3.002096800896D-01, + $ 8.869424306723D-02, + $ 3.558554457457D-01, + $ 1.368811706511D-01, + $ 4.097782537049D-01, + $ 1.860739985015D-01, + $ 4.616337666067D-01, + $ 2.354235077396D-01, + $ 5.110707008418D-01, + $ 2.842074921347D-01, + $ 5.577415286164D-01, + $ 3.317784414984D-01, + $ 6.013060431367D-01, + $ 3.775299002041D-01, + $ 3.661596767262D-01, + $ 4.599367887165D-02, + $ 4.237633153507D-01, + $ 9.404893773654D-02, + $ 4.786328454658D-01, + $ 1.431377109092D-01, + $ 5.305702076790D-01, + $ 1.924186388844D-01, + $ 5.793436224232D-01, + $ 2.411590944775D-01, + $ 6.247069017095D-01, + $ 2.886871491584D-01, + $ 4.874315552535D-01, + $ 4.804978774953D-02, + $ 5.427337322059D-01, + $ 9.716857199367D-02, + $ 5.943493747247D-01, + $ 1.465205839795D-01, + $ 6.421314033565D-01, + $ 1.953579449804D-01, + $ 6.020628374714D-01, + $ 4.916375015738D-02, + $ 6.529222529857D-01, + $ 9.861621540127D-02 / + DATA ((S(i,j,24),i=1,2),j=1,36) + $ / 1.135081039844D-01, + $ 3.331954884663D-02, + $ 1.612866626099D-01, + $ 7.247167465437D-02, + $ 2.100786550168D-01, + $ 1.151539110850D-01, + $ 2.592282009460D-01, + $ 1.599491097144D-01, + $ 3.081740561320D-01, + $ 2.058699956028D-01, + $ 3.564289781578D-01, + $ 2.521624953503D-01, + $ 4.035587288241D-01, + $ 2.982090785798D-01, + $ 4.491671196374D-01, + $ 3.434762087236D-01, + $ 4.928854782917D-01, + $ 3.874831357203D-01, + $ 5.343646791959D-01, + $ 4.297814821747D-01, + $ 5.732683216531D-01, + $ 4.699402260944D-01, + $ 2.214131583219D-01, + $ 3.873602040644D-02, + $ 2.741796504750D-01, + $ 8.089496256902D-02, + $ 3.259797439149D-01, + $ 1.251732177621D-01, + $ 3.765441148827D-01, + $ 1.706260286403D-01, + $ 4.255773574531D-01, + $ 2.165115147300D-01, + $ 4.727795117058D-01, + $ 2.622089812225D-01, + $ 5.178546895819D-01, + $ 3.071721431296D-01, + $ 5.605141192097D-01, + $ 3.508998998801D-01, + $ 6.004763319353D-01, + $ 3.929160876167D-01, + $ 3.352842634947D-01, + $ 4.202563457288D-02, + $ 3.891971629815D-01, + $ 8.614309758871D-02, + $ 4.409875565542D-01, + $ 1.314500879380D-01, + $ 4.904893058592D-01, + $ 1.772189657384D-01, + $ 5.375056138770D-01, + $ 2.228277110050D-01, + $ 5.818255708670D-01, + $ 2.677179935014D-01, + $ 6.232334858145D-01, + $ 3.113675035544D-01, + $ 4.489485354492D-01, + $ 4.409162378368D-02, + $ 5.015136875933D-01, + $ 8.939009917748D-02, + $ 5.511300550513D-01, + $ 1.351806029383D-01, + $ 5.976720409858D-01, + $ 1.808370355053D-01, + $ 6.409956378989D-01, + $ 2.257852192302D-01, + $ 5.581222330828D-01, + $ 4.532173421637D-02, + $ 6.074705984162D-01, + $ 9.117488031840D-02, + $ 6.532272537379D-01, + $ 1.369294213140D-01, + $ 6.594761494500D-01, + $ 4.589901487276D-02 / + DATA ((S(i,j,25),i=1,2),j=1,42) + $ / 1.033958573552D-01, + $ 3.034544009064D-02, + $ 1.473521412414D-01, + $ 6.618803044247D-02, + $ 1.924552158706D-01, + $ 1.054431128988D-01, + $ 2.381094362890D-01, + $ 1.468263551239D-01, + $ 2.838121707937D-01, + $ 1.894486108188D-01, + $ 3.291323133373D-01, + $ 2.326374238762D-01, + $ 3.736896978741D-01, + $ 2.758485808486D-01, + $ 4.171406040760D-01, + $ 3.186179331997D-01, + $ 4.591677985257D-01, + $ 3.605329796304D-01, + $ 4.994733831718D-01, + $ 4.012147253587D-01, + $ 5.377731830445D-01, + $ 4.403050025571D-01, + $ 5.737917830001D-01, + $ 4.774565904277D-01, + $ 2.027323586271D-01, + $ 3.544122504976D-02, + $ 2.516942375187D-01, + $ 7.418304388646D-02, + $ 3.000227995257D-01, + $ 1.150502745727D-01, + $ 3.474806691046D-01, + $ 1.571963371209D-01, + $ 3.938103180359D-01, + $ 1.999631877247D-01, + $ 4.387519590456D-01, + $ 2.428073457847D-01, + $ 4.820503960078D-01, + $ 2.852575132906D-01, + $ 5.234573778475D-01, + $ 3.268884208675D-01, + $ 5.627318647235D-01, + $ 3.673033321676D-01, + $ 5.996390607157D-01, + $ 4.061211551830D-01, + $ 3.084780753792D-01, + $ 3.860125523100D-02, + $ 3.589988275920D-01, + $ 7.928938987105D-02, + $ 4.078628415882D-01, + $ 1.212614643030D-01, + $ 4.549287258890D-01, + $ 1.638770827383D-01, + $ 5.000278512957D-01, + $ 2.065965798260D-01, + $ 5.429785044928D-01, + $ 2.489436378852D-01, + $ 5.835939850492D-01, + $ 2.904811368947D-01, + $ 6.216870353445D-01, + $ 3.307941957667D-01, + $ 4.151104662709D-01, + $ 4.064829146053D-02, + $ 4.649804275009D-01, + $ 8.258424547295D-02, + $ 5.124695757010D-01, + $ 1.251841962027D-01, + $ 5.574711100606D-01, + $ 1.679107505976D-01, + $ 5.998597333287D-01, + $ 2.102805057359D-01, + $ 6.395007148517D-01, + $ 2.518418087774D-01, + $ 5.188456224746D-01, + $ 4.194321676078D-02, + $ 5.664190707943D-01, + $ 8.457661551921D-02, + $ 6.110464353283D-01, + $ 1.273652932519D-01, + $ 6.526430302052D-01, + $ 1.698173239076D-01, + $ 6.167551880378D-01, + $ 4.266398851549D-02, + $ 6.607195418355D-01, + $ 8.551925814238D-02 / + DATA ((S(i,j,26),i=1,2),j=1,49) + $ / 9.469870086838D-02, + $ 2.778748387309D-02, + $ 1.353170300568D-01, + $ 6.076569878628D-02, + $ 1.771679481726D-01, + $ 9.703072762711D-02, + $ 2.197066664232D-01, + $ 1.354112458525D-01, + $ 2.624783557375D-01, + $ 1.750996479744D-01, + $ 3.050969521214D-01, + $ 2.154896907450D-01, + $ 3.472252637196D-01, + $ 2.560954625740D-01, + $ 3.885610219026D-01, + $ 2.965070050624D-01, + $ 4.288273776063D-01, + $ 3.363641488734D-01, + $ 4.677662471303D-01, + $ 3.753400029837D-01, + $ 5.051333589553D-01, + $ 4.131297522144D-01, + $ 5.406942145810D-01, + $ 4.494423776082D-01, + $ 5.742204122576D-01, + $ 4.839938958842D-01, + $ 1.865407027225D-01, + $ 3.259144851071D-02, + $ 2.321186453689D-01, + $ 6.835679505297D-02, + $ 2.773159142524D-01, + $ 1.062284864452D-01, + $ 3.219200192237D-01, + $ 1.454404409323D-01, + $ 3.657032593944D-01, + $ 1.854018282583D-01, + $ 4.084376778364D-01, + $ 2.256297412015D-01, + $ 4.499004945751D-01, + $ 2.657104425001D-01, + $ 4.898758141326D-01, + $ 3.052755487632D-01, + $ 5.281547442266D-01, + $ 3.439863920645D-01, + $ 5.645346989814D-01, + $ 3.815229456122D-01, + $ 5.988181252160D-01, + $ 4.175752420967D-01, + $ 2.850425424472D-01, + $ 3.562149509863D-02, + $ 3.324619433028D-01, + $ 7.330318886871D-02, + $ 3.785848333076D-01, + $ 1.123226296008D-01, + $ 4.232891028562D-01, + $ 1.521084193338D-01, + $ 4.664287050830D-01, + $ 1.921844459224D-01, + $ 5.078458493736D-01, + $ 2.321360989678D-01, + $ 5.473779816204D-01, + $ 2.715886486361D-01, + $ 5.848617133811D-01, + $ 3.101924707571D-01, + $ 6.201348281585D-01, + $ 3.476121052891D-01, + $ 3.852191185388D-01, + $ 3.763224880035D-02, + $ 4.325025061073D-01, + $ 7.659581935637D-02, + $ 4.778486229734D-01, + $ 1.163381306084D-01, + $ 5.211663693009D-01, + $ 1.563890598753D-01, + $ 5.623469504854D-01, + $ 1.963320810149D-01, + $ 6.012718188659D-01, + $ 2.357847407259D-01, + $ 6.378179206390D-01, + $ 2.743846121244D-01, + $ 4.836936460215D-01, + $ 3.895902610739D-02, + $ 5.293792562684D-01, + $ 7.871246819313D-02, + $ 5.726281253100D-01, + $ 1.187963808203D-01, + $ 6.133658776169D-01, + $ 1.587914708062D-01, + $ 6.515085491865D-01, + $ 1.983058575228D-01, + $ 5.778692716065D-01, + $ 3.977209689792D-02, + $ 6.207904288086D-01, + $ 7.990157592981D-02, + $ 6.608688171047D-01, + $ 1.199671308754D-01, + $ 6.656263089489D-01, + $ 4.015955957806D-02 / + DATA ((S(i,j,27),i=1,2),j=1,56) + $ / 8.715738780836D-02, 2.557175233368D-02, + $ 1.248383123134D-01, 5.604823383377D-02, + $ 1.638062693383D-01, 8.968568601901D-02, + $ 2.035586203373D-01, 1.254086651976D-01, + $ 2.436798975294D-01, 1.624780150162D-01, + $ 2.838207507774D-01, 2.003422342683D-01, + $ 3.236787502218D-01, 2.385628026255D-01, + $ 3.629849554841D-01, 2.767731148784D-01, + $ 4.014948081992D-01, 3.146542308245D-01, + $ 4.389818379260D-01, 3.519196415895D-01, + $ 4.752331143674D-01, 3.883050984024D-01, + $ 5.100457318374D-01, 4.235613423909D-01, + $ 5.432238388955D-01, 4.574484717196D-01, + $ 5.745758685072D-01, 4.897311639256D-01, + $ 1.723981437593D-01, 3.010630597881D-02, + $ 2.149553257845D-01, 6.326031554205D-02, + $ 2.573256081247D-01, 9.848566980259D-02, + $ 2.993163751238D-01, 1.350835952384D-01, + $ 3.407238005148D-01, 1.725184055442D-01, + $ 3.813454978483D-01, 2.103559279731D-01, + $ 4.209848104423D-01, 2.482278774555D-01, + $ 4.594519699996D-01, 2.858099509983D-01, + $ 4.965640166186D-01, 3.228075659915D-01, + $ 5.321441655572D-01, 3.589459907204D-01, + $ 5.660208438582D-01, 3.939630088864D-01, + $ 5.980264315964D-01, 4.276029922949D-01, + $ 2.644215852351D-01, 3.300939429073D-02, + $ 3.090113743443D-01, 6.803887650079D-02, + $ 3.525871079198D-01, 1.044326136207D-01, + $ 3.950418005354D-01, 1.416751597518D-01, + $ 4.362475663430D-01, 1.793408610505D-01, + $ 4.760661812146D-01, 2.170630750176D-01, + $ 5.143551042512D-01, 2.545145157816D-01, + $ 5.509709026936D-01, 2.913940101707D-01, + $ 5.857711030329D-01, 3.274169910911D-01, + $ 6.186149917404D-01, 3.623081329317D-01, + $ 3.586894569557D-01, 3.497354386450D-02, + $ 4.035266610019D-01, 7.129736739757D-02, + $ 4.467775312333D-01, 1.084758620193D-01, + $ 4.883638346609D-01, 1.460915689242D-01, + $ 5.281908348435D-01, 1.837790832370D-01, + $ 5.661542687149D-01, 2.212075390874D-01, + $ 6.021450102031D-01, 2.580682841161D-01, + $ 6.360520783610D-01, 2.940656362094D-01, + $ 4.521611065087D-01, 3.631055365867D-02, + $ 4.959365651561D-01, 7.348318468484D-02, + $ 5.376815804038D-01, 1.111087643813D-01, + $ 5.773314480244D-01, 1.488226085145D-01, + $ 6.148113245575D-01, 1.862892274135D-01, + $ 6.500407462842D-01, 2.231909701714D-01, + $ 5.425151448707D-01, 3.718201306119D-02, + $ 5.841860556908D-01, 7.483616335067D-02, + $ 6.234632186851D-01, 1.125990834266D-01, + $ 6.602934551849D-01, 1.501303813158D-01, + $ 6.278573968375D-01, 3.767559930246D-02, + $ 6.665611711265D-01, 7.548443301360D-02 / + DATA ((S(i,j,28),i=1,2),j=1,64) + $ / 8.056516651369D-02, 2.363454684003D-02, + $ 1.156476077139D-01, 5.191291632546D-02, + $ 1.520473382760D-01, 8.322715736995D-02, + $ 1.892986699746D-01, 1.165855667994D-01, + $ 2.270194446778D-01, 1.513077167410D-01, + $ 2.648908185093D-01, 1.868882025808D-01, + $ 3.026389259574D-01, 2.229277629776D-01, + $ 3.400220296151D-01, 2.590951840746D-01, + $ 3.768217953336D-01, 2.951047291751D-01, + $ 4.128372900922D-01, 3.307019714170D-01, + $ 4.478807131816D-01, 3.656544101088D-01, + $ 4.817742034089D-01, 3.997448951940D-01, + $ 5.143472814653D-01, 4.327667110812D-01, + $ 5.454346213906D-01, 4.645196123532D-01, + $ 5.748739313170D-01, 4.948063555703D-01, + $ 1.599598738286D-01, 2.792357590049D-02, + $ 1.998097412501D-01, 5.877141038139D-02, + $ 2.396228952566D-01, 9.164573914691D-02, + $ 2.792228341098D-01, 1.259049641963D-01, + $ 3.184251107547D-01, 1.610594823401D-01, + $ 3.570481164426D-01, 1.967151653461D-01, + $ 3.949164710492D-01, 2.325404606175D-01, + $ 4.318617293971D-01, 2.682461141151D-01, + $ 4.677221009932D-01, 3.035720116012D-01, + $ 5.023417939271D-01, 3.382781859197D-01, + $ 5.355701836636D-01, 3.721383065626D-01, + $ 5.672608451329D-01, 4.049346360466D-01, + $ 5.972704202540D-01, 4.364538098634D-01, + $ 2.461687022334D-01, 3.070423166833D-02, + $ 2.881774566287D-01, 6.338034669282D-02, + $ 3.293963604117D-01, 9.742862487068D-02, + $ 3.697303822241D-01, 1.323799532282D-01, + $ 4.090663023135D-01, 1.678497018129D-01, + $ 4.472819355412D-01, 2.035095105326D-01, + $ 4.842513377231D-01, 2.390692566672D-01, + $ 5.198477629963D-01, 2.742649818076D-01, + $ 5.539453011883D-01, 3.088503806580D-01, + $ 5.864196762401D-01, 3.425904245907D-01, + $ 6.171484466668D-01, 3.752562294789D-01, + $ 3.350337830566D-01, 3.261589934635D-02, + $ 3.775773224758D-01, 6.658438928082D-02, + $ 4.188155229849D-01, 1.014565797158D-01, + $ 4.586805892009D-01, 1.368573320844D-01, + $ 4.970895714224D-01, 1.724614851952D-01, + $ 5.339505133961D-01, 2.079779381416D-01, + $ 5.691665792531D-01, 2.431385788322D-01, + $ 6.026387682680D-01, 2.776901883050D-01, + $ 6.342676150163D-01, 3.113881356387D-01, + $ 4.237951119537D-01, 3.394877848664D-02, + $ 4.656918683235D-01, 6.880219556291D-02, + $ 5.058857069186D-01, 1.041946859722D-01, + $ 5.443204666714D-01, 1.398039738736D-01, + $ 5.809298813760D-01, 1.753373381196D-01, + $ 6.156416039447D-01, 2.105215793514D-01, + $ 6.483801351067D-01, 2.450953312157D-01, + $ 5.103616577252D-01, 3.485560643801D-02, + $ 5.506738792581D-01, 7.026308631512D-02, + $ 5.889573040995D-01, 1.059035061296D-01, + $ 6.251641589517D-01, 1.414823925236D-01, + $ 6.592414921570D-01, 1.767207908215D-01, + $ 5.930314017533D-01, 3.542189339562D-02, + $ 6.309812253390D-01, 7.109574040370D-02, + $ 6.666296011353D-01, 1.067259792283D-01, + $ 6.703715271050D-01, 3.569455268821D-02 / + DATA ((S(i,j,29),i=1,2),j=1,72) + $ / 7.476563943166D-02, 2.193168509461D-02, + $ 1.075341482001D-01, 4.826419281534D-02, + $ 1.416344885203D-01, 7.751191883576D-02, + $ 1.766325315389D-01, 1.087558139248D-01, + $ 2.121744174482D-01, 1.413661374253D-01, + $ 2.479669443408D-01, 1.748768214259D-01, + $ 2.837600452294D-01, 2.089216406612D-01, + $ 3.193344933194D-01, 2.431987685546D-01, + $ 3.544935442439D-01, 2.774497054378D-01, + $ 3.890571932288D-01, 3.114460356157D-01, + $ 4.228581214259D-01, 3.449806851913D-01, + $ 4.557387211304D-01, 3.778618641248D-01, + $ 4.875487950542D-01, 4.099086391699D-01, + $ 5.181436529963D-01, 4.409474925854D-01, + $ 5.473824095601D-01, 4.708094517711D-01, + $ 5.751263398976D-01, 4.993275140355D-01, + $ 1.489515746840D-01, 2.599381993267D-02, + $ 1.863656444352D-01, 5.479286532462D-02, + $ 2.238602880356D-01, 8.556763251425D-02, + $ 2.612723375728D-01, 1.177257802267D-01, + $ 2.984332990206D-01, 1.508168456193D-01, + $ 3.351786584663D-01, 1.844801892178D-01, + $ 3.713505522209D-01, 2.184145236088D-01, + $ 4.067981098955D-01, 2.523590641486D-01, + $ 4.413769993688D-01, 2.860812976901D-01, + $ 4.749487182516D-01, 3.193686757809D-01, + $ 5.073798105075D-01, 3.520226949548D-01, + $ 5.385410448879D-01, 3.838544395668D-01, + $ 5.683065353671D-01, 4.146810037641D-01, + $ 5.965527620664D-01, 4.443224094681D-01, + $ 2.299227700856D-01, 2.865757664058D-02, + $ 2.695752998553D-01, 5.923421684486D-02, + $ 3.086178716611D-01, 9.117817776058D-02, + $ 3.469649871659D-01, 1.240593814083D-01, + $ 3.845153566320D-01, 1.575272058259D-01, + $ 4.211600033403D-01, 1.912845163525D-01, + $ 4.567867834330D-01, 2.250710177858D-01, + $ 4.912829319232D-01, 2.586521303441D-01, + $ 5.245364793304D-01, 2.918112242865D-01, + $ 5.564369788916D-01, 3.243439239068D-01, + $ 5.868757697775D-01, 3.560536787835D-01, + $ 6.157458853520D-01, 3.867480821243D-01, + $ 3.138461110672D-01, 3.051374637507D-02, + $ 3.542495872051D-01, 6.237111233731D-02, + $ 3.935751553120D-01, 9.516223952402D-02, + $ 4.317634668111D-01, 1.285467341509D-01, + $ 4.687413842251D-01, 1.622318931656D-01, + $ 5.044274237060D-01, 1.959581153836D-01, + $ 5.387354077926D-01, 2.294888081184D-01, + $ 5.715768898356D-01, 2.626031152714D-01, + $ 6.028627200136D-01, 2.950904075287D-01, + $ 6.325039812653D-01, 3.267458451113D-01, + $ 3.981986708423D-01, 3.183291458750D-02, + $ 4.382791182133D-01, 6.459548193881D-02, + $ 4.769233057218D-01, 9.795757037088D-02, + $ 5.140823911194D-01, 1.316307235127D-01, + $ 5.496977833863D-01, 1.653556486359D-01, + $ 5.837047306513D-01, 1.988931724127D-01, + $ 6.160349566927D-01, 2.320174581439D-01, + $ 6.466185353209D-01, 2.645106562169D-01, + $ 4.810835158795D-01, 3.275917807744D-02, + $ 5.199925041324D-01, 6.612546183967D-02, + $ 5.571717692207D-01, 9.981498331474D-02, + $ 5.925789250836D-01, 1.335687001410D-01, + $ 6.261658523860D-01, 1.671444402896D-01, + $ 6.578811126669D-01, 2.003106382156D-01, + $ 5.609624612998D-01, 3.337500940231D-02, + $ 5.979959659985D-01, 6.708750335902D-02, + $ 6.330523711054D-01, 1.008792126425D-01, + $ 6.660960998104D-01, 1.345050343172D-01, + $ 6.365384364586D-01, 3.372799460737D-02, + $ 6.710994302899D-01, 6.755249309678D-02 / + DATA ((S(i,j,30),i=1,2),j=1,81) + $ / 7.345133894143D-02, 2.177844081486D-02, + $ 1.009859834045D-01, 4.590362185775D-02, + $ 1.324289619749D-01, 7.255063095691D-02, + $ 1.654272109607D-01, 1.017825451961D-01, + $ 1.990767186776D-01, 1.325652320980D-01, + $ 2.330125945523D-01, 1.642765374497D-01, + $ 2.670080611108D-01, 1.965360374338D-01, + $ 3.008753376294D-01, 2.290726770542D-01, + $ 3.344475596168D-01, 2.616645495371D-01, + $ 3.675709724071D-01, 2.941150728843D-01, + $ 4.001000887588D-01, 3.262440400919D-01, + $ 4.318956350436D-01, 3.578835350612D-01, + $ 4.628239056796D-01, 3.888751854044D-01, + $ 4.927563229774D-01, 4.190678003223D-01, + $ 5.215687136708D-01, 4.483151836884D-01, + $ 5.491402346985D-01, 4.764740676088D-01, + $ 5.753520160126D-01, 5.034021310998D-01, + $ 1.388326356418D-01, 2.435436510373D-02, + $ 1.743686900537D-01, 5.118897057343D-02, + $ 2.099737037950D-01, 8.014695048540D-02, + $ 2.454492590909D-01, 1.105117874156D-01, + $ 2.807219257864D-01, 1.417950531571D-01, + $ 3.156842271976D-01, 1.736604945720D-01, + $ 3.502090945178D-01, 2.058466324694D-01, + $ 3.841684849520D-01, 2.381284261196D-01, + $ 4.174372367906D-01, 2.703031270423D-01, + $ 4.498926465012D-01, 3.021845683091D-01, + $ 4.814146229808D-01, 3.335993355166D-01, + $ 5.118863625735D-01, 3.643833735518D-01, + $ 5.411947455119D-01, 3.943789541958D-01, + $ 5.692301500357D-01, 4.234320144404D-01, + $ 5.958857204140D-01, 4.513897947419D-01, + $ 2.156270284786D-01, 2.681225755444D-02, + $ 2.532385054910D-01, 5.557495747806D-02, + $ 2.902564617772D-01, 8.569368062950D-02, + $ 3.266979823143D-01, 1.167367450324D-01, + $ 3.625039627494D-01, 1.483861994003D-01, + $ 3.975838937549D-01, 1.803821503011D-01, + $ 4.318396099010D-01, 2.124962965666D-01, + $ 4.651706555733D-01, 2.445221837806D-01, + $ 4.974752649621D-01, 2.762701224323D-01, + $ 5.286517579628D-01, 3.075627775211D-01, + $ 5.586001195732D-01, 3.382311089827D-01, + $ 5.872229902021D-01, 3.681108834741D-01, + $ 6.144258616235D-01, 3.970397446873D-01, + $ 2.951676508065D-01, 2.867499538750D-02, + $ 3.335085485473D-01, 5.867879341904D-02, + $ 3.709561760636D-01, 8.961099205022D-02, + $ 4.074722861667D-01, 1.211627927626D-01, + $ 4.429923648839D-01, 1.530748903555D-01, + $ 4.774428052722D-01, 1.851176436722D-01, + $ 5.107446539536D-01, 2.170829107658D-01, + $ 5.428151370543D-01, 2.487786689026D-01, + $ 5.735699292557D-01, 2.800239952795D-01, + $ 6.029253794563D-01, 3.106445702878D-01, + $ 6.307998987073D-01, 3.404689500841D-01, + $ 3.752652273693D-01, 2.997145098184D-02, + $ 4.135383879344D-01, 6.086725898678D-02, + $ 4.506113885154D-01, 9.238849548436D-02, + $ 4.864401554606D-01, 1.242786603852D-01, + $ 5.209708076612D-01, 1.563086731483D-01, + $ 5.541422135830D-01, 1.882696509389D-01, + $ 5.858880915114D-01, 2.199672979126D-01, + $ 6.161399390603D-01, 2.512165482925D-01, + $ 6.448296482255D-01, 2.818368701872D-01, + $ 4.544796274918D-01, 3.088970405060D-02, + $ 4.919389072147D-01, 6.240947677637D-02, + $ 5.279313026985D-01, 9.430706144280D-02, + $ 5.624169925571D-01, 1.263547818770D-01, + $ 5.953484627093D-01, 1.583430788823D-01, + $ 6.266730715339D-01, 1.900748462556D-01, + $ 6.563363204279D-01, 2.213599519593D-01, + $ 5.314574716586D-01, 3.152508811515D-02, + $ 5.674614932298D-01, 6.343865291466D-02, + $ 6.017706004970D-01, 9.551503504224D-02, + $ 6.343471270264D-01, 1.275440099801D-01, + $ 6.651494599128D-01, 1.593252037672D-01, + $ 6.050184986006D-01, 3.192538338496D-02, + $ 6.390163550880D-01, 6.402824353962D-02, + $ 6.711199107088D-01, 9.609805077003D-02, + $ 6.741354429572D-01, 3.211853196273D-02 / + DATA ((S(i,j,31),i=1,2),j=1,90) + $ / 6.655644120217D-02, 1.936508874588D-02, + $ 9.446246161270D-02, 4.252442002116D-02, + $ 1.242651925453D-01, 6.806529315354D-02, + $ 1.553438064847D-01, 9.560957491205D-02, + $ 1.871137110543D-01, 1.245931657453D-01, + $ 2.192612628836D-01, 1.545385828779D-01, + $ 2.515682807207D-01, 1.851004249723D-01, + $ 2.838535866287D-01, 2.160182608272D-01, + $ 3.159578817529D-01, 2.470799012277D-01, + $ 3.477370882791D-01, 2.781014208986D-01, + $ 3.790576960891D-01, 3.089172523516D-01, + $ 4.097938317810D-01, 3.393750055472D-01, + $ 4.398256572860D-01, 3.693322470988D-01, + $ 4.690384114718D-01, 3.986541005610D-01, + $ 4.973216048301D-01, 4.272112491409D-01, + $ 5.245681526132D-01, 4.548781735310D-01, + $ 5.506733911804D-01, 4.815315355023D-01, + $ 5.755339829522D-01, 5.070486445802D-01, + $ 1.305472386056D-01, 2.284970375722D-02, + $ 1.637327908216D-01, 4.812254338288D-02, + $ 1.972734634150D-01, 7.531734457512D-02, + $ 2.308694653110D-01, 1.039043639882D-01, + $ 2.643899218338D-01, 1.334526587118D-01, + $ 2.977171599622D-01, 1.636414868936D-01, + $ 3.307293903032D-01, 1.942195406167D-01, + $ 3.633069198219D-01, 2.249752879944D-01, + $ 3.953346955923D-01, 2.557218821820D-01, + $ 4.267018394185D-01, 2.862897925213D-01, + $ 4.573009622572D-01, 3.165224536637D-01, + $ 4.870279559856D-01, 3.462730221636D-01, + $ 5.157819581450D-01, 3.754016870283D-01, + $ 5.434651666465D-01, 4.037733784994D-01, + $ 5.699823887765D-01, 4.312557784139D-01, + $ 5.952403350948D-01, 4.577175367122D-01, + $ 2.025152599210D-01, 2.520253617720D-02, + $ 2.381066653274D-01, 5.223254506119D-02, + $ 2.732823383652D-01, 8.060669688589D-02, + $ 3.080137692611D-01, 1.099335754081D-01, + $ 3.422405614588D-01, 1.399120955960D-01, + $ 3.758808773890D-01, 1.702977801652D-01, + $ 4.088458383439D-01, 2.008799256602D-01, + $ 4.410450550841D-01, 2.314703052181D-01, + $ 4.723879420561D-01, 2.618972111376D-01, + $ 5.027843561874D-01, 2.920013195600D-01, + $ 5.321453674452D-01, 3.216322555191D-01, + $ 5.603839113834D-01, 3.506456615934D-01, + $ 5.874150706875D-01, 3.789007181306D-01, + $ 6.131559381660D-01, 4.062580170573D-01, + $ 2.778497016395D-01, 2.696271276876D-02, + $ 3.143733562262D-01, 5.523469316960D-02, + $ 3.501485810262D-01, 8.445193201626D-02, + $ 3.851430322304D-01, 1.143263119336D-01, + $ 4.193013979470D-01, 1.446177898344D-01, + $ 4.525585960459D-01, 1.751165438438D-01, + $ 4.848447779623D-01, 2.056338306746D-01, + $ 5.160871208277D-01, 2.359965487229D-01, + $ 5.462112185697D-01, 2.660430223139D-01, + $ 5.751425068102D-01, 2.956193664498D-01, + $ 6.028073872854D-01, 3.245763905313D-01, + $ 6.291338275278D-01, 3.527670026207D-01, + $ 3.541797528439D-01, 2.823853479436D-02, + $ 3.908234972075D-01, 5.741296374713D-02, + $ 4.264408450108D-01, 8.724646633650D-02, + $ 4.609949666553D-01, 1.175034422916D-01, + $ 4.944389496536D-01, 1.479755652628D-01, + $ 5.267194884346D-01, 1.784740659484D-01, + $ 5.577787810221D-01, 2.088245700431D-01, + $ 5.875563763537D-01, 2.388628136571D-01, + $ 6.159910016391D-01, 2.684308928769D-01, + $ 6.430219602956D-01, 2.973740761960D-01, + $ 4.300647036214D-01, 2.916399920494D-02, + $ 4.661486308936D-01, 5.898803024756D-02, + $ 5.009658555287D-01, 8.924162698525D-02, + $ 5.344824270448D-01, 1.197185199637D-01, + $ 5.666575997416D-01, 1.502300756161D-01, + $ 5.974457471405D-01, 1.806004191914D-01, + $ 6.267984444117D-01, 2.106621764786D-01, + $ 6.546664713575D-01, 2.402526932672D-01, + $ 5.042711004437D-01, 2.982529203608D-02, + $ 5.392127456774D-01, 6.008728062340D-02, + $ 5.726819437669D-01, 9.058227674571D-02, + $ 6.046469254207D-01, 1.211219235803D-01, + $ 6.350716157435D-01, 1.515286404792D-01, + $ 6.639177679185D-01, 1.816314681256D-01, + $ 5.757276040972D-01, 3.026991752575D-02, + $ 6.090265823140D-01, 6.078402297871D-02, + $ 6.406735344388D-01, 9.135459984177D-02, + $ 6.706397927794D-01, 1.218024155967D-01, + $ 6.435019674427D-01, 3.052608357661D-02, + $ 6.747218676376D-01, 6.112185773983D-02 / + + Pi = ACOS(-1d0) + Pi4 = 4 * Pi + +c Determine if the number of points requested is valid, and, if the +c formula is simple enough, go ahead and put it in now... + + IF (N.eq.1) THEN + Pts(1,1) = 0D0 + Pts(2,1) = 0D0 + Pts(3,1) = 1D0 + Wts (1) = Pi4 + RETURN + ELSEIF (N.eq.4) THEN + CALL VRLoad(Pts,12,SQRT(1D0/3D0)) + CALL VRLoad(Wts,4,Pi) + Pts(1,2) = -Pts(1,2) + Pts(2,2) = -Pts(2,2) + Pts(1,3) = -Pts(1,3) + Pts(3,3) = -Pts(3,3) + Pts(2,4) = -Pts(2,4) + Pts(3,4) = -Pts(3,4) + RETURN + ELSEIF (N.eq.6) THEN + Leb = 1 + ELSEIF (N.eq.18) THEN + Leb = 2 + ELSEIF (N.eq.26) THEN + Leb = 3 + ELSEIF (N.eq.38) THEN + Leb = 4 + ELSEIF (N.eq.50) THEN + Leb = 5 + ELSEIF (N.eq.74) THEN + Leb = 6 + ELSEIF (N.eq.86) THEN + Leb = 7 + ELSEIF (N.eq.110) THEN + Leb = 8 + ELSEIF (N.eq.146) THEN + Leb = 9 + ELSEIF (N.eq.170) THEN + Leb = 10 + ELSEIF (N.eq.194) THEN + Leb = 11 + ELSEIF (N.eq.230) THEN + Leb = 12 + ELSEIF (N.eq.266) THEN + Leb = 13 + ELSEIF (N.eq.302) THEN + Leb = 14 + ELSEIF (N.eq.350) THEN + Leb = 15 + ELSEIF (N.eq.434) THEN + Leb = 16 + ELSEIF (N.eq.590) THEN + Leb = 17 + ELSEIF (N.eq.770) THEN + Leb = 18 + ELSEIF (N.eq.974) THEN + Leb = 19 + ELSEIF (N.eq.1202) THEN + Leb = 20 + ELSEIF (N.eq.1454) THEN + Leb = 21 + ELSEIF (N.eq.1730) THEN + Leb = 22 + ELSEIF (N.eq.2030) THEN + Leb = 23 + ELSEIF (N.eq.2354) THEN + Leb = 24 + ELSEIF (N.eq.2702) THEN + Leb = 25 + ELSEIF (N.eq.3074) THEN + Leb = 26 + ELSEIF (N.eq.3470) THEN + Leb = 27 + ELSEIF (N.eq.3890) THEN + Leb = 28 + ELSEIF (N.eq.4334) THEN + Leb = 29 + ELSEIF (N.eq.4802) THEN + Leb = 30 + ELSEIF (N.eq.5294) THEN + Leb = 31 + ELSE + write(*,*)'Valid Angular Grids are :' + write(*,*)'6, 18, 26, 38, 50, 74, 86, 110, 146, 170, 194, 230' + write(*,*)'266, 302, 434, 590, 770, 974, 1202, 1454, 1730' + write(*,*)'2030, 2354, 2702, 3074, 3470, 3890, 4334, 4802, 5294' + CALL EXIT + ENDIF + +c Construct the Lebedev octahedral sets from their defining +c parameters. See the references given above... + + iPt = 0 + +c First, the special sets... + +c 6-point set (A1)... + + IF (SetTyp(1,Leb).eq.1) THEN + CALL VRLoad(Pts(1,iPt+1),18,0D0) + CALL VRLoad(Wts(iPt+1),6,A(1,Leb)) + z = 1D0 + DO 100 i = 1,6 + Pts((i+1)/2,iPt+i) = z + z = -z + 100 CONTINUE + iPt = iPt + 6 + ENDIF + +c 12-point set (A2)... + + IF (SetTyp(2,Leb).eq.1) THEN + CALL VRLoad(Pts(1,iPt+1),36,0D0) + CALL VRLoad(Wts(iPt+1),12,A(2,Leb)) + z = SQRT(0.5D0) + DO 200 i = 1,2 + DO 210 j = i+1,3 + Pts(i,iPt+1) = z + Pts(j,iPt+1) = z + Pts(i,iPt+2) = z + Pts(j,iPt+2) = -z + Pts(i,iPt+3) = -z + Pts(j,iPt+3) = z + Pts(i,iPt+4) = -z + Pts(j,iPt+4) = -z + iPt = iPt + 4 + 210 CONTINUE + 200 CONTINUE + ENDIF + +c 8-point set (A3)... + + IF (SetTyp(3,Leb).eq.1) THEN + CALL VRLoad(Wts(iPt+1),8,A(3,Leb)) + z = SQRT(1D0/3D0) + DO 300 i1 = 0,1 + DO 310 i2 = 0,1 + DO 320 i3 = 0,1 + Pts(1,iPt+1) = (-1)**i1 * z + Pts(2,iPt+1) = (-1)**i2 * z + Pts(3,iPt+1) = (-1)**i3 * z + iPt = iPt + 1 + 320 CONTINUE + 310 CONTINUE + 300 CONTINUE + ENDIF + +c Next, the general sets... + +c 24-point sets (Bk)... + + DO 400 k = 1,SetTyp(4,Leb) + CALL VRLoad(Wts(iPt+1),24,B(k,Leb)) + mk = SQRT(ABS(T(k,Leb))) + lk = SQRT((1D0-mk**2)/2) + DO 410 j = 1,3 + DO 420 i1 = 0,1 + DO 430 i2 = 0,1 + DO 440 i3 = 0,1 + Pts(Pmt(1,j),iPt+1) = (-1)**i1 * mk + Pts(Pmt(2,j),iPt+1) = (-1)**i2 * lk + Pts(Pmt(3,j),iPt+1) = (-1)**i3 * lk + iPt = iPt + 1 + 440 CONTINUE + 430 CONTINUE + 420 CONTINUE + 410 CONTINUE + 400 CONTINUE + +c 24-point sets (Ck)... + + DO 500 k = 1,SetTyp(5,Leb) + CALL VRLoad(Wts(iPt+1),24,C(k,Leb)) + pk = SQRT(ABS((1D0+SQRT(1D0-4*V(k,Leb)))/2)) + qk = SQRT(1D0-pk**2) + DO 510 j = 1,6 + DO 520 i1 = 0,1 + DO 530 i2 = 0,1 + Pts(Pmt(1,j),iPt+1) = (-1)**i1 * pk + Pts(Pmt(2,j),iPt+1) = (-1)**i2 * qk + Pts(Pmt(3,j),iPt+1) = 0D0 + iPt = iPt + 1 + 530 CONTINUE + 520 CONTINUE + 510 CONTINUE + 500 CONTINUE + +c 48-point sets (Dk)... + + DO 600 k = 1,SetTyp(6,Leb) + CALL VRLoad(Wts(iPt+1),48,D(k,Leb)) + +c To find the base-points r,s,w, we must find the roots +c of a polynomial (See Ref. 2)... + + s1k = S(1,k,Leb) + s2k = S(2,k,Leb) + s3k = SQRT(1-s1k*s1k-s2k*s2k) + + DO j = 1,6 + do i1 = 0,1 + do i2 = 0,1 + do i3 = 0,1 + Pts(Pmt(1,j),iPt+1) = (-1)**i1*s1k + Pts(Pmt(2,j),iPt+1) = (-1)**i2*s3k + Pts(Pmt(3,j),iPt+1) = (-1)**i3*s2k + iPt = iPt + 1 + enddo + enddo + enddo + enddo + 600 CONTINUE + +c Scale the weights by 4*Pi and we're done... + + CALL VRScale(Wts,N,Pi4) + RETURN + END + +c----------------------------------------------------------------------- + + SUBROUTINE VRload(A,N,Value) + IMPLICIT REAL*8 (a-h,o-z) + REAL*8 A(N) + DO i = 1,N + A(i) = Value + END DO + RETURN + END + +c----------------------------------------------------------------------- + + SUBROUTINE VRscale(A,N,Scale) + IMPLICIT REAL*8 (a-h,o-z) + REAL*8 A(N) + DO i = 1, N + A(i) = Scale * A(i) + END DO + RETURN + END diff --git a/src/xcDFT/eDFT.f90 b/src/xcDFT/eDFT.f90 new file mode 100644 index 0000000..6ae8a60 --- /dev/null +++ b/src/xcDFT/eDFT.f90 @@ -0,0 +1,133 @@ +program eDFT + +! exchange-correlation density-functional theory calculations + + include 'parameters.h' + + integer :: nAt,nBas,nEl(nspin),nO(nspin),nV(nspin) + double precision :: ENuc,EKS + + double precision,allocatable :: ZNuc(:),rAt(:,:) + + integer :: nShell + integer,allocatable :: TotAngMomShell(:) + integer,allocatable :: KShell(:) + double precision,allocatable :: CenterShell(:,:) + double precision,allocatable :: DShell(:,:) + double precision,allocatable :: ExpShell(:,:) + + double precision,allocatable :: S(:,:),T(:,:),V(:,:),Hc(:,:),X(:,:) + double precision,allocatable :: ERI(:,:,:,:) + + integer :: x_rung,c_rung + character(len=12) :: x_DFA ,c_DFA + integer :: SGn + integer :: nRad,nAng,nGrid + double precision,allocatable :: root(:,:) + double precision,allocatable :: weight(:) + double precision,allocatable :: AO(:,:) + double precision,allocatable :: dAO(:,:,:) + + double precision :: start_KS,end_KS,t_KS + + integer :: nEns + double precision,allocatable :: wEns(:) + + integer :: maxSCF,max_diis + double precision :: thresh + logical :: DIIS,guess_type,ortho_type + +! Hello World + + write(*,*) + write(*,*) '******************************************' + write(*,*) '* eDFT: density-functional for ensembles *' + write(*,*) '******************************************' + write(*,*) + +!------------------------------------------------------------------------ +! Read input information +!------------------------------------------------------------------------ + +! Read number of atoms, number of electrons of the system +! nO = number of occupied orbitals +! nV = number of virtual orbitals (see below) +! nBas = number of basis functions (see below) +! = nO + nV + + call read_molecule(nAt,nEl,nO) + allocate(ZNuc(nAt),rAt(nAt,ncart)) + +! Read geometry + + call read_geometry(nAt,ZNuc,rAt,ENuc) + + allocate(CenterShell(maxShell,ncart),TotAngMomShell(maxShell),KShell(maxShell), & + DShell(maxShell,maxK),ExpShell(maxShell,maxK)) + +!------------------------------------------------------------------------ +! Read basis set information +!------------------------------------------------------------------------ + + call read_basis(nAt,rAt,nBas,nO,nV,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell) + +!------------------------------------------------------------------------ +! Read one- and two-electron integrals +!------------------------------------------------------------------------ + +! Memory allocation for one- and two-electron integrals + + allocate(S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),X(nBas,nBas), & + ERI(nBas,nBas,nBas,nBas)) + +! Read integrals + + call read_integrals(nBas,S,T,V,Hc,ERI) + +! Orthogonalization X = S^(-1/2) + + call orthogonalization_matrix(nBas,S,X) + +!------------------------------------------------------------------------ +! DFT options +!------------------------------------------------------------------------ + +! Allocate ensemble weights + + allocate(wEns(maxEns)) + + call read_options(x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,thresh,DIIS,max_diis,guess_type,ortho_type) + +!------------------------------------------------------------------------ +! Construct quadrature grid +!------------------------------------------------------------------------ + call read_grid(SGn,nRad,nAng,nGrid) + + allocate(root(ncart,nGrid),weight(nGrid)) + call quadrature_grid(nRad,nAng,nGrid,root,weight) + +!------------------------------------------------------------------------ +! Calculate AO values at grid points +!------------------------------------------------------------------------ + + allocate(AO(nBas,nGrid),dAO(ncart,nBas,nGrid)) + call AO_values_grid(nBas,nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell, & + nGrid,root,AO,dAO) + +!------------------------------------------------------------------------ +! Compute KS energy +!------------------------------------------------------------------------ + + call cpu_time(start_KS) + call Kohn_Sham(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns(1:nEns),nGrid,weight(:),maxSCF,thresh,max_diis,guess_type, & + nBas,AO(:,:),dAO(:,:,:),nO(:),nV(:),S(:,:),T(:,:),V(:,:),Hc(:,:),ERI(:,:,:,:),X(:,:),ENuc,EKS) + call cpu_time(end_KS) + + t_KS = end_KS - start_KS + write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for KS = ',t_KS,' seconds' + write(*,*) + +!------------------------------------------------------------------------ +! End of eDFT +!------------------------------------------------------------------------ +end program eDFT diff --git a/src/xcDFT/elda_correlation_Levy_Zahariev_shift.f90 b/src/xcDFT/elda_correlation_Levy_Zahariev_shift.f90 new file mode 100644 index 0000000..0473d71 --- /dev/null +++ b/src/xcDFT/elda_correlation_Levy_Zahariev_shift.f90 @@ -0,0 +1,62 @@ +subroutine elda_correlation_Levy_Zahariev_shift(nEns,aLF,nGrid,weight,rho,EcLZ) + +! Compute Levy-Zahariev LDA correlation shift of 2-glomium for various states + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: aLF(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,ec_p + double precision :: dFcdra,dFcdrb + +! Output variables + + double precision,intent(out) :: EcLZ + +! Compute Levy-Zahariev eLDA correlation shift + + EcLZ = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + r = ra + rb + + if(ra > threshold) then + + ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + dFcdra = aLF(2)*r**(-1d0/6d0) + 2d0*aLF(3)*r**(-1d0/3d0) + dFcdra = dFcdra/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + dFcdra = ec_p*dFcdra/6d0 + dFcdra = ec_p + dFcdra + + EcLZ = EcLZ - weight(iG)*r*r*dFcdra + + end if + + if(rb > threshold) then + + ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + dFcdrb = aLF(2)*r**(-1d0/6d0) + 2d0*aLF(3)*r**(-1d0/3d0) + dFcdrb = dFcdrb/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + dFcdrb = ec_p*dFcdrb/6d0 + dFcdrb = ec_p + dFcdrb + + EcLZ = EcLZ - weight(iG)*r*r*dFcdrb + + end if + + end do + +end subroutine elda_correlation_Levy_Zahariev_shift diff --git a/src/xcDFT/elda_correlation_energy.f90 b/src/xcDFT/elda_correlation_energy.f90 new file mode 100644 index 0000000..98e6ab8 --- /dev/null +++ b/src/xcDFT/elda_correlation_energy.f90 @@ -0,0 +1,70 @@ +subroutine elda_correlation_energy(nEns,aLF,nGrid,weight,rho,Ec) + +! Compute LDA correlation energy of 2-glomium for various states + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: aLF(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,ec_p + +! Output variables + + double precision,intent(out) :: Ec(nsp) + + +! Compute eLDA correlation energy + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + r = ra + rb + +! Spin-up contribution + + if(ra > threshold) then + + ec_p = aLF(1)/(1d0 + aLF(2)*ra**(-1d0/6d0) + aLF(3)*ra**(-1d0/3d0)) + + Ec(1) = Ec(1) + weight(iG)*ec_p*ra + + end if + +! Opposite-spin contribution + + if(r > threshold) then + + ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + + Ec(2) = Ec(2) + weight(iG)*ec_p*r + + end if + +! Spin-down contribution + + if(rb > threshold) then + + ec_p = aLF(1)/(1d0 + aLF(2)*rb**(-1d0/6d0) + aLF(3)*rb**(-1d0/3d0)) + + Ec(3) = Ec(3) + weight(iG)*ec_p*rb + + end if + + end do + + Ec(2) = Ec(2) - Ec(1) - Ec(3) + +end subroutine elda_correlation_energy diff --git a/src/xcDFT/elda_correlation_individual_energy.f90 b/src/xcDFT/elda_correlation_individual_energy.f90 new file mode 100644 index 0000000..d0b86b6 --- /dev/null +++ b/src/xcDFT/elda_correlation_individual_energy.f90 @@ -0,0 +1,58 @@ +subroutine elda_correlation_individual_energy(nEns,aLF,nGrid,weight,rhow,rho,Ec) + +! Compute LDA correlation individual energy of 2-glomium for various states + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: aLF(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra, rb, r + double precision :: raI,rbI,rI + double precision :: ec_p,dFcdr + +! Output variables + + double precision,intent(out) :: Ec(nsp) + +! Compute eLDA correlation potential + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + + raI = max(0d0,rho(iG,1)) + rbI = max(0d0,rho(iG,2)) + + r = ra + rb + rI = raI + rbI + + if(r > threshold .and. rI > threshold) then + + ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + + dFcdr = aLF(2)*r**(-1d0/6d0) + 2d0*aLF(3)*r**(-1d0/3d0) + dFcdr = dFcdr/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + dFcdr = ec_p*dFcdr/(6d0*r) + dFcdr = ec_p + dFcdr*r + + Ec(2) = Ec(2) + weight(iG)*rI*dFcdr + + end if + + end do + +end subroutine elda_correlation_individual_energy diff --git a/src/xcDFT/elda_correlation_potential.f90 b/src/xcDFT/elda_correlation_potential.f90 new file mode 100644 index 0000000..b31642a --- /dev/null +++ b/src/xcDFT/elda_correlation_potential.f90 @@ -0,0 +1,71 @@ +subroutine elda_correlation_potential(nEns,aLF,nGrid,weight,nBas,AO,rho,Fc) + +! Compute LDA correlation energy of 2-glomium for various states + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: aLF(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: mu,nu,iG + double precision :: ra,rb,r,ec_p + double precision :: dFcdra,dFcdrb + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Compute eLDA correlation potential + + Fc(:,:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + + if(ra > threshold) then + + r = ra + rb + + ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + dFcdra = aLF(2)*r**(-1d0/6d0) + 2d0*aLF(3)*r**(-1d0/3d0) + dFcdra = dFcdra/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + dFcdra = ec_p*dFcdra/(6d0*r) + dFcdra = ec_p + dFcdra*r + + Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdra + + endif + + if(rb > threshold) then + + r = ra + rb + + ec_p = aLF(1)/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + dFcdrb = aLF(2)*r**(-1d0/6d0) + 2d0*aLF(3)*r**(-1d0/3d0) + dFcdrb = dFcdrb/(1d0 + aLF(2)*r**(-1d0/6d0) + aLF(3)*r**(-1d0/3d0)) + dFcdrb = ec_p*dFcdrb/(6d0*r) + dFcdrb = ec_p + dFcdrb*r + + Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*dFcdrb + + endif + + end do + end do + end do + +end subroutine elda_correlation_potential diff --git a/src/xcDFT/electron_number.f90 b/src/xcDFT/electron_number.f90 new file mode 100644 index 0000000..310e161 --- /dev/null +++ b/src/xcDFT/electron_number.f90 @@ -0,0 +1,20 @@ +function electron_number(nGrid,w,rho) result(nEl) + +! Compute the number of electrons via integration of the one-electron density + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: w(nGrid) + double precision,intent(in) :: rho(nGrid) + +! Output variables + + double precision :: nEl + + nEl = dot_product(w,rho) + +end function electron_number diff --git a/src/xcDFT/elements.f90 b/src/xcDFT/elements.f90 new file mode 100644 index 0000000..22953dc --- /dev/null +++ b/src/xcDFT/elements.f90 @@ -0,0 +1,170 @@ +function element_number(element_name) + + implicit none + + integer,parameter :: nelement_max = 103 + character(len=2),intent(in) :: element_name + integer :: element_number + character(len=2),parameter :: element_list(nelement_max) = & + (/' H', 'He', & ! 2 + 'Li','Be', ' B',' C',' N',' O',' F','Ne', & ! 10 + 'Na','Mg', 'Al','Si',' P',' S','Cl','Ar', & ! 18 + ' K','Ca','Sc','Ti',' V','Cr','Mn','Fe','Co','Ni','Cu','Zn','Ga','Ge','As','Se','Br','Kr', & ! 36 + 'Rb','Sr',' Y','Zr','Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd','In','Sn','Sb','Te',' I','Xe', & ! 54 + 'Cs','Ba', & ! 56 + 'La','Ce','Pr','Nd','Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb', & ! 70 + 'Lu','Hf','Ta',' W','Re','Os','Ir','Pt','Au','Hg','Tl','Pb','Bi','Po','At','Rn', & ! 86 + 'Fr','Ra', & ! 88 + 'Ac','Th','Pa',' U','Np','Pu','Am','Cm','Bk','Cf','Es','Fm','Md','No', & ! 102 + 'Lr' & ! 103 + /) + +!===== + integer :: ielement +!===== + + ielement=1 + do while( ADJUSTL(element_name) /= ADJUSTL(element_list(ielement)) ) + if( ielement == nelement_max ) then + write(*,'(a,a)') ' Input symbol ',element_name + write(*,'(a,i3,a)') ' Element symbol is not one of first ',nelement_max,' elements' + write(*,*) '!!! element symbol not understood !!!' + stop + endif + ielement = ielement + 1 + enddo + + element_number = ielement + +end function element_number + +function element_core(zval,zatom) + implicit none + double precision,intent(in) :: zval + double precision,intent(in) :: zatom + integer :: element_core +!===== + + ! + ! If zval /= zatom, this is certainly an effective core potential + ! and no core states should be frozen. + if( ABS(zval - zatom) > 1d0-3 ) then + element_core = 0 + else + + if( zval <= 4.00001d0 ) then ! up to Be + element_core = 0 + else if( zval <= 12.00001d0 ) then ! up to Mg + element_core = 1 + else if( zval <= 30.00001d0 ) then ! up to Ca + element_core = 5 + else if( zval <= 48.00001d0 ) then ! up to Sr + element_core = 9 + else + write(*,*) '!!! not imlemented in element_core !!!' + stop + endif + + endif + + +end function element_core + +function element_covalent_radius(zatom) + +! Return covalent radius of an atom + + implicit none + include 'parameters.h' + + integer,intent(in) :: zatom + double precision :: element_covalent_radius + + ! + ! Data from Cambridge Structural Database + ! http://en.wikipedia.org/wiki/Covalent_radius + ! + ! Values are first given in picometer + ! They will be converted in bohr later on + select case(zatom) + case( 1) + element_covalent_radius = 31. + case( 2) + element_covalent_radius = 28. + case( 3) + element_covalent_radius = 128. + case( 4) + element_covalent_radius = 96. + case( 5) + element_covalent_radius = 84. + case( 6) + element_covalent_radius = 73. + case( 7) + element_covalent_radius = 71. + case( 8) + element_covalent_radius = 66. + case( 9) + element_covalent_radius = 57. + case(10) ! Ne. + element_covalent_radius = 58. + case(11) + element_covalent_radius = 166. + case(12) + element_covalent_radius = 141. + case(13) + element_covalent_radius = 121. + case(14) + element_covalent_radius = 111. + case(15) + element_covalent_radius = 107. + case(16) + element_covalent_radius = 105. + case(17) + element_covalent_radius = 102. + case(18) ! Ar. + element_covalent_radius = 106. + case(19) + element_covalent_radius = 203. + case(20) + element_covalent_radius = 176. + case(21) + element_covalent_radius = 170. + case(22) + element_covalent_radius = 160. + case(23) + element_covalent_radius = 153. + case(24) + element_covalent_radius = 139. + case(25) + element_covalent_radius = 145. + case(26) + element_covalent_radius = 145. + case(27) + element_covalent_radius = 140. + case(28) + element_covalent_radius = 124. + case(29) + element_covalent_radius = 132. + case(30) + element_covalent_radius = 122. + case(31) + element_covalent_radius = 120. + case(32) + element_covalent_radius = 119. + case(34) + element_covalent_radius = 120. + case(35) + element_covalent_radius = 120. + case(36) ! Kr. + element_covalent_radius = 116. + case default + write(*,*) '!!! covalent radius not available !!!' + stop + end select + + ! pm to bohr conversion + element_covalent_radius = element_covalent_radius*pmtoau + + +end function element_covalent_radius + diff --git a/src/xcDFT/exchange_energy.f90 b/src/xcDFT/exchange_energy.f90 new file mode 100644 index 0000000..8e63441 --- /dev/null +++ b/src/xcDFT/exchange_energy.f90 @@ -0,0 +1,80 @@ +subroutine exchange_energy(rung,DFA,nEns,wEns,nGrid,weight,nBas,P,FxHF,rho,drho,Ex) + +! Compute the exchange energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: rung + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: FxHF(nBas,nBas) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Local variables + + double precision :: ExLDA,ExGGA,ExHF + double precision :: cX,aX,aC + +! Output variables + + double precision,intent(out) :: Ex + + select case (rung) + +! Hartree calculation + + case(0) + + Ex = 0d0 + +! LDA functionals + + case(1) + + call lda_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,ExLDA) + + Ex = ExLDA + +! GGA functionals + + case(2) + + call gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,ExGGA) + + Ex = ExGGA + +! Hybrid functionals + + case(4) + + cX = 0.20d0 + aX = 0.72d0 + aC = 0.81d0 + + call lda_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,ExLDA) + call gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,ExGGA) + call fock_exchange_energy(nBas,P,FxHF,ExHF) + + Ex = ExLDA & + + cX*(ExHF - ExLDA) & + + aX*(ExGGA - ExLDA) + +! Hartree-Fock calculation + case(666) + + call fock_exchange_energy(nBas,P,FxHF,ExHF) + + Ex = ExHF + + end select + +end subroutine exchange_energy diff --git a/src/xcDFT/exchange_potential.f90 b/src/xcDFT/exchange_potential.f90 new file mode 100644 index 0000000..847175f --- /dev/null +++ b/src/xcDFT/exchange_potential.f90 @@ -0,0 +1,81 @@ +subroutine exchange_potential(rung,DFA,nEns,wEns,nGrid,weight,nBas,P,ERI,AO,dAO,rho,drho,Fx,FxHF) + +! Compute the exchange potential + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: rung + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(ncart,nBas,nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(ncart,nGrid) + +! Local variables + + double precision,allocatable :: FxLDA(:,:),FxGGA(:,:) + double precision :: cX,aX + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas),FxHF(nBas,nBas) + +! Memory allocation + + select case (rung) + +! Hartree calculation + case(0) + + Fx(:,:) = 0d0 + +! LDA functionals + + case(1) + + call lda_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,rho,Fx) + +! GGA functionals + + case(2) + + call gga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + +! Hybrid functionals + + case(4) + + allocate(FxLDA(nBas,nBas),FxGGA(nBas,nBas)) + + cX = 0.20d0 + aX = 0.72d0 + + call lda_exchange_potential(DFA,nGrid,weight,nBas,AO,rho,FxLDA) + call gga_exchange_potential(DFA,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) + call fock_exchange_potential(nBas,P,ERI,FxHF) + + Fx(:,:) = FxLDA(:,:) & + + cX*(FxHF(:,:) - FxLDA(:,:)) & + + aX*(FxGGA(:,:) - FxLDA(:,:)) + +! Hartree-Fock calculation + + case(666) + + call fock_exchange_potential(nBas,P,ERI,FxHF) + + Fx(:,:) = FxHF(:,:) + + end select + +end subroutine exchange_potential diff --git a/src/xcDFT/fock_exchange_energy.f90 b/src/xcDFT/fock_exchange_energy.f90 new file mode 100644 index 0000000..f019c04 --- /dev/null +++ b/src/xcDFT/fock_exchange_energy.f90 @@ -0,0 +1,25 @@ +subroutine fock_exchange_energy(nBas,P,Fx,Ex) + +! Compute the (exact) Fock exchange energy + + implicit none + +! Input variables + + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: Fx(nBas,nBas) + +! Local variables + + double precision,external :: trace_matrix + +! Output variables + + double precision,intent(out) :: Ex + +! Compute HF exchange energy + + Ex = trace_matrix(nBas,matmul(P,Fx)) + +end subroutine fock_exchange_energy diff --git a/src/xcDFT/fock_exchange_potential.f90 b/src/xcDFT/fock_exchange_potential.f90 new file mode 100644 index 0000000..59af3b1 --- /dev/null +++ b/src/xcDFT/fock_exchange_potential.f90 @@ -0,0 +1,34 @@ +subroutine fock_exchange_potential(nBas,P,ERI,Fx) + +! Compute the Fock exchange potential + + implicit none + +! Input variables + + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: mu,nu,la,si + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas) + +! Compute HF exchange matrix + + Fx(:,:) = 0d0 + do nu=1,nBas + do si=1,nBas + do la=1,nBas + do mu=1,nBas + Fx(mu,nu) = Fx(mu,nu) - P(la,si)*ERI(mu,si,la,nu) + enddo + enddo + enddo + enddo + +end subroutine fock_exchange_potential diff --git a/src/xcDFT/generate_shell.f90 b/src/xcDFT/generate_shell.f90 new file mode 100644 index 0000000..c6e0ab5 --- /dev/null +++ b/src/xcDFT/generate_shell.f90 @@ -0,0 +1,32 @@ +subroutine generate_shell(atot,nShellFunction,ShellFunction) + +! Generate shells for a given total angular momemtum + + implicit none + +! Input variables + + integer,intent(in) :: atot,nShellFunction + +! Local variables + + integer :: ax,ay,az,ia + +! Output variables + + integer,intent(out) :: ShellFunction(nShellFunction,3) + + ia = 0 + do ax=atot,0,-1 + do az=0,atot + ay = atot - ax - az + if(ay >= 0) then + ia = ia + 1 + ShellFunction(ia,1) = ax + ShellFunction(ia,2) = ay + ShellFunction(ia,3) = az + endif + enddo + enddo + +end subroutine generate_shell diff --git a/src/xcDFT/gga_correlation_energy.f90 b/src/xcDFT/gga_correlation_energy.f90 new file mode 100644 index 0000000..3a4c10d --- /dev/null +++ b/src/xcDFT/gga_correlation_energy.f90 @@ -0,0 +1,42 @@ +subroutine gga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) + +! Compute GGA correlation energy + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,ga,gb + +! Output variables + + double precision :: Ec(nsp) + +! Coefficients for ??? GGA exchange functional + +! Compute GGA exchange energy + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = rho(iG,1) + rb = rho(iG,2) + ga = drho(1,iG,1)**2 + drho(2,iG,1)**2 + drho(3,iG,1)**2 + gb = drho(1,iG,2)**2 + drho(2,iG,2)**2 + drho(3,iG,2)**2 + + enddo + +end subroutine gga_correlation_energy diff --git a/src/xcDFT/gga_correlation_potential.f90 b/src/xcDFT/gga_correlation_potential.f90 new file mode 100644 index 0000000..1839e07 --- /dev/null +++ b/src/xcDFT/gga_correlation_potential.f90 @@ -0,0 +1,31 @@ +subroutine gga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + +! Compute GGA correlation potential + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(3,nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(3,nGrid,nspin) + +! Local variables + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Coefficients for GGA correlation functional + +! Compute GGA correlation matrix in the AO basis + +end subroutine gga_correlation_potential diff --git a/src/xcDFT/gga_exchange_energy.f90 b/src/xcDFT/gga_exchange_energy.f90 new file mode 100644 index 0000000..06d72dc --- /dev/null +++ b/src/xcDFT/gga_exchange_energy.f90 @@ -0,0 +1,44 @@ +subroutine gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) + +! Select GGA exchange functional for energy calculation + + implicit none + + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Output variables + + double precision :: Ex + + select case (DFA) + +! Gill's 96 exchange functional + + case ('G96') + + call G96_gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) + +! Becke's 88 exchange functional + + case ('B88') + + call B88_gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) + + case default + + call print_warning('!!! GGA exchange functional not available !!!') + stop + + end select + +end subroutine gga_exchange_energy diff --git a/src/xcDFT/gga_exchange_potential.f90 b/src/xcDFT/gga_exchange_potential.f90 new file mode 100644 index 0000000..538b4a0 --- /dev/null +++ b/src/xcDFT/gga_exchange_potential.f90 @@ -0,0 +1,48 @@ +subroutine gga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + +! Select GGA exchange functional for potential calculation + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(3,nBas,nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas) + +! Select GGA exchange functional + + select case (DFA) + +! Gill's 96 exchange functional + + case ('G96') + + call G96_gga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + +! Becke's 88 exchange functional + + case ('B88') + + call B88_gga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + + case default + + call print_warning('!!! GGA exchange functional not available !!!') + stop + + end select + +end subroutine gga_exchange_potential diff --git a/src/xcDFT/gradient_density.f90 b/src/xcDFT/gradient_density.f90 new file mode 100644 index 0000000..7d9e0cd --- /dev/null +++ b/src/xcDFT/gradient_density.f90 @@ -0,0 +1,45 @@ +subroutine gradient_density(nGrid,nBas,P,AO,dAO,drho) + +! Calculate gradient of the one-electron density + + implicit none + include 'parameters.h' + +! Input variables + + double precision,parameter :: thresh = 1d-15 + + integer,intent(in) :: nGrid + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(3,nBas,nGrid) + +! Local variables + + integer :: ixyz,iG,mu,nu + double precision,external :: trace_matrix + +! Output variables + + double precision,intent(out) :: drho(3,nGrid) + + drho(:,:) = 0d0 + do iG=1,nGrid + do mu=1,nBas + do nu=1,nBas + do ixyz=1,3 + drho(ixyz,iG) = drho(ixyz,iG) & + + P(mu,nu)*(dAO(ixyz,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(ixyz,nu,iG)) + enddo + enddo + enddo + enddo + + do iG=1,nGrid + do ixyz=1,3 + if(abs(drho(ixyz,iG)) < thresh) drho(ixyz,iG) = thresh + enddo + enddo + +end subroutine gradient_density diff --git a/src/xcDFT/hartree_coulomb.f90 b/src/xcDFT/hartree_coulomb.f90 new file mode 100644 index 0000000..468d086 --- /dev/null +++ b/src/xcDFT/hartree_coulomb.f90 @@ -0,0 +1,33 @@ +subroutine hartree_coulomb(nBas,P,ERI,J) + +! Compute Coulomb matrix + + implicit none + +! Input variables + + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: mu,nu,la,si + +! Output variables + + double precision,intent(out) :: J(nBas,nBas) + + J = 0d0 + do mu=1,nBas + do nu=1,nBas + do la=1,nBas + do si=1,nBas + J(mu,nu) = J(mu,nu) + P(la,si)*ERI(mu,nu,la,si) + enddo + enddo + enddo + enddo + + +end subroutine hartree_coulomb diff --git a/src/xcDFT/individual_energy.f90 b/src/xcDFT/individual_energy.f90 new file mode 100644 index 0000000..025f21a --- /dev/null +++ b/src/xcDFT/individual_energy.f90 @@ -0,0 +1,156 @@ +subroutine 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) + +! Compute individual energies as well as excitation energies + + 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) :: 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) :: T(nBas,nBas) + double precision,intent(in) :: V(nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ENuc + + double precision,intent(in) :: Pw(nBas,nBas) + double precision,intent(in) :: rhow(nGrid,nspin) + double precision,intent(in) :: drhow(ncart,nGrid,nspin) + + double precision,intent(in) :: P(nBas,nBas,nspin,nEns) + double precision,intent(in) :: rho(nGrid,nspin,nEns) + double precision,intent(in) :: drho(ncart,nGrid,nspin,nEns) + + double precision,intent(in) :: J(nBas,nBas,nspin) + double precision,intent(in) :: Fx(nBas,nBas,nspin) + double precision,intent(in) :: FxHF(nBas,nBas,nspin) + double precision,intent(in) :: Fc(nBas,nBas,nspin) + +! Local variables + + double precision :: ET(nspin,nEns) + double precision :: EV(nspin,nEns) + double precision :: EJ(nsp,nEns) + double precision :: Ex(nspin,nEns) + double precision :: Ec(nsp,nEns) + double precision :: EcLZ(nsp) + double precision :: EcDD(nsp,nEns) + + double precision,external :: trace_matrix + + integer :: ispin,iEns + +! Output variables + + double precision,intent(out) :: E(nEns) + double precision,intent(out) :: Om(nEns) + +!------------------------------------------------------------------------ +! Kinetic energy +!------------------------------------------------------------------------ + + do ispin=1,nspin + do iEns=1,nEns + ET(ispin,iEns) = trace_matrix(nBas,matmul(P(:,:,ispin,iEns),T(:,:))) + end do + end do + +!------------------------------------------------------------------------ +! Potential energy +!------------------------------------------------------------------------ + + do iEns=1,nEns + do ispin=1,nspin + EV(ispin,iEns) = trace_matrix(nBas,matmul(P(:,:,ispin,iEns),V(:,:))) + end do + end do + +!------------------------------------------------------------------------ +! Hartree energy +!------------------------------------------------------------------------ + + do iEns=1,nEns + + do ispin=1,nspin + call hartree_coulomb(nBas,P(:,:,ispin,iEns),ERI,J(:,:,ispin)) + end do + + EJ(1,iEns) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1,iEns),J(:,:,1))) + EJ(2,iEns) = trace_matrix(nBas,matmul(P(:,:,1,iEns),J(:,:,2))) + EJ(3,iEns) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2,iEns),J(:,:,2))) + + end do + +!------------------------------------------------------------------------ +! Exchange energy +!------------------------------------------------------------------------ + + do iEns=1,nEns + do ispin=1,nspin + + call exchange_potential(x_rung,x_DFA,nEns,wEns(:),nGrid,weight(:),nBas,P(:,:,ispin,iEns),ERI(:,:,:,:), & + AO(:,:),dAO(:,:,:),rho(:,ispin,iEns),drho(:,:,ispin,iEns),Fx(:,:,ispin),FxHF(:,:,ispin)) + call exchange_energy(x_rung,x_DFA,nEns,wEns(:),nGrid,weight(:),nBas,P(:,:,ispin,iEns),FxHF(:,:,ispin), & + rho(:,ispin,iEns),drho(:,:,ispin,iEns),Ex(ispin,iEns)) + + end do + end do + +!------------------------------------------------------------------------ +! Correlation energy +!------------------------------------------------------------------------ + + do iEns=1,nEns + + call correlation_individual_energy(c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),rhow(:,:),drhow(:,:,:), & + rho(:,:,iEns),drho(:,:,:,iEns),Ec(:,iEns)) + + end do + +!------------------------------------------------------------------------ +! Compute Levy-Zahariev shift +!------------------------------------------------------------------------ + + call correlation_Levy_Zahariev_shift(c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),rho(:,:,:),drho(:,:,:,:),EcLZ(:)) + +!------------------------------------------------------------------------ +! Compute derivative discontinuities +!------------------------------------------------------------------------ + + call correlation_derivative_discontinuity(c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),rhow(:,:),drhow(:,:,:),EcDD(:,:)) + +!------------------------------------------------------------------------ +! Total energy +!------------------------------------------------------------------------ + + do iEns=1,nEns + E(iEns) = ENuc + sum(ET(:,iEns)) + sum(EV(:,iEns)) + sum(EJ(:,iEns)) & + + sum(Ex(:,iEns)) + sum(Ec(:,iEns)) + sum(EcLZ(:)) + sum(EcDD(:,iEns)) + end do + +!------------------------------------------------------------------------ +! Excitation energies +!------------------------------------------------------------------------ + + do iEns=1,nEns + Om(iEns) = E(iEns) - E(1) + end do + +!------------------------------------------------------------------------ +! Dump results +!------------------------------------------------------------------------ + + call print_individual_energy(nEns,EJ,Ex,Ec,EcLZ,EcDD,E,Om) + +end subroutine individual_energy diff --git a/src/xcDFT/lda_correlation_Levy_Zahariev_shift.f90 b/src/xcDFT/lda_correlation_Levy_Zahariev_shift.f90 new file mode 100644 index 0000000..cb3229b --- /dev/null +++ b/src/xcDFT/lda_correlation_Levy_Zahariev_shift.f90 @@ -0,0 +1,51 @@ +subroutine lda_correlation_Levy_Zahariev_shift(DFA,nEns,wEns,nGrid,weight,rho,EcLZ) + +! Compute the lda correlation part of the Levy-Zahariev shift + + implicit none + + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Output variables + + double precision,intent(out) :: EcLZ(nsp) + +! Select correlation functional + + select case (DFA) + +! Wigner's LDA correlation functional: Wigner, Trans. Faraday Soc. 34 (1938) 678 + + case ('W38') + + call W38_lda_correlation_Levy_Zahariev_shift(nGrid,weight(:),rho(:,:),EcLZ(:)) + +! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + + case ('VWN5') + + call VWN5_lda_correlation_Levy_Zahariev_shift(nGrid,weight(:),rho(:,:),EcLZ(:)) + +! Loos-Fromager weight-dependent correlation functional: Loos and Fromager (in preparation) + + case ('LF19') + + call LF19_lda_correlation_Levy_Zahariev_shift(nEns,wEns,nGrid,weight(:),rho(:,:),EcLZ(:)) + + case default + + call print_warning('!!! LDA correlation functional not available !!!') + stop + + end select + +end subroutine lda_correlation_Levy_Zahariev_shift diff --git a/src/xcDFT/lda_correlation_derivative_discontinuity.f90 b/src/xcDFT/lda_correlation_derivative_discontinuity.f90 new file mode 100644 index 0000000..86a3310 --- /dev/null +++ b/src/xcDFT/lda_correlation_derivative_discontinuity.f90 @@ -0,0 +1,54 @@ +subroutine lda_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) + +! Compute the correlation LDA part of the derivative discontinuity + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + +! Local variables + + double precision :: aC + +! Output variables + + double precision,intent(out) :: Ec(nsp,nEns) + +! Select correlation functional + + select case (DFA) + +! Wigner's LDA correlation functional: Wigner, Trans. Faraday Soc. 34 (1938) 678 + + case ('W38') + + Ec(:,:) = 0d0 + +! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + + case ('VWN5') + + Ec(:,:) = 0d0 + +! Loos-Fromager weight-dependent correlation functional: Loos and Fromager (in preparation) + + case ('LF19') + + call LF19_lda_correlation_derivative_discontinuity(nEns,wEns,nGrid,weight(:),rhow(:,:),Ec(:,:)) + + case default + + call print_warning('!!! LDA correlation functional not available !!!') + stop + + end select + +end subroutine lda_correlation_derivative_discontinuity diff --git a/src/xcDFT/lda_correlation_energy.f90 b/src/xcDFT/lda_correlation_energy.f90 new file mode 100644 index 0000000..b5c96d0 --- /dev/null +++ b/src/xcDFT/lda_correlation_energy.f90 @@ -0,0 +1,60 @@ +subroutine lda_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,Ec) + +! Select LDA correlation functional + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Output variables + + double precision,intent(out) :: Ec(nsp) + +! Select correlation functional + + select case (DFA) + +! Hartree-Fock + + case ('HF') + + Ec(:) = 0d0 + + case ('W38') + + call W38_lda_correlation_energy(nGrid,weight(:),rho(:,:),Ec(:)) + +! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + + case ('VWN5') + + call VWN5_lda_correlation_energy(nGrid,weight(:),rho(:,:),Ec(:)) + +! Chachiyo's LDA correlation functional: Chachiyo, JCP 145 (2016) 021101 + + case ('C16') + + call C16_lda_correlation_energy(nGrid,weight(:),rho(:,:),Ec(:)) + +! Loos-Fromager weight-dependent correlation functional: Loos and Fromager (in preparation) + + case ('LF19') + + call LF19_lda_correlation_energy(nEns,wEns(:),nGrid,weight(:),rho(:,:),Ec(:)) + + case default + + call print_warning('!!! LDA correlation functional not available !!!') + stop + + end select + +end subroutine lda_correlation_energy diff --git a/src/xcDFT/lda_correlation_individual_energy.f90 b/src/xcDFT/lda_correlation_individual_energy.f90 new file mode 100644 index 0000000..ef5e5b3 --- /dev/null +++ b/src/xcDFT/lda_correlation_individual_energy.f90 @@ -0,0 +1,51 @@ +subroutine lda_correlation_individual_energy(DFA,nEns,wEns,nGrid,weight,rhow,rho,Ec) + +! Compute LDA correlation energy for individual states + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + double precision,intent(in) :: rho(nGrid,nspin) + +! Output variables + + double precision :: Ec(nsp) + +! Select correlation functional + + select case (DFA) + +! Wigner's LDA correlation functional: Wigner, Trans. Faraday Soc. 34 (1938) 678 + + case ('W38') + + call W38_lda_correlation_individual_energy(nGrid,weight(:),rhow(:,:),rho(:,:),Ec(:)) + +! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + + case ('VWN5') + + call VWN5_lda_correlation_individual_energy(nGrid,weight(:),rhow(:,:),rho(:,:),Ec(:)) + +! Loos-Fromager weight-dependent correlation functional: Loos and Fromager (in preparation) + + case ('LF19') + + call LF19_lda_correlation_individual_energy(nEns,wEns,nGrid,weight(:),rhow(:,:),rho(:,:),Ec(:)) + + case default + + call print_warning('!!! LDA correlation functional not available !!!') + stop + + end select + +end subroutine lda_correlation_individual_energy diff --git a/src/xcDFT/lda_correlation_potential.f90 b/src/xcDFT/lda_correlation_potential.f90 new file mode 100644 index 0000000..f6a6b15 --- /dev/null +++ b/src/xcDFT/lda_correlation_potential.f90 @@ -0,0 +1,64 @@ +subroutine lda_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,rho,Fc) + +! Select LDA correlation potential + + implicit none +include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Select correlation functional + + select case (DFA) + +! Hartree-Fock + + case ('HF') + + Fc(:,:,:) = 0d0 + +! Wigner's LDA correlation functional: Wigner, Trans. Faraday Soc. 34 (1938) 678 + + case ('W38') + + call W38_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) + +! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + + case ('VWN5') + + call VWN5_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) + +! Chachiyo's LDA correlation functional: Chachiyo, JCP 145 (2016) 021101 + + case ('C16') + + call C16_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) + +! Loos-Fromager weight-dependent correlation functional: Loos and Fromager (in preparation) + + case ('LF19') + + call LF19_lda_correlation_potential(nEns,wEns(:),nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) + + case default + + call print_warning('!!! LDA correlation functional not available !!!') + stop + + end select + +end subroutine lda_correlation_potential diff --git a/src/xcDFT/lda_exchange_energy.f90 b/src/xcDFT/lda_exchange_energy.f90 new file mode 100644 index 0000000..69e1faa --- /dev/null +++ b/src/xcDFT/lda_exchange_energy.f90 @@ -0,0 +1,38 @@ +subroutine lda_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,Ex) + +! Select LDA exchange functional + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid) + +! Output variables + + double precision,intent(out) :: Ex + +! Select correlation functional + + select case (DFA) + +! Slater's LDA correlation functional: Slater, Phys. Rev. 81 (1951) 385 + + case ('S51') + + call S51_lda_exchange_energy(nGrid,weight,rho,Ex) + + case default + + call print_warning('!!! LDA exchange functional not available !!!') + stop + + end select + +end subroutine lda_exchange_energy diff --git a/src/xcDFT/lda_exchange_potential.f90 b/src/xcDFT/lda_exchange_potential.f90 new file mode 100644 index 0000000..9da6444 --- /dev/null +++ b/src/xcDFT/lda_exchange_potential.f90 @@ -0,0 +1,41 @@ +subroutine lda_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,rho,Fx) + +! Select LDA correlation potential + + implicit none + + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid) + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas) + +! Select exchange functional + + select case (DFA) + +! Slater's LDA correlation functional: Slater, Phys. Rev. 81 (1951) 385 + + case ('S51') + + call S51_lda_exchange_potential(nGrid,weight,nBas,AO,rho,Fx) + + case default + + call print_warning('!!! LDA exchange functional not available !!!') + stop + + end select + +end subroutine lda_exchange_potential diff --git a/src/xcDFT/one_electron_density.f90 b/src/xcDFT/one_electron_density.f90 new file mode 100644 index 0000000..ee6a654 --- /dev/null +++ b/src/xcDFT/one_electron_density.f90 @@ -0,0 +1,47 @@ +subroutine one_electron_density(nGrid,nBas,P,AO,dAO,rho,drho) + +! Calculate one-electron density + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(3,nBas,nGrid) + +! Local variables + + integer :: ixyz,iG,mu,nu + double precision,external :: trace_matrix + +! Output variables + + double precision,intent(out) :: rho(nGrid) + double precision,intent(out) :: drho(3,nGrid) + + rho(:) = 0d0 + do iG=1,nGrid + do mu=1,nBas + do nu=1,nBas + rho(iG) = rho(iG) + AO(mu,iG)*P(mu,nu)*AO(nu,iG) + enddo + enddo + enddo + + drho(:,:) = 0d0 + do ixyz=1,3 + do iG=1,nGrid + do mu=1,nBas + do nu=1,nBas + drho(ixyz,iG) = drho(ixyz,iG) & + + P(mu,nu)*(dAO(ixyz,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(ixyz,nu,iG)) + enddo + enddo + enddo + enddo + +end subroutine one_electron_density diff --git a/src/xcDFT/orthogonalization_matrix.f90 b/src/xcDFT/orthogonalization_matrix.f90 new file mode 100644 index 0000000..ed837d4 --- /dev/null +++ b/src/xcDFT/orthogonalization_matrix.f90 @@ -0,0 +1,63 @@ +subroutine orthogonalization_matrix(nBas,S,X) + +! Compute the orthogonalization matrix X = S^(-1/2) + + implicit none + +! Input variables + + integer,intent(in) :: nBas + double precision,intent(in) :: S(nBas,nBas) + +! Local variables + + logical :: debug + double precision,allocatable :: UVec(:,:),Uval(:) + double precision,parameter :: thresh = 1d-6 + + integer :: i + +! Output variables + + double precision,intent(out) :: X(nBas,nBas) + + debug = .false. + + allocate(Uvec(nBas,nBas),Uval(nBas)) + + write(*,*) + write(*,*) ' *** Lowdin orthogonalization X = S^(-1/2) *** ' + write(*,*) + + Uvec = S + call diagonalize_matrix(nBas,Uvec,Uval) + + do i=1,nBas + + if(Uval(i) > thresh) then + + Uval(i) = 1d0/sqrt(Uval(i)) + + else + + write(*,*) 'Eigenvalue',i,'too small for Lowdin orthogonalization' + + endif + + enddo + + call ADAt(nBas,Uvec,Uval,X) + +! Print results + + if(debug) then + + write(*,'(A28)') '----------------------' + write(*,'(A28)') 'Orthogonalization matrix' + write(*,'(A28)') '----------------------' + call matout(nBas,nBas,X) + write(*,*) + + endif + +end subroutine orthogonalization_matrix diff --git a/src/xcDFT/print_KS.f90 b/src/xcDFT/print_KS.f90 new file mode 100644 index 0000000..2c1d542 --- /dev/null +++ b/src/xcDFT/print_KS.f90 @@ -0,0 +1,102 @@ +subroutine print_KS(nBas,nO,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew) + +! Print one- and two-electron energies and other stuff for KS calculation + + implicit none + include 'parameters.h' + + integer,intent(in) :: nBas + integer,intent(in) :: nO(nspin) + double precision,intent(in) :: eps(nBas,nspin) + double precision,intent(in) :: c(nBas,nBas,nspin) + double precision,intent(in) :: ENuc + double precision,intent(in) :: ET(nspin) + double precision,intent(in) :: EV(nspin) + double precision,intent(in) :: EJ(nsp) + double precision,intent(in) :: Ex(nspin) + double precision,intent(in) :: Ec(nsp) + double precision,intent(in) :: Ew + + integer :: HOMO(nspin) + integer :: LUMO(nspin) + double precision :: Gap(nspin) + +! HOMO and LUMO + + HOMO(:) = nO(:) + + LUMO(:) = HOMO(:) + 1 + + Gap(1) = eps(LUMO(1),1) - eps(HOMO(1),1) + Gap(2) = eps(LUMO(2),2) - eps(HOMO(2),2) + +! Dump results + + + write(*,*) + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40)') ' Summary ' + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,1X,F16.10,A3)') ' One-electron energy: ',sum(ET(:)) + sum(EV(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' One-electron a energy: ',ET(1) + EV(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' One-electron b energy: ',ET(2) + EV(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Kinetic energy: ',sum(ET(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Kinetic a energy: ',ET(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Kinetic b energy: ',ET(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Potential energy: ',sum(EV(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Potential a energy: ',EV(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Potential b energy: ',EV(2),' au' + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron a energy: ',sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron aa energy: ',EJ(1) + Ex(1) + Ec(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron ab energy: ',EJ(2) + Ec(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron bb energy: ',EJ(3) + Ex(2) + Ec(3),' au' + write(*,'(A40,1X,F16.10,A3)') ' Coulomb energy: ',sum(EJ(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Coulomb aa energy: ',EJ(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Coulomb ab energy: ',EJ(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Coulomb bb energy: ',EJ(3),' au' + write(*,'(A40,1X,F16.10,A3)') ' Exchange energy: ',sum(Ex(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Exchange a energy: ',Ex(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Exchange b energy: ',Ex(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',sum(Ec(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',Ec(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation ab energy: ',Ec(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',Ec(3),' au' + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',Ew,' au' + write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' + write(*,'(A40,1X,F16.10,A3)') ' Kohn-Sham energy: ',Ew + ENuc,' au' + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,F13.6,A3)') ' KS HOMO a energy:',eps(HOMO(1),1)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS LUMO a energy:',eps(LUMO(1),1)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS HOMOa-LUMOa gap:',Gap(1)*HatoeV,' eV' + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,F13.6,A3)') ' KS HOMO b energy:',eps(HOMO(2),2)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS LUMO b energy:',eps(LUMO(2),2)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' KS HOMOb-LUMOb gap :',Gap(2)*HatoeV,' eV' + write(*,'(A60)') '-------------------------------------------------' + write(*,*) + +! Print results + + write(*,'(A50)') '-----------------------------------------' + write(*,'(A50)') 'Kohn-Sham spin-up orbital coefficients ' + write(*,'(A50)') '-----------------------------------------' + call matout(nBas,nBas,c(:,:,1)) + write(*,'(A50)') '-----------------------------------------' + write(*,'(A50)') 'Kohn-Sham spin-down orbital coefficients ' + write(*,'(A50)') '-----------------------------------------' + call matout(nBas,nBas,c(:,:,2)) + write(*,*) + write(*,'(A50)') '---------------------------------------' + write(*,'(A50)') ' Kohn-Sham spin-up orbital energies ' + write(*,'(A50)') '---------------------------------------' + call matout(nBas,1,eps(:,1)) + write(*,*) + write(*,'(A50)') '---------------------------------------' + write(*,'(A50)') ' Kohn-Sham spin-down orbital energies ' + write(*,'(A50)') '---------------------------------------' + call matout(nBas,1,eps(:,2)) + write(*,*) + +end subroutine print_KS diff --git a/src/xcDFT/print_individual_energy.f90 b/src/xcDFT/print_individual_energy.f90 new file mode 100644 index 0000000..c82a44e --- /dev/null +++ b/src/xcDFT/print_individual_energy.f90 @@ -0,0 +1,105 @@ +subroutine print_individual_energy(nEns,EJ,Ex,Ec,EcLZ,EcDD,E,Om) + +! Print individual energies for eDFT calculation + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nEns + double precision,intent(in) :: EJ(nsp,nEns) + double precision,intent(in) :: Ex(nspin,nEns) + double precision,intent(in) :: Ec(nsp,nEns) + double precision,intent(in) :: EcLZ(nsp) + double precision,intent(in) :: EcDD(nsp,nEns) + double precision,intent(in) :: E(nEns) + double precision,intent(in) :: Om(nEns) + +! Local variables + + integer :: iEns + +!------------------------------------------------------------------------ +! Hartree energy +!------------------------------------------------------------------------ + + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A50)') ' Individual Hartree energies' + write(*,'(A60)') '-------------------------------------------------' + do iEns=1,nEns + write(*,'(A40,I2,A2,F16.10,A3)') ' Hartree energy state ',iEns,': ',sum(EJ(:,iEns)),' au' + end do + write(*,'(A60)') '-------------------------------------------------' + write(*,*) + +!------------------------------------------------------------------------ +! Exchange energy +!------------------------------------------------------------------------ + + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A50)') ' Individual exchange energies' + write(*,'(A60)') '-------------------------------------------------' + do iEns=1,nEns + write(*,'(A40,I2,A2,F16.10,A3)') ' Exchange energy state ',iEns,': ',sum(Ex(:,iEns)),' au' + end do + write(*,'(A60)') '-------------------------------------------------' + write(*,*) + +!------------------------------------------------------------------------ +! Correlation energy +!------------------------------------------------------------------------ + + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A50)') ' Individual correlation energies' + write(*,'(A60)') '-------------------------------------------------' + do iEns=1,nEns + write(*,'(A40,I2,A2,F16.10,A3)') ' Correlation energy state ',iEns,': ',sum(Ec(:,iEns)),' au' + end do + write(*,'(A60)') '-------------------------------------------------' + write(*,*) + +!------------------------------------------------------------------------ +! Compute Levy-Zahariev shift +!------------------------------------------------------------------------ + + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,2X,2X,F16.10,A3)') ' Levy-Zahariev shifts: ',sum(EcLZ(:)),' au' + write(*,'(A60)') '-------------------------------------------------' + write(*,*) + +!------------------------------------------------------------------------ +! Compute derivative discontinuities +!------------------------------------------------------------------------ + + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A50)') ' Derivative discontinuities (DD) ' + write(*,'(A60)') '-------------------------------------------------' + do iEns=1,nEns + write(*,'(A40,I2,A2,F16.10,A3)') ' Correlation part of DD ',iEns,': ',sum(EcDD(:,iEns)),' au' + end do + write(*,'(A60)') '-------------------------------------------------' + write(*,*) + +!------------------------------------------------------------------------ +! Total and Excitation energies +!------------------------------------------------------------------------ + + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A50)') ' Individual and excitation energies ' + write(*,'(A60)') '-------------------------------------------------' + do iEns=1,nEns + write(*,'(A40,I2,A2,F16.10,A3)') ' Individual energy state ',iEns,': ',E(iEns),' au' + end do + write(*,'(A60)') '-------------------------------------------------' + do iEns=2,nEns + write(*,'(A40,I2,A2,F16.10,A3)') ' Excitation energy 1 ->',iEns,': ',Om(iEns),' au' + end do + write(*,'(A60)') '-------------------------------------------------' + do iEns=2,nEns + write(*,'(A40,I2,A2,F16.10,A3)') ' Excitation energy 1 ->',iEns,': ',Om(iEns)*HaToeV,' eV' + end do + write(*,'(A60)') '-------------------------------------------------' + write(*,*) + +end subroutine print_individual_energy diff --git a/src/xcDFT/quadrature_grid.f90 b/src/xcDFT/quadrature_grid.f90 new file mode 100644 index 0000000..420e80a --- /dev/null +++ b/src/xcDFT/quadrature_grid.f90 @@ -0,0 +1,77 @@ +subroutine quadrature_grid(nRad,nAng,nGrid,root,weight) + +! Build roots and weights of quadrature grid + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nRad,nAng,nGrid + +! Local variables + + integer :: i,j,k + double precision :: scale + double precision,allocatable :: Radius(:) + double precision,allocatable :: RadWeight(:) + double precision,allocatable :: XYZ(:,:) + double precision,allocatable :: XYZWeight(:) + +! Output variables + + double precision,intent(out) :: root(3,nGrid) + double precision,intent(out) :: weight(nGrid) + +! Memory allocation + + allocate(Radius(nRad),RadWeight(nRad),XYZ(3,nAng),XYZWeight(nAng)) + +! Findthe radial grid + + scale = 1d0 + call EulMac(Radius,RadWeight,nRad,scale) + + write(*,20) + write(*,30) + write(*,20) + do i = 1,nRad + write(*,40) i,Radius(i),RadWeight(i) + end do + write(*,20) + write(*,*) + +! Find the angular grid + + call Lebdev(XYZ,XYZWeight,nAng) + + write(*,20) + write(*,50) + write(*,20) + do j = 1,nAng + write(*,60) j,(XYZ(k,j),k=1,3), XYZWeight(j) + end do + write(*,20) + +! Form the roots and weights + + k = 0 + do i=1,nRad + do j=1,nAng + k = k + 1 + root(:,k) = Radius(i)*XYZ(:,j) + weight(k) = RadWeight(i)*XYZWeight(j) + enddo + enddo + +! Compute values of the basis functions (and the its gradient if required) at each grid point + +20 format(T2,58('-')) +30 format(T20,'Radial Quadrature',/, & + T6,'I',T26,'Radius',T50,'Weight') +40 format(T3,I4,T18,F17.10,T35,F25.10) +50 format(T20,'Angular Quadrature',/, & + T6,'I',T19,'X',T29,'Y',T39,'Z',T54,'Weight') +60 format(T3,I4,T13,3F10.5,T50,F10.5) + +end subroutine quadrature_grid diff --git a/src/xcDFT/read_basis.f90 b/src/xcDFT/read_basis.f90 new file mode 100644 index 0000000..f3cc123 --- /dev/null +++ b/src/xcDFT/read_basis.f90 @@ -0,0 +1,119 @@ +subroutine read_basis(nAt,rAt,nBas,nO,nV,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell) + +! Read basis set information + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nAt,nO(nspin) + double precision,intent(in) :: rAt(nAt,ncart) + +! Local variables + + integer :: nShAt,iAt,iShell + integer :: i,j,k + character :: shelltype + +! Output variables + + integer,intent(out) :: nShell,nBas + double precision,intent(out) :: CenterShell(maxShell,ncart) + integer,intent(out) :: TotAngMomShell(maxShell),KShell(maxShell) + double precision,intent(out) :: DShell(maxShell,maxK),ExpShell(maxShell,maxK) + integer,intent(out) :: nV(nspin) + +!------------------------------------------------------------------------ +! Primary basis set information +!------------------------------------------------------------------------ + +! Open file with basis set specification + + open(unit=2,file='input/basis') + +! Read basis information + + write(*,'(A28)') 'Gaussian basis set' + write(*,'(A28)') '------------------' + + nShell = 0 + do i=1,nAt + read(2,*) iAt,nShAt + write(*,'(A28,1X,I16)') 'Atom n. ',iAt + write(*,'(A28,1X,I16)') 'number of shells ',nShAt + write(*,'(A28)') '------------------' + +! Basis function centers + + do j=1,nShAt + nShell = nShell + 1 + do k=1,ncart + CenterShell(nShell,k) = rAt(iAt,k) + enddo + +! Shell type and contraction degree + + read(2,*) shelltype,KShell(nShell) + if(shelltype == "S") then + TotAngMomShell(nShell) = 0 + write(*,'(A28,1X,I16)') 's-type shell with K = ',KShell(nShell) + elseif(shelltype == "P") then + TotAngMomShell(nShell) = 1 + write(*,'(A28,1X,I16)') 'p-type shell with K = ',KShell(nShell) + elseif(shelltype == "D") then + TotAngMomShell(nShell) = 2 + write(*,'(A28,1X,I16)') 'd-type shell with K = ',KShell(nShell) + elseif(shelltype == "F") then + TotAngMomShell(nShell) = 3 + write(*,'(A28,1X,I16)') 'f-type shell with K = ',KShell(nShell) + elseif(shelltype == "G") then + TotAngMomShell(nShell) = 4 + write(*,'(A28,1X,I16)') 'g-type shell with K = ',KShell(nShell) + elseif(shelltype == "H") then + TotAngMomShell(nShell) = 5 + write(*,'(A28,1X,I16)') 'h-type shell with K = ',KShell(nShell) + elseif(shelltype == "I") then + TotAngMomShell(nShell) = 6 + write(*,'(A28,1X,I16)') 'i-type shell with K = ',KShell(nShell) + endif + +! Read exponents and contraction coefficients + + write(*,'(A28,1X,A16,A16)') '','Exponents','Contraction' + do k=1,Kshell(nShell) + read(2,*) ExpShell(nShell,k),DShell(nShell,k) + write(*,'(A28,1X,F16.10,F16.10)') '',ExpShell(nShell,k),DShell(nShell,k) + enddo + enddo + write(*,'(A28)') '------------------' + enddo + +! Total number of shells + + write(*,'(A28,1X,I16)') 'Number of shells',nShell + write(*,'(A28)') '------------------' + write(*,*) + +! Close file with basis set specification + + close(unit=2) + +! Calculate number of basis functions + + nBas = 0 + do iShell=1,nShell + nBas = nBas + (TotAngMomShell(iShell)*TotAngMomShell(iShell) + 3*TotAngMomShell(iShell) + 2)/2 + enddo + + write(*,'(A28)') '------------------' + write(*,'(A28,1X,I16)') 'Number of basis functions',NBas + write(*,'(A28)') '------------------' + write(*,*) + +! Number of virtual orbitals + + nV(1) = nBas - nO(1) + nV(2) = nBas - nO(2) + +end subroutine read_basis diff --git a/src/xcDFT/read_geometry.f90 b/src/xcDFT/read_geometry.f90 new file mode 100644 index 0000000..60c60b8 --- /dev/null +++ b/src/xcDFT/read_geometry.f90 @@ -0,0 +1,68 @@ +subroutine read_geometry(nAt,ZNuc,rA,ENuc) + +! Read molecular geometry + + implicit none + + include 'parameters.h' + +! Ouput variables + + integer,intent(in) :: nAt + +! Local variables + + integer :: i,j + double precision :: RAB + character(len=2) :: El + integer,external :: element_number + +! Ouput variables + + double precision,intent(out) :: ZNuc(NAt),rA(nAt,ncart),ENuc + +! Open file with geometry specification + + open(unit=1,file='input/molecule') + +! Read geometry + + read(1,*) + read(1,*) + read(1,*) + + do i=1,nAt + read(1,*) El,rA(i,1),rA(i,2),rA(i,3) + ZNuc(i) = element_number(El) + enddo + +! Compute nuclear repulsion energy + + ENuc = 0 + + do i=1,nAt-1 + do j=i+1,nAt + RAB = (rA(i,1)-rA(j,1))**2 + (rA(i,2)-rA(j,2))**2 + (rA(i,3)-rA(j,3))**2 + ENuc = ENuc + ZNuc(i)*ZNuc(j)/sqrt(RAB) + enddo + enddo + +! Close file with geometry specification + close(unit=1) + +! Print geometry + write(*,'(A28)') '------------------' + write(*,'(A28)') 'Molecular geometry' + write(*,'(A28)') '------------------' + do i=1,NAt + write(*,'(A28,1X,I16)') 'Atom n. ',i + write(*,'(A28,1X,F16.10)') 'Z = ',ZNuc(i) + write(*,'(A28,1X,F16.10,F16.10,F16.10)') 'Atom coordinates:',(rA(i,j),j=1,ncart) + enddo + write(*,*) + write(*,'(A28)') '------------------' + write(*,'(A28,1X,F16.10)') 'Nuclear repulsion energy = ',ENuc + write(*,'(A28)') '------------------' + write(*,*) + +end subroutine read_geometry diff --git a/src/xcDFT/read_grid.f90 b/src/xcDFT/read_grid.f90 new file mode 100644 index 0000000..5cf4391 --- /dev/null +++ b/src/xcDFT/read_grid.f90 @@ -0,0 +1,47 @@ +subroutine read_grid(SGn,nRad,nAng,nGrid) + +! Read grid type + + implicit none + +! Input variables + + integer,intent(in) :: SGn + +! Output variables + + integer,intent(out) :: nRad + integer,intent(out) :: nAng + integer,intent(out) :: nGrid + + write(*,*)'----------------------------------------------------------' + write(*,'(A22,I1)')' Quadrature grid: SG-',SGn + write(*,*)'----------------------------------------------------------' + + select case (SGn) + + case(0) + nRad = 23 + nAng = 170 + + case(1) + nRad = 50 + nAng = 194 + + case(2) + nRad = 75 + nAng = 302 + + case(3) + nRad = 99 + nAng = 590 + + case default + call print_warning('!!! Quadrature grid not available !!!') + stop + + end select + + nGrid = nRad*nAng + +end subroutine read_grid diff --git a/src/xcDFT/read_integrals.f90 b/src/xcDFT/read_integrals.f90 new file mode 100644 index 0000000..fa435d1 --- /dev/null +++ b/src/xcDFT/read_integrals.f90 @@ -0,0 +1,114 @@ +subroutine read_integrals(nBas,S,T,V,Hc,G) + +! Read one- and two-electron integrals from files + + implicit none + +! Input variables + + integer,intent(in) :: nBas + +! Local variables + + logical :: debug + integer :: mu,nu,la,si + double precision :: Ov,Kin,Nuc,ERI + +! Output variables + + double precision,intent(out) :: S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),G(nBas,nBas,nBas,nBas) + +! Open file with integrals + + debug = .false. + + open(unit=8 ,file='int/Ov.dat') + open(unit=9 ,file='int/Kin.dat') + open(unit=10,file='int/Nuc.dat') + open(unit=11,file='int/ERI.dat') + +! Read overlap integrals + + S = 0d0 + do + read(8,*,end=8) mu,nu,Ov + S(mu,nu) = Ov + enddo + 8 close(unit=8) + +! Read kinetic integrals + + T = 0d0 + do + read(9,*,end=9) mu,nu,Kin + T(mu,nu) = Kin + enddo + 9 close(unit=9) + +! Read nuclear integrals + + V = 0d0 + do + read(10,*,end=10) mu,nu,Nuc + V(mu,nu) = Nuc + enddo + 10 close(unit=10) + +! Define core Hamiltonian + + Hc = T + V + +! Read nuclear integrals + + G = 0d0 + do + read(11,*,end=11) mu,nu,la,si,ERI +! (12|34) + G(mu,nu,la,si) = ERI +! (21|34) + G(nu,mu,la,si) = ERI +! (12|43) + G(mu,nu,si,la) = ERI +! (21|43) + G(nu,mu,si,la) = ERI +! (34|12) + G(la,si,mu,nu) = ERI +! (43|12) + G(si,la,mu,nu) = ERI +! (34|21) + G(la,si,nu,mu) = ERI +! (43|21) + G(si,la,nu,mu) = ERI + enddo + 11 close(unit=11) + + +! Print results + if(debug) then + write(*,'(A28)') '----------------------' + write(*,'(A28)') 'Overlap integrals' + write(*,'(A28)') '----------------------' + call matout(nBas,nBas,S) + write(*,*) + write(*,'(A28)') '----------------------' + write(*,'(A28)') 'Kinetic integrals' + write(*,'(A28)') '----------------------' + call matout(nBas,nBas,T) + write(*,*) + write(*,'(A28)') '----------------------' + write(*,'(A28)') 'Nuclear integrals' + write(*,'(A28)') '----------------------' + call matout(nBas,nBas,V) + write(*,*) + write(*,'(A28)') '----------------------' + write(*,'(A28)') 'Electron repulsion integrals' + write(*,'(A28)') '----------------------' + do la=1,nBas + do si=1,nBas + call matout(nBas,nBas,G(1,1,la,si)) + enddo + enddo + write(*,*) + endif + +end subroutine read_integrals diff --git a/src/xcDFT/read_molecule.f90 b/src/xcDFT/read_molecule.f90 new file mode 100644 index 0000000..3422526 --- /dev/null +++ b/src/xcDFT/read_molecule.f90 @@ -0,0 +1,52 @@ +subroutine read_molecule(nAt,nEl,nO) + +! Read number of atoms nAt and number of electrons nEl + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(out) :: nAt,nEl(nspin),nO(nspin) + +! Local variables + + integer :: n + +! Open file with geometry specification + + open(unit=1,file='input/molecule') + +! Read number of atoms and number of electrons + + read(1,*) + read(1,*) nAt,n,nEl(1),nEl(2) + +! Check imput consistency + + if(n /= sum(nEl(:))) then + write(*,*) 'number of electrons inconsistent' + stop + endif + + nO(:) = nEl(:) + +! Print results + + write(*,'(A28)') '----------------------' + write(*,'(A28,1X,I16)') 'Number of atoms',nAt + write(*,'(A28)') '----------------------' + write(*,*) + write(*,'(A28)') '----------------------' + write(*,'(A28,1X,I16)') 'Number of spin-up electrons',nEl(1) + write(*,'(A28,1X,I16)') 'Number of spin-down electrons',nEl(2) + write(*,'(A28,1X,I16)') 'Total number of electrons',sum(nEl(:)) + write(*,'(A28)') '----------------------' + write(*,*) + +! Close file with geometry specification + + close(unit=1) + +end subroutine read_molecule diff --git a/src/xcDFT/read_options.f90 b/src/xcDFT/read_options.f90 new file mode 100644 index 0000000..ff96627 --- /dev/null +++ b/src/xcDFT/read_options.f90 @@ -0,0 +1,106 @@ +subroutine read_options(x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,maxSCF,thresh,DIIS,max_diis,guess_type,ortho_type) + +! Read DFT options + + implicit none + + include 'parameters.h' + +! Local variables + + integer :: I + +! Output variables + + integer,intent(out) :: x_rung,c_rung + character(len=12),intent(out) :: x_DFA, c_DFA + integer,intent(out) :: SGn + integer,intent(out) :: nEns + double precision,intent(out) :: wEns(maxEns) + + integer,intent(out) :: maxSCF + double precision,intent(out) :: thresh + logical,intent(out) :: DIIS + integer,intent(out) :: max_diis + integer,intent(out) :: guess_type + integer,intent(out) :: ortho_type + +! Local variables + + character(len=1) :: answer + +! Open file with method specification + + open(unit=1,file='input/options') + +! Default values + + x_rung = 1 + c_rung = 1 + x_DFA = 'S51' + c_DFA = 'W38' + SGn = 0 + wEns(:) = 0d0 + +! EXCHANGE: read rung of Jacob's ladder + + read(1,*) + read(1,*) x_rung,x_DFA + +! CORRELATION: read rung of Jacob's ladder + + read(1,*) + read(1,*) c_rung,c_DFA + +! Read SG-n grid + + read(1,*) + read(1,*) SGn + +! Read number of states in ensemble + + read(1,*) + read(1,*) nEns + + if(nEns.gt.maxEns) then + write(*,*) ' Number of states in ensemble too big!! ' + stop + endif + + write(*,*)'----------------------------------------------------------' + write(*,'(A33,I3)')' Number of states in ensemble = ',nEns + write(*,*)'----------------------------------------------------------' + write(*,*) + +! Read ensemble weights + read(1,*) + read(1,*) (wEns(I),I=2,nEns) + wEns(1) = 1d0 - sum(wEns) + + write(*,*)'----------------------------------------------------------' + write(*,*)' Ensemble weights ' + write(*,*)'----------------------------------------------------------' + call matout(nEns,1,wEns) + write(*,*) + +! Read KS options + + maxSCF = 64 + thresh = 1d-6 + DIIS = .false. + max_diis = 5 + guess_type = 1 + ortho_type = 1 + + read(1,*) + read(1,*) maxSCF,thresh,answer,max_diis,guess_type,ortho_type + + if(answer == 'T') DIIS = .true. + + if(.not.DIIS) max_diis = 1 + +! Close file with options + + close(unit=1) + +end subroutine read_options diff --git a/src/xcDFT/select_rung.f90 b/src/xcDFT/select_rung.f90 new file mode 100644 index 0000000..3d20c3a --- /dev/null +++ b/src/xcDFT/select_rung.f90 @@ -0,0 +1,53 @@ +subroutine select_rung(rung,DFA) + +! Select rung of Jacob's ladder + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: rung + character(len=12),intent(in) :: DFA + + select case (rung) + +! Hartree calculation + case(0) + write(*,*) "* 0th rung of Jacob's ladder: Hartree calculation *" + +! LDA functionals + case(1) + write(*,*) "* 1st rung of Jacob's ladder: local-density approximation (LDA) *" + +! GGA functionals + case(2) + write(*,*) "* 2nd rung of Jacob's ladder: generalized gradient approximation (GGA) *" + +! meta-GGA functionals + case(3) + write(*,*) "* 3rd rung of Jacob's ladder: meta-GGA functional (MGGA) *" + +! Hybrid functionals + case(4) + write(*,*) "* 4th rung of Jacob's ladder: hybrid functional *" + +! Hartree-Fock calculation + case(666) + write(*,*) "* rung 666: Hartree-Fock calculation *" + +! Default + case default + write(*,*) "!!! rung not available !!!" + stop + + end select + + ! Print selected functional + + write(*,*) '* You have selected the following functional: ',DFA,' *' + write(*,*) '*******************************************************************' + write(*,*) + + +end subroutine select_rung diff --git a/src/xcDFT/utils.f90 b/src/xcDFT/utils.f90 new file mode 100644 index 0000000..4142b10 --- /dev/null +++ b/src/xcDFT/utils.f90 @@ -0,0 +1,400 @@ +!------------------------------------------------------------------------ +function Kronecker_delta(i,j) result(delta) + +! Kronecker Delta + + implicit none + +! Input variables + + integer,intent(in) :: i,j + +! Output variables + + double precision :: delta + + if(i == j) then + delta = 1d0 + else + delta = 0d0 + endif + +end function Kronecker_delta + +!------------------------------------------------------------------------ +subroutine matout(m,n,A) + +! Print the MxN array A + + implicit none + + integer,parameter :: ncol = 5 + double precision,parameter :: small = 1d-10 + integer,intent(in) :: m,n + double precision,intent(in) :: A(m,n) + double precision :: B(ncol) + integer :: ilower,iupper,num,i,j + + do ilower=1,n,ncol + iupper = min(ilower + ncol - 1,n) + num = iupper - ilower + 1 + write(*,'(3X,10(9X,I6))') (j,j=ilower,iupper) + do i=1,m + do j=ilower,iupper + B(j-ilower+1) = A(i,j) + enddo + do j=1,num + if(abs(B(j)) < small) B(j) = 0d0 + enddo + write(*,'(I7,10F15.8)') i,(B(j),j=1,num) + enddo + enddo + +end subroutine matout + +!------------------------------------------------------------------------ +subroutine trace_vector(n,v,Tr) + +! Calculate the trace of the vector v of length n +!!! Please use the intrinsic fortran sum() !!! + + implicit none + +! Input variables + + integer,intent(in) :: n + double precision,intent(in) :: v(n) + +! Local variables + + integer :: i + +! Output variables + + double precision,intent(out) :: Tr + + Tr = 0d0 + do i=1,n + Tr = Tr + v(i) + enddo + +end subroutine trace_vector + +!------------------------------------------------------------------------ +function trace_matrix(n,A) result(Tr) + +! Calculate the trace of the square matrix A + + implicit none + +! Input variables + + integer,intent(in) :: n + double precision,intent(in) :: A(n,n) + +! Local variables + + integer :: i + +! Output variables + + double precision :: Tr + + Tr = 0d0 + do i=1,n + Tr = Tr + A(i,i) + enddo + +end function trace_matrix + +!------------------------------------------------------------------------ +subroutine compute_error(nData,Mean,Var,Error) + +! Calculate the statistical error + + implicit none + +! Input variables + + double precision,intent(in) :: nData,Mean(3) + +! Output variables + + double precision,intent(out) :: Error(3) + double precision,intent(inout):: Var(3) + + Error = sqrt((Var-Mean**2/nData)/nData/(nData-1d0)) + +end subroutine compute_error + +!------------------------------------------------------------------------ +subroutine identity_matrix(N,A) + +! Set the matrix A to the identity matrix + + implicit none + +! Input variables + + integer,intent(in) :: N + +! Local viaruabkes + + integer :: i + +! Output variables + + double precision,intent(out) :: A(N,N) + + A = 0d0 + + do i=1,N + A(i,i) = 1d0 + enddo + +end subroutine identity_matrix + +!------------------------------------------------------------------------ +subroutine prepend(N,M,A,b) + +! Prepend the vector b of size N into the matrix A of size NxM + + implicit none + +! Input variables + + integer,intent(in) :: N,M + double precision,intent(in) :: b(N) + +! Local viaruabkes + + integer :: i,j + +! Output variables + + double precision,intent(out) :: A(N,M) + + +! print*,'b in append' +! call matout(N,1,b) + + do i=1,N + do j=M-1,1,-1 + A(i,j+1) = A(i,j) + enddo + A(i,1) = b(i) + enddo + +end subroutine prepend + +!------------------------------------------------------------------------ +subroutine append(N,M,A,b) + +! Append the vector b of size N into the matrix A of size NxM + + implicit none + +! Input variables + + integer,intent(in) :: N,M + double precision,intent(in) :: b(N) + +! Local viaruabkes + + integer :: i,j + +! Output variables + + double precision,intent(out) :: A(N,M) + + do i=1,N + do j=2,M + A(i,j-1) = A(i,j) + enddo + A(i,M) = b(i) + enddo + +end subroutine append + +!------------------------------------------------------------------------ +subroutine AtDA(N,A,D,B) + +! Perform B = At.D.A where A is a NxN matrix and D is a diagonal matrix given +! as a vector of length N + + implicit none + +! Input variables + + integer,intent(in) :: N + double precision,intent(in) :: A(N,N),D(N) + +! Local viaruabkes + + integer :: i,j,k + +! Output variables + + double precision,intent(out) :: B(N,N) + + B = 0d0 + + do i=1,N + do j=1,N + do k=1,N + B(i,k) = B(i,k) + A(j,i)*D(j)*A(j,k) + enddo + enddo + enddo + +end subroutine AtDA + +!------------------------------------------------------------------------ +subroutine ADAt(N,A,D,B) + +! Perform B = A.D.At where A is a NxN matrix and D is a diagonal matrix given +! as a vector of length N + + implicit none + +! Input variables + + integer,intent(in) :: N + double precision,intent(in) :: A(N,N),D(N) + +! Local viaruabkes + + integer :: i,j,k + +! Output variables + + double precision,intent(out) :: B(N,N) + + B = 0d0 + + do i=1,N + do j=1,N + do k=1,N + B(i,k) = B(i,k) + A(i,j)*D(j)*A(k,j) + enddo + enddo + enddo + +end subroutine ADAt +!------------------------------------------------------------------------ +subroutine DA(N,D,A) + +! Perform A <- D.A where A is a NxN matrix and D is a diagonal matrix given +! as a vector of length N + + implicit none + + integer,intent(in) :: N + integer :: i,j,k + double precision,intent(in) :: D(N) + double precision,intent(inout):: A(N,N) + + do i=1,N + do j=1,N + A(i,j) = D(i)*A(i,j) + enddo + enddo + +end subroutine DA + +!------------------------------------------------------------------------ +subroutine AD(N,A,D) + +! Perform A <- A.D where A is a NxN matrix and D is a diagonal matrix given +! as a vector of length N + + implicit none + + integer,intent(in) :: N + integer :: i,j,k + double precision,intent(in) :: D(N) + double precision,intent(inout):: A(N,N) + + do i=1,N + do j=1,N + A(i,j) = A(i,j)*D(j) + enddo + enddo + +end subroutine AD + +!------------------------------------------------------------------------ + +subroutine print_warning(message) + +! Print warning + + implicit none + + character(len=*),intent(in) :: message + + write(*,*) message + +end subroutine print_warning + +!------------------------------------------------------------------------ +recursive function fac(n) result(fact) + + implicit none + integer :: fact + integer, intent(in) :: n + + if (n == 0) then + fact = 1 + else + fact = n * fac(n-1) + end if + +end function fac + +!------------------------------------------------------------------------ + +function dfac(n) result(fact) + + implicit none + double precision :: fact + integer, intent(in) :: n + integer :: fac + + fact = dble(fac(n)) + +end function dfac + +!------------------------------------------------------------------------ + +function NormCoeff(alpha,a) + +! Compute normalization coefficients for cartesian gaussians + + implicit none + +! Input variables + + double precision,intent(in) :: alpha + integer,intent(in) :: a(3) + +! local variable + double precision :: pi,dfa(3),dfac + integer :: atot + +! Output variable + double precision NormCoeff + + pi = 4d0*atan(1d0) + atot = a(1) + a(2) + a(3) + + dfa(1) = dfac(2*a(1))/(2d0**a(1)*dfac(a(1))) + dfa(2) = dfac(2*a(2))/(2d0**a(2)*dfac(a(2))) + dfa(3) = dfac(2*a(3))/(2d0**a(3)*dfac(a(3))) + + + NormCoeff = (2d0*alpha/pi)**(3d0/2d0)*(4d0*alpha)**atot + NormCoeff = NormCoeff/(dfa(1)*dfa(2)*dfa(3)) + NormCoeff = sqrt(NormCoeff) + +end function NormCoeff diff --git a/src/xcDFT/wrap_lapack.f90 b/src/xcDFT/wrap_lapack.f90 new file mode 100644 index 0000000..6c29ab7 --- /dev/null +++ b/src/xcDFT/wrap_lapack.f90 @@ -0,0 +1,207 @@ +!subroutine eigenvalues_non_symmetric_matrix(N,A,e) +! +!! Diagonalize a square matrix +! +! implicit none +! +!! Input variables +! +! integer,intent(in) :: N +! double precision,intent(inout):: A(N,N) +! double precision,intent(out) :: e(N) +! +!! Local variables +! +! integer :: lwork,info +! double precision,allocatable :: work(:) +! +!! Memory allocation +! +! allocate(eRe(N),eIm(N),work(3*N)) +! lwork = size(work) +! +! call DGEEV('N','N',N,A,N, eRe, eIm, 0d0,1, VR,LDVR, WORK, LWORK, INFO ) +! +! if(info /= 0) then +! print*,'Problem in diagonalize_matrix (dseev)!!' +! stop +! endif +! +!end subroutine eigenvalues_non_symmetric_matrix + +subroutine diagonalize_matrix(N,A,e) + +! Diagonalize a square matrix + + implicit none + +! Input variables + + integer,intent(in) :: N + double precision,intent(inout):: A(N,N) + double precision,intent(out) :: e(N) + +! Local variables + + integer :: lwork,info + double precision,allocatable :: work(:) + +! Memory allocation + + allocate(work(3*N)) + lwork = size(work) + + call dsyev('V','U',N,A,N,e,work,lwork,info) + + if(info /= 0) then + print*,'Problem in diagonalize_matrix (dsyev)!!' + endif + +end subroutine diagonalize_matrix + +subroutine svd(N,A,U,D,Vt) + + ! Compute A = U.D.Vt + ! Dimension of A is NxN + + implicit none + + integer, intent(in) :: N + double precision,intent(in) :: A(N,N) + double precision,intent(out) :: U(N,N) + double precision,intent(out) :: Vt(N,N) + double precision,intent(out) :: D(N) + double precision,allocatable :: work(:) + integer :: info,lwork + + double precision,allocatable :: scr(:,:) + + allocate (scr(N,N)) + + scr(:,:) = A(:,:) + + ! Find optimal size for temporary arrays + + allocate(work(1)) + + lwork = -1 + call dgesvd('A','A',N,N,scr,N,D,U,N,Vt,N,work,lwork,info) + lwork = int(work(1)) + + deallocate(work) + + allocate(work(lwork)) + + call dgesvd('A','A',N,N,scr,N,D,U,N,Vt,N,work,lwork,info) + + deallocate(work,scr) + + if (info /= 0) then + print *, info, ': SVD failed' + stop + endif + +end + +subroutine inverse_matrix(N,A,B) + +! Returns the inverse of the square matrix A in B + + implicit none + + integer,intent(in) :: N + double precision, intent(in) :: A(N,N) + double precision, intent(out) :: B(N,N) + + integer :: info,lwork + integer, allocatable :: ipiv(:) + double precision,allocatable :: work(:) + + allocate (ipiv(N),work(N*N)) + lwork = size(work) + + B(1:N,1:N) = A(1:N,1:N) + + call dgetrf(N,N,B,N,ipiv,info) + + if (info /= 0) then + + print*,info + stop 'error in inverse (dgetrf)!!' + + endif + + call dgetri(N,B,N,ipiv,work,lwork,info) + + if (info /= 0) then + + print *, info + stop 'error in inverse (dgetri)!!' + + endif + + deallocate(ipiv,work) + +end subroutine inverse_matrix + +subroutine linear_solve(N,A,b,x,rcond) + +! Solve the linear system A.x = b where A is a NxN matrix +! and x and x are vectors of size N + + implicit none + + integer,intent(in) :: N + double precision,intent(in) :: A(N,N),b(N),rcond + double precision,intent(out) :: x(N) + + integer :: info,lwork + double precision :: ferr,berr + integer,allocatable :: ipiv(:),iwork(:) + double precision,allocatable :: AF(:,:),work(:) + + lwork = 3*N + allocate(AF(N,N),ipiv(N),work(lwork),iwork(N)) + + call dsysvx('N','U',N,1,A,N,AF,N,ipiv,b,N,x,N,rcond,ferr,berr,work,lwork,iwork,info) + +! if (info /= 0) then + +! print *, info +! stop 'error in linear_solve (dsysvx)!!' + +! endif + +end subroutine linear_solve + +subroutine easy_linear_solve(N,A,b,x) + +! Solve the linear system A.x = b where A is a NxN matrix +! and x and x are vectors of size N + + implicit none + + integer,intent(in) :: N + double precision,intent(in) :: A(N,N),b(N) + double precision,intent(out) :: x(N) + + integer :: info,lwork + integer,allocatable :: ipiv(:) + double precision,allocatable :: work(:) + + allocate(ipiv(N),work(N*N)) + lwork = size(work) + + x = b + + call dsysv('U',N,1,A,N,ipiv,x,N,work,lwork,info) + + if (info /= 0) then + + print *, info + stop 'error in linear_solve (dsysv)!!' + + endif + +end subroutine easy_linear_solve +