diff --git a/bin/lowdin b/bin/lowdin index 76465d52..71d55c69 100755 --- a/bin/lowdin +++ b/bin/lowdin @@ -358,7 +358,7 @@ if [ $extFile="lowdin" ]; then fi gawk '($1~/BASIS/ && toupper($2)~/^'$BASIS_NAME'$/){flag=1; next} ($0~/END/){flag=0}; - (flag==1){print toupper($0)}' $nameFile > $LOWDIN_DATA/basis/$BASIS_NAME + (flag==1){print toupper($0)}' $nameFile > $BASIS_NAME.$PID done fi @@ -393,6 +393,14 @@ if [ $extFile="lowdin" ]; then mv $nameFile*.over $LOWDIN_SCRATCH/$nameFile &> /dev/null mv $nameFile*.kin $LOWDIN_SCRATCH/$nameFile &> /dev/null mv $nameFile*.coeff $LOWDIN_SCRATCH/$nameFile &> /dev/null + #PID to avoid basis duplicates in simultaneous calculations + if [ ${#BASIS_NAMES[@]} -gt "0" ] + then + for BASIS_NAME in ${BASIS_NAMES[@]} + do + mv $BASIS_NAME.$PID $LOWDIN_SCRATCH/$nameFile/$BASIS_NAME &> /dev/null + done + fi if [ -e $nameFile.gms.bs ] then @@ -492,15 +500,6 @@ if [ $extFile="lowdin" ]; then rm -rf $LOWDIN_SCRATCH/$nameFile fi - ### Clean custom basis files - if [ ${#BASIS_NAMES[@]} -gt "0" ] - then - for BASIS_NAME in ${BASIS_NAMES[@]} - do - rm $LOWDIN_DATA/basis/$BASIS_NAME - done - fi - else echo $1 ", this file does not exist. " exit 1 diff --git a/lib/basis/NAKAI-CC-PVDZ b/lib/basis/NAKAI-CC-PVDZ new file mode 100644 index 00000000..cf7c2174 --- /dev/null +++ b/lib/basis/NAKAI-CC-PVDZ @@ -0,0 +1,14 @@ +O-HYDROGEN H (CC-PVDZ) BASIS TYPE: 1 +# +5 +1 0 1 +13.01000000 1.0 +2 0 1 +1.96200000 1.0 +3 0 1 +0.44460000 1.0 +4 0 1 +0.12200000 1.00000000 +5 1 1 +0.72700000 1.00000000 + diff --git a/src/CI/CIStrings.f90 b/src/CI/CIStrings.f90 index 68dcd970..16603832 100644 --- a/src/CI/CIStrings.f90 +++ b/src/CI/CIStrings.f90 @@ -46,7 +46,7 @@ subroutine CIStrings_buildStrings() CIcore_instance%numberOfStrings(i)%values(1) = 1 !! ground - write (*,"(A,A)") " ", MolecularSystem_getNameOfSpecie(i) + write (*,"(A,A)") " ", MolecularSystem_getNameOfSpecies(i) do cilevel = 1,CIcore_instance%CILevel(i) diff --git a/src/CI/CIcore.f90 b/src/CI/CIcore.f90 index 5adb3a32..8021df01 100644 --- a/src/CI/CIcore.f90 +++ b/src/CI/CIcore.f90 @@ -152,7 +152,7 @@ subroutine CIcore_constructor(level) do i=1, numberOfSpecies - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( i ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( i ) ) numberOfContractions = MolecularSystem_getTotalNumberOfContractions( i ) arguments(2) = nameOfSpecie diff --git a/src/CI/CImod.f90 b/src/CI/CImod.f90 index aabcf038..3acc0911 100644 --- a/src/CI/CImod.f90 +++ b/src/CI/CImod.f90 @@ -111,9 +111,9 @@ subroutine CImod_run() write (*,"(A32)",advance="no") "Number of orbitals for species: " do i = 1, numberOfSpecies-1 - write (*,"(A)",advance="no") trim(MolecularSystem_getNameOfSpecie(i))//", " + write (*,"(A)",advance="no") trim(MolecularSystem_getNameOfSpecies(i))//", " end do - write (*,"(A)",advance="no") trim(MolecularSystem_getNameOfSpecie(numberOfSpecies)) + write (*,"(A)",advance="no") trim(MolecularSystem_getNameOfSpecies(numberOfSpecies)) write (*,*) "" write (*,"(A28)",advance="no") " occupied orbitals: " @@ -558,7 +558,7 @@ subroutine CImod_getTransformedIntegrals() allocate(CIcore_instance%fourIndexArray(numberOfSpecies)) do i=1, numberOfSpecies - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( i ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( i ) ) specieID = MolecularSystem_getSpecieID( nameOfSpecie=nameOfSpecie ) ocupationNumber = MolecularSystem_getOcupationNumber( i ) numberOfContractions = MolecularSystem_getTotalNumberOfContractions( i ) @@ -577,7 +577,7 @@ subroutine CImod_getTransformedIntegrals() open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted") - arguments(2) = MolecularSystem_getNameOfSpecie(i) + arguments(2) = MolecularSystem_getNameOfSpecies(i) arguments(1) = "COEFFICIENTS" coefficients = & @@ -651,7 +651,7 @@ subroutine CImod_getTransformedIntegrals() if ( numberOfSpecies > 1 ) then do j = 1 , numberOfSpecies if ( i .ne. j) then - nameOfOtherSpecie = trim( MolecularSystem_getNameOfSpecie( j ) ) + nameOfOtherSpecie = trim( MolecularSystem_getNameOfSpecies( j ) ) otherSpecieID = MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecie ) ocupationNumberOfOtherSpecie = MolecularSystem_getOcupationNumber( j ) numberOfContractionsOfOtherSpecie = MolecularSystem_getTotalNumberOfContractions( j ) @@ -1077,7 +1077,7 @@ subroutine CImod_densityMatrices() !Inicializando las matrices do species=1, numberOfSpecies - speciesName = MolecularSystem_getNameOfSpecie(species) + speciesName = MolecularSystem_getNameOfSpecies(species) numberOfContractions = MolecularSystem_getTotalNumberOfContractions( species ) ! numberOfOrbitals = CIcore_instance%numberOfOrbitals%values(species) @@ -1388,7 +1388,7 @@ subroutine CImod_densityMatrices() !! Building the CI reduced density matrix in the atomic orbital representation do species=1, numberOfSpecies - speciesName = MolecularSystem_getNameOfSpecie(species) + speciesName = MolecularSystem_getNameOfSpecies(species) numberOfContractions = MolecularSystem_getTotalNumberOfContractions( species ) do state=1, CONTROL_instance%CI_STATES_TO_PRINT @@ -1472,7 +1472,7 @@ subroutine CImod_densityMatrices() write(*,*) "-----------------" numberOfContractions = MolecularSystem_getTotalNumberOfContractions( species ) - speciesName = MolecularSystem_getNameOfSpecie(species) + speciesName = MolecularSystem_getNameOfSpecies(species) call Vector_constructor ( auxdensityEigenValues, & @@ -1684,7 +1684,7 @@ subroutine CImod_densityMatrices() ! end do ! !Write occupation numbers to file - ! write (6,"(T8,A10,A20)") trim(MolecularSystem_getNameOfSpecie(specie)),"OCCUPATIONS:" + ! write (6,"(T8,A10,A20)") trim(MolecularSystem_getNameOfSpecies(specie)),"OCCUPATIONS:" ! call Matrix_show ( ciOccupationNumbers ) diff --git a/src/CI/Configuration.f90 b/src/CI/Configuration.f90 index 030963e4..2f33fe8a 100644 --- a/src/CI/Configuration.f90 +++ b/src/CI/Configuration.f90 @@ -1147,7 +1147,7 @@ subroutine Configuration_show(this) do i=1, numberOfSpecies - print *, "For specie ", MolecularSystem_getNameOfSpecie ( i ) + print *, "For specie ", MolecularSystem_getNameOfSpecies( i ) ! print *, "Excitations: ", this%order(i) ! print *, "Ndeterminants: ",this%nDeterminants ! print *, "Occupations" diff --git a/src/CalcProp/CalculateProperties.f90 b/src/CalcProp/CalculateProperties.f90 index dd8a8ce5..bce2dbdd 100755 --- a/src/CalcProp/CalculateProperties.f90 +++ b/src/CalcProp/CalculateProperties.f90 @@ -146,10 +146,10 @@ subroutine CalculateProperties_constructor( this,fileName ) open(unit = occupationsUnit, file=trim(occupationsFile), status="old", form="formatted") do speciesID=1, numberOfSpecies numberOfContractions = MolecularSystem_getTotalNumberOfContractions (speciesID ) - print *, "We are calculating properties for ", trim(MolecularSystem_getNameOfSpecie(speciesID)), & + print *, "We are calculating properties for ", trim(MolecularSystem_getNameOfSpecies(speciesID)), & " in the CI ground state" auxstring="1" !ground state - arguments(2) = MolecularSystem_getNameOfSpecie(speciesID) + arguments(2) = MolecularSystem_getNameOfSpecies(speciesID) arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxstring)) this%densityMatrix(speciesID)= Matrix_getFromFile(unit=occupationsUnit, rows= int(numberOfcontractions,4), & columns= int(numberOfcontractions,4), binary=.false., arguments=arguments(1:2)) @@ -159,9 +159,9 @@ subroutine CalculateProperties_constructor( this,fileName ) open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted") do speciesID=1, numberOfSpecies numberOfContractions = MolecularSystem_getTotalNumberOfContractions (speciesID ) - print *, "We are calculating properties for ", trim(MolecularSystem_getNameOfSpecie(speciesID)), & + print *, "We are calculating properties for ", trim(MolecularSystem_getNameOfSpecies(speciesID)), & " in the HF/KS ground state" - arguments(2) = MolecularSystem_getNameOfSpecie(speciesID) + arguments(2) = MolecularSystem_getNameOfSpecies(speciesID) arguments(1) = "DENSITY" this%densityMatrix(speciesID) = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), & columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2)) @@ -180,7 +180,7 @@ subroutine CalculateProperties_constructor( this,fileName ) do speciesID=1, numberOfSpecies numberOfContractions = MolecularSystem_getTotalNumberOfContractions (speciesID ) ! Overlap matrix - arguments(2) = MolecularSystem_getNameOfSpecie(speciesID) + arguments(2) = MolecularSystem_getNameOfSpecies(speciesID) arguments(1) = "OVERLAP" this%overlapMatrix(speciesID) = Matrix_getFromFile(unit=integralsUnit, rows= int(numberOfContractions,4), & columns= int(numberOfContractions,4), binary=.true., arguments=arguments(1:2)) @@ -294,7 +294,7 @@ subroutine CalculateProperties_showPopulationAnalyses(this) do type= 1, size(analysis) - speciesName = trim(MolecularSystem_getNameOfSpecie( speciesID )) + speciesName = trim(MolecularSystem_getNameOfSpecies( speciesID )) if(trim(speciesName) .eq. "E-ALPHA") then speciesNickname="E-" @@ -366,7 +366,7 @@ subroutine CalculateProperties_showPopulationAnalyses(this) ! search_specie: do i = 1, MolecularSystem_getNumberOfQuantumSpecies() ! speciesName="" - ! speciesName = trim(MolecularSystem_getNameOfSpecie(i)) + ! speciesName = trim(MolecularSystem_getNameOfSpecies(i)) ! if( scan(trim(speciesName),"E")==1 ) then ! if( scan(trim(speciesName),"-")>1 ) then @@ -408,7 +408,7 @@ function CalculateProperties_getPopulation( this, typeOfPopulation, speciesID, t call Matrix_constructor( auxMatrix, int( numberOfcontractions, 8), int( numberOfcontractions, 8) ) - speciesName=trim(MolecularSystem_getNameOfSpecie( speciesID )) + speciesName=trim(MolecularSystem_getNameOfSpecies( speciesID )) if(trim(speciesName) .eq. "E-ALPHA") then call Matrix_constructor( output, int( numberOfcontractions, 8), 2_8 ) otherSpeciesID=speciesID+1 @@ -485,7 +485,7 @@ subroutine CalculateProperties_showExpectedPositions(this) print *,"" write (6,"(T19,4A9)") "","", "", "" do i=1, numberOfSpecies - write (6,"(T5,A15,3F9.4)") trim(MolecularSystem_getNameOfSpecie( i )), CalculateProperties_getExpectedPosition(this, i) + write (6,"(T5,A15,3F9.4)") trim(MolecularSystem_getNameOfSpecies( i )), CalculateProperties_getExpectedPosition(this, i) end do print *,"" print *,"END EXPECTED POSITIONS" @@ -540,7 +540,7 @@ subroutine CalculateProperties_showContributionsToElectrostaticMoment(this) do i=1, numberOfSpecies dipole(i,:)=CalculateProperties_getDipoleOfQuantumSpecies(this, i) totalDipole(:)=totalDipole(:)+dipole(i,:) - write (6,"(T5,A15,3F13.8)") trim(MolecularSystem_getNameOfSpecie( i )), dipole(i,:) + write (6,"(T5,A15,3F13.8)") trim(MolecularSystem_getNameOfSpecies( i )), dipole(i,:) end do dipole(numberOfSpecies+1,:)=CalculateProperties_getDipoleOfPuntualCharges() totalDipole(:)=totalDipole(:)+dipole(numberOfSpecies+1,:) @@ -558,7 +558,7 @@ subroutine CalculateProperties_showContributionsToElectrostaticMoment(this) do i=1, numberOfSpecies dipole(i,:)=CalculateProperties_getDipoleOfQuantumSpecies(this, i)*2.54174619 totalDipole(:)=totalDipole(:)+dipole(i,:) - write (6,"(T5,A15,3F13.8)") trim(MolecularSystem_getNameOfSpecie( i )), dipole(i,:) + write (6,"(T5,A15,3F13.8)") trim(MolecularSystem_getNameOfSpecies( i )), dipole(i,:) end do dipole(numberOfSpecies+1,:)=CalculateProperties_getDipoleOfPuntualCharges()*2.54174619 @@ -579,7 +579,7 @@ subroutine CalculateProperties_showContributionsToElectrostaticMoment(this) do i=1, numberOfSpecies quadrupole(i,:)=CalculateProperties_getQuadrupoleOfQuantumSpecies(this, i)*2.54174619*0.52917720859 totalQuadrupole(:)=totalQuadrupole(:)+quadrupole(i,:) - write (6,"(T5,A15,6F14.8)") trim(MolecularSystem_getNameOfSpecie( i )), quadrupole(i,:) + write (6,"(T5,A15,6F14.8)") trim(MolecularSystem_getNameOfSpecies( i )), quadrupole(i,:) end do quadrupole(numberOfSpecies+1,:)=CalculateProperties_getQuadrupoleOfPuntualCharges()*2.54174619*0.52917720859 @@ -755,7 +755,7 @@ end module CalculateProperties_ ! ! ! do i=1, numberOfSpecies -! nameOfSpecieSelected = trim( Particle_Manager_getNameOfSpecie( i ) ) +! nameOfSpecieSelected = trim( Particle_Manager_getNameOfSpecies( i ) ) ! numberOfContractions = Particle_Manager_getTotalNumberOfContractions( i ) ! call Matrix_constructor (densityMatrix, int(numberOfContractions,8), int(numberOfContractions,8)) ! densityMatrix = MolecularSystem_getDensityMatrix( trim(nameOfSpecieSelected) ) @@ -796,7 +796,7 @@ end module CalculateProperties_ ! print *,"" ! write (6,"(T19,A9)") "" ! do i=1, numberOfSpecies -! write (6,"(T5,A15,F9.4)") trim(Particle_Manager_getNameOfSpecie( i )), (this%expectedR2%values(i)) +! write (6,"(T5,A15,F9.4)") trim(Particle_Manager_getNameOfSpecies( i )), (this%expectedR2%values(i)) ! end do ! print *,"" ! print *,"END EXPECTED " diff --git a/src/DFT/DFT.f90 b/src/DFT/DFT.f90 index 218a14bc..bb100e7b 100644 --- a/src/DFT/DFT.f90 +++ b/src/DFT/DFT.f90 @@ -28,6 +28,7 @@ program DFT use MolecularSystem_ use DensityFunctionalTheory_ use GridManager_ + use Functional_ use String_ use Matrix_ use Exception_ @@ -36,6 +37,7 @@ program DFT character(50) :: job character(100) :: densFile + type(Grid), allocatable :: grids(:), gridsCommonPoints(:,:) type(Matrix), allocatable :: densityMatrix(:) type(Matrix), allocatable :: exchangeCorrelationMatrix(:) type(Matrix) :: exchangeCorrelationEnergy @@ -62,21 +64,30 @@ program DFT !!Load the system in lowdin.sys format call MolecularSystem_loadFromFile( "LOWDIN.SYS" ) - call Functional_createFunctionals( ) + numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies() + + !! Allocate memory. + if(allocated(grids)) deallocate(grids) + allocate(grids(numberOfSpecies)) + + if (allocated(gridsCommonPoints)) deallocate(gridsCommonPoints) + allocate(gridsCommonPoints(numberOfSpecies,numberOfSpecies)) + + do speciesID = 1 , numberOfSpecies + grids(speciesID)%molSys => MolecularSystem_instance + end do !!!Building grids jobs select case ( job ) case ("BUILD_SCF_GRID") - call DensityFunctionalTheory_buildSCFGrid() + call DensityFunctionalTheory_buildSCFGrid(grids,gridsCommonPoints) STOP case ("BUILD_FINAL_GRID" ) - call DensityFunctionalTheory_buildFinalGrid() + call DensityFunctionalTheory_buildFinalGrid(grids,gridsCommonPoints) STOP end select - !!!Computing energy and potential jobs - numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies() - + !!!Computing energy and potential jobs allocate( densityMatrix(numberOfSpecies) , numberOfParticles(numberOfSpecies), & exchangeCorrelationMatrix(numberOfSpecies)) @@ -99,7 +110,7 @@ program DFT select case ( job ) case ("SCF_DFT") - call DensityFunctionalTheory_SCFDFT(densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles) + call DensityFunctionalTheory_SCFDFT(grids,gridsCommonPoints,densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles) case ("FINAL_DFT") !read scf information for comparison do speciesID = 1 , numberOfSpecies @@ -124,7 +135,7 @@ program DFT close(unit=excUnit) end do - call DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles) + call DensityFunctionalTheory_finalDFT(grids,gridsCommonPoints,densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles) ! case default ! write(*,*) "USAGE: lowdin-DFT.x job " ! write(*,*) "Where job can be: " diff --git a/src/DFT/DensityFunctionalTheory.f90 b/src/DFT/DensityFunctionalTheory.f90 index 97f0197b..70b05299 100644 --- a/src/DFT/DensityFunctionalTheory.f90 +++ b/src/DFT/DensityFunctionalTheory.f90 @@ -25,6 +25,7 @@ module DensityFunctionalTheory_ use CONTROL_ use MolecularSystem_ use GridManager_ + use Functional_ use String_ use Exception_ use omp_lib @@ -39,15 +40,28 @@ module DensityFunctionalTheory_ !! @brief Builds a grid for each species - Different sizes are possible, all points in memory ! Felix Moncada, 2017 ! Roberto Flores-Moreno, 2009 - subroutine DensityFunctionalTheory_buildSCFGrid(exactExchangeFractions) + subroutine DensityFunctionalTheory_buildSCFGrid(scfGrids,scfGridsCommonPoints,exactExchangeFractions,system) implicit none + type(Grid) :: scfGrids(:), scfGridsCommonPoints(:,:) real(8), optional :: exactExchangeFractions(*) - integer :: speciesID + type(MolecularSystem), optional, target :: system + + type(Functional), allocatable :: Functionals(:,:) + type(MolecularSystem), pointer :: molSys + integer :: speciesID,numberOfSpecies !!Start time ! call Stopwatch_constructor(lowdin_stopwatch) ! call Stopwatch_start(lowdin_stopwatch) + if( present(system) ) then + molSys=>system + else + molSys=>MolecularSystem_instance + end if + + numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(molSys) + if(CONTROL_instance%PRINT_LEVEL .gt. 0) then print *, "" print *, "--------------------------------------------------------------------------------------" @@ -57,19 +71,22 @@ subroutine DensityFunctionalTheory_buildSCFGrid(exactExchangeFractions) print *, "" end if - call GridManager_buildGrids( "INITIAL" ) - if(CONTROL_instance%GRID_STORAGE .ne. "DISK") call Functional_createFunctionals( ) - if(CONTROL_instance%PRINT_LEVEL .gt. 0) call Functional_show( ) + call GridManager_buildGrids(scfGrids,scfGridsCommonPoints,"INITIAL",molSys ) + + allocate(Functionals(numberOfSpecies,numberOfSpecies)) + call Functional_createFunctionals(Functionals,numberOfSpecies,molSys) + + if(CONTROL_instance%PRINT_LEVEL .gt. 0) call Functional_show(Functionals) if(CONTROL_instance%GRID_STORAGE .eq. "DISK") then - call GridManager_writeGrids( "INITIAL" ) - call GridManager_atomicOrbitals( "WRITE","INITIAL" ) + call GridManager_writeGrids(scfGrids,scfGridsCommonPoints,Functionals,"INITIAL") + call GridManager_atomicOrbitals(scfGrids,scfGridsCommonPoints,"WRITE","INITIAL" ) else - call GridManager_atomicOrbitals( "COMPUTE","INITIAL" ) + call GridManager_atomicOrbitals(scfGrids,scfGridsCommonPoints,"COMPUTE","INITIAL" ) end if if(present(exactExchangeFractions)) then - do speciesID=1, MolecularSystem_getNumberOfQuantumSpecies() - exactExchangeFractions(speciesID)=Functional_getExchangeFraction(speciesID) + do speciesID=1, MolecularSystem_getNumberOfQuantumSpecies(molSys) + exactExchangeFractions(speciesID)=Functional_getExchangeFraction(Functionals,speciesID) end do end if ! call Stopwatch_stop(lowdin_stopwatch) @@ -77,8 +94,23 @@ subroutine DensityFunctionalTheory_buildSCFGrid(exactExchangeFractions) end subroutine DensityFunctionalTheory_buildSCFGrid - subroutine DensityFunctionalTheory_buildFinalGrid() + subroutine DensityFunctionalTheory_buildFinalGrid(finalGrids,finalGridsCommonPoints,system) implicit none + type(Grid) :: finalGrids(:), finalGridsCommonPoints(:,:) + type(MolecularSystem), optional, target :: system + + type(Functional), allocatable :: Functionals(:,:) + type(MolecularSystem), pointer :: molSys + integer :: numberOfSpecies + + if( present(system) ) then + molSys=>system + else + molSys=>MolecularSystem_instance + end if + + numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(molSys) + if(CONTROL_instance%PRINT_LEVEL .gt. 0) then print *, "" print *, "--------------------------------------------------------------------------------------" @@ -87,24 +119,29 @@ subroutine DensityFunctionalTheory_buildFinalGrid() print *, "Euler-Maclaurin radial grids - Lebedev angular grids" print *, "" end if - call GridManager_buildGrids( "FINAL" ) - if(CONTROL_instance%GRID_STORAGE .ne. "DISK") call Functional_createFunctionals( ) + call GridManager_buildGrids(finalGrids,finalGridsCommonPoints,"FINAL",molSys) + + allocate(Functionals(numberOfSpecies,numberOfSpecies)) + call Functional_createFunctionals(Functionals,numberOfSpecies,molSys) + if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then - call GridManager_writeGrids( "FINAL" ) - call GridManager_atomicOrbitals( "WRITE","FINAL" ) + call GridManager_writeGrids(finalGrids,finalGridsCommonPoints,Functionals,"FINAL" ) + call GridManager_atomicOrbitals(finalGrids,finalGridsCommonPoints,"WRITE","FINAL" ) else - call GridManager_atomicOrbitals( "COMPUTE","FINAL" ) + call GridManager_atomicOrbitals(finalGrids,finalGridsCommonPoints,"COMPUTE","FINAL" ) end if end subroutine DensityFunctionalTheory_buildFinalGrid - subroutine DensityFunctionalTheory_SCFDFT(densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles) + subroutine DensityFunctionalTheory_SCFDFT(scfGrids,scfGridsCommonPoints,densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles) implicit none + type(Grid) :: scfGrids(:), scfGridsCommonPoints(:,:) type(Matrix), intent(in) :: densityMatrix(*) !IN type(Matrix) :: exchangeCorrelationMatrix(*) !OUT type(Matrix) :: exchangeCorrelationEnergy !OUT real(8) :: numberOfParticles(*) !OUT + type(Functional), allocatable :: Functionals(:,:) type(Matrix), allocatable :: overlapMatrix(:) character(50) :: labels(2) integer :: densUnit, excUnit @@ -118,17 +155,19 @@ subroutine DensityFunctionalTheory_SCFDFT(densityMatrix, exchangeCorrelationMatr real(8) :: sumCheck, auxEnergy, otherAuxEnergy, otherElectronAuxEnergy real(8) :: time1, time2, time3 - numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies() + numberOfSpecies=size(scfGrids(:)) if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then - call GridManager_readGrids( "INITIAL") - call GridManager_atomicOrbitals( "READ", "INITIAL" ) + call GridManager_readGrids(scfGrids,scfGridsCommonPoints,"INITIAL") + call GridManager_atomicOrbitals(scfGrids,scfGridsCommonPoints,"READ", "INITIAL" ) end if !!Start time ! call Stopwatch_constructor(lowdin_stopwatch) ! call Stopwatch_start(lowdin_stopwatch) + allocate(Functionals(numberOfSpecies,numberOfSpecies)) + call Functional_createFunctionals(Functionals,numberOfSpecies,scfGrids(1)%molSys) - call DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,numberOfParticles) + call DensityFunctionalTheory_calculateDensityAndGradients(scfGrids,scfGridsCommonPoints,densityMatrix,numberOfParticles) ! call Stopwatch_stop(lowdin_stopwatch) ! write(*,"(A,F10.3,A4)") "** Calculating density and gradient:", lowdin_stopwatch%enlapsetTime ," (s)" @@ -136,26 +175,28 @@ subroutine DensityFunctionalTheory_SCFDFT(densityMatrix, exchangeCorrelationMatr ! call Stopwatch_constructor(lowdin_stopwatch) ! call Stopwatch_start(lowdin_stopwatch) - call DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEnergy) + call DensityFunctionalTheory_calculateEnergyDensity(scfGrids,scfGridsCommonPoints,Functionals,exchangeCorrelationEnergy) !!In the final iteration we don't update the exchange correlation matrix to save time do speciesID = 1 , numberOfSpecies - numberOfContractions=MolecularSystem_getTotalNumberOfContractions( speciesID ) + numberOfContractions=MolecularSystem_getTotalNumberOfContractions( speciesID, scfGrids(speciesID)%molSys ) call Matrix_constructor(exchangeCorrelationMatrix(speciesID), int(numberOfContractions,8), int(numberOfContractions,8), 0.0_8 ) - call GridManager_buildExchangeCorrelationMatrix(speciesID, exchangeCorrelationMatrix(speciesID)) + call GridManager_buildExchangeCorrelationMatrix(scfGrids,scfGridsCommonPoints,speciesID, exchangeCorrelationMatrix(speciesID)) end do ! call Stopwatch_stop(lowdin_stopwatch) ! write(*,"(A,F10.3,A4)") "** Calculating energy and potential:", lowdin_stopwatch%enlapsetTime ," (s)" end subroutine DensityFunctionalTheory_SCFDFT - subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles) + subroutine DensityFunctionalTheory_finalDFT(finalGrids,finalGridsCommonPoints,densityMatrix, exchangeCorrelationMatrix, exchangeCorrelationEnergy, numberOfParticles) implicit none + type(Grid) :: finalGrids(:), finalGridsCommonPoints(:,:) type(Matrix) :: densityMatrix(*) !IN type(Matrix) :: exchangeCorrelationMatrix(*) !OUT type(Matrix) :: exchangeCorrelationEnergy !OUT real(8) :: numberOfParticles(*) !OUT + type(Functional), allocatable :: Functionals(:,:) type(Matrix), allocatable :: overlapMatrix(:) character(100) :: excFile character(50) :: labels(2) @@ -170,12 +211,12 @@ subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMa real(8) :: sumCheck, auxEnergy, otherAuxEnergy, otherElectronAuxEnergy real(8) :: time1, time2, time3 - numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies() + numberOfSpecies=size(finalGrids(:)) !print scf grid information for comparison if(CONTROL_instance%PRINT_LEVEL .gt. 0 ) then do speciesID = 1 , numberOfSpecies - write (*,"(A50 F15.8)") "Number of "//trim(MolecularSystem_getNameOfSpecie(speciesID))//" particles in the SCF grid: ", numberOfParticles(speciesID) + write (*,"(A50 F15.8)") "Number of "//trim(MolecularSystem_getNameOfSpecies(speciesID, finalGrids(speciesID)%molSys))//" particles in the SCF grid: ", numberOfParticles(speciesID) end do print *, "" write (*,"(A50, F15.8)") "Exchange-correlation energy with the SCF grid: ", sum(exchangeCorrelationEnergy%values) @@ -183,11 +224,14 @@ subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMa end if if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then - call GridManager_readGrids( "FINAL" ) - call GridManager_atomicOrbitals( "READ", "FINAL" ) + call GridManager_readGrids(finalGrids,finalGridsCommonPoints,"FINAL" ) + call GridManager_atomicOrbitals(finalGrids,finalGridsCommonPoints,"READ", "FINAL" ) end if - call DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,numberOfParticles) + allocate(Functionals(numberOfSpecies,numberOfSpecies)) + call Functional_createFunctionals(Functionals,numberOfSpecies,finalGrids(1)%molSys) + + call DensityFunctionalTheory_calculateDensityAndGradients(finalGrids,finalGridsCommonPoints,densityMatrix,numberOfParticles) !!Start time ! call Stopwatch_constructor(lowdin_stopwatch) @@ -205,35 +249,35 @@ subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMa ! call Stopwatch_constructor(lowdin_stopwatch) ! call Stopwatch_start(lowdin_stopwatch) - call DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEnergy) + call DensityFunctionalTheory_calculateEnergyDensity(finalGrids,finalGridsCommonPoints,Functionals,exchangeCorrelationEnergy) !print scf grid information for comparison if(CONTROL_instance%PRINT_LEVEL .gt. 0 ) then do speciesID = 1 , numberOfSpecies - write (*,"(A50 F15.8)") "Number of "//trim(MolecularSystem_getNameOfSpecie(speciesID))//" particles in the final grid: ", numberOfParticles(speciesID) + write (*,"(A50 F15.8)") "Number of "//trim(MolecularSystem_getNameOfSpecies(speciesID, finalGrids(speciesID)%molSys))//" particles in the final grid: ", numberOfParticles(speciesID) end do print *, "" write (*,"(A50, F15.8)") "Exchange-correlation energy with the final grid: ", sum(exchangeCorrelationEnergy%values) print *, "" end if do speciesID = 1 , numberOfSpecies-1 - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=finalGrids(speciesID)%nameOfSpecies do otherSpeciesID = speciesID+1 , numberOfSpecies - nameOfOtherSpecies=MolecularSystem_getNameOfSpecie(otherSpeciesID) + nameOfOtherSpecies=finalGrids(otherSpeciesID)%nameOfSpecies if ( nameOfSpecies .eq. "E-" ) then ! if ( nameOfSpecies .eq. "E-" .and. nameOfOtherSpecies .eq. "POSITRON" ) then !Closed shell electron and other species terms - call GridManager_getContactDensity( speciesID, otherSpeciesID ) + call GridManager_getContactDensity(finalGrids,finalGridsCommonPoints,speciesID, otherSpeciesID ) elseif ( nameOfSpecies .eq. "E-ALPHA" ) then ! elseif ( nameOfSpecies .eq. "E-ALPHA" .and. nameOfOtherSpecies .eq. "POSITRON" ) then !Open shell Electron and other species terms - otherElectronID=MolecularSystem_getSpecieID("E-BETA") + otherElectronID=MolecularSystem_getSpecieID("E-BETA",finalGrids(speciesID)%molSys) - call GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectronID ) + call GridManager_getContactDensity(finalGrids,finalGridsCommonPoints,speciesID, otherSpeciesID, otherElectronID ) end if @@ -255,15 +299,17 @@ subroutine DensityFunctionalTheory_finalDFT(densityMatrix, exchangeCorrelationMa end subroutine DensityFunctionalTheory_finalDFT - subroutine DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,numberOfParticles) + subroutine DensityFunctionalTheory_calculateDensityAndGradients(Grid_instance,GridCommonPoints,densityMatrix,numberOfParticles) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridCommonPoints(:,:) type(Matrix) :: densityMatrix(*) !IN real(8) :: numberOfParticles(*) !OUT integer :: numberOfSpecies integer :: speciesID integer :: i,dir - numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies() + numberOfSpecies=size(Grid_instance(:)) do speciesID = 1 , numberOfSpecies ! Calculate density and gradients @@ -276,7 +322,7 @@ subroutine DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,nu call Vector_Constructor( Grid_instance(speciesID)%densityGradient(dir), Grid_instance(speciesID)%totalSize, 0.0_8) end do - call GridManager_getDensityGradientAtGrid( speciesID, densityMatrix(speciesID), Grid_instance(speciesID)%density, Grid_instance(speciesID)%densityGradient) + call GridManager_getDensityGradientAtGrid(Grid_instance,GridCommonPoints, speciesID, densityMatrix(speciesID), Grid_instance(speciesID)%density, Grid_instance(speciesID)%densityGradient) ! Check density and gradient in z numberOfParticles(speciesID)=0.0_8 @@ -290,24 +336,27 @@ subroutine DensityFunctionalTheory_calculateDensityAndGradients(densityMatrix,nu end subroutine DensityFunctionalTheory_calculateDensityAndGradients - subroutine DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEnergy) + subroutine DensityFunctionalTheory_calculateEnergyDensity(Grid_instance,GridCommonPoints,Functionals,exchangeCorrelationEnergy) + type(Grid) :: Grid_instance(:) + type(Grid) :: GridCommonPoints(:,:) + type(Functional) :: Functionals(:,:) type(Matrix) :: exchangeCorrelationEnergy !OUT integer :: numberOfSpecies integer :: speciesID, otherSpeciesID, otherElectronID character(50) :: nameOfSpecies, nameOfOtherSpecies - numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies() + numberOfSpecies=size(Grid_instance(:)) exchangeCorrelationEnergy%values(:,:)=0.0_8 ! Calculate energy density and potential for one species do speciesID = 1 , numberOfSpecies - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=Grid_instance(speciesID)%nameOfSpecies if( nameOfSpecies .eq. "E-" ) then - call GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchangeCorrelationEnergy%values(speciesID,speciesID)) + call GridManager_getElectronicEnergyAndPotentialAtGrid(Grid_instance,GridCommonPoints,Functionals, speciesID, exchangeCorrelationEnergy%values(speciesID,speciesID)) elseif( nameOfSpecies .eq. "E-ALPHA" ) then !El potencial de BETA se calcula simultaneamente con ALPHA - otherSpeciesID = MolecularSystem_getSpecieID( nameOfSpecie="E-BETA" ) - call GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchangeCorrelationEnergy%values(speciesID,speciesID), & + otherSpeciesID = MolecularSystem_getSpecieID( "E-BETA", Grid_instance(speciesID)%molSys ) + call GridManager_getElectronicEnergyAndPotentialAtGrid(Grid_instance,GridCommonPoints,Functionals, speciesID, exchangeCorrelationEnergy%values(speciesID,speciesID), & otherSpeciesID, exchangeCorrelationEnergy%values(otherSpeciesID,otherSpeciesID) ) elseif (nameOfSpecies .eq. "E-BETA") then @@ -317,16 +366,16 @@ subroutine DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEne !There aren't more same species functionals implemented so far end if - ! write (*,"(A50, F15.8)") trim(MolecularSystem_getNameOfSpecie(speciesID))//" Exchange-correlation contribution: ", exchangeCorrelationEnergy(speciesID,speciesID) + ! write (*,"(A50, F15.8)") trim(MolecularSystem_getNameOfSpecies(speciesID))//" Exchange-correlation contribution: ", exchangeCorrelationEnergy(speciesID,speciesID) end do ! Calculate energy density and potential for two species do speciesID = 1 , numberOfSpecies-1 - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=Grid_instance(speciesID)%nameOfSpecies do otherSpeciesID = speciesID+1 , numberOfSpecies - nameOfOtherSpecies=MolecularSystem_getNameOfSpecie(otherSpeciesID) + nameOfOtherSpecies=Grid_instance(otherSpeciesID)%nameOfSpecies if (nameOfSpecies .eq. "E-ALPHA" .and. nameOfSpecies .eq. "E-BETA") then !Nada, todo se hace como si fuera una sola especie @@ -337,7 +386,7 @@ subroutine DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEne (nameOfOtherSpecies .ne. "E-" .and. nameOfOtherSpecies .ne. "E-ALPHA" .and. nameOfOtherSpecies .ne. "E-BETA") ) then !Closed shell electron and other species terms - call GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, otherSpeciesID, exchangeCorrelationEnergy%values(speciesID,otherSpeciesID) ) + call GridManager_getInterspeciesEnergyAndPotentialAtGrid(Grid_instance, GridCommonPoints,Functionals, speciesID, otherSpeciesID, exchangeCorrelationEnergy%values(speciesID,otherSpeciesID) ) ! write (*,"(A50, F15.8)") trim(nameOfSpecies)//"/"//trim(nameOfOtherSpecies)//" Correlation contribution: ", exchangeCorrelationEnergy(speciesID,otherSpeciesID) @@ -345,9 +394,9 @@ subroutine DensityFunctionalTheory_calculateEnergyDensity(exchangeCorrelationEne elseif ( nameOfSpecies .eq. "E-ALPHA" .and. & (nameOfOtherSpecies .ne. "E-" .and. nameOfOtherSpecies .ne. "E-ALPHA" .and. nameOfOtherSpecies .ne. "E-BETA") ) then - otherElectronID=MolecularSystem_getSpecieID("E-BETA") + otherElectronID=MolecularSystem_getSpecieID("E-BETA",Grid_instance(speciesID)%molSys) - call GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, otherSpeciesID, exchangeCorrelationEnergy%values(speciesID,otherSpeciesID), & + call GridManager_getInterspeciesEnergyAndPotentialAtGrid(Grid_instance, GridCommonPoints,Functionals, speciesID, otherSpeciesID, exchangeCorrelationEnergy%values(speciesID,otherSpeciesID), & otherElectronID, exchangeCorrelationEnergy%values(otherElectronID,otherSpeciesID) ) ! write (*,"(A50, F15.8)") trim(nameOfSpecies)//"/"//trim(nameOfOtherSpecies)//" Correlation contribution: ", exchangeCorrelationEnergy(speciesID,otherSpeciesID) diff --git a/src/DFT/Functional.f90 b/src/DFT/Functional.f90 index 8b5c7b16..2baec6cc 100644 --- a/src/DFT/Functional.f90 +++ b/src/DFT/Functional.f90 @@ -39,13 +39,10 @@ module Functional_ TYPE(xc_f03_func_info_t) :: info2 end type Functional - type(Functional), public, allocatable :: Functionals(:) - public :: & Functional_createFunctionals, & Functional_constructor, & Functional_show, & - Functional_getIndex, & Functional_getExchangeFraction, & Functional_libxcEvaluate, & Functional_LDAEvaluate, & @@ -84,48 +81,45 @@ module Functional_ contains - subroutine Functional_createFunctionals() + subroutine Functional_createFunctionals(these,numberOfSpecies,molSys) implicit none - + type(Functional) :: these(:,:) integer :: numberOfSpecies - integer :: speciesID, otherSpeciesID, i + type(MolecularSystem) :: molSys + + integer :: speciesID, otherSpeciesID character(50) :: labels(2), dftFile integer :: dftUnit - numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies() - - if(.not.allocated(Functionals) )allocate(Functionals(numberOfSpecies+numberOfSpecies*(numberOfSpecies-1)/2)) - i=1 do speciesID=1, numberOfSpecies - call Functional_constructor(Functionals(i), speciesID, speciesID) - i=i+1 + call Functional_constructor(these(speciesID,speciesID), speciesID, speciesID, molSys) end do do speciesID=1, numberOfSpecies-1 do otherSpeciesID=speciesID+1, numberOfSpecies - call Functional_constructor(Functionals(i), speciesID, otherSpeciesID) - i=i+1 + call Functional_constructor(these(speciesID,otherSpeciesID), speciesID, otherSpeciesID, molSys) end do end do end subroutine Functional_createFunctionals - subroutine Functional_constructor(this, speciesID, otherSpeciesID) + subroutine Functional_constructor(this, speciesID, otherSpeciesID, molSys) implicit none type(Functional) :: this integer :: speciesID integer :: otherSpeciesID character(50) :: auxstring + type(MolecularSystem) :: molSys this%name="NONE" this%correlationName="NONE" this%exchangeName="NONE" - this%species1=MolecularSystem_getNameOfSpecie(speciesID) - this%species2=MolecularSystem_getNameOfSpecie(otherSpeciesID) + this%species1=MolecularSystem_getNameOfSpecies(speciesID,molSys) + this%species2=MolecularSystem_getNameOfSpecies(otherSpeciesID,molSys) this%exactExchangeFraction=1.0_8 - this%mass1=MolecularSystem_getMass(speciesID) - this%mass2=MolecularSystem_getMass(otherSpeciesID) + this%mass1=MolecularSystem_getMass(speciesID,molSys) + this%mass2=MolecularSystem_getMass(otherSpeciesID,molSys) if((this%species1 == "E-" .and. this%species2 == "E-") .or. & @@ -307,12 +301,13 @@ subroutine Functional_constructor(this, speciesID, otherSpeciesID) end subroutine Functional_constructor - subroutine Functional_show() + subroutine Functional_show(these) implicit none - type(Functional) :: this - integer :: i + type(Functional) :: these(:,:) + type(Functional) :: this + integer :: i,j real(8) :: p,qe,qn,qen,q2en,q3en,Eab,Ea2b,Eab2,a0,q0,q2,q4 - + if( CONTROL_instance%CALL_LIBXC) then print *, "--------------------------------------------------------------------------------------" print *, "LIBXC library, Fermann, Miguel A. L. Marques, Micael J. T. Oliveira, and Tobias Burnus" @@ -325,127 +320,129 @@ subroutine Functional_show() print *, "--------------------------------------------------------------------------------------" print *, "" - do i=1, size(Functionals) - this=Functionals(i) + do i=1, size(these(:,:),DIM=1) + do j=i, size(these(:,:),DIM=2) + this=these(i,j) - if ((this%species1 == "E-" .and. this%species2 == "E-") .or. & - (this%species1 == "E-ALPHA" .and. this%species2 == "E-ALPHA") .or. & - (this%species1 == "E-ALPHA" .and. this%species2 == "E-BETA") .or. & - (this%species1 == "E-BETA" .and. this%species2 == "E-BETA") .or. & - (this%species1 == "E-BETA" .and. this%species2 == "E-ALPHA") ) then + if ((this%species1 == "E-" .and. this%species2 == "E-") .or. & + (this%species1 == "E-ALPHA" .and. this%species2 == "E-ALPHA") .or. & + (this%species1 == "E-ALPHA" .and. this%species2 == "E-BETA") .or. & + (this%species1 == "E-BETA" .and. this%species2 == "E-BETA") .or. & + (this%species1 == "E-BETA" .and. this%species2 == "E-ALPHA") ) then - if( CONTROL_instance%CALL_LIBXC) then + if( CONTROL_instance%CALL_LIBXC) then - if( this%correlationName .ne. "NONE" ) then + if( this%correlationName .ne. "NONE" ) then - write(*, "(T5,A10,A10,A5,A12,A)") trim(this%species1), trim(this%species2), "","exchange:", xc_f03_func_info_get_name(this%info1) - ! print *, "family", xc_f03_func_info_get_family(this%info1), "shell", this%shell + write(*, "(T5,A10,A10,A5,A12,A)") trim(this%species1), trim(this%species2), "","exchange:", xc_f03_func_info_get_name(this%info1) + ! print *, "family", xc_f03_func_info_get_family(this%info1), "shell", this%shell - write(*, "(T5,A10,A10,A5,A12,A)") trim(this%species1), trim(this%species2), "","correlation:", xc_f03_func_info_get_name(this%info2) - ! print *, "family", xc_f03_func_info_get_family(this%info2), "shell", this%shell + write(*, "(T5,A10,A10,A5,A12,A)") trim(this%species1), trim(this%species2), "","correlation:", xc_f03_func_info_get_name(this%info2) + ! print *, "family", xc_f03_func_info_get_family(this%info2), "shell", this%shell - else + else - write(*, "(T5,A10,A10,A5,A21,A)") trim(this%species1), trim(this%species2), "", "exchange-correlation:", xc_f03_func_info_get_name(this%info1) + write(*, "(T5,A10,A10,A5,A21,A)") trim(this%species1), trim(this%species2), "", "exchange-correlation:", xc_f03_func_info_get_name(this%info1) - ! print *, "family", xc_f03_func_info_get_family(this%info1), "shell", this%shell + ! print *, "family", xc_f03_func_info_get_family(this%info1), "shell", this%shell - end if + end if - else - write(*, "(T5,A10,A10,A5,A)") trim(this%species1), trim(this%species2), "",this%name - - end if - else - write(*, "(T5,A10,A10,A5,A)") trim(this%species1), trim(this%species2), "",this%name - - if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3") print *, "Using as correlation length: beta=q*rhoE^(1/3)" - if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE6RHON6") print *, "Using as correlation length: beta=q*rhoE^(1/6)*rhoN^(1/6)" - if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON") print *, "Using as correlation length: beta=1/(q*rhoE^(-1/3)+r*rhoN^(-1))" - if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON3AS") print *, "Using as correlation length: beta=qe*rhoE^(1/3)+qn*rhoN^(1/3)" - if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON3RHOEN6") print *, "Using as correlation length: beta=q*rhoE^(1/3)+p*rhoN^(1/3)+r*rhoE^(1/6)*rhoN^(1/6)" - if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "NEWBETA") print *, "beta=(qe*rhoE(i)+qn*rhoN(i)+q2en*(rhoE(i)-rhoN(i))**2/(rhoE(i)+rhoN(i))+q3en*(rhoE(i)-rhoN(i))**3/(rhoE(i)+rhoN(i))**2)**(1.0/3.0)" - - if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "NEWNEWBETA") print *, "beta=(q0*(rhoE(i)+rhoN(i))+q2*(rhoE(i)-rhoN(i))**2/(rhoE(i)+rhoN(i))+q3*(rhoE(i)-rhoN(i))**4/(rhoE(i)+rhoN(i))**3)**(1.0/3.0)" - - if(CONTROL_instance%BETA_FUNCTION .eq. "NEWBETA") then - - if(this%mass2 .gt. 2.0) then !hydrogen - print *, "electron-hydrogen correlation parameters" - a0=4.5839773752240566113 - Ea2b=0.527444 - Eab2=0.597139 - else !positron - print *, "electron-positron correlation parameters" - a0=2.2919886876120283056 - Ea2b=0.262005 - Eab2=0.262005 - end if - - p=1.0 - - if(CONTROL_instance%DUMMY_REAL(1) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(2) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(3) .ne. 0) then - Ea2b=CONTROL_instance%DUMMY_REAL(1) - Eab2=CONTROL_instance%DUMMY_REAL(2) - p=CONTROL_instance%DUMMY_REAL(3) - end if - - print *, "Ea2b=", Ea2b - print *, "Eab2=", Eab2 - qe=a0*(11.0/8.0/Ea2b-3.0/4.0/Eab2) - qn=a0*(11.0/8.0/Eab2-3.0/4.0/Ea2b) - q2en=a0*3.0/16.0*(1.0/Ea2b+1.0/Eab2) - q3en=a0*9.0/16.0*(1.0/Eab2-1.0/Ea2b) - print *, "qe=", qe - print *, "qn=", qn - print *, "q2en=", q2en - print *, "q3en=", q3en - - print *, "p", CONTROL_instance%DUMMY_REAL(3) - - else if(CONTROL_instance%BETA_FUNCTION .eq. "NEWNEWBETA") then - - if(this%mass2 .gt. 2.0) then !hydrogen - STOP "this beta function only works for electron-positron" - else !positron - a0=2.2919886876120283056 - Eab=0.25 - Eab2=0.2620050702329801 - end if - - - if (this%name .eq. "correlation:EXPCS-GGA-NOA") a0=4.5839773752240566113 - - p=1.0 + else + write(*, "(T5,A10,A10,A5,A)") trim(this%species1), trim(this%species2), "",this%name - if(CONTROL_instance%BETA_PARAMETER_A .ne. 0 .or. CONTROL_instance%BETA_PARAMETER_B .ne. 0 .or. CONTROL_instance%BETA_PARAMETER_C .ne. 0) then - Eab=CONTROL_instance%BETA_PARAMETER_A - Eab2=CONTROL_instance%BETA_PARAMETER_B - p=CONTROL_instance%BETA_PARAMETER_C end if - - print *, "Eab=", Eab - print *, "Eab2=", Eab2 - q0=a0/2/Eab - q2=a0*(-5/Eab+53/Eab2/8) - q4=a0*(9/Eab/2-45/Eab2/8) - print *, "q0=", q0 - print *, "q2=", q2 - print *, "q4=", q4 - - print *, "p", CONTROL_instance%DUMMY_REAL(3) + else + write(*, "(T5,A10,A10,A5,A)") trim(this%species1), trim(this%species2), "",this%name + if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3") print *, "Using as correlation length: beta=q*rhoE^(1/3)" + if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE6RHON6") print *, "Using as correlation length: beta=q*rhoE^(1/6)*rhoN^(1/6)" + if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON") print *, "Using as correlation length: beta=1/(q*rhoE^(-1/3)+r*rhoN^(-1))" + if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON3AS") print *, "Using as correlation length: beta=qe*rhoE^(1/3)+qn*rhoN^(1/3)" + if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "RHOE3RHON3RHOEN6") print *, "Using as correlation length: beta=q*rhoE^(1/3)+p*rhoN^(1/3)+r*rhoE^(1/6)*rhoN^(1/6)" + if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "NEWBETA") print *, "beta=(qe*rhoE(i)+qn*rhoN(i)+q2en*(rhoE(i)-rhoN(i))**2/(rhoE(i)+rhoN(i))+q3en*(rhoE(i)-rhoN(i))**3/(rhoE(i)+rhoN(i))**2)**(1.0/3.0)" + + if(this%name .ne. "NONE" .and. CONTROL_instance%BETA_FUNCTION .eq. "NEWNEWBETA") print *, "beta=(q0*(rhoE(i)+rhoN(i))+q2*(rhoE(i)-rhoN(i))**2/(rhoE(i)+rhoN(i))+q3*(rhoE(i)-rhoN(i))**4/(rhoE(i)+rhoN(i))**3)**(1.0/3.0)" + + if(CONTROL_instance%BETA_FUNCTION .eq. "NEWBETA") then + + if(this%mass2 .gt. 2.0) then !hydrogen + print *, "electron-hydrogen correlation parameters" + a0=4.5839773752240566113 + Ea2b=0.527444 + Eab2=0.597139 + else !positron + print *, "electron-positron correlation parameters" + a0=2.2919886876120283056 + Ea2b=0.262005 + Eab2=0.262005 + end if + + p=1.0 + + if(CONTROL_instance%DUMMY_REAL(1) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(2) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(3) .ne. 0) then + Ea2b=CONTROL_instance%DUMMY_REAL(1) + Eab2=CONTROL_instance%DUMMY_REAL(2) + p=CONTROL_instance%DUMMY_REAL(3) + end if + + print *, "Ea2b=", Ea2b + print *, "Eab2=", Eab2 + qe=a0*(11.0/8.0/Ea2b-3.0/4.0/Eab2) + qn=a0*(11.0/8.0/Eab2-3.0/4.0/Ea2b) + q2en=a0*3.0/16.0*(1.0/Ea2b+1.0/Eab2) + q3en=a0*9.0/16.0*(1.0/Eab2-1.0/Ea2b) + print *, "qe=", qe + print *, "qn=", qn + print *, "q2en=", q2en + print *, "q3en=", q3en + + print *, "p", CONTROL_instance%DUMMY_REAL(3) + + else if(CONTROL_instance%BETA_FUNCTION .eq. "NEWNEWBETA") then + + if(this%mass2 .gt. 2.0) then !hydrogen + STOP "this beta function only works for electron-positron" + else !positron + a0=2.2919886876120283056 + Eab=0.25 + Eab2=0.2620050702329801 + end if + + + if (this%name .eq. "correlation:EXPCS-GGA-NOA") a0=4.5839773752240566113 + + p=1.0 + + if(CONTROL_instance%BETA_PARAMETER_A .ne. 0 .or. CONTROL_instance%BETA_PARAMETER_B .ne. 0 .or. CONTROL_instance%BETA_PARAMETER_C .ne. 0) then + Eab=CONTROL_instance%BETA_PARAMETER_A + Eab2=CONTROL_instance%BETA_PARAMETER_B + p=CONTROL_instance%BETA_PARAMETER_C + end if + + print *, "Eab=", Eab + print *, "Eab2=", Eab2 + q0=a0/2/Eab + q2=a0*(-5/Eab+53/Eab2/8) + q4=a0*(9/Eab/2-45/Eab2/8) + print *, "q0=", q0 + print *, "q2=", q2 + print *, "q4=", q4 + + print *, "p", CONTROL_instance%DUMMY_REAL(3) + + + else + if(this%name .ne. "NONE" .and. (CONTROL_instance%DUMMY_REAL(1) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(2) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(3) .ne. 0) ) then + print *, "q", CONTROL_instance%DUMMY_REAL(1) + print *, "p", CONTROL_instance%DUMMY_REAL(2) + print *, "r", CONTROL_instance%DUMMY_REAL(3) + end if - else - if(this%name .ne. "NONE" .and. (CONTROL_instance%DUMMY_REAL(1) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(2) .ne. 0 .or. CONTROL_instance%DUMMY_REAL(3) .ne. 0) ) then - print *, "q", CONTROL_instance%DUMMY_REAL(1) - print *, "p", CONTROL_instance%DUMMY_REAL(2) - print *, "r", CONTROL_instance%DUMMY_REAL(3) end if end if - - end if + end do end do print *, "" @@ -453,39 +450,14 @@ subroutine Functional_show() end subroutine Functional_show - function Functional_getIndex(speciesID, otherSpeciesID) result( output) - implicit none - integer :: speciesID - integer, optional :: otherSpeciesID - integer :: output - character(50) :: nameOfSpecies, otherNameOfSpecies - integer i - - nameOfSpecies = MolecularSystem_getNameOfSpecie( speciesID ) - if( present(otherSpeciesID) ) then - otherNameOfSpecies = MolecularSystem_getNameOfSpecie( otherSpeciesID ) - else - otherNameOfSpecies = nameOfSpecies - end if - - do i=1, size(Functionals(:)) - if (Functionals(i)%species1 == nameOfSpecies .and. Functionals(i)%species2 == otherNameOfSpecies) then - output=i - return - end if - end do - - end function Functional_getIndex - - function Functional_getExchangeFraction(speciesID) result( output) + function Functional_getExchangeFraction(these,speciesID) result( output) implicit none + type(Functional) :: these(:,:) integer :: speciesID real(8) :: output integer :: index - index=Functional_getIndex(speciesID) - - output=Functionals(index)%exactExchangeFraction + output=these(speciesID,speciesID)%exactExchangeFraction end function Functional_getExchangeFraction @@ -567,7 +539,7 @@ subroutine Functional_EPCEvaluate( this, mass, n, rhoE, rhoN, ec, vcE, vcN ) real(8) :: ec(*) !! Energy density - output real(8) :: vcE(*), vcN(*) !! Potentials - output - real(8) :: a,b,c, q + real(8) :: a,b,c, prodRho real(8) :: denominator, densityThreshold real(8) :: v_exchange(n),va_correlation(n),vb_correlation(n) integer :: i @@ -588,35 +560,27 @@ subroutine Functional_EPCEvaluate( this, mass, n, rhoE, rhoN, ec, vcE, vcN ) STOP "The nuclear electron functional chosen is not implemented" end if - !$omp parallel private(denominator) + ec(1:n)=0.0 + vcE(1:n)=0.0 + vcN(1:n)=0.0 + + ! print *, "i, rhoE, rhoN, denominator, energy density, potentialE, potentialN" + !$omp parallel private(denominator,prodRho) !$omp do schedule (dynamic) do i = 1, n - - denominator=a-b*sqrt(rhoE(i)*rhoN(i))+c*rhoE(i)*rhoN(i) - + if( rhoE(i)+rhoN(i) .lt. densityThreshold ) cycle + prodRho=rhoE(i)*rhoN(i) + denominator=a-b*sqrt(prodRho)+c*prodRho !!!Energy density - ! ec(i)= -rhoE(1:n)*rhoN(1:n)/denominator(1:n) ec(i)= -rhoN(i)/denominator - !!!Potential - - if( rhoE(i)+rhoN(i) .gt. densityThreshold ) then ! - vcE(i)= (rhoE(i)*rhoN(i)*(c*rhoN(i)-b*rhoN(i)/(2*sqrt(rhoE(i)*rhoN(i))))-rhoN(i)*denominator)/denominator**2 - vcN(i)= (rhoN(i)*rhoE(i)*(c*rhoE(i)-b*rhoE(i)/(2*sqrt(rhoE(i)*rhoN(i))))-rhoE(i)*denominator)/denominator**2 - else - vcE(i)=0.0 - vcN(i)=0.0 - end if - + vcE(i)= rhoN(i)*(prodRho*c-sqrt(prodRho)*b/2.0-denominator)/denominator**2 + vcN(i)= rhoE(i)*(prodRho*c-sqrt(prodRho)*b/2.0-denominator)/denominator**2 + ! write(*,"(I0.1,5ES16.6)") i, rhoE(i), rhoN(i), ec(i), vcE(i), vcN(i) end do !$omp end do !$omp end parallel - ! print *, "i, rhoE, rhoN, denominator, energy density, potentialE, potentialN" - ! do i = 1, n - ! write(*,"(I0.1,5F16.6)") i, rhoE(i), rhoN(i), ec(i), vcE(i), vcN(i) - ! end do - end subroutine Functional_EPCEvaluate subroutine Functional_IKNEvaluate( this, mass, n, rhoE, rhoN, ec, vcE, vcN ) diff --git a/src/DFT/Grid.f90 b/src/DFT/Grid.f90 index b0f70bd5..b2226307 100644 --- a/src/DFT/Grid.f90 +++ b/src/DFT/Grid.f90 @@ -28,6 +28,8 @@ module Grid_ type, public :: Grid + type(MolecularSystem), pointer :: molSys + character(30) :: nameOfSpecies integer :: totalSize type(Matrix) :: points !! x,y,z,weight @@ -39,9 +41,6 @@ module Grid_ end type Grid - type(Grid), public, allocatable :: Grid_instance(:) - type(Grid), public, allocatable :: GridsCommonPoints(:,:) - public :: & Grid_constructor, & Grid_buildAtomic, & @@ -56,11 +55,12 @@ module Grid_ !! @brief Builds a grid for each species - Different sizes are possible, all points in memory ! Felix Moncada, 2017 ! Roberto Flores-Moreno, 2009 - subroutine Grid_constructor( this, speciesID, type ) + subroutine Grid_constructor( this, speciesID, type, molSys ) implicit none type(Grid) :: this integer :: speciesID character(*) :: type + type(MolecularSystem), target :: molSys type(Matrix) :: atomicGrid, molecularGrid integer :: numberOfSpecies, numberOfCenters @@ -70,7 +70,9 @@ subroutine Grid_constructor( this, speciesID, type ) real(8), allocatable :: origins(:,:), distance(:),factor(:) integer, allocatable :: atomicGridSize(:) - this%nameOfSpecies=trim(MolecularSystem_getNameOfSpecie(speciesID)) + this%molSys=>molSys + + this%nameOfSpecies=trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys)) if (trim(type) .eq. "INITIAL") then radialSize=CONTROL_instance%GRID_RADIAL_POINTS @@ -87,7 +89,7 @@ subroutine Grid_constructor( this, speciesID, type ) if(CONTROL_instance%PRINT_LEVEL .gt. 0) & write (*,"(A,I4,A,I2,A,A)") " Building an atomic grid with", radialSize, " radial points in ", numberOfShells, " shells for ", trim(this%nameOfSpecies) - numberOfCenters=size(MolecularSystem_instance%species(speciesID)%particles) + numberOfCenters=size(this%molSys%species(speciesID)%particles) allocate(origins(numberOfCenters,3), atomicGridSize(numberOfCenters)) !Get Atomic Grid @@ -98,7 +100,7 @@ subroutine Grid_constructor( this, speciesID, type ) !We are screening the points with delocalized orbital values lower than 1E-6 molecularGridSize=0 do particleID = 1, numberOfCenters - call Grid_radialCutoff( atomicGrid, initialGridSize, speciesID, particleID, atomicGridSize(particleID)) + call Grid_radialCutoff( atomicGrid, initialGridSize, speciesID, particleID, atomicGridSize(particleID), this%molSys) molecularGridSize=molecularGridSize + atomicGridSize(particleID) end do @@ -106,7 +108,7 @@ subroutine Grid_constructor( this, speciesID, type ) i=1 do particleID = 1, numberOfCenters - origins(particleID,1:3) = MolecularSystem_instance%species(speciesID)%particles(particleID)%origin(1:3) + origins(particleID,1:3) = this%molSys%species(speciesID)%particles(particleID)%origin(1:3) do point = 1, atomicGridSize(particleID) molecularGrid%values(i,1)=atomicGrid%values(point,1)+origins(particleID,1) molecularGrid%values(i,2)=atomicGrid%values(point,2)+origins(particleID,2) @@ -115,7 +117,7 @@ subroutine Grid_constructor( this, speciesID, type ) i=i+1 end do end do - + ! call Matrix_show(molecularGrid) !Calculate adecuate weights with Becke's @@ -170,7 +172,7 @@ subroutine Grid_constructor( this, speciesID, type ) if(CONTROL_instance%PRINT_LEVEL .gt. 0) then write(*,"(A,ES9.3,A,ES9.3,A)") "Screening delocalized orbital(<", CONTROL_instance%ELECTRON_DENSITY_THRESHOLD,& ") and low weight(<",CONTROL_instance%GRID_WEIGHT_THRESHOLD,") points ..." - print *, "Final molecular grid size for: ", trim(this%nameOfSpecies), Grid_instance(speciesID)%totalSize ," points" + print *, "Final molecular grid size for: ", trim(this%nameOfSpecies), this%totalSize ," points" print *, " " end if @@ -200,13 +202,14 @@ subroutine Grid_exception( typeMessage, description, debugDescription) end subroutine Grid_exception - subroutine Grid_radialCutoff(atomicGrid, gridSize, speciesID, particleID, relevantPoints) + subroutine Grid_radialCutoff(atomicGrid, gridSize, speciesID, particleID, relevantPoints, molSys) ! Gets the radial point where basis sets take negligible values ! Felix Moncada, 2017 implicit none type(matrix) :: atomicGrid - integer :: gridSize, speciesID, particleID + integer :: gridSize, speciesID, particleID integer :: relevantPoints !output + type(molecularSystem) :: molSys integer :: numberOfContractions integer :: numberOfPrimitives @@ -216,12 +219,12 @@ subroutine Grid_radialCutoff(atomicGrid, gridSize, speciesID, particleID, releva ! Search for the lowest exponent in the atomic basis set minExp=1E12 - numberOfContractions = size(MolecularSystem_instance%species(speciesID)%particles(particleID)%basis%contraction) + numberOfContractions = size(molSys%species(speciesID)%particles(particleID)%basis%contraction) do mu = 1, numberOfContractions - numberOfPrimitives = size(MolecularSystem_instance%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents) + numberOfPrimitives = size(molSys%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents) do i = 1, numberOfPrimitives - if (MolecularSystem_instance%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents(i) .lt. minExp) then - minExp=MolecularSystem_instance%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents(i) + if (molSys%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents(i) .lt. minExp) then + minExp=molSys%species(speciesID)%particles(particleID)%basis%contraction(mu)%orbitalExponents(i) end if end do end do diff --git a/src/DFT/GridManager.f90 b/src/DFT/GridManager.f90 index 16f8c530..007ff91f 100644 --- a/src/DFT/GridManager.f90 +++ b/src/DFT/GridManager.f90 @@ -50,26 +50,25 @@ module GridManager_ !! @brief Builds a grid for each species - Different sizes are possible, all points in memory ! Felix Moncada, 2017 ! Roberto Flores-Moreno, 2009 - subroutine GridManager_buildGrids( type ) + subroutine GridManager_buildGrids(Grid_instance, GridsCommonPoints, type, molSys ) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) character(*) :: type + type(MolecularSystem), target :: molSys + integer :: numberOfSpecies integer :: speciesID,otherSpeciesID character(50) :: labels(2) character(100) :: dftFile integer :: dftUnit - - numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies() - - !! Allocate memory. - if (.not. allocated(Grid_instance)) allocate(Grid_instance(numberOfSpecies)) - if (.not. allocated(GridsCommonPoints)) allocate(GridsCommonPoints(numberOfSpecies,numberOfSpecies)) + numberOfSpecies = size(Grid_instance(:)) !! Build and write species grids do speciesID = 1, numberOfSpecies - call Grid_constructor(Grid_instance(speciesID), speciesID , type ) + call Grid_constructor(Grid_instance(speciesID), speciesID , type, molSys) end do @@ -87,8 +86,11 @@ end subroutine GridManager_buildGrids !! @brief Writes a grid for each species - Different sizes are possible, all points in memory ! Felix Moncada, 2017 ! Roberto Flores-Moreno, 2009 - subroutine GridManager_writeGrids( type ) + subroutine GridManager_writeGrids(Grid_instance, GridsCommonPoints, Functionals, type ) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) + type(Functional) :: Functionals(:,:) character(*) :: type integer :: numberOfSpecies integer :: speciesID,otherSpeciesID @@ -96,7 +98,7 @@ subroutine GridManager_writeGrids( type ) character(100) :: dftFile integer :: dftUnit - numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies() + numberOfSpecies = size(Grid_instance(:)) !! Build and write species grids do speciesID = 1, numberOfSpecies @@ -121,7 +123,7 @@ subroutine GridManager_writeGrids( type ) !! This goes here for convenience only labels(1) = "EXACT-EXCHANGE-FRACTION" - call Vector_writeToFile(unit=dftUnit, binary=.true., value=Functional_getExchangeFraction(speciesID), arguments= labels ) + call Vector_writeToFile(unit=dftUnit, binary=.true., value=Functional_getExchangeFraction(Functionals,speciesID), arguments= labels ) labels(1) = "INTEGRATION-GRID" call Matrix_writeToFile(Grid_instance(speciesID)%points, unit=dftUnit, binary=.true., arguments = labels(1:2) ) @@ -166,8 +168,10 @@ end subroutine GridManager_writeGrids !! @brief Reads a grid for each species - Different sizes are possible, all points in memory ! Felix Moncada, 2017 ! Roberto Flores-Moreno, 2009 - subroutine GridManager_readGrids( type ) + subroutine GridManager_readGrids(Grid_instance, GridsCommonPoints, type ) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) character(*) :: type integer :: numberOfSpecies integer :: speciesID,otherSpeciesID @@ -176,16 +180,12 @@ subroutine GridManager_readGrids( type ) integer :: dftUnit real(8) :: auxVal - numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies() - - !! Allocate memory. - if (.not. allocated(Grid_instance)) allocate(Grid_instance(numberOfSpecies)) - if (.not. allocated(GridsCommonPoints)) allocate(GridsCommonPoints(numberOfSpecies,numberOfSpecies)) + numberOfSpecies = size(Grid_instance(:)) !! Build and write species grids do speciesID = 1, numberOfSpecies - Grid_instance(speciesID)%nameOfSpecies=trim(MolecularSystem_getNameOfSpecie(speciesID)) + Grid_instance(speciesID)%nameOfSpecies=trim(MolecularSystem_getNameOfSpecies(speciesID,Grid_instance(speciesID)%molSys)) !! Open file for dft dftUnit = 77 if( trim(type) .eq. "INITIAL" ) then @@ -250,8 +250,10 @@ end subroutine GridManager_readGrids !! @brief Writes the values of all the atomic orbitals and their gradients in a set of coordinates to a file !!! Felix Moncada, 2017 !< - subroutine GridManager_atomicOrbitals( action, type ) + subroutine GridManager_atomicOrbitals(Grid_instance, GridsCommonPoints, action, type ) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) character(*) action !read, compute or write character(*) type @@ -259,7 +261,7 @@ subroutine GridManager_atomicOrbitals( action, type ) integer :: totalNumberOfContractions integer :: speciesID integer :: gridSize - integer :: mu,nu, point, index + integer :: mu,nu, point character(50) :: labels(2) character(100) :: orbsFile @@ -269,11 +271,12 @@ subroutine GridManager_atomicOrbitals( action, type ) integer :: i, j, k, g, u integer :: numberOfCartesiansOrbitals - numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies() + numberOfSpecies = size(Grid_instance(:)) do speciesID = 1 , numberOfSpecies gridSize = Grid_instance(speciesID)%totalSize - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID ) + totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,Grid_instance(speciesID)%molSys) + orbsUnit = 78 if( trim(type) .eq. "INITIAL" ) then write( orbsFile, "(A,I0.4)") "lowdin."//trim(Grid_instance(speciesID)%nameOfSpecies)//".orbitals" @@ -283,8 +286,13 @@ subroutine GridManager_atomicOrbitals( action, type ) STOP "ERROR At DFT program, requested an unknown grid type to orbitals at GridManager" end if - if (.not. allocated(Grid_instance(speciesID)%orbitalsWithGradient)) & - allocate(Grid_instance(speciesID)%orbitalsWithGradient(totalNumberOfContractions)) + if (allocated(Grid_instance(speciesID)%orbitalsWithGradient)) then + do u=1, size(Grid_instance(speciesID)%orbitalsWithGradient(:)) + call Matrix_destructor(Grid_instance(speciesID)%orbitalsWithGradient(u)) + end do + deallocate(Grid_instance(speciesID)%orbitalsWithGradient) + end if + allocate(Grid_instance(speciesID)%orbitalsWithGradient(totalNumberOfContractions)) do u=1, totalNumberOfContractions call Matrix_Constructor( Grid_instance(speciesID)%orbitalsWithGradient(u), int(gridSize,8), int(4,8), 0.0_8) @@ -306,16 +314,16 @@ subroutine GridManager_atomicOrbitals( action, type ) if(trim(action) .eq. "WRITE") open(unit = orbsUnit, file=trim(orbsFile), status="replace", form="unformatted") k=0 - do g = 1, size(MolecularSystem_instance%species(speciesID)%particles) - do i = 1, size(MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction) - numberOfCartesiansOrbitals = MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(i)%numCartesianOrbital + do g = 1, size(Grid_instance(speciesID)%molSys%species(speciesID)%particles) + do i = 1, size(Grid_instance(speciesID)%molSys%species(speciesID)%particles(g)%basis%contraction) + numberOfCartesiansOrbitals = Grid_instance(speciesID)%molSys%species(speciesID)%particles(g)%basis%contraction(i)%numCartesianOrbital call Matrix_constructor( auxMatrix(1), int(gridSize,8), int(numberOfCartesiansOrbitals,8), 0.0_8) !orbital call Matrix_constructor( auxMatrix(2), int(gridSize,8), int(numberOfCartesiansOrbitals,8), 0.0_8) !d orbital/dx call Matrix_constructor( auxMatrix(3), int(gridSize,8), int(numberOfCartesiansOrbitals,8), 0.0_8) !d orbital/dy call Matrix_constructor( auxMatrix(4), int(gridSize,8), int(numberOfCartesiansOrbitals,8), 0.0_8) !d orbital/dz - - call ContractedGaussian_getGradientAtGrid( MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(i), & + + call ContractedGaussian_getGradientAtGrid( Grid_instance(speciesID)%molSys%species(speciesID)%particles(g)%basis%contraction(i), & Grid_instance(speciesID)%points, gridSize, auxMatrix(1), auxMatrix(2), auxMatrix(3), auxMatrix(4)) ! call Matrix_show(auxMatrix(1)) @@ -361,8 +369,10 @@ end subroutine GridManager_atomicOrbitals !! @brief Returns the values of the density in a set of coordinates !!! Felix Moncada, 2017 !< - subroutine GridManager_getDensityGradientAtGrid( speciesID, densityMatrix, densityInGrid, gradientInGrid) + subroutine GridManager_getDensityGradientAtGrid(Grid_instance, GridsCommonPoints, speciesID, densityMatrix, densityInGrid, gradientInGrid) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) integer :: speciesID type(Matrix) :: densityMatrix type(Vector) :: densityInGrid @@ -375,8 +385,8 @@ subroutine GridManager_getDensityGradientAtGrid( speciesID, densityMatrix, densi integer :: i, j, u, g integer :: ii, jj, v, gg integer :: s, ss - real(8) :: sum integer :: numberOfContractions + real(8) :: auxreal integer :: n, nproc real :: time1,time2 @@ -385,7 +395,8 @@ subroutine GridManager_getDensityGradientAtGrid( speciesID, densityMatrix, densi gridSize = Grid_instance(speciesID)%totalSize - numberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID ) + numberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID,Grid_instance(speciesID)%molSys) + nproc=omp_get_max_threads() if(.not. allocated(nodeDensityInGrid) ) allocate( nodeDensityInGrid(nproc),nodeGradientInGrid(nproc,3) ) @@ -451,6 +462,15 @@ subroutine GridManager_getDensityGradientAtGrid( speciesID, densityMatrix, densi call Vector_Destructor( nodeGradientInGrid(n,3)) end do + !!Check for negative values, which should be numerical mistakes + auxreal=1.0E8 + do point = 1 , gridSize + if(densityInGrid%values(point).lt.auxreal) auxreal=densityInGrid%values(point) + if(densityInGrid%values(point).lt.0.0) densityInGrid%values(point)=0.0 + end do + if(-auxreal.gt.CONTROL_instance%NUCLEAR_ELECTRON_DENSITY_THRESHOLD) print *, "found significative negative density, up to", auxreal, ", for species", speciesID + + time2=omp_get_wtime() ! write(*,"(A,F10.3,A4)") "**getDensityGradientAtGrid:", time2-time1 ," (s)" @@ -464,9 +484,12 @@ end subroutine GridManager_getDensityGradientAtGrid !! @brief Returns the values of the exchange correlation potential for a specie in a set of coordinates !!! Felix Moncada, 2017 !< - subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchangeCorrelationEnergy, & + subroutine GridManager_getElectronicEnergyAndPotentialAtGrid(Grid_instance, GridsCommonPoints, Functionals, speciesID, exchangeCorrelationEnergy, & otherSpeciesID, otherExchangeCorrelationEnergy) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) + type(Functional) :: Functionals(:,:) integer :: speciesID real(8) :: exchangeCorrelationEnergy integer, optional :: otherSpeciesID @@ -477,11 +500,11 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang type(Vector) :: energyDensity type(Vector) :: sigma, sigmaPotential type(Vector) :: densityAB, potentialAB, sigmaAB, sigmaPotentialAB - integer :: i, index, dir + integer :: i, dir - nameOfSpecies = MolecularSystem_getNameOfSpecie( speciesID ) - if( present(otherSpeciesID) ) otherNameOfSpecies = MolecularSystem_getNameOfSpecie( otherSpeciesID ) + nameOfSpecies = MolecularSystem_getNameOfSpecies( speciesID,Grid_instance(speciesID)%molSys) + if( present(otherSpeciesID) ) otherNameOfSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID,Grid_instance(otherSpeciesID)%molSys) gridSize = Grid_instance(speciesID)%totalSize @@ -491,8 +514,6 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang !Closed Shell if (nameOfSpecies=="E-" .and. .not. present(otherSpeciesID) ) then - index=Functional_getIndex(speciesID) - call Vector_Constructor(sigma, gridSize, 0.0_8) call Vector_Constructor(sigmaPotential, gridSize, 0.0_8) !$omp parallel private(i) @@ -506,7 +527,7 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang +Grid_instance(speciesID)%densityGradient(3)%values(i)**2) !evaluates energy density, potential and sigma potential - call Functional_libxcEvaluate(Functionals(index), 1, Grid_instance(speciesID)%density%values(i), & + call Functional_libxcEvaluate(Functionals(speciesID,speciesID), 1, Grid_instance(speciesID)%density%values(i), & sigma%values(i), energyDensity%values(i) , & Grid_instance(speciesID)%potential%values(i), sigmaPotential%values(i) ) end if @@ -540,8 +561,6 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang call Vector_Constructor(potentialAB, 2*gridSize, 0.0_8) call Vector_Constructor(sigmaPotentialAB, 3*gridSize, 0.0_8) - index=Functional_getIndex(speciesID) - !$omp parallel private(i) !$omp do schedule (dynamic) do i=1, gridSize @@ -565,7 +584,7 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang !evaluates energy density, potential and sigma potential - call Functional_libxcEvaluate(Functionals(index), 1, densityAB%values(2*i-1:2*i), sigmaAB%values(3*i-2:3*i), & + call Functional_libxcEvaluate(Functionals(speciesID,otherSpeciesID), 1, densityAB%values(2*i-1:2*i), sigmaAB%values(3*i-2:3*i), & energyDensity%values(i) , potentialAB%values(2*i-1:2*i), sigmaPotentialAB%values(3*i-2:3*i) ) !potential assignment @@ -619,8 +638,7 @@ subroutine GridManager_getElectronicEnergyAndPotentialAtGrid( speciesID, exchang end if else - index=Functional_getIndex(speciesID) - if ( Functionals(index)%name .eq. "exchange:Slater-correlation:VWN5") then + if ( Functionals(speciesID,speciesID)%name .eq. "exchange:Slater-correlation:VWN5") then if (nameOfSpecies=="E-" .and. .not. present(otherSpeciesID) ) then @@ -659,10 +677,13 @@ end subroutine GridManager_getElectronicEnergyAndPotentialAtGrid !! @brief Returns the values of the exchange correlation potential for a specie in a set of coordinates !!! Felix Moncada, 2017 !< - subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, otherSpeciesID, exchangeCorrelationEnergy, & + subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid(Grid_instance, GridsCommonPoints, Functionals, speciesID, otherSpeciesID, exchangeCorrelationEnergy, & otherElectronID, otherElectronExchangeCorrelationEnergy) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) + type(Functional) :: Functionals(:,:) integer :: speciesID integer :: otherSpeciesID real(8) :: exchangeCorrelationEnergy @@ -675,18 +696,16 @@ subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, other type(Vector) :: sigma type(Vector) :: densityAB, potentialAB, sigmaAB, sigmaPotentialAB type(Vector) :: electronicDensityAtOtherGrid, electronicGradientAtOtherGrid(3), electronicPotentialAtOtherGrid, electronicGradientPotentialAtOtherGrid(3) - integer :: i, j, k, index, dir + integer :: i, j, k, dir - nameOfSpecies = MolecularSystem_getNameOfSpecie( speciesID ) - otherNameOfSpecies = MolecularSystem_getNameOfSpecie( otherSpeciesID ) + nameOfSpecies = MolecularSystem_getNameOfSpecies( speciesID,Grid_instance(speciesID)%molSys) + otherNameOfSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID,Grid_instance(otherSpeciesID)%molSys) if ( (nameOfSpecies.ne."E-" .and. nameOfSpecies.ne."E-ALPHA") ) return gridSize = Grid_instance(speciesID)%totalSize otherGridSize = Grid_instance(otherSpeciesID)%totalSize - index=Functional_getIndex(speciesID, otherSpeciesID) - !Nuclear electron correlation !"E-BETA" is treated at the same time as E-ALPHA @@ -699,7 +718,7 @@ subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, other end do !!This adds E-BETA density and gradient - call GridManager_getElectronicDensityInOtherGrid(speciesID, otherSpeciesID, & + call GridManager_getElectronicDensityInOtherGrid(Grid_instance, GridsCommonPoints, speciesID, otherSpeciesID, & GridsCommonPoints(speciesID,otherSpeciesID)%totalSize, int(GridsCommonPoints(speciesID,otherSpeciesID)%points%values), & electronicDensityAtOtherGrid, electronicGradientAtOtherGrid) @@ -714,86 +733,86 @@ subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid( speciesID, other select case (trim(auxstring) ) case ("EXPCS-GGA") - call Functional_expCSGGAEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_expCSGGAEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid, electronicGradientAtOtherGrid, & Grid_instance(otherSpeciesID)%density, Grid_instance(otherSpeciesID)%densityGradient, & energyDensity, electronicPotentialAtOtherGrid, electronicGradientPotentialAtOtherGrid, & Grid_instance(otherSpeciesID)%potential, Grid_instance(otherSpeciesID)%gradientPotential ) case ("EXPCS-GGA-NOA") - call Functional_expCSGGAEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_expCSGGAEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid, electronicGradientAtOtherGrid, & Grid_instance(otherSpeciesID)%density, Grid_instance(otherSpeciesID)%densityGradient, & energyDensity, electronicPotentialAtOtherGrid, electronicGradientPotentialAtOtherGrid, & Grid_instance(otherSpeciesID)%potential, Grid_instance(otherSpeciesID)%gradientPotential ) case ("EPC17-1") - call Functional_EPCEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_EPCEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("EPC17-2") - call Functional_EPCEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_EPCEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("IKN-NSF") - call Functional_IKNEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_IKNEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("MLCS-FIT") - call Functional_MLCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_MLCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("MLCS-A") - call Functional_MLCSAEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_MLCSAEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("MLCS-AN") - call Functional_MLCSANEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_MLCSANEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("CS-MYFIT") - call Functional_myCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_myCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("IMAMURA-MYFIT") - call Functional_myCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_myCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("MEJIA-MYFIT") - call Functional_myCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_myCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("MEJIAA-MYFIT") - call Functional_myCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_myCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("EXPCS-A") - call Functional_expCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_expCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("EXPCS-NOA") - call Functional_expCSEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_expCSEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("PSN") - call Functional_PSNEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_PSNEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) case ("PSNAP") - call Functional_PSNAPEvaluate(Functionals(index), MolecularSystem_getMass( otherSpeciesID ), otherGridSize, & + call Functional_PSNAPEvaluate(Functionals(speciesID, otherSpeciesID), MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys ), otherGridSize, & electronicDensityAtOtherGrid%values, Grid_instance(otherSpeciesID)%density%values, & energyDensity%values, electronicPotentialAtOtherGrid%values, Grid_instance(otherSpeciesID)%potential%values ) @@ -857,8 +876,10 @@ end subroutine GridManager_getInterspeciesEnergyAndPotentialAtGrid !> !! @brief Builds the exchange correlation for a species ! Felix Moncada, 2017 - subroutine GridManager_buildExchangeCorrelationMatrix( speciesID, exchangeCorrelationMatrix) + subroutine GridManager_buildExchangeCorrelationMatrix(Grid_instance, GridsCommonPoints, speciesID, exchangeCorrelationMatrix) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) integer :: speciesID type(Matrix) :: exchangeCorrelationMatrix @@ -874,7 +895,7 @@ subroutine GridManager_buildExchangeCorrelationMatrix( speciesID, exchangeCorrel type(Matrix),allocatable :: nodeExchangeCorrelationMatrix(:) gridSize = Grid_instance(speciesID)%totalSize - numberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID ) + numberOfContractions = MolecularSystem_getTotalNumberOfContractions( speciesID,Grid_instance(speciesID)%molSys) nproc=omp_get_max_threads() @@ -953,7 +974,10 @@ end subroutine GridManager_buildExchangeCorrelationMatrix - subroutine GridManager_getElectronicDensityInOtherGrid(electronicID,otherSpeciesID, commonGridSize, commonPoints, electronicDensityAtOtherGrid, electronicGradientAtOtherGrid ) + subroutine GridManager_getElectronicDensityInOtherGrid(Grid_instance, GridsCommonPoints,electronicID,otherSpeciesID, commonGridSize, commonPoints, electronicDensityAtOtherGrid, electronicGradientAtOtherGrid ) + implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) integer :: electronicID, otherSpeciesID integer :: commonGridSize integer :: commonPoints(commonGridSize,2) @@ -969,14 +993,19 @@ subroutine GridManager_getElectronicDensityInOtherGrid(electronicID,otherSpecies electronicGridSize=Grid_instance(electronicID)%totalSize otherGridSize=Grid_instance(otherSpeciesID)%totalSize - nameOfElectron=MolecularSystem_getNameOfSpecie(electronicID) - if (nameOfElectron .eq. "E-ALPHA") otherElectronicID=MolecularSystem_getSpecieID( "E-BETA" ) - if (nameOfElectron .eq. "E-BETA") otherElectronicID=MolecularSystem_getSpecieID( "E-ALPHA" ) + nameOfElectron=MolecularSystem_getNameOfSpecies(electronicID,Grid_instance(electronicID)%molSys) + + if (nameOfElectron .eq. "E-ALPHA") otherElectronicID=MolecularSystem_getSpecieID( "E-BETA",Grid_instance(electronicID)%molSys) + if (nameOfElectron .eq. "E-BETA") otherElectronicID=MolecularSystem_getSpecieID( "E-ALPHA",Grid_instance(electronicID)%molSys) call Vector_constructor(electronicDensityAtOtherGrid, otherGridSize, 1.0E-12_8) + time1=omp_get_wtime() + + !check if both have common points + if(commonGridSize .lt. 0) print *, "WARNING! trying to evaluate the correlation between species ", electronicID, " and " ,otherSpeciesID, " but there are no common points. Are the GTF centers equal?" do k=1, commonGridSize !here we are assuming that the electron came in the first position i=commonPoints(k,1) @@ -993,12 +1022,14 @@ subroutine GridManager_getElectronicDensityInOtherGrid(electronicID,otherSpecies electronicGradientAtOtherGrid(3)%values(j)=Grid_instance(electronicID)%densityGradient(3)%values(i) end if end do + time2=omp_get_wtime() ! write(*,"(A,F10.3,A4)") "**getElectronicDensityInOtherGrid:", time2-time1 ," (s)" end subroutine GridManager_getElectronicDensityInOtherGrid subroutine GridManager_findCommonPoints(grid,gridSize,otherGrid,otherGridSize,commonPoints,commonSize) + implicit none type(Matrix) :: grid,otherGrid integer :: gridSize,otherGridSize,commonSize type(Matrix) :: commonPoints @@ -1052,8 +1083,10 @@ end subroutine GridManager_FindCommonPoints !> !! @brief Builds the exchange correlation for a species ! Felix Moncada, 2017 - subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectronID) + subroutine GridManager_getContactDensity(Grid_instance, GridsCommonPoints, speciesID, otherSpeciesID, otherElectronID) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) integer :: speciesID, otherSpeciesID integer, optional :: otherElectronID @@ -1076,7 +1109,7 @@ subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectr call Vector_constructor(electronicGradientAtOtherGrid(3), gridSize, 0.0_8) !electrons go on the first position - call GridManager_getElectronicDensityInOtherGrid(speciesID, otherSpeciesID, & + call GridManager_getElectronicDensityInOtherGrid(Grid_instance, GridsCommonPoints, speciesID, otherSpeciesID, & GridsCommonPoints(speciesID,otherSpeciesID)%totalSize, int(GridsCommonPoints(speciesID,otherSpeciesID)%points%values), electronicDensityAtOtherGrid, electronicGradientAtOtherGrid ) call Vector_constructor(gfactor, gridSize, 0.0_8) @@ -1099,7 +1132,7 @@ subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectr end if - if(MolecularSystem_getMass(otherSpeciesID) .lt. 2.0 .and. (auxstring.eq."expCS-A" .or. auxstring.eq."expCS-GGA")) then !positron + if(MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys) .lt. 2.0 .and. (auxstring.eq."expCS-A" .or. auxstring.eq."expCS-GGA")) then !positron kf=2.2919886876120283056 a0n=0.3647813291441602 @@ -1120,7 +1153,7 @@ subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectr rhoE=electronicDensityAtOtherGrid%values(point) rhoP=Grid_instance(otherSpeciesID)%density%values(point) - call Functional_getBeta( rhoE, rhoP, MolecularSystem_getMass(otherSpeciesID), kf, beta, dBdE, dBdP, d2BdE2, d2BdP2, d2BdEP) + call Functional_getBeta( rhoE, rhoP, MolecularSystem_getMass( otherSpeciesID, Grid_instance(otherSpeciesID)%molSys), kf, beta, dBdE, dBdP, d2BdE2, d2BdP2, d2BdEP) if( rhoE .gt. densityThreshold .and. rhoP .gt. densityThreshold ) then ! gfactor%values(point)=(a0n+a1n*beta+a2n*beta**2+a3n*beta**3+a4n*beta**4)/(a0d*beta**3+a1d*beta**4+a2d*beta**5) @@ -1151,8 +1184,8 @@ subroutine GridManager_getContactDensity( speciesID, otherSpeciesID, otherElectr if(CONTROL_instance%PRINT_LEVEL .gt. 0) then print *, "" - print *, "Contact density between ", trim(MolecularSystem_getNameOfSpecie(speciesID)),"-", trim(MolecularSystem_getNameOfSpecie(otherSpeciesID)) - if(present(otherElectronID) ) print *, "Including contact density between ", trim(MolecularSystem_getNameOfSpecie(otherElectronID)),"-", trim(MolecularSystem_getNameOfSpecie(otherSpeciesID)) + print *, "Contact density between ", trim(Grid_instance(speciesID)%nameOfSpecies),"-", trim(Grid_instance(otherSpeciesID)%nameOfSpecies) + if(present(otherElectronID) ) print *, "Including contact density between ", trim(Grid_instance(otherElectronID)%nameOfSpecies),"-", trim(Grid_instance(otherSpeciesID)%nameOfSpecies) if(auxstring.eq."expCS-A" .or. auxstring.eq."expCS-GGA" ) then print *, "As the integral of rhoA*rhoB(1+g[beta])" @@ -1178,8 +1211,10 @@ end subroutine GridManager_getContactDensity !> !! @brief Builds the exchange correlation for a species ! Felix Moncada, 2017 - subroutine GridManager_getExpectedDistances( speciesID) + subroutine GridManager_getExpectedDistances(Grid_instance, GridsCommonPoints, speciesID) implicit none + type(Grid) :: Grid_instance(:) + type(Grid) :: GridsCommonPoints(:,:) integer :: speciesID integer :: point,gridSize @@ -1188,7 +1223,7 @@ subroutine GridManager_getExpectedDistances( speciesID) gridSize =Grid_instance(speciesID)%totalSize - numberOfCenters=MolecularSystem_instance%numberOfPointCharges + numberOfCenters=Grid_instance(speciesID)%molSys%numberOfPointCharges if(.not. allocated(distances))allocate(distances(numberOfCenters)) @@ -1199,14 +1234,14 @@ subroutine GridManager_getExpectedDistances( speciesID) distances(center)=distances(center) + & Grid_instance(speciesID)%density%values(point)* & - sqrt((MolecularSystem_instance%pointCharges(center)%origin(1)-Grid_instance(speciesID)%points%values(point,1) )**2+ & - (MolecularSystem_instance%pointCharges(center)%origin(2)-Grid_instance(speciesID)%points%values(point,2) )**2+ & - (MolecularSystem_instance%pointCharges(center)%origin(3)-Grid_instance(speciesID)%points%values(point,3) )**2 ) * & + sqrt((Grid_instance(speciesID)%molSys%pointCharges(center)%origin(1)-Grid_instance(speciesID)%points%values(point,1) )**2+ & + (Grid_instance(speciesID)%molSys%pointCharges(center)%origin(2)-Grid_instance(speciesID)%points%values(point,2) )**2+ & + (Grid_instance(speciesID)%molSys%pointCharges(center)%origin(3)-Grid_instance(speciesID)%points%values(point,3) )**2 ) * & Grid_instance(speciesID)%points%values(point,4) end do - write (*,"(A10,A10,F20.10)") trim(Grid_instance(speciesID)%nameOfSpecies), trim(MolecularSystem_instance%pointCharges(center)%nickname), distances(center) + write (*,"(A10,A10,F20.10)") trim(Grid_instance(speciesID)%nameOfSpecies), trim(Grid_instance(speciesID)%molSys%pointCharges(center)%nickname), distances(center) end do diff --git a/src/MBPT/ENFunctions.f90 b/src/MBPT/ENFunctions.f90 index af4c4627..1d16d935 100644 --- a/src/MBPT/ENFunctions.f90 +++ b/src/MBPT/ENFunctions.f90 @@ -178,7 +178,7 @@ subroutine EpsteinNesbet_show() print *,"" do i=1, EpsteinNesbet_instance%numberOfSpecies - write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecie( i ) )//"} = ", & + write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecies( i ) )//"} = ", & EpsteinNesbet_instance%energyCorrectionOfSecondOrder%values(i,1) end do @@ -187,7 +187,7 @@ subroutine EpsteinNesbet_show() do i=1, EpsteinNesbet_instance%numberOfSpecies do j=i+1,EpsteinNesbet_instance%numberOfSpecies k=k+1 - write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecie( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecie( j ) )//" } = ", & + write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecies( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecies( j ) )//" } = ", & EpsteinNesbet_instance%energyOfCouplingCorrectionOfSecondOrder%values(k,1) end do end do @@ -208,7 +208,7 @@ subroutine EpsteinNesbet_show() print *,"" do i=1, EpsteinNesbet_instance%numberOfSpecies - write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecie( i ) )//" } = ", & + write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecies( i ) )//" } = ", & EpsteinNesbet_instance%energyCorrectionOfSecondOrder%values(i,2) end do @@ -217,7 +217,7 @@ subroutine EpsteinNesbet_show() do i=1, EpsteinNesbet_instance%numberOfSpecies do j=i+1,EpsteinNesbet_instance%numberOfSpecies k=k+1 - write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecie( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecie( j ) ) //" } = ", & + write (*,'(A30,F20.12)') "E(2){ "//trim( MolecularSystem_getNameOfSpecies( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecies( j ) ) //" } = ", & EpsteinNesbet_instance%energyOfCouplingCorrectionOfSecondOrder%values(k,2) end do end do @@ -238,7 +238,7 @@ subroutine EpsteinNesbet_show() print *,"" do i=1, EpsteinNesbet_instance%numberOfSpecies - write (*,'(A30,F20.12)') "E(2){ "// trim( MolecularSystem_getNameOfSpecie( i ) )//" } = ", & + write (*,'(A30,F20.12)') "E(2){ "// trim( MolecularSystem_getNameOfSpecies( i ) )//" } = ", & EpsteinNesbet_instance%energyCorrectionOfSecondOrder%values(i,3) end do @@ -247,7 +247,7 @@ subroutine EpsteinNesbet_show() do i=1, EpsteinNesbet_instance%numberOfSpecies do j=i+1,EpsteinNesbet_instance%numberOfSpecies k=k+1 - write (*,'(A30,F20.12)') "E(2){ "// trim( MolecularSystem_getNameOfSpecie( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecie( j ) ) // " } = ", & + write (*,'(A30,F20.12)') "E(2){ "// trim( MolecularSystem_getNameOfSpecies( i ) ) // "/" // trim( MolecularSystem_getNameOfSpecies( j ) ) // " } = ", & EpsteinNesbet_instance%energyOfCouplingCorrectionOfSecondOrder%values(k,3) end do end do @@ -359,7 +359,7 @@ function EpsteinNesbet_getSpecieCorrection( specieName) result( output) do i=1, EpsteinNesbet_instance%numberOfSpecies - if ( trim(specieName) == trim( MolecularSystem_getNameOfSpecie( i ) ) ) then + if ( trim(specieName) == trim( MolecularSystem_getNameOfSpecies( i ) ) ) then output = EpsteinNesbet_instance%energyCorrectionOfSecondOrder%values(i,1) !!MP2 return @@ -473,14 +473,14 @@ subroutine EpsteinNesbet_secondOrderCorrection() do is=1, EpsteinNesbet_instance%numberOfSpecies - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( is ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( is ) ) independentEnergyCorrection = 0.0_8 if( trim(nameOfSpecie)=="E-" .or. .not.CONTROL_instance%MP_ONLY_ELECTRONIC_CORRECTION ) then numberOfContractions = MolecularSystem_getTotalNumberOfContractions(is) - arguments(2) = MolecularSystem_getNameOfSpecie(is) + arguments(2) = MolecularSystem_getNameOfSpecies(is) arguments(1) = "COEFFICIENTS" eigenVec= Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), & @@ -743,7 +743,7 @@ subroutine EpsteinNesbet_secondOrderCorrection() do is = 1 , EpsteinNesbet_instance%numberOfSpecies numberOfContractions = MolecularSystem_getTotalNumberOfContractions(is) - arguments(2) = trim(MolecularSystem_getNameOfSpecie(is)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(is)) arguments(1) = "COEFFICIENTS" eigenVec = & @@ -755,7 +755,7 @@ subroutine EpsteinNesbet_secondOrderCorrection() unit = wfnUnit, binary = .true., arguments = arguments(1:2), & output = eigenValues ) - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( is ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( is ) ) specieID =MolecularSystem_getSpecieID( nameOfSpecie=trim(nameOfSpecie) ) ocupationNumber = MolecularSystem_getOcupationNumber( is ) lambda = MolecularSystem_getEta( is ) @@ -766,7 +766,7 @@ subroutine EpsteinNesbet_secondOrderCorrection() numberOfContractionsOfOtherSpecie = MolecularSystem_getTotalNumberOfContractions( js ) - arguments(2) = trim(MolecularSystem_getNameOfSpecie(js)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(js)) arguments(1) = "COEFFICIENTS" eigenVecOtherSpecie = & @@ -779,7 +779,7 @@ subroutine EpsteinNesbet_secondOrderCorrection() output = eigenValuesOfOtherSpecie ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( js ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( js ) ) otherSpecieID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecie ) ocupationNumberOfOtherSpecie = MolecularSystem_getOcupationNumber( js ) diff --git a/src/MBPT/MPFunctions.f90 b/src/MBPT/MPFunctions.f90 index 1f8e9c7f..de27319a 100644 --- a/src/MBPT/MPFunctions.f90 +++ b/src/MBPT/MPFunctions.f90 @@ -188,7 +188,7 @@ subroutine MollerPlesset_show() print *,"" do i=1, MollerPlesset_instance%numberOfSpecies - write (*,'(A30,F20.12)') "E(2){ "//trim(MolecularSystem_getNameOfSpecie(i))//" } = ", & + write (*,'(A30,F20.12)') "E(2){ "//trim(MolecularSystem_getNameOfSpecies(i))//" } = ", & MollerPlesset_instance%energyCorrectionOfSecondOrder%values(i) end do @@ -197,7 +197,7 @@ subroutine MollerPlesset_show() do i=1, MollerPlesset_instance%numberOfSpecies do j=i+1,MollerPlesset_instance%numberOfSpecies k=k+1 - write (*,'(A30,F20.12)') "E(2){ "//trim(MolecularSystem_getNameOfSpecie(i))//"/"//trim(MolecularSystem_getNameOfSpecie(j))//" } = ", & + write (*,'(A30,F20.12)') "E(2){ "//trim(MolecularSystem_getNameOfSpecies(i))//"/"//trim(MolecularSystem_getNameOfSpecies(j))//" } = ", & MollerPlesset_instance%energyOfCouplingCorrectionOfSecondOrder%values(k) end do end do @@ -302,7 +302,7 @@ function MollerPlesset_getSpecieCorrection( specieName) result( output) do i=1, MollerPlesset_instance%numberOfSpecies - if ( trim(specieName) == trim( MolecularSystem_getNameOfSpecie( i ) ) ) then + if ( trim(specieName) == trim( MolecularSystem_getNameOfSpecies( i ) ) ) then output = MollerPlesset_instance%energyCorrectionOfSecondOrder%values(i) return @@ -412,14 +412,14 @@ subroutine MollerPlesset_secondOrderCorrection() do is=1, MollerPlesset_instance%numberOfSpecies - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( is ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( is ) ) independentEnergyCorrection = 0.0_8 if( trim(nameOfSpecie)=="E-" .or. .not.CONTROL_instance%MP_ONLY_ELECTRONIC_CORRECTION ) then numberOfContractions = MolecularSystem_getTotalNumberOfContractions(is) - arguments(2) = MolecularSystem_getNameOfSpecie(is) + arguments(2) = MolecularSystem_getNameOfSpecies(is) arguments(1) = "COEFFICIENTS" eigenVec= Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), & @@ -687,7 +687,7 @@ subroutine MollerPlesset_secondOrderCorrection() do is = 1 , MollerPlesset_instance%numberOfSpecies numberOfContractions = MolecularSystem_getTotalNumberOfContractions(is) - arguments(2) = trim(MolecularSystem_getNameOfSpecie(is)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(is)) arguments(1) = "COEFFICIENTS" eigenVec = & @@ -699,7 +699,7 @@ subroutine MollerPlesset_secondOrderCorrection() unit = wfnUnit, binary = .true., arguments = arguments(1:2), & output = eigenValues ) - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( is ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( is ) ) specieID =MolecularSystem_getSpecieID( nameOfSpecie=trim(nameOfSpecie) ) ocupationNumber = MolecularSystem_getOcupationNumber( is ) lambda = MolecularSystem_getEta( is ) @@ -710,7 +710,7 @@ subroutine MollerPlesset_secondOrderCorrection() numberOfContractionsOfOtherSpecie = MolecularSystem_getTotalNumberOfContractions( js ) - arguments(2) = trim(MolecularSystem_getNameOfSpecie(js)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(js)) arguments(1) = "COEFFICIENTS" eigenVecOtherSpecie = & @@ -723,7 +723,7 @@ subroutine MollerPlesset_secondOrderCorrection() output = eigenValuesOfOtherSpecie ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( js ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( js ) ) otherSpecieID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecie ) ocupationNumberOfOtherSpecie = MolecularSystem_getOcupationNumber( js ) @@ -797,8 +797,8 @@ subroutine MollerPlesset_secondOrderCorrection() select case (order) case ("AB") - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie) @@ -835,8 +835,8 @@ subroutine MollerPlesset_secondOrderCorrection() case ("BA") - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie) diff --git a/src/NOCI/NOCI.f90 b/src/NOCI/NOCI.f90 index 531caa8b..9d5911c9 100644 --- a/src/NOCI/NOCI.f90 +++ b/src/NOCI/NOCI.f90 @@ -27,13 +27,16 @@ !! @warning This programs only works linked to lowdincore library, provided by LOWDIN quantum chemistry package !! program NOCI + use NOCIBuild_ + use NOCIRunSCF_ + use NOCIMatrices_ + use NOCISuperposed_ + use NOCIFranckCondon_ + use NOCIRotFormula_ use CONTROL_ use InputManager_ use MolecularSystem_ - use Exception_ - use NonOrthogonalCI_ use String_ - use InputCI_ use Stopwatch_ use MecanicProperties_ implicit none @@ -63,23 +66,25 @@ program NOCI !!Load the system in lowdin.sys format call MolecularSystem_loadFromFile( "LOWDIN.SYS" ) - call NonOrthogonalCI_constructor(NonOrthogonalCI_instance) + call NOCIBuild_constructor(NOCI_instance) if(CONTROL_instance%READ_NOCI_GEOMETRIES) then - call NonOrthogonalCI_readGeometries(NonOrthogonalCI_instance) + call NOCIBuild_readGeometries(NOCI_instance) else - call NonOrthogonalCI_displaceGeometries(NonOrthogonalCI_instance) + call NOCIBuild_displaceGeometries(NOCI_instance) end if - call NonOrthogonalCI_runHFs(NonOrthogonalCI_instance) - call NonOrthogonalCI_buildOverlapAndHamiltonianMatrix(NonOrthogonalCI_instance) - - if(.not. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then - call NonOrthogonalCI_diagonalizeCImatrix(NonOrthogonalCI_instance) - call NonOrthogonalCI_generateSuperposedSystem(NonOrthogonalCI_instance) - call NonOrthogonalCI_buildDensityMatrix(NonOrthogonalCI_instance) - call NonOrthogonalCI_getNaturalOrbitals(NonOrthogonalCI_instance) - call NonOrthogonalCI_computeFranckCondon(NonOrthogonalCI_instance) - call NonOrthogonalCI_saveToFile(NonOrthogonalCI_instance) - else + call NOCIRunSCF_runHFs(NOCI_instance) + call NOCIMatrices_buildOverlapAndHamiltonian(NOCI_instance) + + if (.not.(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS .or. CONTROL_instance%COMPUTE_ROCI_FORMULA)) then + call NOCIMatrices_diagonalize(NOCI_instance) + call NOCISuperposed_generateSuperposedSystem(NOCI_instance) + call NOCISuperposed_buildDensityMatrix(NOCI_instance) + call NOCISuperposed_getNaturalOrbitals(NOCI_instance) + call NOCIFranckCondon_computeFranckCondon(NOCI_instance) + call NOCISuperposed_saveToFile(NOCI_instance) + else if (CONTROL_instance%COMPUTE_ROCI_FORMULA) then + call NOCIRotFormula_compute(NOCI_instance) + else if (CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then write (*,"(T10,A)") "COMPUTED NOCI ELEMENTS ONLY WITH RESPECT TO THE FIRST GEOMETRY - YOU HAVE TO SOLVE THE CI EQUATION MANUALLY!" end if @@ -204,18 +209,25 @@ program NOCI ! end if if ( CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION ) then - call NonOrthogonalCI_constructor(NonOrthogonalCI_instance) - call NonOrthogonalCI_displaceGeometries(NonOrthogonalCI_instance) - call NonOrthogonalCI_runHFs(NonOrthogonalCI_instance) - call NonOrthogonalCI_buildOverlapAndHamiltonianMatrix(NonOrthogonalCI_instance) - if(.not. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then - call NonOrthogonalCI_diagonalizeCImatrix(NonOrthogonalCI_instance) - call NonOrthogonalCI_generateSuperposedSystem(NonOrthogonalCI_instance) - call NonOrthogonalCI_buildDensityMatrix(NonOrthogonalCI_instance) - call NonOrthogonalCI_getNaturalOrbitals(NonOrthogonalCI_instance) - call NonOrthogonalCI_computeFranckCondon(NonOrthogonalCI_instance) - call NonOrthogonalCI_saveToFile(NonOrthogonalCI_instance) + call NOCIBuild_constructor(NOCI_instance) + if(CONTROL_instance%READ_NOCI_GEOMETRIES) then + call NOCIBuild_readGeometries(NOCI_instance) else + call NOCIBuild_displaceGeometries(NOCI_instance) + end if + call NOCIRunSCF_runHFs(NOCI_instance) + call NOCIMatrices_buildOverlapAndHamiltonian(NOCI_instance) + + if (.not.(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS .or. CONTROL_instance%COMPUTE_ROCI_FORMULA)) then + call NOCIMatrices_diagonalize(NOCI_instance) + call NOCISuperposed_generateSuperposedSystem(NOCI_instance) + call NOCISuperposed_buildDensityMatrix(NOCI_instance) + call NOCISuperposed_getNaturalOrbitals(NOCI_instance) + call NOCIFranckCondon_computeFranckCondon(NOCI_instance) + call NOCISuperposed_saveToFile(NOCI_instance) + else if (CONTROL_instance%COMPUTE_ROCI_FORMULA) then + call NOCIRotFormula_compute(NOCI_instance) + else if (CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then write (*,"(T10,A)") "COMPUTED NOCI ELEMENTS ONLY WITH RESPECT TO THE FIRST GEOMETRY - YOU HAVE TO SOLVE THE CI EQUATION MANUALLY!" end if end if @@ -223,7 +235,7 @@ program NOCI call MolecularSystem_saveToFile() !!calculate CI density properties - call system ("lowdin-CalcProp.x") + if ( .not. (CONTROL_instance%COMPUTE_ROCI_FORMULA .or. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS)) call system ("lowdin-CalcProp.x") if ( CONTROL_instance%IS_THERE_OUTPUT ) then write(strAuxNumber,"(I10)") Input_instance%numberOfOutputs diff --git a/src/NOCI/NOCIBuild.f90 b/src/NOCI/NOCIBuild.f90 new file mode 100644 index 00000000..229ce491 --- /dev/null +++ b/src/NOCI/NOCIBuild.f90 @@ -0,0 +1,981 @@ +!****************************************************************************** +!! This code is part of LOWDIN Quantum chemistry package +!! +!! this program has been developed under direction of: +!! +!! UNIVERSIDAD NACIONAL DE COLOMBIA" +!! PROF. ANDRES REYES GROUP" +!! http://www.qcc.unal.edu.co" +!! +!! UNIVERSIDAD DE GUADALAJARA" +!! PROF. ROBERTO FLORES GROUP" +!! http://www.cucei.udg.mx/~robertof" +!! +!! AUTHORS +!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA +!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! CONTRIBUTORS +!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA +!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO +!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! +!! Todos los derechos reservados, 2011 +!! +!!****************************************************************************** + +module NOCIBuild_ + use Math_ + use MolecularSystem_ + use ParticleManager_ + use Lebedev_ + use Matrix_ + use Vector_ + use String_ + use omp_lib + implicit none + + !> + !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727 + !! + !! @author Felix + !! + !! Creation data : 02-22 + !! + !! History change: + !! + !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co ) + !! -# Creation of the module. + !! + !< + + type, public :: NonOrthogonalCI + logical :: isInstanced + integer :: numberOfDisplacedSystems + integer :: numberOfEnergyRejectedSystems + integer :: numberOfEllipsoidRejectedSystems + integer :: numberOfPPdistanceRejectedSystems + integer :: numberOfNPdistanceRejectedSystems + integer :: numberOfEquivalentSystems + integer :: numberOfTransformedCenters + integer :: numberOfIndividualTransformations + integer :: printMatrixThreshold + integer, allocatable :: rotationCenterList(:,:) + type(Matrix) :: configurationOverlapMatrix, configurationHamiltonianMatrix, configurationCoefficients + type(Matrix), allocatable :: configurationKineticMatrix(:), configurationPuntualMatrix(:), configurationExternalMatrix(:), configurationExchangeMatrix(:) + type(Matrix), allocatable :: configurationHartreeMatrix(:,:), configurationDFTcorrelationMatrix(:,:) + type(Vector) :: configurationCorrelationEnergies, statesEigenvalues + type(IVector), allocatable :: sysBasisList(:,:) + type(Matrix), allocatable :: HFCoefficients(:,:) + type(Matrix), allocatable :: mergedCoefficients(:) + type(Matrix), allocatable :: mergedOverlapMatrix(:) + type(Matrix), allocatable :: mergedDensityMatrix(:,:) + type(MolecularSystem), allocatable :: molecularSystems(:) + type(MolecularSystem) :: mergedMolecularSystem + character(50) :: transformationType + character(15),allocatable :: systemLabels(:) + real(8) :: refEnergy + real(8), allocatable :: exactExchangeFraction(:) + ! integer :: numberOfUniqueSystems !sort of symmetry + ! integer :: numberOfUniquePairs !sort of symmetry + ! type(IVector) :: systemTypes !sort of symmetry + ! type(IMatrix) :: configurationPairTypes !, uniqueOverlapElements, uniqueHamiltonianElements + ! type(MolecularSystem), allocatable :: uniqueMolecularSystems(:) + end type NonOrthogonalCI + + type(NonOrthogonalCI), public :: NOCI_instance + + public :: & + NOCIBuild_constructor,& + NOCIBuild_displaceGeometries,& + NOCIBuild_readGeometries + + private + +contains + + !> + !! @brief Allocates memory and run HF calculations to be used in the construction of the NOCI matrix + !! + !! @param this + !< + subroutine NOCIBuild_constructor(this) + implicit none + type(NonOrthogonalCI) :: this + integer :: numberOfRotationCenters, numberOfTranslationCenters + integer :: p,q,r + + print *, "-------------------------------------------------------------" + print *, "STARTING NON ORTHOGONAL CONFIGURATION INTERACTION CALCULATION" + print *, "-------------------------------------------------------------" + print *, "" + this%isInstanced=.true. + this%numberOfDisplacedSystems=0 + this%numberOfEnergyRejectedSystems=0 + this%numberOfEllipsoidRejectedSystems=0 + this%numberOfPPdistanceRejectedSystems=0 + this%numberOfNPdistanceRejectedSystems=0 + ! this%numberOfUniqueSystems=0 + ! this%numberOfUniquePairs=0 + this%printMatrixThreshold=30 + numberOfTranslationCenters=0 + numberOfRotationCenters=0 + + allocate(this%rotationCenterList(size(MolecularSystem_instance%allParticles),2)) + !For rotations, 0,0: leave alone, N,M: rotation center number to be rotated around point M + this%rotationCenterList=0 + + !!Translation count + do p = 1, size(MolecularSystem_instance%allParticles) + + if(MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter.gt.numberOfTranslationCenters) & + numberOfTranslationCenters=MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter + + if(MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter.ne.0) & + write (*,"(A,A10,A,3F9.5,A)") "Particle ", trim(ParticleManager_getSymbol(p)), & + " basis functions at ", MolecularSystem_instance%allParticles(p)%particlePtr%origin(1:3), & + " are going to be displaced" + end do + + !!Rotation count + do p = 1, size(MolecularSystem_instance%allParticles) + if(MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint.eq.0) cycle + write (*,"(A,A10,A,3F9.5,A,I5)") "Particle ", trim(ParticleManager_getSymbol(p)), & + " located at ", MolecularSystem_instance%allParticles(p)%particlePtr%origin(1:3), & + " is center of rotation number", MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint + + do q = 1, size(MolecularSystem_instance%allParticles) + if(MolecularSystem_instance%allParticles(q)%particlePtr%rotateAround .eq. & + MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint) then + write (*,"(A,A10,A,3F9.5,A,I5)") "Particle ", trim(ParticleManager_getSymbol(q)), & + " basis functions at ", MolecularSystem_instance%allParticles(q)%particlePtr%origin(1:3), & + " are going to be rotated around center ", MolecularSystem_instance%allParticles(q)%particlePtr%rotateAround + + if(q .eq. MolecularSystem_instance%allParticles(q)%particlePtr%owner) then + !in the case of several species with the same center, rotate them as one + numberOfRotationCenters=numberOfRotationCenters+1 + this%rotationCenterList(q,1)=numberOfRotationCenters + !find childs + if ( allocated(MolecularSystem_instance%allParticles(q)%particlePtr%childs) ) then + do r=1,size(MolecularSystem_instance%allParticles(q)%particlePtr%childs) + this%rotationCenterList( MolecularSystem_instance%allParticles(q)%particlePtr%childs(r),1)=numberOfRotationCenters + end do + end if + end if + this%rotationCenterList(q,2)=p + end if + end do + end do + + ! print *, "this%rotationCenterList" + ! do p=1, size(MolecularSystem_instance%allParticles) + ! print *, "Particle ", trim(ParticleManager_getSymbol(p)),this%rotationCenterList(p,1), this%rotationCenterList(p,2) + ! end do + + if(numberOfTranslationCenters.ne.0) then + + this%transformationType="TRANSLATION" + this%numberOfTransformedCenters=numberOfTranslationCenters + this%numberOfIndividualTransformations=& + CONTROL_instance%TRANSLATION_SCAN_GRID(1)*CONTROL_instance%TRANSLATION_SCAN_GRID(2)*CONTROL_instance%TRANSLATION_SCAN_GRID(3)& + +(CONTROL_instance%TRANSLATION_SCAN_GRID(1)-1)*(CONTROL_instance%TRANSLATION_SCAN_GRID(2)-1)*(CONTROL_instance%TRANSLATION_SCAN_GRID(3)-1) + + print *, "" + write (*,"(A,I5,A,I10,A)") "Displacing coordinates of ", numberOfTranslationCenters, " centers", & + this%numberOfIndividualTransformations," times" + print *, "" + + else if(numberOfRotationCenters.ne.0) then + print *, "" + write (*,"(A,I5,A,I5,A,I5,A)") "Rotating coordinates of ", numberOfRotationCenters, " centers", CONTROL_instance%ROTATIONAL_SCAN_GRID, & + " times in ", CONTROL_instance%NESTED_ROTATIONAL_GRIDS, " nested grids" + print *, "" + + this%transformationType="ROTATION" + this%numberOfTransformedCenters=numberOfRotationCenters + this%numberOfIndividualTransformations=CONTROL_instance%ROTATIONAL_SCAN_GRID*CONTROL_instance%NESTED_ROTATIONAL_GRIDS + else if(CONTROL_instance%ROTATION_AROUND_Z_STEP.ne.0) then + print *, "" + write (*,"(A)") "Rotating around the z axis the basis centers of the quantum particles " + + if(CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE .eq. 360 ) then + this%numberOfIndividualTransformations=int(CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE/CONTROL_instance%ROTATION_AROUND_Z_STEP) + else + this%numberOfIndividualTransformations=int(CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE/CONTROL_instance%ROTATION_AROUND_Z_STEP)+1 + end if + + write (*,"(A,I5,A,I5,A)") "From 0 to ", CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE ," degrees in ", this%numberOfIndividualTransformations, " steps" + print *, "" + + this%transformationType="ROTATION_AROUND_Z" + this%numberOfTransformedCenters=1 + else if(CONTROL_instance%READ_NOCI_GEOMETRIES) then + this%transformationType="READ_GEOMETRIES" + write (*,"(A)") "Reading input geometries from "//trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords file" + else + STOP "To perform a NOCI calculation, please provide either instructions for a geometry transformation or a NOCI.coords file" + end if + + ! call Vector_constructorInteger(this%systemTypes,this%numberOfIndividualTransformations**this%numberOfTransformedCenters,0) + + + allocate(this%mergedDensityMatrix(CONTROL_instance%CI_STATES_TO_PRINT,molecularSystem_instance%numberOfQuantumSpecies),& + this%mergedOverlapMatrix(molecularSystem_instance%numberOfQuantumSpecies),& + this%mergedCoefficients(molecularSystem_instance%numberOfQuantumSpecies),& + this%configurationKineticMatrix(molecularSystem_instance%numberOfQuantumSpecies),& + this%configurationPuntualMatrix(molecularSystem_instance%numberOfQuantumSpecies),& + this%configurationExternalMatrix(molecularSystem_instance%numberOfQuantumSpecies),& + this%configurationExchangeMatrix(molecularSystem_instance%numberOfQuantumSpecies),& + this%configurationHartreeMatrix(molecularSystem_instance%numberOfQuantumSpecies,molecularSystem_instance%numberOfQuantumSpecies),& + this%configurationDFTcorrelationMatrix(molecularSystem_instance%numberOfQuantumSpecies,molecularSystem_instance%numberOfQuantumSpecies),& + this%exactExchangeFraction(molecularSystem_instance%numberOfQuantumSpecies)) + + this%exactExchangeFraction(molecularSystem_instance%numberOfQuantumSpecies)=1.0_8 + + end subroutine NOCIBuild_constructor + !> + !! @brief Generates different geometries and runs HF calculations at each + !! + !! @param this + !< + subroutine NOCIBuild_displaceGeometries(this) + implicit none + type(NonOrthogonalCI) :: this + + type(MolecularSystem) :: originalMolecularSystem + type(MolecularSystem) :: displacedMolecularSystem + real(8) :: displacement + character(100) :: coordsFile + integer, allocatable :: transformationCounter(:) + integer :: coordsUnit + integer :: i,j + integer :: closestSystem + logical :: skip + real(8) :: timeA + + !$ timeA = omp_get_wtime() + + call MolecularSystem_copyConstructor(originalMolecularSystem, molecularSystem_instance) + + !!Dynamically allocated through the displacement routine + allocate(this%molecularSystems(0)) + + allocate(transformationCounter(this%numberOfTransformedCenters)) + + transformationCounter(1:this%numberOfTransformedCenters)=1 + transformationCounter(1)=0 + + this%numberOfDisplacedSystems=0 + + coordsUnit=333 + coordsFile=trim(CONTROL_instance%INPUT_FILE)//"trial.coords" + + print *, "generating NOCI displaced geometries and HF wavefunctions... saving coords to ", trim(coordsFile) + + open(unit=coordsUnit, file=trim(coordsFile), status="replace", form="formatted") + +!!!!! clock type iterations to form all the possible combination of modified geometries + do while (.true.) + + !Determine the next movement like a clock iteration + transformationCounter(1)=transformationCounter(1)+1 + do i=1,this%numberOfTransformedCenters-1 + if(transformationCounter(i) .gt. this%numberOfIndividualTransformations) then + j=i+1 + transformationCounter(j)=transformationCounter(j)+1 + transformationCounter(1:i)=1 + end if + end do + + if(transformationCounter(this%numberOfTransformedCenters) .gt. this%numberOfIndividualTransformations) exit + + write (coordsUnit,"(A)",advance="no") "Transformation counter: " + do i=1,this%numberOfTransformedCenters + write (coordsUnit,"(I10)",advance="no") transformationCounter(i) + end do + write (coordsUnit,*) "" + + skip=.false. + !Apply the transformation given by transformationCounter to each center, the result is saved in molecularSystemInstance + call NOCIBuild_transformCoordinates(this,transformationCounter(1:this%numberOfTransformedCenters),originalMolecularSystem,displacedMolecularSystem,skip) + + call MolecularSystem_showCartesianMatrix(displacedMolecularSystem,unit=coordsUnit) + + !Classify the system according to its distance matrix (symmetry) + ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) & + ! call NOCIBuild_classifyNewSystem(this,systemType, newSystemFlag) + + !Check if the new system is not beyond the max displacement + if(skip) then + write (coordsUnit,"(A)") "Skipping system beyond the ellipsoids boundaries" + this%numberOfEllipsoidRejectedSystems=this%numberOfEllipsoidRejectedSystems+1 + cycle + end if + + !Check if the separation between particles of the same charge is not too small + call NOCIBuild_checkSameChargesDistance(displacedMolecularSystem,displacement,skip) + + if(skip) then + write (coordsUnit,"(A,F20.12)") "Skipping system with same charge particle separation", displacement + this%numberOfPPdistanceRejectedSystems=this%numberOfPPdistanceRejectedSystems+1 + cycle + end if + + !Check if the separation between positive and negative particles is not too big + call NOCIBuild_checkOppositeChargesDistance(displacedMolecularSystem,displacement,skip) + + if(skip) then + write (coordsUnit,"(A,F20.12)") "Skipping system with positive and negative particle separation", displacement + this%numberOfNPdistanceRejectedSystems=this%numberOfNPdistanceRejectedSystems+1 + cycle + end if + + !Check if the new system is not to close to previous calculated systems - duplicate protection + call NOCIBuild_checkNewSystemDisplacement(this,displacedMolecularSystem,closestSystem,displacement) + + if(displacement .lt. CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then + write (coordsUnit,"(A,F20.12,A,I10)") "Skipping system with distance ", displacement , "a.u. from system ", closestSystem + skip=.true. + this%numberOfEquivalentSystems=this%numberOfEquivalentSystems+1 + cycle + end if + + !!Copy the molecular system to the NonOrthogonalCI object + ! if(newSystemFlag) then + ! this%numberOfUniqueSystems=this%numberOfUniqueSystems+1 + ! this%systemTypes%values(this%numberOfDisplacedSystems)=this%numberOfUniqueSystems + ! else + ! this%systemTypes%values(this%numberOfDisplacedSystems)=systemType + ! end if + + ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then + ! write (coordsUnit,"(A,I5,A,I10,A,F20.12)") "Saving system of type ", this%systemTypes%values(this%numberOfDisplacedSystems) , & + ! " with ID ", this%numberOfDisplacedSystems, " and energy", testEnergy + ! else< + if(skip .eqv. .false.) then + call NOCIBuild_saveSystem(this,displacedMolecularSystem) + write (coordsUnit,"(A,I10)") "Saving system with ID ", this%numberOfDisplacedSystems + end if + end do + + close(coordsUnit) + + print *, "" + write (*,'(A10,I10,A)') "Mixing ", this%numberOfDisplacedSystems, " HF calculations at different geometries" + + if(this%numberOfEllipsoidRejectedSystems .gt. 0) & + write (*,'(A10,I10,A)') "Rejected ", this%numberOfEllipsoidRejectedSystems, & + " geometries outside the ellipsoids area" + + if(this%numberOfPPdistanceRejectedSystems .gt. 0) & + write (*,'(A10,I10,A,ES18.8,A,ES18.8)') "Rejected ", this%numberOfPPdistanceRejectedSystems, & + " geometries with separation between same charge basis sets smaller than", CONTROL_instance%CONFIGURATION_MIN_PP_DISTANCE, & + " or larger than", CONTROL_instance%CONFIGURATION_MAX_PP_DISTANCE + + if(this%numberOfNPdistanceRejectedSystems .gt. 0) & + write (*,'(A10,I10,A,ES18.8)') "Rejected ", this%numberOfNPdistanceRejectedSystems, & + " geometries with separation between positive and negative basis sets larger than", CONTROL_instance%CONFIGURATION_MAX_NP_DISTANCE + + if(this%numberOfEquivalentSystems .gt. 0) & + write (*,'(A10,I10,A)') "Rejected ", this%numberOfEquivalentSystems, & + " duplicated geometries after permutations" + + print *, "" + + ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) & + ! call Matrix_constructorInteger(this%configurationPairTypes,int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0) + ! minEnergy=0.0 + +!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time displacing coordinates : ", omp_get_wtime() - timeA ," (s)" + print *, "" + + end subroutine NOCIBuild_displaceGeometries + + !> + !! @brief Read different geometries + !! + !! @param this + !< + subroutine NOCIBuild_readGeometries(this) + implicit none + type(NonOrthogonalCI) :: this + + type(MolecularSystem) :: originalMolecularSystem + real(8) :: origin(3) + character(100) :: string,coordsFile + integer :: coordsUnit + integer :: sysI,i,ii,j,mu + real(8) :: timeA + logical :: readSuccess + + !$ timeA = omp_get_wtime() + + call MolecularSystem_copyConstructor(originalMolecularSystem, molecularSystem_instance) + + coordsUnit=333 + coordsFile=trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords" + readSuccess=.false. + + inquire(FILE = coordsFile, EXIST = readSuccess ) + if(.not. readSuccess) then + print *, "Didn't find the file ", trim(coordsFile) + STOP "Please provide one or turn the readNOCIGeometries flag off!" + end if + + open(unit=coordsUnit, file=trim(coordsFile), status="old", form="formatted") + + read(coordsUnit,*) string, this%numberOfDisplacedSystems + print *, "reading ", this%numberOfDisplacedSystems, " systems" + + allocate(this%molecularSystems(this%numberOfDisplacedSystems)) + + do sysI = 1, this%numberOfDisplacedSystems + call MolecularSystem_copyConstructor(molecularSystem_instance, originalMolecularSystem) + write(molecularSystem_instance%description,"(I10)") sysI + read(coordsUnit,*) string !skip line + read(coordsUnit,*) string !skip line + + !! Print quatum species information + do i = 1, molecularSystem_instance%numberOfQuantumSpecies + + !! Copy origins in open-shell case + if(trim(molecularSystem_instance%species(i)%name) .eq. "E-BETA" ) then + do ii = 1, i-1 + if(trim(molecularSystem_instance%species(ii)%name) .ne. "E-ALPHA" ) cycle + do j = 1, size(molecularSystem_instance%species(i)%particles) + molecularSystem_instance%species(i)%particles(j)%origin = & + molecularSystem_instance%species(ii)%particles(j)%origin + do mu = 1, molecularSystem_instance%species(i)%particles(j)%basis%length + molecularSystem_instance%species(i)%particles(j)%basis%contraction(mu)%origin = & + molecularSystem_instance%species(i)%particles(j)%origin + end do + end do + end do + cycle !skip the rest of the read + end if + + do j = 1, size(molecularSystem_instance%species(i)%particles) + read(coordsUnit,*) string, origin(1), origin(2), origin(3) + + molecularSystem_instance%species(i)%particles(j)%origin = origin/AMSTRONG + do mu = 1, molecularSystem_instance%species(i)%particles(j)%basis%length + molecularSystem_instance%species(i)%particles(j)%basis%contraction(mu)%origin = & + molecularSystem_instance%species(i)%particles(j)%origin + end do + end do + end do + + !! Point charges information + do i = 1, molecularSystem_instance%numberOfPointCharges + read(coordsUnit,*) string, origin(1), origin(2), origin(3) + + molecularSystem_instance%pointCharges(i)%origin = origin/AMSTRONG + end do + call MolecularSystem_copyConstructor(this%molecularSystems(sysI), molecularSystem_instance) + + end do + + close(unit=coordsUnit) + + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time reading coordinates : ", omp_get_wtime() - timeA ," (s)" + end subroutine NOCIBuild_readGeometries + + + !> + !! @brief Apply the transformation (translation or rotation) given by transformationCounter to each center, based in the originalMolecularSystemPositions the result is saved in molecularSystemInstance + !! @param this,transformationCounter,originalMolecularSystem + !< + subroutine NOCIBuild_transformCoordinates(this,transformationCounter,originalMolecularSystem,displacedMolecularSystem,skip) + type(NonOrthogonalCI) :: this + integer :: transformationCounter(*) + type(MolecularSystem) :: originalMolecularSystem + type(MolecularSystem), target :: displacedMolecularSystem + logical, intent(out) :: skip + + real(8) :: centerX, centerY, centerZ, displacedOrigin(3), distanceCheck, distanceToCenter, angle, maxAngle + integer :: center, displacementId + real(8),allocatable :: X(:), Y(:), Z(:), W(:) + integer :: i,j,k,p,q,s,mu, nsteps + character(200) :: description + + skip=.false. + + call MolecularSystem_copyConstructor(displacedMolecularSystem, originalMolecularSystem) + + write(displacedMolecularSystem%description, '(I10)') transformationCounter(1) + do i=2,this%numberOfTransformedCenters + write(description, '(A)') adjustl(adjustr(displacedMolecularSystem%description)//"-"//adjustl(String_convertIntegerToString(transformationCounter(i)))) + displacedMolecularSystem%description=trim(description) + end do + + particleManager_instance => displacedMolecularSystem%allParticles + + if(trim(this%transformationType).eq."TRANSLATION") then + + do center=1, this%numberOfTransformedCenters + do p=1, size(originalMolecularSystem%allParticles) + if(center.eq.originalMolecularSystem%allParticles(p)%particlePtr%translationCenter) then + centerX=originalMolecularSystem%allParticles(p)%particlePtr%origin(1) + centerY=originalMolecularSystem%allParticles(p)%particlePtr%origin(2) + centerZ=originalMolecularSystem%allParticles(p)%particlePtr%origin(3) + end if + end do + + !!These loops update the molecular system file for each displaced geometry + !!ADD DIFFERENT AXIS DISPLACEMENTS! + displacementId=0 + !Body centered cube + do i=1,CONTROL_instance%TRANSLATION_SCAN_GRID(1)*2-1 + do j=1,CONTROL_instance%TRANSLATION_SCAN_GRID(2)*2-1 + do k=1,CONTROL_instance%TRANSLATION_SCAN_GRID(3)*2-1 + + if( (mod(i,2) .eq. mod(j,2)) .and. (mod(i,2) .eq. mod(k,2)) ) then + displacementId=displacementId+1 + + if(displacementId .eq. transformationCounter(center) ) then + + distanceCheck= & + (CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0))**2/& + CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(1)**2+& + (CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0))**2/& + CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(2)**2+& + (CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0))**2/& + CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(3)**2 + + if(distanceCheck .gt. 1.0) then + skip=.true. + ! return + end if + + distanceCheck= & + (CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0))**2/& + CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(1)**2+& + (CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0))**2/& + CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(2)**2+& + (CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0))**2/& + CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(3)**2 + + if(distanceCheck .lt. 1.0) then + skip=.true. + ! return + end if + + displacedOrigin(1)=centerX+CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0) + displacedOrigin(2)=centerY+CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0) + displacedOrigin(3)=centerZ+CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0) + + do p=1, size(displacedMolecularSystem%allParticles) + if(center.eq.displacedMolecularSystem%allParticles(p)%particlePtr%translationCenter) then + ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin ) + displacedMolecularSystem%allParticles(p)%particlePtr%origin=displacedOrigin + do mu = 1, displacedMolecularSystem%allParticles(p)%particlePtr%basis%length + displacedMolecularSystem%allParticles(p)%particlePtr%basis%contraction(mu)%origin = displacedOrigin + end do + end if + end do + + ! write(*, '(3I5,F4.1,A,F4.1,A,F4.1)') i,j,k, & + ! (i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0," ", & + ! (j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0," ", & + ! (k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0 + end if + end if + end do + end do + end do + + end do + + else if(trim(this%transformationType).eq."ROTATION") then + + allocate(X(CONTROL_instance%ROTATIONAL_SCAN_GRID),& + Y(CONTROL_instance%ROTATIONAL_SCAN_GRID),& + Z(CONTROL_instance%ROTATIONAL_SCAN_GRID),& + W(CONTROL_instance%ROTATIONAL_SCAN_GRID)) + + call Lebedev_angularGrid(X(:),Y(:),Z(:),W(:),CONTROL_instance%ROTATIONAL_SCAN_GRID) + + do center=1, this%numberOfTransformedCenters + displacementId=0 + + do i=1,CONTROL_instance%ROTATIONAL_SCAN_GRID + do j=1,CONTROL_instance%NESTED_ROTATIONAL_GRIDS + displacementId=displacementId+1 + if(displacementId .eq. transformationCounter(center) ) then + do p=1, size(displacedMolecularSystem%allParticles) + if(this%rotationCenterList(p,1).eq. center ) then + + do q=1, size(originalMolecularSystem%allParticles) + if(this%rotationCenterList(q,1) .eq. center ) then + centerX=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(1) + centerY=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(2) + centerZ=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(3) + end if + end do + + distanceToCenter=sqrt((originalMolecularSystem%allParticles(p)%particlePtr%origin(1)-centerX)**2 & + +(originalMolecularSystem%allParticles(p)%particlePtr%origin(2)-centerY)**2 & + +(originalMolecularSystem%allParticles(p)%particlePtr%origin(3)-centerZ)**2) + + distanceToCenter=distanceToCenter+& + CONTROL_instance%NESTED_GRIDS_DISPLACEMENT*(j-(CONTROL_instance%NESTED_ROTATIONAL_GRIDS+1)/2.0) + + displacedOrigin(1)=centerX+X(i)*distanceToCenter + displacedOrigin(2)=centerY+Y(i)*distanceToCenter + displacedOrigin(3)=centerZ+Z(i)*distanceToCenter + + ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin ) + displacedMolecularSystem%allParticles(p)%particlePtr%origin=displacedOrigin + do mu = 1, displacedMolecularSystem%allParticles(p)%particlePtr%basis%length + displacedMolecularSystem%allParticles(p)%particlePtr%basis%contraction(mu)%origin = displacedOrigin + end do + end if + end do + end if + end do + end do + end do + else if(trim(this%transformationType).eq."ROTATION_AROUND_Z") then + + do center=1, this%numberOfTransformedCenters + displacementId=0 + + maxAngle=CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE + nsteps=this%numberOfIndividualTransformations + + do i=1, nsteps + ! do j=1,CONTROL_instance%NESTED_ROTATIONAL_GRIDS + displacementId=displacementId+1 + if(displacementId .eq. transformationCounter(center) ) then + angle=(i-1)*CONTROL_instance%ROTATION_AROUND_Z_STEP*Math_PI/180 + do s = 1, originalMolecularSystem%numberOfQuantumSpecies + do p = 1, size(originalMolecularSystem%species(s)%particles) + + centerX=originalMolecularSystem%species(s)%particles(p)%origin(1) + centerY=originalMolecularSystem%species(s)%particles(p)%origin(2) + centerZ=originalMolecularSystem%species(s)%particles(p)%origin(3) + + ! distanceToCenter=sqrt((originalMolecularSystem%allParticles(p)%particlePtr%origin(1)-centerX)**2 & + ! +(originalMolecularSystem%allParticles(p)%particlePtr%origin(2)-centerY)**2) + + displacedOrigin(1)=centerX*cos(angle) - centerY*sin(angle) + displacedOrigin(2)=centerX*sin(angle) + centerY*cos(angle) + displacedOrigin(3)=centerZ + + ! distanceToCenter=distanceToCenter+& + ! CONTROL_instance%NESTED_GRIDS_DISPLACEMENT*(j-(CONTROL_instance%NESTED_ROTATIONAL_GRIDS+1)/2.0) + + ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin ) + displacedMolecularSystem%species(s)%particles(p)%origin=displacedOrigin + do mu = 1, displacedMolecularSystem%species(s)%particles(p)%basis%length + displacedMolecularSystem%species(s)%particles(p)%basis%contraction(mu)%origin = displacedOrigin + end do + end do + end do + end if + ! end do + end do + end do + end if + + end subroutine NOCIBuild_transformCoordinates + + !> + !! @brief Computes the distance between the particles of latest generated molecular system with all the previous saved ones + !! + !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles + !< + subroutine NOCIBuild_checkNewSystemDisplacement(this,newMolecularSystem,closestSystem,displacement) + implicit none + type(NonOrthogonalCI) :: this + type(MolecularSystem) :: newMolecularSystem + integer :: closestSystem + real(8) :: displacement + + integer :: sysI, i + type(Vector), allocatable :: displacementVector(:) + real(8) :: dispSum + + displacement=1.0E8 + + allocate(displacementVector(newMolecularSystem%numberOfQuantumSpecies)) + + do sysI=1, this%numberOfDisplacedSystems + + call MolecularSystem_GetTwoSystemsDisplacement(this%molecularSystems(sysI), newMolecularSystem, displacementVector) + + dispSum=0.0 + do i=1, newMolecularSystem%numberOfQuantumSpecies + dispSum=dispSum+sum(displacementVector(i)%values(:)) + end do + if(dispSum .lt. displacement ) then + displacement=dispSum + closestSystem=sysI + if(displacement .lt. CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) exit + end if + end do + + deallocate(displacementVector) + + end subroutine NOCIBuild_checkNewSystemDisplacement + + + !> + !! @brief Finds the maximum of the distances between the basis set center of a particle to its closest neighbour with opposite charge + !! + !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles + !< + subroutine NOCIBuild_checkOppositeChargesDistance(molSys,minNPDistance,skip) + implicit none + type(MolecularSystem) :: molSys + real(8) :: minNPDistance + logical :: skip + + integer :: p,q + real(8) :: npDistance + + + minNPDistance=1E8 + do p=1, size(molSys%allParticles)-1 + if(.not.(molSys%allParticles(p)%particlePtr%translationCenter .ne. 0 .or. & + molSys%allParticles(p)%particlePtr%rotateAround .ne. 0)) cycle + do q=p+1, size(molSys%allParticles) + if(.not.(molSys%allParticles(q)%particlePtr%translationCenter .ne. 0 .or. & + molSys%allParticles(q)%particlePtr%rotateAround .ne. 0)) cycle + if( molSys%allParticles(p)%particlePtr%charge*molSys%allParticles(q)%particlePtr%charge .gt. 0.0 ) cycle + npDistance=sqrt(& + (molSys%allParticles(p)%particlePtr%origin(1)-molSys%allParticles(q)%particlePtr%origin(1))**2+& + (molSys%allParticles(p)%particlePtr%origin(2)-molSys%allParticles(q)%particlePtr%origin(2))**2+& + (molSys%allParticles(p)%particlePtr%origin(3)-molSys%allParticles(q)%particlePtr%origin(3))**2) + if(npDistance .lt. minNPDistance) minNPDistance=npDistance + end do + end do + + if(minNPDistance .gt. CONTROL_instance%CONFIGURATION_MAX_NP_DISTANCE) skip=.true. + + end subroutine NOCIBuild_checkOppositeChargesDistance + + !> + !! @brief Finds the maximum of the distances between the basis set center of a particle to its closest neighbour with the same charge + !! + !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles + !< + subroutine NOCIBuild_checkSameChargesDistance(molSys,distance,skip) + implicit none + type(MolecularSystem) :: molSys + real(8) :: distance + logical :: skip + + real(8) :: minPPDistance + + integer :: p,q + real(8) :: ppDistance + + + minPPDistance=1.0E8 + do p=1, size(molSys%allParticles)-1 + if(.not.(molSys%allParticles(p)%particlePtr%translationCenter .ne. 0 .or. & + molSys%allParticles(p)%particlePtr%rotateAround .ne. 0)) cycle + do q=p+1, size(molSys%allParticles) + if(.not.(molSys%allParticles(q)%particlePtr%translationCenter .ne. 0 .or. & + molSys%allParticles(q)%particlePtr%rotateAround .ne. 0)) cycle + if( molSys%allParticles(p)%particlePtr%charge*molSys%allParticles(q)%particlePtr%charge .lt. 0.0 ) cycle + + ppDistance=sqrt(& + (molSys%allParticles(p)%particlePtr%origin(1)-molSys%allParticles(q)%particlePtr%origin(1))**2+& + (molSys%allParticles(p)%particlePtr%origin(2)-molSys%allParticles(q)%particlePtr%origin(2))**2+& + (molSys%allParticles(p)%particlePtr%origin(3)-molSys%allParticles(q)%particlePtr%origin(3))**2) + if(ppDistance .lt. minPPDistance) minPPDistance=ppDistance + + end do + end do + + if(minPPDistance .gt. CONTROL_instance%CONFIGURATION_MAX_PP_DISTANCE) skip=.true. + if(minPPDistance .lt. CONTROL_instance%CONFIGURATION_MIN_PP_DISTANCE) skip=.true. + + end subroutine NOCIBuild_checkSameChargesDistance + + !> + !! @brief Classify the new system by comparing its distance matrix to previosly saved systems + !! + !! @param this, systemType: integer defining system equivalence type, newSystemFlag: returns if the system is new or not + !< + ! subroutine NOCIBuild_classifyNewSystem(this, systemType, newSystemFlag) + ! implicit none + ! type(NonOrthogonalCI) :: this + ! integer :: systemType + ! logical :: newSystemFlag + + ! type(MolecularSystem) :: currentMolecularSystem + ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix + + ! integer :: sysI, i, checkingType + ! logical :: match + + ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance) + ! systemType=0 + ! newSystemFlag=.true. + ! currentDistanceMatrix=ParticleManager_getDistanceMatrix() + + ! ! print *, "Current distance matrix" + ! ! call Matrix_show(currentDistanceMatrix) + + ! types: do checkingType=1, this%numberOfUniqueSystems + ! ! print *, "checkingType", checkingType + ! systems: do sysI=1, this%numberOfDisplacedSystems + + ! if(this%systemTypes%values(sysI) .eq. checkingType) then + ! call MolecularSystem_copyConstructor(molecularSystem_instance, this%molecularSystems(sysI)) + + ! previousDistanceMatrix=ParticleManager_getDistanceMatrix() + + ! ! print *, "Comparing with previous distance matrix", checkingType + ! ! call Matrix_show(previousDistanceMatrix) + + ! match=.true. + ! do i=1, size(currentDistanceMatrix%values(:,1)) + ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. & + ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then + ! match=.false. + ! exit + ! end if + ! end do + + ! ! print *, "match?", match + + ! if(match) then + ! systemType=this%systemTypes%values(sysI) + ! newSystemFlag=.false. + ! exit types + ! else + ! cycle types + ! end if + ! end if + ! end do systems + ! end do types + + ! ! print *, "newSystemFlag", newSystemFlag + + ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem) + + ! end subroutine NOCIBuild_classifyNewSystem + + + ! > + ! @brief Saves molecular system and wfn files for a displaced system + + ! @param systemID + ! < + subroutine NOCIBuild_saveSystem(this, newSystem) + implicit none + type(NonOrthogonalCI) :: this + type(MolecularSystem) :: newSystem + + type(MolecularSystem), allocatable :: tempMolecularSystems(:) + integer :: i + + !!Increase the size of the molecular systems array by 1 + this%numberOfDisplacedSystems=this%numberOfDisplacedSystems+1 + + allocate(tempMolecularSystems(size(this%MolecularSystems))) + + do i=1, size(this%MolecularSystems) + call MolecularSystem_copyConstructor(tempMolecularSystems(i),this%MolecularSystems(i)) + end do + + deallocate(this%MolecularSystems) + allocate(this%MolecularSystems(this%numberOfDisplacedSystems)) + + do i=1, size(tempMolecularSystems) + call MolecularSystem_copyConstructor(this%MolecularSystems(i),tempMolecularSystems(i)) + end do + + deallocate(tempMolecularSystems) + !!Copy the molecular system to the NonOrthogonalCI object + + call MolecularSystem_copyConstructor(this%MolecularSystems(this%numberOfDisplacedSystems), newSystem) + + end subroutine NOCIBuild_saveSystem + + !> + !! @brief Classify the sysI and sysII pair according to their distance matrix + !! + !! @param sysI and sysII: molecular system indices. + !< + ! subroutine NOCIBuild_classifyConfigurationPair(this,currentSysI,currentSysII,newPairFlag) + ! implicit none + ! type(NonOrthogonalCI) :: this + ! integer :: currentSysI, currentSysII !Indices of the systems to classify + ! logical :: newPairFlag + + ! type(MolecularSystem) :: currentMolecularSystem + ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix + + ! integer :: sysI, sysII, i, checkingType + ! logical :: match + + ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance) + ! newPairFlag=.true. + ! currentDistanceMatrix=ParticleManager_getDistanceMatrix() + + ! ! print *, "Current distance matrix" + ! ! call Matrix_show(currentDistanceMatrix) + + ! types: do checkingType=1, this%numberOfUniquePairs + ! ! print *, "checkingType", checkingType + ! systemI: do sysI=1, currentSysI + ! systemII: do sysII=sysI+1, currentSysII + + ! if(sysI .eq. currentSysI .and. sysII .eq. currentSysII ) cycle types + + ! if((this%configurationPairTypes%values(sysI,sysII) .eq. checkingType) .and. & + ! (this%systemTypes%values(sysI) .eq. this%systemTypes%values(currentSysI)) .and. & + ! (this%systemTypes%values(sysII) .eq. this%systemTypes%values(currentSysII))) then + + ! ! call MolecularSystem_mergeTwoSystems(molecularSystem_instance, this%MolecularSystems(sysI), this%MolecularSystems(sysII)) + + ! previousDistanceMatrix=ParticleManager_getDistanceMatrix() + + ! ! print *, "Comparing with previous distance matrix", checkingType + ! ! call Matrix_show(previousDistanceMatrix) + + ! match=.true. + ! do i=1, size(currentDistanceMatrix%values(:,1)) + ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. & + ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then + ! match=.false. + ! exit + ! end if + ! end do + + ! if(match) then + ! newPairFlag=.false. + ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%configurationPairTypes%values(sysI,sysII) + ! exit types + ! else + ! cycle types + ! end if + ! end if + ! end do systemII + ! end do systemI + ! end do types + + ! if(newPairFlag) then + ! this%numberOfUniquePairs=this%numberOfUniquePairs+1 + ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%numberOfUniquePairs + ! end if + + ! if(this%configurationPairTypes%values(currentSysI,currentSysII).eq.0) then + ! print *, "newPairFlag", newPairFlag + ! print *, currentSysI, currentSysII, this%configurationPairTypes%values(currentSysI,currentSysII) + ! STOP "I found a type zero" + ! end if + ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem) + + ! end subroutine NOCIBuild_classifyConfigurationPair + +end module NOCIBuild_ + diff --git a/src/NOCI/NOCIFranckCondon.f90 b/src/NOCI/NOCIFranckCondon.f90 new file mode 100644 index 00000000..a0a923d7 --- /dev/null +++ b/src/NOCI/NOCIFranckCondon.f90 @@ -0,0 +1,503 @@ +!****************************************************************************** +!! This code is part of LOWDIN Quantum chemistry package +!! +!! this program has been developed under direction of: +!! +!! UNIVERSIDAD NACIONAL DE COLOMBIA" +!! PROF. ANDRES REYES GROUP" +!! http://www.qcc.unal.edu.co" +!! +!! UNIVERSIDAD DE GUADALAJARA" +!! PROF. ROBERTO FLORES GROUP" +!! http://www.cucei.udg.mx/~robertof" +!! +!! AUTHORS +!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA +!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! CONTRIBUTORS +!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA +!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO +!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! +!! Todos los derechos reservados, 2011 +!! +!!****************************************************************************** + +module NOCIFranckCondon_ + use NOCIBuild_ + use NOCIMatrices_ + use MolecularSystem_ + use Matrix_ + use Vector_ + use DirectIntegralManager_ + use omp_lib + implicit none + + !> + !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727 + !! + !! @author Felix + !! + !! Creation data : 02-22 + !! + !! History change: + !! + !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co ) + !! -# Creation of the module. + !! + !< + + public :: & + NOCIFranckCondon_computeFranckCondon + + private + +contains + + !> + !! @brief Compute Franck-Condon factors from the current NOCI calculations and previous results read from file + !! + !! @param + !< + subroutine NOCIFranckCondon_computeFranckCondon(this) + type(NonOrthogonalCI) :: this + integer :: nociUnit, numberOfSpecies, occupationNumber,numberOfDisplacedSystems, numberOfContractions, dim2 + character(100) :: nociFile + type(Matrix) :: ciCoefficients + type(Vector) :: ciEnergies + type(Matrix), allocatable :: auxCoefficients(:), superMergedCoefficients(:) + type(IVector), allocatable :: sysListCur(:,:), sysListRef(:,:), orbListI(:), orbListII(:) + type(IVector) :: auxIVector + type(MolecularSystem) :: superMergedMolecularSystem + logical :: existFile + type(Matrix) :: molecularOverlapMatrix + type(Matrix), allocatable :: superOverlapMatrix(:), superMomentMatrix(:,:), inverseOverlapMatrix(:), molecularMomentMatrix(:,:) !,attractionMatrix(:), externalPotMatrix(:) + integer :: stateI, stateII + integer :: i,ii,j,jj,k,mu,nu,mumu,nunu,sysI, sysII, speciesID, otherSpeciesID + integer :: particlesPerOrbital + real(8) :: overlapDeterminant, trololo, trolololo(3), pointchargesdipole(3) + + integer :: densUnit + character(100) :: densFile + character(50) :: arguments(2), auxString + type(Matrix), allocatable :: franckCondonMatrix(:), transitionDipoleMatrix(:,:), refCurOverlapMatrix(:), refCurMomentMatrix(:,:) + type(Matrix) :: refCurTotalOverlap + real(8) :: timeA + + !$ timeA = omp_get_wtime() + + existFile=.false. + + nociFile = trim(CONTROL_instance%INPUT_FILE)//"refNOCI" + inquire( FILE = trim(nociFile)//".sys", EXIST = existFile ) + + if(.not. existFile) return + print *, "Found a reference molecular system for NOCI calculations ", trim(nociFile)//".sys" + + pointchargesdipole=0.0 + do i=1, size( MolecularSystem_instance%pointCharges ) + pointchargesdipole = pointchargesdipole + MolecularSystem_instance%pointCharges(i)%origin(:) * MolecularSystem_instance%pointCharges(i)%charge + end do + + + call MolecularSystem_loadFromFile("LOWDIN.SYS",nociFile) + call MolecularSystem_showInformation() + call MolecularSystem_showParticlesInformation() + call MolecularSystem_showCartesianMatrix() + + nociFile = trim(CONTROL_instance%INPUT_FILE)//"refNOCI.states" + inquire( FILE = trim(nociFile), EXIST = existFile ) + + if(.not. existFile) then + print *, "Did not find reference states for NOCI calculations ", nociFile + return + end if + print *, "Found reference states for NOCI calculations ", nociFile + print *, "Computing the Franck-Condon factors with respect to that system" + + nociUnit=123 + open(unit = nociUnit, file=trim(nociFile), status="old", form="unformatted") + + arguments(1) = "NOCI-NUMBEROFSPECIES" + call Vector_getFromFileInteger(1,unit=nociUnit, binary=.true., value=numberOfSpecies, arguments=arguments(1:1) ) + + arguments(1) = "NOCI-NUMBEROFDISPLACEDSYSTEMS" + call Vector_getFromFileInteger(1,unit=nociUnit, binary=.true., value=numberOfDisplacedSystems, arguments=arguments(1:1) ) + + allocate(auxCoefficients(numberOfSpecies)) + allocate(sysListCur(numberOfDisplacedSystems,numberOfSpecies),sysListRef(numberOfDisplacedSystems,numberOfSpecies)) + allocate(orbListI(numberOfDisplacedSystems),orbListII(numberOfDisplacedSystems)) + allocate(superMergedCoefficients(numberOfSpecies)) + allocate(superOverlapMatrix(numberOfSpecies), superMomentMatrix(numberOfSpecies,3),inverseOverlapMatrix(numberOfSpecies),molecularMomentMatrix(numberOfSpecies,3)) + allocate(franckCondonMatrix(numberOfSpecies),transitionDipoleMatrix(numberOfSpecies+1,3),refCurOverlapMatrix(numberOfSpecies),refCurMomentMatrix(numberOfSpecies,3)) + + arguments(1) = "NOCI-CONFIGURATIONCOEFFICIENTS" + ciCoefficients = Matrix_getFromFile(numberOfDisplacedSystems,numberOfDisplacedSystems,nociUnit,binary=.true.,arguments=arguments(1:1) ) + + arguments(1:1) = "NOCI-CONFIGURATIONENERGIES" + call Vector_getFromFile(numberOfDisplacedSystems, nociUnit, output=ciEnergies, binary=.true., arguments=arguments(1:1) ) + + arguments(1) = "MERGEDCOEFFICIENTS" + do speciesID=1, numberOfSpecies + numberOfContractions=molecularSystem_getTotalNumberOfContractions(speciesID) + dim2=max(MolecularSystem_getTotalNumberOfContractions(speciesID),MolecularSystem_getOcupationNumber(speciesID)) + arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) + auxCoefficients(speciesID) = Matrix_getFromFile(numberOfContractions,dim2,nociUnit,binary=.true.,arguments=arguments(1:2) ) + end do + + do sysI=1, numberOfDisplacedSystems + do speciesID=1, numberOfSpecies + numberOfContractions=molecularSystem_getTotalNumberOfContractions(speciesID) + write(auxString,*) sysI + arguments(1) = "SYSBASISLIST"//trim(auxString) + arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) + call Vector_getFromFileInteger(numberOfContractions, nociUnit, output=sysListRef(sysI,speciesID), binary=.true., arguments=arguments(1:2) ) + end do + end do + + close(nociUnit) + + !Create a super-mega molecular system + !Merge coefficients from NOCI calculation and reference system + + print *, "super-mega molecular system" + call MolecularSystem_mergeTwoSystems(superMergedMolecularSystem, this%mergedMolecularSystem, MolecularSystem_instance, & + orbListI(:),orbListII(:), reorder=.false.) + call MolecularSystem_showInformation(superMergedMolecularSystem) + call MolecularSystem_showParticlesInformation(superMergedMolecularSystem) + call MolecularSystem_showCartesianMatrix(superMergedMolecularSystem) + + call NOCIMatrices_mergeCoefficients(this%mergedCoefficients(:),auxCoefficients(:),& + this%mergedMolecularSystem,MolecularSystem_instance,superMergedMolecularSystem,& + orbListI(:),orbListII(:),superMergedCoefficients(:)) + + ! do speciesID=1, numberOfSpecies + ! print *, "superMergedCoefficients", speciesID + ! call Matrix_show(superMergedCoefficients(speciesID)) + ! end do + + !Fix basis list size + do speciesID=1, numberOfSpecies + ! print *, "orbListI", "speciesID", speciesID + ! call Vector_showInteger(orbListI(speciesID)) + do sysI=1, this%numberOfDisplacedSystems + call Vector_copyConstructorInteger(auxIVector,this%sysBasisList(sysI,speciesID)) + call Vector_constructorInteger(sysListCur(sysI,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem), 0) + do i=1, size(auxIVector%values) + if(orbListI(speciesID)%values(i) .eq. 0) cycle + sysListCur(sysI,speciesID)%values(i)=auxIVector%values(orbListI(speciesID)%values(i)) + end do + ! print *, "sysListCur", "sysI", sysI, "speciesID", speciesID + ! call Vector_showInteger(sysListCur(sysI,speciesID)) + end do + end do + + do speciesID=1, numberOfSpecies + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1)) !not using the merged molecular systems + ! print *, "orbListII", "speciesID", speciesID + ! call Vector_showInteger(orbListII(speciesID)) + do sysII=1, numberOfDisplacedSystems + call Vector_copyConstructorInteger(auxIVector,sysListRef(sysII,speciesID)) + call Vector_constructorInteger(sysListRef(sysII,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem), 0) + do i=1, size(orbListII(speciesID)%values) + if(orbListII(speciesID)%values(i) .eq. 0) cycle + sysListRef(sysII,speciesID)%values(i)=auxIVector%values(orbListII(speciesID)%values(i)) + end do + ! print *, "sysListRef", "sysII", sysII, "speciesID", speciesID + ! call Vector_showInteger(sysListRef(sysII,speciesID)) + end do + end do + + ! if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return + + ! numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies + + + print *, "" + print *, "Computing overlap and moment integrals for the super-mega system..." + print *, "" + do speciesID = 1, numberOfSpecies + call DirectIntegralManager_getOverlapIntegrals(superMergedMolecularSystem,speciesID,superOverlapMatrix(speciesID)) + call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,1,superMomentMatrix(speciesID,1)) + call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,2,superMomentMatrix(speciesID,2)) + call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,3,superMomentMatrix(speciesID,3)) + end do + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for supermolecular 1-body integrals : ", omp_get_wtime() - timeA ," (s)" + !$ timeA = omp_get_wtime() + + print *, "" + print *, "Self overlap matrices for the supermegaposed systems..." + print *, "" + + do speciesID=1, numberOfSpecies + call Matrix_constructor(refCurOverlapMatrix(speciesID), int(this%numberOfDisplacedSystems,8), & + int(numberOfDisplacedSystems,8), 1.0_8) + end do + !!Fill the merged density matrix + !!"Non Diagonal" terms - system pairs + do sysI=1, numberOfDisplacedSystems !computed + do sysII=1, numberOfDisplacedSystems !reference + ! if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle + !!Compute molecular overlap matrix and its inverse + do speciesID=1, numberOfSpecies + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems + particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) + call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) + ! call Matrix_constructor(inverseOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) + + do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysI + if(sysListRef(sysI,speciesID)%values(mu) .eq. 0) cycle + do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysII + if(sysListRef(sysII,speciesID)%values(nu) .eq. 0) cycle + do i = 1 , occupationNumber + ii=occupationNumber*(sysI-1)+i+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2 + do j = 1 , occupationNumber + jj=occupationNumber*(sysII-1)+j+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2 + ! print *, "i, j, mu, nu, coefI, coefII, overlap", i,j,mu,nu,superMergedCoefficients(speciesID)%values(mu,ii),& + ! superMergedCoefficients(speciesID)%values(nu,jj),& + ! superOverlapMatrix(speciesID)%values(mu,nu) + molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+& + superMergedCoefficients(speciesID)%values(mu,ii)*& + superMergedCoefficients(speciesID)%values(nu,jj)*& + superOverlapMatrix(speciesID)%values(mu,nu) + end do + end do + end do + end do + if(occupationNumber .ne. 0) then + ! inverseOverlapMatrix=Matrix_inverse(molecularOverlapMatrix) + ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII + ! call Matrix_show(inverseOverlapMatrices(speciesID)) + call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant,method="LU") + ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant + else + overlapDeterminant=1.0 + end if + refCurOverlapMatrix(speciesID)%values(sysI,sysII)=refCurOverlapMatrix(speciesID)%values(sysI,sysII)*overlapDeterminant**particlesPerOrbital + end do + + end do + end do + + do speciesID=1, numberOfSpecies + print *, "Reference Overlap Matrix for", speciesID + call Matrix_show(refCurOverlapMatrix(speciesID)) + end do + + print *, "" + print *, "Building Franck-Condon matrices for the superposed systems..." + print *, "" + + do speciesID=1, numberOfSpecies + call Matrix_constructor(refCurOverlapMatrix(speciesID), int(this%numberOfDisplacedSystems,8), & + int(numberOfDisplacedSystems,8), 1.0_8) + do k=1,3 + call Matrix_constructor(refCurMomentMatrix(speciesID,k), int(this%numberOfDisplacedSystems,8), & + int(numberOfDisplacedSystems,8), 0.0_8) + end do + end do + call Matrix_constructor(refCurTotalOverlap, int(this%numberOfDisplacedSystems,8), & + int(numberOfDisplacedSystems,8), 1.0_8) + + !!Fill the merged density matrix + !!"Non Diagonal" terms - system pairs + do sysI=1, this%numberOfDisplacedSystems !computed + do sysII=1, numberOfDisplacedSystems !reference + ! if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle + !!Compute molecular overlap matrix and its inverse + do speciesID=1, numberOfSpecies + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems + particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) + call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) + do k=1,3 + call Matrix_constructor(molecularMomentMatrix(speciesID,k), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) + end do + + do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysI + if(sysListCur(sysI,speciesID)%values(mu) .eq. 0) cycle + do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysII + if(sysListRef(sysII,speciesID)%values(nu) .eq. 0) cycle + do i = 1 , occupationNumber + ii=occupationNumber*(sysI-1)+i + do j = 1 , occupationNumber + jj=occupationNumber*(sysII-1)+j+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2 + ! print *, "i, j, mu, nu, coefI, coefII, overlap", i,j,mu,nu,superMergedCoefficients(speciesID)%values(mu,ii),& + ! superMergedCoefficients(speciesID)%values(nu,jj),& + ! superOverlapMatrix(speciesID)%values(mu,nu) + molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+& + superMergedCoefficients(speciesID)%values(mu,ii)*& + superMergedCoefficients(speciesID)%values(nu,jj)*& + superOverlapMatrix(speciesID)%values(mu,nu) + do k=1,3 + molecularMomentMatrix(speciesID,k)%values(i,j)=molecularMomentMatrix(speciesID,k)%values(i,j)+& + superMergedCoefficients(speciesID)%values(mu,ii)*& + superMergedCoefficients(speciesID)%values(nu,jj)*& + superMomentMatrix(speciesID,k)%values(mu,nu) + end do + end do + end do + end do + end do + if(occupationNumber .ne. 0) then + inverseOverlapMatrix(speciesID)=Matrix_inverse(molecularOverlapMatrix) + ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII + ! call Matrix_show(inverseOverlapMatrices(speciesID)) + call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant,method="LU") + ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant + refCurOverlapMatrix(speciesID)%values(sysI,sysII)=overlapDeterminant**particlesPerOrbital + else + overlapDeterminant=1.0 + end if + refCurTotalOverlap%values(sysI,sysII)=refCurTotalOverlap%values(sysI,sysII)*refCurOverlapMatrix(speciesID)%values(sysI,sysII) + end do + + do speciesID=1, numberOfSpecies + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems + particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) + do i = 1 , occupationNumber + do j = 1 , occupationNumber + do k=1,3 + refCurMomentMatrix(speciesID,k)%values(sysI,sysII)=refCurMomentMatrix(speciesID,k)%values(sysI,sysII)+& + molecularMomentMatrix(speciesID,k)%values(i,j)*& + inverseOverlapMatrix(speciesID)%values(j,i) + end do + end do + end do + do k=1,3 + refCurMomentMatrix(speciesID,k)%values(sysI,sysII)=refCurMomentMatrix(speciesID,k)%values(sysI,sysII)*refCurTotalOverlap%values(sysI,sysII)*particlesPerOrbital + end do + end do + end do + end do + + do speciesID=1, numberOfSpecies + print *, "refCurOverlapMatrix(speciesID)", speciesID + call Matrix_show(refCurOverlapMatrix(speciesID)) + call Matrix_constructor(franckCondonMatrix(speciesID), int(CONTROL_instance%CI_STATES_TO_PRINT,8), int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8) + end do + + !+1 For point charges + do speciesID=1, numberOfSpecies+1 + do k=1,3 + call Matrix_constructor(transitionDipoleMatrix(speciesID,k), int(CONTROL_instance%CI_STATES_TO_PRINT,8), int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8) + end do + end do + + do stateII=1, CONTROL_instance%CI_STATES_TO_PRINT + print *, "Reference state:", stateII + do stateI=1, CONTROL_instance%CI_STATES_TO_PRINT + print *, " current state:", stateI + do speciesID=1, numberOfSpecies + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1)) !not using the merged molecular systems + print *, "occupationNumber", occupationNumber + particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(1)) + trololo=0 + do sysI=1, this%numberOfDisplacedSystems !computed + do sysII=1, numberOfDisplacedSystems !reference + do i = 1 , occupationNumber + do j = 1 , occupationNumber + trololo = trololo + & + inverseOverlapMatrix(speciesID)%values(j,i)*& + this%configurationCoefficients%values(sysI,stateI)*& + ciCoefficients%values(sysII,stateII)*& !!reference + refCurOverlapMatrix(speciesID)%values(sysI,sysII)*& + particlesPerOrbital + end do + end do + ! refCurTotalOverlap%values(sysI,sysII)*& + ! franckCondonMatrix(speciesID)%values(stateI,stateII)+& + + do k=1,3 + transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) = transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) + & + molecularsystem_getcharge( speciesID )*& + this%configurationCoefficients%values(sysI,stateI)*& + ciCoefficients%values(sysII,stateII)*& !!reference + refCurMomentMatrix(speciesID,k)%values(sysI,sysII) + end do + + end do + end do + print *, "speciesID", speciesID, "trololo", trololo + franckCondonMatrix(speciesID)%values(stateI,stateII)=trololo + franckCondonMatrix(speciesID)%values(stateI,stateII)=franckCondonMatrix(speciesID)%values(stateI,stateII)/(occupationNumber*particlesPerOrbital) + print *, " F.C. factor for ", molecularSystem_getNameOfSpecies(speciesID),& + franckCondonMatrix(speciesID)%values(stateI,stateII) + end do + do sysI=1, this%numberOfDisplacedSystems !computed + do sysII=1, numberOfDisplacedSystems !reference + do k=1,3 + transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) = transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) + & + pointchargesdipole(k)*& + this%configurationCoefficients%values(sysI,stateI)*& + ciCoefficients%values(sysII,stateII)*& !!reference + refCurTotalOverlap%values(sysI,sysII) + end do + end do + end do + ! trololo=1 + ! do speciesID=1, numberOfSpecies + ! trololo=trololo*franckCondonMatrix(speciesID)%values(stateI,stateII) + ! end do + ! print *, " F.C. factor product ", trololo + ! trololo=0 + ! do speciesID=1, numberOfSpecies + ! trololo=trololo+franckCondonMatrix(speciesID)%values(stateI,stateII) + ! end do + ! print *, " F.C. factor sum ", trololo + ! trololo=0 + ! do sysI=1, this%numberOfDisplacedSystems !computed + ! do sysII=1, numberOfDisplacedSystems !reference + ! trololo = trololo + & + ! this%configurationCoefficients%values(sysI,stateI)*& + ! ciCoefficients%values(sysII,stateII)*& !!reference + ! refCurTotalOverlap%values(sysI,sysII) + ! end do + ! end do + ! print *, " total overlap ", trololo + end do + end do + + print *, "Dipole approximation spectrum" + do stateII=1, CONTROL_instance%CI_STATES_TO_PRINT + print *, "Reference state:", stateII + do stateI=1, CONTROL_instance%CI_STATES_TO_PRINT + trolololo=0 + print *, "current state:", stateI + do speciesID=1, numberOfSpecies + do k=1,3 + trolololo(k)=trolololo(k)+transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) + end do + print *, " T.D. integrals for ", molecularSystem_getNameOfSpecies(speciesID),& + transitionDipoleMatrix(speciesID,1)%values(stateI,stateII),& + transitionDipoleMatrix(speciesID,2)%values(stateI,stateII),& + transitionDipoleMatrix(speciesID,3)%values(stateI,stateII) + end do + do k=1,3 + trolololo(k)=trolololo(k)+transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) + end do + print *, " T.D. integrals point charges ", & + transitionDipoleMatrix(numberOfSpecies+1,1)%values(stateI,stateII),& + transitionDipoleMatrix(numberOfSpecies+1,2)%values(stateI,stateII),& + transitionDipoleMatrix(numberOfSpecies+1,3)%values(stateI,stateII) + print *, "energy dif", ciEnergies%values(stateII)-this%statesEigenvalues%values(stateI), "total components", trolololo(1:3) ,"intensity", sqrt(sum(trolololo(1:3)**2)) + end do + end do + + close(densUnit) + + deallocate(auxCoefficients,& + sysListCur,sysListRef,& + orbListI,orbListII,& + superMergedCoefficients,& + superOverlapMatrix,& + franckCondonMatrix) + + end subroutine NOCIFranckCondon_computeFranckCondon + + +end module NOCIFranckCondon_ + diff --git a/src/NOCI/NOCIMatrices.f90 b/src/NOCI/NOCIMatrices.f90 new file mode 100644 index 00000000..83d424d0 --- /dev/null +++ b/src/NOCI/NOCIMatrices.f90 @@ -0,0 +1,1625 @@ +!****************************************************************************** +!! This code is part of LOWDIN Quantum chemistry package +!! +!! this program has been developed under direction of: +!! +!! UNIVERSIDAD NACIONAL DE COLOMBIA" +!! PROF. ANDRES REYES GROUP" +!! http://www.qcc.unal.edu.co" +!! +!! UNIVERSIDAD DE GUADALAJARA" +!! PROF. ROBERTO FLORES GROUP" +!! http://www.cucei.udg.mx/~robertof" +!! +!! AUTHORS +!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA +!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! CONTRIBUTORS +!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA +!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO +!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! +!! Todos los derechos reservados, 2011 +!! +!!****************************************************************************** + +module NOCIMatrices_ + use NOCIBuild_ + use MolecularSystem_ + use Matrix_ + use Vector_ + use DirectIntegralManager_ + use Libint2Interface_ + use omp_lib + implicit none + + !> + !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727 + !! + !! @author Felix + !! + !! Creation data : 02-22 + !! + !! History change: + !! + !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co ) + !! -# Creation of the module. + !! + !< + + public :: & + NOCIMatrices_buildOverlapAndHamiltonian,& + NOCIMatrices_diagonalize,& + NOCIMatrices_mergeCoefficients + + private + +contains + + !> + !! @brief Computes overlap and hamiltonian non orthogonal CI matrices for previously calculated molecular systems at different geometries + !! + !! @param this + !< + subroutine NOCIMatrices_buildOverlapAndHamiltonian(this) + implicit none + type(NonOrthogonalCI) :: this + type(MolecularSystem), allocatable :: mergedMolecularSystem(:) + type(Libint2Interface), allocatable :: Libint2ParallelInstance(:,:) + integer, allocatable :: sysIbatch(:), sysIIbatch(:) + integer :: sysI,sysII,me,mySysI,mySysII + type(Matrix), allocatable :: mergedCoefficients(:), inverseOverlapMatrices(:) + type(IVector), allocatable :: sysIbasisList(:,:),sysIIbasisList(:,:) + real(8) :: overlapUpperBound + integer :: prescreenedElements, overlapScreenedElements + + integer :: speciesID, otherSpeciesID + integer :: nspecies + integer :: ncores, batchSize, upperBound + + integer :: matrixUnit + character(100) :: matrixFile + real(8) :: empiricalScaleFactor + + real(8) :: timeMerging, timePrescreen, timeOverlap, timeTwoIntegrals + real(8) :: timeA + real(8) :: timeB + + timePrescreen=0.0 + timeOverlap=0.0 + timeTwoIntegrals=0.0 + + print *, "" + print *, "A prescreening of the overlap matrix elements is performed for the heavy species" + write (*,'(A,ES8.1)') "Overlap and Hamiltonian matrix elements are saved for pairs with overlap higher than",& + CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD + print *, "For pairs with lower overlap, setting H(I,II)=0, S(I,II)=0" + print *, "" + + prescreenedElements=0 + overlapScreenedElements=0 + + matrixUnit=290 + matrixFile= trim(CONTROL_instance%INPUT_FILE)//"NOCI-Matrix.ci" + + print *, "computing NOCI overlap and hamiltonian matrices... saving them to ", trim(matrixFile) + + open(unit=matrixUnit, file=trim(matrixFile), status="replace", form="formatted") + + write (matrixUnit,'(A20,I20)') "MatrixSize", this%numberOfDisplacedSystems + write (matrixUnit,'(A10,A10,A20,A20)') "Conf. ", "Conf. ", "Overlap ","Hamiltonian " + !Save diagonal elements + do sysI=1,this%numberOfDisplacedSystems + this%configurationOverlapMatrix%values(sysI,sysI)=1.0 + write (matrixUnit,'(I10,I10,ES20.12,ES20.12)') sysI, sysI, & + this%configurationOverlapMatrix%values(sysI,sysI), this%configurationHamiltonianMatrix%values(sysI,sysI) + end do + + !Allocate objets to distribute in parallel + nspecies=this%molecularSystems(1)%numberOfQuantumSpecies + ncores=CONTROL_instance%NUMBER_OF_CORES + batchSize=this%numberOfDisplacedSystems + print *, "ncores", ncores, "batchsize", batchSize + + allocate(mergedMolecularSystem(batchSize),& + mergedCoefficients(nspecies),& + inverseOverlapMatrices(nspecies),& + Libint2ParallelInstance(nspecies,batchSize),& + sysIbatch(batchSize),& + sysIIbatch(batchSize),& + sysIbasisList(nspecies,batchSize),& + sysIIbasisList(nspecies,batchSize)) + + if(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then + upperBound=1 + this%printMatrixThreshold=this%numberOfDisplacedSystems + else + upperBound=this%numberOfDisplacedSystems + end if + ! print *, "upperBound", upperBound + + sysI=1 + sysII=1 + + systemLoop: do while((sysI.le.upperBound .and. sysII.le.this%numberOfDisplacedSystems)) + ! print *, "distributing sysI ", sysI, " sysII ", sysII, " into", batchSize, " batches" + !In serial, prepare systems + sysIbatch(:)=0 + sysIIbatch(:)=0 + me=0 + mySysI=sysI + mySysII=sysII + + do while(me.lt.batchSize) + mySysII=mySysII+1 + if(mySysII .gt. this%numberOfDisplacedSystems) then + mySysI=mySysI+1 + mySysII=mySysI+1 + if(mySysI .gt. upperBound .or. mySysII .gt. this%numberOfDisplacedSystems) exit + end if + + ! print *, "checking prescreening of elements", mySysI, mySysII + !$ timeA = omp_get_wtime() + !Estimates overlap with a 1s-1s integral approximation + call NOCIMatrices_prescreenOverlap(this,mySysI,mySysII,overlapUpperBound) + + if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. & + overlapUpperBound .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then + ! print *, "preskipping elements", mySysI, mySysII, "with overlap estimated as", overlapUpperBound + prescreenedElements=prescreenedElements+1 + else + !$ timeB = omp_get_wtime() + !$ timePrescreen=timePrescreen+(timeB - timeA) + me=me+1 + sysIbatch(me)=mySysI + sysIIbatch(me)=mySysII + !$ timeA = omp_get_wtime() + !This generates a new molecular system + ! print *, "Merging systems from geometries ", mySysI, mySysII + call MolecularSystem_mergeTwoSystems(mergedMolecularSystem(me), & + this%molecularSystems(mySysI), this%molecularSystems(mySysII),sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me)) + ! call MolecularSystem_showInformation() + ! call MolecularSystem_showParticlesInformation() + ! call MolecularSystem_showCartesianMatrix(mergedMolecularSystem) + call DirectIntegralManager_constructor(Libint2ParallelInstance(1:nspecies,me),mergedMolecularSystem(me)) + !$ timeB = omp_get_wtime() + !$ timeMerging=timeMerging+(timeB - timeA) + + end if + end do + + !In parallel, fill matrices + + call OMP_set_num_threads(ncores) + !$omp parallel & + !$omp& private(mySysI,mySysII,mergedCoefficients,inverseOverlapMatrices),& + !$omp& shared(this,sysI,sysII,matrixUnit,prescreenedElements,overlapScreenedElements,sysIbasisList,sysIIbasisList,mergedMolecularSystem,Libint2ParallelInstance,nspecies,batchSize) + !$omp do schedule(dynamic,10) + procs: do me=1, batchSize + mySysI=sysIbatch(me) + mySysII=sysIIbatch(me) + if(mySysI .eq. 0 .or. mySysII .eq. 0) cycle procs + + ! print *, "evaluating S and H elements for", mySysI, mySysII + + !! Merge occupied coefficients into a single matrix + call NOCIMatrices_mergeCoefficients(this%HFCoefficients(mySysI,:),this%HFCoefficients(mySysII,:),& + this%molecularSystems(mySysI),this%molecularSystems(mySysII),mergedMolecularSystem(me),& + sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me),mergedCoefficients) + !$ timeA = omp_get_wtime() + + call NOCIMatrices_computeOverlapAndHCoreElements(this,mySysI,mySysII,mergedMolecularSystem(me),mergedCoefficients,& + sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me),inverseOverlapMatrices) + !$ timeB = omp_get_wtime() + !$ timeOverlap=timeOverlap+(timeB - timeA) + + !! SKIP ENERGY EVALUATION IF OVERLAP IS TOO LOW + + if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. & + abs(this%configurationOverlapMatrix%values(mySysI,mySysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then + ! print *, "screening elements", mySysI, mySysII, "with overlap", this%configurationOverlapMatrix%values(mySysI,mySysII) + this%configurationOverlapMatrix%values(mySysI,mySysII)=0.0 + this%configurationHamiltonianMatrix%values(mySysI,mySysII)=0.0 + !$OMP ATOMIC + overlapScreenedElements=overlapScreenedElements+1 + else + + !$ timeA = omp_get_wtime() + ! print *, "evaluating twoParticlesContributions for", mySysI, mySysII + call NOCIMatrices_twoParticlesContributions(this,mySysI,mySysII,mergedMolecularSystem(me),& + inverseOverlapMatrices,mergedCoefficients,Libint2ParallelInstance(1:nspecies,me)) + + if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then + ! !DFT energy correction for off diagonal elements following Gao2016 - scaled average of the diagonal elements + + do speciesID = 1, nspecies + this%configurationHamiltonianMatrix%values(mySysI,mySysII)=this%configurationHamiltonianMatrix%values(mySysI,mySysII)-& + this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*& + (1/this%exactExchangeFraction(speciesID)-1)*& + (this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysI)+& + this%configurationExchangeMatrix(speciesID)%values(mySysII,mySysII)) + + this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)=this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)-& + this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*& + (1/this%exactExchangeFraction(speciesID)-1)*& + (this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysI)+& + this%configurationExchangeMatrix(speciesID)%values(mySysII,mySysII)) + + do otherSpeciesID = speciesID, nspecies + this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)=this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)+& + this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*& + (this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysI)+& + this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysII,mySysII)) + this%configurationHamiltonianMatrix%values(mySysI,mySysII)=this%configurationHamiltonianMatrix%values(mySysI,mySysII)+& + this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII) + end do + end do + + ! this%configurationHamiltonianMatrix%values(mySysI,mySysII)=this%configurationHamiltonianMatrix%values(mySysI,mySysII)+& + ! this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*& + ! (this%configurationCorrelationEnergies%values(mySysI)+& + ! this%configurationCorrelationEnergies%values(mySysII)) + ! !DFT energy correction for off diagonal elements + ! call NOCIMatrices_getOffDiagonalDensityMatrix(this,mySysI,mySysII,mergedCoefficients,mergedMolecularSystem(me),this%configurationOverlapMatrix%values(mySysI,mySysII),& + ! inverseOverlapMatrices,sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me)) + end if + + !$ timeB = omp_get_wtime() + !$ timeTwoIntegrals=timeTwoIntegrals+(timeB - timeA) + end if + + ! print *, "thread", omp_get_thread_num()+1,"me", me, "mySysI", " mySysII", mySysI, mySysII, "S", this%configurationOverlapMatrix%values(mySysI,mySysII), "H", this%configurationHamiltonianMatrix%values(mySysI,mySysII) + end do procs + !$omp end do nowait + !$omp end parallel + + !In serial, symmetrize, free memory and print + do me=1, batchSize + mySysI=sysIbatch(me) + mySysII=sysIIbatch(me) + + if(mySysI .eq. 0 .or. mySysII .eq. 0) exit systemLoop + + !Yu2020 magical empirical correction + if(CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION .and. & + abs(this%configurationOverlapMatrix%values(mySysI,mySysII)) .gt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then + empiricalScaleFactor=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A*& + abs(this%configurationOverlapMatrix%values(mySysI,mySysII))**CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B/& + abs(this%configurationOverlapMatrix%values(mySysI,mySysII)) + this%configurationOverlapMatrix%values(mySysI,mySysII)=& + this%configurationOverlapMatrix%values(mySysI,mySysII)*empiricalScaleFactor + this%configurationHamiltonianMatrix%values(mySysI,mySysII)=& + this%configurationHamiltonianMatrix%values(mySysI,mySysII)*empiricalScaleFactor + do speciesID=1, nspecies + this%configurationKineticMatrix(speciesID)%values(mySysI,mySysII)=& + this%configurationKineticMatrix(speciesID)%values(mySysI,mySysII)*empiricalScaleFactor + this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysII)=& + this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysII)*empiricalScaleFactor + this%configurationExternalMatrix(speciesID)%values(mySysI,mySysII)=& + this%configurationExternalMatrix(speciesID)%values(mySysI,mySysII)*empiricalScaleFactor + this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)=& + this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII)*empiricalScaleFactor + do otherSpeciesID=speciesID, nspecies + this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)=& + this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)*empiricalScaleFactor + this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)=& + this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII)*empiricalScaleFactor + end do + end do + end if + + !Symmetrize + this%configurationOverlapMatrix%values(mySysII,mySysI)=this%configurationOverlapMatrix%values(mySysI,mySysII) + this%configurationHamiltonianMatrix%values(mySysII,mySysI)=this%configurationHamiltonianMatrix%values(mySysI,mySysII) + + do speciesID=1, nspecies + this%configurationKineticMatrix(speciesID)%values(mySysII,mySysI)=this%configurationKineticMatrix(speciesID)%values(mySysI,mySysII) + this%configurationPuntualMatrix(speciesID)%values(mySysII,mySysI)=this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysII) + this%configurationExternalMatrix(speciesID)%values(mySysII,mySysI)=this%configurationExternalMatrix(speciesID)%values(mySysI,mySysII) + this%configurationExchangeMatrix(speciesID)%values(mySysII,mySysI)=this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII) + do otherSpeciesID=speciesID, nspecies + this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysII,mySysI)=& + this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII) + this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysII,mySysI)=& + this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII) + end do + end do + + write (matrixUnit,'(I10,I10,ES20.12,ES20.12)') mySysI, mySysII, & + this%configurationOverlapMatrix%values(mySysI,mySysII), this%configurationHamiltonianMatrix%values(mySysI,mySysII) + + if (this%numberOfDisplacedSystems .le. this%printMatrixThreshold) then + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, "Overlap element = ", this%configurationOverlapMatrix%values(mySysI,mySysII) + do speciesID = 1, nspecies + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + " Kinetic element = ", this%configurationKineticMatrix(speciesID)%values(mySysI,mySysII) + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + " Puntual element = ", this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysII) + if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + " External element = ", this%configurationExternalMatrix(speciesID)%values(mySysI,mySysII) + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + "/"//trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + " Hartree element = ", this%configurationHartreeMatrix(speciesID,speciesID)%values(mySysI,mySysII) + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + " Exchange element = ", this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysII) + end do + do speciesID=1, nspecies-1 + do otherSpeciesID=speciesID+1, nspecies + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + "/"//trim( this%molecularSystems(mySysI)%species(otherSpeciesID)%name ) // & + " Hartree element = ", this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII) + end do + end do + if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then + do speciesID=1, nspecies + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + "/"//trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + " DFTcorrelation element = ", this%configurationDFTcorrelationMatrix(speciesID,speciesID)%values(mySysI,mySysII) + end do + do speciesID=1, nspecies + do otherSpeciesID=speciesID+1, nspecies-1 + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, trim( this%molecularSystems(mySysI)%species(speciesID)%name ) // & + "/"//trim( this%molecularSystems(mySysI)%species(otherSpeciesID)%name ) // & + " DFTcorrelation element = ", this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysII) + end do + end do + + ! write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, "Total DFT Correlation element = ", this%configurationOverlapMatrix%values(mySysI,mySysII)/2.0*& + ! (this%configurationCorrelationEnergies%values(mySysI)+& + ! this%configurationCorrelationEnergies%values(mySysII)) + end if + write (*,'(I10,I10,A38,ES20.12)') mySysI, mySysII, "Hamiltonian element = ", this%configurationHamiltonianMatrix%values(mySysI,mySysII) + print *, "" + + end if + + call DirectIntegralManager_destructor(Libint2ParallelInstance(1:nspecies,me)) + + sysI=mySysI + sysII=mySysII + + end do + + end do systemLoop + + close(matrixUnit) + + print *, "" + print *, "Configuration pairs skipped by overlap prescreening: ", prescreenedElements + print *, "Configuration pairs skipped by overlap screening: ", overlapScreenedElements + if( .not. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then + print *, "Overlap integrals computed for ", this%numberOfDisplacedSystems*(this%numberOfDisplacedSystems-1)/2& + -prescreenedElements, "configuration pairs" + print *, "Four center integrals computed for", this%numberOfDisplacedSystems*(this%numberOfDisplacedSystems-1)/2& + -prescreenedElements-overlapScreenedElements, "configuration pairs" + else + print *, "Overlap integrals computed for ", this%numberOfDisplacedSystems& + -prescreenedElements, "configuration pairs" + print *, "Four center integrals computed for", this%numberOfDisplacedSystems& + -prescreenedElements-overlapScreenedElements, "configuration pairs" + end if + print *, "" + + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for overlap prescreening : ", timePrescreen ," (s)" + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for merging systems : ", timeMerging ," (s)" + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for two index integrals : ", timeOverlap ," (s)" + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for four index integrals : ", timeTwoIntegrals ," (s)" + + print *, "" + + deallocate(mergedMolecularSystem,& + mergedCoefficients,& + inverseOverlapMatrices,& + Libint2ParallelInstance,& + sysIbatch,& + sysIIbatch,& + sysIbasisList,& + sysIIbasisList) + + ! integer :: symmetryEquivalentElements + ! timeSymmetry=0.0 + ! symmetryEquivalentElements=0 + ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then + ! write (matrixUnit,'(A10,A10,A10,A20,A20)') "Conf. ", "Conf. ", "Type ", "Overlap ","Hamiltonian " + ! else + ! end if + ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then + ! write (matrixUnit,'(I10,I10,I10,ES20.12,ES20.12)') sysI, sysI, this%configurationPairTypes%values(sysI,sysI), & + ! this%configurationOverlapMatrix%values(sysI,sysI), this%configurationHamiltonianMatrix%values(sysI,sysI) + ! else + ! end if + ! write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for element symmetry : ", timeSymmetry ," (s)" + ! !$ timeA = omp_get_wtime() + ! !!Check symmetry of the element + ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then + ! call NOCIMatrices_classifyConfigurationPair(this,sysI,sysII,newPairFlag) + ! !$ timeB = omp_get_wtime() + ! !$ timeSymmetry=timeSymmetry+(timeB - timeA) + + ! !!Copy results from previously computed equivalent elements + ! if (newPairFlag .eqv. .false.) then + ! do preSysI=1, sysI + ! do preSysII=preSysI+1, sysII + ! if(this%configurationPairTypes%values(preSysI,preSysII) .eq. this%configurationPairTypes%values(sysI,sysII)) then + ! this%configurationOverlapMatrix%values(sysI,sysII)=this%configurationOverlapMatrix%values(preSysI,preSysII) + ! this%configurationOverlapMatrix%values(sysII,sysI)=this%configurationOverlapMatrix%values(sysI,sysII) + ! this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(preSysI,preSysII) + ! this%configurationHamiltonianMatrix%values(sysII,sysI)=this%configurationHamiltonianMatrix%values(sysI,sysII) + ! symmetryEquivalentElements=symmetryEquivalentElements+1 + + ! if( this%configurationOverlapMatrix%values(sysI,sysII) .ne. 0.0) & + ! write (*,'(A,I10,I10,A,I10,A,ES20.12,ES20.12)') "Pair ",sysI, sysII," is type ", & + ! this%configurationPairTypes%values(sysI,sysII), " Overlap and Hamiltonian elements", & + ! this%configurationOverlapMatrix%values(sysI,sysII), this%configurationHamiltonianMatrix%values(sysI,sysII) + + ! cycle systemII + ! end if + ! end do + ! end do + ! end if + ! end if + !!This is a symmetry test, assume positive phase + ! if( this%configurationOverlapMatrix%values(sysI,sysII) .lt. 0.0) then + ! this%configurationOverlapMatrix%values(sysI,sysII)=-this%configurationOverlapMatrix%values(sysI,sysII) + ! this%configurationOverlapMatrix%values(sysII,sysI)=-this%configurationOverlapMatrix%values(sysII,sysI) + ! this%configurationHamiltonianMatrix%values(sysI,sysII)=-this%configurationHamiltonianMatrix%values(sysI,sysII) + ! this%configurationHamiltonianMatrix%values(sysII,sysI)=-this%configurationHamiltonianMatrix%values(sysII,sysI) + ! end if + + ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then + ! write (matrixUnit,'(I10,I10,I10,ES20.12,ES20.12)') sysI, sysII, this%configurationPairTypes%values(sysI,sysII), & + ! this%configurationOverlapMatrix%values(sysI,sysII), this%configurationHamiltonianMatrix%values(sysI,sysII) + ! else + ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) & + ! print *, "Configuration pairs skipped by symmetry equivalence: ", symmetryEquivalentElements + + end subroutine NOCIMatrices_buildOverlapAndHamiltonian + + + !> + !! @brief Merges the occupied orbitals coefficients from two systems + !! @param occupationI and occupationII: Number of orbitals to merge from each matrix. + !! sysBasisList: array indicating which basis functions of the merged molecular system belong to sysI and sysII Merged Coefficients: Matrices for output. + !< + subroutine NOCIMatrices_mergeCoefficients(coefficientsI,coefficientsII,molecularSystemI,molecularSystemII,mergedMolecularSystem,& + sysIbasisList,sysIIbasisList,mergedCoefficients) + type(Matrix), intent(in) :: coefficientsI(*), coefficientsII(*) + type(MolecularSystem), intent(in) :: molecularSystemI, molecularSystemII, mergedMolecularSystem + type(IVector), intent(in) :: sysIbasisList(*), sysIIbasisList(*) + type(Matrix), intent(out) :: mergedCoefficients(*) + + ! character(100) :: wfnFile + ! character(50) :: arguments(2) + ! integer :: wfnUnit + integer :: speciesID, i, j, mu + + !! Mix coefficients of occupied orbitals of both systems + !!Create a dummy density matrix to lowdin.wfn file + ! wfnUnit = 500 + ! wfnFile = "lowdin.wfn" + ! open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted") + do speciesID = 1, mergedMolecularSystem%numberOfQuantumSpecies + + ! arguments(2) = mergedMolecularSystem%species(speciesID)%name + + ! arguments(1) = "COEFFICIENTS" + + ! !Max: to make the matrix square for the integral calculations for configuration pairs, and rectangular for the merged coefficients of all systems + call Matrix_constructor(mergedCoefficients(speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),8), & + int(max(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem)),8), 0.0_8 ) + + ! print *, "sysI coefficients for ", speciesID + ! call Matrix_show(coefficientsI(speciesID)) + ! print *, "sysII coefficients for ", speciesID + ! call Matrix_show(coefficientsII(speciesID)) + + !sysI orbitals on the left columns, sysII on the right columns + !sysI coefficients + do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) + if((sysIbasisList(speciesID)%values(mu) .ne. 0) ) then + do i=1, MolecularSystem_getOcupationNumber(speciesID,molecularSystemI)!sysI + mergedCoefficients(speciesID)%values(mu,i)=coefficientsI(speciesID)%values(sysIbasisList(speciesID)%values(mu),i) + ! print *, "sys I", mu, i, mergedCoefficients(speciesID)%values(mu,i) + end do + end if + end do + + ! !sysII coefficients + do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) + if((sysIIbasisList(speciesID)%values(mu) .ne. 0) ) then + do i=1, MolecularSystem_getOcupationNumber(speciesID,molecularSystemII)!sysII + j=MolecularSystem_getOcupationNumber(speciesID,molecularSystemI)+i !column + mergedCoefficients(speciesID)%values(mu,j)=coefficientsII(speciesID)%values(sysIIbasisList(speciesID)%values(mu),i) + ! print *, "sys II", mu, j, mergedCoefficients(speciesID)%values(mu,j) + end do + end if + end do + + ! print *, "Merged coefficients matrix for ", speciesID + ! call Matrix_show(mergedCoefficients(speciesID)) + + ! call Matrix_writeToFile(mergedCoefficients(speciesID), unit=wfnUnit, binary=.true., arguments = arguments + ! call Matrix_writeToFile(auxMatrix, unit=wfnUnit, binary=.true., arguments = arguments ) + + ! arguments(1) = "ORBITALS" + ! call Vector_constructor(auxVector, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), 0.0_8 ) + + ! call Vector_writeToFile(auxVector, unit=wfnUnit, binary=.true., arguments = arguments ) + + ! Only occupied orbitals are going to be transformed - handled in integral transformation program + ! print *, "removed", MolecularSystem_getTotalNumberOfContractions(speciesID)-MolecularSystem_getOcupationNumber(speciesID) + ! arguments(1) = "REMOVED-ORBITALS" + ! call Vector_writeToFile(unit=wfnUnit, binary=.true., & + ! value=real(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)-MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem),8),& + ! arguments= arguments ) + + end do + ! close(wfnUnit) + + end subroutine NOCIMatrices_mergeCoefficients + + !> + !! @brief Merges the occupied orbitals coefficients from two systems + !! @param occupationI and occupationII: Number of orbitals to merge from each matrix. + !! sysBasisList: array indicating which basis functions of the merged molecular system belong to sysI and sysII Merged Coefficients: Matrices for output. + !< + subroutine NOCIMatrices_getOffDiagonalDensityMatrix(this,sysI,sysII,mergedCoefficients,mergedMolecularSystem,overlapElement,inverseOverlapMatrices,& + sysIbasisList,sysIIbasisList) + type(NonOrthogonalCI), intent(inout) :: this + integer, intent(in) :: sysI, sysII + type(Matrix), intent(in) :: mergedCoefficients(*), inverseOverlapMatrices(*) + type(MolecularSystem), intent(in) :: mergedMolecularSystem + real(8), intent(in) :: overlapElement + type(IVector), intent(in) :: sysIbasisList(*), sysIIbasisList(*) + + type(Matrix), allocatable :: mergedDensityMatrix(:) + type(Matrix), allocatable :: exchangeCorrelationMatrices(:) + type(Matrix) :: dftEnergyMatrix + real(8), allocatable :: particlesInGrid(:) + + integer :: speciesID, otherSpeciesID, i, j, ii, jj, mu, nu + integer :: numberOfSpecies, particlesPerOrbital, occupationNumber, numberOfContractions + + !!"Non Diagonal" terms - system pairs + if( abs(overlapElement) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) return + + numberOfSpecies=mergedMolecularSystem%numberOfQuantumSpecies + allocate(mergedDensityMatrix(numberOfSpecies)) + + call MolecularSystem_copyConstructor(MolecularSystem_instance,mergedMolecularSystem) + + ! Compute density contributions + do speciesID=1, numberOfSpecies + particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem) + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem)/2 + numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) + call Matrix_constructor(mergedDensityMatrix(speciesID),int(numberOfContractions,8),int(numberOfContractions,8),0.0_8) + do mu = 1 , numberOfContractions + if(sysIbasisList(speciesID)%values(mu) .eq. 0) cycle + do nu = 1 , numberOfContractions + if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle + do i = 1 , occupationNumber + ii= i + do j = 1 , occupationNumber + jj=occupationNumber + j + mergedDensityMatrix(speciesID)%values(mu,nu) = mergedDensityMatrix(speciesID)%values(mu,nu) + & + inverseOverlapMatrices(speciesID)%values(j,i)*& + mergedCoefficients(speciesID)%values(mu,ii)*& + mergedCoefficients(speciesID)%values(nu,jj) + mergedDensityMatrix(speciesID)%values(nu,mu) = mergedDensityMatrix(speciesID)%values(nu,mu) + & + inverseOverlapMatrices(speciesID)%values(j,i)*& + mergedCoefficients(speciesID)%values(mu,ii)*& + mergedCoefficients(speciesID)%values(nu,jj) + end do + end do + end do + end do + mergedDensityMatrix(speciesID)%values=0.5*particlesPerOrbital*mergedDensityMatrix(speciesID)%values + ! print *, "off diagonal matrix for", speciesID + ! call Matrix_show(mergedDensityMatrix(speciesID)) + end do + + + ! if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then + ! print *, "Superposed DFT energies:" + + ! allocate(exchangeCorrelationMatrices(numberOfSpecies), & + ! particlesInGrid(numberOfSpecies)) + ! call DensityFunctionalTheory_buildFinalGrid() + ! call Matrix_constructor(dftEnergyMatrix, int(numberOfSpecies,8), & + ! int(numberOfSpecies,8), 0.0_8 ) + ! do speciesID=1, numberOfSpecies + ! numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) + ! call Matrix_constructor(exchangeCorrelationMatrices(speciesID), int(numberOfContractions,8), & + ! int(numberOfContractions,8), 0.0_8) + ! end do + ! call DensityFunctionalTheory_finalDFT(mergedDensityMatrix(1:numberOfSpecies), & + ! exchangeCorrelationMatrices, & + ! dftEnergyMatrix, & + ! particlesInGrid) + + ! do speciesID = 1, numberOfSpecies + ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & + ! " Particles in grid = ", particlesInGrid(speciesID) + ! end do + + ! do speciesID = 1, numberOfSpecies + ! do otherSpeciesID = speciesID, numberOfSpecies + ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & + ! "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // & + ! " DFT Corr. energy = ", dftEnergyMatrix%values(speciesID,otherSpeciesID) + ! this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(sysI,sysII)=dftEnergyMatrix%values(speciesID,otherSpeciesID)*overlapElement + ! end do + ! end do + ! end if + + + do speciesID=1, numberOfSpecies + call Matrix_destructor(mergedDensityMatrix(speciesID)) + end do + + deallocate(mergedDensityMatrix) + + end subroutine NOCIMatrices_getOffDiagonalDensityMatrix + + + !> + !! @brief Computes an upper bound of the overlap between two configurations, based on the max distance between particles of the same species and the lowest exponent of the basis set functions. Assumes a localized hartree product for the heaviest species + !! + !! @param sysI and sysII: molecular system indices. estimatedOverlap: output value + !< + subroutine NOCIMatrices_prescreenOverlap(this,sysI,sysII,estimatedOverlap) + type(NonOrthogonalCI) :: this + integer :: sysI, sysII !Indices of the systems to screen + real(8) :: estimatedOverlap + + type(Vector), allocatable :: displacementVector(:) + integer :: speciesID, k, l, m + real(8) :: massThreshold, minExponent, speciesOverlap + + !displacement vectors contains the max distance between equivalent basis function centers + allocate(displacementVector(this%molecularSystems(sysI)%numberOfQuantumSpecies)) + + call MolecularSystem_GetTwoSystemsDisplacement(this%molecularSystems(sysI), this%molecularSystems(sysII),displacementVector(:)) + + estimatedOverlap=1.0 + + !only compute for heavy particles, maybe should be a control parameter + massThreshold=10.0 + + do speciesID = 1, this%molecularSystems(sysI)%numberOfQuantumSpecies + if(this%molecularSystems(sysI)%species(speciesID)%mass .lt. massThreshold) cycle + speciesOverlap=1.0 + !!get smallest exponent of the basis set + do k = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles) + minExponent=1.0E8 + do l = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction) + do m = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents) + if(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents(m).lt.minExponent) & + minExponent=this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents(m) + !Assume a 1S GTF + ! normCoefficients(speciesID)=(2.0*minExponents(speciesID)/Math_PI)**(3.0/4.0) + end do + end do + !!Compute an hipothetical overlap between two 1S functions with the lowest orbital exponent separated at the distance between systems + speciesOverlap=speciesOverlap*exp(-minExponent*displacementVector(speciesID)%values(k)**2/2.0) + end do + + ! print *, "sysI", sysI, "sysII", sysII, "species", speciesID,"overlap approx", speciesOverlap + estimatedOverlap=estimatedOverlap*speciesOverlap + end do + + deallocate(displacementVector) + + end subroutine NOCIMatrices_prescreenOverlap + + !> + !! @brief Classify the sysI and sysII pair according to their distance matrix + !! + !! @param sysI and sysII: molecular system indices. + !< + ! subroutine NOCIMatrices_classifyConfigurationPair(this,currentSysI,currentSysII,newPairFlag) + ! implicit none + ! type(NonOrthogonalCI) :: this + ! integer :: currentSysI, currentSysII !Indices of the systems to classify + ! logical :: newPairFlag + + ! type(MolecularSystem) :: currentMolecularSystem + ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix + + ! integer :: sysI, sysII, i, checkingType + ! logical :: match + + ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance) + ! newPairFlag=.true. + ! currentDistanceMatrix=ParticleManager_getDistanceMatrix() + + ! ! print *, "Current distance matrix" + ! ! call Matrix_show(currentDistanceMatrix) + + ! types: do checkingType=1, this%numberOfUniquePairs + ! ! print *, "checkingType", checkingType + ! systemI: do sysI=1, currentSysI + ! systemII: do sysII=sysI+1, currentSysII + + ! if(sysI .eq. currentSysI .and. sysII .eq. currentSysII ) cycle types + + ! if((this%configurationPairTypes%values(sysI,sysII) .eq. checkingType) .and. & + ! (this%systemTypes%values(sysI) .eq. this%systemTypes%values(currentSysI)) .and. & + ! (this%systemTypes%values(sysII) .eq. this%systemTypes%values(currentSysII))) then + + ! ! call MolecularSystem_mergeTwoSystems(molecularSystem_instance, this%MolecularSystems(sysI), this%MolecularSystems(sysII)) + + ! previousDistanceMatrix=ParticleManager_getDistanceMatrix() + + ! ! print *, "Comparing with previous distance matrix", checkingType + ! ! call Matrix_show(previousDistanceMatrix) + + ! match=.true. + ! do i=1, size(currentDistanceMatrix%values(:,1)) + ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. & + ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then + ! match=.false. + ! exit + ! end if + ! end do + + ! if(match) then + ! newPairFlag=.false. + ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%configurationPairTypes%values(sysI,sysII) + ! exit types + ! else + ! cycle types + ! end if + ! end if + ! end do systemII + ! end do systemI + ! end do types + + ! if(newPairFlag) then + ! this%numberOfUniquePairs=this%numberOfUniquePairs+1 + ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%numberOfUniquePairs + ! end if + + ! if(this%configurationPairTypes%values(currentSysI,currentSysII).eq.0) then + ! print *, "newPairFlag", newPairFlag + ! print *, currentSysI, currentSysII, this%configurationPairTypes%values(currentSysI,currentSysII) + ! STOP "I found a type zero" + ! end if + ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem) + + ! end subroutine NOCIMatrices_classifyConfigurationPair + + + !> + !! @brief Computes overlap matrix element between two configurations along with one particle energy contributions + !! + !! @param sysI and sysII: molecular system indices. Merged Molecular System: Union of objects from sysI and sysII. Merged Coefficients: Mixed molecular system coefficients. Sys basis list indicate the basis functions of each sysI and sysII in the merged molecular system. inverseOverlapMatrices: output required for two particle contributions + !< + subroutine NOCIMatrices_computeOverlapAndHCoreElements(this,sysI,sysII,mergedMolecularSystem,mergedCoefficients, & + sysIbasisList, sysIIbasisList,inverseOverlapMatrices) + + type(NonOrthogonalCI) :: this + type(MolecularSystem) :: mergedMolecularSystem + integer :: sysI, sysII + type(Matrix) :: mergedCoefficients(*), inverseOverlapMatrices(*) + type(IVector) :: sysIbasisList(*), sysIIbasisList(*) + + integer :: speciesID + integer :: a,b,bb,mu,nu + integer :: numberOfContractions,occupationNumber,particlesPerOrbital + type(Matrix) :: molecularOverlapMatrix + type(Matrix), allocatable :: auxOverlapMatrix(:), auxKineticMatrix(:), auxAttractionMatrix(:), auxExternalPotMatrix(:) + type(Matrix), allocatable :: molecularKineticMatrix(:), molecularAttractionMatrix(:), molecularExternalMatrix(:) + type(Vector) :: overlapDeterminant + real(8) :: oneParticleKineticEnergy,oneParticleAttractionEnergy,oneParticleExternalEnergy + + allocate(auxOverlapMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & + auxKineticMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & + auxAttractionMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & + auxExternalPotMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & + molecularKineticMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & + molecularAttractionMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & + molecularExternalMatrix(mergedMolecularSystem%numberOfQuantumSpecies)) + + !!Initialize overlap + this%configurationOverlapMatrix%values(sysI,sysII)=1.0 + + call Vector_constructor(overlapDeterminant, mergedMolecularSystem%numberOfQuantumSpecies, 0.0_8) + +!!!!Overlap first + do speciesID = 1, this%MolecularSystems(sysI)%numberOfQuantumSpecies + + numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) + particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem) + !! Calculate one- particle integrals + call DirectIntegralManager_getOverlapIntegrals(mergedMolecularSystem,speciesID,& + auxOverlapMatrix(speciesID)) + + !!Test + + ! print *, "auxOverlapMatrix", speciesID + ! call Matrix_show(auxOverlapMatrix(speciesID)) + + call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), & + int(occupationNumber,8), 0.0_8 ) + + do mu=1, numberOfContractions!sysI + if(sysIbasisList(speciesID)%values(mu) .eq. 0 ) cycle + do nu=1, numberOfContractions !sysII + if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle + do a=1, occupationNumber !sysI + do b=occupationNumber+1, 2*occupationNumber + bb=b-occupationNumber + ! print *, "a, b, mu, nu, coefI, coefII", a, b, mu, nu, mergedCoefficients(speciesID)%values(mu,a), mergedCoefficients(speciesID)%values(nu,b),auxOverlapMatrix(speciesID)%values(mu,nu) + + molecularOverlapMatrix%values(a,bb)=molecularOverlapMatrix%values(a,bb)+& + mergedCoefficients(speciesID)%values(mu,a)*& + mergedCoefficients(speciesID)%values(nu,b)*& + auxOverlapMatrix(speciesID)%values(mu,nu) + end do + end do + end do + end do + + ! print *, "molecularOverlapMatrix sysI, sysII, speciesID", sysI, sysII, speciesID + ! call Matrix_show(molecularOverlapMatrix) + + !Sometimes we run calculations for systems with ghost species + if(occupationNumber .ne. 0) then + inverseOverlapMatrices(speciesID)=Matrix_inverse(molecularOverlapMatrix) + ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII + ! call Matrix_show(inverseOverlapMatrices(speciesID)) + call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant%values(speciesID),method="LU") + ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant%values(speciesID) + else + overlapDeterminant%values(speciesID)=1.0 + end if + + this%configurationOverlapMatrix%values(sysI,sysII)=this%configurationOverlapMatrix%values(sysI,sysII)*overlapDeterminant%values(speciesID)**particlesPerOrbital + + + end do + + ! print *, "total overlap", this%configurationOverlapMatrix%values(sysI,sysII) + + !!Skip the rest of the evaluation if the overlap is smaller than the threshold + if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. & + abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) return + + !!Point charge-Point charge repulsion + this%configurationHamiltonianMatrix%values(sysI,sysII)=MolecularSystem_getPointChargesEnergy(this%molecularSystems(sysI))*& + this%configurationOverlapMatrix%values(sysI,sysII) + ! print *, "Point charge-Point charge repulsion", MolecularSystem_getPointChargesEnergy() + + !!Compute hcore if overlap is significant + do speciesID = 1, this%molecularSystems(sysI)%numberOfQuantumSpecies + + numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) + particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem) + + call Matrix_constructor(auxKineticMatrix(speciesID),& + int(numberOfContractions,8),int(numberOfContractions,8),0.0_8) + call Matrix_constructor(auxAttractionMatrix(speciesID),& + int(numberOfContractions,8),int(numberOfContractions,8),0.0_8) + call Matrix_constructor(auxExternalPotMatrix(speciesID),& + int(numberOfContractions,8),int(numberOfContractions,8),0.0_8) + + call DirectIntegralManager_getKineticIntegrals(mergedMolecularSystem,speciesID,auxKineticMatrix(speciesID)) + call DirectIntegralManager_getAttractionIntegrals(mergedMolecularSystem,speciesID,auxAttractionMatrix(speciesID)) + if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & + call DirectIntegralManager_getExternalPotentialIntegrals(mergedMolecularSystem,speciesID,auxExternalPotMatrix(speciesID)) + + !! Incluiding mass effect + if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then + auxKineticMatrix(speciesID)%values = & + auxKineticMatrix(speciesID)%values * & + ( 1.0_8/MolecularSystem_getMass( speciesID,this%molecularSystems(sysI) ) -1.0_8 / MolecularSystem_getTotalMass(this%molecularSystems(sysI)) ) + else + auxKineticMatrix(speciesID)%values = & + auxKineticMatrix(speciesID)%values / & + MolecularSystem_getMass( speciesID,this%molecularSystems(sysI) ) + end if + + !! Including charge + auxAttractionMatrix(speciesID)%values=auxAttractionMatrix(speciesID)%values*(-MolecularSystem_getCharge(speciesID,this%molecularSystems(sysI))) + + call Matrix_constructor(molecularKineticMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) + call Matrix_constructor(molecularAttractionMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) + call Matrix_constructor(molecularExternalMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) + + !!Test + ! print *, "auxKineticMatrix", speciesID + ! call Matrix_show(auxKineticMatrix(speciesID)) + ! print *, "auxAttractionMatrix", speciesID + ! call Matrix_show(auxAttractionMatrix(speciesID)) + + do mu=1, numberOfContractions !sysI + if(sysIbasisList(speciesID)%values(mu) .eq. 0) cycle + do nu=1, numberOfContractions !sysII + if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle + do a=1, occupationNumber !sysI + do b=occupationNumber+1, 2*occupationNumber + bb=b-occupationNumber + + ! print *, "hcore", a, b, mu, nu, mergedCoefficients(speciesID)%values(mu,a), mergedCoefficients(speciesID)%values(nu,b), & + ! auxKineticMatrix%values(mu,nu)/MolecularSystem_getMass(speciesID)+& + ! auxAttractionMatrix%values(mu,nu)*(-MolecularSystem_getCharge(speciesID)) + + molecularKineticMatrix(speciesID)%values(a,bb)=molecularKineticMatrix(speciesID)%values(a,bb)+& + mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*& + auxKineticMatrix(speciesID)%values(mu,nu) + + molecularAttractionMatrix(speciesID)%values(a,bb)=molecularAttractionMatrix(speciesID)%values(a,bb)+& + mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*& + auxAttractionMatrix(speciesID)%values(mu,nu) + + if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & + molecularExternalMatrix(speciesID)%values(a,bb)=molecularExternalMatrix(speciesID)%values(a,bb)+& + mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*& + auxExternalPotMatrix(speciesID)%values(mu,nu) + end do + end do + end do + end do + molecularKineticMatrix(speciesID)%values=particlesPerOrbital*molecularKineticMatrix(speciesID)%values + molecularAttractionMatrix(speciesID)%values=particlesPerOrbital*molecularAttractionMatrix(speciesID)%values + molecularExternalMatrix(speciesID)%values=particlesPerOrbital*molecularExternalMatrix(speciesID)%values + !!End test + end do + + !!One Particle Terms + do speciesID=1, this%molecularSystems(sysI)%numberOfQuantumSpecies + oneParticleKineticEnergy=0.0 + oneParticleAttractionEnergy=0.0 + oneParticleExternalEnergy=0.0 + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) + do a=1, occupationNumber !sysI + do b=1, occupationNumber !sysII + oneParticleKineticEnergy=oneParticleKineticEnergy+ molecularKineticMatrix(speciesID)%values(a,b)*& + inverseOverlapMatrices(speciesID)%values(b,a) + oneParticleAttractionEnergy=oneParticleAttractionEnergy+ molecularAttractionMatrix(speciesID)%values(a,b)*& + inverseOverlapMatrices(speciesID)%values(b,a) + oneParticleExternalEnergy=oneParticleExternalEnergy+ molecularExternalMatrix(speciesID)%values(a,b)*& + inverseOverlapMatrices(speciesID)%values(b,a) + end do + end do + this%configurationKineticMatrix(speciesID)%values(sysI,sysII)=oneParticleKineticEnergy*this%configurationOverlapMatrix%values(sysI,sysII) + this%configurationPuntualMatrix(speciesID)%values(sysI,sysII)=oneParticleAttractionEnergy*this%configurationOverlapMatrix%values(sysI,sysII) + this%configurationExternalMatrix(speciesID)%values(sysI,sysII)=oneParticleExternalEnergy*this%configurationOverlapMatrix%values(sysI,sysII) + + this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+& + (oneParticleKineticEnergy+oneParticleAttractionEnergy+oneParticleExternalEnergy)*this%configurationOverlapMatrix%values(sysI,sysII) + ! print *, "sysI, sysII", sysI, sysII, "oneParticleEnergy for species", speciesID, oneParticleEnergy + end do + + deallocate(auxOverlapMatrix, auxKineticMatrix, auxAttractionMatrix, auxExternalPotMatrix, & + molecularKineticMatrix, molecularAttractionMatrix, molecularExternalMatrix) + + end subroutine NOCIMatrices_computeOverlapAndHCoreElements + !> + !! @brief Computes the two particles contributions to the non diagonal elements of the hamiltonian matrix + !! + !! @param this, sysI,sysII: system indexes, inverseOverlapMatrices, mergedCoefficients are required to evaluate the elements + !< + subroutine NOCIMatrices_twoParticlesContributions(this,sysI,sysII,mergedMolecularSystem,inverseOverlapMatrices,mergedCoefficients,Libint2LocalInstance) + implicit none + type(NonOrthogonalCI) :: this + integer :: sysI, sysII + type(MolecularSystem) :: mergedMolecularSystem + type(Matrix) :: inverseOverlapMatrices(*) + type(Matrix) :: mergedCoefficients(*) + type(Libint2Interface) :: Libint2LocalInstance(*) + + type(matrix), allocatable :: fourCenterIntegrals(:,:) + type(imatrix), allocatable :: twoIndexArray(:),fourIndexArray(:) + integer :: numberOfContractions,occupationNumber,particlesPerOrbital + integer :: otherNumberOfContractions,otherOccupationNumber,otherParticlesPerOrbital + integer :: ssize1, auxIndex, auxIndex1 + integer :: a,b,bb,c,d,dd,i,j + real(8) :: hartreeEnergy, exchangeEnergy + + allocate(fourCenterIntegrals(mergedMolecularSystem%numberOfQuantumSpecies,mergedMolecularSystem%numberOfQuantumSpecies), & + twoIndexArray(mergedMolecularSystem%numberOfQuantumSpecies), & + fourIndexArray(mergedMolecularSystem%numberOfQuantumSpecies)) + + !!Fill indexes arrays + do i=1, mergedMolecularSystem%numberOfQuantumSpecies + ! print *, "reading integrals species", i + numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem) + occupationNumber=MolecularSystem_getOcupationNumber(i,mergedMolecularSystem) + !!Two particle integrals indexes + call Matrix_constructorInteger(twoIndexArray(i), & + int(max(numberOfContractions,occupationNumber),8), & + int(max(numberOfContractions,occupationNumber),8), 0 ) + + c = 0 + do a=1,max(numberOfContractions,occupationNumber) + do b=a, max(numberOfContractions,occupationNumber) + c = c + 1 + twoIndexArray(i)%values(a,b) = c !IndexMap_tensorR2ToVectorC( a, b, numberOfContractions ) + twoIndexArray(i)%values(b,a) = twoIndexArray(i)%values(a,b) + end do + end do + + ssize1 = max(numberOfContractions,occupationNumber) + ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2 + + call Matrix_constructorInteger(fourIndexArray(i), int( ssize1,8), int( ssize1,8) , 0 ) + + c = 0 + do a = 1, ssize1 + do b = a, ssize1 + c = c + 1 + fourIndexArray(i)%values(a,b) = c! IndexMap_tensorR2ToVectorC( a, b, numberOfContractions ) + fourIndexArray(i)%values(b,a) = fourIndexArray(i)%values(a,b) + end do + end do + end do + + !! Calculate two- particle integrals + call NOCIMatrices_transformIntegralsMemory(mergedMolecularSystem, mergedCoefficients, & + twoIndexArray, fourIndexArray, fourCenterIntegrals, Libint2LocalInstance) + +!!!Add charges + if ( .not. InterPotential_instance%isInstanced) then + do i=1, mergedMolecularSystem%numberOfQuantumSpecies + fourCenterIntegrals(i,i)%values = & + fourCenterIntegrals(i,i)%values * mergedMolecularSystem%species(i)%charge**2.0 + + do j = i+1 , mergedMolecularSystem%numberOfQuantumSpecies + fourCenterIntegrals(i,j)%values = & + fourCenterIntegrals(i,j)%values * mergedMolecularSystem%species(i)%charge * mergedMolecularSystem%species(j)%charge + end do + end do + end if +!!!Compute Hamiltonian Matrix element between displaced geometries + + ! !!Point charge-Point charge repulsion + ! !!One Particle Terms + ! !!Have already been computed + + !!Same species repulsion + do i=1, mergedMolecularSystem%numberOfQuantumSpecies + numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem) + occupationNumber=MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI)) + particlesPerOrbital=MolecularSystem_getEta(i,mergedMolecularSystem) + hartreeEnergy=0.0 + exchangeEnergy=0.0 + do a=1,occupationNumber !sysI + do b=occupationNumber+1, 2*occupationNumber !sysII + bb=b-occupationNumber + do c=1, occupationNumber !sysI + do d=occupationNumber+1, 2*occupationNumber !sysII + dd=d-occupationNumber + auxIndex = fourIndexArray(i)%values(twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d) ) + hartreeEnergy=hartreeEnergy+0.5*fourCenterIntegrals(i,i)%values(auxIndex, 1)*& + inverseOverlapMatrices(i)%values(bb,a)*inverseOverlapMatrices(i)%values(dd,c)*particlesPerOrbital**2 !coulomb + exchangeEnergy=exchangeEnergy-0.5*fourCenterIntegrals(i,i)%values(auxIndex, 1)*& + inverseOverlapMatrices(i)%values(dd,a)*inverseOverlapMatrices(i)%values(bb,c)*particlesPerOrbital !exchange + ! print *, a, b, c, d, twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d), fourIndexArray(i)%values( & + ! twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d)), + end do + end do + end do + end do + this%configurationHartreeMatrix(i,i)%values(sysI,sysII)=hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII) + this%configurationExchangeMatrix(i)%values(sysI,sysII)=exchangeEnergy*this%configurationOverlapMatrix%values(sysI,sysII) + this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+& + (hartreeEnergy+exchangeEnergy)*this%configurationOverlapMatrix%values(sysI,sysII) + ! print *, "same species interactionEnergy for species", i, hartreeEnergy, exchangeEnergy + end do + + !!Interspecies repulsion + do i=1, mergedMolecularSystem%numberOfQuantumSpecies-1 + numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem) + occupationNumber=MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI)) + particlesPerOrbital=MolecularSystem_getEta(i,mergedMolecularSystem) + do j=i+1, mergedMolecularSystem%numberOfQuantumSpecies + otherNumberOfContractions=MolecularSystem_getTotalNumberOfContractions(j,mergedMolecularSystem) + otherOccupationNumber=MolecularSystem_getOcupationNumber(j,mergedMolecularSystem) + otherParticlesPerOrbital=MolecularSystem_getEta(j,mergedMolecularSystem) + hartreeEnergy=0.0 + ssize1 = max(otherNumberOfContractions,otherOccupationNumber) + ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2 + otherOccupationNumber=MolecularSystem_getOcupationNumber(j,this%molecularSystems(sysI)) + do a=1, occupationNumber !sysI + do b=occupationNumber+1, 2*occupationNumber !sysII + bb=b-MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI)) + auxIndex1 = ssize1 * (twoIndexArray(i)%values(a,b) - 1 ) + do c=1, otherOccupationNumber !sysI + do d=otherOccupationNumber+1,2*otherOccupationNumber !sysII + dd=d-otherOccupationNumber + auxIndex = auxIndex1 + twoIndexArray(j)%values(c,d) + hartreeEnergy=hartreeEnergy+fourCenterIntegrals(i,j)%values(auxIndex, 1)*& + inverseOverlapMatrices(i)%values(bb,a)*inverseOverlapMatrices(j)%values(dd,c)*& + particlesPerOrbital*otherParticlesPerOrbital + ! print *, a, b, c, d, fourCenterIntegrals(i,j)%values(auxIndex, 1), inverseOverlapMatrices(i)%values(bb,a), inverseOverlapMatrices(j)%values(dd,c) + end do + end do + end do + end do + this%configurationHartreeMatrix(i,j)%values(sysI,sysII)=hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII) + this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+& + hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII) + ! print *, "interspecies hartreeEnergy for species", i, j, hartreeEnergy + end do + end do + + deallocate(fourCenterIntegrals,twoIndexArray,fourIndexArray) + + end subroutine NOCIMatrices_twoParticlesContributions + + !> + !! @brief Solves the NOCI matrix equation + !! + !! @param this + !< + subroutine NOCIMatrices_diagonalize(this) + implicit none + type(NonOrthogonalCI) :: this + type(Matrix) :: transformationMatrix,transformedHamiltonianMatrix,eigenVectors,auxMatrix + type(Vector) :: eigenValues + integer :: removedStates + integer :: speciesID,otherSpeciesID,sysI,sysII,state,i,j + real(8) :: auxEnergy + real(8) :: timeA + + !$ timeA = omp_get_wtime() + + call Matrix_constructor(this%configurationCoefficients, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) + call Vector_constructor(this%statesEigenvalues, this%numberOfDisplacedSystems, 0.0_8) + + ! print *, "non orthogonal CI overlap Matrix " + ! call Matrix_show(this%configurationOverlapMatrix) + + ! print *, "non orthogonal CI Hamiltionian Matrix " + ! call Matrix_show(this%configurationHamiltonianMatrix) + ! + print *, "" + print *, "Transforming non orthogonal CI Hamiltonian Matrix..." + + call Matrix_constructor(transformationMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8) , 0.0_8) + call Matrix_constructor(transformedHamiltonianMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8) , 0.0_8) + + call Vector_constructor( eigenValues, this%numberOfDisplacedSystems ) + call Matrix_constructor( eigenVectors,int(this%numberOfDisplacedSystems,8),int(this%numberOfDisplacedSystems,8)) + + !!**************************************************************** + !! diagonaliza la matriz de overlap obteniendo una matriz unitaria + !! + call Matrix_eigen( this%configurationOverlapMatrix, eigenValues, eigenVectors, SYMMETRIC ) + + ! print *,"Overlap eigenvectors " + ! call Matrix_show( eigenVectors ) + + ! print *,"Overlap eigenvalues " + ! call Vector_show( eigenValues ) + + !! Remove states from configurations with linear dependencies + do i = 1 , this%numberOfDisplacedSystems + do j = 1 , this%numberOfDisplacedSystems + if ( abs(eigenValues%values(j)) >= CONTROL_instance%OVERLAP_EIGEN_THRESHOLD ) then + transformationMatrix%values(i,j) = & + eigenVectors%values(i,j)/sqrt( eigenvalues%values(j) ) + else + transformationMatrix%values(i,j) = 0 + end if + end do + end do + + removedStates=0 + do i = 1 , this%numberOfDisplacedSystems + if ( abs(eigenValues%values(i)) .lt. CONTROL_instance%OVERLAP_EIGEN_THRESHOLD ) & + removedStates=removedStates+1 + end do + + if (removedStates .gt. 0) & + write(*,"(A,I5,A,ES9.3)") "Removed ", removedStates , & + " states from the CI transformation Matrix with overlap eigen threshold of ", CONTROL_instance%OVERLAP_EIGEN_THRESHOLD + + + !!Ortogonalizacion simetrica + transformationMatrix%values = & + matmul(transformationMatrix%values, transpose(eigenVectors%values)) + + ! print *,"Matriz de transformacion " + ! call Matrix_show( transformationMatrix ) + + !!********************************************************************************************** + !! Transform configuration hamiltonian matrix + !! + transformedHamiltonianMatrix%values = & + matmul( matmul( transpose( transformationMatrix%values ) , & + this%configurationHamiltonianMatrix%values), transformationMatrix%values ) + + ! print *,"transformed Hamiltonian Matrix " + ! call Matrix_show( this%configurationHamiltonianMatrix ) + + print *, "Diagonalizing non orthogonal CI Hamiltonian Matrix..." + !! Calcula valores y vectores propios de matriz de CI transformada. + call Matrix_eigen( transformedHamiltonianMatrix, this%statesEigenvalues, this%configurationCoefficients, SYMMETRIC ) + + !! Calcula los vectores propios para matriz de CI + this%configurationCoefficients%values = matmul( transformationMatrix%values, this%configurationCoefficients%values ) + + ! print *,"non orthogonal CI eigenvalues " + ! call Vector_show( this%statesEigenvalues ) + + ! print *,"configuration Coefficients" + ! call Matrix_show( this%configurationCoefficients ) + + write(*,"(A)") "" + write(*,"(A)") " MIXED HARTREE-FOCK CALCULATION" + write(*,"(A)") " NON ORTHOGONAL CONFIGURATION INTERACTION" + write(*,"(A)") " EIGENVALUES AND EIGENVECTORS: " + write(*,"(A)") "=========================================" + write(*,"(A)") "" + do state = 1, min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems) + write (*,"(A)") "" + write (*,"(T9,A17,I3,A10, F25.12)") "STATE: ", state, " ENERGY = ", this%statesEigenvalues%values(state) + write (*,"(A38)") "Components: " + write(*,"(A38,F25.12)") " Point charges energy = ", MolecularSystem_getPointChargesEnergy(this%molecularSystems(1)) + do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergy=0 + do sysI=1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + this%configurationCoefficients%values(sysI,state)**2*& + this%configurationKineticMatrix(speciesID)%values(sysI,sysI) + do sysII=sysI+1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + 2.0_8*this%configurationCoefficients%values(sysI,state)*& + this%configurationCoefficients%values(sysII,state)*& + this%configurationKineticMatrix(speciesID)%values(sysI,sysII) + end do + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + " Kinetic energy = ", auxEnergy + end do + do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergy=0 + do sysI=1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + this%configurationCoefficients%values(sysI,state)**2*& + this%configurationPuntualMatrix(speciesID)%values(sysI,sysI) + do sysII=sysI+1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + 2.0_8*this%configurationCoefficients%values(sysI,state)*& + this%configurationCoefficients%values(sysII,state)*& + this%configurationPuntualMatrix(speciesID)%values(sysI,sysII) + end do + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + " Puntual energy = ", auxEnergy + end do + if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then + do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergy=0 + do sysI=1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + this%configurationCoefficients%values(sysI,state)**2*& + this%configurationExternalMatrix(speciesID)%values(sysI,sysI) + do sysII=sysI+1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + 2.0_8*this%configurationCoefficients%values(sysI,state)*& + this%configurationCoefficients%values(sysII,state)*& + this%configurationExternalMatrix(speciesID)%values(sysI,sysII) + end do + end do + write(*,"(A38,F25.12)") trim(this%molecularSystems(1)%species(speciesID)%name ) // & + " External energy = ", auxEnergy + end do + end if + do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergy=0 + do sysI=1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + this%configurationCoefficients%values(sysI,state)**2*& + this%configurationExchangeMatrix(speciesID)%values(sysI,sysI) + do sysII=sysI+1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + 2.0_8*this%configurationCoefficients%values(sysI,state)*& + this%configurationCoefficients%values(sysII,state)*& + this%configurationExchangeMatrix(speciesID)%values(sysI,sysII) + end do + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + " Exchange energy = ", auxEnergy + + do otherSpeciesID=speciesID, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergy=0 + do sysI=1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + this%configurationCoefficients%values(sysI,state)**2*& + this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysI) + do sysII=sysI+1, this%numberOfDisplacedSystems + auxEnergy= auxEnergy+ & + 2.0_8*this%configurationCoefficients%values(sysI,state)*& + this%configurationCoefficients%values(sysII,state)*& + this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysII) + end do + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + "/"//trim( this%molecularSystems(1)%species(otherSpeciesID)%name ) // & + " Hartree energy = ", auxEnergy + end do + end do + end do + write(*,"(A)") "" + + call Matrix_constructor(auxMatrix,int(this%numberOfDisplacedSystems,8),& + int(CONTROL_instance%CI_STATES_TO_PRINT,8),0.0_8) + do i=1, this%numberOfDisplacedSystems + do j=1, CONTROL_instance%CI_STATES_TO_PRINT + auxMatrix%values(i,j)=this%configurationCoefficients%values(i,j) + end do + end do + + + write(*,"(I5,A)") CONTROL_instance%CI_STATES_TO_PRINT, " LOWEST LYING STATES CONFIGURATION COEFFICIENTS" + write(*,"(A)") "" + call Matrix_show(auxMatrix , & + rowkeys = this%systemLabels, & + columnkeys = string_convertvectorofrealstostring( this%statesEigenvalues ),& + flags=WITH_BOTH_KEYS) + write(*,"(A)") "" + + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for NOCI matrix diagonalization : ", omp_get_wtime() - timeA ," (s)" + + end subroutine NOCIMatrices_diagonalize + + !> + !! @brief Calculate and Transform the four center integrals in one sweep without writing anything to disk + !! + !! @param molecularSystem, HFCoefficients: species array with the atomic coefficients, fourCenterIntegrals: species*species array to save integrals + !< + subroutine NOCIMatrices_transformIntegralsMemory(mergedMolecularSystem, mergedCoefficients, twoIndexArray, fourIndexArray, fourCenterIntegrals, Libint2LocalInstance) + implicit none + type(MolecularSystem), intent(in) :: mergedMolecularSystem + type(Matrix), intent(in) :: mergedCoefficients(mergedMolecularSystem%numberOfQuantumSpecies) + type(iMatrix), intent(in) :: twoIndexArray(mergedMolecularSystem%numberOfQuantumSpecies) + type(iMatrix), intent(in) :: fourIndexArray(mergedMolecularSystem%numberOfQuantumSpecies) + type(Matrix), intent(out) :: fourCenterIntegrals(mergedMolecularSystem%numberOfQuantumSpecies,mergedMolecularSystem%numberOfQuantumSpecies) + type(Libint2Interface) :: Libint2LocalInstance(mergedMolecularSystem%numberOfQuantumSpecies) + + real(8), allocatable, target :: ints(:,:,:,:) + real(8), allocatable :: tempA(:,:,:) + real(8), allocatable :: tempB(:,:) + real(8), allocatable :: tempC(:) + + integer :: p, p_l, p_u + integer :: q, q_l, q_u + integer :: r, r_l, r_u + integer :: s, s_l, s_u + integer :: ssize, ssizeb, auxIndex, auxIndexA + integer :: n,u, mu,nu, lambda,sigma + real(8) :: auxTransformedTwoParticlesIntegral + + type(Matrix) :: densityMatrix + integer :: speciesID, otherSpeciesID + integer :: numberOfOrbitals, otherNumberOfOrbitals + integer(8) :: numberOfIntegrals + + do speciesID=1, mergedMolecularSystem%numberOfQuantumSpecies + numberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), & + MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )) + numberOfIntegrals= int( ( ( numberOfOrbitals * ( numberOfOrbitals + 1.0_8 ) / 4.0_8 ) * & + ( ( numberOfOrbitals * ( numberOfOrbitals + 1.0_8) / 2.0_8 ) + 1.0_8) ), 8 ) + + call Matrix_constructor( fourCenterIntegrals(speciesID,speciesID), numberOfIntegrals, 1_8, 0.0_8 ) + + p_l = 1 + p_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2 + q_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1 + q_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem ) + + r_l = 1 + r_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2 + s_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1 + s_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem ) + + ssize = MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) + call Matrix_constructor( densityMatrix, int(ssize,8), int(ssize,8), 1.0_8 ) !Test filling with values later + + ! Prepare matrix + if(allocated(ints)) deallocate(ints) + if(allocated(tempA)) deallocate (tempA) + if(allocated(tempB)) deallocate (tempB) + if(allocated(tempC)) deallocate (tempC) + allocate (ints ( ssize, ssize, ssize, ssize ), & + tempA ( ssize, ssize, ssize ), & + tempB ( ssize, ssize ), & + tempC ( ssize )) + ints = 0 + + call DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(& + speciesID, & + densityMatrix, & + ints, mergedMolecularSystem, Libint2LocalInstance(speciesID) ) + + + do p = p_l, p_u + tempA = 0 + n = p + + ! !First quarter transformation happens here + do mu = 1, ssize + !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle + tempA(:,:,:) = tempA(:,:,:) + mergedCoefficients(speciesID)%values( mu, p )* & + ints(:,:,:,mu) + end do + + do q = p, q_u + u = q + tempB = 0 + + if ( q < q_l ) cycle + !! second quarter + do nu = 1, ssize + !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle + tempB(:,:) = tempB(:,:) + mergedCoefficients(speciesID)%values( nu, q )* & + tempA(:,:,nu) + end do + + do r = n, r_u + + tempC = 0 + + !Why?? + !if ( r < this%r_l ) cycle + + !! third quarter + do lambda = 1, ssize + !if ( abs(coefficientsOfAtomicOrbitals%values( lambda, r )) < 1E-10 ) cycle + tempC(:) = tempC(:) + mergedCoefficients(speciesID)%values( lambda, r )* & + tempB(:,lambda) + end do + + do s = u, s_u + auxTransformedTwoParticlesIntegral = 0 + + if ( s < s_l ) cycle + !! fourth quarter + do sigma = 1, ssize + auxTransformedTwoParticlesIntegral = auxTransformedTwoParticlesIntegral + & + mergedCoefficients(speciesID)%values( sigma, s )* & + tempC(sigma) + + end do + auxIndex = fourIndexArray(speciesID)%values(twoIndexArray(speciesID)%values(p,q), twoIndexArray(speciesID)%values(r,s) ) + fourCenterIntegrals(speciesID,speciesID)%values(auxIndex, 1) = auxTransformedTwoParticlesIntegral + ! print *, speciesID, p, q, r, s, auxIndex, auxTransformedTwoParticlesIntegral + end do + u = r + 1 + end do + end do + end do + end do + + do speciesID=1, mergedMolecularSystem%numberOfQuantumSpecies-1 + do otherSpeciesID=speciesID+1, mergedMolecularSystem%numberOfQuantumSpecies + + numberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), & + MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem)) + otherNumberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,mergedMolecularSystem), & + MolecularSystem_getOcupationNumber(otherSpeciesID,mergedMolecularSystem)) + + numberOfIntegrals = int((numberOfOrbitals*((numberOfOrbitals+1.0_8)/2.0_8)) * & + (otherNumberOfOrbitals*(otherNumberOfOrbitals+1.0_8)/2.0_8),8) + + call Matrix_constructor( fourCenterIntegrals(speciesID,otherSpeciesID), numberOfIntegrals, 1_8, 0.0_8 ) + + ssize = MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) + ssizeb = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,mergedMolecularSystem) + + call Matrix_constructor( densityMatrix, int(ssize,8), int(ssize,8), 1.0_8 ) !Test filling with values later + + p_l = 1 + p_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2 + q_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1 + q_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem ) + + r_l = 1 + r_u = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )/2 + s_l = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )/2+1 + s_u = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem ) + + ! Prepare matrix + ! Prepare matrix + if(allocated(ints)) deallocate(ints) + if(allocated(tempA)) deallocate (tempA) + if(allocated(tempB)) deallocate (tempB) + if(allocated(tempC)) deallocate (tempC) + allocate (ints ( ssizeb, ssizeb, ssize, ssize ), & + tempA ( ssizeb, ssizeb, ssize ), & + tempB ( ssizeb, ssizeb ), & + tempC ( ssizeb )) + ints = 0 + + call DirectIntegralManager_getDirectInterRepulsionIntegralsAll(& + speciesID, otherSpeciesID, & + densityMatrix, & + ints, mergedMolecularSystem, Libint2LocalInstance(speciesID), Libint2LocalInstance(otherSpeciesID) ) + + ! do mu = 1, ssize + ! do nu = 1, ssize + ! do lambda = 1, ssizeb + ! do sigma = 1, ssizeb + ! print *, mu, nu, lambda, sigma, ints(lambda,sigma,nu,mu) + ! end do + ! end do + ! end do + ! end do + do p = p_l, p_u + tempA = 0 + !First quarter transformation happens here + do mu = 1, ssize + !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle + tempA(:,:,:) = tempA(:,:,:) + mergedCoefficients(speciesID)%values( mu, p )* & + ints(:,:,:,mu) + end do + + do q = q_l, q_u + tempB = 0 + + ! if ( q < p ) cycle + !! second quarter + do nu = 1, ssize + !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle + + tempB(:,:) = tempB(:,:) + mergedCoefficients(speciesID)%values( nu, q )* & + tempA(:,:,nu) + end do + + auxIndexA = (otherNumberOfOrbitals*(otherNumberOfOrbitals+1))/2 * (twoIndexArray(speciesID)%values(p,q) - 1 ) + + do r = r_l , r_u + + tempC = 0 + + !! third quarter + do lambda = 1, ssizeb + + tempC(:) = tempC(:) + mergedCoefficients(otherSpeciesID)%values( lambda, r )* & + tempB(:,lambda) + + end do + do s = s_l, s_u + auxTransformedTwoParticlesIntegral = 0 + + ! if ( s < r ) cycle + !! fourth quarter + do sigma = 1, ssizeb + auxTransformedTwoParticlesIntegral = auxTransformedTwoParticlesIntegral + & + mergedCoefficients(otherSpeciesID)%values( sigma, s )* & + tempC(sigma) + + end do + + auxIndex = auxIndexA + twoIndexArray(otherSpeciesID)%values(r,s) + + fourCenterIntegrals(speciesID,otherSpeciesID)%values(auxIndex, 1) = auxTransformedTwoParticlesIntegral + + ! print *, speciesID,otherSpeciesID, p, q, r, s, auxIndex, auxTransformedTwoParticlesIntegral + + end do + end do + end do + end do + + end do + end do + + ! call DirectIntegralManager_destructor(Libint2LocalInstance) + + end subroutine NOCIMatrices_transformIntegralsMemory + +end module NOCIMatrices_ + diff --git a/src/NOCI/NOCIRotFormula.f90 b/src/NOCI/NOCIRotFormula.f90 new file mode 100644 index 00000000..baca5776 --- /dev/null +++ b/src/NOCI/NOCIRotFormula.f90 @@ -0,0 +1,396 @@ +!****************************************************************************** +!! This code is part of LOWDIN Quantum chemistry package +!! +!! this program has been developed under direction of: +!! +!! UNIVERSIDAD NACIONAL DE COLOMBIA" +!! PROF. ANDRES REYES GROUP" +!! http://www.qcc.unal.edu.co" +!! +!! UNIVERSIDAD DE GUADALAJARA" +!! PROF. ROBERTO FLORES GROUP" +!! http://www.cucei.udg.mx/~robertof" +!! +!! AUTHORS +!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA +!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! CONTRIBUTORS +!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA +!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO +!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! +!! Todos los derechos reservados, 2011 +!! +!!****************************************************************************** + +module NOCIRotFormula_ + use NOCIBuild_ + use MolecularSystem_ + use Matrix_ + use Vector_ + use Math_ + use DirectIntegralManager_ + use Libint2Interface_ + use omp_lib + implicit none + + !> + !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727 + !! + !! @author Felix + !! + !! Creation data : 02-22 + !! + !! History change: + !! + !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co ) + !! -# Creation of the module. + !! + !< + + public :: & + NOCIRotFormula_compute + + private + +contains + + !> + !! @brief Computes the rotational CI energies from previously computed overlap and hamiltonian non orthogonal CI elements + !! + !! @param this + !< + subroutine NOCIRotFormula_compute(this) + implicit none + type(NonOrthogonalCI) :: this + type(Vector) :: angles, signs + type(Matrix) :: weights + integer :: i,state,sysI,npoints,nstates,speciesID,otherSpeciesID + real(8) :: overlapIntegral, auxEnergyIntegral, auxEnergy, e0, sc + + ! real(8) :: timeMerging, timePrescreen, timeOverlap, timeTwoIntegrals + ! real(8) :: timeA + ! real(8) :: timeB + + if((this%transformationType).ne."ROTATION_AROUND_Z") then + print *, "The Rotational Configuration Interaction formula for the rotational states energy is only available for molecular systems rotated around the z-axis" + print *, "Please set rotationalScanGridAroundZ=N in the input and restart the calculation" + end if + + nstates=min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems) + if(nstates .lt. 2) nstates=2 + npoints=this%numberOfIndividualTransformations + + call Vector_constructor(angles,npoints,0.0_8) + call Matrix_constructor(weights,int(npoints,8),int(nstates,8),1.0_8) + call Vector_constructor(signs,this%numberOfDisplacedSystems,1.0_8) + call Vector_constructor(this%statesEigenvalues, this%numberOfDisplacedSystems, 0.0_8) + + do i=1,npoints + angles%values(i)=(i-1)*CONTROL_instance%ROTATION_AROUND_Z_STEP*Math_PI/180 + end do + + if(this%molecularSystems(1)%numberOfPointCharges .gt. 1) then + print *, "Using 1D formula: cos(m gamma) as weights, with trapezoid integration rule" + weights%values(1,:)=0.5_8 + do state=1,nstates + weights%values(2:npoints,state)=cos((state-1)*angles%values(2:npoints)) + end do + weights%values(npoints,:)=0.5_8*weights%values(npoints,:) + else + print *, "Using 2D formula: sin(gamma) P_l(cos(gamma)) as weights, with trapezoid integration rule" + ! weights%values(1,:)=0.5_8 + call Math_p_polynomial_value (npoints , nstates-1, cos(angles%values), weights%values) + call flush() + do i=1,npoints + weights%values(i,:)=sin(angles%values(i))*weights%values(i,:) + end do + weights%values(npoints,:)=0.5_8*weights%values(npoints,:) + end if + + write(*,"(A)") "" + write(*,"(A)") " MIXED HARTREE-FOCK CALCULATION" + write(*,"(A)") " NON ORTHOGONAL CONFIGURATION INTERACTION" + write(*,"(A)") " ROTATIONAL CI FORMULA UNSCALED ENERGIES: " + write(*,"(A)") "=========================================" + write(*,"(A)") "" + + do state=1,nstates + overlapIntegral=0 + + do sysI=1,this%numberOfDisplacedSystems + signs%values(sysI)=this%configurationOverlapMatrix%values(1,sysI)/abs(this%configurationOverlapMatrix%values(1,sysI)) + overlapIntegral=overlapIntegral+signs%values(sysI)*this%configurationOverlapMatrix%values(1,sysI)*weights%values(sysI,state) + end do + + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationHamiltonianMatrix%values(1,sysI)*weights%values(sysI,state) + end do + this%statesEigenvalues%values(state)=auxEnergyIntegral/overlapIntegral + ! print *, "state", state, "overlapIntegral", overlapIntegral, "energyIntegral", auxEnergyIntegral, "energy", auxEnergyIntegral/overlapIntegral + write (*,"(A)") "" + write (*,"(T9,A17,I3,A10, F25.12)") "STATE: ", state, " ENERGY = ", this%statesEigenvalues%values(state) + + write (*,"(A38)") "Components: " + write(*,"(A38,F25.12)") " Point charges energy = ", MolecularSystem_getPointChargesEnergy(this%molecularSystems(1)) + + do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationKineticMatrix(speciesID)%values(1,sysI)*weights%values(sysI,state) + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + " Kinetic energy = ", auxEnergyIntegral/overlapIntegral + end do + + do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationPuntualMatrix(speciesID)%values(1,sysI)*weights%values(sysI,state) + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + " Puntual energy = ", auxEnergyIntegral/overlapIntegral + end do + + if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then + do speciesID = 1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationExternalMatrix(speciesID)%values(1,sysI)*weights%values(sysI,state) + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + " External energy = ", auxEnergyIntegral/overlapIntegral + end do + end if + + do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationHartreeMatrix(speciesID,speciesID)%values(1,sysI)*weights%values(sysI,state) + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + "/"//trim( this%molecularSystems(1)%species(speciesID)%name ) // & + " Hartree energy = ", auxEnergyIntegral/overlapIntegral + end do + + do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationExchangeMatrix(speciesID)%values(1,sysI)*weights%values(sysI,state) + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + " Exchange energy = ", auxEnergyIntegral/overlapIntegral + + end do + + do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies-1 + do otherSpeciesID=speciesID+1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(1,sysI)*weights%values(sysI,state) + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + "/"//trim( this%molecularSystems(1)%species(otherSpeciesID)%name ) // & + " Hartree energy = ", auxEnergyIntegral/overlapIntegral + end do + end do + if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then + do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies + do otherSpeciesID=speciesID, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(1,sysI)*weights%values(sysI,state) + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + "/"//trim( this%molecularSystems(1)%species(otherSpeciesID)%name ) // & + " DFTcorrelation energy = ", auxEnergyIntegral/overlapIntegral + end do + end do + end if + + write(*,"(A)") "" + + end do + + if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then + write(*,"(A)") "" + write(*,"(A)") " MIXED HARTREE-FOCK CALCULATION" + write(*,"(A)") " NON ORTHOGONAL CONFIGURATION INTERACTION" + write(*,"(A)") " ROTATIONAL CI FORMULA SCALED ENERGIES: " + write(*,"(A)") "=========================================" + write(*,"(A)") "" + + print *, "Using a sigmoid function, e0+(1+e0)exp(-(1-|S|)^4/sc^4), to scale down the interspecies correlation functional energy" + print *, "All the other energy contributions remain equal" + print *, "" + + if(CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0 .ne. 0.0_8 .or. CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC .ne. 0.0_8 ) then + sc=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC + e0=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0 + write (*,'(A63)') "Employing sigmoid parameters provided in the input" + write (*,'(A48,F15.8)') "sc =", sc + write (*,'(A48,F15.8)') "e0 =", e0 + print *, "" + else + call NOCIRotFormula_getScalingParameters(this,sc,e0) + end if + + do state=1,nstates + overlapIntegral=0 + auxEnergy=0 + do sysI=1,this%numberOfDisplacedSystems + overlapIntegral=overlapIntegral+signs%values(sysI)*this%configurationOverlapMatrix%values(1,sysI)*weights%values(sysI,state) + end do + + do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies + do otherSpeciesID=speciesID+1, this%molecularSystems(1)%numberOfQuantumSpecies + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(1,sysI)*weights%values(sysI,state)*& + ((e0+(1-e0)*exp(-(1-abs(this%configurationOverlapMatrix%values(1,sysI)))**4/sc**4))-1) + + end do + write(*,"(A38,F25.12)") trim( this%molecularSystems(1)%species(speciesID)%name ) // & + "/"//trim( this%molecularSystems(1)%species(otherSpeciesID)%name ) // & + " DFTcorrection energy = ", auxEnergyIntegral/overlapIntegral + auxEnergy=auxEnergy+auxEnergyIntegral/overlapIntegral + end do + end do + + auxEnergyIntegral=0 + do sysI=1,this%numberOfDisplacedSystems + auxEnergyIntegral=auxEnergyIntegral+signs%values(sysI)*this%configurationHamiltonianMatrix%values(1,sysI)*weights%values(sysI,state) + end do + write (*,"(T9,A10,I3,A17, F25.12)") "STATE: ", state, "SCALED ENERGY = ", auxEnergyIntegral/overlapIntegral+auxEnergy + write (*,"(A)") "" + end do + + end if + + end subroutine NOCIRotFormula_compute + + !> + !! @brief Get the empirical scaling parameters from the multilinear regression + !! + !! @param this + !< + subroutine NOCIRotFormula_getScalingParameters(this,sc,e0) + implicit none + type(NonOrthogonalCI) :: this + real(8), intent(out) :: sc,e0 + + type(Matrix) :: momentMatrices(1:3), densityMatrix + integer :: i,j,k,speciesID,otherSpeciesID + real(8) :: b(0:6,1:2) !1 for sc, 2 for e0 + real(8) :: x(1:6) + +!Regression parameters +! Intercept +! $x_1$: dim +! $x_2$: DFT $T_p$ +! $x_3$: $\langle r_p \rangle$ +! $x_4$: $-E^c_{ep}$ +! $x_5$: E$_{0\ \mathrm{RoDFT}}-$E$_\mathrm{DFT}$ +! $x_6$: $\Delta E_{0-1 \mathrm{RoDFT}}$ + b(0,1)=0.3881 + b(1,1)=-0.0802 + b(2,1)=17.22 + b(3,1)=0.00948 + b(4,1)=-7.41 + b(5,1)=16.21 + b(6,1)=122.3 + + b(0,2)=-0.6042 + b(1,2)=0.5374 + b(2,2)=-34.29 + b(3,2)=-0.02577 + b(4,2)=37.33 + b(5,2)=-65.85 + b(6,2)=-256.5 + + x(:)=0.0 + + x(1)=2 + if(this%molecularSystems(1)%numberOfPointCharges .gt. 1) x(1)=1 + + do speciesID=1, this%molecularSystems(1)%numberOfQuantumSpecies + !find proton kinetic energy + if(this%molecularSystems(1)%species(speciesID)%mass .ge. 1500_8 .and. this%molecularSystems(1)%species(speciesID)%mass .lt. 2500_8 .and. this%molecularSystems(1)%species(speciesID)%charge .eq. 1.0_8) then + x(2)=this%configurationKineticMatrix(speciesID)%values(1,1) + + call DirectIntegralManager_getMomentIntegrals(this%molecularSystems(1),speciesID,1,momentMatrices(1)) + call DirectIntegralManager_getMomentIntegrals(this%molecularSystems(1),speciesID,2,momentMatrices(2)) + call DirectIntegralManager_getMomentIntegrals(this%molecularSystems(1),speciesID,3,momentMatrices(3)) + + call Matrix_constructor(densityMatrix,int(size( this%HFCoefficients(1,speciesID)%values, DIM = 1),8),int(size( this%HFCoefficients(1,speciesID)%values, DIM = 1),8),0.0_8) + + do i = 1 , size( this%HFCoefficients(1,speciesID)%values, DIM = 1 ) + do j = 1 , size( this%HFCoefficients(1,speciesID)%values, DIM = 1 ) + do k = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1)) + + densityMatrix%values(i,j) = & + densityMatrix%values( i,j ) + & + ( this%HFCoefficients(1,speciesID)%values(i,k) & + * this%HFCoefficients(1,speciesID)%values(j,k) ) + end do + end do + end do + densityMatrix%values = MolecularSystem_getEta(speciesID,this%molecularSystems(1)) * densityMatrix%values + + if(this%molecularSystems(1)%numberOfPointCharges .gt. 1) then + x(3)=sqrt(sum( densityMatrix%values * momentMatrices(1)%values ) **2 +& + sum( densityMatrix%values * momentMatrices(2)%values ) **2) + + else + x(3)=sqrt(sum( densityMatrix%values * momentMatrices(1)%values ) **2 +& + sum( densityMatrix%values * momentMatrices(2)%values ) **2 +& + sum( densityMatrix%values * momentMatrices(3)%values ) **2) + end if + + do otherSpeciesID=1,speciesID-1 + x(4)=x(4)+this%configurationDFTcorrelationMatrix(otherSpeciesID,speciesID)%values(1,1) + end do + do otherSpeciesID=speciesID+1,this%molecularSystems(1)%numberOfQuantumSpecies + x(4)=x(4)+this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(1,1) + end do + x(4)=-x(4) + exit + end if + end do + + x(5)=this%configurationHamiltonianMatrix%values(1,1)-this%statesEigenvalues%values(1) + x(6)=this%statesEigenvalues%values(2)-this%statesEigenvalues%values(1) + + sc=b(0,1) + e0=b(0,2) + + do i=1,6 + sc=sc+b(i,1)*x(i) + e0=e0+b(i,2)*x(i) + end do + + if(sc<1.0E-8) sc=1.0E-8 + if(e0<0.0) e0=0.0 + if(e0>1.0) e0=1.0 + + write (*,'(A63)') "The sigmoid parameters" + write (*,'(A48,F15.8)') "e0 =", e0 + write (*,'(A48,F15.8)') "sc =", sc + write (*,'(A63)') "were obtained from the regression parameters:" + write (*,'(A48,I6)') "rotational dimensions =", int(x(1)) + write (*,'(A48,F15.8)') "proton kinetic energy =", x(2) + write (*,'(A48,F15.8)') "proton rotation radius =", x(3) + write (*,'(A48,F15.8)') "-proton/electron correlation energy =", x(4) + write (*,'(A48,F15.8)') "-Unscaled rotational ground state correction =", x(5) + write (*,'(A48,F15.8)') "Unscaled rotational first transition energy =", x(6) + write (*,'(A63)') "" + + end subroutine NOCIRotFormula_getScalingParameters + +end module NOCIRotFormula_ + diff --git a/src/NOCI/NOCIRunSCF.f90 b/src/NOCI/NOCIRunSCF.f90 new file mode 100644 index 00000000..2742d1d0 --- /dev/null +++ b/src/NOCI/NOCIRunSCF.f90 @@ -0,0 +1,279 @@ +!****************************************************************************** +!! This code is part of LOWDIN Quantum chemistry package +!! +!! this program has been developed under direction of: +!! +!! UNIVERSIDAD NACIONAL DE COLOMBIA" +!! PROF. ANDRES REYES GROUP" +!! http://www.qcc.unal.edu.co" +!! +!! UNIVERSIDAD DE GUADALAJARA" +!! PROF. ROBERTO FLORES GROUP" +!! http://www.cucei.udg.mx/~robertof" +!! +!! AUTHORS +!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA +!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! CONTRIBUTORS +!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA +!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO +!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! +!! Todos los derechos reservados, 2011 +!! +!!****************************************************************************** + +module NOCIRunSCF_ + use NOCIBuild_ + use MolecularSystem_ + use Matrix_ + use Vector_ + use DirectIntegralManager_ + use MultiSCF_ + use WaveFunction_ + use omp_lib + implicit none + + !> + !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727 + !! + !! @author Felix + !! + !! Creation data : 02-22 + !! + !! History change: + !! + !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co ) + !! -# Creation of the module. + !! + !< + + public :: & + NOCIRunSCF_runHFs + + private + +contains + + !> + !! @brief Run a Hartree-Fock calculation at displaced geometries and fill CI matrix diagonals + !! + !! @param this -> NOCI instance + !< + subroutine NOCIRunSCF_runHFs(this) + implicit none + type(NonOrthogonalCI) :: this + + integer, allocatable :: sysIbatch(:) + type(MultiSCF), allocatable :: MultiSCFParallelInstance(:) + type(WaveFunction), allocatable :: WaveFunctionParallelInstance(:,:) + type(Libint2Interface), allocatable :: Libint2ParallelInstance(:,:) + integer :: speciesID, otherSpeciesID, nspecies + integer :: sysI,me,mySysI + integer :: ncores, batchSize + integer :: coordsUnit + real(8) :: timeA + character(100) :: coordsFile + character(50) :: auxmethod + + !$ timeA = omp_get_wtime() + !!Read HF energy of the non displaced SCF calculation + ! print *, "HF reference energy is ", hfEnergy + nspecies=molecularSystem_instance%numberOfQuantumSpecies + + allocate(this%HFCoefficients(this%numberOfDisplacedSystems,nspecies)) + allocate(this%systemLabels(this%numberOfDisplacedSystems)) + + call Matrix_constructor(this%configurationHamiltonianMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) + call Matrix_constructor(this%configurationOverlapMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) + call Vector_constructor(this%configurationCorrelationEnergies, this%numberOfDisplacedSystems, 0.0_8) + do speciesID=1, nspecies + call Matrix_constructor(this%configurationKineticMatrix(speciesID), & + int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) + call Matrix_constructor(this%configurationPuntualMatrix(speciesID), & + int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) + call Matrix_constructor(this%configurationExternalMatrix(speciesID), & + int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) + call Matrix_constructor(this%configurationExchangeMatrix(speciesID), & + int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) + do otherSpeciesID=speciesID, nspecies + call Matrix_constructor(this%configurationHartreeMatrix(speciesID,otherSpeciesID), & + int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) + call Matrix_constructor(this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID), & + int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) + end do + end do + + coordsUnit=333 + coordsFile=trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords" + open(unit=coordsUnit, file=trim(coordsFile), status="replace", form="formatted") + + if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then + print *, "running KS calculations at the displaced geometries ... saving results on file ", coordsFile + else + print *, "running HF calculations at the displaced geometries ... saving results on file ", coordsFile + end if + + + write (coordsUnit,'(A25,I20)') "numberOfDisplacedSystems ", this%numberOfDisplacedSystems + + !Allocate objets to distribute in parallel + ncores=CONTROL_instance%NUMBER_OF_CORES + batchSize=min(ncores,this%numberOfDisplacedSystems) + print *, "ncores", ncores, "batchsize", batchSize + + call MolecularSystem_destroy() + + !Skip priting scf iterations + CONTROL_instance%PRINT_LEVEL=0 + CONTROL_instance%NUMBER_OF_CORES=1 + + allocate(sysIbatch(batchSize),& + MultiSCFParallelInstance(batchSize),& + WaveFunctionParallelInstance(nspecies,batchSize),& + Libint2ParallelInstance(nspecies,batchSize)) + + sysI=0 + systemLoop: do while(sysI.le.this%numberOfDisplacedSystems) + !In serial, prepare systems + sysIbatch(:)=0 + me=0 + mySysI=sysI + + do while(me.lt.batchSize) + mySysI=mySysI+1 + if(mySysI .gt. this%numberOfDisplacedSystems) exit + me=me+1 + sysIbatch(me)=mySysI + + write(this%systemLabels(mySysI), '(A)') trim(this%molecularSystems(mySysI)%description) + call MultiSCF_constructor(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me),CONTROL_instance%ITERATION_SCHEME,this%molecularSystems(mySysI)) + call MultiSCF_buildHcore(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me)) + call MultiSCF_getInitialGuess(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me)) + call DirectIntegralManager_constructor(Libint2ParallelInstance(1:nspecies,me),this%molecularSystems(mySysI)) + + end do + ! STOP "NOCI runs only work with CONTROL_instance%INTEGRAL_STORAGE == MEMORY" + + !In parallel, run SCF calculations without calling lowdin-scf.x + call OMP_set_num_threads(ncores) + !$omp parallel& + !$omp& private(mySysI,auxmethod,speciesID,otherSpeciesID) + !$omp do schedule(dynamic) + procs: do me=1, batchSize + mySysI=sysIbatch(me) + if(mySysI .eq. 0) cycle procs + + if (CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then + do speciesID=1, nspecies + call DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(& + speciesID, & + WaveFunctionParallelInstance(speciesID,me)%densityMatrix, & + WaveFunctionParallelInstance(speciesID,me)%fourCenterIntegrals(speciesID)%values, & + this%molecularSystems(mySysI),Libint2ParallelInstance(speciesID,me)) + end do + + do speciesID=1, nspecies-1 + do otherSpeciesID=speciesID+1,nspecies + call DirectIntegralManager_getDirectInterRepulsionIntegralsAll(& + speciesID, otherSpeciesID, & + WaveFunctionParallelInstance(speciesID,me)%densityMatrix, & + WaveFunctionParallelInstance(speciesID,me)%fourCenterIntegrals(otherSpeciesID)%values, & + this%molecularSystems(mySysI),Libint2ParallelInstance(speciesID,me),Libint2ParallelInstance(otherSpeciesID,me)) + end do + end do + end if + + call MultiSCF_solveHartreeFockRoothan(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me),Libint2ParallelInstance(1:nspecies,me)) + + !Save HF results + ! call MultiSCF_saveWfn(MultiSCF_instance,WaveFunction_instance) + ! call MolecularSystem_copyConstructor(this%molecularSystems(sysI),molecularSystem_instance) + this%configurationHamiltonianMatrix%values(mySysI,mySysI)=MultiSCFParallelInstance(me)%totalEnergy + + do speciesID = 1, nspecies + this%HFCoefficients(mySysI,speciesID) = WaveFunctionParallelInstance(speciesID,me)%waveFunctionCoefficients + this%configurationKineticMatrix(speciesID)%values(mySysI,mySysI)=WaveFunctionParallelInstance(speciesID,me)%kineticEnergy + this%configurationPuntualMatrix(speciesID)%values(mySysI,mySysI)=WaveFunctionParallelInstance(speciesID,me)%puntualInteractionEnergy + this%configurationExternalMatrix(speciesID)%values(mySysI,mySysI)=WaveFunctionParallelInstance(speciesID,me)%externalPotentialEnergy + this%configurationExchangeMatrix(speciesID)%values(mySysI,mySysI)=WaveFunctionParallelInstance(speciesID,me)%exchangeHFEnergy + do otherSpeciesID = speciesID, this%molecularSystems(mySysI)%numberOfQuantumSpecies + this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysI)=& + WaveFunctionParallelInstance(speciesID,me)%hartreeEnergy(otherSpeciesID) + this%configurationDFTcorrelationMatrix(speciesID,otherSpeciesID)%values(mySysI,mySysI)=& + WaveFunctionParallelInstance(speciesID,me)%exchangeCorrelationEnergy(otherSpeciesID) + end do + end do + + ! Compute HF energy with KS determinants + if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then + if(CONTROL_instance%METHOD.eq."RKS") then + auxmethod="RHF" + else + auxmethod="UHF" + end if + + do speciesID = 1, nspecies + WaveFunctionParallelInstance(speciesID,me)%exchangeCorrelationEnergy=0.0_8 + WaveFunctionParallelInstance(speciesID,me)%exchangeCorrelationMatrix%values=0.0_8 + this%exactExchangeFraction(speciesID)=WaveFunctionParallelInstance(speciesID,me)%exactExchangeFraction + WaveFunctionParallelInstance(speciesID,me)%exactExchangeFraction=1.0_8 + end do + call MultiSCF_obtainFinalEnergy(MultiSCFParallelInstance(me),WaveFunctionParallelInstance(1:nspecies,me),Libint2ParallelInstance(1:nspecies,me),auxmethod) + !Difference between HF and KS energies + this%configurationCorrelationEnergies%values(mySysI)=this%configurationHamiltonianMatrix%values(mySysI,mySysI)-MultiSCFParallelInstance(me)%totalEnergy + end if + end do procs + !$omp end do nowait + !$omp end parallel + + !In serial, free memory and print + do me=1, batchSize + mySysI=sysIbatch(me) + if(mySysI .eq. 0) exit systemLoop + + write (coordsUnit,'(A10,I10,A10,ES20.12,A20,ES20.12)') "Geometry ", mySysI, "Energy", this%configurationHamiltonianMatrix%values(mySysI,mySysI), & + "Correlation energy", this%configurationCorrelationEnergies%values(mySysI) + call MolecularSystem_showCartesianMatrix(this%molecularSystems(mySysI),unit=coordsUnit) + + if (this%numberOfDisplacedSystems .le. this%printMatrixThreshold) then + write (*,'(A10,I10,A10,ES20.12,A20,ES20.12)') "Geometry ", mySysI, "Energy", this%configurationHamiltonianMatrix%values(mySysI,mySysI), & + "Correlation energy", this%configurationCorrelationEnergies%values(mySysI) + call MolecularSystem_showCartesianMatrix(this%molecularSystems(mySysI)) + ! do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + ! print *, "sysI", sysI, "speciesID", speciesID, "occupation number", MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(mySysI)) + ! end do + end if + + call DirectIntegralManager_destructor(Libint2ParallelInstance(1:nspecies,me)) + call MultiSCF_destructor(MultiSCFParallelInstance(me)) + + sysI=mySysI + + end do + + CONTROL_instance%NUMBER_OF_CORES=ncores + + !!Screen geometries with high energies + ! if( CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD .ne. 0.0 .and. & + ! testEnergy .gt. this%refEnergy+CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD) then + ! write (coordsUnit,"(A,F20.12)") "Skipping system with high energy", testEnergy + ! this%numberOfEnergyRejectedSystems=this%numberOfEnergyRejectedSystems+1 + ! else + ! if(this%numberOfEnergyRejectedSystems .gt. 0) & + ! write (*,'(A10,I10,A,F18.12)') "Rejected ", this%numberOfEnergyRejectedSystems, & + ! " geometries with energy higher than", this%refEnergy+CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD + + end do systemLoop + + close(coordsUnit) +!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for HF calculations at displaced geometries : ", omp_get_wtime() - timeA ," (s)" + + end subroutine NOCIRunSCF_runHFs + +end module NOCIRunSCF_ + diff --git a/src/NOCI/NOCISuperposed.f90 b/src/NOCI/NOCISuperposed.f90 new file mode 100644 index 00000000..eae2bba7 --- /dev/null +++ b/src/NOCI/NOCISuperposed.f90 @@ -0,0 +1,639 @@ +!****************************************************************************** +!! This code is part of LOWDIN Quantum chemistry package +!! +!! this program has been developed under direction of: +!! +!! UNIVERSIDAD NACIONAL DE COLOMBIA" +!! PROF. ANDRES REYES GROUP" +!! http://www.qcc.unal.edu.co" +!! +!! UNIVERSIDAD DE GUADALAJARA" +!! PROF. ROBERTO FLORES GROUP" +!! http://www.cucei.udg.mx/~robertof" +!! +!! AUTHORS +!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA +!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA +!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! CONTRIBUTORS +!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA +!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO +!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA +!! +!! +!! Todos los derechos reservados, 2011 +!! +!!****************************************************************************** + +module NOCISuperposed_ + use NOCIBuild_ + use NOCIMatrices_ + use MolecularSystem_ + use ParticleManager_ + use Matrix_ + use Vector_ + use DirectIntegralManager_ + use omp_lib + implicit none + + !> + !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727 + !! + !! @author Felix + !! + !! Creation data : 02-22 + !! + !! History change: + !! + !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co ) + !! -# Creation of the module. + !! + !< + + public :: & + NOCISuperposed_generateSuperposedSystem,& + NOCISuperposed_buildDensityMatrix,& + NOCISuperposed_getNaturalOrbitals,& + NOCISuperposed_saveToFile + + private + +contains + + !> + !! @brief Generates one molecular system combining all the displaced geometries and coefficients + !! + !! @param this + !< + subroutine NOCISuperposed_generateSuperposedSystem(this) + implicit none + type(NonOrthogonalCI) :: this + type(MolecularSystem) :: auxMolecularSystem + type(Matrix), allocatable :: auxCoefficients(:) + type(IVector), allocatable :: auxBasisList(:) + + integer :: i, sysI, speciesID + integer :: numberOfSpecies + + real(8) :: timeA + + !$ timeA = omp_get_wtime() + + if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return + + numberOfSpecies=this%molecularSystems(1)%numberOfQuantumSpecies + + allocate(this%sysBasisList(this%numberOfDisplacedSystems,numberOfSpecies),& + auxCoefficients(numberOfSpecies),& + auxBasisList(numberOfSpecies)) + + !Create a super molecular system + !!!Merge coefficients from system 1 and system 2 + call MolecularSystem_mergeTwoSystems(this%mergedMolecularSystem, this%molecularSystems(1), this%molecularSystems(2), & + this%sysBasisList(1,:),this%sysBasisList(2,:)) + + call NOCIMatrices_mergeCoefficients(this%HFCoefficients(1,:),this%HFCoefficients(2,:),& + this%molecularSystems(1),this%molecularSystems(2),this%mergedMolecularSystem,& + this%sysBasisList(1,:),this%sysBasisList(2,:),this%mergedCoefficients(:)) + + ! do speciesID=1, numberOfSpecies + ! print *, "2", speciesID, "ocupationNumber", MolecularSystem_getOcupationNumber(speciesID,this%mergedMolecularSystem) + ! print *, "2", speciesID, "mergedCoefficients" + ! call Matrix_show(this%mergedCoefficients(speciesID)) + ! end do + ! + !! Loop other systems expanding the merged coefficients matrix + do sysI=3, this%numberOfDisplacedSystems + call MolecularSystem_copyConstructor(auxMolecularSystem,this%mergedMolecularSystem) + do speciesID=1, numberOfSpecies + call Matrix_copyConstructor(auxCoefficients(speciesID), this%mergedCoefficients(speciesID)) + end do + call MolecularSystem_mergeTwoSystems(this%mergedMolecularSystem, auxMolecularSystem, this%molecularSystems(sysI), & + auxBasisList,this%sysBasisList(sysI,:),reorder=.false.) + call NOCIMatrices_mergeCoefficients(auxCoefficients,this%HFCoefficients(sysI,:),& + auxMolecularSystem,this%molecularSystems(sysI),this%mergedMolecularSystem,& + auxBasisList,this%sysBasisList(sysI,:),this%mergedCoefficients(:)) + ! do speciesID=1, numberOfSpecies + ! print *, sysI, speciesID, "ocupationNumber", MolecularSystem_getOcupationNumber(speciesID,this%mergedMolecularSystem) + ! print *, sysI, speciesID, "mergedCoefficients" + ! call Matrix_show(this%mergedCoefficients(speciesID)) + ! end do + end do + + !!!Fix basis list size + do sysI=1, this%numberOfDisplacedSystems + do speciesID=1, numberOfSpecies + call Vector_copyConstructorInteger(auxBasisList(speciesID),this%sysBasisList(sysI,speciesID)) + call Vector_constructorInteger(this%sysBasisList(sysI,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,this%mergedMolecularSystem), 0) + do i=1, size(auxBasisList(speciesID)%values) + this%sysBasisList(sysI,speciesID)%values(i)=auxBasisList(speciesID)%values(i) + end do + ! print *, "sysI", sysI, "speciesID", speciesID, "after list" + ! call Vector_showInteger(this%sysBasisList(sysI,speciesID)) + end do + end do + + write(*,*) "" + print *, "Superposed molecular system geometry" + write(*,*) "---------------------------------- " + ! call MolecularSystem_showInformation() + ! call MolecularSystem_showParticlesInformation() + call MolecularSystem_copyConstructor(molecularSystem_instance,this%mergedMolecularSystem) + call MolecularSystem_showCartesianMatrix(molecularSystem_instance) + particleManager_instance => molecularSystem_instance%allParticles + call ParticleManager_setOwner() + call MolecularSystem_saveToFile() + + ! do speciesID=1, numberOfSpecies + ! write(*,*) "" + ! write(*,*) " Merged Occupied Eigenvectors for: ", trim( MolecularSystem_instance%species(speciesID)%name ) + ! write(*,*) "---------------------------------- " + ! write(*,*) "" + ! print *, "contractions", speciesID, int(MolecularSystem_getTotalNumberOfContractions(speciesID),8) + ! print *, "ocupation", speciesID, int(MolecularSystem_getOcupationNumber(speciesID),8) + ! call Matrix_constructor(auxCoefficients(speciesID),int(MolecularSystem_getTotalNumberOfContractions(speciesID),8),& + ! int(MolecularSystem_getOcupationNumber(speciesID),8),0.0_8) + ! do i=1, MolecularSystem_getTotalNumberOfContractions(speciesID) + ! do j=1, MolecularSystem_getOcupationNumber(speciesID) + ! auxCoefficients(speciesID)%values(i,j)=mergedCoefficients(speciesID)%values(i,j) + ! end do + ! end do + ! call Matrix_show(auxCoefficients(speciesID)) + ! end do + + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time creating supermolecular system : ", omp_get_wtime() - timeA ," (s)" + !$ timeA = omp_get_wtime() + + deallocate(auxCoefficients,& + auxBasisList) + + return + + end subroutine NOCISuperposed_generateSuperposedSystem + + !> + !! @brief Generates the NOCI density matrix in the superposed molecular system + !! + !! @param this + !< + subroutine NOCISuperposed_buildDensityMatrix(this) + implicit none + type(NonOrthogonalCI) :: this + + type(Matrix) :: molecularOverlapMatrix + type(Matrix), allocatable :: inverseOverlapMatrix(:) !,kineticMatrix(:), attractionMatrix(:), externalPotMatrix(:) + integer :: state + integer :: i,ii,j,jj,mu,nu, sysI, sysII, speciesID, otherSpeciesID + integer :: particlesPerOrbital + integer :: numberOfSpecies + + integer :: densUnit + character(100) :: densFile + character(50) :: arguments(2), auxString + type(Matrix), allocatable :: exchangeCorrelationMatrices(:) + type(Matrix) :: dftEnergyMatrix + real(8), allocatable :: particlesInGrid(:) + real(8) :: timeA + + !$ timeA = omp_get_wtime() + + if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return + + numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies + + allocate(InverseOverlapMatrix(numberOfSpecies)) + + print *, "" + print *, "Computing overlap integrals for the superposed systems..." + print *, "" + do speciesID = 1, numberOfSpecies + call DirectIntegralManager_getOverlapIntegrals(molecularSystem_instance,speciesID,this%mergedOverlapMatrix(speciesID)) + end do + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for supermolecular 1-body integrals : ", omp_get_wtime() - timeA ," (s)" + !$ timeA = omp_get_wtime() + + print *, "" + print *, "Building merged density matrices for the superposed systems..." + print *, "" + !!Build the merged density matrix + do state=1, CONTROL_instance%CI_STATES_TO_PRINT + do speciesID=1, numberOfSpecies + call Matrix_constructor(this%mergedDensityMatrix(state,speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), & + int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8) + end do + end do + !!Fill the merged density matrix + ! "Diagonal" terms - same system + do sysI=1, this%numberOfDisplacedSystems + do speciesID=1, numberOfSpecies + particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) + do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) + if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle + do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) + if(this%sysBasisList(sysI,speciesID)%values(nu) .eq. 0) cycle + do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) + ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i + do state=1, CONTROL_instance%CI_STATES_TO_PRINT + this%mergedDensityMatrix(state,speciesID)%values(mu,nu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) + & + this%configurationCoefficients%values(sysI,state)**2*& + this%mergedCoefficients(speciesID)%values(mu,ii)*& + this%mergedCoefficients(speciesID)%values(nu,ii)*& + particlesPerOrbital + end do + end do + end do + end do + end do + end do + !!"Non Diagonal" terms - system pairs + do sysI=1, this%numberOfDisplacedSystems + do sysII=sysI+1, this%numberOfDisplacedSystems + if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle + !!Compute molecular overlap matrix and its inverse + do speciesID=1, numberOfSpecies + call Matrix_constructor(molecularOverlapMatrix, & + int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)),8), & + int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)),8), 0.0_8 ) + call Matrix_constructor(inverseOverlapMatrix(speciesID), & + int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)),8), & + int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)),8), 0.0_8 ) + + do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) !sysI + if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle + do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) !sysII + if(this%sysBasisList(sysII,speciesID)%values(nu) .eq. 0) cycle + do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) + ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i + do j = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)) + jj=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))*(sysII-1)+j + ! print *, "i, j, mu, nu, coefI, coefII", i,j,mu,nu,mergedCoefficients(speciesID)%values(mu,ii),mergedCoefficients(speciesID)%values(nu,jj) + molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+& + this%mergedCoefficients(speciesID)%values(mu,ii)*& + this%mergedCoefficients(speciesID)%values(nu,jj)*& + this%mergedOverlapMatrix(speciesID)%values(mu,nu) + end do + end do + end do + end do + ! print *, "molecularOverlapMatrix sysI, sysII, speciesID", sysI, sysII, speciesID + ! call Matrix_show(molecularOverlapMatrix) + if(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) .ne. 0) & + inverseOverlapMatrix(speciesID)=Matrix_inverse(molecularOverlapMatrix) + end do + + ! Compute density contributions + do speciesID=1, numberOfSpecies + particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) + do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) + if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle + do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) + if(this%sysBasisList(sysII,speciesID)%values(nu) .eq. 0) cycle + do state=1, CONTROL_instance%CI_STATES_TO_PRINT + do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) + ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i + do j = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)) + jj=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))*(sysII-1)+j + this%mergedDensityMatrix(state,speciesID)%values(mu,nu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) + & + this%configurationCoefficients%values(sysI,state)*& + this%configurationCoefficients%values(sysII,state)*& + this%configurationOverlapMatrix%values(sysI,sysII)*& + inverseOverlapMatrix(speciesID)%values(j,i)*& + this%mergedCoefficients(speciesID)%values(mu,ii)*& + this%mergedCoefficients(speciesID)%values(nu,jj)*& + particlesPerOrbital + this%mergedDensityMatrix(state,speciesID)%values(nu,mu) = this%mergedDensityMatrix(state,speciesID)%values(nu,mu) + & + this%configurationCoefficients%values(sysI,state)*& + this%configurationCoefficients%values(sysII,state)*& + this%configurationOverlapMatrix%values(sysI,sysII)*& + inverseOverlapMatrix(speciesID)%values(j,i)*& + this%mergedCoefficients(speciesID)%values(mu,ii)*& + this%mergedCoefficients(speciesID)%values(nu,jj)*& + particlesPerOrbital + end do + end do + end do + end do + end do + end do + !!symmetrize + ! do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) + ! do nu = mu+1 , MolecularSystem_getTotalNumberOfContractions(speciesID) + ! this%mergedDensityMatrix(state,speciesID)%values(nu,mu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) + ! end do + ! end do + end do + end do + + !! Open file - to write density matrices + densUnit = 29 + + densFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci" + open(unit = densUnit, file=trim(densFile), status="replace", form="formatted") + do state=1, CONTROL_instance%CI_STATES_TO_PRINT + do speciesID=1, numberOfSpecies + ! print *, "this%mergedDensityMatrix", state, trim( MolecularSystem_instance%species(speciesID)%name ) + ! call Matrix_show(this%mergedDensityMatrix(state,speciesID)) + write(auxString,*) state + arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) + arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxString)) + call Matrix_writeToFile ( this%mergedDensityMatrix(state,speciesID), densUnit , arguments=arguments(1:2) ) + end do + end do + + ! if(CONTROL_instance%ELECTRON_EXCHANGE_CORRELATION_FUNCTIONAL.ne."NONE" .or. & + ! CONTROL_instance%NUCLEAR_ELECTRON_CORRELATION_FUNCTIONAL.ne."NONE") then + ! print *, "Superposed DFT energies:" + + ! allocate(exchangeCorrelationMatrices(numberOfSpecies), & + ! particlesInGrid(numberOfSpecies)) + ! call DensityFunctionalTheory_buildFinalGrid() + ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT + ! call Matrix_constructor(dftEnergyMatrix, int(numberOfSpecies,8), & + ! int(numberOfSpecies,8), 0.0_8 ) + ! do speciesID=1, numberOfSpecies + ! call Matrix_constructor(exchangeCorrelationMatrices(speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), & + ! int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8) + ! end do + ! call DensityFunctionalTheory_finalDFT(this%mergedDensityMatrix(state,1:numberOfSpecies), & + ! exchangeCorrelationMatrices, & + ! dftEnergyMatrix, & + ! particlesInGrid) + + ! do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + ! do otherSpeciesID = speciesID, MolecularSystem_instance%numberOfQuantumSpecies + ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & + ! "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // & + ! " DFT Corr. energy = ", dftEnergyMatrix%values(speciesID,otherSpeciesID) + ! end do + ! end do + ! end do + ! end if + + close(densUnit) + + deallocate(inverseOverlapMatrix) + + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for merging density matrices : ", omp_get_wtime() - timeA ," (s)" + + return + + ! allocate(kineticMatrix(numberOfSpecies),& + ! attractionMatrix(numberOfSpecies),& + ! externalPotMatrix(numberOfSpecies)) + ! do speciesID = 1, numberOfSpecies + ! call DirectIntegralManager_getKineticIntegrals(molecularSystem_instance,speciesID,kineticMatrix(speciesID)) + ! if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then + ! kineticMatrix(speciesID)%values = & + ! kineticMatrix(speciesID)%values * & + ! ( 1.0_8/MolecularSystem_getMass( speciesID ) -1.0_8 / MolecularSystem_getTotalMass() ) + ! else + ! kineticMatrix(speciesID)%values = & + ! kineticMatrix(speciesID)%values / & + ! MolecularSystem_getMass( speciesID ) + ! end if + + ! call DirectIntegralManager_getAttractionIntegrals(molecularSystem_instance,speciesID,attractionMatrix(speciesID)) + ! attractionMatrix(speciesID)%values=attractionMatrix(speciesID)%values*(-MolecularSystem_getCharge(speciesID)) + + ! if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & + ! call DirectIntegralManager_getExternalPotentialIntegrals(molecularSystem_instance,speciesID,externalPotMatrix(speciesID)) + ! end do + ! write(*,*) "" + ! write(*,*) "==========================================================" + ! write(*,*) " ONE BODY ENERGY CONTRIBUTIONS OF THE SUPERPOSED SYSTEMS: " + ! write(*,*) "" + ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT + ! write(*,*) " STATE: ", state + ! do speciesID=1, numberOfSpecies + ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & + ! " Kinetic energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*kineticMatrix(speciesID)%values) + ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & + ! "/Fixed interact. energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*attractionMatrix(speciesID)%values) + ! if( CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & + ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name) // & + ! " Ext Pot energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*externalPotMatrix(speciesID)%values) + ! print *, "" + ! end do + ! print *, "" + ! end do + ! deallocate(kineticMatrix,& + ! attractionMatrix,& + ! externalPotMatrix) + + end subroutine NOCISuperposed_buildDensityMatrix + + !> + !! @brief Generates the NOCI natural orbitals from the NOCI density matrix in the superposed molecular system + !! + !! @param this + !< + subroutine NOCISuperposed_getNaturalOrbitals(this) + implicit none + type(NonOrthogonalCI) :: this + + type(Matrix) :: auxMatrix, densityEigenVectors, auxdensityEigenVectors + type(Vector) :: auxVector, densityEigenValues, auxdensityEigenValues + + integer :: state + integer :: i,j,k,speciesID + integer :: numberOfSpecies + + integer :: densUnit + character(100) :: densFile + character(50) :: arguments(2), auxString + real(8) :: timeA + + !$ timeA = omp_get_wtime() + if(.not. CONTROL_instance%CI_NATURAL_ORBITALS) return + if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return + + numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies + + write(*,*) "" + write(*,*) "=============================================" + write(*,*) " NATURAL ORBITALS OF THE SUPERPOSED SYSTEMS: " + write(*,*) "" + !! Open file - to write density matrices + densUnit = 29 + + densFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci" + open(unit = densUnit, file=trim(densFile), status="old", form="formatted", position="append") + + do state=1, CONTROL_instance%CI_STATES_TO_PRINT + + write(*,*) " STATE: ", state + + do speciesID=1, numberOfSpecies + + write(*,*) "" + write(*,*) " Natural Orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(speciesID)%name ) + write(*,*) "--------------------------------------------------------------" + + call Vector_constructor ( densityEigenValues, & + int(MolecularSystem_getTotalNumberOfContractions(speciesID),4), 0.0_8 ) + call Matrix_constructor ( densityEigenVectors, & + int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), & + int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8 ) + + call Vector_constructor ( auxdensityEigenValues, & + int(MolecularSystem_getTotalNumberOfContractions(speciesID),4), 0.0_8 ) + call Matrix_constructor ( auxdensityEigenVectors, & + int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), & + int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8 ) + + !! Lowdin orthogonalization of the density matrix + auxMatrix = Matrix_pow(this%mergedOverlapMatrix(speciesID), 0.5_8, method="SVD" ) + + auxMatrix%values=matmul(matmul(auxMatrix%values,this%mergedDensityMatrix(state,speciesID)%values),auxMatrix%values) + + ! print *, "Diagonalizing non orthogonal CI density Matrix..." + + !! Calcula valores y vectores propios de matriz de densidad CI ortogonal. + call Matrix_eigen(auxMatrix , auxdensityEigenValues, auxdensityEigenVectors, SYMMETRIC ) + + !! Transform back to the atomic basis + auxMatrix = Matrix_pow(this%mergedOverlapMatrix(speciesID), -0.5_8, method="SVD" ) + + auxdensityEigenVectors%values=matmul(auxMatrix%values,auxdensityEigenVectors%values) + + ! reorder and count significant occupations + k=0 + do i = 1, MolecularSystem_getTotalNumberOfContractions(speciesID) + densityEigenValues%values(i) = auxdensityEigenValues%values(MolecularSystem_getTotalNumberOfContractions(speciesID) - i + 1) + densityEigenVectors%values(:,i) = auxdensityEigenVectors%values(:,MolecularSystem_getTotalNumberOfContractions(speciesID) - i + 1) + if(abs(densityEigenValues%values(i)) .ge. 1.0E-4_8 ) k=k+1 + end do + if(k .eq. 0) k=1 + ! Print eigenvectors with occupation larger than 0.01 + call Vector_constructor(auxVector,k,0.0_8) + call Matrix_constructor(auxMatrix,int(MolecularSystem_getTotalNumberOfContractions(speciesID),8),int(k,8),0.0_8) + k=0 + do i=1, MolecularSystem_getTotalNumberOfContractions(speciesID) + if(abs(densityEigenValues%values(i)) .ge. 1.0E-4_8 ) then + k=k+1 + auxVector%values(k)=densityEigenValues%values(i) + do j=1, MolecularSystem_getTotalNumberOfContractions(speciesID) + auxMatrix%values(j,k)=densityEigenVectors%values(j,i) + end do + end if + end do + !densityEigenVectors + call Matrix_show( auxMatrix , & + rowkeys = MolecularSystem_getlabelsofcontractions( speciesID ), & + columnkeys = string_convertvectorofrealstostring( auxVector ),& + flags=WITH_BOTH_KEYS) + + write(*,"(A10,A10,A20,I5,A15,F17.12)") "number of ", trim(MolecularSystem_getNameOfSpecies( speciesID )) ," particles in state", state , & + " density matrix: ", sum( transpose(this%mergedDensityMatrix(state,speciesID)%values)*this%mergedOverlapMatrix(speciesID)%values) + write(*,"(A10,A10,A40,F17.12)") "sum of ", trim(MolecularSystem_getNameOfSpecies( speciesID )) , "natural orbital occupations", sum(densityEigenValues%values) + + ! density matrix check + ! auxMatrix%values=0.0 + ! do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) + ! do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) + ! do k=1, MolecularSystem_getTotalNumberOfContractions(speciesID) + ! auxMatrix%values(mu,nu)=auxMatrix%values(mu,nu)+densityEigenValues%values(k)*& + ! densityEigenVectors%values(mu,k)*densityEigenVectors%values(nu,k) + ! end do + ! end do + ! end do + ! print *, "atomicDensityMatrix again" + ! call Matrix_show(auxMatrix) + + write(auxString,*) state + + arguments(2) = trim( MolecularSystem_instance%species(speciesID)%name ) + arguments(1) = "NATURALORBITALS"//trim(adjustl(auxstring)) + + call Matrix_writeToFile ( densityEigenVectors, densUnit , arguments=arguments(1:2) ) + + arguments(2) = trim( MolecularSystem_instance%species(speciesID)%name ) + arguments(1) = "OCCUPATIONS"//trim(adjustl(auxstring)) + + call Vector_writeToFile( densityEigenValues, densUnit, arguments=arguments(1:2) ) + + write(*,*) " End of natural orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(speciesID)%name ) + end do + end do + + write(*,*) "" + write(*,*) " END OF NATURAL ORBITALS" + write(*,*) "==============================" + write(*,*) "" + + close(densUnit) + + !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for NOCI natural orbitals : ", omp_get_wtime() - timeA ," (s)" + + return + + end subroutine NOCISuperposed_getNaturalOrbitals + + !> + !! @brief Save NOCI results to file + !! + !! @param + !< + subroutine NOCISuperposed_saveToFile(this) + type(NonOrthogonalCI) :: this + integer :: nociUnit, speciesID, numberOfSpecies, sysI + character(100) :: prefix, nociFile + character(50) :: arguments(2), auxString + + !Save merged molecular system + call MolecularSystem_copyConstructor(molecularSystem_instance,this%mergedMolecularSystem) + + prefix=trim(CONTROL_instance%INPUT_FILE)//"NOCI" + call MolecularSystem_saveToFile(prefix) + + numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies + + nociUnit=123 + nociFile=trim(prefix)//".states" + open(unit = nociUnit, file=trim(nociFile), status="replace", form="unformatted") + + arguments(1:1) = "NOCI-NUMBEROFDISPLACEDSYSTEMS" + call Vector_writeToFileInteger(unit=nociUnit, binary=.true., value=this%numberOfDisplacedSystems, arguments=arguments(1:1) ) + + arguments(1:1) = "NOCI-NUMBEROFSPECIES" + call Vector_writeToFileInteger(unit=nociUnit, binary=.true., value=numberOfSpecies, arguments=arguments(1:1) ) + + arguments(1:1) = "NOCI-CONFIGURATIONCOEFFICIENTS" + call Matrix_writeToFile ( this%configurationCoefficients, nociUnit , binary=.true., arguments=arguments(1:1) ) + + arguments(1:1) = "NOCI-CONFIGURATIONENERGIES" + call Vector_writeToFile ( this%statesEigenvalues, nociUnit , binary=.true., arguments=arguments(1:1) ) + + arguments(1) = "MERGEDCOEFFICIENTS" + do speciesID=1, numberOfSpecies + arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) + call Matrix_writeToFile ( this%mergedCoefficients(speciesID), nociUnit, binary=.true. , arguments=arguments(1:2) ) + end do + + do sysI=1, this%numberOfDisplacedSystems + do speciesID=1, numberOfSpecies + write(auxString,*) sysI + arguments(1) = "SYSBASISLIST"//trim(auxString) + arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) + call Vector_writeToFileInteger(this%sysBasisList(sysI,speciesID), nociUnit, binary=.true., arguments=arguments(1:2) ) + end do + end do + + ! do state=1, min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems) + ! end do + + ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT + ! write(auxString,*) state + ! call Matrix_writeToFile ( this%mergedDensityMatrix(state,speciesID), densUnit , arguments=arguments(1:2) ) + ! end do + ! end do + + close(nociUnit) + + end subroutine NOCISuperposed_saveToFile + + +end module NOCISuperposed_ + diff --git a/src/NOCI/NonOrthogonalCI.f90 b/src/NOCI/NonOrthogonalCI.f90 deleted file mode 100644 index 756d2f01..00000000 --- a/src/NOCI/NonOrthogonalCI.f90 +++ /dev/null @@ -1,3450 +0,0 @@ -!****************************************************************************** -!! This code is part of LOWDIN Quantum chemistry package -!! -!! this program has been developed under direction of: -!! -!! UNIVERSIDAD NACIONAL DE COLOMBIA" -!! PROF. ANDRES REYES GROUP" -!! http://www.qcc.unal.edu.co" -!! -!! UNIVERSIDAD DE GUADALAJARA" -!! PROF. ROBERTO FLORES GROUP" -!! http://www.cucei.udg.mx/~robertof" -!! -!! AUTHORS -!! E.F. POSADA. UNIVERSIDAD NACIONAL DE COLOMBIA -!! S.A. GONZALEZ. UNIVERSIDAD NACIONAL DE COLOMBIA -!! F.S. MONCADA. UNIVERSIDAD NACIONAL DE COLOMBIA -!! J. ROMERO. UNIVERSIDAD NACIONAL DE COLOMBIA -!! -!! CONTRIBUTORS -!! N.F.AGUIRRE. UNIVERSIDAD NACIONAL DE COLOMBIA -!! GABRIEL MERINO. UNIVERSIDAD DE GUANAJUATO -!! J.A. CHARRY UNIVERSIDAD NACIONAL DE COLOMBIA -!! -!! -!! Todos los derechos reservados, 2011 -!! -!!****************************************************************************** - -module NonOrthogonalCI_ - use Math_ - use Exception_ - use MolecularSystem_ - use ParticleManager_ - use Matrix_ - use ReadTransformedIntegrals_ - use Lebedev_ - use Matrix_ - use Vector_ - use Solver_ - use DirectIntegralManager_ - use Libint2Interface_ - use MultiSCF_ - use WaveFunction_ - use String_ - use omp_lib - implicit none - - !> - !! @brief non Orthogonal Configuration Interaction Module. APMO implementation of Skone et al 2005 10.1063/1.2039727 - !! - !! @author Felix - !! - !! Creation data : 02-22 - !! - !! History change: - !! - !! - 02-22 : Felix Moncada ( fsmoncadaa@unal.edu.co ) - !! -# Creation of the module. - !! - !< - - type, public :: NonOrthogonalCI - logical :: isInstanced - integer :: numberOfDisplacedSystems - integer :: numberOfEnergyRejectedSystems - integer :: numberOfEllipsoidRejectedSystems - integer :: numberOfPPdistanceRejectedSystems - integer :: numberOfNPdistanceRejectedSystems - integer :: numberOfEquivalentSystems - integer :: numberOfTransformedCenters - integer :: numberOfIndividualTransformations - integer :: printMatrixThreshold - integer, allocatable :: rotationCenterList(:,:) - type(Matrix) :: configurationOverlapMatrix, configurationHamiltonianMatrix, configurationCoefficients - type(Matrix), allocatable :: configurationKineticMatrix(:), configurationPuntualMatrix(:), configurationExternalMatrix(:), configurationExchangeMatrix(:) - type(Matrix), allocatable :: configurationHartreeMatrix(:,:) - type(Vector) :: configurationCorrelationEnergies, statesEigenvalues - type(IVector), allocatable :: sysBasisList(:,:) - type(Matrix), allocatable :: HFCoefficients(:,:) - type(Matrix), allocatable :: mergedCoefficients(:) - type(Matrix), allocatable :: mergedOverlapMatrix(:) - type(Matrix), allocatable :: mergedDensityMatrix(:,:) - type(MolecularSystem), allocatable :: molecularSystems(:) - type(MolecularSystem) :: mergedMolecularSystem - character(50) :: transformationType - character(15),allocatable :: systemLabels(:) - real(8) :: refEnergy - ! integer :: numberOfUniqueSystems !sort of symmetry - ! integer :: numberOfUniquePairs !sort of symmetry - ! type(IVector) :: systemTypes !sort of symmetry - ! type(IMatrix) :: configurationPairTypes !, uniqueOverlapElements, uniqueHamiltonianElements - ! type(MolecularSystem), allocatable :: uniqueMolecularSystems(:) - end type NonOrthogonalCI - - type(NonOrthogonalCI), public :: NonOrthogonalCI_instance - - public :: & - NonOrthogonalCI_constructor,& - NonOrthogonalCI_displaceGeometries,& - NonOrthogonalCI_readGeometries,& - NonOrthogonalCI_runHFs,& - NonOrthogonalCI_buildOverlapAndHamiltonianMatrix,& - NonOrthogonalCI_diagonalizeCImatrix,& - NonOrthogonalCI_generateSuperposedSystem,& - NonOrthogonalCI_buildDensityMatrix,& - NonOrthogonalCI_getNaturalOrbitals,& - NonOrthogonalCI_saveToFile,& - NonOrthogonalCI_computeFranckCondon - - private - -contains - - !> - !! @brief Allocates memory and run HF calculations to be used in the construction of the NOCI matrix - !! - !! @param this - !< - subroutine NonOrthogonalCI_constructor(this) - implicit none - type(NonOrthogonalCI) :: this - integer :: numberOfRotationCenters, numberOfTranslationCenters - integer :: p,q,r - - print *, "-------------------------------------------------------------" - print *, "STARTING NON ORTHOGONAL CONFIGURATION INTERACTION CALCULATION" - print *, "-------------------------------------------------------------" - print *, "" - this%isInstanced=.true. - this%numberOfDisplacedSystems=0 - this%numberOfEnergyRejectedSystems=0 - this%numberOfEllipsoidRejectedSystems=0 - this%numberOfPPdistanceRejectedSystems=0 - this%numberOfNPdistanceRejectedSystems=0 - ! this%numberOfUniqueSystems=0 - ! this%numberOfUniquePairs=0 - this%printMatrixThreshold=30 - numberOfTranslationCenters=0 - numberOfRotationCenters=0 - - allocate(this%rotationCenterList(size(MolecularSystem_instance%allParticles),2)) - !For rotations, 0,0: leave alone, N,M: rotation center number to be rotated around point M - this%rotationCenterList=0 - - !!Translation count - do p = 1, size(MolecularSystem_instance%allParticles) - - if(MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter.gt.numberOfTranslationCenters) & - numberOfTranslationCenters=MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter - - if(MolecularSystem_instance%allParticles(p)%particlePtr%translationCenter.ne.0) & - write (*,"(A,A10,A,3F9.5,A)") "Particle ", trim(ParticleManager_getSymbol(p)), & - " basis functions at ", MolecularSystem_instance%allParticles(p)%particlePtr%origin(1:3), & - " are going to be displaced" - end do - - !!Rotation count - do p = 1, size(MolecularSystem_instance%allParticles) - if(MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint.eq.0) cycle - write (*,"(A,A10,A,3F9.5,A,I5)") "Particle ", trim(ParticleManager_getSymbol(p)), & - " located at ", MolecularSystem_instance%allParticles(p)%particlePtr%origin(1:3), & - " is center of rotation number", MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint - - do q = 1, size(MolecularSystem_instance%allParticles) - if(MolecularSystem_instance%allParticles(q)%particlePtr%rotateAround .eq. & - MolecularSystem_instance%allParticles(p)%particlePtr%rotationPoint) then - write (*,"(A,A10,A,3F9.5,A,I5)") "Particle ", trim(ParticleManager_getSymbol(q)), & - " basis functions at ", MolecularSystem_instance%allParticles(q)%particlePtr%origin(1:3), & - " are going to be rotated around center ", MolecularSystem_instance%allParticles(q)%particlePtr%rotateAround - - if(q .eq. MolecularSystem_instance%allParticles(q)%particlePtr%owner) then - !in the case of several species with the same center, rotate them as one - numberOfRotationCenters=numberOfRotationCenters+1 - this%rotationCenterList(q,1)=numberOfRotationCenters - !find childs - if ( allocated(MolecularSystem_instance%allParticles(q)%particlePtr%childs) ) then - do r=1,size(MolecularSystem_instance%allParticles(q)%particlePtr%childs) - this%rotationCenterList( MolecularSystem_instance%allParticles(q)%particlePtr%childs(r),1)=numberOfRotationCenters - end do - end if - end if - this%rotationCenterList(q,2)=p - end if - end do - end do - print *, "" - - ! print *, "this%rotationCenterList" - ! do p=1, size(MolecularSystem_instance%allParticles) - ! print *, "Particle ", trim(ParticleManager_getSymbol(p)),this%rotationCenterList(p,1), this%rotationCenterList(p,2) - ! end do - - if(numberOfTranslationCenters.ne.0) then - - this%transformationType="TRANSLATION" - this%numberOfTransformedCenters=numberOfTranslationCenters - this%numberOfIndividualTransformations=& - CONTROL_instance%TRANSLATION_SCAN_GRID(1)*CONTROL_instance%TRANSLATION_SCAN_GRID(2)*CONTROL_instance%TRANSLATION_SCAN_GRID(3)& - +(CONTROL_instance%TRANSLATION_SCAN_GRID(1)-1)*(CONTROL_instance%TRANSLATION_SCAN_GRID(2)-1)*(CONTROL_instance%TRANSLATION_SCAN_GRID(3)-1) - - print *, "" - write (*,"(A,I5,A,I10,A)") "Displacing coordinates of ", numberOfTranslationCenters, " centers", & - this%numberOfIndividualTransformations," times" - print *, "" - - else if(numberOfRotationCenters.ne.0) then - print *, "" - write (*,"(A,I5,A,I5,A,I5,A)") "Rotating coordinates of ", numberOfRotationCenters, " centers", CONTROL_instance%ROTATIONAL_SCAN_GRID, & - " times in ", CONTROL_instance%NESTED_ROTATIONAL_GRIDS, " nested grids" - - print *, "" - - this%transformationType="ROTATION" - this%numberOfTransformedCenters=numberOfRotationCenters - this%numberOfIndividualTransformations=CONTROL_instance%ROTATIONAL_SCAN_GRID*CONTROL_instance%NESTED_ROTATIONAL_GRIDS - else if(CONTROL_instance%READ_NOCI_GEOMETRIES) then - this%transformationType="READ_GEOMETRIES" - write (*,"(A)") "Reading input geometries from "//trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords file" - end if - - ! call Vector_constructorInteger(this%systemTypes,this%numberOfIndividualTransformations**this%numberOfTransformedCenters,0) - - - allocate(this%mergedDensityMatrix(CONTROL_instance%CI_STATES_TO_PRINT,molecularSystem_instance%numberOfQuantumSpecies),& - this%mergedOverlapMatrix(molecularSystem_instance%numberOfQuantumSpecies),& - this%mergedCoefficients(molecularSystem_instance%numberOfQuantumSpecies),& - this%configurationKineticMatrix(molecularSystem_instance%numberOfQuantumSpecies),& - this%configurationPuntualMatrix(molecularSystem_instance%numberOfQuantumSpecies),& - this%configurationExternalMatrix(molecularSystem_instance%numberOfQuantumSpecies),& - this%configurationExchangeMatrix(molecularSystem_instance%numberOfQuantumSpecies),& - this%configurationHartreeMatrix(molecularSystem_instance%numberOfQuantumSpecies,molecularSystem_instance%numberOfQuantumSpecies)) - - end subroutine NonOrthogonalCI_constructor - !> - !! @brief Generates different geometries and runs HF calculations at each - !! - !! @param this - !< - subroutine NonOrthogonalCI_displaceGeometries(this) - implicit none - type(NonOrthogonalCI) :: this - - type(MolecularSystem) :: originalMolecularSystem - type(MolecularSystem) :: displacedMolecularSystem - real(8) :: displacement - character(100) :: coordsFile - integer, allocatable :: transformationCounter(:) - integer :: coordsUnit - integer :: i,j - integer :: closestSystem - logical :: skip - real(8) :: timeA - - !$ timeA = omp_get_wtime() - - call MolecularSystem_copyConstructor(originalMolecularSystem, molecularSystem_instance) - - !!Dynamically allocated through the displacement routine - allocate(this%molecularSystems(0)) - - allocate(transformationCounter(this%numberOfTransformedCenters)) - - transformationCounter(1:this%numberOfTransformedCenters)=1 - transformationCounter(1)=0 - - this%numberOfDisplacedSystems=0 - - coordsUnit=333 - coordsFile=trim(CONTROL_instance%INPUT_FILE)//"trial.coords" - - print *, "generating NOCI displaced geometries and HF wavefunctions... saving coords to ", trim(coordsFile) - - open(unit=coordsUnit, file=trim(coordsFile), status="replace", form="formatted") - -!!!!! clock type iterations to form all the possible combination of modified geometries - do while (.true.) - - !Determine the next movement like a clock iteration - transformationCounter(1)=transformationCounter(1)+1 - do i=1,this%numberOfTransformedCenters-1 - if(transformationCounter(i) .gt. this%numberOfIndividualTransformations) then - j=i+1 - transformationCounter(j)=transformationCounter(j)+1 - transformationCounter(1:i)=1 - end if - end do - - if(transformationCounter(this%numberOfTransformedCenters) .gt. this%numberOfIndividualTransformations) exit - - write (coordsUnit,"(A)",advance="no") "Transformation counter: " - do i=1,this%numberOfTransformedCenters - write (coordsUnit,"(I10)",advance="no") transformationCounter(i) - end do - write (coordsUnit,*) "" - - skip=.false. - !Apply the transformation given by transformationCounter to each center, the result is saved in molecularSystemInstance - call NonOrthogonalCI_transformCoordinates(this,transformationCounter(1:this%numberOfTransformedCenters),originalMolecularSystem,displacedMolecularSystem,skip) - - call MolecularSystem_showCartesianMatrix(displacedMolecularSystem,unit=coordsUnit) - - !Classify the system according to its distance matrix (symmetry) - ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) & - ! call NonOrthogonalCI_classifyNewSystem(this,systemType, newSystemFlag) - - !Check if the new system is not beyond the max displacement - if(skip) then - write (coordsUnit,"(A)") "Skipping system beyond the ellipsoids boundaries" - this%numberOfEllipsoidRejectedSystems=this%numberOfEllipsoidRejectedSystems+1 - cycle - end if - - !Check if the separation between particles of the same charge is not too small - call NonOrthogonalCI_checkSameChargesDistance(displacedMolecularSystem,displacement,skip) - - if(skip) then - write (coordsUnit,"(A,F20.12)") "Skipping system with same charge particle separation", displacement - this%numberOfPPdistanceRejectedSystems=this%numberOfPPdistanceRejectedSystems+1 - cycle - end if - - !Check if the separation between positive and negative particles is not too big - call NonOrthogonalCI_checkOppositeChargesDistance(displacedMolecularSystem,displacement,skip) - - if(skip) then - write (coordsUnit,"(A,F20.12)") "Skipping system with positive and negative particle separation", displacement - this%numberOfNPdistanceRejectedSystems=this%numberOfNPdistanceRejectedSystems+1 - cycle - end if - - !Check if the new system is not to close to previous calculated systems - duplicate protection - call NonOrthogonalCI_checkNewSystemDisplacement(this,displacedMolecularSystem,closestSystem,displacement) - - if(displacement .lt. CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then - write (coordsUnit,"(A,F20.12,A,I10)") "Skipping system with distance ", displacement , "a.u. from system ", closestSystem - skip=.true. - this%numberOfEquivalentSystems=this%numberOfEquivalentSystems+1 - cycle - end if - - !!Copy the molecular system to the NonOrthogonalCI object - ! if(newSystemFlag) then - ! this%numberOfUniqueSystems=this%numberOfUniqueSystems+1 - ! this%systemTypes%values(this%numberOfDisplacedSystems)=this%numberOfUniqueSystems - ! else - ! this%systemTypes%values(this%numberOfDisplacedSystems)=systemType - ! end if - - ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then - ! write (coordsUnit,"(A,I5,A,I10,A,F20.12)") "Saving system of type ", this%systemTypes%values(this%numberOfDisplacedSystems) , & - ! " with ID ", this%numberOfDisplacedSystems, " and energy", testEnergy - ! else< - if(skip .eqv. .false.) then - call NonOrthogonalCI_saveSystem(this,displacedMolecularSystem) - write (coordsUnit,"(A,I10)") "Saving system with ID ", this%numberOfDisplacedSystems - end if - end do - - close(coordsUnit) - - print *, "" - write (*,'(A10,I10,A)') "Mixing ", this%numberOfDisplacedSystems, " HF calculations at different geometries" - - if(this%numberOfEllipsoidRejectedSystems .gt. 0) & - write (*,'(A10,I10,A)') "Rejected ", this%numberOfEllipsoidRejectedSystems, & - " geometries outside the ellipsoids area" - - if(this%numberOfPPdistanceRejectedSystems .gt. 0) & - write (*,'(A10,I10,A,ES18.8,A,ES18.8)') "Rejected ", this%numberOfPPdistanceRejectedSystems, & - " geometries with separation between same charge basis sets smaller than", CONTROL_instance%CONFIGURATION_MIN_PP_DISTANCE, & - " or larger than", CONTROL_instance%CONFIGURATION_MAX_PP_DISTANCE - - if(this%numberOfNPdistanceRejectedSystems .gt. 0) & - write (*,'(A10,I10,A,ES18.8)') "Rejected ", this%numberOfNPdistanceRejectedSystems, & - " geometries with separation between positive and negative basis sets larger than", CONTROL_instance%CONFIGURATION_MAX_NP_DISTANCE - - if(this%numberOfEquivalentSystems .gt. 0) & - write (*,'(A10,I10,A)') "Rejected ", this%numberOfEquivalentSystems, & - " duplicated geometries after permutations" - - print *, "" - - ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) & - ! call Matrix_constructorInteger(this%configurationPairTypes,int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0) - ! minEnergy=0.0 - -!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time displacing coordinates : ", omp_get_wtime() - timeA ," (s)" - print *, "" - - end subroutine NonOrthogonalCI_displaceGeometries - - !> - !! @brief Read different geometries - !! - !! @param this - !< - subroutine NonOrthogonalCI_readGeometries(this) - implicit none - type(NonOrthogonalCI) :: this - - type(MolecularSystem) :: originalMolecularSystem - real(8) :: origin(3) - character(100) :: string,coordsFile - integer :: coordsUnit - integer :: sysI,i,ii,j,mu - real(8) :: timeA - logical :: readSuccess - - !$ timeA = omp_get_wtime() - - call MolecularSystem_copyConstructor(originalMolecularSystem, molecularSystem_instance) - - coordsUnit=333 - coordsFile=trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords" - readSuccess=.false. - - inquire(FILE = coordsFile, EXIST = readSuccess ) - if(.not. readSuccess) then - print *, "Didn't find the file ", trim(coordsFile) - STOP "Please provide one or turn the readNOCIGeometries flag off!" - end if - - open(unit=coordsUnit, file=trim(coordsFile), status="old", form="formatted") - - read(coordsUnit,*) string, this%numberOfDisplacedSystems - print *, "reading ", this%numberOfDisplacedSystems, " systems" - - allocate(this%molecularSystems(this%numberOfDisplacedSystems)) - - do sysI = 1, this%numberOfDisplacedSystems - call MolecularSystem_copyConstructor(molecularSystem_instance, originalMolecularSystem) - write(molecularSystem_instance%description,"(I10)") sysI - read(coordsUnit,*) string !skip line - read(coordsUnit,*) string !skip line - - !! Print quatum species information - do i = 1, molecularSystem_instance%numberOfQuantumSpecies - - !! Copy origins in open-shell case - if(trim(molecularSystem_instance%species(i)%name) .eq. "E-BETA" ) then - do ii = 1, i-1 - if(trim(molecularSystem_instance%species(ii)%name) .ne. "E-ALPHA" ) cycle - do j = 1, size(molecularSystem_instance%species(i)%particles) - molecularSystem_instance%species(i)%particles(j)%origin = & - molecularSystem_instance%species(ii)%particles(j)%origin - do mu = 1, molecularSystem_instance%species(i)%particles(j)%basis%length - molecularSystem_instance%species(i)%particles(j)%basis%contraction(mu)%origin = & - molecularSystem_instance%species(i)%particles(j)%origin - end do - end do - end do - cycle !skip the rest of the read - end if - - do j = 1, size(molecularSystem_instance%species(i)%particles) - read(coordsUnit,*) string, origin(1), origin(2), origin(3) - - molecularSystem_instance%species(i)%particles(j)%origin = origin/AMSTRONG - do mu = 1, molecularSystem_instance%species(i)%particles(j)%basis%length - molecularSystem_instance%species(i)%particles(j)%basis%contraction(mu)%origin = & - molecularSystem_instance%species(i)%particles(j)%origin - end do - end do - end do - - !! Point charges information - do i = 1, molecularSystem_instance%numberOfPointCharges - read(coordsUnit,*) string, origin(1), origin(2), origin(3) - - molecularSystem_instance%pointCharges(i)%origin = origin/AMSTRONG - end do - call MolecularSystem_copyConstructor(this%molecularSystems(sysI), molecularSystem_instance) - - end do - - close(unit=coordsUnit) - - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time reading coordinates : ", omp_get_wtime() - timeA ," (s)" - end subroutine NonOrthogonalCI_readGeometries - - - !> - !! @brief Apply the transformation (translation or rotation) given by transformationCounter to each center, based in the originalMolecularSystemPositions the result is saved in molecularSystemInstance - !! @param this,transformationCounter,originalMolecularSystem - !< - subroutine NonOrthogonalCI_transformCoordinates(this,transformationCounter,originalMolecularSystem,displacedMolecularSystem,skip) - type(NonOrthogonalCI) :: this - integer :: transformationCounter(*) - type(MolecularSystem) :: originalMolecularSystem - type(MolecularSystem), target :: displacedMolecularSystem - logical, intent(out) :: skip - - real(8) :: centerX, centerY, centerZ, displacedOrigin(3), distanceCheck, distanceToCenter - integer :: center, displacementId - real(8),allocatable :: X(:), Y(:), Z(:), W(:) - integer :: i,j,k,p,q,mu - character(200) :: description - - skip=.false. - - call MolecularSystem_copyConstructor(displacedMolecularSystem, originalMolecularSystem) - - write(displacedMolecularSystem%description, '(I10)') transformationCounter(1) - do i=2,this%numberOfTransformedCenters - write(description, '(A)') adjustl(adjustr(displacedMolecularSystem%description)//"-"//adjustl(String_convertIntegerToString(transformationCounter(i)))) - displacedMolecularSystem%description=trim(description) - end do - - particleManager_instance => displacedMolecularSystem%allParticles - - if(trim(this%transformationType).eq."TRANSLATION") then - - do center=1, this%numberOfTransformedCenters - do p=1, size(originalMolecularSystem%allParticles) - if(center.eq.originalMolecularSystem%allParticles(p)%particlePtr%translationCenter) then - centerX=originalMolecularSystem%allParticles(p)%particlePtr%origin(1) - centerY=originalMolecularSystem%allParticles(p)%particlePtr%origin(2) - centerZ=originalMolecularSystem%allParticles(p)%particlePtr%origin(3) - end if - end do - - !!These loops update the molecular system file for each displaced geometry - !!ADD DIFFERENT AXIS DISPLACEMENTS! - displacementId=0 - !Body centered cube - do i=1,CONTROL_instance%TRANSLATION_SCAN_GRID(1)*2-1 - do j=1,CONTROL_instance%TRANSLATION_SCAN_GRID(2)*2-1 - do k=1,CONTROL_instance%TRANSLATION_SCAN_GRID(3)*2-1 - - if( (mod(i,2) .eq. mod(j,2)) .and. (mod(i,2) .eq. mod(k,2)) ) then - displacementId=displacementId+1 - - if(displacementId .eq. transformationCounter(center) ) then - - distanceCheck= & - (CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0))**2/& - CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(1)**2+& - (CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0))**2/& - CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(2)**2+& - (CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0))**2/& - CONTROL_instance%CONFIGURATION_MAX_DISPLACEMENT(3)**2 - - if(distanceCheck .gt. 1.0) then - skip=.true. - ! return - end if - - distanceCheck= & - (CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0))**2/& - CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(1)**2+& - (CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0))**2/& - CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(2)**2+& - (CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0))**2/& - CONTROL_instance%CONFIGURATION_MIN_DISPLACEMENT(3)**2 - - if(distanceCheck .lt. 1.0) then - skip=.true. - ! return - end if - - displacedOrigin(1)=centerX+CONTROL_instance%TRANSLATION_STEP*((i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0) - displacedOrigin(2)=centerY+CONTROL_instance%TRANSLATION_STEP*((j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0) - displacedOrigin(3)=centerZ+CONTROL_instance%TRANSLATION_STEP*((k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0) - - do p=1, size(displacedMolecularSystem%allParticles) - if(center.eq.displacedMolecularSystem%allParticles(p)%particlePtr%translationCenter) then - ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin ) - displacedMolecularSystem%allParticles(p)%particlePtr%origin=displacedOrigin - do mu = 1, displacedMolecularSystem%allParticles(p)%particlePtr%basis%length - displacedMolecularSystem%allParticles(p)%particlePtr%basis%contraction(mu)%origin = displacedOrigin - end do - end if - end do - - ! write(*, '(3I5,F4.1,A,F4.1,A,F4.1)') i,j,k, & - ! (i+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(1)+1)/2.0," ", & - ! (j+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(2)+1)/2.0," ", & - ! (k+1)/2.0-(CONTROL_instance%TRANSLATION_SCAN_GRID(3)+1)/2.0 - end if - end if - end do - end do - end do - - end do - - else if(trim(this%transformationType).eq."ROTATION") then - - allocate(X(CONTROL_instance%ROTATIONAL_SCAN_GRID),& - Y(CONTROL_instance%ROTATIONAL_SCAN_GRID),& - Z(CONTROL_instance%ROTATIONAL_SCAN_GRID),& - W(CONTROL_instance%ROTATIONAL_SCAN_GRID)) - - call Lebedev_angularGrid(X(:),Y(:),Z(:),W(:),CONTROL_instance%ROTATIONAL_SCAN_GRID) - - do center=1, this%numberOfTransformedCenters - displacementId=0 - - do i=1,CONTROL_instance%ROTATIONAL_SCAN_GRID - do j=1,CONTROL_instance%NESTED_ROTATIONAL_GRIDS - displacementId=displacementId+1 - if(displacementId .eq. transformationCounter(center) ) then - do p=1, size(displacedMolecularSystem%allParticles) - if(this%rotationCenterList(p,1).eq. center ) then - - do q=1, size(originalMolecularSystem%allParticles) - if(this%rotationCenterList(q,1) .eq. center ) then - centerX=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(1) - centerY=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(2) - centerZ=originalMolecularSystem%allParticles(this%rotationCenterList(q,2))%particlePtr%origin(3) - end if - end do - - distanceToCenter=sqrt((originalMolecularSystem%allParticles(p)%particlePtr%origin(1)-centerX)**2 & - +(originalMolecularSystem%allParticles(p)%particlePtr%origin(2)-centerY)**2 & - +(originalMolecularSystem%allParticles(p)%particlePtr%origin(3)-centerZ)**2) - - distanceToCenter=distanceToCenter+& - CONTROL_instance%NESTED_GRIDS_DISPLACEMENT*(j-(CONTROL_instance%NESTED_ROTATIONAL_GRIDS+1)/2.0) - - displacedOrigin(1)=centerX+X(i)*distanceToCenter - displacedOrigin(2)=centerY+Y(i)*distanceToCenter - displacedOrigin(3)=centerZ+Z(i)*distanceToCenter - - ! call ParticleManager_setOrigin( MolecularSystem_instance%allParticles(p)%particlePtr, displacedOrigin ) - displacedMolecularSystem%allParticles(p)%particlePtr%origin=displacedOrigin - do mu = 1, displacedMolecularSystem%allParticles(p)%particlePtr%basis%length - displacedMolecularSystem%allParticles(p)%particlePtr%basis%contraction(mu)%origin = displacedOrigin - end do - end if - end do - end if - end do - end do - end do - end if - - end subroutine NonOrthogonalCI_transformCoordinates - - !> - !! @brief Computes the distance between the particles of latest generated molecular system with all the previous saved ones - !! - !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles - !< - subroutine NonOrthogonalCI_checkNewSystemDisplacement(this,newMolecularSystem,closestSystem,displacement) - implicit none - type(NonOrthogonalCI) :: this - type(MolecularSystem) :: newMolecularSystem - integer :: closestSystem - real(8) :: displacement - - integer :: sysI, i - type(Vector), allocatable :: displacementVector(:) - real(8) :: dispSum - - displacement=1.0E8 - - allocate(displacementVector(newMolecularSystem%numberOfQuantumSpecies)) - - do sysI=1, this%numberOfDisplacedSystems - - call MolecularSystem_GetTwoSystemsDisplacement(this%molecularSystems(sysI), newMolecularSystem, displacementVector) - - dispSum=0.0 - do i=1, newMolecularSystem%numberOfQuantumSpecies - dispSum=dispSum+sum(displacementVector(i)%values(:)) - end do - if(dispSum .lt. displacement ) then - displacement=dispSum - closestSystem=sysI - if(displacement .lt. CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) exit - end if - end do - - deallocate(displacementVector) - - end subroutine NonOrthogonalCI_checkNewSystemDisplacement - - - !> - !! @brief Finds the maximum of the distances between the basis set center of a particle to its closest neighbour with opposite charge - !! - !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles - !< - subroutine NonOrthogonalCI_checkOppositeChargesDistance(molSys,minNPDistance,skip) - implicit none - type(MolecularSystem) :: molSys - real(8) :: minNPDistance - logical :: skip - - integer :: p,q - real(8) :: npDistance - - - minNPDistance=1E8 - do p=1, size(molSys%allParticles)-1 - if(.not.(molSys%allParticles(p)%particlePtr%translationCenter .ne. 0 .or. & - molSys%allParticles(p)%particlePtr%rotateAround .ne. 0)) cycle - do q=p+1, size(molSys%allParticles) - if(.not.(molSys%allParticles(q)%particlePtr%translationCenter .ne. 0 .or. & - molSys%allParticles(q)%particlePtr%rotateAround .ne. 0)) cycle - if( molSys%allParticles(p)%particlePtr%charge*molSys%allParticles(q)%particlePtr%charge .gt. 0.0 ) cycle - npDistance=sqrt(& - (molSys%allParticles(p)%particlePtr%origin(1)-molSys%allParticles(q)%particlePtr%origin(1))**2+& - (molSys%allParticles(p)%particlePtr%origin(2)-molSys%allParticles(q)%particlePtr%origin(2))**2+& - (molSys%allParticles(p)%particlePtr%origin(3)-molSys%allParticles(q)%particlePtr%origin(3))**2) - if(npDistance .lt. minNPDistance) minNPDistance=npDistance - end do - end do - - if(minNPDistance .gt. CONTROL_instance%CONFIGURATION_MAX_NP_DISTANCE) skip=.true. - - end subroutine NonOrthogonalCI_checkOppositeChargesDistance - - !> - !! @brief Finds the maximum of the distances between the basis set center of a particle to its closest neighbour with the same charge - !! - !! @param this, output: closestSystem: ID of previous system closest to the new one, displacement: sum of the distances between particles - !< - subroutine NonOrthogonalCI_checkSameChargesDistance(molSys,distance,skip) - implicit none - type(MolecularSystem) :: molSys - real(8) :: distance - logical :: skip - - real(8) :: minPPDistance - - integer :: p,q - real(8) :: ppDistance - - - minPPDistance=1.0E8 - do p=1, size(molSys%allParticles)-1 - if(.not.(molSys%allParticles(p)%particlePtr%translationCenter .ne. 0 .or. & - molSys%allParticles(p)%particlePtr%rotateAround .ne. 0)) cycle - do q=p+1, size(molSys%allParticles) - if(.not.(molSys%allParticles(q)%particlePtr%translationCenter .ne. 0 .or. & - molSys%allParticles(q)%particlePtr%rotateAround .ne. 0)) cycle - if( molSys%allParticles(p)%particlePtr%charge*molSys%allParticles(q)%particlePtr%charge .lt. 0.0 ) cycle - - ppDistance=sqrt(& - (molSys%allParticles(p)%particlePtr%origin(1)-molSys%allParticles(q)%particlePtr%origin(1))**2+& - (molSys%allParticles(p)%particlePtr%origin(2)-molSys%allParticles(q)%particlePtr%origin(2))**2+& - (molSys%allParticles(p)%particlePtr%origin(3)-molSys%allParticles(q)%particlePtr%origin(3))**2) - if(ppDistance .lt. minPPDistance) minPPDistance=ppDistance - - end do - end do - - if(minPPDistance .gt. CONTROL_instance%CONFIGURATION_MAX_PP_DISTANCE) skip=.true. - if(minPPDistance .lt. CONTROL_instance%CONFIGURATION_MIN_PP_DISTANCE) skip=.true. - - end subroutine NonOrthogonalCI_checkSameChargesDistance - - !> - !! @brief Classify the new system by comparing its distance matrix to previosly saved systems - !! - !! @param this, systemType: integer defining system equivalence type, newSystemFlag: returns if the system is new or not - !< - ! subroutine NonOrthogonalCI_classifyNewSystem(this, systemType, newSystemFlag) - ! implicit none - ! type(NonOrthogonalCI) :: this - ! integer :: systemType - ! logical :: newSystemFlag - - ! type(MolecularSystem) :: currentMolecularSystem - ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix - - ! integer :: sysI, i, checkingType - ! logical :: match - - ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance) - ! systemType=0 - ! newSystemFlag=.true. - ! currentDistanceMatrix=ParticleManager_getDistanceMatrix() - - ! ! print *, "Current distance matrix" - ! ! call Matrix_show(currentDistanceMatrix) - - ! types: do checkingType=1, this%numberOfUniqueSystems - ! ! print *, "checkingType", checkingType - ! systems: do sysI=1, this%numberOfDisplacedSystems - - ! if(this%systemTypes%values(sysI) .eq. checkingType) then - ! call MolecularSystem_copyConstructor(molecularSystem_instance, this%molecularSystems(sysI)) - - ! previousDistanceMatrix=ParticleManager_getDistanceMatrix() - - ! ! print *, "Comparing with previous distance matrix", checkingType - ! ! call Matrix_show(previousDistanceMatrix) - - ! match=.true. - ! do i=1, size(currentDistanceMatrix%values(:,1)) - ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. & - ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then - ! match=.false. - ! exit - ! end if - ! end do - - ! ! print *, "match?", match - - ! if(match) then - ! systemType=this%systemTypes%values(sysI) - ! newSystemFlag=.false. - ! exit types - ! else - ! cycle types - ! end if - ! end if - ! end do systems - ! end do types - - ! ! print *, "newSystemFlag", newSystemFlag - - ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem) - - ! end subroutine NonOrthogonalCI_classifyNewSystem - - !> - !! @brief Run a Hartree-Fock calculation at displaced geometries and fill CI matrix diagonals - !! - !! @param this -> NOCI instance - !< - subroutine NonOrthogonalCI_runHFs(this) - implicit none - type(NonOrthogonalCI) :: this - - integer :: sysI, speciesID, otherSpeciesID - integer :: coordsUnit - real(8) :: timeA - character(100) :: coordsFile - - !$ timeA = omp_get_wtime() - !!Read HF energy of the non displaced SCF calculation - ! print *, "HF reference energy is ", hfEnergy - - allocate(this%HFCoefficients(this%numberOfDisplacedSystems,molecularSystem_instance%numberOfQuantumSpecies)) - allocate(this%systemLabels(this%numberOfDisplacedSystems)) - - call Matrix_constructor(this%configurationHamiltonianMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) - call Matrix_constructor(this%configurationOverlapMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) - call Vector_constructor(this%configurationCorrelationEnergies, this%numberOfDisplacedSystems, 0.0_8) - do speciesID=1, MolecularSystem_instance%numberOfQuantumSpecies - call Matrix_constructor(this%configurationKineticMatrix(speciesID), & - int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) - call Matrix_constructor(this%configurationPuntualMatrix(speciesID), & - int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) - call Matrix_constructor(this%configurationExternalMatrix(speciesID), & - int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) - call Matrix_constructor(this%configurationExchangeMatrix(speciesID), & - int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) - do otherSpeciesID=speciesID, MolecularSystem_instance%numberOfQuantumSpecies - call Matrix_constructor(this%configurationHartreeMatrix(speciesID,otherSpeciesID), & - int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) - end do - end do - - coordsUnit=333 - coordsFile=trim(CONTROL_instance%INPUT_FILE)//"NOCI.coords" - open(unit=coordsUnit, file=trim(coordsFile), status="replace", form="formatted") - - if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then - print *, "running KS calculations at the displaced geometries ... saving results on file ", coordsFile - else - print *, "running HF calculations at the displaced geometries ... saving results on file ", coordsFile - end if - - - write (coordsUnit,'(A25,I20)') "numberOfDisplacedSystems ", this%numberOfDisplacedSystems - - do sysI=1, this%numberOfDisplacedSystems - write(this%systemLabels(sysI), '(A)') trim(this%molecularSystems(sysI)%description) - - !!Do SCF without calling lowdin-scf.x - call MolecularSystem_copyConstructor(molecularSystem_instance, this%molecularSystems(sysI)) - CONTROL_instance%PRINT_LEVEL=0 - - if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) & - call MolecularSystem_saveToFile() - - if(allocated(WaveFunction_instance)) deallocate(WaveFunction_instance) - allocate(WaveFunction_instance(molecularSystem_instance%numberOfQuantumSpecies)) - - call MultiSCF_constructor(MultiSCF_instance,WaveFunction_instance,CONTROL_instance%ITERATION_SCHEME) - - call MultiSCF_buildHcore(MultiSCF_instance,WaveFunction_instance) - - call MultiSCF_getInitialGuess(MultiSCF_instance,WaveFunction_instance) - - if (CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then - if(allocated(Libint2Instance)) deallocate(Libint2Instance) - allocate(Libint2Instance(MolecularSystem_instance%numberOfQuantumSpecies)) - call DirectIntegralManager_constructor(Libint2Instance,MolecularSystem_instance) - do speciesID=1, MolecularSystem_instance%numberOfQuantumSpecies - call DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(& - speciesID, & - WaveFunction_instance(speciesID)%densityMatrix, & - WaveFunction_instance(speciesID)%fourCenterIntegrals(speciesID)%values, & - MolecularSystem_instance,Libint2Instance(speciesID)) - end do - - do speciesID=1, MolecularSystem_instance%numberOfQuantumSpecies-1 - do otherSpeciesID=speciesID+1, MolecularSystem_instance%numberOfQuantumSpecies - call DirectIntegralManager_getDirectInterRepulsionIntegralsAll(& - speciesID, otherSpeciesID, & - WaveFunction_instance(speciesID)%densityMatrix, & - WaveFunction_instance(speciesID)%fourCenterIntegrals(otherSpeciesID)%values, & - MolecularSystem_instance,Libint2Instance(speciesID),Libint2Instance(otherSpeciesID)) - end do - end do - end if - - call MultiSCF_solveHartreeFockRoothan(MultiSCF_instance,WaveFunction_instance,Libint2Instance) - - !Save HF results - ! call MultiSCF_saveWfn(MultiSCF_instance,WaveFunction_instance) - call MolecularSystem_copyConstructor(this%molecularSystems(sysI),molecularSystem_instance) - this%configurationHamiltonianMatrix%values(sysI,sysI)=MultiSCF_instance%totalEnergy - - do speciesID = 1, molecularSystem_instance%numberOfQuantumSpecies - this%HFCoefficients(sysI,speciesID) = WaveFunction_instance(speciesID)%waveFunctionCoefficients - - this%configurationKineticMatrix(speciesID)%values(sysI,sysI)=WaveFunction_instance(speciesID)%kineticEnergy - this%configurationPuntualMatrix(speciesID)%values(sysI,sysI)=WaveFunction_instance(speciesID)%puntualInteractionEnergy - this%configurationExternalMatrix(speciesID)%values(sysI,sysI)=WaveFunction_instance(speciesID)%externalPotentialEnergy - this%configurationExchangeMatrix(speciesID)%values(sysI,sysI)=WaveFunction_instance(speciesID)%exchangeHFEnergy - do otherSpeciesID = speciesID, molecularSystem_instance%numberOfQuantumSpecies - this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysI)=& - WaveFunction_instance(speciesID)%hartreeEnergy(otherSpeciesID) - end do - end do - - ! Compute HF energy with KS determinants - if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then - if(CONTROL_instance%METHOD.eq."RKS") then - CONTROL_instance%METHOD="RHF" - else - CONTROL_instance%METHOD="UHF" - end if - - do speciesID = 1, molecularSystem_instance%numberOfQuantumSpecies - WaveFunction_instance(speciesID)%exchangeCorrelationEnergy=0.0_8 - WaveFunction_instance(speciesID)%exchangeCorrelationMatrix%values=0.0_8 - WaveFunction_instance(speciesID)%exactExchangeFraction=1.0_8 - end do - call MultiSCF_obtainFinalEnergy(MultiSCF_instance,WaveFunction_instance,Libint2Instance) - !Difference between HF and KS energies - this%configurationCorrelationEnergies%values(sysI)=this%configurationHamiltonianMatrix%values(sysI,sysI)-MultiSCF_instance%totalEnergy - - if(CONTROL_instance%METHOD.eq."RHF") then - CONTROL_instance%METHOD="RKS" - else - CONTROL_instance%METHOD="UKS" - end if - end if - - write (coordsUnit,'(A10,I10,A10,ES20.12,A20,ES20.12)') "Geometry ", sysI, "Energy", this%configurationHamiltonianMatrix%values(sysI,sysI), & - "Correlation energy", this%configurationCorrelationEnergies%values(sysI) - call MolecularSystem_showCartesianMatrix(MolecularSystem_instance,unit=coordsUnit) - - if (this%numberOfDisplacedSystems .le. this%printMatrixThreshold) then - write (*,'(A10,I10,A10,ES20.12,A20,ES20.12)') "Geometry ", sysI, "Energy", this%configurationHamiltonianMatrix%values(sysI,sysI), & - "Correlation energy", this%configurationCorrelationEnergies%values(sysI) - call MolecularSystem_showCartesianMatrix(MolecularSystem_instance) - ! do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - ! print *, "sysI", sysI, "speciesID", speciesID, "occupation number", MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) - ! end do - end if - - call DirectIntegralManager_destructor(Libint2Instance) - call MultiSCF_destructor(MultiSCF_instance) - - !!Screen geometries with high energies - ! if( CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD .ne. 0.0 .and. & - ! testEnergy .gt. this%refEnergy+CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD) then - ! write (coordsUnit,"(A,F20.12)") "Skipping system with high energy", testEnergy - ! this%numberOfEnergyRejectedSystems=this%numberOfEnergyRejectedSystems+1 - ! else - ! if(this%numberOfEnergyRejectedSystems .gt. 0) & - ! write (*,'(A10,I10,A,F18.12)') "Rejected ", this%numberOfEnergyRejectedSystems, & - ! " geometries with energy higher than", this%refEnergy+CONTROL_instance%CONFIGURATION_ENERGY_THRESHOLD - - end do - - close(coordsUnit) -!$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for HF calculations at displaced geometries : ", omp_get_wtime() - timeA ," (s)" - - end subroutine NonOrthogonalCI_runHFs - - ! > - ! @brief Saves molecular system and wfn files for a displaced system - - ! @param systemID - ! < - subroutine NonOrthogonalCI_saveSystem(this, newSystem) - implicit none - type(NonOrthogonalCI) :: this - type(MolecularSystem) :: newSystem - - type(MolecularSystem), allocatable :: tempMolecularSystems(:) - integer :: i - - !!Increase the size of the molecular systems array by 1 - this%numberOfDisplacedSystems=this%numberOfDisplacedSystems+1 - - allocate(tempMolecularSystems(size(this%MolecularSystems))) - - do i=1, size(this%MolecularSystems) - call MolecularSystem_copyConstructor(tempMolecularSystems(i),this%MolecularSystems(i)) - end do - - deallocate(this%MolecularSystems) - allocate(this%MolecularSystems(this%numberOfDisplacedSystems)) - - do i=1, size(tempMolecularSystems) - call MolecularSystem_copyConstructor(this%MolecularSystems(i),tempMolecularSystems(i)) - end do - - deallocate(tempMolecularSystems) - !!Copy the molecular system to the NonOrthogonalCI object - - call MolecularSystem_copyConstructor(this%MolecularSystems(this%numberOfDisplacedSystems), newSystem) - - end subroutine NonOrthogonalCI_saveSystem - - !> - !! @brief Computes overlap and hamiltonian non orthogonal CI matrices for previously calculated molecular systems at different geometries - !! - !! @param this - !< - subroutine NonOrthogonalCI_buildOverlapAndHamiltonianMatrix(this) - implicit none - type(NonOrthogonalCI) :: this - type(MolecularSystem), allocatable :: mergedMolecularSystem(:) - type(Libint2Interface), allocatable :: Libint2ParallelInstance(:,:) - integer, allocatable :: sysIbatch(:), sysIIbatch(:) - integer :: sysI,sysII,me,mySysII - type(Matrix), allocatable :: mergedCoefficients(:), inverseOverlapMatrices(:) - type(IVector), allocatable :: sysIbasisList(:,:),sysIIbasisList(:,:) - real(8) :: overlapUpperBound - integer :: prescreenedElements, overlapScreenedElements - - integer :: speciesID, otherSpeciesID - integer :: nspecies - integer :: ncores, batchSize, upperBound - - integer :: matrixUnit - character(100) :: matrixFile - real(8) :: empiricalScaleFactor - - real(8) :: timeMerging, timePrescreen, timeOverlap, timeTwoIntegrals - real(8) :: timeA - real(8) :: timeB - - timePrescreen=0.0 - timeOverlap=0.0 - timeTwoIntegrals=0.0 - - print *, "" - print *, "A prescreening of the overlap matrix elements is performed for the heavy species" - write (*,'(A,ES8.1)') "Overlap and Hamiltonian matrix elements are saved for pairs with overlap higher than",& - CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD - print *, "For pairs with lower overlap, setting H(I,II)=0, S(I,II)=0" - print *, "" - - prescreenedElements=0 - overlapScreenedElements=0 - - matrixUnit=290 - matrixFile= trim(CONTROL_instance%INPUT_FILE)//"NOCI-Matrix.ci" - - print *, "computing NOCI overlap and hamiltonian matrices... saving them to ", trim(matrixFile) - - open(unit=matrixUnit, file=trim(matrixFile), status="replace", form="formatted") - - write (matrixUnit,'(A20,I20)') "MatrixSize", this%numberOfDisplacedSystems - write (matrixUnit,'(A10,A10,A20,A20)') "Conf. ", "Conf. ", "Overlap ","Hamiltonian " - - !Allocate objets to distribute in parallel - nspecies=molecularSystem_instance%numberOfQuantumSpecies - ncores=CONTROL_instance%NUMBER_OF_CORES - batchSize=this%numberOfDisplacedSystems - print *, "ncores", ncores, "batchsize", batchSize - - allocate(mergedMolecularSystem(batchSize),& - mergedCoefficients(nspecies),& - inverseOverlapMatrices(nspecies),& - Libint2ParallelInstance(nspecies,batchSize),& - sysIbatch(batchSize),& - sysIIbatch(batchSize),& - sysIbasisList(nspecies,batchSize),& - sysIIbasisList(nspecies,batchSize)) - - if(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) then - upperBound=1 - this%printMatrixThreshold=this%numberOfDisplacedSystems - else - upperBound=this%numberOfDisplacedSystems - end if - ! print *, "upperBound", upperBound - - systemI: do sysI=1, upperBound - - this%configurationOverlapMatrix%values(sysI,sysI)=1.0 - !Save diagonal elements - write (matrixUnit,'(I10,I10,ES20.12,ES20.12)') sysI, sysI, & - this%configurationOverlapMatrix%values(sysI,sysI), this%configurationHamiltonianMatrix%values(sysI,sysI) - - sysII=sysI - systemII: do while(sysII.lt.this%numberOfDisplacedSystems) - - ! print *, "distributing sysII", sysII, "into", batchSize, "batches" - !In serial, prepare systems - sysIIbatch(:)=0 - me=0 - mySysII=sysII - - do while(me.lt.batchSize) - mySysII=mySysII+1 - if(mySysII .gt. this%numberOfDisplacedSystems) exit - - !$ timeA = omp_get_wtime() - !Estimates overlap with a 1s-1s integral approximation - call NonOrthogonalCI_prescreenOverlap(this,sysI,mySysII,overlapUpperBound) - - if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. & - overlapUpperBound .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then - ! print *, "preskipping elements", sysI, mySysII, "with overlap estimated as", overlapUpperBound - prescreenedElements=prescreenedElements+1 - else - !$ timeB = omp_get_wtime() - !$ timePrescreen=timePrescreen+(timeB - timeA) - me=me+1 - sysIIbatch(me)=mySysII - !$ timeA = omp_get_wtime() - !This generates a new molecular system - ! print *, "Merging systems from geometries ", sysI, mySysII - call MolecularSystem_mergeTwoSystems(mergedMolecularSystem(me), & - this%molecularSystems(sysI), this%molecularSystems(mySysII),sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me)) - ! call MolecularSystem_showInformation() - ! call MolecularSystem_showParticlesInformation() - ! call MolecularSystem_showCartesianMatrix(mergedMolecularSystem) - call DirectIntegralManager_constructor(Libint2ParallelInstance(1:nspecies,me),mergedMolecularSystem(me)) - !$ timeB = omp_get_wtime() - !$ timeMerging=timeMerging+(timeB - timeA) - end if - end do - - !In parallel, fill matrices - - call OMP_set_num_threads(ncores) - !$omp parallel & - !$omp& private(mySysII,mergedCoefficients,inverseOverlapMatrices),& - !$omp& shared(this,sysI,sysII,matrixUnit,prescreenedElements,overlapScreenedElements,sysIbasisList,sysIIbasisList,mergedMolecularSystem,Libint2ParallelInstance,nspecies,batchSize) - !$omp do schedule(dynamic,10) - procs: do me=1, batchSize - mySysII=sysIIbatch(me) - - if(mySysII .eq. 0) cycle procs - - ! print *, "evaluating S and H elements for", sysI, mySysII - - ! cycle systemII - !! Merge occupied coefficients into a single matrix - call NonOrthogonalCI_mergeCoefficients(this%HFCoefficients(sysI,:),this%HFCoefficients(mySysII,:),& - this%molecularSystems(sysI),this%molecularSystems(mySysII),mergedMolecularSystem(me),& - sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me),mergedCoefficients) - !$ timeA = omp_get_wtime() - - call NonOrthogonalCI_computeOverlapAndHCoreElements(this,sysI,mySysII,mergedMolecularSystem(me),mergedCoefficients,& - sysIbasisList(1:nspecies,me),sysIIbasisList(1:nspecies,me),inverseOverlapMatrices) - !$ timeB = omp_get_wtime() - !$ timeOverlap=timeOverlap+(timeB - timeA) - - !! SKIP ENERGY EVALUATION IF OVERLAP IS TOO LOW - - if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. & - abs(this%configurationOverlapMatrix%values(sysI,mySysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then - ! print *, "screening elements", sysI, mySysII, "with overlap", this%configurationOverlapMatrix%values(sysI,mySysII) - this%configurationOverlapMatrix%values(sysI,mySysII)=0.0 - this%configurationHamiltonianMatrix%values(sysI,mySysII)=0.0 - !$OMP ATOMIC - overlapScreenedElements=overlapScreenedElements+1 - ! cycle systemII - else - !$ timeA = omp_get_wtime() - call NonOrthogonalCI_twoParticlesContributions(this,sysI,mySysII,mergedMolecularSystem(me),& - inverseOverlapMatrices,mergedCoefficients,Libint2ParallelInstance(1:nspecies,me)) - !$ timeB = omp_get_wtime() - !$ timeTwoIntegrals=timeTwoIntegrals+(timeB - timeA) - end if - - ! print *, "thread", omp_get_thread_num()+1,"me", me, "sysI", " mySysII", sysI, mySysII, "S", this%configurationOverlapMatrix%values(sysI,mySysII), "H", this%configurationHamiltonianMatrix%values(sysI,mySysII) - end do procs - !$omp end do nowait - !$omp end parallel - - !In serial, symmetrize, free memory and print - do me=1, batchSize - mySysII=sysIIbatch(me) - - if(mySysII .eq. 0) exit systemII - - !DFT energy correction for off diagonal elements - if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then - this%configurationHamiltonianMatrix%values(sysI,mySysII)=this%configurationHamiltonianMatrix%values(sysI,mySysII)+& - this%configurationOverlapMatrix%values(sysI,mySysII)/2.0*& - (this%configurationCorrelationEnergies%values(sysI)+& - this%configurationCorrelationEnergies%values(mySysII)) - end if - - !Yu2020 magical empirical correction - if(CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION .and. & - abs(this%configurationOverlapMatrix%values(sysI,mySysII)) .gt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) then - empiricalScaleFactor=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A*& - abs(this%configurationOverlapMatrix%values(sysI,mySysII))**CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B/& - abs(this%configurationOverlapMatrix%values(sysI,mySysII)) - this%configurationOverlapMatrix%values(sysI,mySysII)=& - this%configurationOverlapMatrix%values(sysI,mySysII)*empiricalScaleFactor - this%configurationHamiltonianMatrix%values(sysI,mySysII)=& - this%configurationHamiltonianMatrix%values(sysI,mySysII)*empiricalScaleFactor - do speciesID=1, nspecies - this%configurationKineticMatrix(speciesID)%values(sysI,mySysII)=& - this%configurationKineticMatrix(speciesID)%values(sysI,mySysII)*empiricalScaleFactor - this%configurationPuntualMatrix(speciesID)%values(sysI,mySysII)=& - this%configurationPuntualMatrix(speciesID)%values(sysI,mySysII)*empiricalScaleFactor - this%configurationExternalMatrix(speciesID)%values(sysI,mySysII)=& - this%configurationExternalMatrix(speciesID)%values(sysI,mySysII)*empiricalScaleFactor - this%configurationExchangeMatrix(speciesID)%values(sysI,mySysII)=& - this%configurationExchangeMatrix(speciesID)%values(sysI,mySysII)*empiricalScaleFactor - do otherSpeciesID=speciesID, nspecies - this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,mySysII)=& - this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,mySysII)*empiricalScaleFactor - end do - end do - end if - - !Symmetrize - this%configurationOverlapMatrix%values(mySysII,sysI)=this%configurationOverlapMatrix%values(sysI,mySysII) - this%configurationHamiltonianMatrix%values(mySysII,sysI)=this%configurationHamiltonianMatrix%values(sysI,mySysII) - - do speciesID=1, nspecies - this%configurationKineticMatrix(speciesID)%values(mySysII,sysI)=this%configurationKineticMatrix(speciesID)%values(sysI,mySysII) - this%configurationPuntualMatrix(speciesID)%values(mySysII,sysI)=this%configurationPuntualMatrix(speciesID)%values(sysI,mySysII) - this%configurationExternalMatrix(speciesID)%values(mySysII,sysI)=this%configurationExternalMatrix(speciesID)%values(sysI,mySysII) - this%configurationExchangeMatrix(speciesID)%values(mySysII,sysI)=this%configurationExchangeMatrix(speciesID)%values(sysI,mySysII) - do otherSpeciesID=speciesID, nspecies - this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(mySysII,sysI)=& - this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,mySysII) - end do - end do - - write (matrixUnit,'(I10,I10,ES20.12,ES20.12)') sysI, mySysII, & - this%configurationOverlapMatrix%values(sysI,mySysII), this%configurationHamiltonianMatrix%values(sysI,mySysII) - - if (this%numberOfDisplacedSystems .le. this%printMatrixThreshold) then - write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, "Overlap element = ", this%configurationOverlapMatrix%values(sysI,mySysII) - write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, "Hamiltonian element = ", this%configurationHamiltonianMatrix%values(sysI,mySysII) - - do speciesID = 1, nspecies - write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( this%molecularSystems(sysI)%species(speciesID)%name ) // & - " Kinetic element = ", this%configurationKineticMatrix(speciesID)%values(sysI,mySysII) - write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( this%molecularSystems(sysI)%species(speciesID)%name ) // & - " Puntual element = ", this%configurationPuntualMatrix(speciesID)%values(sysI,mySysII) - if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & - write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( this%molecularSystems(sysI)%species(speciesID)%name ) // & - " External element = ", this%configurationExternalMatrix(speciesID)%values(sysI,mySysII) - end do - do speciesID=1, nspecies - write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( this%molecularSystems(sysI)%species(speciesID)%name ) // & - " Exchange element = ", this%configurationExchangeMatrix(speciesID)%values(sysI,mySysII) - do otherSpeciesID=speciesID, nspecies - write (*,'(I10,I10,A38,ES20.12)') sysI, mySysII, trim( MolecularSystem_instance%species(speciesID)%name ) // & - "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // & - " Hartree element = ", this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,mySysII) - end do - end do - print *, "" - - end if - - call DirectIntegralManager_destructor(Libint2ParallelInstance(1:nspecies,me)) - end do - sysII=mySysII - - end do systemII - - end do systemI - - close(matrixUnit) - - print *, "" - print *, "Configuration pairs skipped by overlap prescreening: ", prescreenedElements - print *, "Configuration pairs skipped by overlap screening: ", overlapScreenedElements - print *, "Overlap integrals computed for ", this%numberOfDisplacedSystems*(this%numberOfDisplacedSystems-1)/2& - -prescreenedElements, "configuration pairs" - print *, "Four center integrals computed for", this%numberOfDisplacedSystems*(this%numberOfDisplacedSystems-1)/2& - -prescreenedElements-overlapScreenedElements, "configuration pairs" - print *, "" - - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for overlap prescreening : ", timePrescreen ," (s)" - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for merging systems : ", timeMerging ," (s)" - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for two index integrals : ", timeOverlap ," (s)" - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for four index integrals : ", timeTwoIntegrals ," (s)" - - print *, "" - - deallocate(mergedMolecularSystem,& - mergedCoefficients,& - inverseOverlapMatrices,& - Libint2ParallelInstance,& - sysIbatch,& - sysIIbatch,& - sysIbasisList,& - sysIIbasisList) - - ! integer :: symmetryEquivalentElements - ! timeSymmetry=0.0 - ! symmetryEquivalentElements=0 - ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then - ! write (matrixUnit,'(A10,A10,A10,A20,A20)') "Conf. ", "Conf. ", "Type ", "Overlap ","Hamiltonian " - ! else - ! end if - ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then - ! write (matrixUnit,'(I10,I10,I10,ES20.12,ES20.12)') sysI, sysI, this%configurationPairTypes%values(sysI,sysI), & - ! this%configurationOverlapMatrix%values(sysI,sysI), this%configurationHamiltonianMatrix%values(sysI,sysI) - ! else - ! end if - ! write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for element symmetry : ", timeSymmetry ," (s)" - ! !$ timeA = omp_get_wtime() - ! !!Check symmetry of the element - ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then - ! call NonOrthogonalCI_classifyConfigurationPair(this,sysI,sysII,newPairFlag) - ! !$ timeB = omp_get_wtime() - ! !$ timeSymmetry=timeSymmetry+(timeB - timeA) - - ! !!Copy results from previously computed equivalent elements - ! if (newPairFlag .eqv. .false.) then - ! do preSysI=1, sysI - ! do preSysII=preSysI+1, sysII - ! if(this%configurationPairTypes%values(preSysI,preSysII) .eq. this%configurationPairTypes%values(sysI,sysII)) then - ! this%configurationOverlapMatrix%values(sysI,sysII)=this%configurationOverlapMatrix%values(preSysI,preSysII) - ! this%configurationOverlapMatrix%values(sysII,sysI)=this%configurationOverlapMatrix%values(sysI,sysII) - ! this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(preSysI,preSysII) - ! this%configurationHamiltonianMatrix%values(sysII,sysI)=this%configurationHamiltonianMatrix%values(sysI,sysII) - ! symmetryEquivalentElements=symmetryEquivalentElements+1 - - ! if( this%configurationOverlapMatrix%values(sysI,sysII) .ne. 0.0) & - ! write (*,'(A,I10,I10,A,I10,A,ES20.12,ES20.12)') "Pair ",sysI, sysII," is type ", & - ! this%configurationPairTypes%values(sysI,sysII), " Overlap and Hamiltonian elements", & - ! this%configurationOverlapMatrix%values(sysI,sysII), this%configurationHamiltonianMatrix%values(sysI,sysII) - - ! cycle systemII - ! end if - ! end do - ! end do - ! end if - ! end if - !!This is a symmetry test, assume positive phase - ! if( this%configurationOverlapMatrix%values(sysI,sysII) .lt. 0.0) then - ! this%configurationOverlapMatrix%values(sysI,sysII)=-this%configurationOverlapMatrix%values(sysI,sysII) - ! this%configurationOverlapMatrix%values(sysII,sysI)=-this%configurationOverlapMatrix%values(sysII,sysI) - ! this%configurationHamiltonianMatrix%values(sysI,sysII)=-this%configurationHamiltonianMatrix%values(sysI,sysII) - ! this%configurationHamiltonianMatrix%values(sysII,sysI)=-this%configurationHamiltonianMatrix%values(sysII,sysI) - ! end if - - ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) then - ! write (matrixUnit,'(I10,I10,I10,ES20.12,ES20.12)') sysI, sysII, this%configurationPairTypes%values(sysI,sysII), & - ! this%configurationOverlapMatrix%values(sysI,sysII), this%configurationHamiltonianMatrix%values(sysI,sysII) - ! else - ! if(CONTROL_instance%CONFIGURATION_USE_SYMMETRY .eqv. .true.) & - ! print *, "Configuration pairs skipped by symmetry equivalence: ", symmetryEquivalentElements - - end subroutine NonOrthogonalCI_buildOverlapAndHamiltonianMatrix - - - !> - !! @brief Merges the occupied orbitals coefficients from two systems - !! @param occupationI and occupationII: Number of orbitals to merge from each matrix. - !! sysBasisList: array indicating which basis functions of the merged molecular system belong to sysI and sysII Merged Coefficients: Matrices for output. - !< - subroutine NonOrthogonalCI_mergeCoefficients(coefficientsI,coefficientsII,molecularSystemI,molecularSystemII,mergedMolecularSystem,& - sysIbasisList,sysIIbasisList,mergedCoefficients) - type(Matrix), intent(in) :: coefficientsI(*), coefficientsII(*) - type(MolecularSystem), intent(in) :: molecularSystemI, molecularSystemII, mergedMolecularSystem - type(IVector), intent(in) :: sysIbasisList(*), sysIIbasisList(*) - type(Matrix), intent(out) :: mergedCoefficients(*) - - ! character(100) :: wfnFile - ! character(50) :: arguments(2) - ! integer :: wfnUnit - integer :: speciesID, i, j, mu - - !! Mix coefficients of occupied orbitals of both systems - !!Create a dummy density matrix to lowdin.wfn file - ! wfnUnit = 500 - ! wfnFile = "lowdin.wfn" - ! open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted") - do speciesID = 1, mergedMolecularSystem%numberOfQuantumSpecies - - ! arguments(2) = mergedMolecularSystem%species(speciesID)%name - - ! arguments(1) = "COEFFICIENTS" - - ! !Max: to make the matrix square for the integral calculations for configuration pairs, and rectangular for the merged coefficients of all systems - call Matrix_constructor(mergedCoefficients(speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),8), & - int(max(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem)),8), 0.0_8 ) - - ! print *, "sysI coefficients for ", speciesID - ! call Matrix_show(coefficientsI(speciesID)) - ! print *, "sysII coefficients for ", speciesID - ! call Matrix_show(coefficientsII(speciesID)) - - !sysI orbitals on the left columns, sysII on the right columns - - !sysI coefficients - do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) - if((sysIbasisList(speciesID)%values(mu) .ne. 0) ) then - do i=1, MolecularSystem_getOcupationNumber(speciesID,molecularSystemI)!sysI - mergedCoefficients(speciesID)%values(mu,i)=coefficientsI(speciesID)%values(sysIbasisList(speciesID)%values(mu),i) - ! print *, "sys I", mu, i, mergedCoefficients(speciesID)%values(mu,i) - end do - end if - end do - - ! !sysII coefficients - do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) - if((sysIIbasisList(speciesID)%values(mu) .ne. 0) ) then - do i=1, MolecularSystem_getOcupationNumber(speciesID,molecularSystemII)!sysII - j=MolecularSystem_getOcupationNumber(speciesID,molecularSystemI)+i !column - mergedCoefficients(speciesID)%values(mu,j)=coefficientsII(speciesID)%values(sysIIbasisList(speciesID)%values(mu),i) - ! print *, "sys II", mu, j, mergedCoefficients(speciesID)%values(mu,j) - end do - end if - end do - - ! print *, "Merged coefficients matrix for ", speciesID - ! call Matrix_show(mergedCoefficients(speciesID)) - - ! call Matrix_writeToFile(mergedCoefficients(speciesID), unit=wfnUnit, binary=.true., arguments = arguments ) - - ! arguments(1) = "DENSITY" - ! call Matrix_constructor(auxMatrix, int(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),8), & - ! int(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem),8), 0.0_8 ) - - ! auxMatrix%values=1.0 - - ! do i = 1 , MolecularSystem_getOcupationNumber(speciesID)*2 !!double size A+B - ! do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) - ! do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) - ! auxMatrix%values(mu,nu)=auxMatrix%values(mu,nu)& - ! +MolecularSystem_getEta(speciesID)*mergedCoefficients(speciesID)%values(mu,i)*mergedCoefficients(speciesID)%values(nu,i) - ! end do - ! end do - ! end do - - ! print *, "auxDensity", speciesID - ! call Matrix_show(auxMatrix) - - ! call Matrix_writeToFile(auxMatrix, unit=wfnUnit, binary=.true., arguments = arguments ) - - ! arguments(1) = "ORBITALS" - ! call Vector_constructor(auxVector, MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), 0.0_8 ) - - ! call Vector_writeToFile(auxVector, unit=wfnUnit, binary=.true., arguments = arguments ) - - ! Only occupied orbitals are going to be transformed - handled in integral transformation program - ! print *, "removed", MolecularSystem_getTotalNumberOfContractions(speciesID)-MolecularSystem_getOcupationNumber(speciesID) - ! arguments(1) = "REMOVED-ORBITALS" - ! call Vector_writeToFile(unit=wfnUnit, binary=.true., & - ! value=real(MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem)-MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem),8),& - ! arguments= arguments ) - - end do - ! close(wfnUnit) - - end subroutine NonOrthogonalCI_mergeCoefficients - - - !> - !! @brief Computes an upper bound of the overlap between two configurations, based on the max distance between particles of the same species and the lowest exponent of the basis set functions. Assumes a localized hartree product for the heaviest species - !! - !! @param sysI and sysII: molecular system indices. estimatedOverlap: output value - !< - subroutine NonOrthogonalCI_prescreenOverlap(this,sysI,sysII,estimatedOverlap) - type(NonOrthogonalCI) :: this - integer :: sysI, sysII !Indices of the systems to screen - real(8) :: estimatedOverlap - - type(Vector), allocatable :: displacementVector(:) - integer :: speciesID, k, l, m - real(8) :: massThreshold, minExponent, speciesOverlap - - !displacement vectors contains the max distance between equivalent basis function centers - allocate(displacementVector(this%molecularSystems(sysI)%numberOfQuantumSpecies)) - - call MolecularSystem_GetTwoSystemsDisplacement(this%molecularSystems(sysI), this%molecularSystems(sysII),displacementVector(:)) - - estimatedOverlap=1.0 - - !only compute for heavy particles, maybe should be a control parameter - massThreshold=10.0 - - do speciesID = 1, this%molecularSystems(sysI)%numberOfQuantumSpecies - if(this%molecularSystems(sysI)%species(speciesID)%mass .lt. massThreshold) cycle - speciesOverlap=1.0 - !!get smallest exponent of the basis set - do k = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles) - minExponent=1.0E8 - do l = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction) - do m = 1, size(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents) - if(this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents(m).lt.minExponent) & - minExponent=this%molecularSystems(sysI)%species(speciesID)%particles(k)%basis%contraction(l)%orbitalExponents(m) - !Assume a 1S GTF - ! normCoefficients(speciesID)=(2.0*minExponents(speciesID)/Math_PI)**(3.0/4.0) - end do - end do - !!Compute an hipothetical overlap between two 1S functions with the lowest orbital exponent separated at the distance between systems - speciesOverlap=speciesOverlap*exp(-minExponent*displacementVector(speciesID)%values(k)**2/2.0) - end do - - ! print *, "sysI", sysI, "sysII", sysII, "species", speciesID,"overlap approx", speciesOverlap - estimatedOverlap=estimatedOverlap*speciesOverlap - end do - - deallocate(displacementVector) - - end subroutine NonOrthogonalCI_prescreenOverlap - - !> - !! @brief Classify the sysI and sysII pair according to their distance matrix - !! - !! @param sysI and sysII: molecular system indices. - !< - ! subroutine NonOrthogonalCI_classifyConfigurationPair(this,currentSysI,currentSysII,newPairFlag) - ! implicit none - ! type(NonOrthogonalCI) :: this - ! integer :: currentSysI, currentSysII !Indices of the systems to classify - ! logical :: newPairFlag - - ! type(MolecularSystem) :: currentMolecularSystem - ! type(Matrix) :: currentDistanceMatrix,previousDistanceMatrix - - ! integer :: sysI, sysII, i, checkingType - ! logical :: match - - ! call MolecularSystem_copyConstructor(currentMolecularSystem, molecularSystem_instance) - ! newPairFlag=.true. - ! currentDistanceMatrix=ParticleManager_getDistanceMatrix() - - ! ! print *, "Current distance matrix" - ! ! call Matrix_show(currentDistanceMatrix) - - ! types: do checkingType=1, this%numberOfUniquePairs - ! ! print *, "checkingType", checkingType - ! systemI: do sysI=1, currentSysI - ! systemII: do sysII=sysI+1, currentSysII - - ! if(sysI .eq. currentSysI .and. sysII .eq. currentSysII ) cycle types - - ! if((this%configurationPairTypes%values(sysI,sysII) .eq. checkingType) .and. & - ! (this%systemTypes%values(sysI) .eq. this%systemTypes%values(currentSysI)) .and. & - ! (this%systemTypes%values(sysII) .eq. this%systemTypes%values(currentSysII))) then - - ! ! call MolecularSystem_mergeTwoSystems(molecularSystem_instance, this%MolecularSystems(sysI), this%MolecularSystems(sysII)) - - ! previousDistanceMatrix=ParticleManager_getDistanceMatrix() - - ! ! print *, "Comparing with previous distance matrix", checkingType - ! ! call Matrix_show(previousDistanceMatrix) - - ! match=.true. - ! do i=1, size(currentDistanceMatrix%values(:,1)) - ! if(sum(abs(currentDistanceMatrix%values(i,:) - previousDistanceMatrix%values(i,:))) .gt. & - ! CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE ) then - ! match=.false. - ! exit - ! end if - ! end do - - ! if(match) then - ! newPairFlag=.false. - ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%configurationPairTypes%values(sysI,sysII) - ! exit types - ! else - ! cycle types - ! end if - ! end if - ! end do systemII - ! end do systemI - ! end do types - - ! if(newPairFlag) then - ! this%numberOfUniquePairs=this%numberOfUniquePairs+1 - ! this%configurationPairTypes%values(currentSysI,currentSysII)=this%numberOfUniquePairs - ! end if - - ! if(this%configurationPairTypes%values(currentSysI,currentSysII).eq.0) then - ! print *, "newPairFlag", newPairFlag - ! print *, currentSysI, currentSysII, this%configurationPairTypes%values(currentSysI,currentSysII) - ! STOP "I found a type zero" - ! end if - ! call MolecularSystem_copyConstructor(molecularSystem_instance, currentMolecularSystem) - - ! end subroutine NonOrthogonalCI_classifyConfigurationPair - - - !> - !! @brief Computes overlap matrix element between two configurations along with one particle energy contributions - !! - !! @param sysI and sysII: molecular system indices. Merged Molecular System: Union of objects from sysI and sysII. Merged Coefficients: Mixed molecular system coefficients. Sys basis list indicate the basis functions of each sysI and sysII in the merged molecular system. inverseOverlapMatrices: output required for two particle contributions - !< - subroutine NonOrthogonalCI_computeOverlapAndHCoreElements(this,sysI,sysII,mergedMolecularSystem,mergedCoefficients, & - sysIbasisList, sysIIbasisList,inverseOverlapMatrices) - - type(NonOrthogonalCI) :: this - type(MolecularSystem) :: mergedMolecularSystem - integer :: sysI, sysII - type(Matrix) :: mergedCoefficients(*), inverseOverlapMatrices(*) - type(IVector) :: sysIbasisList(*), sysIIbasisList(*) - - integer :: speciesID - integer :: a,b,bb,mu,nu - integer :: numberOfContractions,occupationNumber,particlesPerOrbital - type(Matrix) :: molecularOverlapMatrix - type(Matrix), allocatable :: auxOverlapMatrix(:), auxKineticMatrix(:), auxAttractionMatrix(:), auxExternalPotMatrix(:) - type(Matrix), allocatable :: molecularKineticMatrix(:), molecularAttractionMatrix(:), molecularExternalMatrix(:) - type(Vector) :: overlapDeterminant - real(8) :: oneParticleKineticEnergy,oneParticleAttractionEnergy,oneParticleExternalEnergy - - allocate(auxOverlapMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & - auxKineticMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & - auxAttractionMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & - auxExternalPotMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & - molecularKineticMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & - molecularAttractionMatrix(mergedMolecularSystem%numberOfQuantumSpecies), & - molecularExternalMatrix(mergedMolecularSystem%numberOfQuantumSpecies)) - - !!Initialize overlap - this%configurationOverlapMatrix%values(sysI,sysII)=1.0 - - call Vector_constructor(overlapDeterminant, mergedMolecularSystem%numberOfQuantumSpecies, 0.0_8) - -!!!!Overlap first - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - - numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) - occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) - particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem) - !! Calculate one- particle integrals - call DirectIntegralManager_getOverlapIntegrals(mergedMolecularSystem,speciesID,& - auxOverlapMatrix(speciesID)) - - !!Test - - ! print *, "auxOverlapMatrix", speciesID - ! call Matrix_show(auxOverlapMatrix(speciesID)) - - call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), & - int(occupationNumber,8), 0.0_8 ) - - do mu=1, numberOfContractions!sysI - if(sysIbasisList(speciesID)%values(mu) .eq. 0 ) cycle - do nu=1, numberOfContractions !sysII - if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle - do a=1, occupationNumber !sysI - do b=occupationNumber+1, 2*occupationNumber - bb=b-occupationNumber - ! print *, "a, b, mu, nu, coefI, coefII", a, b, mu, nu, mergedCoefficients(speciesID)%values(mu,a), mergedCoefficients(speciesID)%values(nu,b),auxOverlapMatrix(speciesID)%values(mu,nu) - - molecularOverlapMatrix%values(a,bb)=molecularOverlapMatrix%values(a,bb)+& - mergedCoefficients(speciesID)%values(mu,a)*& - mergedCoefficients(speciesID)%values(nu,b)*& - auxOverlapMatrix(speciesID)%values(mu,nu) - end do - end do - end do - end do - - ! print *, "molecularOverlapMatrix sysI, sysII, speciesID", sysI, sysII, speciesID - ! call Matrix_show(molecularOverlapMatrix) - - !Sometimes we run calculations for systems with ghost species - if(occupationNumber .ne. 0) then - inverseOverlapMatrices(speciesID)=Matrix_inverse(molecularOverlapMatrix) - ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII - ! call Matrix_show(inverseOverlapMatrices(speciesID)) - call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant%values(speciesID),method="LU") - ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant%values(speciesID) - else - overlapDeterminant%values(speciesID)=1.0 - end if - - this%configurationOverlapMatrix%values(sysI,sysII)=this%configurationOverlapMatrix%values(sysI,sysII)*overlapDeterminant%values(speciesID)**particlesPerOrbital - - - end do - - ! print *, "total overlap", this%configurationOverlapMatrix%values(sysI,sysII) - - !!Skip the rest of the evaluation if the overlap is smaller than the threshold - if( CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD .gt. 0.0 .and. & - abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD) return - - !!Point charge-Point charge repulsion - this%configurationHamiltonianMatrix%values(sysI,sysII)=MolecularSystem_getPointChargesEnergy()*& - this%configurationOverlapMatrix%values(sysI,sysII) - ! print *, "Point charge-Point charge repulsion", MolecularSystem_getPointChargesEnergy() - - !!Compute hcore if overlap is significant - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - - numberOfContractions=MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) - occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) - particlesPerOrbital=MolecularSystem_getEta(speciesID,mergedMolecularSystem) - - call Matrix_constructor(auxKineticMatrix(speciesID),& - int(numberOfContractions,8),int(numberOfContractions,8),0.0_8) - call Matrix_constructor(auxAttractionMatrix(speciesID),& - int(numberOfContractions,8),int(numberOfContractions,8),0.0_8) - call Matrix_constructor(auxExternalPotMatrix(speciesID),& - int(numberOfContractions,8),int(numberOfContractions,8),0.0_8) - - call DirectIntegralManager_getKineticIntegrals(mergedMolecularSystem,speciesID,auxKineticMatrix(speciesID)) - call DirectIntegralManager_getAttractionIntegrals(mergedMolecularSystem,speciesID,auxAttractionMatrix(speciesID)) - if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & - call DirectIntegralManager_getExternalPotentialIntegrals(mergedMolecularSystem,speciesID,auxExternalPotMatrix(speciesID)) - - !! Incluiding mass effect - if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then - auxKineticMatrix(speciesID)%values = & - auxKineticMatrix(speciesID)%values * & - ( 1.0_8/MolecularSystem_getMass( speciesID ) -1.0_8 / MolecularSystem_getTotalMass() ) - else - auxKineticMatrix(speciesID)%values = & - auxKineticMatrix(speciesID)%values / & - MolecularSystem_getMass( speciesID ) - end if - - !! Including charge - auxAttractionMatrix(speciesID)%values=auxAttractionMatrix(speciesID)%values*(-MolecularSystem_getCharge(speciesID)) - - call Matrix_constructor(molecularKineticMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) - call Matrix_constructor(molecularAttractionMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) - call Matrix_constructor(molecularExternalMatrix(speciesID), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) - - !!Test - ! print *, "auxKineticMatrix", speciesID - ! call Matrix_show(auxKineticMatrix(speciesID)) - ! print *, "auxAttractionMatrix", speciesID - ! call Matrix_show(auxAttractionMatrix(speciesID)) - - do mu=1, numberOfContractions !sysI - if(sysIbasisList(speciesID)%values(mu) .eq. 0) cycle - do nu=1, numberOfContractions !sysII - if(sysIIbasisList(speciesID)%values(nu) .eq. 0) cycle - do a=1, occupationNumber !sysI - do b=occupationNumber+1, 2*occupationNumber - bb=b-occupationNumber - - ! print *, "hcore", a, b, mu, nu, mergedCoefficients(speciesID)%values(mu,a), mergedCoefficients(speciesID)%values(nu,b), & - ! auxKineticMatrix%values(mu,nu)/MolecularSystem_getMass(speciesID)+& - ! auxAttractionMatrix%values(mu,nu)*(-MolecularSystem_getCharge(speciesID)) - - molecularKineticMatrix(speciesID)%values(a,bb)=molecularKineticMatrix(speciesID)%values(a,bb)+& - mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*& - auxKineticMatrix(speciesID)%values(mu,nu) - - molecularAttractionMatrix(speciesID)%values(a,bb)=molecularAttractionMatrix(speciesID)%values(a,bb)+& - mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*& - auxAttractionMatrix(speciesID)%values(mu,nu) - - if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & - molecularExternalMatrix(speciesID)%values(a,bb)=molecularExternalMatrix(speciesID)%values(a,bb)+& - mergedCoefficients(speciesID)%values(mu,a)*mergedCoefficients(speciesID)%values(nu,b)*& - auxExternalPotMatrix(speciesID)%values(mu,nu) - end do - end do - end do - end do - molecularKineticMatrix(speciesID)%values=particlesPerOrbital*molecularKineticMatrix(speciesID)%values - molecularAttractionMatrix(speciesID)%values=particlesPerOrbital*molecularAttractionMatrix(speciesID)%values - molecularExternalMatrix(speciesID)%values=particlesPerOrbital*molecularExternalMatrix(speciesID)%values - !!End test - end do - - !!One Particle Terms - do speciesID=1, MolecularSystem_instance%numberOfQuantumSpecies - oneParticleKineticEnergy=0.0 - oneParticleAttractionEnergy=0.0 - oneParticleExternalEnergy=0.0 - occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) - do a=1, occupationNumber !sysI - do b=1, occupationNumber !sysII - oneParticleKineticEnergy=oneParticleKineticEnergy+ molecularKineticMatrix(speciesID)%values(a,b)*& - inverseOverlapMatrices(speciesID)%values(b,a) - oneParticleAttractionEnergy=oneParticleAttractionEnergy+ molecularAttractionMatrix(speciesID)%values(a,b)*& - inverseOverlapMatrices(speciesID)%values(b,a) - oneParticleExternalEnergy=oneParticleExternalEnergy+ molecularExternalMatrix(speciesID)%values(a,b)*& - inverseOverlapMatrices(speciesID)%values(b,a) - end do - end do - this%configurationKineticMatrix(speciesID)%values(sysI,sysII)=oneParticleKineticEnergy*this%configurationOverlapMatrix%values(sysI,sysII) - this%configurationPuntualMatrix(speciesID)%values(sysI,sysII)=oneParticleAttractionEnergy*this%configurationOverlapMatrix%values(sysI,sysII) - this%configurationExternalMatrix(speciesID)%values(sysI,sysII)=oneParticleExternalEnergy*this%configurationOverlapMatrix%values(sysI,sysII) - - this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+& - (oneParticleKineticEnergy+oneParticleAttractionEnergy+oneParticleExternalEnergy)*this%configurationOverlapMatrix%values(sysI,sysII) - ! print *, "sysI, sysII", sysI, sysII, "oneParticleEnergy for species", speciesID, oneParticleEnergy - end do - - deallocate(auxOverlapMatrix, auxKineticMatrix, auxAttractionMatrix, auxExternalPotMatrix, & - molecularKineticMatrix, molecularAttractionMatrix, molecularExternalMatrix) - - end subroutine NonOrthogonalCI_computeOverlapAndHCoreElements - !> - !! @brief Computes the two particles contributions to the non diagonal elements of the hamiltonian matrix - !! - !! @param this, sysI,sysII: system indexes, inverseOverlapMatrices, mergedCoefficients are required to evaluate the elements - !< - subroutine NonOrthogonalCI_twoParticlesContributions(this,sysI,sysII,mergedMolecularSystem,inverseOverlapMatrices,mergedCoefficients,Libint2LocalInstance) - implicit none - type(NonOrthogonalCI) :: this - integer :: sysI, sysII - type(MolecularSystem) :: mergedMolecularSystem - type(Matrix) :: inverseOverlapMatrices(*) - type(Matrix) :: mergedCoefficients(*) - type(Libint2Interface) :: Libint2LocalInstance(*) - - type(matrix), allocatable :: fourCenterIntegrals(:,:) - type(imatrix), allocatable :: twoIndexArray(:),fourIndexArray(:) - integer :: numberOfContractions,occupationNumber,particlesPerOrbital - integer :: otherNumberOfContractions,otherOccupationNumber,otherParticlesPerOrbital - integer :: ssize1, auxIndex, auxIndex1 - integer :: a,b,bb,c,d,dd,i,j - real(8) :: hartreeEnergy, exchangeEnergy - - allocate(fourCenterIntegrals(mergedMolecularSystem%numberOfQuantumSpecies,mergedMolecularSystem%numberOfQuantumSpecies), & - twoIndexArray(mergedMolecularSystem%numberOfQuantumSpecies), & - fourIndexArray(mergedMolecularSystem%numberOfQuantumSpecies)) - - !!Fill indexes arrays - do i=1, mergedMolecularSystem%numberOfQuantumSpecies - ! print *, "reading integrals species", i - numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem) - occupationNumber=MolecularSystem_getOcupationNumber(i,mergedMolecularSystem) - !!Two particle integrals indexes - call Matrix_constructorInteger(twoIndexArray(i), & - int(max(numberOfContractions,occupationNumber),8), & - int(max(numberOfContractions,occupationNumber),8), 0 ) - - c = 0 - do a=1,max(numberOfContractions,occupationNumber) - do b=a, max(numberOfContractions,occupationNumber) - c = c + 1 - twoIndexArray(i)%values(a,b) = c !IndexMap_tensorR2ToVectorC( a, b, numberOfContractions ) - twoIndexArray(i)%values(b,a) = twoIndexArray(i)%values(a,b) - end do - end do - - ssize1 = max(numberOfContractions,occupationNumber) - ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2 - - call Matrix_constructorInteger(fourIndexArray(i), int( ssize1,8), int( ssize1,8) , 0 ) - - c = 0 - do a = 1, ssize1 - do b = a, ssize1 - c = c + 1 - fourIndexArray(i)%values(a,b) = c! IndexMap_tensorR2ToVectorC( a, b, numberOfContractions ) - fourIndexArray(i)%values(b,a) = fourIndexArray(i)%values(a,b) - end do - end do - end do - - !! Calculate two- particle integrals - call NonOrthogonalCI_transformIntegralsMemory(mergedMolecularSystem, mergedCoefficients, & - twoIndexArray, fourIndexArray, fourCenterIntegrals, Libint2LocalInstance) - -!!!Add charges - if ( .not. InterPotential_instance%isInstanced) then - do i=1, mergedMolecularSystem%numberOfQuantumSpecies - fourCenterIntegrals(i,i)%values = & - fourCenterIntegrals(i,i)%values * mergedMolecularSystem%species(i)%charge**2.0 - - do j = i+1 , MolecularSystem_instance%numberOfQuantumSpecies - fourCenterIntegrals(i,j)%values = & - fourCenterIntegrals(i,j)%values * mergedMolecularSystem%species(i)%charge * mergedMolecularSystem%species(j)%charge - end do - end do - end if -!!!Compute Hamiltonian Matrix element between displaced geometries - - ! !!Point charge-Point charge repulsion - ! !!One Particle Terms - ! !!Have already been computed - - !!Same species repulsion - do i=1, mergedMolecularSystem%numberOfQuantumSpecies - numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem) - occupationNumber=MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI)) - particlesPerOrbital=MolecularSystem_getEta(i,mergedMolecularSystem) - hartreeEnergy=0.0 - exchangeEnergy=0.0 - do a=1,occupationNumber !sysI - do b=occupationNumber+1, 2*occupationNumber !sysII - bb=b-occupationNumber - do c=1, occupationNumber !sysI - do d=occupationNumber+1, 2*occupationNumber !sysII - dd=d-occupationNumber - auxIndex = fourIndexArray(i)%values(twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d) ) - hartreeEnergy=hartreeEnergy+0.5*fourCenterIntegrals(i,i)%values(auxIndex, 1)*& - inverseOverlapMatrices(i)%values(bb,a)*inverseOverlapMatrices(i)%values(dd,c)*particlesPerOrbital**2 !coulomb - exchangeEnergy=exchangeEnergy-0.5*fourCenterIntegrals(i,i)%values(auxIndex, 1)*& - inverseOverlapMatrices(i)%values(dd,a)*inverseOverlapMatrices(i)%values(bb,c)*particlesPerOrbital !exchange - ! print *, a, b, c, d, twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d), fourIndexArray(i)%values( & - ! twoIndexArray(i)%values(a,b), twoIndexArray(i)%values(c,d)), - end do - end do - end do - end do - this%configurationHartreeMatrix(i,i)%values(sysI,sysII)=hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII) - this%configurationExchangeMatrix(i)%values(sysI,sysII)=exchangeEnergy*this%configurationOverlapMatrix%values(sysI,sysII) - this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+& - (hartreeEnergy+exchangeEnergy)*this%configurationOverlapMatrix%values(sysI,sysII) - ! print *, "same species interactionEnergy for species", i, hartreeEnergy, exchangeEnergy - end do - - !!Interspecies repulsion - do i=1, mergedMolecularSystem%numberOfQuantumSpecies-1 - numberOfContractions=MolecularSystem_getTotalNumberOfContractions(i,mergedMolecularSystem) - occupationNumber=MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI)) - particlesPerOrbital=MolecularSystem_getEta(i,mergedMolecularSystem) - do j=i+1, mergedMolecularSystem%numberOfQuantumSpecies - otherNumberOfContractions=MolecularSystem_getTotalNumberOfContractions(j,mergedMolecularSystem) - otherOccupationNumber=MolecularSystem_getOcupationNumber(j,mergedMolecularSystem) - otherParticlesPerOrbital=MolecularSystem_getEta(j,mergedMolecularSystem) - hartreeEnergy=0.0 - ssize1 = max(otherNumberOfContractions,otherOccupationNumber) - ssize1 = ( ssize1 * ( ssize1 + 1 ) ) / 2 - otherOccupationNumber=MolecularSystem_getOcupationNumber(j,this%molecularSystems(sysI)) - do a=1, occupationNumber !sysI - do b=occupationNumber+1, 2*occupationNumber !sysII - bb=b-MolecularSystem_getOcupationNumber(i,this%molecularSystems(sysI)) - auxIndex1 = ssize1 * (twoIndexArray(i)%values(a,b) - 1 ) - do c=1, otherOccupationNumber !sysI - do d=otherOccupationNumber+1,2*otherOccupationNumber !sysII - dd=d-otherOccupationNumber - auxIndex = auxIndex1 + twoIndexArray(j)%values(c,d) - hartreeEnergy=hartreeEnergy+fourCenterIntegrals(i,j)%values(auxIndex, 1)*& - inverseOverlapMatrices(i)%values(bb,a)*inverseOverlapMatrices(j)%values(dd,c)*& - particlesPerOrbital*otherParticlesPerOrbital - ! print *, a, b, c, d, fourCenterIntegrals(i,j)%values(auxIndex, 1), inverseOverlapMatrices(i)%values(bb,a), inverseOverlapMatrices(j)%values(dd,c) - end do - end do - end do - end do - this%configurationHartreeMatrix(i,j)%values(sysI,sysII)=hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII) - this%configurationHamiltonianMatrix%values(sysI,sysII)=this%configurationHamiltonianMatrix%values(sysI,sysII)+& - hartreeEnergy*this%configurationOverlapMatrix%values(sysI,sysII) - ! print *, "interspecies hartreeEnergy for species", i, j, hartreeEnergy - end do - end do - - deallocate(fourCenterIntegrals,twoIndexArray,fourIndexArray) - - end subroutine NonOrthogonalCI_twoParticlesContributions - - !> - !! @brief Solves the NOCI matrix equation - !! - !! @param this - !< - subroutine NonOrthogonalCI_diagonalizeCImatrix(this) - implicit none - type(NonOrthogonalCI) :: this - type(Matrix) :: transformationMatrix,transformedHamiltonianMatrix,eigenVectors,auxMatrix - type(Vector) :: eigenValues - integer :: removedStates - integer :: speciesID,otherSpeciesID,sysI,sysII,state,i,j - real(8) :: auxEnergy - real(8) :: timeA - - !$ timeA = omp_get_wtime() - - call Matrix_constructor(this%configurationCoefficients, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8), 0.0_8) - call Vector_constructor(this%statesEigenvalues, this%numberOfDisplacedSystems, 0.0_8) - - ! print *, "non orthogonal CI overlap Matrix " - ! call Matrix_show(this%configurationOverlapMatrix) - - ! print *, "non orthogonal CI Hamiltionian Matrix " - ! call Matrix_show(this%configurationHamiltonianMatrix) - ! - print *, "" - print *, "Transforming non orthogonal CI Hamiltonian Matrix..." - - call Matrix_constructor(transformationMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8) , 0.0_8) - call Matrix_constructor(transformedHamiltonianMatrix, int(this%numberOfDisplacedSystems,8), int(this%numberOfDisplacedSystems,8) , 0.0_8) - - call Vector_constructor( eigenValues, this%numberOfDisplacedSystems ) - call Matrix_constructor( eigenVectors,int(this%numberOfDisplacedSystems,8),int(this%numberOfDisplacedSystems,8)) - - !!**************************************************************** - !! diagonaliza la matriz de overlap obteniendo una matriz unitaria - !! - call Matrix_eigen( this%configurationOverlapMatrix, eigenValues, eigenVectors, SYMMETRIC ) - - ! print *,"Overlap eigenvectors " - ! call Matrix_show( eigenVectors ) - - ! print *,"Overlap eigenvalues " - ! call Vector_show( eigenValues ) - - !! Remove states from configurations with linear dependencies - do i = 1 , this%numberOfDisplacedSystems - do j = 1 , this%numberOfDisplacedSystems - if ( abs(eigenValues%values(j)) >= CONTROL_instance%OVERLAP_EIGEN_THRESHOLD ) then - transformationMatrix%values(i,j) = & - eigenVectors%values(i,j)/sqrt( eigenvalues%values(j) ) - else - transformationMatrix%values(i,j) = 0 - end if - end do - end do - - removedStates=0 - do i = 1 , this%numberOfDisplacedSystems - if ( abs(eigenValues%values(i)) .lt. CONTROL_instance%OVERLAP_EIGEN_THRESHOLD ) & - removedStates=removedStates+1 - end do - - if (removedStates .gt. 0) & - write(*,"(A,I5,A,ES9.3)") "Removed ", removedStates , & - " states from the CI transformation Matrix with overlap eigen threshold of ", CONTROL_instance%OVERLAP_EIGEN_THRESHOLD - - - !!Ortogonalizacion simetrica - transformationMatrix%values = & - matmul(transformationMatrix%values, transpose(eigenVectors%values)) - - ! print *,"Matriz de transformacion " - ! call Matrix_show( transformationMatrix ) - - !!********************************************************************************************** - !! Transform configuration hamiltonian matrix - !! - transformedHamiltonianMatrix%values = & - matmul( matmul( transpose( transformationMatrix%values ) , & - this%configurationHamiltonianMatrix%values), transformationMatrix%values ) - - ! print *,"transformed Hamiltonian Matrix " - ! call Matrix_show( this%configurationHamiltonianMatrix ) - - print *, "Diagonalizing non orthogonal CI Hamiltonian Matrix..." - !! Calcula valores y vectores propios de matriz de CI transformada. - call Matrix_eigen( transformedHamiltonianMatrix, this%statesEigenvalues, this%configurationCoefficients, SYMMETRIC ) - - !! Calcula los vectores propios para matriz de CI - this%configurationCoefficients%values = matmul( transformationMatrix%values, this%configurationCoefficients%values ) - - ! print *,"non orthogonal CI eigenvalues " - ! call Vector_show( this%statesEigenvalues ) - - ! print *,"configuration Coefficients" - ! call Matrix_show( this%configurationCoefficients ) - - write(*,"(A)") "" - write(*,"(A)") " MIXED HARTREE-FOCK CALCULATION" - write(*,"(A)") " NON ORTHOGONAL CONFIGURATION INTERACTION" - write(*,"(A)") " EIGENVALUES AND EIGENVECTORS: " - write(*,"(A)") "=========================================" - write(*,"(A)") "" - do state = 1, min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems) - write (*,"(A)") "" - write (*,"(T9,A17,I3,A10, F25.12)") "STATE: ", state, " ENERGY = ", this%statesEigenvalues%values(state) - write (*,"(A38)") "Components: " - write(*,"(A38,F25.12)") " Point charges energy = ", MolecularSystem_getPointChargesEnergy() - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - auxEnergy=0 - do sysI=1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - this%configurationCoefficients%values(sysI,state)**2*& - this%configurationKineticMatrix(speciesID)%values(sysI,sysI) - do sysII=sysI+1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - 2.0_8*this%configurationCoefficients%values(sysI,state)*& - this%configurationCoefficients%values(sysII,state)*& - this%configurationKineticMatrix(speciesID)%values(sysI,sysII) - end do - end do - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - " Kinetic energy = ", auxEnergy - end do - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - auxEnergy=0 - do sysI=1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - this%configurationCoefficients%values(sysI,state)**2*& - this%configurationPuntualMatrix(speciesID)%values(sysI,sysI) - do sysII=sysI+1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - 2.0_8*this%configurationCoefficients%values(sysI,state)*& - this%configurationCoefficients%values(sysII,state)*& - this%configurationPuntualMatrix(speciesID)%values(sysI,sysII) - end do - end do - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - " Puntual energy = ", auxEnergy - end do - if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - auxEnergy=0 - do sysI=1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - this%configurationCoefficients%values(sysI,state)**2*& - this%configurationExternalMatrix(speciesID)%values(sysI,sysI) - do sysII=sysI+1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - 2.0_8*this%configurationCoefficients%values(sysI,state)*& - this%configurationCoefficients%values(sysII,state)*& - this%configurationExternalMatrix(speciesID)%values(sysI,sysII) - end do - end do - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - " External energy = ", auxEnergy - end do - end if - do speciesID=1, molecularSystem_instance%numberOfQuantumSpecies - auxEnergy=0 - do sysI=1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - this%configurationCoefficients%values(sysI,state)**2*& - this%configurationExchangeMatrix(speciesID)%values(sysI,sysI) - do sysII=sysI+1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - 2.0_8*this%configurationCoefficients%values(sysI,state)*& - this%configurationCoefficients%values(sysII,state)*& - this%configurationExchangeMatrix(speciesID)%values(sysI,sysII) - end do - end do - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - " Exchange energy = ", auxEnergy - - do otherSpeciesID=speciesID, molecularSystem_instance%numberOfQuantumSpecies - auxEnergy=0 - do sysI=1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - this%configurationCoefficients%values(sysI,state)**2*& - this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysI) - do sysII=sysI+1, this%numberOfDisplacedSystems - auxEnergy= auxEnergy+ & - 2.0_8*this%configurationCoefficients%values(sysI,state)*& - this%configurationCoefficients%values(sysII,state)*& - this%configurationHartreeMatrix(speciesID,otherSpeciesID)%values(sysI,sysII) - end do - end do - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // & - " Hartree energy = ", auxEnergy - end do - end do - end do - write(*,"(A)") "" - - call Matrix_constructor(auxMatrix,int(this%numberOfDisplacedSystems,8),& - int(CONTROL_instance%CI_STATES_TO_PRINT,8),0.0_8) - do i=1, this%numberOfDisplacedSystems - do j=1, CONTROL_instance%CI_STATES_TO_PRINT - auxMatrix%values(i,j)=this%configurationCoefficients%values(i,j) - end do - end do - - - write(*,"(I5,A)") CONTROL_instance%CI_STATES_TO_PRINT, " LOWEST LYING STATES CONFIGURATION COEFFICIENTS" - write(*,"(A)") "" - call Matrix_show(auxMatrix , & - rowkeys = this%systemLabels, & - columnkeys = string_convertvectorofrealstostring( this%statesEigenvalues ),& - flags=WITH_BOTH_KEYS) - write(*,"(A)") "" - - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for NOCI matrix diagonalization : ", omp_get_wtime() - timeA ," (s)" - - end subroutine NonOrthogonalCI_diagonalizeCImatrix - - !> - !! @brief Generates one molecular system combining all the displaced geometries and coefficients - !! - !! @param this - !< - subroutine NonOrthogonalCI_generateSuperposedSystem(this) - implicit none - type(NonOrthogonalCI) :: this - type(MolecularSystem) :: auxMolecularSystem - type(Matrix), allocatable :: auxCoefficients(:) - type(IVector), allocatable :: auxBasisList(:) - - integer :: i, sysI, speciesID - integer :: numberOfSpecies - - real(8) :: timeA - - !$ timeA = omp_get_wtime() - - if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return - - numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies - - allocate(this%sysBasisList(this%numberOfDisplacedSystems,numberOfSpecies),& - auxCoefficients(numberOfSpecies),& - auxBasisList(numberOfSpecies)) - - !Create a super molecular system - !!!Merge coefficients from system 1 and system 2 - call MolecularSystem_mergeTwoSystems(this%mergedMolecularSystem, this%molecularSystems(1), this%molecularSystems(2), & - this%sysBasisList(1,:),this%sysBasisList(2,:)) - - call NonOrthogonalCI_mergeCoefficients(this%HFCoefficients(1,:),this%HFCoefficients(2,:),& - this%molecularSystems(1),this%molecularSystems(2),this%mergedMolecularSystem,& - this%sysBasisList(1,:),this%sysBasisList(2,:),this%mergedCoefficients(:)) - - ! do speciesID=1, numberOfSpecies - ! print *, "2", speciesID, "ocupationNumber", MolecularSystem_getOcupationNumber(speciesID,this%mergedMolecularSystem) - ! print *, "2", speciesID, "mergedCoefficients" - ! call Matrix_show(this%mergedCoefficients(speciesID)) - ! end do - ! - !! Loop other systems expanding the merged coefficients matrix - do sysI=3, this%numberOfDisplacedSystems - call MolecularSystem_copyConstructor(auxMolecularSystem,this%mergedMolecularSystem) - do speciesID=1, numberOfSpecies - call Matrix_copyConstructor(auxCoefficients(speciesID), this%mergedCoefficients(speciesID)) - end do - call MolecularSystem_mergeTwoSystems(this%mergedMolecularSystem, auxMolecularSystem, this%molecularSystems(sysI), & - auxBasisList,this%sysBasisList(sysI,:),reorder=.false.) - call NonOrthogonalCI_mergeCoefficients(auxCoefficients,this%HFCoefficients(sysI,:),& - auxMolecularSystem,this%molecularSystems(sysI),this%mergedMolecularSystem,& - auxBasisList,this%sysBasisList(sysI,:),this%mergedCoefficients(:)) - ! do speciesID=1, numberOfSpecies - ! print *, sysI, speciesID, "ocupationNumber", MolecularSystem_getOcupationNumber(speciesID,this%mergedMolecularSystem) - ! print *, sysI, speciesID, "mergedCoefficients" - ! call Matrix_show(this%mergedCoefficients(speciesID)) - ! end do - end do - - !!!Fix basis list size - do sysI=1, this%numberOfDisplacedSystems - do speciesID=1, numberOfSpecies - call Vector_copyConstructorInteger(auxBasisList(speciesID),this%sysBasisList(sysI,speciesID)) - call Vector_constructorInteger(this%sysBasisList(sysI,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,this%mergedMolecularSystem), 0) - do i=1, size(auxBasisList(speciesID)%values) - this%sysBasisList(sysI,speciesID)%values(i)=auxBasisList(speciesID)%values(i) - end do - ! print *, "sysI", sysI, "speciesID", speciesID, "after list" - ! call Vector_showInteger(this%sysBasisList(sysI,speciesID)) - end do - end do - - write(*,*) "" - print *, "Superposed molecular system geometry" - write(*,*) "---------------------------------- " - ! call MolecularSystem_showInformation() - ! call MolecularSystem_showParticlesInformation() - call MolecularSystem_copyConstructor(molecularSystem_instance,this%mergedMolecularSystem) - call MolecularSystem_showCartesianMatrix(molecularSystem_instance) - particleManager_instance => molecularSystem_instance%allParticles - call ParticleManager_setOwner() - call MolecularSystem_saveToFile() - - ! do speciesID=1, numberOfSpecies - ! write(*,*) "" - ! write(*,*) " Merged Occupied Eigenvectors for: ", trim( MolecularSystem_instance%species(speciesID)%name ) - ! write(*,*) "---------------------------------- " - ! write(*,*) "" - ! print *, "contractions", speciesID, int(MolecularSystem_getTotalNumberOfContractions(speciesID),8) - ! print *, "ocupation", speciesID, int(MolecularSystem_getOcupationNumber(speciesID),8) - ! call Matrix_constructor(auxCoefficients(speciesID),int(MolecularSystem_getTotalNumberOfContractions(speciesID),8),& - ! int(MolecularSystem_getOcupationNumber(speciesID),8),0.0_8) - ! do i=1, MolecularSystem_getTotalNumberOfContractions(speciesID) - ! do j=1, MolecularSystem_getOcupationNumber(speciesID) - ! auxCoefficients(speciesID)%values(i,j)=mergedCoefficients(speciesID)%values(i,j) - ! end do - ! end do - ! call Matrix_show(auxCoefficients(speciesID)) - ! end do - - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time creating supermolecular system : ", omp_get_wtime() - timeA ," (s)" - !$ timeA = omp_get_wtime() - - deallocate(auxCoefficients,& - auxBasisList) - - return - - end subroutine NonOrthogonalCI_generateSuperposedSystem - - !> - !! @brief Generates the NOCI density matrix in the superposed molecular system - !! - !! @param this - !< - subroutine NonOrthogonalCI_buildDensityMatrix(this) - implicit none - type(NonOrthogonalCI) :: this - - type(Matrix) :: molecularOverlapMatrix - type(Matrix), allocatable :: inverseOverlapMatrix(:) !,kineticMatrix(:), attractionMatrix(:), externalPotMatrix(:) - integer :: state - integer :: i,ii,j,jj,mu,nu, sysI, sysII, speciesID, otherSpeciesID - integer :: particlesPerOrbital - integer :: numberOfSpecies - - integer :: densUnit - character(100) :: densFile - character(50) :: arguments(2), auxString - type(Matrix), allocatable :: exchangeCorrelationMatrices(:) - type(Matrix) :: dftEnergyMatrix - real(8), allocatable :: particlesInGrid(:) - real(8) :: timeA - - !$ timeA = omp_get_wtime() - - if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return - - numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies - - allocate(InverseOverlapMatrix(numberOfSpecies)) - - print *, "" - print *, "Computing overlap integrals for the superposed systems..." - print *, "" - do speciesID = 1, numberOfSpecies - call DirectIntegralManager_getOverlapIntegrals(molecularSystem_instance,speciesID,this%mergedOverlapMatrix(speciesID)) - end do - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for supermolecular 1-body integrals : ", omp_get_wtime() - timeA ," (s)" - !$ timeA = omp_get_wtime() - - print *, "" - print *, "Building merged density matrices for the superposed systems..." - print *, "" - !!Build the merged density matrix - do state=1, CONTROL_instance%CI_STATES_TO_PRINT - do speciesID=1, numberOfSpecies - call Matrix_constructor(this%mergedDensityMatrix(state,speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), & - int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8) - end do - end do - !!Fill the merged density matrix - ! "Diagonal" terms - same system - do sysI=1, this%numberOfDisplacedSystems - do speciesID=1, numberOfSpecies - particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) - do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) - if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle - do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) - if(this%sysBasisList(sysI,speciesID)%values(nu) .eq. 0) cycle - do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) - ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i - do state=1, CONTROL_instance%CI_STATES_TO_PRINT - this%mergedDensityMatrix(state,speciesID)%values(mu,nu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) + & - this%configurationCoefficients%values(sysI,state)**2*& - this%mergedCoefficients(speciesID)%values(mu,ii)*& - this%mergedCoefficients(speciesID)%values(nu,ii)*& - particlesPerOrbital - end do - end do - end do - end do - end do - end do - !!"Non Diagonal" terms - system pairs - do sysI=1, this%numberOfDisplacedSystems - do sysII=sysI+1, this%numberOfDisplacedSystems - if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle - !!Compute molecular overlap matrix and its inverse - do speciesID=1, numberOfSpecies - call Matrix_constructor(molecularOverlapMatrix, & - int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)),8), & - int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)),8), 0.0_8 ) - call Matrix_constructor(inverseOverlapMatrix(speciesID), & - int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)),8), & - int(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)),8), 0.0_8 ) - - do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) !sysI - if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle - do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) !sysII - if(this%sysBasisList(sysII,speciesID)%values(nu) .eq. 0) cycle - do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) - ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i - do j = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)) - jj=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))*(sysII-1)+j - ! print *, "i, j, mu, nu, coefI, coefII", i,j,mu,nu,mergedCoefficients(speciesID)%values(mu,ii),mergedCoefficients(speciesID)%values(nu,jj) - molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+& - this%mergedCoefficients(speciesID)%values(mu,ii)*& - this%mergedCoefficients(speciesID)%values(nu,jj)*& - this%mergedOverlapMatrix(speciesID)%values(mu,nu) - end do - end do - end do - end do - ! print *, "molecularOverlapMatrix sysI, sysII, speciesID", sysI, sysII, speciesID - ! call Matrix_show(molecularOverlapMatrix) - if(MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) .ne. 0) & - inverseOverlapMatrix(speciesID)=Matrix_inverse(molecularOverlapMatrix) - end do - - ! Compute density contributions - do speciesID=1, numberOfSpecies - particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) - do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) - if(this%sysBasisList(sysI,speciesID)%values(mu) .eq. 0) cycle - do nu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) - if(this%sysBasisList(sysII,speciesID)%values(nu) .eq. 0) cycle - do state=1, CONTROL_instance%CI_STATES_TO_PRINT - do i = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) - ii=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI))*(sysI-1)+i - do j = 1 , MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII)) - jj=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysII))*(sysII-1)+j - this%mergedDensityMatrix(state,speciesID)%values(mu,nu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) + & - this%configurationCoefficients%values(sysI,state)*& - this%configurationCoefficients%values(sysII,state)*& - this%configurationOverlapMatrix%values(sysI,sysII)*& - inverseOverlapMatrix(speciesID)%values(j,i)*& - this%mergedCoefficients(speciesID)%values(mu,ii)*& - this%mergedCoefficients(speciesID)%values(nu,jj)*& - particlesPerOrbital - this%mergedDensityMatrix(state,speciesID)%values(nu,mu) = this%mergedDensityMatrix(state,speciesID)%values(nu,mu) + & - this%configurationCoefficients%values(sysI,state)*& - this%configurationCoefficients%values(sysII,state)*& - this%configurationOverlapMatrix%values(sysI,sysII)*& - inverseOverlapMatrix(speciesID)%values(j,i)*& - this%mergedCoefficients(speciesID)%values(mu,ii)*& - this%mergedCoefficients(speciesID)%values(nu,jj)*& - particlesPerOrbital - end do - end do - end do - end do - end do - end do - !!symmetrize - ! do mu = 1 , MolecularSystem_getTotalNumberOfContractions(speciesID) - ! do nu = mu+1 , MolecularSystem_getTotalNumberOfContractions(speciesID) - ! this%mergedDensityMatrix(state,speciesID)%values(nu,mu) = this%mergedDensityMatrix(state,speciesID)%values(mu,nu) - ! end do - ! end do - end do - end do - - !! Open file - to write density matrices - densUnit = 29 - - densFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci" - open(unit = densUnit, file=trim(densFile), status="replace", form="formatted") - do state=1, CONTROL_instance%CI_STATES_TO_PRINT - do speciesID=1, numberOfSpecies - ! print *, "this%mergedDensityMatrix", state, trim( MolecularSystem_instance%species(speciesID)%name ) - ! call Matrix_show(this%mergedDensityMatrix(state,speciesID)) - write(auxString,*) state - arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) - arguments(1) = "DENSITYMATRIX"//trim(adjustl(auxString)) - call Matrix_writeToFile ( this%mergedDensityMatrix(state,speciesID), densUnit , arguments=arguments(1:2) ) - end do - end do - - if(CONTROL_instance%ELECTRON_EXCHANGE_CORRELATION_FUNCTIONAL.ne."NONE" .or. & - CONTROL_instance%NUCLEAR_ELECTRON_CORRELATION_FUNCTIONAL.ne."NONE") then - print *, "Superposed DFT energies:" - - allocate(exchangeCorrelationMatrices(numberOfSpecies), & - particlesInGrid(numberOfSpecies)) - call DensityFunctionalTheory_buildFinalGrid() - do state=1, CONTROL_instance%CI_STATES_TO_PRINT - call Matrix_constructor(dftEnergyMatrix, int(numberOfSpecies,8), & - int(numberOfSpecies,8), 0.0_8 ) - do speciesID=1, numberOfSpecies - call Matrix_constructor(exchangeCorrelationMatrices(speciesID), int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), & - int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8) - end do - call DensityFunctionalTheory_finalDFT(this%mergedDensityMatrix(state,1:numberOfSpecies), & - exchangeCorrelationMatrices, & - dftEnergyMatrix, & - particlesInGrid) - - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - do otherSpeciesID = speciesID, MolecularSystem_instance%numberOfQuantumSpecies - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // & - " DFT Corr. energy = ", dftEnergyMatrix%values(speciesID,otherSpeciesID) - end do - end do - end do - end if - - close(densUnit) - - deallocate(inverseOverlapMatrix) - - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for merging density matrices : ", omp_get_wtime() - timeA ," (s)" - - return - - ! allocate(kineticMatrix(numberOfSpecies),& - ! attractionMatrix(numberOfSpecies),& - ! externalPotMatrix(numberOfSpecies)) - ! do speciesID = 1, numberOfSpecies - ! call DirectIntegralManager_getKineticIntegrals(molecularSystem_instance,speciesID,kineticMatrix(speciesID)) - ! if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then - ! kineticMatrix(speciesID)%values = & - ! kineticMatrix(speciesID)%values * & - ! ( 1.0_8/MolecularSystem_getMass( speciesID ) -1.0_8 / MolecularSystem_getTotalMass() ) - ! else - ! kineticMatrix(speciesID)%values = & - ! kineticMatrix(speciesID)%values / & - ! MolecularSystem_getMass( speciesID ) - ! end if - - ! call DirectIntegralManager_getAttractionIntegrals(molecularSystem_instance,speciesID,attractionMatrix(speciesID)) - ! attractionMatrix(speciesID)%values=attractionMatrix(speciesID)%values*(-MolecularSystem_getCharge(speciesID)) - - ! if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & - ! call DirectIntegralManager_getExternalPotentialIntegrals(molecularSystem_instance,speciesID,externalPotMatrix(speciesID)) - ! end do - ! write(*,*) "" - ! write(*,*) "==========================================================" - ! write(*,*) " ONE BODY ENERGY CONTRIBUTIONS OF THE SUPERPOSED SYSTEMS: " - ! write(*,*) "" - ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT - ! write(*,*) " STATE: ", state - ! do speciesID=1, numberOfSpecies - ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - ! " Kinetic energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*kineticMatrix(speciesID)%values) - ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - ! "/Fixed interact. energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*attractionMatrix(speciesID)%values) - ! if( CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) & - ! write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name) // & - ! " Ext Pot energy = ", sum(transpose(this%mergedDensityMatrix(state,speciesID)%values)*externalPotMatrix(speciesID)%values) - ! print *, "" - ! end do - ! print *, "" - ! end do - ! deallocate(kineticMatrix,& - ! attractionMatrix,& - ! externalPotMatrix) - - end subroutine NonOrthogonalCI_buildDensityMatrix - - !> - !! @brief Generates the NOCI natural orbitals from the NOCI density matrix in the superposed molecular system - !! - !! @param this - !< - subroutine NonOrthogonalCI_getNaturalOrbitals(this) - implicit none - type(NonOrthogonalCI) :: this - - type(Matrix) :: auxMatrix, densityEigenVectors, auxdensityEigenVectors - type(Vector) :: auxVector, densityEigenValues, auxdensityEigenValues - - integer :: state - integer :: i,j,k,speciesID - integer :: numberOfSpecies - - integer :: densUnit - character(100) :: densFile - character(50) :: arguments(2), auxString - real(8) :: timeA - - !$ timeA = omp_get_wtime() - if(.not. CONTROL_instance%CI_NATURAL_ORBITALS) return - if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return - - numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies - - write(*,*) "" - write(*,*) "=============================================" - write(*,*) " NATURAL ORBITALS OF THE SUPERPOSED SYSTEMS: " - write(*,*) "" - !! Open file - to write density matrices - densUnit = 29 - - densFile = trim(CONTROL_instance%INPUT_FILE)//"Matrices.ci" - open(unit = densUnit, file=trim(densFile), status="old", form="formatted", position="append") - - do state=1, CONTROL_instance%CI_STATES_TO_PRINT - - write(*,*) " STATE: ", state - - do speciesID=1, numberOfSpecies - - write(*,*) "" - write(*,*) " Natural Orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(speciesID)%name ) - write(*,*) "--------------------------------------------------------------" - - call Vector_constructor ( densityEigenValues, & - int(MolecularSystem_getTotalNumberOfContractions(speciesID),4), 0.0_8 ) - call Matrix_constructor ( densityEigenVectors, & - int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), & - int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8 ) - - call Vector_constructor ( auxdensityEigenValues, & - int(MolecularSystem_getTotalNumberOfContractions(speciesID),4), 0.0_8 ) - call Matrix_constructor ( auxdensityEigenVectors, & - int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), & - int(MolecularSystem_getTotalNumberOfContractions(speciesID),8), 0.0_8 ) - - !! Lowdin orthogonalization of the density matrix - auxMatrix = Matrix_pow(this%mergedOverlapMatrix(speciesID), 0.5_8, method="SVD" ) - - auxMatrix%values=matmul(matmul(auxMatrix%values,this%mergedDensityMatrix(state,speciesID)%values),auxMatrix%values) - - ! print *, "Diagonalizing non orthogonal CI density Matrix..." - - !! Calcula valores y vectores propios de matriz de densidad CI ortogonal. - call Matrix_eigen(auxMatrix , auxdensityEigenValues, auxdensityEigenVectors, SYMMETRIC ) - - !! Transform back to the atomic basis - auxMatrix = Matrix_pow(this%mergedOverlapMatrix(speciesID), -0.5_8, method="SVD" ) - - auxdensityEigenVectors%values=matmul(auxMatrix%values,auxdensityEigenVectors%values) - - ! reorder and count significant occupations - k=0 - do i = 1, MolecularSystem_getTotalNumberOfContractions(speciesID) - densityEigenValues%values(i) = auxdensityEigenValues%values(MolecularSystem_getTotalNumberOfContractions(speciesID) - i + 1) - densityEigenVectors%values(:,i) = auxdensityEigenVectors%values(:,MolecularSystem_getTotalNumberOfContractions(speciesID) - i + 1) - if(abs(densityEigenValues%values(i)) .ge. 1.0E-4_8 ) k=k+1 - end do - if(k .eq. 0) k=1 - ! Print eigenvectors with occupation larger than 0.01 - call Vector_constructor(auxVector,k,0.0_8) - call Matrix_constructor(auxMatrix,int(MolecularSystem_getTotalNumberOfContractions(speciesID),8),int(k,8),0.0_8) - k=0 - do i=1, MolecularSystem_getTotalNumberOfContractions(speciesID) - if(abs(densityEigenValues%values(i)) .ge. 1.0E-4_8 ) then - k=k+1 - auxVector%values(k)=densityEigenValues%values(i) - do j=1, MolecularSystem_getTotalNumberOfContractions(speciesID) - auxMatrix%values(j,k)=densityEigenVectors%values(j,i) - end do - end if - end do - !densityEigenVectors - call Matrix_show( auxMatrix , & - rowkeys = MolecularSystem_getlabelsofcontractions( speciesID ), & - columnkeys = string_convertvectorofrealstostring( auxVector ),& - flags=WITH_BOTH_KEYS) - - write(*,"(A10,A10,A20,I5,A15,F17.12)") "number of ", trim(MolecularSystem_getNameOfSpecie( speciesID )) ," particles in state", state , & - " density matrix: ", sum( transpose(this%mergedDensityMatrix(state,speciesID)%values)*this%mergedOverlapMatrix(speciesID)%values) - write(*,"(A10,A10,A40,F17.12)") "sum of ", trim(MolecularSystem_getNameOfSpecie( speciesID )) , "natural orbital occupations", sum(densityEigenValues%values) - - ! density matrix check - ! auxMatrix%values=0.0 - ! do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) - ! do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID) - ! do k=1, MolecularSystem_getTotalNumberOfContractions(speciesID) - ! auxMatrix%values(mu,nu)=auxMatrix%values(mu,nu)+densityEigenValues%values(k)*& - ! densityEigenVectors%values(mu,k)*densityEigenVectors%values(nu,k) - ! end do - ! end do - ! end do - ! print *, "atomicDensityMatrix again" - ! call Matrix_show(auxMatrix) - - write(auxString,*) state - - arguments(2) = trim( MolecularSystem_instance%species(speciesID)%name ) - arguments(1) = "NATURALORBITALS"//trim(adjustl(auxstring)) - - call Matrix_writeToFile ( densityEigenVectors, densUnit , arguments=arguments(1:2) ) - - arguments(2) = trim( MolecularSystem_instance%species(speciesID)%name ) - arguments(1) = "OCCUPATIONS"//trim(adjustl(auxstring)) - - call Vector_writeToFile( densityEigenValues, densUnit, arguments=arguments(1:2) ) - - write(*,*) " End of natural orbitals in state: ", state, " for: ", trim( MolecularSystem_instance%species(speciesID)%name ) - end do - end do - - write(*,*) "" - write(*,*) " END OF NATURAL ORBITALS" - write(*,*) "==============================" - write(*,*) "" - - close(densUnit) - - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for NOCI natural orbitals : ", omp_get_wtime() - timeA ," (s)" - - return - - end subroutine NonOrthogonalCI_getNaturalOrbitals - - !> - !! @brief Calculate and Transform the four center integrals in one sweep without writing anything to disk - !! - !! @param molecularSystem, HFCoefficients: species array with the atomic coefficients, fourCenterIntegrals: species*species array to save integrals - !< - subroutine NonOrthogonalCI_transformIntegralsMemory(mergedMolecularSystem, mergedCoefficients, twoIndexArray, fourIndexArray, fourCenterIntegrals, Libint2LocalInstance) - implicit none - type(MolecularSystem), intent(in) :: mergedMolecularSystem - type(Matrix), intent(in) :: mergedCoefficients(mergedMolecularSystem%numberOfQuantumSpecies) - type(iMatrix), intent(in) :: twoIndexArray(mergedMolecularSystem%numberOfQuantumSpecies) - type(iMatrix), intent(in) :: fourIndexArray(mergedMolecularSystem%numberOfQuantumSpecies) - type(Matrix), intent(out) :: fourCenterIntegrals(mergedMolecularSystem%numberOfQuantumSpecies,mergedMolecularSystem%numberOfQuantumSpecies) - type(Libint2Interface) :: Libint2LocalInstance(mergedMolecularSystem%numberOfQuantumSpecies) - - real(8), allocatable, target :: ints(:,:,:,:) - real(8), allocatable :: tempA(:,:,:) - real(8), allocatable :: tempB(:,:) - real(8), allocatable :: tempC(:) - - integer :: p, p_l, p_u - integer :: q, q_l, q_u - integer :: r, r_l, r_u - integer :: s, s_l, s_u - integer :: ssize, ssizeb, auxIndex, auxIndexA - integer :: n,u, mu,nu, lambda,sigma - real(8) :: auxTransformedTwoParticlesIntegral - - type(Matrix) :: densityMatrix - integer :: speciesID, otherSpeciesID - integer :: numberOfOrbitals, otherNumberOfOrbitals - integer(8) :: numberOfIntegrals - - do speciesID=1, mergedMolecularSystem%numberOfQuantumSpecies - numberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), & - MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )) - numberOfIntegrals= int( ( ( numberOfOrbitals * ( numberOfOrbitals + 1.0_8 ) / 4.0_8 ) * & - ( ( numberOfOrbitals * ( numberOfOrbitals + 1.0_8) / 2.0_8 ) + 1.0_8) ), 8 ) - - call Matrix_constructor( fourCenterIntegrals(speciesID,speciesID), numberOfIntegrals, 1_8, 0.0_8 ) - - p_l = 1 - p_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2 - q_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1 - q_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem ) - - r_l = 1 - r_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2 - s_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1 - s_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem ) - - ssize = MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) - call Matrix_constructor( densityMatrix, int(ssize,8), int(ssize,8), 1.0_8 ) !Test filling with values later - - ! Prepare matrix - if(allocated(ints)) deallocate(ints) - if(allocated(tempA)) deallocate (tempA) - if(allocated(tempB)) deallocate (tempB) - if(allocated(tempC)) deallocate (tempC) - allocate (ints ( ssize, ssize, ssize, ssize ), & - tempA ( ssize, ssize, ssize ), & - tempB ( ssize, ssize ), & - tempC ( ssize )) - ints = 0 - - call DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(& - speciesID, & - densityMatrix, & - ints, mergedMolecularSystem, Libint2LocalInstance(speciesID) ) - - - do p = p_l, p_u - tempA = 0 - n = p - - ! !First quarter transformation happens here - do mu = 1, ssize - !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle - tempA(:,:,:) = tempA(:,:,:) + mergedCoefficients(speciesID)%values( mu, p )* & - ints(:,:,:,mu) - end do - - do q = p, q_u - u = q - tempB = 0 - - if ( q < q_l ) cycle - !! second quarter - do nu = 1, ssize - !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle - tempB(:,:) = tempB(:,:) + mergedCoefficients(speciesID)%values( nu, q )* & - tempA(:,:,nu) - end do - - do r = n, r_u - - tempC = 0 - - !Why?? - !if ( r < this%r_l ) cycle - - !! third quarter - do lambda = 1, ssize - !if ( abs(coefficientsOfAtomicOrbitals%values( lambda, r )) < 1E-10 ) cycle - tempC(:) = tempC(:) + mergedCoefficients(speciesID)%values( lambda, r )* & - tempB(:,lambda) - end do - - do s = u, s_u - auxTransformedTwoParticlesIntegral = 0 - - if ( s < s_l ) cycle - !! fourth quarter - do sigma = 1, ssize - auxTransformedTwoParticlesIntegral = auxTransformedTwoParticlesIntegral + & - mergedCoefficients(speciesID)%values( sigma, s )* & - tempC(sigma) - - end do - auxIndex = fourIndexArray(speciesID)%values(twoIndexArray(speciesID)%values(p,q), twoIndexArray(speciesID)%values(r,s) ) - fourCenterIntegrals(speciesID,speciesID)%values(auxIndex, 1) = auxTransformedTwoParticlesIntegral - ! print *, speciesID, p, q, r, s, auxIndex, auxTransformedTwoParticlesIntegral - end do - u = r + 1 - end do - end do - end do - end do - - do speciesID=1, mergedMolecularSystem%numberOfQuantumSpecies-1 - do otherSpeciesID=speciesID+1, mergedMolecularSystem%numberOfQuantumSpecies - - numberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem), & - MolecularSystem_getOcupationNumber(speciesID,mergedMolecularSystem)) - otherNumberOfOrbitals = max( MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,mergedMolecularSystem), & - MolecularSystem_getOcupationNumber(otherSpeciesID,mergedMolecularSystem)) - - numberOfIntegrals = int((numberOfOrbitals*((numberOfOrbitals+1.0_8)/2.0_8)) * & - (otherNumberOfOrbitals*(otherNumberOfOrbitals+1.0_8)/2.0_8),8) - - call Matrix_constructor( fourCenterIntegrals(speciesID,otherSpeciesID), numberOfIntegrals, 1_8, 0.0_8 ) - - ssize = MolecularSystem_getTotalNumberOfContractions(speciesID,mergedMolecularSystem) - ssizeb = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,mergedMolecularSystem) - - call Matrix_constructor( densityMatrix, int(ssize,8), int(ssize,8), 1.0_8 ) !Test filling with values later - - p_l = 1 - p_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2 - q_l = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem )/2+1 - q_u = MolecularSystem_getOcupationNumber( speciesID, mergedMolecularSystem ) - - r_l = 1 - r_u = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )/2 - s_l = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem )/2+1 - s_u = MolecularSystem_getOcupationNumber( otherSpeciesID, mergedMolecularSystem ) - - ! Prepare matrix - ! Prepare matrix - if(allocated(ints)) deallocate(ints) - if(allocated(tempA)) deallocate (tempA) - if(allocated(tempB)) deallocate (tempB) - if(allocated(tempC)) deallocate (tempC) - allocate (ints ( ssizeb, ssizeb, ssize, ssize ), & - tempA ( ssizeb, ssizeb, ssize ), & - tempB ( ssizeb, ssizeb ), & - tempC ( ssizeb )) - ints = 0 - - call DirectIntegralManager_getDirectInterRepulsionIntegralsAll(& - speciesID, otherSpeciesID, & - densityMatrix, & - ints, mergedMolecularSystem, Libint2LocalInstance(speciesID), Libint2LocalInstance(otherSpeciesID) ) - - ! do mu = 1, ssize - ! do nu = 1, ssize - ! do lambda = 1, ssizeb - ! do sigma = 1, ssizeb - ! print *, mu, nu, lambda, sigma, ints(lambda,sigma,nu,mu) - ! end do - ! end do - ! end do - ! end do - do p = p_l, p_u - tempA = 0 - !First quarter transformation happens here - do mu = 1, ssize - !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle - tempA(:,:,:) = tempA(:,:,:) + mergedCoefficients(speciesID)%values( mu, p )* & - ints(:,:,:,mu) - end do - - do q = q_l, q_u - tempB = 0 - - ! if ( q < p ) cycle - !! second quarter - do nu = 1, ssize - !if ( abs(coefficientsOfAtomicOrbitals%values( nu, q )) < 1E-10 ) cycle - - tempB(:,:) = tempB(:,:) + mergedCoefficients(speciesID)%values( nu, q )* & - tempA(:,:,nu) - end do - - auxIndexA = (otherNumberOfOrbitals*(otherNumberOfOrbitals+1))/2 * (twoIndexArray(speciesID)%values(p,q) - 1 ) - - do r = r_l , r_u - - tempC = 0 - - !! third quarter - do lambda = 1, ssizeb - - tempC(:) = tempC(:) + mergedCoefficients(otherSpeciesID)%values( lambda, r )* & - tempB(:,lambda) - - end do - do s = s_l, s_u - auxTransformedTwoParticlesIntegral = 0 - - ! if ( s < r ) cycle - !! fourth quarter - do sigma = 1, ssizeb - auxTransformedTwoParticlesIntegral = auxTransformedTwoParticlesIntegral + & - mergedCoefficients(otherSpeciesID)%values( sigma, s )* & - tempC(sigma) - - end do - - auxIndex = auxIndexA + twoIndexArray(otherSpeciesID)%values(r,s) - - fourCenterIntegrals(speciesID,otherSpeciesID)%values(auxIndex, 1) = auxTransformedTwoParticlesIntegral - - ! print *, speciesID,otherSpeciesID, p, q, r, s, auxIndex, auxTransformedTwoParticlesIntegral - - end do - end do - end do - end do - - end do - end do - - ! call DirectIntegralManager_destructor(Libint2LocalInstance) - - end subroutine NonOrthogonalCI_transformIntegralsMemory - - - !> - !! @brief Save NOCI results to file - !! - !! @param - !< - subroutine NonOrthogonalCI_saveToFile(this) - type(NonOrthogonalCI) :: this - integer :: nociUnit, speciesID, numberOfSpecies, sysI - character(100) :: prefix, nociFile - character(50) :: arguments(2), auxString - - !Save merged molecular system - call MolecularSystem_copyConstructor(molecularSystem_instance,this%mergedMolecularSystem) - - prefix=trim(CONTROL_instance%INPUT_FILE)//"NOCI" - call MolecularSystem_saveToFile(prefix) - - numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies - - nociUnit=123 - nociFile=trim(prefix)//".states" - open(unit = nociUnit, file=trim(nociFile), status="replace", form="unformatted") - - arguments(1:1) = "NOCI-NUMBEROFDISPLACEDSYSTEMS" - call Vector_writeToFileInteger(unit=nociUnit, binary=.true., value=this%numberOfDisplacedSystems, arguments=arguments(1:1) ) - - arguments(1:1) = "NOCI-NUMBEROFSPECIES" - call Vector_writeToFileInteger(unit=nociUnit, binary=.true., value=numberOfSpecies, arguments=arguments(1:1) ) - - arguments(1:1) = "NOCI-CONFIGURATIONCOEFFICIENTS" - call Matrix_writeToFile ( this%configurationCoefficients, nociUnit , binary=.true., arguments=arguments(1:1) ) - - arguments(1:1) = "NOCI-CONFIGURATIONENERGIES" - call Vector_writeToFile ( this%statesEigenvalues, nociUnit , binary=.true., arguments=arguments(1:1) ) - - arguments(1) = "MERGEDCOEFFICIENTS" - do speciesID=1, numberOfSpecies - arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) - call Matrix_writeToFile ( this%mergedCoefficients(speciesID), nociUnit, binary=.true. , arguments=arguments(1:2) ) - end do - - do sysI=1, this%numberOfDisplacedSystems - do speciesID=1, numberOfSpecies - write(auxString,*) sysI - arguments(1) = "SYSBASISLIST"//trim(auxString) - arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) - call Vector_writeToFileInteger(this%sysBasisList(sysI,speciesID), nociUnit, binary=.true., arguments=arguments(1:2) ) - end do - end do - - ! do state=1, min(CONTROL_instance%NUMBER_OF_CI_STATES,this%numberOfDisplacedSystems) - ! end do - - ! do state=1, CONTROL_instance%CI_STATES_TO_PRINT - ! write(auxString,*) state - ! call Matrix_writeToFile ( this%mergedDensityMatrix(state,speciesID), densUnit , arguments=arguments(1:2) ) - ! end do - ! end do - - close(nociUnit) - - end subroutine NonOrthogonalCI_saveToFile - - !> - !! @brief Compute Franck-Condon factors from the current NOCI calculations and previous results read from file - !! - !! @param - !< - subroutine NonOrthogonalCI_computeFranckCondon(this) - type(NonOrthogonalCI) :: this - integer :: nociUnit, numberOfSpecies, occupationNumber,numberOfDisplacedSystems, numberOfContractions, dim2 - character(100) :: nociFile - type(Matrix) :: ciCoefficients - type(Vector) :: ciEnergies - type(Matrix), allocatable :: auxCoefficients(:), superMergedCoefficients(:) - type(IVector), allocatable :: sysListCur(:,:), sysListRef(:,:), orbListI(:), orbListII(:) - type(IVector) :: auxIVector - type(MolecularSystem) :: superMergedMolecularSystem - logical :: existFile - type(Matrix) :: molecularOverlapMatrix - type(Matrix), allocatable :: superOverlapMatrix(:), superMomentMatrix(:,:), inverseOverlapMatrix(:), molecularMomentMatrix(:,:) !,attractionMatrix(:), externalPotMatrix(:) - integer :: stateI, stateII - integer :: i,ii,j,jj,k,mu,nu,mumu,nunu,sysI, sysII, speciesID, otherSpeciesID - integer :: particlesPerOrbital - real(8) :: overlapDeterminant, trololo, trolololo(3), pointchargesdipole(3) - - integer :: densUnit - character(100) :: densFile - character(50) :: arguments(2), auxString - type(Matrix), allocatable :: franckCondonMatrix(:), transitionDipoleMatrix(:,:), refCurOverlapMatrix(:), refCurMomentMatrix(:,:) - type(Matrix) :: refCurTotalOverlap - real(8) :: timeA - - !$ timeA = omp_get_wtime() - - existFile=.false. - - nociFile = trim(CONTROL_instance%INPUT_FILE)//"refNOCI" - inquire( FILE = trim(nociFile)//".sys", EXIST = existFile ) - - if(.not. existFile) return - print *, "Found a reference molecular system for NOCI calculations ", trim(nociFile)//".sys" - - pointchargesdipole=0.0 - do i=1, size( MolecularSystem_instance%pointCharges ) - pointchargesdipole = pointchargesdipole + MolecularSystem_instance%pointCharges(i)%origin(:) * MolecularSystem_instance%pointCharges(i)%charge - end do - - - call MolecularSystem_loadFromFile("LOWDIN.SYS",nociFile) - call MolecularSystem_showInformation() - call MolecularSystem_showParticlesInformation() - call MolecularSystem_showCartesianMatrix() - - nociFile = trim(CONTROL_instance%INPUT_FILE)//"refNOCI.states" - inquire( FILE = trim(nociFile), EXIST = existFile ) - - if(.not. existFile) then - print *, "Did not find reference states for NOCI calculations ", nociFile - return - end if - print *, "Found reference states for NOCI calculations ", nociFile - print *, "Computing the Franck-Condon factors with respect to that system" - - nociUnit=123 - open(unit = nociUnit, file=trim(nociFile), status="old", form="unformatted") - - arguments(1) = "NOCI-NUMBEROFSPECIES" - call Vector_getFromFileInteger(1,unit=nociUnit, binary=.true., value=numberOfSpecies, arguments=arguments(1:1) ) - - arguments(1) = "NOCI-NUMBEROFDISPLACEDSYSTEMS" - call Vector_getFromFileInteger(1,unit=nociUnit, binary=.true., value=numberOfDisplacedSystems, arguments=arguments(1:1) ) - - allocate(auxCoefficients(numberOfSpecies)) - allocate(sysListCur(numberOfDisplacedSystems,numberOfSpecies),sysListRef(numberOfDisplacedSystems,numberOfSpecies)) - allocate(orbListI(numberOfDisplacedSystems),orbListII(numberOfDisplacedSystems)) - allocate(superMergedCoefficients(numberOfSpecies)) - allocate(superOverlapMatrix(numberOfSpecies), superMomentMatrix(numberOfSpecies,3),inverseOverlapMatrix(numberOfSpecies),molecularMomentMatrix(numberOfSpecies,3)) - allocate(franckCondonMatrix(numberOfSpecies),transitionDipoleMatrix(numberOfSpecies+1,3),refCurOverlapMatrix(numberOfSpecies),refCurMomentMatrix(numberOfSpecies,3)) - - arguments(1) = "NOCI-CONFIGURATIONCOEFFICIENTS" - ciCoefficients = Matrix_getFromFile(numberOfDisplacedSystems,numberOfDisplacedSystems,nociUnit,binary=.true.,arguments=arguments(1:1) ) - - arguments(1:1) = "NOCI-CONFIGURATIONENERGIES" - call Vector_getFromFile(numberOfDisplacedSystems, nociUnit, output=ciEnergies, binary=.true., arguments=arguments(1:1) ) - - arguments(1) = "MERGEDCOEFFICIENTS" - do speciesID=1, numberOfSpecies - numberOfContractions=molecularSystem_getTotalNumberOfContractions(speciesID) - dim2=max(MolecularSystem_getTotalNumberOfContractions(speciesID),MolecularSystem_getOcupationNumber(speciesID)) - arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) - auxCoefficients(speciesID) = Matrix_getFromFile(numberOfContractions,dim2,nociUnit,binary=.true.,arguments=arguments(1:2) ) - end do - - do sysI=1, numberOfDisplacedSystems - do speciesID=1, numberOfSpecies - numberOfContractions=molecularSystem_getTotalNumberOfContractions(speciesID) - write(auxString,*) sysI - arguments(1) = "SYSBASISLIST"//trim(auxString) - arguments(2) = trim(MolecularSystem_instance%species(speciesID)%name) - call Vector_getFromFileInteger(numberOfContractions, nociUnit, output=sysListRef(sysI,speciesID), binary=.true., arguments=arguments(1:2) ) - end do - end do - - close(nociUnit) - - !Create a super-mega molecular system - !Merge coefficients from NOCI calculation and reference system - - print *, "super-mega molecular system" - call MolecularSystem_mergeTwoSystems(superMergedMolecularSystem, this%mergedMolecularSystem, MolecularSystem_instance, & - orbListI(:),orbListII(:), reorder=.false.) - call MolecularSystem_showInformation(superMergedMolecularSystem) - call MolecularSystem_showParticlesInformation(superMergedMolecularSystem) - call MolecularSystem_showCartesianMatrix(superMergedMolecularSystem) - - call NonOrthogonalCI_mergeCoefficients(this%mergedCoefficients(:),auxCoefficients(:),& - this%mergedMolecularSystem,MolecularSystem_instance,superMergedMolecularSystem,& - orbListI(:),orbListII(:),superMergedCoefficients(:)) - - ! do speciesID=1, numberOfSpecies - ! print *, "superMergedCoefficients", speciesID - ! call Matrix_show(superMergedCoefficients(speciesID)) - ! end do - - !Fix basis list size - do speciesID=1, numberOfSpecies - ! print *, "orbListI", "speciesID", speciesID - ! call Vector_showInteger(orbListI(speciesID)) - do sysI=1, this%numberOfDisplacedSystems - call Vector_copyConstructorInteger(auxIVector,this%sysBasisList(sysI,speciesID)) - call Vector_constructorInteger(sysListCur(sysI,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem), 0) - do i=1, size(auxIVector%values) - if(orbListI(speciesID)%values(i) .eq. 0) cycle - sysListCur(sysI,speciesID)%values(i)=auxIVector%values(orbListI(speciesID)%values(i)) - end do - ! print *, "sysListCur", "sysI", sysI, "speciesID", speciesID - ! call Vector_showInteger(sysListCur(sysI,speciesID)) - end do - end do - - do speciesID=1, numberOfSpecies - occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1)) !not using the merged molecular systems - ! print *, "orbListII", "speciesID", speciesID - ! call Vector_showInteger(orbListII(speciesID)) - do sysII=1, numberOfDisplacedSystems - call Vector_copyConstructorInteger(auxIVector,sysListRef(sysII,speciesID)) - call Vector_constructorInteger(sysListRef(sysII,speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem), 0) - do i=1, size(orbListII(speciesID)%values) - if(orbListII(speciesID)%values(i) .eq. 0) cycle - sysListRef(sysII,speciesID)%values(i)=auxIVector%values(orbListII(speciesID)%values(i)) - end do - ! print *, "sysListRef", "sysII", sysII, "speciesID", speciesID - ! call Vector_showInteger(sysListRef(sysII,speciesID)) - end do - end do - - ! if(CONTROL_instance%CI_STATES_TO_PRINT .eq. 0) return - - ! numberOfSpecies=molecularSystem_instance%numberOfQuantumSpecies - - - print *, "" - print *, "Computing overlap and moment integrals for the super-mega system..." - print *, "" - do speciesID = 1, numberOfSpecies - call DirectIntegralManager_getOverlapIntegrals(superMergedMolecularSystem,speciesID,superOverlapMatrix(speciesID)) - call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,1,superMomentMatrix(speciesID,1)) - call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,2,superMomentMatrix(speciesID,2)) - call DirectIntegralManager_getMomentIntegrals(superMergedMolecularSystem,speciesID,3,superMomentMatrix(speciesID,3)) - end do - !$ write(*,"(A,E10.3,A4)") "** TOTAL Elapsed Time for supermolecular 1-body integrals : ", omp_get_wtime() - timeA ," (s)" - !$ timeA = omp_get_wtime() - - print *, "" - print *, "Self overlap matrices for the supermegaposed systems..." - print *, "" - - do speciesID=1, numberOfSpecies - call Matrix_constructor(refCurOverlapMatrix(speciesID), int(this%numberOfDisplacedSystems,8), & - int(numberOfDisplacedSystems,8), 1.0_8) - end do - !!Fill the merged density matrix - !!"Non Diagonal" terms - system pairs - do sysI=1, numberOfDisplacedSystems !computed - do sysII=1, numberOfDisplacedSystems !reference - ! if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle - !!Compute molecular overlap matrix and its inverse - do speciesID=1, numberOfSpecies - occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems - particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) - call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) - ! call Matrix_constructor(inverseOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) - - do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysI - if(sysListRef(sysI,speciesID)%values(mu) .eq. 0) cycle - do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysII - if(sysListRef(sysII,speciesID)%values(nu) .eq. 0) cycle - do i = 1 , occupationNumber - ii=occupationNumber*(sysI-1)+i+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2 - do j = 1 , occupationNumber - jj=occupationNumber*(sysII-1)+j+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2 - ! print *, "i, j, mu, nu, coefI, coefII, overlap", i,j,mu,nu,superMergedCoefficients(speciesID)%values(mu,ii),& - ! superMergedCoefficients(speciesID)%values(nu,jj),& - ! superOverlapMatrix(speciesID)%values(mu,nu) - molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+& - superMergedCoefficients(speciesID)%values(mu,ii)*& - superMergedCoefficients(speciesID)%values(nu,jj)*& - superOverlapMatrix(speciesID)%values(mu,nu) - end do - end do - end do - end do - if(occupationNumber .ne. 0) then - ! inverseOverlapMatrix=Matrix_inverse(molecularOverlapMatrix) - ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII - ! call Matrix_show(inverseOverlapMatrices(speciesID)) - call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant,method="LU") - ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant - else - overlapDeterminant=1.0 - end if - refCurOverlapMatrix(speciesID)%values(sysI,sysII)=refCurOverlapMatrix(speciesID)%values(sysI,sysII)*overlapDeterminant**particlesPerOrbital - end do - - end do - end do - - do speciesID=1, numberOfSpecies - print *, "Reference Overlap Matrix for", speciesID - call Matrix_show(refCurOverlapMatrix(speciesID)) - end do - - print *, "" - print *, "Building Franck-Condon matrices for the superposed systems..." - print *, "" - - do speciesID=1, numberOfSpecies - call Matrix_constructor(refCurOverlapMatrix(speciesID), int(this%numberOfDisplacedSystems,8), & - int(numberOfDisplacedSystems,8), 1.0_8) - do k=1,3 - call Matrix_constructor(refCurMomentMatrix(speciesID,k), int(this%numberOfDisplacedSystems,8), & - int(numberOfDisplacedSystems,8), 0.0_8) - end do - end do - call Matrix_constructor(refCurTotalOverlap, int(this%numberOfDisplacedSystems,8), & - int(numberOfDisplacedSystems,8), 1.0_8) - - !!Fill the merged density matrix - !!"Non Diagonal" terms - system pairs - do sysI=1, this%numberOfDisplacedSystems !computed - do sysII=1, numberOfDisplacedSystems !reference - ! if( abs(this%configurationOverlapMatrix%values(sysI,sysII)) .lt. CONTROL_instance%CONFIGURATION_OVERLAP_THRESHOLD ) cycle - !!Compute molecular overlap matrix and its inverse - do speciesID=1, numberOfSpecies - occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems - particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) - call Matrix_constructor(molecularOverlapMatrix, int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) - do k=1,3 - call Matrix_constructor(molecularMomentMatrix(speciesID,k), int(occupationNumber,8), int(occupationNumber,8), 0.0_8 ) - end do - - do mu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysI - if(sysListCur(sysI,speciesID)%values(mu) .eq. 0) cycle - do nu=1, MolecularSystem_getTotalNumberOfContractions(speciesID,superMergedMolecularSystem) !sysII - if(sysListRef(sysII,speciesID)%values(nu) .eq. 0) cycle - do i = 1 , occupationNumber - ii=occupationNumber*(sysI-1)+i - do j = 1 , occupationNumber - jj=occupationNumber*(sysII-1)+j+MolecularSystem_getOcupationNumber(speciesID,superMergedMolecularSystem)/2 - ! print *, "i, j, mu, nu, coefI, coefII, overlap", i,j,mu,nu,superMergedCoefficients(speciesID)%values(mu,ii),& - ! superMergedCoefficients(speciesID)%values(nu,jj),& - ! superOverlapMatrix(speciesID)%values(mu,nu) - molecularOverlapMatrix%values(i,j)=molecularOverlapMatrix%values(i,j)+& - superMergedCoefficients(speciesID)%values(mu,ii)*& - superMergedCoefficients(speciesID)%values(nu,jj)*& - superOverlapMatrix(speciesID)%values(mu,nu) - do k=1,3 - molecularMomentMatrix(speciesID,k)%values(i,j)=molecularMomentMatrix(speciesID,k)%values(i,j)+& - superMergedCoefficients(speciesID)%values(mu,ii)*& - superMergedCoefficients(speciesID)%values(nu,jj)*& - superMomentMatrix(speciesID,k)%values(mu,nu) - end do - end do - end do - end do - end do - if(occupationNumber .ne. 0) then - inverseOverlapMatrix(speciesID)=Matrix_inverse(molecularOverlapMatrix) - ! print *, "inverseOverlapMatrices sysI, sysII", speciesID, sysI, sysII - ! call Matrix_show(inverseOverlapMatrices(speciesID)) - call Matrix_getDeterminant(molecularOverlapMatrix,overlapDeterminant,method="LU") - ! print *, "OverlapDeterminantLU speciesID, sysI, sysII", speciesID, sysI, sysII, overlapDeterminant - refCurOverlapMatrix(speciesID)%values(sysI,sysII)=overlapDeterminant**particlesPerOrbital - else - overlapDeterminant=1.0 - end if - refCurTotalOverlap%values(sysI,sysII)=refCurTotalOverlap%values(sysI,sysII)*refCurOverlapMatrix(speciesID)%values(sysI,sysII) - end do - - do speciesID=1, numberOfSpecies - occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(sysI)) !not using the merged molecular systems - particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(sysI)) - do i = 1 , occupationNumber - do j = 1 , occupationNumber - do k=1,3 - refCurMomentMatrix(speciesID,k)%values(sysI,sysII)=refCurMomentMatrix(speciesID,k)%values(sysI,sysII)+& - molecularMomentMatrix(speciesID,k)%values(i,j)*& - inverseOverlapMatrix(speciesID)%values(j,i) - end do - end do - end do - do k=1,3 - refCurMomentMatrix(speciesID,k)%values(sysI,sysII)=refCurMomentMatrix(speciesID,k)%values(sysI,sysII)*refCurTotalOverlap%values(sysI,sysII)*particlesPerOrbital - end do - end do - end do - end do - - do speciesID=1, numberOfSpecies - print *, "refCurOverlapMatrix(speciesID)", speciesID - call Matrix_show(refCurOverlapMatrix(speciesID)) - call Matrix_constructor(franckCondonMatrix(speciesID), int(CONTROL_instance%CI_STATES_TO_PRINT,8), int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8) - end do - - !+1 For point charges - do speciesID=1, numberOfSpecies+1 - do k=1,3 - call Matrix_constructor(transitionDipoleMatrix(speciesID,k), int(CONTROL_instance%CI_STATES_TO_PRINT,8), int(CONTROL_instance%CI_STATES_TO_PRINT,8), 0.0_8) - end do - end do - - do stateII=1, CONTROL_instance%CI_STATES_TO_PRINT - print *, "Reference state:", stateII - do stateI=1, CONTROL_instance%CI_STATES_TO_PRINT - print *, " current state:", stateI - do speciesID=1, numberOfSpecies - occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molecularSystems(1)) !not using the merged molecular systems - print *, "occupationNumber", occupationNumber - particlesPerOrbital=MolecularSystem_getEta(speciesID,this%molecularSystems(1)) - trololo=0 - do sysI=1, this%numberOfDisplacedSystems !computed - do sysII=1, numberOfDisplacedSystems !reference - do i = 1 , occupationNumber - do j = 1 , occupationNumber - trololo = trololo + & - inverseOverlapMatrix(speciesID)%values(j,i)*& - this%configurationCoefficients%values(sysI,stateI)*& - ciCoefficients%values(sysII,stateII)*& !!reference - refCurOverlapMatrix(speciesID)%values(sysI,sysII)*& - particlesPerOrbital - end do - end do - ! refCurTotalOverlap%values(sysI,sysII)*& - ! franckCondonMatrix(speciesID)%values(stateI,stateII)+& - - do k=1,3 - transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) = transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) + & - molecularsystem_getcharge( speciesID )*& - this%configurationCoefficients%values(sysI,stateI)*& - ciCoefficients%values(sysII,stateII)*& !!reference - refCurMomentMatrix(speciesID,k)%values(sysI,sysII) - end do - - end do - end do - print *, "speciesID", speciesID, "trololo", trololo - franckCondonMatrix(speciesID)%values(stateI,stateII)=trololo - franckCondonMatrix(speciesID)%values(stateI,stateII)=franckCondonMatrix(speciesID)%values(stateI,stateII)/(occupationNumber*particlesPerOrbital) - print *, " F.C. factor for ", molecularSystem_getNameOfSpecies(speciesID),& - franckCondonMatrix(speciesID)%values(stateI,stateII) - end do - do sysI=1, this%numberOfDisplacedSystems !computed - do sysII=1, numberOfDisplacedSystems !reference - do k=1,3 - transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) = transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) + & - pointchargesdipole(k)*& - this%configurationCoefficients%values(sysI,stateI)*& - ciCoefficients%values(sysII,stateII)*& !!reference - refCurTotalOverlap%values(sysI,sysII) - end do - end do - end do - ! trololo=1 - ! do speciesID=1, numberOfSpecies - ! trololo=trololo*franckCondonMatrix(speciesID)%values(stateI,stateII) - ! end do - ! print *, " F.C. factor product ", trololo - ! trololo=0 - ! do speciesID=1, numberOfSpecies - ! trololo=trololo+franckCondonMatrix(speciesID)%values(stateI,stateII) - ! end do - ! print *, " F.C. factor sum ", trololo - ! trololo=0 - ! do sysI=1, this%numberOfDisplacedSystems !computed - ! do sysII=1, numberOfDisplacedSystems !reference - ! trololo = trololo + & - ! this%configurationCoefficients%values(sysI,stateI)*& - ! ciCoefficients%values(sysII,stateII)*& !!reference - ! refCurTotalOverlap%values(sysI,sysII) - ! end do - ! end do - ! print *, " total overlap ", trololo - end do - end do - - print *, "Dipole approximation spectrum" - do stateII=1, CONTROL_instance%CI_STATES_TO_PRINT - print *, "Reference state:", stateII - do stateI=1, CONTROL_instance%CI_STATES_TO_PRINT - trolololo=0 - print *, "current state:", stateI - do speciesID=1, numberOfSpecies - do k=1,3 - trolololo(k)=trolololo(k)+transitionDipoleMatrix(speciesID,k)%values(stateI,stateII) - end do - print *, " T.D. integrals for ", molecularSystem_getNameOfSpecies(speciesID),& - transitionDipoleMatrix(speciesID,1)%values(stateI,stateII),& - transitionDipoleMatrix(speciesID,2)%values(stateI,stateII),& - transitionDipoleMatrix(speciesID,3)%values(stateI,stateII) - end do - do k=1,3 - trolololo(k)=trolololo(k)+transitionDipoleMatrix(numberOfSpecies+1,k)%values(stateI,stateII) - end do - print *, " T.D. integrals point charges ", & - transitionDipoleMatrix(numberOfSpecies+1,1)%values(stateI,stateII),& - transitionDipoleMatrix(numberOfSpecies+1,2)%values(stateI,stateII),& - transitionDipoleMatrix(numberOfSpecies+1,3)%values(stateI,stateII) - print *, "energy dif", ciEnergies%values(stateII)-this%statesEigenvalues%values(stateI), "total components", trolololo(1:3) ,"intensity", sqrt(sum(trolololo(1:3)**2)) - end do - end do - - close(densUnit) - - deallocate(auxCoefficients,& - sysListCur,sysListRef,& - orbListI,orbListII,& - superMergedCoefficients,& - superOverlapMatrix,& - franckCondonMatrix) - - end subroutine NonOrthogonalCI_computeFranckCondon - - -end module NonOrthogonalCI_ - diff --git a/src/PT/PropagatorTheory.f90 b/src/PT/PropagatorTheory.f90 index f7616aa8..34eb7dad 100644 --- a/src/PT/PropagatorTheory.f90 +++ b/src/PT/PropagatorTheory.f90 @@ -294,7 +294,7 @@ subroutine PropagatorTheory_show() n=size(PropagatorTheory_instance%secondOrderCorrections(i)%values,DIM=1) - nameOfSpecies=trim(MolecularSystem_getNameOfSpecie( q )) + nameOfSpecies=trim(MolecularSystem_getNameOfSpecies( q )) write (6,"(T10,A8,A10)") "SPECIES: ",nameOfSpecies @@ -404,7 +404,7 @@ subroutine PropagatorTheory_show() ! i = i + 1 ! ! n=size(PropagatorTheory_instance%thirdOrderCorrections(i)%values,DIM=1) -! write (6,"(T10,A8,A10)")"SPECIE: ",trim(MolecularSystem_getNameOfSpecie( q )) +! write (6,"(T10,A8,A10)")"SPECIE: ",trim(MolecularSystem_getNameOfSpecies( q )) ! write ( 6,'(T10,A85)') "--------------------------------------------------------------------------------------------" ! write ( 6,'(T10,A10,A10,A10,A10,A10,A10,A10,A10)') " Orbital "," KT (eV) "," EP2 (eV)"," P.S "," P3 (eV)"& ! ," P.S "," OVGF (eV)"," P.S " @@ -590,7 +590,7 @@ subroutine PropagatorTheory_secondOrderCorrection() q = q + 1 - nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) ) + nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) ) chargeOfSpeciesA = MolecularSystem_getCharge( i ) ! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i ) occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i ) @@ -649,7 +649,7 @@ subroutine PropagatorTheory_secondOrderCorrection() ! call TransformIntegrals_constructor( repulsionTransformer ) - arguments(2) = MolecularSystem_getNameOfSpecie(i) + arguments(2) = MolecularSystem_getNameOfSpecies(i) arguments(1) = "ORBITALS" @@ -662,7 +662,7 @@ subroutine PropagatorTheory_secondOrderCorrection() activeOrbitalsOfSpeciesB = MolecularSystem_getTotalNumberOfContractions( p ) if ( InputCI_Instance(p)%activeOrbitals /= 0 ) activeOrbitalsOfSpeciesB = InputCI_Instance(p)%activeOrbitals - arguments(2) = trim(MolecularSystem_getNameOfSpecie(p)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(p)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( p ), & @@ -721,7 +721,7 @@ subroutine PropagatorTheory_secondOrderCorrection() activeOrbitalsOfSpeciesB = MolecularSystem_getTotalNumberOfContractions( j ) if ( InputCI_Instance(j)%activeOrbitals /= 0 ) activeOrbitalsOfSpeciesB = InputCI_Instance(j)%activeOrbitals - arguments(2) = trim(MolecularSystem_getNameOfSpecie(j)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(j)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( j ), & @@ -845,7 +845,7 @@ subroutine PropagatorTheory_secondOrderCorrection() else ! interspecies - nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) + nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) chargeOfSpeciesB = MolecularSystem_getCharge( j ) ! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -990,7 +990,7 @@ subroutine PropagatorTheory_secondOrderCorrection() do j = 1 , PropagatorTheory_instance%numberOfSpecies - nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) + nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) E2hp = 0.0_8 E2ph= 0.0_8 @@ -1090,7 +1090,7 @@ subroutine PropagatorTheory_secondOrderCorrection() do j = 1 , PropagatorTheory_instance%numberOfSpecies - nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) + nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) E2hp = 0.0_8 E2ph= 0.0_8 @@ -1489,7 +1489,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() do p = 1 , PropagatorTheory_instance%numberOfSpecies - nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( p ) ) + nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( p ) ) if (nameOfSpeciesA=="E-ALPHA".or.nameOfSpeciesA=="E-BETA") then @@ -1514,7 +1514,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() else - nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( n ) ) + nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( n ) ) !JC call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, & ! MolecularSystem_getEigenVectors(p), MolecularSystem_getEigenVectors(n), & @@ -1540,7 +1540,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() q = q + 1 - nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) ) + nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) ) chargeOfSpeciesA = MolecularSystem_getCharge( i ) !JC eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i ) occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i ) @@ -1549,7 +1549,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() lambdaOfSpeciesA = MolecularSystem_getLambda( i ) virtualNumberOfSpeciesA = activeOrbitalsOfSpeciesA - occupationNumberOfSpeciesA - arguments(2) = trim(MolecularSystem_getNameOfSpecie(i)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(i)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( i ), & @@ -1774,7 +1774,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() !JC print *,"entro al else" - nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( p ) ) + nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( p ) ) chargeOfSpeciesB = MolecularSystem_getCharge( p ) !JC eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( p ) occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( p ) @@ -1783,7 +1783,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() lambdaOfSpeciesB = MolecularSystem_getLambda( p ) virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB - arguments(2) = trim(MolecularSystem_getNameOfSpecie(p)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(p)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( p ), & unit = wfnUnit, binary = .true., arguments = arguments(1:2), & @@ -2191,7 +2191,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() !JC print *,"entro a r diferente de p" - nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( r ) ) + nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( r ) ) chargeOfSpeciesC = MolecularSystem_getCharge( r ) ! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( r ) occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( r ) @@ -2200,7 +2200,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() lambdaOfSpeciesC = MolecularSystem_getLambda( r ) virtualNumberOfSpeciesC = activeOrbitalsOfSpeciesC - occupationNumberOfSpeciesC - arguments(2) = trim(MolecularSystem_getNameOfSpecie(r)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(r)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( r ), & unit = wfnUnit, binary = .true., arguments = arguments(1:2), & @@ -2646,7 +2646,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() else ! interspecies - nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) + nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) chargeOfSpeciesB = MolecularSystem_getCharge( j ) ! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -2655,7 +2655,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() lambdaOfSpeciesB = MolecularSystem_getLambda( j ) virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB - arguments(2) = trim(MolecularSystem_getNameOfSpecie(j)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(j)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( j ), & unit = wfnUnit, binary = .true., arguments = arguments(1:2), & @@ -3061,7 +3061,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() else ! Interspecies term - nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) + nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) chargeOfSpeciesB = MolecularSystem_getCharge( j ) ! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -3070,7 +3070,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() lambdaOfSpeciesB = MolecularSystem_getLambda( j ) virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB - arguments(2) = trim(MolecularSystem_getNameOfSpecie(j)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(j)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( j ), & unit = wfnUnit, binary = .true., arguments = arguments(1:2), & @@ -3501,7 +3501,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() id1=0 id2=0 - nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) + nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) chargeOfSpeciesB = MolecularSystem_getCharge( k ) ! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -3510,7 +3510,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() lambdaOfSpeciesB = MolecularSystem_getLambda( k ) virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB - arguments(2) = trim(MolecularSystem_getNameOfSpecie(k)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(k)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( k ), & unit = wfnUnit, binary = .true., arguments = arguments(1:2), & @@ -3756,7 +3756,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() else ! Interspecies term - nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) + nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) chargeOfSpeciesB = MolecularSystem_getCharge( j ) ! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -3765,7 +3765,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() lambdaOfSpeciesB = MolecularSystem_getLambda( j ) virtualNumberOfSpeciesB = activeOrbitalsOfSpeciesB - occupationNumberOfSpeciesB - arguments(2) = trim(MolecularSystem_getNameOfSpecie(j)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(j)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( j ), & unit = wfnUnit, binary = .true., arguments = arguments(1:2), & @@ -4130,7 +4130,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() ! print *,"ENTRO AL TERMINO DE TRES PARTICULAS:",i,j,k - nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) ) + nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) ) chargeOfSpeciesC = MolecularSystem_getCharge( k ) ! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k ) occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k ) @@ -4139,7 +4139,7 @@ subroutine PropagatorTheory_thirdOrderCorrection5() lambdaOfSpeciesC = MolecularSystem_getLambda( k ) virtualNumberOfSpeciesC = activeOrbitalsOfSpeciesC - occupationNumberOfSpeciesC - arguments(2) = trim(MolecularSystem_getNameOfSpecie(k)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(k)) arguments(1) = "ORBITALS" call Vector_getFromFile( elementsNum = MolecularSystem_getTotalNumberOfContractions( k ), & unit = wfnUnit, binary = .true., arguments = arguments(1:2), & @@ -4870,7 +4870,7 @@ end module PropagatorTheory_ ! do i = specie1ID , specie2ID - ! nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( i ) ) + ! nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( i ) ) ! specieID = MolecularSystem_getSpecieID( nameOfSpecie=nameOfSpecie ) ! charge = MolecularSystem_getCharge( specieID ) @@ -5034,7 +5034,7 @@ end module PropagatorTheory_ ! do j = 1 , PropagatorTheory_instance%numberOfSpecies ! if (j.ne.i) then - ! nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( j ) ) + ! nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( j ) ) ! otherSpecieID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecie ) ! eigenValuesOfOtherSpecie = MolecularSystem_getEigenValues(j) ! occupationNumberOfOtherSpecie = MolecularSystem_getOcupationNumber( j ) @@ -5300,7 +5300,7 @@ end module PropagatorTheory_ ! speciesID = MolecularSystem_getSpecieID( nameOfSpecie=CONTROL_instance%IONIZE_SPECIES ) - ! nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) ) + ! nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) ) ! chargeOfSpecies = MolecularSystem_getCharge( speciesID ) @@ -5409,7 +5409,7 @@ end module PropagatorTheory_ ! do j = 1 , PropagatorTheory_instance%numberOfSpecies ! if (j.ne.speciesID) then - ! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) ) + ! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) ) ! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies ) ! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j) ! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j ) @@ -5503,7 +5503,7 @@ end module PropagatorTheory_ ! do j = 1 , PropagatorTheory_instance%numberOfSpecies ! if (j.ne.speciesID) then - ! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) ) + ! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) ) ! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies ) ! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j) ! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j ) @@ -5801,7 +5801,7 @@ end module PropagatorTheory_ ! print *,"BEGINNING OF SECOND ORDER ELECTRON-NUCLEAR PROPAGATOR CALCULATIONS" ! speciesID = MolecularSystem_getSpecieID( nameOfSpecie=CONTROL_instance%IONIZE_SPECIES ) -! nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) ) +! nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) ) ! chargeOfSpecies = MolecularSystem_getCharge( speciesID ) ! eigenValuesOfSpecies = MolecularSystem_getEigenValues( speciesID ) ! occupationNumberOfSpecies = MolecularSystem_getOcupationNumber( speciesID ) @@ -6034,7 +6034,7 @@ end module PropagatorTheory_ ! do j = 1 , PropagatorTheory_instance%numberOfSpecies ! if (j.ne.speciesID) then -! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) ) ! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies ) ! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j) ! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j ) @@ -6248,7 +6248,7 @@ end module PropagatorTheory_ ! do j = 1 , PropagatorTheory_instance%numberOfSpecies ! if (j.ne.speciesID) then -! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) ) ! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies ) ! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j) ! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j ) @@ -6391,7 +6391,7 @@ end module PropagatorTheory_ ! do j = 1 , PropagatorTheory_instance%numberOfSpecies ! if (j.ne.speciesID) then -! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( j ) ) ! otherSpeciesID =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies ) ! eigenValuesOfOtherSpecies = MolecularSystem_getEigenValues(j) ! occupationNumberOfOtherSpecies = MolecularSystem_getOcupationNumber( j ) @@ -6477,7 +6477,7 @@ end module PropagatorTheory_ ! do i = 1 , PropagatorTheory_instance%numberOfSpecies - 1 ! if (i.ne.speciesID) then -! nameOfOtherSpecies1= trim( MolecularSystem_getNameOfSpecie( i ) ) +! nameOfOtherSpecies1= trim( MolecularSystem_getNameOfSpecies( i ) ) ! otherSpeciesID1 =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies ) ! eigenValuesOfOtherSpecies1 = MolecularSystem_getEigenValues(j) ! occupationNumberOfOtherSpecies1 = MolecularSystem_getOcupationNumber( i ) @@ -6495,7 +6495,7 @@ end module PropagatorTheory_ ! do j = i+1 , PropagatorTheory_instance%numberOfSpecies ! if (j.ne.speciesID) then -! nameOfOtherSpecies2= trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfOtherSpecies2= trim( MolecularSystem_getNameOfSpecies( j ) ) ! otherSpeciesID2 =MolecularSystem_getSpecieID( nameOfSpecie=nameOfOtherSpecies ) ! eigenValuesOfOtherSpecies2 = MolecularSystem_getEigenValues(j) ! occupationNumberOfOtherSpecies2 = MolecularSystem_getOcupationNumber( j ) @@ -6972,7 +6972,7 @@ end module PropagatorTheory_ ! ! q = q + 1 ! -! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) ) +! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) ) ! chargeOfSpeciesA = MolecularSystem_getCharge( i ) !! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i ) ! occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i ) @@ -7017,7 +7017,7 @@ end module PropagatorTheory_ ! ! else ! -! nameOfSpeciesB= trim( MolecularSystem_getNameOfSpecie( p ) ) +! nameOfSpeciesB= trim( MolecularSystem_getNameOfSpecies( p ) ) ! !! call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, & !! MolecularSystem_getEigenVectors(i), MolecularSystem_getEigenVectors(p), & @@ -7136,7 +7136,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -7257,7 +7257,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -7303,7 +7303,7 @@ end module PropagatorTheory_ ! ! else ! interspecies ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -7593,7 +7593,7 @@ end module PropagatorTheory_ ! ! else ! Interspecies term ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -7778,7 +7778,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -7914,7 +7914,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -7975,7 +7975,7 @@ end module PropagatorTheory_ ! ! else ! Interspecies term ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -8180,7 +8180,7 @@ end module PropagatorTheory_ ! ! print *,"entro al manolito",k ! -! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesC = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k ) @@ -8415,7 +8415,7 @@ end module PropagatorTheory_ ! ! q = q + 1 ! -! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) ) +! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) ) ! chargeOfSpeciesA = MolecularSystem_getCharge( i ) !! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i ) ! occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i ) @@ -8461,7 +8461,7 @@ end module PropagatorTheory_ ! ! else ! -! nameOfSpeciesB= trim( MolecularSystem_getNameOfSpecie( p ) ) +! nameOfSpeciesB= trim( MolecularSystem_getNameOfSpecies( p ) ) ! !! call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, & !! MolecularSystem_getEigenVectors(i), MolecularSystem_getEigenVectors(p), & @@ -8595,7 +8595,7 @@ end module PropagatorTheory_ ! ! else ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( p ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( p ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( p ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( p ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( p ) @@ -8808,7 +8808,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -8927,7 +8927,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -8973,7 +8973,7 @@ end module PropagatorTheory_ ! ! else ! interspecies ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -9447,7 +9447,7 @@ end module PropagatorTheory_ ! ! else ! Interspecies term ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -9687,7 +9687,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -9841,7 +9841,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -9910,7 +9910,7 @@ end module PropagatorTheory_ ! ! else ! Interspecies term ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -10163,7 +10163,7 @@ end module PropagatorTheory_ ! ! print *,"entro al manolito",k ! -! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesC = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k ) @@ -10565,7 +10565,7 @@ end module PropagatorTheory_ ! ! do p = 1 , PropagatorTheory_instance%numberOfSpecies ! -! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( p ) ) +! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( p ) ) ! ! do n = 1 , PropagatorTheory_instance%numberOfSpecies ! @@ -10579,7 +10579,7 @@ end module PropagatorTheory_ ! ! else ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( n ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( n ) ) ! !! call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, & !! MolecularSystem_getEigenVectors(p), MolecularSystem_getEigenVectors(n), & @@ -10602,7 +10602,7 @@ end module PropagatorTheory_ ! ! q = q + 1 ! -! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) ) +! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) ) ! chargeOfSpeciesA = MolecularSystem_getCharge( i ) !! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i ) ! occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i ) @@ -10796,7 +10796,7 @@ end module PropagatorTheory_ ! ! print *,"entro al else" ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( p ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( p ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( p ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( p ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( p ) @@ -11070,7 +11070,7 @@ end module PropagatorTheory_ ! ! print *,"entro a r diferente de p" ! -! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( r ) ) +! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( r ) ) ! chargeOfSpeciesC = MolecularSystem_getCharge( r ) !! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( r ) ! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( r ) @@ -11295,7 +11295,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -11414,7 +11414,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -11460,7 +11460,7 @@ end module PropagatorTheory_ ! ! else ! interspecies ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -11734,7 +11734,7 @@ end module PropagatorTheory_ ! ! else ! Interspecies term ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -11957,7 +11957,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -12112,7 +12112,7 @@ end module PropagatorTheory_ ! ! if (k .ne. i) then ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -12182,7 +12182,7 @@ end module PropagatorTheory_ ! ! else ! Interspecies term ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -12412,7 +12412,7 @@ end module PropagatorTheory_ ! ! print *,"entro al manolito",k ! -! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesC = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k ) @@ -12747,7 +12747,7 @@ end module PropagatorTheory_ ! ! do p = 1 , PropagatorTheory_instance%numberOfSpecies ! -! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( p ) ) +! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( p ) ) ! ! if (nameOfSpeciesA=="e-ALPHA".or.nameOfSpeciesA=="e-BETA") then ! @@ -12769,7 +12769,7 @@ end module PropagatorTheory_ ! ! else ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( n ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( n ) ) ! !! call TransformIntegrals_atomicToMolecularOfTwoSpecies( repulsionTransformer, & !! MolecularSystem_getEigenVectors(p), MolecularSystem_getEigenVectors(n), & @@ -12792,7 +12792,7 @@ end module PropagatorTheory_ ! ! q = q + 1 ! -! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecie( i ) ) +! nameOfSpeciesA = trim( MolecularSystem_getNameOfSpecies( i ) ) ! chargeOfSpeciesA = MolecularSystem_getCharge( i ) !! eigenValuesOfSpeciesA = MolecularSystem_getEigenValues( i ) ! occupationNumberOfSpeciesA = MolecularSystem_getOcupationNumber( i ) @@ -12986,7 +12986,7 @@ end module PropagatorTheory_ ! ! print *,"entro al else" ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( p ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( p ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( p ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( p ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( p ) @@ -13331,7 +13331,7 @@ end module PropagatorTheory_ ! ! print *,"entro a r diferente de p" ! -! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( r ) ) +! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( r ) ) ! chargeOfSpeciesC = MolecularSystem_getCharge( r ) !! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( r ) ! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( r ) @@ -13711,7 +13711,7 @@ end module PropagatorTheory_ ! ! else ! interspecies ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -14081,7 +14081,7 @@ end module PropagatorTheory_ ! ! else ! Interspecies term ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -14444,7 +14444,7 @@ end module PropagatorTheory_ ! id1=0 ! id2=0 ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( k ) @@ -14678,7 +14678,7 @@ end module PropagatorTheory_ ! ! else ! Interspecies term ! -! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecie( j ) ) +! nameOfSpeciesB = trim( MolecularSystem_getNameOfSpecies( j ) ) ! chargeOfSpeciesB = MolecularSystem_getCharge( j ) !! eigenValuesOfSpeciesB = MolecularSystem_getEigenValues( j ) ! occupationNumberOfSpeciesB = MolecularSystem_getOcupationNumber( j ) @@ -14988,7 +14988,7 @@ end module PropagatorTheory_ ! ! print *,"ENTRO AL TERMINO DE TRES PARTICULAS:",i,j,k ! -! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecie( k ) ) +! nameOfSpeciesC = trim( MolecularSystem_getNameOfSpecies( k ) ) ! chargeOfSpeciesC = MolecularSystem_getCharge( k ) !! eigenValuesOfSpeciesC = MolecularSystem_getEigenValues( k ) ! occupationNumberOfSpeciesC = MolecularSystem_getOcupationNumber( k ) diff --git a/src/core/BasisSet.f90 b/src/core/BasisSet.f90 index 0c9d2c9a..4189e143 100644 --- a/src/core/BasisSet.f90 +++ b/src/core/BasisSet.f90 @@ -116,140 +116,140 @@ subroutine BasisSet_load(this, formatType, basisName, ParticleName, origin, unit !! Open BasisSet file from library inquire(file=trim(CONTROL_instance%DATA_DIRECTORY)//trim(CONTROL_instance%BASIS_SET_DATABASE)//trim(basisName), exist = existFile) - if(existFile) then - - !! Open File open(unit=30, file=trim(CONTROL_instance%DATA_DIRECTORY)//trim(CONTROL_instance%BASIS_SET_DATABASE)//trim(basisName), status="old",form="formatted") - rewind(30) - - found = .false. - - !! Open element and Find Element Basis set - do while(found .eqv. .false.) - - read(30,*, iostat=status) token, symbol - - !! Some debug information in case of error! - if (status > 0 ) then - - call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.") - - end if - - if (status == -1 ) then - - call BasisSet_exception(ERROR, "The basisSet: "//trim(this%name)//" for: "//trim(particleSelected)//" was not found!","BasisSet module at Load function.") - - end if - - if(trim(token(1:2)) == "O-") then - - if(trim(symbol) == trim(particleSelected)) then - - found = .true. - - end if - + else + !! Open BasisSet file from directory + inquire(file=trim(basisName), exist = existFile) + if(existFile) then + open(unit=30, file=trim(basisName), status="old",form="formatted") + else + !! File not found + call BasisSet_exception(ERROR, "The basisSet file: "//trim(basisName)//" was not found!","BasisSet module at Load function.") + end if + end if + + rewind(30) + found = .false. + + !! Open element and Find Element Basis set + do while(found .eqv. .false.) + + read(30,*, iostat=status) token, symbol + + !! Some debug information in case of error! + if (status > 0 ) then + + call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.") + + end if + + if (status == -1 ) then + + call BasisSet_exception(ERROR, "The basisSet: "//trim(this%name)//" for: "//trim(particleSelected)//" was not found!","BasisSet module at Load function.") + + end if + + if(trim(token(1:2)) == "O-") then + + if(trim(symbol) == trim(particleSelected)) then + + found = .true. + end if - - end do - - !! Neglect any coment - token = "#" - do while(trim(token(1:1)) == "#") - - read(30,*) token - - end do - - !! Start reading basis set - backspace(30) - - read(30,*, iostat=status) this%length - + + end if + + end do + + !! Neglect any coment + token = "#" + do while(trim(token(1:1)) == "#") + + read(30,*) token + + end do + + !! Start reading basis set + backspace(30) + + read(30,*, iostat=status) this%length + + !! Some debug information in case of error! + if (status > 0 ) then + + call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.") + + end if + + allocate(this%contraction(this%length)) + + do i = 1, this%length + + read(30,*,iostat=status) this%contraction(i)%id, & + this%contraction(i)%angularMoment, & + this%contraction(i)%length + !! Some debug information in case of error! if (status > 0 ) then - + call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.") - + end if - - allocate(this%contraction(this%length)) - - do i = 1, this%length - - read(30,*,iostat=status) this%contraction(i)%id, & - this%contraction(i)%angularMoment, & - this%contraction(i)%length - + + allocate(this%contraction(i)%orbitalExponents(this%contraction(i)%length)) + allocate(this%contraction(i)%contractionCoefficients(this%contraction(i)%length)) + + do j = 1, this%contraction(i)%length + + read(30,*,iostat=status) this%contraction(i)%orbitalExponents(j), & + this%contraction(i)%contractionCoefficients(j) + !! Some debug information in case of error! if (status > 0 ) then - + call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.") - + end if - - allocate(this%contraction(i)%orbitalExponents(this%contraction(i)%length)) - allocate(this%contraction(i)%contractionCoefficients(this%contraction(i)%length)) - - do j = 1, this%contraction(i)%length - - read(30,*,iostat=status) this%contraction(i)%orbitalExponents(j), & - this%contraction(i)%contractionCoefficients(j) - - !! Some debug information in case of error! - if (status > 0 ) then - - call BasisSet_exception(ERROR, "ERROR reading basisSet file: "//trim(this%name)//" Please check that file!","BasisSet module at Load function.") - - end if - - end do - - !! Ajust and normalize contractions - this%contraction(i)%origin = this%origin - - !! Calculates the number of cartesian orbitals, by dimensionality - select case(CONTROL_instance%DIMENSIONALITY) - - case(3) - this%contraction(i)%numCartesianOrbital = ( ( this%contraction(i)%angularMoment + 1_8 )*( this%contraction(i)%angularMoment + 2_8 ) ) / 2_8 - case(2) - this%contraction(i)%numCartesianOrbital = ( ( this%contraction(i)%angularMoment + 1_8 ) ) - case(1) - this%contraction(i)%numCartesianOrbital = 1 - case default - call BasisSet_exception( ERROR, "Class object Basis set in load function",& - "This Dimensionality is not avaliable") - end select - - !! Normalize - allocate(this%contraction(i)%contNormalization(this%contraction(i)%numCartesianOrbital)) - allocate(this%contraction(i)%primNormalization(this%contraction(i)%length, & - this%contraction(i)%length*this%contraction(i)%numCartesianOrbital)) - - this%contraction(i)%contNormalization = 1.0_8 - this%contraction(i)%primNormalization = 1.0_8 - call ContractedGaussian_normalizePrimitive(this%contraction(i)) - call ContractedGaussian_normalizeContraction(this%contraction(i)) - - !! DEBUG - !! call ContractedGaussian_showInCompactForm(this%contraction(i)) - end do - - close(30) - - !!DONE - - else - - call BasisSet_exception(ERROR, "The basisSet file: "//trim(basisName)//" was not found!","BasisSet module at Load function.") - - end if - + + !! Ajust and normalize contractions + this%contraction(i)%origin = this%origin + + !! Calculates the number of cartesian orbitals, by dimensionality + select case(CONTROL_instance%DIMENSIONALITY) + + case(3) + this%contraction(i)%numCartesianOrbital = ( ( this%contraction(i)%angularMoment + 1_8 )*( this%contraction(i)%angularMoment + 2_8 ) ) / 2_8 + case(2) + this%contraction(i)%numCartesianOrbital = ( ( this%contraction(i)%angularMoment + 1_8 ) ) + case(1) + this%contraction(i)%numCartesianOrbital = 1 + case default + call BasisSet_exception( ERROR, "Class object Basis set in load function",& + "This Dimensionality is not avaliable") + end select + + !! Normalize + allocate(this%contraction(i)%contNormalization(this%contraction(i)%numCartesianOrbital)) + allocate(this%contraction(i)%primNormalization(this%contraction(i)%length, & + this%contraction(i)%length*this%contraction(i)%numCartesianOrbital)) + + this%contraction(i)%contNormalization = 1.0_8 + this%contraction(i)%primNormalization = 1.0_8 + + call ContractedGaussian_normalizePrimitive(this%contraction(i)) + call ContractedGaussian_normalizeContraction(this%contraction(i)) + + !! DEBUG + !! call ContractedGaussian_showInCompactForm(this%contraction(i)) + + end do + + close(30) + + !!DONE end select end subroutine BasisSet_load diff --git a/src/core/CONTROL.f90 b/src/core/CONTROL.f90 index b85c6dd0..e5b0240f 100644 --- a/src/core/CONTROL.f90 +++ b/src/core/CONTROL.f90 @@ -215,6 +215,8 @@ module CONTROL_ integer :: TRANSLATION_SCAN_GRID(3) integer :: ROTATIONAL_SCAN_GRID integer :: NESTED_ROTATIONAL_GRIDS + integer :: ROTATION_AROUND_Z_MAX_ANGLE + real(8) :: ROTATION_AROUND_Z_STEP real(8) :: TRANSLATION_STEP real(8) :: NESTED_GRIDS_DISPLACEMENT real(8) :: CONFIGURATION_ENERGY_THRESHOLD @@ -227,10 +229,13 @@ module CONTROL_ real(8) :: CONFIGURATION_EQUIVALENCE_DISTANCE real(8) :: EMPIRICAL_OVERLAP_PARAMETER_A real(8) :: EMPIRICAL_OVERLAP_PARAMETER_B + real(8) :: EMPIRICAL_OVERLAP_PARAMETER_E0 + real(8) :: EMPIRICAL_OVERLAP_PARAMETER_SC logical :: CONFIGURATION_USE_SYMMETRY logical :: READ_NOCI_GEOMETRIES logical :: EMPIRICAL_OVERLAP_CORRECTION logical :: ONLY_FIRST_NOCI_ELEMENTS + logical :: COMPUTE_ROCI_FORMULA !!*************************************************************************** !! CCSD Parameters @@ -557,6 +562,8 @@ module CONTROL_ integer :: LowdinParameters_translationScanGrid(3) integer :: LowdinParameters_rotationalScanGrid integer :: LowdinParameters_nestedRotationalGrids + integer :: LowdinParameters_rotationAroundZMaxAngle + real(8) :: LowdinParameters_rotationAroundZStep real(8) :: LowdinParameters_translationStep real(8) :: LowdinParameters_nestedGridsDisplacement real(8) :: LowdinParameters_configurationEnergyThreshold @@ -569,10 +576,13 @@ module CONTROL_ real(8) :: LowdinParameters_configurationEquivalenceDistance real(8) :: LowdinParameters_empiricalOverlapParameterA real(8) :: LowdinParameters_empiricalOverlapParameterB + real(8) :: LowdinParameters_empiricalOverlapParameterE0 + real(8) :: LowdinParameters_empiricalOverlapParameterSc logical :: LowdinParameters_configurationUseSymmetry logical :: LowdinParameters_readNOCIGeometries logical :: LowdinParameters_empiricalOverlapCorrection logical :: LowdinParameters_onlyFirstNOCIelements + logical :: LowdinParameters_computeROCIformula !!*************************************************************************** !! CCSD @@ -899,6 +909,8 @@ module CONTROL_ LowdinParameters_nonOrthogonalConfigurationInteraction,& LowdinParameters_translationScanGrid,& LowdinParameters_rotationalScanGrid,& + LowdinParameters_rotationAroundZMaxAngle,& + LowdinParameters_rotationAroundZStep,& LowdinParameters_nestedRotationalGrids,& LowdinParameters_translationStep,& LowdinParameters_nestedGridsDisplacement,& @@ -912,10 +924,13 @@ module CONTROL_ LowdinParameters_configurationEquivalenceDistance,& LowdinParameters_empiricalOverlapParameterA,& LowdinParameters_empiricalOverlapParameterB,& + LowdinParameters_empiricalOverlapParameterE0,& + LowdinParameters_empiricalOverlapParameterSc,& LowdinParameters_configurationUseSymmetry,& LowdinParameters_readNOCIGeometries,& LowdinParameters_empiricalOverlapCorrection,& LowdinParameters_onlyFirstNOCIelements,& + LowdinParameters_computeROCIformula,& !!*************************************************************************** !! CCSD !! @@ -1262,6 +1277,8 @@ subroutine CONTROL_start() LowdinParameters_nonOrthogonalConfigurationInteraction=.false. LowdinParameters_translationScanGrid(:)=0 LowdinParameters_rotationalScanGrid=0 + LowdinParameters_rotationAroundZMaxAngle=360 + LowdinParameters_rotationAroundZStep=0 LowdinParameters_nestedRotationalGrids=1 LowdinParameters_translationStep=0.0 LowdinParameters_nestedGridsDisplacement=0.0 @@ -1275,10 +1292,13 @@ subroutine CONTROL_start() LowdinParameters_configurationEquivalenceDistance=1.0E-8 LowdinParameters_empiricalOverlapParameterA=0.0604 LowdinParameters_empiricalOverlapParameterB=0.492 + LowdinParameters_empiricalOverlapParameterE0=0.0 + LowdinParameters_empiricalOverlapParameterSc=0.0 LowdinParameters_configurationUseSymmetry=.false. LowdinParameters_readNOCIgeometries=.false. LowdinParameters_empiricalOverlapCorrection=.false. LowdinParameters_onlyFirstNOCIelements=.false. + LowdinParameters_computeROCIformula=.false. !!*************************************************************************** !! CCSD !! @@ -1602,6 +1622,8 @@ subroutine CONTROL_start() CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION=.FALSE. CONTROL_instance%TRANSLATION_SCAN_GRID(:)=0 CONTROL_instance%ROTATIONAL_SCAN_GRID=0 + CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE=360 + CONTROL_instance%ROTATION_AROUND_Z_STEP=0 CONTROL_instance%NESTED_ROTATIONAL_GRIDS=1 CONTROL_instance%TRANSLATION_STEP=0.0 CONTROL_instance%NESTED_GRIDS_DISPLACEMENT=0.0 @@ -1615,10 +1637,13 @@ subroutine CONTROL_start() CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE=1.0E-8 CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A=0.0604 CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B=0.492 + CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0=0.0 + CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_Sc=0.0 CONTROL_instance%CONFIGURATION_USE_SYMMETRY=.false. CONTROL_instance%READ_NOCI_GEOMETRIES=.false. CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION=.false. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS=.false. + CONTROL_instance%COMPUTE_ROCI_FORMULA=.false. !!*************************************************************************** !! CCSD !! @@ -1995,6 +2020,8 @@ subroutine CONTROL_load(unit) CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION=LowdinParameters_nonOrthogonalConfigurationInteraction CONTROL_instance%TRANSLATION_SCAN_GRID=LowdinParameters_translationScanGrid CONTROL_instance%ROTATIONAL_SCAN_GRID=LowdinParameters_rotationalScanGrid + CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE=LowdinParameters_rotationAroundZMaxAngle + CONTROL_instance%ROTATION_AROUND_Z_STEP=LowdinParameters_rotationAroundZStep CONTROL_instance%NESTED_ROTATIONAL_GRIDS=LowdinParameters_nestedRotationalGrids CONTROL_instance%TRANSLATION_STEP=LowdinParameters_translationStep CONTROL_instance%NESTED_GRIDS_DISPLACEMENT=LowdinParameters_nestedGridsDisplacement @@ -2012,10 +2039,13 @@ subroutine CONTROL_load(unit) CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE=LowdinParameters_configurationEquivalenceDistance CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A=LowdinParameters_empiricalOverlapParameterA CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B=LowdinParameters_empiricalOverlapParameterB + CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0=LowdinParameters_empiricalOverlapParameterE0 + CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC=LowdinParameters_empiricalOverlapParameterSc CONTROL_instance%CONFIGURATION_USE_SYMMETRY=LowdinParameters_configurationUseSymmetry CONTROL_instance%READ_NOCI_GEOMETRIES=LowdinParameters_readNOCIGeometries CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION=LowdinParameters_empiricalOverlapCorrection CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS=LowdinParameters_onlyFirstNOCIelements + CONTROL_instance%COMPUTE_ROCI_FORMULA=LowdinParameters_computeROCIformula !!*************************************************************************** @@ -2361,6 +2391,8 @@ subroutine CONTROL_save( unit, lastStep, firstStep ) LowdinParameters_nonOrthogonalConfigurationInteraction=CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION LowdinParameters_translationScanGrid=CONTROL_instance%TRANSLATION_SCAN_GRID LowdinParameters_rotationalScanGrid=CONTROL_instance%ROTATIONAL_SCAN_GRID + LowdinParameters_rotationAroundZMaxAngle=CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE + LowdinParameters_rotationAroundZStep=CONTROL_instance%ROTATION_AROUND_Z_STEP LowdinParameters_nestedRotationalGrids=CONTROL_instance%NESTED_ROTATIONAL_GRIDS LowdinParameters_translationStep=CONTROL_instance%TRANSLATION_STEP LowdinParameters_nestedGridsDisplacement=CONTROL_instance%NESTED_GRIDS_DISPLACEMENT @@ -2374,10 +2406,13 @@ subroutine CONTROL_save( unit, lastStep, firstStep ) LowdinParameters_configurationEquivalenceDistance=CONTROL_instance%CONFIGURATION_EQUIVALENCE_DISTANCE LowdinParameters_empiricalOverlapParameterA=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_A LowdinParameters_empiricalOverlapParameterB=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B + LowdinParameters_empiricalOverlapParameterE0=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0 + LowdinParameters_empiricalOverlapParameterSc=CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC LowdinParameters_configurationUseSymmetry=CONTROL_instance%CONFIGURATION_USE_SYMMETRY LowdinParameters_readNOCIGeometries=CONTROL_instance%READ_NOCI_GEOMETRIES LowdinParameters_empiricalOverlapCorrection=CONTROL_instance%EMPIRICAL_OVERLAP_CORRECTION LowdinParameters_onlyFirstNOCIelements=CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS + LowdinParameters_computeROCIformula=CONTROL_instance%COMPUTE_ROCI_FORMULA !!*************************************************************************** !! CCSD @@ -2697,6 +2732,8 @@ subroutine CONTROL_copy(this, otherThis) otherThis%NONORTHOGONAL_CONFIGURATION_INTERACTION = this%NONORTHOGONAL_CONFIGURATION_INTERACTION otherThis%TRANSLATION_SCAN_GRID = this%TRANSLATION_SCAN_GRID otherThis%ROTATIONAL_SCAN_GRID = this%ROTATIONAL_SCAN_GRID + otherThis%ROTATION_AROUND_Z_MAX_ANGLE=this%ROTATION_AROUND_Z_MAX_ANGLE + otherThis%ROTATION_AROUND_Z_STEP=this%ROTATION_AROUND_Z_STEP otherThis%NESTED_ROTATIONAL_GRIDS = this%NESTED_ROTATIONAL_GRIDS otherThis%TRANSLATION_STEP = this%TRANSLATION_STEP otherThis%NESTED_GRIDS_DISPLACEMENT = this%NESTED_GRIDS_DISPLACEMENT @@ -2710,6 +2747,9 @@ subroutine CONTROL_copy(this, otherThis) otherThis%CONFIGURATION_EQUIVALENCE_DISTANCE=this%CONFIGURATION_EQUIVALENCE_DISTANCE otherThis%CONFIGURATION_USE_SYMMETRY=this%CONFIGURATION_USE_SYMMETRY otherThis%READ_NOCI_GEOMETRIES=this%READ_NOCI_GEOMETRIES + otherThis%ONLY_FIRST_NOCI_ELEMENTS=this%ONLY_FIRST_NOCI_ELEMENTS + otherThis%COMPUTE_ROCI_FORMULA=this%COMPUTE_ROCI_FORMULA + !!*************************************************************************** !! CCSD !! @@ -2997,10 +3037,32 @@ subroutine CONTROL_show() if(CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS) & write (*,"(T10,A)") "COMPUTING NOCI ELEMENTS ONLY WITH RESPECT TO THE FIRST GEOMETRY - YOU HAVE TO SOLVE THE CI EQUATION MANUALLY!" - - print *, "" + if(CONTROL_instance%COMPUTE_ROCI_FORMULA) then + CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS=.true. + if(CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE .gt. 180 ) CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE=180 + write (*,"(T10,A)") "COMPUTING ROTATIONAL ENERGIES FROM THE FIRST GEOMETRY NOCI ELEMENTS" + if(CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0 .gt. 0.0 .or. CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_B .gt. 0.0) then + write (*,"(T10,A,F8.5,A,F8.5)") & + "EMPLOYING EMPIRICAL SCALE FACTORS E0=",& + CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_E0,& + " AND Sc=",& + CONTROL_instance%EMPIRICAL_OVERLAP_PARAMETER_SC + end if + print *, "" + end if + if(CONTROL_instance%ROTATION_AROUND_Z_STEP .gt. 0 ) then + ! if(CONTROL_instance%NESTED_ROTATIONAL_GRIDS .gt. 1 ) then + ! write (*,"(T10,I3,A,I6,A)") CONTROL_instance%NESTED_ROTATIONAL_GRIDS, " GRIDS OF", CONTROL_instance%ROTATIONAL_SCAN_GRID_AROUND_Z, " BASIS FUNCTIONS WILL BE PLACED AROUND EACH ROTATIONAL CENTER" + ! write (*,"(T10,A,F6.3,A10)") "WITH A RADIAL SEPARATION OF", CONTROL_instance%NESTED_GRIDS_DISPLACEMENT, " BOHRS" + ! else + write (*,"(T10,A,F8.2,A,I6,A)") "THE MOLECULAR SYSTEM WILL BE ROTATED AROUND THE Z AXIS IN STEPS OF", CONTROL_instance%ROTATION_AROUND_Z_STEP, " DEGREES UP TO ", CONTROL_instance%ROTATION_AROUND_Z_MAX_ANGLE, " DEGREES" + ! end if + end if + + + print *, "" end if diff --git a/src/core/CosmoCore.f90 b/src/core/CosmoCore.f90 index fef9bfda..72ddde87 100644 --- a/src/core/CosmoCore.f90 +++ b/src/core/CosmoCore.f90 @@ -388,7 +388,7 @@ subroutine CosmoCore_q_builder(cmatinv, cosmo_ints, ints, q_charges,specieid) call Matrix_constructor(q_charge, int(ints,8), 1_8) call Matrix_constructor(cosmo_pot, int(ints,8), 1_8) - specieName=MolecularSystem_getNameOfSpecie(specieid) + specieName=MolecularSystem_getNameOfSpecies(specieid) charge=MolecularSystem_getCharge(MolecularSystem_getSpecieID(specieName)) @@ -503,7 +503,7 @@ subroutine CosmoCore_q_int_builder(integrals_file,charges_file,surface,charges,i if(trim(charges_file)=="cosmo.clasical") then - allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(specieID = f_aux), MolecularSystem_getTotalNumberOfContractions(specieID = f_aux))) + allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(f_aux), MolecularSystem_getTotalNumberOfContractions(f_aux))) ints_mat_aux = 0 !!JC ii = 0 mm = 1 @@ -710,7 +710,7 @@ subroutine CosmoCore_nucleiPotentialQuantumCharges(surface_aux,charges_file,char allocate(cosmo_int(charges)) allocate(a_mat(segments,charges)) allocate(clasical_positions(np,3)) - allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(specieID = f_aux), MolecularSystem_getTotalNumberOfContractions(specieID = f_aux))) + allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(f_aux), MolecularSystem_getTotalNumberOfContractions(f_aux))) open(unit=100, file=trim(charges_file), status='old', form="unformatted") diff --git a/src/core/EnergyGradients.f90 b/src/core/EnergyGradients.f90 index 79940c8a..51cd19cd 100644 --- a/src/core/EnergyGradients.f90 +++ b/src/core/EnergyGradients.f90 @@ -746,10 +746,10 @@ end subroutine EnergyGradients_getAnalyticDerivative ! do i=1, ParticleManager_getNumberOfQuantumSpecies() ! if ( ParticleManager_instance%particles(i)%isQuantum ) then - ! status=system("cp "//trim(fileName)//trim(ParticleManager_getNameOfSpecie( i ))//".vec " & - ! //trim(fileName)//"0."//trim(ParticleManager_getNameOfSpecie( i ))//".vec ") - ! status=system("cp "//trim(fileName)//trim(ParticleManager_getNameOfSpecie( i ))//".vec " & - ! //trim(fileName)//"1."//trim(ParticleManager_getNameOfSpecie( i ))//".vec ") + ! status=system("cp "//trim(fileName)//trim(ParticleManager_getNameOfSpecies( i ))//".vec " & + ! //trim(fileName)//"0."//trim(ParticleManager_getNameOfSpecies( i ))//".vec ") + ! status=system("cp "//trim(fileName)//trim(ParticleManager_getNameOfSpecies( i ))//".vec " & + ! //trim(fileName)//"1."//trim(ParticleManager_getNameOfSpecies( i ))//".vec ") ! end if ! end do @@ -1003,7 +1003,7 @@ subroutine EnergyGradients_calculateAnalyticUncoupledFirstDerivative(surface) ! end do ocupationNumber = MolecularSystem_getOcupationNumber( specieIterator ) - arguments(2) = MolecularSystem_getNameOfSpecie(specieIterator) + arguments(2) = MolecularSystem_getNameOfSpecies(specieIterator) arguments(1) = "DENSITY" densityMatrix = & @@ -1891,7 +1891,7 @@ subroutine EnergyGradients_calculateAnalyticCouplingFirstDerivative() orderOfMatrix = MolecularSystem_getTotalNumberOfContractions(specieIterator) - arguments(2) = MolecularSystem_getNameOfSpecie(specieIterator) + arguments(2) = MolecularSystem_getNameOfSpecies(specieIterator) arguments(1) = "DENSITY" densityMatrix = & @@ -1921,7 +1921,7 @@ subroutine EnergyGradients_calculateAnalyticCouplingFirstDerivative() otherOrderOfMatrix = MolecularSystem_getTotalNumberOfContractions(otherSpecieIterator) - otherArguments(2) = MolecularSystem_getNameOfSpecie(otherSpecieIterator) + otherArguments(2) = MolecularSystem_getNameOfSpecies(otherSpecieIterator) otherArguments(1) = "DENSITY" otherDensityMatrix = & diff --git a/src/core/InputCI.f90 b/src/core/InputCI.f90 index b18c7def..022d7bce 100644 --- a/src/core/InputCI.f90 +++ b/src/core/InputCI.f90 @@ -173,7 +173,7 @@ subroutine InputCI_load( numberOfSpeciesInCIinput ) "check the name of the species in the INPUT_CI block of your input file") end if else - InputCI_Instance(i)%species = MolecularSystem_getNameOfSpecie(i) + InputCI_Instance(i)%species = MolecularSystem_getNameOfSpecies(i) InputCI_excitation=0 if( CONTROL_instance%MP_FROZEN_CORE_BOUNDARY .ne. 0 & .and. (trim(InputCI_Instance(i)%species) .eq. "E-" .or. trim(InputCI_Instance(i)%species) .eq. "E-ALPHA" .or. trim(InputCI_Instance(i)%species) .eq. "E-BETA")) & diff --git a/src/core/Math.f90 b/src/core/Math.f90 index 27bb16b2..c62ca548 100644 --- a/src/core/Math.f90 +++ b/src/core/Math.f90 @@ -707,6 +707,138 @@ subroutine init_md_ftable(nmax) end subroutine init_md_ftable + subroutine Math_p_polynomial_value ( m, n, x, v ) + !*****************************************************************************80 + ! + !! P_POLYNOMIAL_VALUE evaluates the Legendre polynomials P(n,x). + ! + ! Discussion: + ! + ! P(n,1) = 1. + ! P(n,-1) = (-1)^N. + ! | P(n,x) | <= 1 in [-1,1]. + ! + ! The N zeroes of P(n,x) are the abscissas used for Gauss-Legendre + ! quadrature of the integral of a function F(X) with weight function 1 + ! over the interval [-1,1]. + ! + ! The Legendre polynomials are orthogonal under the inner product defined + ! as integration from -1 to 1: + ! + ! Integral ( -1 <= X <= 1 ) P(I,X) * P(J,X) dX + ! = 0 if I =/= J + ! = 2 / ( 2*I+1 ) if I = J. + ! + ! Except for P(0,X), the integral of P(I,X) from -1 to 1 is 0. + ! + ! A function F(X) defined on [-1,1] may be approximated by the series + ! C0*P(0,x) + C1*P(1,x) + ... + CN*P(n,x) + ! where + ! C(I) = (2*I+1)/(2) * Integral ( -1 <= X <= 1 ) F(X) P(I,x) dx. + ! + ! The formula is: + ! + ! P(n,x) = (1/2^N) * sum ( 0 <= M <= N/2 ) C(N,M) C(2N-2M,N) X^(N-2*M) + ! + ! Differential equation: + ! + ! (1-X*X) * P(n,x)'' - 2 * X * P(n,x)' + N * (N+1) = 0 + ! + ! First terms: + ! + ! P( 0,x) = 1 + ! P( 1,x) = 1 X + ! P( 2,x) = ( 3 X^2 - 1)/2 + ! P( 3,x) = ( 5 X^3 - 3 X)/2 + ! P( 4,x) = ( 35 X^4 - 30 X^2 + 3)/8 + ! P( 5,x) = ( 63 X^5 - 70 X^3 + 15 X)/8 + ! P( 6,x) = ( 231 X^6 - 315 X^4 + 105 X^2 - 5)/16 + ! P( 7,x) = ( 429 X^7 - 693 X^5 + 315 X^3 - 35 X)/16 + ! P( 8,x) = ( 6435 X^8 - 12012 X^6 + 6930 X^4 - 1260 X^2 + 35)/128 + ! P( 9,x) = (12155 X^9 - 25740 X^7 + 18018 X^5 - 4620 X^3 + 315 X)/128 + ! P(10,x) = (46189 X^10-109395 X^8 + 90090 X^6 - 30030 X^4 + 3465 X^2-63)/256 + ! + ! Recursion: + ! + ! P(0,x) = 1 + ! P(1,x) = x + ! P(n,x) = ( (2*n-1)*x*P(n-1,x)-(n-1)*P(n-2,x) ) / n + ! + ! P'(0,x) = 0 + ! P'(1,x) = 1 + ! P'(N,x) = ( (2*N-1)*(P(N-1,x)+X*P'(N-1,x)-(N-1)*P'(N-2,x) ) / N + ! + ! Licensing: + ! + ! This code is distributed under the MIT license. + ! + ! Modified: + ! + ! 10 March 2012 + ! + ! Author: + ! + ! John Burkardt + ! + ! Reference: + ! + ! Milton Abramowitz, Irene Stegun, + ! Handbook of Mathematical Functions, + ! National Bureau of Standards, 1964, + ! ISBN: 0-486-61272-4, + ! LC: QA47.A34. + ! + ! Daniel Zwillinger, editor, + ! CRC Standard Mathematical Tables and Formulae, + ! 30th Edition, + ! CRC Press, 1996. + ! + ! Parameters: + ! + ! Input, integer ( kind = 4 ) M, the number of evaluation points. + ! + ! Input, integer ( kind = 4 ) N, the highest order polynomial to evaluate. + ! Note that polynomials 0 through N will be evaluated. + ! + ! Input, real ( kind = rk ) X(M), the evaluation points. + ! + ! Output, real ( kind = rk ) V(M,0:N), the values of the Legendre polynomials + ! of order 0 through N at the points X. + ! + implicit none + + integer, parameter :: rk = 8 + + integer ( kind = 4 ) m + integer ( kind = 4 ) n + + integer ( kind = 4 ) i + real ( kind = rk ) v(m,0:n) + real ( kind = rk ) x(m) + + if ( n < 0 ) then + return + end if + + v(1:m,0) = 1.0D+00 + + if ( n < 1 ) then + return + end if + + v(1:m,1) = x(1:m) + + do i = 2, n + + v(1:m,i) = ( real ( 2 * i - 1, kind = rk ) * x(1:m) * v(1:m,i-1) & + - real ( i - 1, kind = rk ) * v(1:m,i-2) ) & + / real ( i, kind = rk ) + + end do + + return + end subroutine Math_p_polynomial_value + !> !! @brief Maneja excepciones de la clase subroutine Math_exception( typeMessage, description, debugDescription) diff --git a/src/core/MolecularSystem.f90 b/src/core/MolecularSystem.f90 index 428f5c54..06c6d9c7 100644 --- a/src/core/MolecularSystem.f90 +++ b/src/core/MolecularSystem.f90 @@ -92,7 +92,6 @@ module MolecularSystem_ MolecularSystem_getMultiplicity, & MolecularSystem_getParticlesFraction, & MolecularSystem_getFactorOfExchangeIntegrals, & - MolecularSystem_getNameOfSpecie, & MolecularSystem_getNameOfSpecies, & MolecularSystem_getSpecieID, & MolecularSystem_getSpecieIDFromSymbol, & @@ -199,7 +198,7 @@ subroutine MolecularSystem_build() !!Check for input errors in the number of particles if( (abs(int(MolecularSystem_instance%species(i)%ocupationNumber)-MolecularSystem_instance%species(i)%ocupationNumber) .gt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD)) then - print *, "species ", trim(MolecularSystem_getNameOfSpecie(i)) , "has fractional ocupation number ", & + print *, "species ", trim(MolecularSystem_getNameOfSpecies(i)) , "has fractional ocupation number ", & MolecularSystem_instance%species(i)%ocupationNumber, "please check your input addParticles and multiplicity" call MolecularSystem_exception(ERROR, "Fractional ocupation number, imposible combination of charge and multiplicity","MolecularSystem module at build function.") end if @@ -238,10 +237,6 @@ subroutine MolecularSystem_destroy() call MecanicProperties_destructor(MolecularSystem_instance%mechanicalProp) - call ExternalPotential_destructor() - call InterPotential_destructor() - - end subroutine MolecularSystem_destroy !> @@ -996,52 +991,66 @@ end subroutine MolecularSystem_loadFromFile !> !! @brief Returns the number of quantum species in the system. !! @author E. F. Posada, 2013 - function MolecularSystem_getNumberOfQuantumSpecies() result( output ) + function MolecularSystem_getNumberOfQuantumSpecies(this) result( output ) implicit none - + type(MolecularSystem), optional, target :: this integer :: output - - output = MolecularSystem_instance%numberOfQuantumSpecies + + type(MolecularSystem), pointer :: system + + output = 0 + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + output = system%numberOfQuantumSpecies end function MolecularSystem_getNumberOfQuantumSpecies !> !! @brief Returns the number of particles of speciesID. !! @author E. F. Posada, 2013 - function MolecularSystem_getNumberOfParticles(speciesID) result(output) + function MolecularSystem_getNumberOfParticles(speciesID,this) result(output) implicit none - integer :: speciesID + type(MolecularSystem), optional, target :: this integer :: output - output = MolecularSystem_instance%species(speciesID)%internalSize + type(MolecularSystem), pointer :: system + + output = 0 + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + + output = system%species(speciesID)%internalSize end function MolecularSystem_getNumberOfParticles !> !! @brief Returns the number of shells for specie. !! @author E. F. Posada, 2013 - function MolecularSystem_getNumberOfContractions( specieID ) result( output ) + function MolecularSystem_getNumberOfContractions(speciesID,this) result( output ) implicit none - integer :: specieID + integer :: speciesID + type(MolecularSystem), optional, target :: this integer :: output - integer :: i, j + type(MolecularSystem), pointer :: system + integer :: j output = 0 + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if - do i = 1, MolecularSystem_instance%numberOfQuantumSpecies - - if ( specieID == i ) then - - do j = 1, size(MolecularSystem_instance%species(i)%particles) - - output = output + size(MolecularSystem_instance%species(i)%particles(j)%basis%contraction) - - end do - - end if - + do j = 1, size(system%species(speciesID)%particles) + output = output + size(system%species(speciesID)%particles(j)%basis%contraction) end do end function MolecularSystem_getNumberOfContractions @@ -1049,9 +1058,9 @@ end function MolecularSystem_getNumberOfContractions !> !! @brief Returns the number of cartesian shells for specie. !! @author E. F. Posada, 2013 - function MolecularSystem_getTotalNumberOfContractions( specieID, this ) result( output ) + function MolecularSystem_getTotalNumberOfContractions( speciesID, this ) result( output ) implicit none - integer :: specieID + integer :: speciesID type(MolecularSystem), optional, target :: this type(MolecularSystem), pointer :: system @@ -1066,14 +1075,10 @@ function MolecularSystem_getTotalNumberOfContractions( specieID, this ) result( system=>MolecularSystem_instance end if - do j = 1, size(system%species(specieID)%particles) - - do k = 1, size(system%species(specieID)%particles(j)%basis%contraction) - - output = output + system%species(specieID)%particles(j)%basis%contraction(k)%numCartesianOrbital - + do j = 1, size(system%species(speciesID)%particles) + do k = 1, size(system%species(speciesID)%particles(j)%basis%contraction) + output = output + system%species(speciesID)%particles(j)%basis%contraction(k)%numCartesianOrbital end do - end do end function MolecularSystem_getTotalNumberOfContractions @@ -1154,20 +1159,29 @@ end function MolecularSystem_getMaxNumberofPrimitives !> @brief find de maximun number of primitives for specieID, necessary for derive with libint !! @author J.M. Rodas 2015 !! @version 1.0 - function MolecularSystem_getMaxNumberofCartesians(specieID) result(output) + function MolecularSystem_getMaxNumberofCartesians(speciesID,this) result(output) implicit none - integer :: specieID + integer :: speciesID + type(MolecularSystem), optional, target :: this integer :: output + type(MolecularSystem), pointer :: system integer :: i, j + + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + output = -1 - do i = 1, size(MolecularSystem_instance%species(specieID)%particles) - do j = 1, size(MolecularSystem_instance%species(specieID)%particles(i)%basis%contraction) + do i = 1, size(system%species(speciesID)%particles) + do j = 1, size(system%species(speciesID)%particles(i)%basis%contraction) - output = max(output, MolecularSystem_instance%species(specieID)%particles(i)%basis%contraction(j)%numCartesianOrbital) + output = max(output, system%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital) end do end do @@ -1219,51 +1233,82 @@ function MolecularSystem_getEta(speciesID,this) result(output) end function MolecularSystem_getEta - function MolecularSystem_getLambda(speciesID) result(output) + function MolecularSystem_getLambda(speciesID,this) result(output) implicit none integer :: speciesID + type(MolecularSystem), optional, target :: this integer :: output + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + output = -1 - output = MolecularSystem_instance%species(speciesID)%lambda + output = system%species(speciesID)%lambda end function MolecularSystem_getLambda - function MolecularSystem_getKappa(speciesID) result(output) + function MolecularSystem_getKappa(speciesID,this) result(output) implicit none integer :: speciesID + type(MolecularSystem), optional, target :: this integer :: output + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + output = -1 - output = MolecularSystem_instance%species(speciesID)%kappa + output = system%species(speciesID)%kappa end function MolecularSystem_getKappa - function MolecularSystem_getMultiplicity(speciesID) result(output) + function MolecularSystem_getMultiplicity(speciesID,this) result(output) implicit none integer :: speciesID + type(MolecularSystem), optional, target :: this integer :: output + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + output = -1 - output = MolecularSystem_instance%species(speciesID)%spin + output = system%species(speciesID)%spin end function MolecularSystem_getMultiplicity - function MolecularSystem_getParticlesFraction(speciesID) result(output) - implicit none - + function MolecularSystem_getParticlesFraction(speciesID,this) result(output) + implicit none integer :: speciesID + type(MolecularSystem), optional, target :: this real(8) :: output + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + output = -1 - output = MolecularSystem_instance%species(speciesID)%particlesFraction + output = system%species(speciesID)%particlesFraction end function MolecularSystem_getParticlesFraction @@ -1271,37 +1316,58 @@ end function MolecularSystem_getParticlesFraction !> @brief Returns the charge of speciesID !! @author E. F. Posada, 2013 !! @version 1.0 - function MolecularSystem_getCharge( speciesID ) result( output ) + function MolecularSystem_getCharge(speciesID,this) result( output ) implicit none integer :: speciesID - + type(MolecularSystem), optional, target :: this real(8) :: output - output = MolecularSystem_instance%species(speciesID)%charge + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + + output = system%species(speciesID)%charge end function MolecularSystem_getCharge !> @brief Returns the omega frequency of speciesID. Why we have these functions?? - function MolecularSystem_getOmega( speciesID ) result( output ) + function MolecularSystem_getOmega(speciesID,this) result( output ) implicit none integer :: speciesID - + type(MolecularSystem), optional, target :: this real(8) :: output - output = MolecularSystem_instance%species(speciesID)%omega + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + + output = system%species(speciesID)%omega end function MolecularSystem_getOmega !> @brief Returns the mass of speciesID !! @author E. F. Posada, 2013 !! @version 1.0 - function MolecularSystem_getMass( speciesID ) result( output ) + function MolecularSystem_getMass(speciesID,this) result( output ) implicit none integer :: speciesID - + type(MolecularSystem), optional, target :: this real(8) :: output - output = MolecularSystem_instance%species(speciesID)%mass + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + + output = system%species(speciesID)%mass end function MolecularSystem_getMass @@ -1332,69 +1398,86 @@ end function MolecularSystem_getQDOCenter !> @brief Returns the Factor Of Exchange Integrals !! @author E. F. Posada, 2013 !! @version 1.0 - function MolecularSystem_getFactorOfExchangeIntegrals( speciesID ) result( output ) + function MolecularSystem_getFactorOfExchangeIntegrals(speciesID,this) result( output ) implicit none integer :: speciesID - + type(MolecularSystem), optional, target :: this real(8) :: output - output = MolecularSystem_instance%species(speciesID)%kappa / MolecularSystem_instance%species(speciesID)%eta + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + + output = system%species(speciesID)%kappa / system%species(speciesID)%eta end function MolecularSystem_getFactorOfExchangeIntegrals !> @brief Returns the name of a species !! @author E. F. Posada, 2013 !! @version 1.0 - function MolecularSystem_getNameOfSpecie(speciesID) result(output) - implicit none - + function MolecularSystem_getNameOfSpecies(speciesID,this) result(output) + implicit none integer :: speciesID + type(MolecularSystem), optional, target :: this character(30) :: output - output = MolecularSystem_instance%species(speciesID)%name - - end function MolecularSystem_getNameOfSpecie - - !> @brief Returns the name of a species - !! @author E. F. Posada, 2013 - !! @version 1.0 - function MolecularSystem_getNameOfSpecies(speciesID) result(output) - implicit none - - integer :: speciesID - character(30) :: output + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if - output = MolecularSystem_instance%species(speciesID)%name + output = system%species(speciesID)%name end function MolecularSystem_getNameOfSpecies !> @brief Returns the symbol of a species !! @author E. F. Posada, 2013 !! @version 1.0 - function MolecularSystem_getSymbolOfSpecies(speciesID) result(output) + function MolecularSystem_getSymbolOfSpecies(speciesID,this) result(output) implicit none integer :: speciesID + type(MolecularSystem), optional, target :: this character(30) :: output - output = MolecularSystem_instance%species(speciesID)%symbol + type(MolecularSystem), pointer :: system + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + + output = system%species(speciesID)%symbol end function MolecularSystem_getSymbolOfSpecies !> @brief Returns the name of a species !! @author E. F. Posada, 2013 !! @version 1.0 - function MolecularSystem_getSpecieID( nameOfSpecie ) result(output) + function MolecularSystem_getSpecieID( nameOfSpecie,this ) result(output) implicit none character(*) :: nameOfSpecie + type(MolecularSystem), optional, target :: this integer :: output + + type(MolecularSystem), pointer :: system integer i + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if output = 0 - do i = 1, MolecularSystem_instance%numberOfQuantumSpecies - if( trim(MolecularSystem_instance%species(i)%name) == trim(nameOfSpecie)) output = i + do i = 1, system%numberOfQuantumSpecies + if( trim(system%species(i)%name) == trim(nameOfSpecie)) output = i end do end function MolecularSystem_getSpecieID @@ -1402,41 +1485,58 @@ end function MolecularSystem_getSpecieID !> @brief Returns the name of a species !! @author E. F. Posada, 2013 !! @version 1.0 - function MolecularSystem_getSpecieIDFromSymbol( symbolOfSpecie ) result(output) + function MolecularSystem_getSpecieIDFromSymbol( symbolOfSpecie,this ) result(output) implicit none character(*) :: symbolOfSpecie + type(MolecularSystem), optional, target :: this integer :: output + + type(MolecularSystem), pointer :: system integer i + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if output = 0 - do i = 1, MolecularSystem_instance%numberOfQuantumSpecies - if( trim(MolecularSystem_instance%species(i)%symbol) == trim(symbolOfSpecie)) output = i + do i = 1, system%numberOfQuantumSpecies + if( trim(system%species(i)%symbol) == trim(symbolOfSpecie)) output = i end do end function MolecularSystem_getSpecieIDFromSymbol !> !! @brief calcula la energia total para una especie especificada - function MolecularSystem_getPointChargesEnergy() result( output ) + function MolecularSystem_getPointChargesEnergy(this) result( output ) implicit none real(8) :: output + type(MolecularSystem), optional, target :: this + type(MolecularSystem), pointer :: system integer :: i integer :: j real(8) :: deltaOrigin(3) + + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + output =0.0_8 - do i=1, size( MolecularSystem_instance%pointCharges ) - do j = i + 1 , size( MolecularSystem_instance%pointCharges ) + do i=1, size( system%pointCharges ) + do j = i + 1 , size( system%pointCharges ) - deltaOrigin = MolecularSystem_instance%pointCharges(i)%origin & - - MolecularSystem_instance%pointCharges(j)%origin + deltaOrigin = system%pointCharges(i)%origin & + - system%pointCharges(j)%origin - output=output + ( ( MolecularSystem_instance%pointCharges(i)%charge & - * MolecularSystem_instance%pointCharges(j)%charge )& + output=output + ( ( system%pointCharges(i)%charge & + * system%pointCharges(j)%charge )& / sqrt( sum( deltaOrigin**2.0_8 ) ) ) end do @@ -1444,33 +1544,41 @@ function MolecularSystem_getPointChargesEnergy() result( output ) !! Point charge potential with the external electric field if ( sum(abs(CONTROL_instance%ELECTRIC_FIELD )) .ne. 0 ) then - do i=1, size( MolecularSystem_instance%pointCharges ) - output = output + sum(CONTROL_instance%ELECTRIC_FIELD(:) * MolecularSystem_instance%pointCharges(i)%origin(:) )* MolecularSystem_instance%pointCharges(i)%charge + do i=1, size( system%pointCharges ) + output = output + sum(CONTROL_instance%ELECTRIC_FIELD(:) * system%pointCharges(i)%origin(:) )* system%pointCharges(i)%charge end do end if end function MolecularSystem_getPointChargesEnergy - function MolecularSystem_getMMPointChargesEnergy() result( output ) + function MolecularSystem_getMMPointChargesEnergy(this) result( output ) implicit none real(8) :: output - + type(MolecularSystem), optional, target :: this + + type(MolecularSystem), pointer :: system integer :: i integer :: j real(8) :: deltaOrigin(3) + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + output =0.0_8 - do i=1, size( MolecularSystem_instance%pointCharges ) - if(trim(MolecularSystem_instance%pointCharges(i)%nickname) == "PC") then - do j = i + 1 , size( MolecularSystem_instance%pointCharges ) + do i=1, size( system%pointCharges ) + if(trim(system%pointCharges(i)%nickname) == "PC") then + do j = i + 1 , size( system%pointCharges ) - deltaOrigin = MolecularSystem_instance%pointCharges(i)%origin & - - MolecularSystem_instance%pointCharges(j)%origin + deltaOrigin = system%pointCharges(i)%origin & + - system%pointCharges(j)%origin - output=output + ( ( MolecularSystem_instance%pointCharges(i)%charge & - * MolecularSystem_instance%pointCharges(j)%charge )& + output=output + ( ( system%pointCharges(i)%charge & + * system%pointCharges(j)%charge )& / sqrt( sum( deltaOrigin**2.0_8 ) ) ) end do @@ -1481,35 +1589,44 @@ end function MolecularSystem_getMMPointChargesEnergy !> !! @brief returns an array of labels of all basis set of speciesID - function MolecularSystem_getlabelsofcontractions(speciesID) result(output) + function MolecularSystem_getlabelsofcontractions(speciesID,this) result(output) implicit none - integer :: speciesID character(19),allocatable :: output(:) + integer :: speciesID + type(MolecularSystem), optional, target :: this + + type(MolecularSystem), pointer :: system integer :: i, j, k integer :: counter character(9), allocatable :: shellCode(:) + if( present(this) ) then + system=>this + else + system=>MolecularSystem_instance + end if + if(allocated(output)) deallocate(output) - allocate(output(MolecularSystem_getTotalNumberOfContractions(speciesID))) + allocate(output(MolecularSystem_getTotalNumberOfContractions(speciesID,system))) output = "" counter = 1 - do i = 1, size(MolecularSystem_instance%species(speciesID)%particles) - do j = 1, size(MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction) + do i = 1, size(system%species(speciesID)%particles) + do j = 1, size(system%species(speciesID)%particles(i)%basis%contraction) if(allocated(shellCode)) deallocate(shellCode) - allocate(shellCode(MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital)) + allocate(shellCode(system%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital)) shellCode = "" - shellCode = ContractedGaussian_getShellCode(MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j)) + shellCode = ContractedGaussian_getShellCode(system%species(speciesID)%particles(i)%basis%contraction(j)) - do k = 1, MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital + do k = 1, system%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital write (output(counter),"(I5,A1,A6,A1,A6)") counter, " ", & - trim(MolecularSystem_instance%species(speciesID)%particles(i)%nickname), " ", & + trim(system%species(speciesID)%particles(i)%nickname), " ", & trim(shellCode(k))//" " counter = counter + 1 @@ -2352,7 +2469,7 @@ subroutine MolecularSystem_mergeTwoSystems(mergedThis,thisA,thisB,sysAbasisList, ! if( (.not. present(sysAbasisList)) .and. (.not. present(sysBbasisList)) ) return !!Fill the basis set lists - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + do speciesID = 1, mergedThis%numberOfQuantumSpecies call Vector_constructorInteger(sysAbasisList(speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,mergedThis), 0 ) call Vector_constructorInteger(sysBbasisList(speciesID), MolecularSystem_getTotalNumberOfContractions(speciesID,mergedThis), 0 ) diff --git a/src/core/ParticleManager.f90 b/src/core/ParticleManager.f90 index 30ea6f79..2e28190e 100644 --- a/src/core/ParticleManager.f90 +++ b/src/core/ParticleManager.f90 @@ -555,7 +555,7 @@ end function ParticleManager_isCenterOfOptimization ! !! @brief Retorna un ID asociado a la especie especificada ! !! ! !> - ! function ParticleManager_getNameOfSpecie( specieID ) result( output ) + ! function ParticleManager_getNameOfSpecies( specieID ) result( output ) ! implicit none ! integer, intent(in) :: specieID ! character(30) :: output @@ -566,10 +566,10 @@ end function ParticleManager_isCenterOfOptimization ! else ! call ParticleManager_exception( ERROR, "You should instance the ParticleManager before use this function", & - ! "Class object ParticleManager in the getNameOfSpecie function") + ! "Class object ParticleManager in the getNameOfSpecies function") ! end if - ! end function ParticleManager_getNameOfSpecie + ! end function ParticleManager_getNameOfSpecies ! !< ! !! @brief Retorna un iterador a laprimera especie en el sistema molecular diff --git a/src/core/ReadTransformedIntegrals.f90 b/src/core/ReadTransformedIntegrals.f90 index 8e23b272..aaab130e 100644 --- a/src/core/ReadTransformedIntegrals.f90 +++ b/src/core/ReadTransformedIntegrals.f90 @@ -76,7 +76,7 @@ subroutine ReadTransformedIntegrals_readOneSpecies( specieID, matrixContainer ) real(8) :: auxIntegralValue numberOfContractions = max( MolecularSystem_getTotalNumberOfContractions(specieID), MolecularSystem_getOcupationNumber( specieID )) - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) prefixOfFile =""//trim(nameOfSpecie) @@ -365,8 +365,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat + MolecularSystem_getTotalNumberOfContractions(otherSpecieID) bias = MolecularSystem_getTotalNumberOfContractions(specieID) - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie) @@ -451,8 +451,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat + MolecularSystem_getTotalNumberOfContractions(otherSpecieID) bias = MolecularSystem_getTotalNumberOfContractions(otherSpecieID) - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie) @@ -542,8 +542,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat + MolecularSystem_getTotalNumberOfContractions(otherSpecieID) bias = MolecularSystem_getTotalNumberOfContractions(specieID) - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie) @@ -618,8 +618,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat ssize2a = ( ssizea * (ssizea + 1 ) ) / 2_8 ssize2b = ( ssizeb * (ssizeb + 1 ) ) / 2_8 - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie) @@ -673,8 +673,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat ssize2b = ( ssizeb * (ssizeb + 1 ) ) / 2_8 - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie) @@ -726,8 +726,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat + MolecularSystem_getTotalNumberOfContractions(otherSpecieID) bias = MolecularSystem_getTotalNumberOfContractions(specieID) - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie) @@ -764,8 +764,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat + MolecularSystem_getTotalNumberOfContractions(otherSpecieID) bias = MolecularSystem_getTotalNumberOfContractions(specieID) - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie) unidOfOutputForIntegrals = CONTROL_instance%UNIT_FOR_MP2_INTEGRALS_FILE @@ -818,8 +818,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat ssize2a = ( ssizea * (ssizea + 1 ) ) / 2_8 ssize2b = ( ssizeb * (ssizeb + 1 ) ) / 2_8 - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie) @@ -877,8 +877,8 @@ subroutine ReadTransformedIntegrals_readTwoSpecies( specieID, otherSpecieID, mat ssize2b = ( ssizeb * (ssizeb + 1 ) ) / 2_8 - nameOfSpecie= trim( MolecularSystem_getNameOfSpecie( specieID ) ) - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( otherSpecieID ) ) + nameOfSpecie= trim( MolecularSystem_getNameOfSpecies( specieID ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( otherSpecieID ) ) prefixOfFile =""//trim(nameOfOtherSpecie)//"."//trim(nameOfSpecie) unidOfOutputForIntegrals = CONTROL_instance%UNIT_FOR_MP2_INTEGRALS_FILE diff --git a/src/core/Solver.f90 b/src/core/Solver.f90 index db2d73d1..081ed520 100644 --- a/src/core/Solver.f90 +++ b/src/core/Solver.f90 @@ -97,7 +97,7 @@ subroutine Solver_run( ) if ( CONTROL_instance%NONORTHOGONAL_CONFIGURATION_INTERACTION ) then call system("lowdin-NOCI.x POSTSCF") !!calculate CI density properties - call system ("lowdin-CalcProp.x") + if ( .not. (CONTROL_instance%COMPUTE_ROCI_FORMULA .or. CONTROL_instance%ONLY_FIRST_NOCI_ELEMENTS)) call system ("lowdin-CalcProp.x") end if if ( CONTROL_instance%PT_ORDER /= 0 ) then diff --git a/src/integralsTransformation/IntegralTransformation.f90 b/src/integralsTransformation/IntegralTransformation.f90 index 1e761928..26d85017 100644 --- a/src/integralsTransformation/IntegralTransformation.f90 +++ b/src/integralsTransformation/IntegralTransformation.f90 @@ -170,7 +170,7 @@ program IntegralsTransformation do i=1, numberOfQuantumSpecies - nameOfSpecies = trim( MolecularSystem_getNameOfSpecie( i ) ) + nameOfSpecies = trim( MolecularSystem_getNameOfSpecies( i ) ) !! For PT = 2 there is no need to transform integrals for all species" if ( partialTransform == "PT2" .and. CONTROL_instance%IONIZE_SPECIES(1) /= "NONE" ) then @@ -195,7 +195,7 @@ program IntegralsTransformation numberOfContractions = MolecularSystem_getTotalNumberOfContractions(i) occupation = MolecularSystem_getOcupationNumber( i ) - arguments(2) = MolecularSystem_getNameOfSpecie(i) + arguments(2) = MolecularSystem_getNameOfSpecies(i) arguments(1) = "COEFFICIENTS" eigenVec= Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), & @@ -253,7 +253,7 @@ program IntegralsTransformation !! if ( numberOfQuantumSpecies > 1 ) then do j = i + 1 , numberOfQuantumSpecies - nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecie( j ) ) + nameOfOtherSpecie= trim( MolecularSystem_getNameOfSpecies( j ) ) !! For PT = 2 there is no need to transform integrals for all species" if ( partialTransform == "PT2" .and. CONTROL_instance%IONIZE_SPECIES(1) /= "NONE" ) then @@ -280,7 +280,7 @@ program IntegralsTransformation numberOfContractionsOfOtherSpecie = MolecularSystem_getTotalNumberOfContractions( j ) otherOccupation = MolecularSystem_getOcupationNumber( j ) - arguments(2) = trim(MolecularSystem_getNameOfSpecie(j)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(j)) arguments(1) = "COEFFICIENTS" eigenVecOtherSpecie = & diff --git a/src/integralsTransformation/TransformIntegralsC.f90 b/src/integralsTransformation/TransformIntegralsC.f90 index ad0d62eb..cadbdb8a 100644 --- a/src/integralsTransformation/TransformIntegralsC.f90 +++ b/src/integralsTransformation/TransformIntegralsC.f90 @@ -1716,8 +1716,8 @@ subroutine TransformIntegralsC_checkInterMOIntegralType(speciesID, otherSpeciesI ionizeA = .false. ionizeB = .false. - nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) ) - nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( otherSpeciesID ) ) + nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) ) + nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( otherSpeciesID ) ) do s = 1, size(CONTROL_instance%IONIZE_SPECIES ) if ( nameOfSpecies == trim(CONTROL_instance%IONIZE_SPECIES(s)) ) then @@ -1843,8 +1843,8 @@ subroutine TransformIntegralsC_checkInterMOIntegralType(speciesID, otherSpeciesI ionizeA = .false. ionizeB = .false. - nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) ) - nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( otherSpeciesID ) ) + nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) ) + nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( otherSpeciesID ) ) do s = 1, size(CONTROL_instance%IONIZE_SPECIES ) if ( nameOfSpecies == trim(CONTROL_instance%IONIZE_SPECIES(s)) ) then @@ -1979,7 +1979,7 @@ subroutine TransformIntegralsC_getNumberOfNonZeroRepulsionIntegrals( specieID, n sfile = trim(adjustl(sfile)) unit = ifile+50 - nameOfSpecie = MolecularSystem_getNameOfSpecie( specieID ) + nameOfSpecie = MolecularSystem_getNameOfSpecies( specieID ) if ( trim(nameOfSpecie) == "E-BETA" ) nameOfSpecie =""//trim("E-ALPHA") @@ -2009,8 +2009,8 @@ subroutine TransformIntegralsC_getNumberOfNonZeroCouplingIntegrals( i, j, nproc sfile = trim(adjustl(sfile)) unit = ifile+50 - nameOfSpecie = MolecularSystem_getNameOfSpecie( i ) - nameOfOtherSpecie = MolecularSystem_getNameOfSpecie( j ) + nameOfSpecie = MolecularSystem_getNameOfSpecies( i ) + nameOfOtherSpecie = MolecularSystem_getNameOfSpecies( j ) open( UNIT=unit,FILE=trim(sfile)//trim(nameOfSpecie)//"."//trim(nameOfOtherSpecie)//".nints", status='old',access='sequential', form='Unformatted') diff --git a/src/integralsTransformation/TransformIntegralsE.f90 b/src/integralsTransformation/TransformIntegralsE.f90 index e001e01e..b22c940b 100644 --- a/src/integralsTransformation/TransformIntegralsE.f90 +++ b/src/integralsTransformation/TransformIntegralsE.f90 @@ -2149,8 +2149,8 @@ subroutine TransformIntegralsE_checkInterMOIntegralType(speciesID, otherSpeciesI ionizeA = .false. ionizeB = .false. - nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) ) - nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( otherSpeciesID ) ) + nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) ) + nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( otherSpeciesID ) ) do s = 1, size(CONTROL_instance%IONIZE_SPECIES ) if ( nameOfSpecies == trim(CONTROL_instance%IONIZE_SPECIES(s)) ) then @@ -2287,8 +2287,8 @@ subroutine TransformIntegralsE_checkInterMOIntegralType(speciesID, otherSpeciesI ionizeA = .false. ionizeB = .false. - nameOfSpecies= trim( MolecularSystem_getNameOfSpecie( speciesID ) ) - nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecie( otherSpeciesID ) ) + nameOfSpecies= trim( MolecularSystem_getNameOfSpecies( speciesID ) ) + nameOfOtherSpecies= trim( MolecularSystem_getNameOfSpecies( otherSpeciesID ) ) do s = 1, size(CONTROL_instance%IONIZE_SPECIES ) if ( nameOfSpecies == trim(CONTROL_instance%IONIZE_SPECIES(s)) ) then diff --git a/src/ints/DirectIntegralManager.f90 b/src/ints/DirectIntegralManager.f90 index 20dfd503..4733500f 100644 --- a/src/ints/DirectIntegralManager.f90 +++ b/src/ints/DirectIntegralManager.f90 @@ -33,6 +33,7 @@ module DirectIntegralManager_ use Matrix_ use Stopwatch_ use ExternalPotential_ + use String_ !# use RysQInts_ !! Please do not remove this line implicit none @@ -62,8 +63,7 @@ module DirectIntegralManager_ !! @version 1.0 !! @par History !! - recursive subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix(speciesID, scheme, & - densityMatrix, twoParticlesMatrix, factor ) + recursive subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix(speciesID, scheme, densityMatrix, twoParticlesMatrix, factor, system, Libint2Local ) implicit none integer :: speciesID @@ -71,17 +71,25 @@ recursive subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix(species type(matrix) :: densityMatrix real(8), allocatable, target :: twoParticlesMatrix(:,:) real(8) :: factor + type(MolecularSystem), optional, target :: system + type(Libint2Interface), optional :: Libint2Local(:) + type(MolecularSystem), pointer :: molSys ! integer :: numberOfContractions ! integer(8) :: integralsByProcess ! integer(8) :: nprocess ! integer(8) :: process ! integer(8) :: starting ! integer(8) :: ending - real(8), allocatable, target :: density(:,:) integer(8) :: ssize + if( present(system) ) then + molSys=>system + else + molSys=>MolecularSystem_instance + end if + ssize = size(densityMatrix%values, DIM=1) allocate(density(ssize, ssize)) density = densityMatrix%values @@ -101,21 +109,23 @@ recursive subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix(species ! if( ending > ssize ) ending = ssize !! Calculate integrals - select case (trim(String_getUppercase(trim(scheme)))) - + if (trim(String_getUppercase(trim(scheme))) .ne. "LIBINT") STOP "The integral method selected has not been implemented" ! case("RYS") ! call RysQuadrature_directIntraSpecies( speciesID, "ERIS", starting, ending, int( process ) , & ! densityMatrix, & ! twoParticlesMatrix, factor) - case("LIBINT") - call Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoParticlesMatrix, factor ) - - ! ! case("CUDINT") - ! ! call CudintInterface_computeIntraSpecies(speciesID) - case default - call Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoParticlesMatrix, factor ) - end select + ! case("CUDINT") + ! call CudintInterface_computeIntraSpecies(speciesID) + if( present(Libint2Local) ) then + if (.not. Libint2Local(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Local(speciesID), molSys, speciesID) + call Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoParticlesMatrix, factor, molSys, Libint2Local(speciesID) ) + else + if (.not. allocated(Libint2Instance)) allocate(Libint2Instance(size(molSys%species))) + if (.not. Libint2Instance(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(speciesID), molSys, speciesID) + call Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoParticlesMatrix, factor, molSys, Libint2Instance(speciesID) ) + end if + deallocate(density) end subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix @@ -126,33 +136,43 @@ end subroutine DirectIntegralManager_getDirectIntraRepulsionMatrix !! @version 1.0 !! @par History !! - subroutine DirectIntegralManager_getDirectInterRepulsionMatrix(speciesID, OtherSpeciesID, scheme, & - densityMatrix, couplingMatrix ) + subroutine DirectIntegralManager_getDirectInterRepulsionMatrix(speciesID, OtherSpeciesID, scheme, densityMatrix, couplingMatrix, system, Libint2Local ) implicit none integer :: speciesID integer :: otherSpeciesID character(*) :: scheme type(matrix) :: densityMatrix real(8), allocatable, target :: couplingMatrix(:,:) + type(MolecularSystem), optional, target :: system + type(Libint2Interface), optional :: Libint2Local(:) + type(MolecularSystem), pointer :: molSys real(8), allocatable, target :: density(:,:) integer :: ssize + if( present(system) ) then + molSys=>system + else + molSys=>MolecularSystem_instance + end if + ssize = size(densityMatrix%values, DIM=1) ! print*, "DIRECT, SIZE DENS:", ssize allocate(density(ssize, ssize)) density = densityMatrix%values - select case (trim(String_getUppercase(trim(scheme)))) - - !case("RYS") - ! Not implemented + if (trim(String_getUppercase(trim(scheme))) .ne. "LIBINT") STOP "The integral method selected has not been implemented" - case("LIBINT") - call Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix) - case default - call Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix) - end select + if( present(Libint2Local) ) then + if (.not. Libint2Local(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Local(speciesID), molSys, speciesID) + if (.not. Libint2Local(otherSpeciesID)%isInstanced) call Libint2Interface_constructor(Libint2Local(otherSpeciesID), molSys, otherSpeciesID) + call Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix, molSys, Libint2Local(speciesID), Libint2Local(otherSpeciesID)) + else + if (.not. allocated(Libint2Instance)) allocate(Libint2Instance(size(molSys%species))) + if (.not. Libint2Instance(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(speciesID), molSys, speciesID) + if (.not. Libint2Instance(otherSpeciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(otherSpeciesID), molSys, otherSpeciesID) + call Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix, molSys, Libint2Instance(speciesID), Libint2Instance(otherSpeciesID)) + end if deallocate(density) @@ -164,24 +184,39 @@ end subroutine DirectIntegralManager_getDirectInterRepulsionMatrix !! @version 1.0 !! @par History !! - subroutine DirectIntegralManager_getDirectIntraRepulsionG12Matrix(speciesID, densityMatrix, twoParticlesMatrix, factor ) + subroutine DirectIntegralManager_getDirectIntraRepulsionG12Matrix(speciesID, densityMatrix, twoParticlesMatrix, factor, system, Libint2Local ) implicit none integer :: speciesID type(matrix) :: densityMatrix real(8), allocatable, target :: twoParticlesMatrix(:,:) real(8) :: factor + type(MolecularSystem), optional, target :: system + type(Libint2Interface), optional :: Libint2Local(:) + type(MolecularSystem), pointer :: molSys real(8), allocatable, target :: density(:,:) integer(8) :: ssize + if( present(system) ) then + molSys=>system + else + molSys=>MolecularSystem_instance + end if + ssize = size(densityMatrix%values, DIM=1) allocate(density(ssize, ssize)) density = densityMatrix%values - !! Calculate integrals - call Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoParticlesMatrix, factor ) - + if( present(Libint2Local) ) then + if (.not. Libint2Local(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Local(speciesID), molSys, speciesID) + call Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoParticlesMatrix, factor, molSys, Libint2Local(speciesID) ) + else + if (.not. allocated(Libint2Instance)) allocate(Libint2Instance(size(molSys%species))) + if (.not. Libint2Instance(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(speciesID), molSys, speciesID) + call Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoParticlesMatrix, factor, molSys, Libint2Instance(speciesID) ) + end if + deallocate(density) end subroutine DirectIntegralManager_getDirectIntraRepulsionG12Matrix @@ -192,23 +227,39 @@ end subroutine DirectIntegralManager_getDirectIntraRepulsionG12Matrix !! @version 1.0 !! @par History !! - subroutine DirectIntegralManager_getDirectInterRepulsionG12Matrix(speciesID, OtherSpeciesID, & - densityMatrix, couplingMatrix) + subroutine DirectIntegralManager_getDirectInterRepulsionG12Matrix(speciesID, OtherSpeciesID, densityMatrix, couplingMatrix, system, Libint2Local) implicit none integer :: speciesID integer :: otherSpeciesID type(matrix) :: densityMatrix real(8), allocatable, target :: couplingMatrix(:,:) + type(MolecularSystem), optional, target :: system + type(Libint2Interface), optional :: Libint2Local(:) + type(MolecularSystem), pointer :: molSys real(8), allocatable, target :: density(:,:) integer :: ssize + if( present(system) ) then + molSys=>system + else + molSys=>MolecularSystem_instance + end if + ssize = size(densityMatrix%values, DIM=1) ! print*, "DIRECT, SIZE DENS:", ssize allocate(density(ssize, ssize)) density = densityMatrix%values - call Libint2Interface_computeG12Interspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix) + ! Initialize libint objects + if( present(Libint2Local)) then + call Libint2Interface_computeG12Interspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix, molSys, Libint2Local(speciesID), Libint2Local(otherSpeciesID)) + else + if (.not. allocated(Libint2Instance)) allocate(Libint2Instance(size(molSys%species))) + if (.not. Libint2Instance(speciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(speciesID), molSys, speciesID) + if (.not. Libint2Instance(otherSpeciesID)%isInstanced) call Libint2Interface_constructor(Libint2Instance(otherSpeciesID), molSys, otherSpeciesID) + call Libint2Interface_computeG12Interspecies_direct(speciesID, otherSpeciesID, density, couplingMatrix, molSys, Libint2Instance(speciesID), Libint2Instance(otherSpeciesID)) + end if deallocate(density) @@ -702,8 +753,8 @@ subroutine DirectIntegralManager_getMomentIntegrals(molSystem,speciesID,componen !!Moment Integrals for one species, one component if(allocated(labels)) deallocate(labels) - allocate(labels(MolecularSystem_instance%species(speciesID)%basisSetSize)) - labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(speciesID)) + allocate(labels(molSystem%species(speciesID)%basisSetSize)) + labels = DirectIntegralManager_getLabels(molSystem%species(speciesID)) call Matrix_constructor(integralsMatrix, int(MolecularSystem_getTotalNumberOfContractions(speciesID,molSystem),8), & int(MolecularSystem_getTotalNumberOfContractions(speciesID,molSystem),8), 0.0_8) @@ -711,32 +762,32 @@ subroutine DirectIntegralManager_getMomentIntegrals(molSystem,speciesID,componen !if(component.gt.3) return !???? ii = 0 - do g = 1, size(MolecularSystem_instance%species(speciesID)%particles) - do h = 1, size(MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction) + do g = 1, size(molSystem%species(speciesID)%particles) + do h = 1, size(molSystem%species(speciesID)%particles(g)%basis%contraction) hh = h ii = ii + 1 jj = ii - 1 - do i = g, size(MolecularSystem_instance%species(speciesID)%particles) - do j = hh, size(MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction) + do i = g, size(molSystem%species(speciesID)%particles) + do j = hh, size(molSystem%species(speciesID)%particles(i)%basis%contraction) jj = jj + 1 !! allocating memory Integrals for shell if(allocated(integralValue)) deallocate(integralValue) - allocate(integralValue(MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital * & - MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital)) + allocate(integralValue(molSystem%species(speciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital * & + molSystem%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital)) !!Calculating integrals for shell - call MomentIntegrals_computeShell( MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(h), & - MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j), [0.0_8, 0.0_8, 0.0_8], component, integralValue) + call MomentIntegrals_computeShell( molSystem%species(speciesID)%particles(g)%basis%contraction(h), & + molSystem%species(speciesID)%particles(i)%basis%contraction(j), [0.0_8, 0.0_8, 0.0_8], component, integralValue) !!saving integrals on Matrix m = 0 - do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(speciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1) - do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1) + do k = labels(ii), labels(ii) + (molSystem%species(speciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1) + do l = labels(jj), labels(jj) + (molSystem%species(speciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1) m = m + 1 integralsMatrix%values(k, l) = integralValue(m) @@ -811,12 +862,11 @@ subroutine DirectIntegralManager_getExternalPotentialIntegrals(molSystem,species !!Overlap Integrals for one species potID = 0 - + do i= 1, ExternalPotential_instance%ssize !if( trim(potential(i)%specie)==trim(interactNameSelected) ) then ! This does not work for UHF ! if ( String_findSubstring(trim( molSystem%species(speciesID)%name ), & ! trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%specie)))) == 1 ) then - if ( trim( molSystem%species(speciesID)%symbol) == trim(String_getUpperCase(trim(ExternalPotential_instance%potentials(i)%specie))) ) then potID=i exit @@ -915,7 +965,6 @@ subroutine DirectIntegralManager_getDirectIntraRepulsionIntegralsAll(speciesID, type(Libint2Interface), optional :: Libint2LocalForSpecies type(MolecularSystem), pointer :: molSys - real(8), allocatable, target :: density(:,:) integer :: ssize diff --git a/src/ints/G12Integrals.f90 b/src/ints/G12Integrals.f90 index 3bfa4ad2..19446252 100644 --- a/src/ints/G12Integrals.f90 +++ b/src/ints/G12Integrals.f90 @@ -217,7 +217,7 @@ subroutine G12Integrals_diskIntraSpecie(specieID) G12_ptr => G12Integrals_instance%libintG12 - nameOfSpecie = trim(MolecularSystem_getNameOfSpecie(specieID)) + nameOfSpecie = trim(MolecularSystem_getNameOfSpecies(specieID)) call cpu_time(startTime) diff --git a/src/ints/IntegralManager.f90 b/src/ints/IntegralManager.f90 index 30a99d41..4c669083 100644 --- a/src/ints/IntegralManager.f90 +++ b/src/ints/IntegralManager.f90 @@ -152,7 +152,7 @@ subroutine IntegralManager_getFirstDerivativeIntegrals() labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f)) if(allocated(integralsMatrix)) deallocate(integralsMatrix) - allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f))) + allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f))) integralsMatrix = 0.0_8 ii = 0 @@ -223,7 +223,7 @@ subroutine IntegralManager_getFirstDerivativeIntegrals() labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f)) if(allocated(integralsMatrix)) deallocate(integralsMatrix) - allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f))) + allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f))) integralsMatrix = 0.0_8 ii = 0 @@ -294,7 +294,7 @@ subroutine IntegralManager_getFirstDerivativeIntegrals() labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f)) if(allocated(integralsMatrix)) deallocate(integralsMatrix) - allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f))) + allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f))) integralsMatrix = 0.0_8 ii = 0 @@ -383,7 +383,7 @@ subroutine IntegralManager_writeHarmonicIntegrals() labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f)) if(allocated(integralsMatrix)) deallocate(integralsMatrix) - allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f))) + allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f))) integralsMatrix = 0.0_8 ii = 0 @@ -529,8 +529,8 @@ subroutine IntegralManager_writeAttractionIntegrals(surface) write(40) MolecularSystem_instance%species(f)%name total_aux=0 - cosmoIntegralFile="cosmo"//trim( MolecularSystem_getNameOfSpecie( f ) )//".opints" - cosmoQuantumChargeFile="cosmo"//trim( MolecularSystem_getNameOfSpecie( f ) )//".charges" + cosmoIntegralFile="cosmo"//trim( MolecularSystem_getNameOfSpecies( f ) )//".opints" + cosmoQuantumChargeFile="cosmo"//trim( MolecularSystem_getNameOfSpecies( f ) )//".charges" open(unit=70, file=trim(cosmoIntegralFile), status="unknown",form="unformatted") open(unit=80, file=trim(cosmoQuantumChargeFile), status="unknown",form="unformatted") @@ -680,8 +680,8 @@ subroutine IntegralManager_writeAttractionIntegrals(surface) if ( f /= g ) then - cosmoQuantumChargeFile="cosmo"//trim( MolecularSystem_getNameOfSpecie( f ) )//".charges" - cosmoIntegralFile="cosmo"//trim( MolecularSystem_getNameOfSpecie( g ) )//".opints" + cosmoQuantumChargeFile="cosmo"//trim( MolecularSystem_getNameOfSpecies( f ) )//".charges" + cosmoIntegralFile="cosmo"//trim( MolecularSystem_getNameOfSpecies( g ) )//".opints" call CosmoCore_q_int_builder(cosmoIntegralFile,cosmoQuantumChargeFile,numberOfPointCharges,totals(f),totals(g),f,g) @@ -779,13 +779,11 @@ subroutine IntegralManager_writeIntraRepulsionIntegrals(nameOfSpecies, scheme) character(*) :: scheme integer :: speciesID - integer :: numberOfContractions !! Skip integrals calculation two times for electrons alpha and beta if(CONTROL_instance%IS_OPEN_SHELL .and. ( trim(nameOfSpecies) == "E-BETA" )) return speciesID = MolecularSystem_getSpecieID(trim(nameOfSpecies)) - numberOfContractions = MolecularSystem_getNumberOfContractions(speciesID) if ( trim(String_getUppercase( CONTROL_instance%INTEGRAL_STORAGE )) == "DIRECT") return @@ -832,11 +830,11 @@ subroutine IntegralManager_writeInterRepulsionIntegrals(scheme) do i = 1, MolecularSystem_instance%numberOfQuantumSpecies - if(CONTROL_instance%IS_OPEN_SHELL .and. trim(MolecularSystem_getNameOfSpecie(i)) == "E-BETA" ) cycle + if(CONTROL_instance%IS_OPEN_SHELL .and. trim(MolecularSystem_getNameOfSpecies(i)) == "E-BETA" ) cycle do j = i+1, MolecularSystem_instance%numberOfQuantumSpecies - if(trim(MolecularSystem_getNameOfSpecie(j)) == "E-BETA" .and. .not. trim(MolecularSystem_getNameOfSpecie(i)) == "E-ALPHA" ) cycle + if(trim(MolecularSystem_getNameOfSpecies(j)) == "E-BETA" .and. .not. trim(MolecularSystem_getNameOfSpecies(i)) == "E-ALPHA" ) cycle !! Calculate integrals (stored on disk) select case (trim(String_getUppercase(trim(scheme)))) @@ -924,7 +922,7 @@ subroutine IntegralManager_writeThreeCenterIntegralsByProduct() labels = DirectIntegralManager_getLabels(MolecularSystem_instance%species(f)) if(allocated(integralsMatrix)) deallocate(integralsMatrix) - allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = f), MolecularSystem_getTotalNumberOfContractions(specieID = f))) + allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(f), MolecularSystem_getTotalNumberOfContractions(f))) integralsMatrix = 0.0_8 diff --git a/src/ints/Ints.f90 b/src/ints/Ints.f90 index b4cafe05..74a90fce 100644 --- a/src/ints/Ints.f90 +++ b/src/ints/Ints.f90 @@ -185,7 +185,7 @@ Program Ints !! intra-species two-boy integration do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies !!Calculate attraction integrals (intra-species) - call IntegralManager_writeIntraRepulsionIntegrals(trim(MolecularSystem_getNameOfSpecie(speciesID)), & + call IntegralManager_writeIntraRepulsionIntegrals(trim(MolecularSystem_getNameOfSpecies(speciesID)), & trim(CONTROL_instance%INTEGRAL_SCHEME)) end do @@ -254,8 +254,8 @@ Program Ints call Libint2Interface_computeG12Interspecies_disk(i, j) - ! call G12Integrals_G12diskInterSpecie(trim(MolecularSystem_getNameOfSpecie(i)), & - ! trim(MolecularSystem_getNameOfSpecie(j)), i, j) + ! call G12Integrals_G12diskInterSpecie(trim(MolecularSystem_getNameOfSpecies(i)), & + ! trim(MolecularSystem_getNameOfSpecies(j)), i, j) end do end do diff --git a/src/ints/Libint2Interface.f90 b/src/ints/Libint2Interface.f90 index 4d9cbd2e..23f5ffa1 100644 --- a/src/ints/Libint2Interface.f90 +++ b/src/ints/Libint2Interface.f90 @@ -483,8 +483,8 @@ subroutine Libint2Interface_compute1BodyInts(integral_kind) do s = 1, nspecies ! Prepare matrix if(allocated(integralsMatrix)) deallocate(integralsMatrix) - allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(specieID = s), & - MolecularSystem_getTotalNumberOfContractions(specieID = s))) + allocate(integralsMatrix(MolecularSystem_getTotalNumberOfContractions(s), & + MolecularSystem_getTotalNumberOfContractions(s))) matrix_ptr = c_loc(integralsMatrix(1,1)) ! Initialize libint objects @@ -511,39 +511,38 @@ end subroutine Libint2Interface_compute1BodyInts !> !! Compute 2-body integrals and computes the G matrix - subroutine Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoBody, factor) + subroutine Libint2Interface_compute2BodyIntraspecies_direct(speciesID, density, twoBody, factor, molSys, Libint2LocalForSpecies) implicit none integer :: speciesID real(8), allocatable, target :: density(:,:) real(8), allocatable, target :: twoBody(:,:) real(8) :: factor + type(MolecularSystem) :: molSys + type(Libint2Interface) :: Libint2LocalForSpecies type(c_ptr) :: density_ptr type(c_ptr) :: twoBody_ptr integer :: nspecies - nspecies = size(MolecularSystem_instance%species) - if (.not. allocated(Libint2Instance)) then - allocate(Libint2Instance(nspecies)) - endif + nspecies = size(molSys%species) ! Prepare matrix if(allocated(twoBody)) deallocate(twoBody) - allocate(twoBody(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), & - MolecularSystem_getTotalNumberOfContractions(specieID = speciesID))) + allocate(twoBody(MolecularSystem_getTotalNumberOfContractions(speciesID,molSys), & + MolecularSystem_getTotalNumberOfContractions(speciesID,molSys))) twoBody_ptr = c_loc(twoBody(1,1)) density_ptr = c_loc(density(1,1)) ! Initialize libint objects - if (.not. Libint2Instance(speciesID)%isInstanced) then - call Libint2Interface_constructor(Libint2Instance(speciesID), MolecularSystem_instance, speciesID) + if (.not. Libint2LocalForSpecies%isInstanced) then + call Libint2Interface_constructor(Libint2LocalForSpecies, molSys, speciesID) endif - call c_LibintInterface_init2BodyInts(Libint2Instance(speciesID)%this) - call c_LibintInterface_compute2BodyDirect(Libint2Instance(speciesID)%this, density_ptr, twoBody_ptr, factor) + call c_LibintInterface_init2BodyInts(Libint2LocalForSpecies%this) + call c_LibintInterface_compute2BodyDirect(Libint2LocalForSpecies%this, density_ptr, twoBody_ptr, factor) end subroutine Libint2Interface_compute2BodyIntraspecies_direct @@ -611,7 +610,7 @@ subroutine Libint2Interface_compute2BodyIntraspecies_disk(speciesID) open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted") labels(1) = "DENSITY" - labels(2) = trim(MolecularSystem_getNameOfSpecie(speciesID)) + labels(2) = trim(MolecularSystem_getNameOfSpecies(speciesID)) aux_dens = Matrix_getFromFile(unit=wfnUnit, rows= int(numberOfContractions,4), & columns= int(numberOfContractions,4), binary=.true., arguments=labels) @@ -635,45 +634,43 @@ end subroutine Libint2Interface_compute2BodyIntraspecies_disk !> !! Compute 2-body integrals and computes the G matrix - subroutine Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, coupling) + subroutine Libint2Interface_compute2BodyInterspecies_direct(speciesID, otherSpeciesID, density, coupling, molSys, Libint2LocalForSpecies, Libint2LocalForOtherSpecies) implicit none integer :: speciesID integer :: otherSpeciesID real(8), allocatable, target :: density(:,:) real(8), allocatable, target :: coupling(:,:) + type(MolecularSystem) :: molSys + type(Libint2Interface) :: Libint2LocalForSpecies + type(Libint2Interface) :: Libint2LocalForOtherSpecies type(c_ptr) :: density_ptr type(c_ptr) :: coupling_ptr integer :: nspecies - nspecies = size(MolecularSystem_instance%species) - - if (.not. allocated(Libint2Instance)) then - allocate(Libint2Instance(nspecies)) - endif + nspecies = size(molSys%species) ! Prepare matrix if(allocated(coupling)) deallocate(coupling) - allocate(coupling(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), & - MolecularSystem_getTotalNumberOfContractions(specieID = speciesID))) + allocate(coupling(MolecularSystem_getTotalNumberOfContractions(speciesID,molSys), & + MolecularSystem_getTotalNumberOfContractions(speciesID,molSys))) coupling_ptr = c_loc(coupling(1,1)) density_ptr = c_loc(density(1,1)) ! Initialize libint objects - if (.not. Libint2Instance(speciesID)%isInstanced) then - call Libint2Interface_constructor(Libint2Instance(speciesID), MolecularSystem_instance, speciesID) - end if - - if (.not. Libint2Instance(otherSpeciesID)%isInstanced) then - call Libint2Interface_constructor(Libint2Instance(otherSpeciesID), MolecularSystem_instance, otherSpeciesID) - end if - + if (.not. Libint2LocalForSpecies%isInstanced) then + call Libint2Interface_constructor(Libint2LocalForSpecies, molSys, speciesID) + endif + if (.not. Libint2LocalForOtherSpecies%isInstanced) then + call Libint2Interface_constructor(Libint2LocalForOtherSpecies, molSys, otherSpeciesID) + endif + call c_LibintInterface_computeCouplingDirect(& - Libint2Instance(speciesID)%this, Libint2Instance(otherSpeciesID)%this, density_ptr, coupling_ptr) + Libint2LocalForSpecies%this, Libint2LocalForOtherSpecies%this, density_ptr, coupling_ptr) end subroutine Libint2Interface_compute2BodyInterSpecies_direct @@ -685,7 +682,7 @@ subroutine Libint2Interface_compute2BodyInterspecies_direct_IT(speciesID, otherS real(8), target :: density(:,:) real(8), target :: coefficients(:,:) real(8), allocatable, target :: coupling(:,:,:) - integer :: p, n + integer :: p type(MolecularSystem) :: molSys type(Libint2Interface) :: Libint2LocalForSpecies type(Libint2Interface) :: Libint2LocalForOtherSpecies @@ -736,8 +733,8 @@ subroutine Libint2Interface_compute2BodyAlphaBeta_direct(speciesID, otherSpecies !! Prepare matrix if(allocated(coupling)) deallocate(coupling) -! allocate(coupling(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), & -! MolecularSystem_getTotalNumberOfContractions(specieID = speciesID))) +! allocate(coupling(MolecularSystem_getTotalNumberOfContractions(speciesID), & +! MolecularSystem_getTotalNumberOfContractions(speciesID))) allocate(coupling(1,1)) @@ -935,13 +932,15 @@ end subroutine Libint2Interface_computeG12Interspecies_disk !> !! Compute 2-body integrals and store them on disk - subroutine Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoBody, factor) + subroutine Libint2Interface_computeG12Intraspecies_direct(speciesID, density, twoBody, factor, molSys, Libint2LocalForSpecies) implicit none integer :: speciesID real(8), allocatable, target :: density(:,:) real(8), allocatable, target :: twoBody(:,:) real(8) :: factor + type(MolecularSystem) :: molSys + type(Libint2Interface) :: Libint2LocalForSpecies integer :: nspecies integer :: i, potID, pot_size @@ -955,22 +954,19 @@ subroutine Libint2Interface_computeG12Intraspecies_direct(speciesID, density, tw type(c_ptr) :: density_ptr type(c_ptr) :: twoBody_ptr - nspecies = size(MolecularSystem_instance%species) - if (.not. allocated(Libint2Instance)) then - allocate(Libint2Instance(nspecies)) - endif + nspecies = size(molSys%species) if(allocated(twoBody)) deallocate(twoBody) - allocate(twoBody(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), & - MolecularSystem_getTotalNumberOfContractions(specieID = speciesID))) + allocate(twoBody(MolecularSystem_getTotalNumberOfContractions(speciesID,molSys), & + MolecularSystem_getTotalNumberOfContractions(speciesID,molSys))) twoBody_ptr = c_loc(twoBody(1,1)) density_ptr = c_loc(density(1,1)) !Get potential ID do i=1, InterPotential_instance%ssize - if ( trim( MolecularSystem_instance%species(speciesID)%symbol) == & + if ( trim( molSys%species(speciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. & - trim( MolecularSystem_instance%species(speciesID)%symbol) == & + trim( molSys%species(speciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie))) ) then potID=i exit @@ -989,24 +985,22 @@ subroutine Libint2Interface_computeG12Intraspecies_direct(speciesID, density, tw coefficients_ptr = c_loc(coefficients(1)) exponents_ptr = c_loc(exponents(1)) - ! Initialize libint objects - if (.not. Libint2Instance(speciesID)%isInstanced) then - call Libint2Interface_constructor(Libint2Instance(speciesID), MolecularSystem_instance, speciesID) - end if - - call c_LibintInterface_init2BodyInts(Libint2Instance(speciesID)%this) + call c_LibintInterface_init2BodyInts(Libint2LocalForSpecies%this) - call c_LibintInterface_computeG12Direct(Libint2Instance(speciesID)%this, density_ptr, twoBody_ptr, factor, coefficients_ptr, exponents_ptr, pot_size) + call c_LibintInterface_computeG12Direct(Libint2LocalForSpecies%this, density_ptr, twoBody_ptr, factor, coefficients_ptr, exponents_ptr, pot_size) end subroutine Libint2Interface_computeG12Intraspecies_direct !! Compute 2-body integrals and store them on disk - subroutine Libint2Interface_computeG12Interspecies_direct(speciesID,otherSpeciesID,density, coupling) + subroutine Libint2Interface_computeG12Interspecies_direct(speciesID,otherSpeciesID,density, coupling, molSys, Libint2LocalForSpecies, Libint2LocalForOtherSpecies) implicit none integer :: speciesID, otherSpeciesID real(8), allocatable, target :: density(:,:) real(8), allocatable, target :: coupling(:,:) + type(MolecularSystem) :: molSys + type(Libint2Interface) :: Libint2LocalForSpecies + type(Libint2Interface) :: Libint2LocalForOtherSpecies integer :: nspecies integer :: i, potID, pot_size @@ -1020,29 +1014,26 @@ subroutine Libint2Interface_computeG12Interspecies_direct(speciesID,otherSpecies type(c_ptr) :: density_ptr type(c_ptr) :: coupling_ptr - nspecies = size(MolecularSystem_instance%species) - if (.not. allocated(Libint2Instance)) then - allocate(Libint2Instance(nspecies)) - endif + nspecies = size(molSys%species) ! Prepare matrix if(allocated(coupling)) deallocate(coupling) - allocate(coupling(MolecularSystem_getTotalNumberOfContractions(specieID = speciesID), & - MolecularSystem_getTotalNumberOfContractions(specieID = speciesID))) + allocate(coupling(MolecularSystem_getTotalNumberOfContractions(speciesID,molSys), & + MolecularSystem_getTotalNumberOfContractions(speciesID,molSys))) coupling_ptr = c_loc(coupling(1,1)) density_ptr = c_loc(density(1,1)) !Get potential ID do i=1, InterPotential_instance%ssize - if ( (trim(MolecularSystem_instance%species(speciesID)%symbol) == & + if ( (trim(molSys%species(speciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. & - trim(MolecularSystem_instance%species(otherSpeciesID)%symbol) == & + trim(molSys%species(otherSpeciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) & ) .or. & - (trim( MolecularSystem_instance%species(otherSpeciesID)%symbol) == & + (trim(molSys%species(otherSpeciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. & - trim( MolecularSystem_instance%species(speciesID)%symbol) == & + trim(molSys%species(speciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) & ) & ) then @@ -1062,19 +1053,9 @@ subroutine Libint2Interface_computeG12Interspecies_direct(speciesID,otherSpecies coefficients_ptr = c_loc(coefficients(1)) exponents_ptr = c_loc(exponents(1)) - - ! Initialize libint objects - if (.not. Libint2Instance(speciesID)%isInstanced) then - call Libint2Interface_constructor(Libint2Instance(speciesID), MolecularSystem_instance, speciesID) - endif - - if (.not. Libint2Instance(otherSpeciesID)%isInstanced) then - call Libint2Interface_constructor(Libint2Instance(otherSpeciesID),MolecularSystem_instance, otherSpeciesID) - endif - call c_LibintInterface_computeG12InterDirect(& - Libint2Instance(speciesID)%this, Libint2Instance(otherSpeciesID)%this, density_ptr, coupling_ptr, coefficients_ptr, exponents_ptr, pot_size) + Libint2LocalForSpecies%this, Libint2LocalForOtherSpecies%this, density_ptr, coupling_ptr, coefficients_ptr, exponents_ptr, pot_size) end subroutine Libint2Interface_computeG12Interspecies_direct @@ -1090,7 +1071,6 @@ subroutine Libint2Interface_compute2BodyIntraspecies_direct_all(speciesID, densi type(MolecularSystem) :: molSys type(Libint2Interface) :: Libint2LocalForSpecies - integer :: nspecies integer :: i, potID, pot_size real(8), allocatable, target :: coefficients(:) @@ -1107,9 +1087,9 @@ subroutine Libint2Interface_compute2BodyIntraspecies_direct_all(speciesID, densi if(InterPotential_instance%isInstanced) then !G12 integrals !Get potential ID do i=1, InterPotential_instance%ssize - if ( trim( MolecularSystem_instance%species(speciesID)%symbol) == & + if ( trim( molSys%species(speciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. & - trim( MolecularSystem_instance%species(speciesID)%symbol) == & + trim( molSys%species(speciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie))) ) then potID=i exit @@ -1145,7 +1125,6 @@ subroutine Libint2Interface_compute2BodyInterspecies_direct_all(speciesID, other type(Libint2Interface) :: Libint2LocalForSpecies type(Libint2Interface) :: Libint2LocalForOtherSpecies - integer :: nspecies integer :: i, potID, pot_size real(8), allocatable, target :: coefficients(:) @@ -1162,14 +1141,14 @@ subroutine Libint2Interface_compute2BodyInterspecies_direct_all(speciesID, other if(InterPotential_instance%isInstanced) then !G12 integrals !Get potential ID do i=1, InterPotential_instance%ssize - if ( (trim(MolecularSystem_instance%species(speciesID)%symbol) == & + if ( (trim(molSys%species(speciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. & - trim(MolecularSystem_instance%species(otherSpeciesID)%symbol) == & + trim(molSys%species(otherSpeciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) & ) .or. & - (trim( MolecularSystem_instance%species(otherSpeciesID)%symbol) == & + (trim( molSys%species(otherSpeciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%specie))) .and. & - trim( MolecularSystem_instance%species(speciesID)%symbol) == & + trim( molSys%species(speciesID)%symbol) == & trim(String_getUpperCase(trim(InterPotential_instance%potentials(i)%otherSpecie)) ) & ) & ) then diff --git a/src/output/CalculateWaveFunction.f90 b/src/output/CalculateWaveFunction.f90 index b95fc4d1..bdde6af6 100644 --- a/src/output/CalculateWaveFunction.f90 +++ b/src/output/CalculateWaveFunction.f90 @@ -114,7 +114,7 @@ subroutine CalculateWaveFunction_getOrbitalValueAt ( speciesID, orbitalNum, coor !! Open file for wavefunction open(unit=wfnUnit, file=trim(wfnFile), status="old", form="unformatted") - arguments(2) = MolecularSystem_getNameOfSpecie(speciesID) + arguments(2) = MolecularSystem_getNameOfSpecies(speciesID) arguments(1) = "COEFFICIENTS" coefficientsofcombination = & diff --git a/src/scf/Convergence.f90 b/src/scf/Convergence.f90 index c8a27efc..ce06ef90 100644 --- a/src/scf/Convergence.f90 +++ b/src/scf/Convergence.f90 @@ -40,6 +40,7 @@ module Convergence_ type, public :: Convergence character(30) :: name + type(MolecularSystem), pointer :: molSys type(Matrix) :: initialDensityMatrix type(Matrix) :: initialFockMatrix @@ -97,12 +98,19 @@ module Convergence_ !> !! @brief Define el constructor para la clase - subroutine Convergence_constructor( this, name ,methodType ) + subroutine Convergence_constructor( this, name ,methodType, system ) implicit none type(Convergence), intent(inout) :: this character(*),optional :: name integer, optional :: methodType + type(MolecularSystem), optional, target :: system + if( present(system) ) then + this%molSys=>system + else + this%molSys=>MolecularSystem_instance + end if + this%name = "undefined" if ( present(name) ) this%name = trim(name) this%methodType = SCF_CONVERGENCE_DEFAULT @@ -473,7 +481,7 @@ subroutine Convergence_dampingMethod( this ) !!******************************************************************************************** if ( fockAndDensityEffect <= densityEffect & - .or. abs(fockAndDensityEffect+densityEffect) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD ) then + .or. abs(fockAndDensityEffect) .lt. CONTROL_instance%DOUBLE_ZERO_THRESHOLD ) then this%initialFockMatrix%values = this%newFockMatrixPtr%values this%initialDensityMatrix%values = this%newDensityMatrixPtr%values @@ -682,7 +690,7 @@ subroutine Convergence_levelShifting(this) if ( .not. CONTROL_instance%ACTIVATE_LEVEL_SHIFTING) return - if ( MolecularSystem_instance%species(this%speciesID)%isElectron ) then + if ( this%molSys%species(this%speciesID)%isElectron ) then levelShiftingFactor=CONTROL_instance%ELECTRONIC_LEVEL_SHIFTING else levelShiftingFactor=CONTROL_instance%NONELECTRONIC_LEVEL_SHIFTING @@ -692,8 +700,8 @@ subroutine Convergence_levelShifting(this) matmul( matmul( transpose(this%coefficientMatrix%values ) , & this%newFockMatrixPtr%values), this%coefficientMatrix%values ) - do i=MolecularSystem_getOcupationNumber(this%speciesID)+1, & - MolecularSystem_getTotalnumberOfContractions(this%speciesID) + do i=MolecularSystem_getOcupationNumber(this%speciesID,this%molSys)+1, & + MolecularSystem_getTotalnumberOfContractions(this%speciesID,this%molSys) fockMatrixTransformed%values(i,i) = levelShiftingFactor + fockMatrixTransformed%values(i,i) end do @@ -722,14 +730,14 @@ subroutine Convergence_removeLevelShifting(this, eigenvalues) if ( .not. CONTROL_instance%ACTIVATE_LEVEL_SHIFTING) return - if ( MolecularSystem_instance%species(this%speciesID)%isElectron ) then + if ( this%molSys%species(this%speciesID)%isElectron ) then levelShiftingFactor=CONTROL_instance%ELECTRONIC_LEVEL_SHIFTING else levelShiftingFactor=CONTROL_instance%NONELECTRONIC_LEVEL_SHIFTING end if - do i=MolecularSystem_getOcupationNumber(this%speciesID)+1, & - MolecularSystem_getTotalnumberOfContractions(this%speciesID) + do i=MolecularSystem_getOcupationNumber(this%speciesID,this%molSys)+1, & + MolecularSystem_getTotalnumberOfContractions(this%speciesID,this%molSys) eigenvalues%values(i) = eigenvalues%values(i) -levelShiftingFactor end do diff --git a/src/scf/DensityMatrixSCFGuess.f90 b/src/scf/DensityMatrixSCFGuess.f90 index 67733f20..a64a9a3a 100644 --- a/src/scf/DensityMatrixSCFGuess.f90 +++ b/src/scf/DensityMatrixSCFGuess.f90 @@ -41,7 +41,7 @@ module DensityMatrixSCFGuess_ !> !! @brief Obtiene la matriz de densidad inicial - subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformationMatrix, densityMatrix, orbitals, printInfo ) + subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformationMatrix, densityMatrix, orbitals, printInfo, system) implicit none integer, intent(in) :: speciesID type(Matrix), intent(in) :: hcoreMatrix @@ -49,7 +49,10 @@ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformatio type(Matrix), intent(inout) :: densityMatrix type(Matrix), intent(inout) :: orbitals logical, intent(in) :: printInfo - + type(MolecularSystem), optional, target :: system + + type(MolecularSystem), pointer :: molSys + type(Matrix) :: auxMatrix character(30) :: nameOfSpecies integer(8) :: orderOfMatrix, occupationNumber @@ -60,9 +63,15 @@ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformatio integer :: wfnUnit integer :: i,j,k - orderOfMatrix = MolecularSystem_getTotalnumberOfContractions( speciesID ) - nameOfSpecies = MolecularSystem_instance%species(speciesID)%name - occupationNumber = MolecularSystem_getOcupationNumber( speciesID ) + if( present(system) ) then + molSys=>system + else + molSys=>MolecularSystem_instance + end if + + orderOfMatrix = MolecularSystem_getTotalnumberOfContractions(speciesID,molSys) + nameOfSpecies = molSys%species(speciesID)%name + occupationNumber = MolecularSystem_getOcupationNumber(speciesID,molSys) readSuccess=.false. arguments(2) = nameOfSpecies @@ -106,7 +115,7 @@ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformatio if(.not. readSuccess) then call Matrix_constructor(orbitals, orderOfMatrix, orderOfMatrix, 0.0_8 ) - if ( MolecularSystem_instance%species(speciesID)%isElectron ) then + if ( molSys%species(speciesID)%isElectron ) then guessType=CONTROL_instance%SCF_ELECTRONIC_TYPE_GUESS else guessType=CONTROL_instance%SCF_NONELECTRONIC_TYPE_GUESS @@ -159,7 +168,7 @@ subroutine DensityMatrixSCFGuess_getGuess( speciesID, hcoreMatrix, transformatio end do end do end do - densityMatrix%values=densityMatrix%values*MolecularSystem_getEta( speciesID ) + densityMatrix%values=densityMatrix%values*MolecularSystem_getEta(speciesID,molSys) if ( CONTROL_instance%BUILD_MIXED_DENSITY_MATRIX .and. ( trim(nameOfSpecies)=="E-ALPHA" .or. trim(nameOfSpecies)=="E+A") ) then @@ -184,7 +193,7 @@ subroutine DensityMatrixSCFGuess_hcore(speciesID, hcore, transformation, eigenVe integer(8) :: orderOfMatrix - orderOfMatrix = MolecularSystem_getTotalnumberOfContractions( speciesID ) + orderOfMatrix = size(hcore%values,DIM=1) if ( .not.allocated(eigenVectors%values) ) then call Matrix_constructor(eigenVectors, orderOfMatrix, orderOfMatrix ) @@ -315,7 +324,7 @@ end module DensityMatrixSCFGuess_ ! numberOfMatrixElements = int(orderOfMatrix, 8) ** 2_8 - ! ocupationNumber = MolecularSystem_instance%species(speciesID)%ocupationNumber + ! ocupationNumber = molSys%species(speciesID)%ocupationNumber ! ! vectors = Matrix_getFromFile(orderOfMatrix, orderOfMatrix, & ! ! file=trim(CONTROL_instance%INPUT_FILE)//trim(nameOfSpecie)//".vec", binary = .false.) diff --git a/src/scf/MultiSCF.f90 b/src/scf/MultiSCF.f90 index 5616bd16..a5588ea4 100644 --- a/src/scf/MultiSCF.f90 +++ b/src/scf/MultiSCF.f90 @@ -38,11 +38,13 @@ module MultiSCF_ use List_ use MolecularSystem_ use WaveFunction_ + use DensityFunctionalTheory_ use SingleSCF_ use omp_lib use DensityMatrixSCFGuess_ use OrbitalLocalizer_ use Convergence_ + use Libint2Interface_ implicit none @@ -52,6 +54,7 @@ module MultiSCF_ type, public :: MultiSCF + type(MolecularSystem), pointer :: molSys type(List) :: energyOMNE character(100) :: name integer :: numberOfIterations @@ -75,6 +78,9 @@ module MultiSCF_ !! logical :: printSCFiterations + !! + type(Grid), allocatable :: DFTGrids(:), DFTGridsCommonPoints(:,:) + end type MultiSCF type(MultiSCF), public, target :: MultiSCF_instance @@ -95,13 +101,22 @@ module MultiSCF_ !> !! @brief Define el constructor para la clase - subroutine MultiSCF_constructor(this,wfObjects,iterationScheme) + subroutine MultiSCF_constructor(this,wfObjects,iterationScheme,molsystem) implicit none type(MultiSCF) :: this type(WaveFunction) :: wfObjects(*) integer :: iterationScheme - integer :: i + type(MolecularSystem), target :: molsystem + + integer :: i, nspecies, speciesID + integer :: dftUnit + character(50) :: labels(2) + character(50) :: dftFile + + this%molSys=>molsystem + nspecies=MolecularSystem_getNumberOfQuantumSpecies(this%molSys) + ! isROHF = .false. select case(iterationScheme) case(0) @@ -120,12 +135,12 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme) this%numberOfIterations = 0 this%status = 0 - allocate(this%singleEnergyTolerance(MolecularSystem_getNumberOfQuantumSpecies()),& - this%singleDensityTolerance(MolecularSystem_getNumberOfQuantumSpecies()),& - this%singleMaxIterations(MolecularSystem_getNumberOfQuantumSpecies())) + allocate(this%singleEnergyTolerance(nspecies),& + this%singleDensityTolerance(nspecies),& + this%singleMaxIterations(nspecies)) - do i = 1, MolecularSystem_getNumberOfQuantumSpecies() - if(MolecularSystem_instance%species(i)%isElectron ) then + do i = 1, nspecies + if(this%molSys%species(i)%isElectron ) then this%singleEnergyTolerance(i)=CONTROL_instance%ELECTRONIC_ENERGY_TOLERANCE this%singleDensityTolerance(i)=CONTROL_instance%ELECTRONIC_DENSITY_MATRIX_TOLERANCE else @@ -138,7 +153,7 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme) case( 0 ) ! we perform single species iterations for nonelectrons - if(MolecularSystem_instance%species(i)%isElectron ) then + if(this%molSys%species(i)%isElectron ) then this%singleMaxIterations(i)=1 else this%singleMaxIterations(i)=CONTROL_instance%SCF_NONELECTRONIC_MAX_ITERATIONS @@ -146,7 +161,7 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme) case( 1 ) ! we perform single species iterations for nelectrons - if(MolecularSystem_instance%species(i)%isElectron ) then + if(this%molSys%species(i)%isElectron ) then this%singleMaxIterations(i)=CONTROL_instance%SCF_ELECTRONIC_MAX_ITERATIONS else this%singleMaxIterations(i)=1 @@ -155,7 +170,7 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme) case( 2 ) ! we perform single species for all species - if(MolecularSystem_instance%species(i)%isElectron ) then + if(this%molSys%species(i)%isElectron ) then this%singleMaxIterations(i)=CONTROL_instance%SCF_ELECTRONIC_MAX_ITERATIONS else this%singleMaxIterations(i)=CONTROL_instance%SCF_NONELECTRONIC_MAX_ITERATIONS @@ -163,7 +178,7 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme) case ( 3 ) ! we do not perform single species SCF - if(MolecularSystem_instance%species(i)%isElectron ) then + if(this%molSys%species(i)%isElectron ) then this%singleMaxIterations(i)=1 else this%singleMaxIterations(i)=1 @@ -183,8 +198,36 @@ subroutine MultiSCF_constructor(this,wfObjects,iterationScheme) if(CONTROL_instance%DEBUG_SCFS) this%printSCFiterations=.true. !! Start the wavefunction object - call WaveFunction_constructor(wfObjects) + call WaveFunction_constructor(wfObjects,nspecies,this%molSys) + !!Initialize DFT: Calculate Grids and build functionals + if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then + if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then + call system("lowdin-DFT.x BUILD_SCF_GRID") + do speciesID = 1, nspecies + dftUnit = 77 + dftFile = "lowdin."//trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys))//".grid" + open(unit = dftUnit, file=trim(dftFile), status="old", form="unformatted") + + labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys) + labels(1) = "EXACT-EXCHANGE-FRACTION" + + call Vector_getFromFile(unit=dftUnit, binary=.true., value=wfObjects(speciesID)%exactExchangeFraction, arguments=labels) + close(unit=dftUnit) + ! print *, "el tormento tuyo", speciesID, these(speciesID)%exactExchangeFraction + end do + else !! Allocate DFT grids memory. + if(allocated(this%DFTGrids)) deallocate(this%DFTGrids) + allocate(this%DFTGrids(nspecies)) + + if (allocated(this%DFTGridsCommonPoints)) deallocate(this%DFTGridsCommonPoints) + allocate(this%DFTGridsCommonPoints(nspecies,nspecies)) + + call DensityFunctionalTheory_buildSCFGrid(this%DFTGrids,this%DFTGridsCommonPoints,wfObjects(1:nspecies)%exactExchangeFraction,this%molSys) + end if + end if + + !! Start the orbital localizer object if (CONTROL_instance%LOCALIZE_ORBITALS) call OrbitalLocalizer_constructor( ) @@ -230,10 +273,11 @@ end function MultiSCF_getLastEnergy !! @brief Realiza esquema de iteracion SCF para todas las especies cuanticas presentes !! @param !! - subroutine MultiSCF_iterate(this, wfObjects, iterationScheme) + subroutine MultiSCF_iterate(this, wfObjects, libint2Objects, iterationScheme) implicit none type(MultiSCF) :: this - type(WaveFunction) :: wfObjects(*) + type(WaveFunction) :: wfObjects(*) + type(Libint2Interface) :: libint2Objects(:) integer, intent(in) :: iterationScheme integer :: i,j @@ -247,7 +291,7 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme) !!!We start with an update of the global energy and matrices this%status = SCF_INTRASPECIES_CONVERGENCE_CONTINUE - numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies() + numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(this%molSys) densFile="lowdin.densmatrix" @@ -258,7 +302,7 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme) call WaveFunction_writeDensityMatricesToFile(wfObjects, densFile) call system("lowdin-DFT.x SCF_DFT "//trim(densFile)) else - call WaveFunction_getDFTContributions(wfObjects,"SCF") + call WaveFunction_getDFTContributions(wfObjects,this%DFTGrids,this%DFTGridsCommonPoints,"SCF") end if end if @@ -266,9 +310,9 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme) !Coupling Matrix is only updated in global SCF cycles do i = 1, numberOfSpecies - call WaveFunction_buildTwoParticlesMatrix(wfObjects(i)) + call WaveFunction_buildTwoParticlesMatrix(wfObjects(i),libint2Objects=libint2Objects(:)) - call WaveFunction_buildCouplingMatrix(wfObjects,i) + call WaveFunction_buildCouplingMatrix(wfObjects,i,libint2Objects=libint2Objects(:)) if ( (CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS") .and. CONTROL_instance%GRID_STORAGE .eq. "DISK") then call WaveFunction_readExchangeCorrelationMatrix(wfObjects(i)) @@ -305,7 +349,7 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme) !!!Now we procede to update each species density matrices according to the iteration scheme selected this%totalDensityMatrixStandardDeviation=0.0 do i = 1, numberOfSpecies - nameOfSpecies = MolecularSystem_getNameOfSpecies(i) + nameOfSpecies = MolecularSystem_getNameOfSpecies(i,this%molSys) oldEnergy=wfObjects(i)%totalEnergyForSpecies deltaEnergy=1.0E16_8 singleIterator=0 @@ -334,7 +378,7 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme) if(this%singleMaxIterations(i).gt.1) then !! Updates two particle matrix - call WaveFunction_buildTwoParticlesMatrix(wfObjects(i)) + call WaveFunction_buildTwoParticlesMatrix(wfObjects(i),libint2Objects=libint2Objects(:)) if (CONTROL_instance%COSMO) then call WaveFunction_buildCosmo2Matrix(wfObjects(i)) @@ -382,10 +426,10 @@ subroutine MultiSCF_iterate(this, wfObjects, iterationScheme) if ( CONTROL_instance%FORCE_CLOSED_SHELL .and. & (CONTROL_instance%METHOD .eq. "UKS" .or. CONTROL_instance%METHOD .eq. "UHF") ) then - i=MolecularSystem_getSpecieIDFromSymbol( trim("E-ALPHA") ) - j=MolecularSystem_getSpecieIDFromSymbol( trim("E-BETA") ) + i=MolecularSystem_getSpecieIDFromSymbol(trim("E-ALPHA"),this%molSys) + j=MolecularSystem_getSpecieIDFromSymbol(trim("E-BETA"),this%molSys) - if(MolecularSystem_getNumberOfParticles(i) .eq. MolecularSystem_getNumberOfParticles(j) ) then + if(MolecularSystem_getNumberOfParticles(i,this%molSys) .eq. MolecularSystem_getNumberOfParticles(j,this%molSys) ) then wfObjects(j)%waveFunctionCoefficients%values= wfObjects(i)%waveFunctionCoefficients%values wfObjects(j)%densityMatrix%values= wfObjects(i)%densityMatrix%values end if @@ -432,13 +476,13 @@ end subroutine MultiSCF_iterate ! if ( this%numberOfIterations > 1 ) then ! auxVar=.true. - ! do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies() + ! do speciesID = 1, nspecies ! nameOfSpecie = MolecularSystem_getNameOfSpecies(speciesID) ! toleraceOfSpecie = this%electronicTolerance - ! if (.not. MolecularSystem_instance%species(speciesID)%isElectron ) then + ! if (.not. this%molSys%species(speciesID)%isElectron ) then ! toleraceOfSpecie = this%nonelectronicTolerance ! end if @@ -504,7 +548,7 @@ subroutine MultiSCF_reset(this,wfObjects) call List_clear( this%energyOMNE ) this%status = SCF_INTRASPECIES_CONVERGENCE_CONTINUE - do speciesIterator = 1, MolecularSystem_getNumberOfQuantumSpecies() + do speciesIterator = 1, MolecularSystem_getNumberOfQuantumSpecies(this%molSys) call SingleSCF_reset(wfObjects(speciesIterator)) end do @@ -566,10 +610,10 @@ subroutine MultiSCF_buildHcore(this,wfObjects) call MolecularSystem_exception(ERROR,"lowdin.opints file not found!", "In SCF.f90 at main program") open(unit=integralsUnit, file=trim(integralsFile), status="old", form="unformatted") read(integralsUnit) numberOfSpecies - if(MolecularSystem_instance%numberOfQuantumSpecies /= numberOfSpecies ) & + if(this%molSys%numberOfQuantumSpecies /= numberOfSpecies ) & call MolecularSystem_exception( ERROR, "Bad "//trim(integralsFile)//" file!", "In SCF.f90 at main program") close(integralsUnit) - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + do speciesID = 1, this%molSys%numberOfQuantumSpecies call WaveFunction_readOverlapMatrix(wfObjects(speciesID), trim(integralsFile)) call WaveFunction_readKineticMatrix(wfObjects(speciesID), trim(integralsFile)) call WaveFunction_readPuntualInteractionMatrix(wfObjects(speciesID), trim(integralsFile)) @@ -580,7 +624,7 @@ subroutine MultiSCF_buildHcore(this,wfObjects) call WaveFunction_readElectricFieldMatrices(wfObjects(speciesID), trim(integralsFile)) end if - if ( MolecularSystem_getOmega(speciesID) .ne. 0.0_8) then + if ( MolecularSystem_getOmega(speciesID,this%molSys) .ne. 0.0_8) then call WaveFunction_readHarmonicOscillatorMatrix(wfObjects(speciesID), trim(integralsFile)) end if !! Builds Cosmo hcore integrals @@ -590,24 +634,24 @@ subroutine MultiSCF_buildHcore(this,wfObjects) end if end do else !!DIRECT or MEMORY - numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies + numberOfSpecies = this%molSys%numberOfQuantumSpecies do speciesID = 1, numberOfSpecies - call DirectIntegralManager_getOverlapIntegrals(molecularSystem_instance,speciesID,& + call DirectIntegralManager_getOverlapIntegrals(this%molSys,speciesID,& wfObjects(speciesID)%overlapMatrix) - call DirectIntegralManager_getKineticIntegrals(molecularSystem_instance,speciesID,& + call DirectIntegralManager_getKineticIntegrals(this%molSys,speciesID,& wfObjects(speciesID)%kineticMatrix) - call DirectIntegralManager_getAttractionIntegrals(molecularSystem_instance,speciesID,& + call DirectIntegralManager_getAttractionIntegrals(this%molSys,speciesID,& wfObjects(speciesID)%puntualInteractionMatrix) if(CONTROL_instance%IS_THERE_EXTERNAL_POTENTIAL) then - call DirectIntegralManager_getExternalPotentialIntegrals(molecularSystem_instance,speciesID,& + call DirectIntegralManager_getExternalPotentialIntegrals(this%molSys,speciesID,& wfObjects(speciesID)%externalPotentialMatrix) end if end do end if !!********************************************************** - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + do speciesID = 1, this%molSys%numberOfQuantumSpecies !! Transformation Matrix call WaveFunction_buildTransformationMatrix(wfObjects(speciesID), 2) !! Hcore Matrix @@ -628,23 +672,24 @@ subroutine MultiSCF_getInitialGuess(this,wfObjects) !!********************************************************** !! Build Guess and first density matrix !! - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + do speciesID = 1, this%molSys%numberOfQuantumSpecies call DensityMatrixSCFGuess_getGuess( speciesID, wfObjects(speciesID)%HcoreMatrix, & wfObjects(speciesID)%transformationMatrix, & wfObjects(speciesID)%densityMatrix,& wfObjects(speciesID)%waveFunctionCoefficients, & - this%printSCFiterations) + this%printSCFiterations, & + this%molSys) normCheck=sum( transpose(wfObjects(speciesID)%densityMatrix%values)*wfObjects(speciesID)%overlapMatrix%values) if ( this%printSCFiterations ) & - write(*,"(A15,A10,A40,F12.6)") "number of ", trim(MolecularSystem_getNameOfSpecies( speciesID )) , & + write(*,"(A15,A10,A40,F12.6)") "number of ", trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys)) , & " particles in guess density matrix: ", normCheck - expectedOccupation=MolecularSystem_getEta(speciesID)*MolecularSystem_instance%species(speciesID)%ocupationNumber - if (trim(MolecularSystem_getNameOfSpecies( speciesID )) .eq. trim(CONTROL_instance%IONIZE_SPECIES(1))) then + expectedOccupation=MolecularSystem_getEta(speciesID,this%molSys)*this%molSys%species(speciesID)%ocupationNumber + if (trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys)) .eq. trim(CONTROL_instance%IONIZE_SPECIES(1))) then do i=1,size(CONTROL_instance%IONIZE_MO) if(CONTROL_instance%IONIZE_MO(i) .gt. 0 .and. CONTROL_instance%MO_FRACTION_OCCUPATION(i) .lt. 1.0_8) & - expectedOccupation=expectedOccupation-MolecularSystem_getEta(speciesID)*(1.0-CONTROL_instance%MO_FRACTION_OCCUPATION(i)) + expectedOccupation=expectedOccupation-MolecularSystem_getEta(speciesID,this%molSys)*(1.0-CONTROL_instance%MO_FRACTION_OCCUPATION(i)) end do end if @@ -657,8 +702,8 @@ subroutine MultiSCF_getInitialGuess(this,wfObjects) end if if ( CONTROL_instance%DEBUG_SCFS ) then - print *, "Initial Density Matrix ", trim(MolecularSystem_getNameOfSpecie( speciesID )) - call Matrix_show(WaveFunction_instance(speciesID)%densityMatrix) + print *, "Initial Density Matrix ", trim(MolecularSystem_getNameOfSpecies(speciesID,this%molSys)) + call Matrix_show(wfObjects(speciesID)%densityMatrix) end if end do @@ -666,10 +711,10 @@ subroutine MultiSCF_getInitialGuess(this,wfObjects) !Forces equal coefficients for E-ALPHA and E-BETA in open shell calculations if ( CONTROL_instance%FORCE_CLOSED_SHELL .and. & (CONTROL_instance%METHOD .eq. "UKS" .or. CONTROL_instance%METHOD .eq. "UHF") ) then - speciesID=MolecularSystem_getSpecieIDFromSymbol( trim("E-ALPHA") ) - otherSpeciesID=MolecularSystem_getSpecieIDFromSymbol( trim("E-BETA") ) + speciesID=MolecularSystem_getSpecieIDFromSymbol(trim("E-ALPHA"),this%molSys) + otherSpeciesID=MolecularSystem_getSpecieIDFromSymbol(trim("E-BETA"),this%molSys) - if(MolecularSystem_getNumberOfParticles(speciesID) .eq. MolecularSystem_getNumberOfParticles(otherSpeciesID) ) then + if(MolecularSystem_getNumberOfParticles(speciesID,this%molSys) .eq. MolecularSystem_getNumberOfParticles(otherSpeciesID,this%molSys)) then wfObjects(otherSpeciesID)%waveFunctionCoefficients%values= wfObjects(speciesID)%waveFunctionCoefficients%values wfObjects(otherSpeciesID)%densityMatrix%values= wfObjects(speciesID)%densityMatrix%values end if @@ -685,7 +730,7 @@ end subroutine MultiSCF_getInitialGuess subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects) type(MultiSCF) :: this type(WaveFunction) :: wfObjects(*) - type(Libint2Interface), optional :: libint2Objects(*) + type(Libint2Interface) :: libint2Objects(:) real(8) :: oldEnergy real(8) :: deltaEnergy @@ -708,7 +753,7 @@ subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects) densUnit=78 densFile="lowdin.densmatrix" - numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies + numberOfSpecies = this%molSys%numberOfQuantumSpecies !! !!*************************************************************************************************************** @@ -735,7 +780,7 @@ subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects) do while(GLOBAL_SCF_CONTINUE) - call MultiSCF_iterate(this, wfObjects, CONTROL_instance%ITERATION_SCHEME ) + call MultiSCF_iterate(this, wfObjects, libint2Objects(:), CONTROL_instance%ITERATION_SCHEME ) deltaEnergy = oldEnergy -MultiSCF_getLastEnergy(this) oldEnergy = MultiSCF_getLastEnergy(this) @@ -745,7 +790,7 @@ subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects) write(*,"(I15,F25.12,F25.12,F25.12,F25.12)") MultiSCF_getNumberOfIterations(this), & MultiSCF_getLastEnergy(this), deltaEnergy, & this%totalDensityMatrixStandardDeviation ,& - sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%particlesInGrid) + sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%particlesInGrid) else write(*,"(I15,F25.12,F25.12,F25.12)") MultiSCF_getNumberOfIterations(this), & MultiSCF_getLastEnergy(this), deltaEnergy, & @@ -813,17 +858,18 @@ subroutine MultiSCF_solveHartreeFockRoothan(this,wfObjects,libint2Objects) ! print *,"" ! end if - call MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects) + call MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects(:)) end subroutine MultiSCF_solveHartreeFockRoothan !> !! @brief solve multcomponent FC=eSC SCF equations, store the coefficients in wfObjects, use the libint2Objects to compute the integrals in direct calculations - subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects) + subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects,method) type(MultiSCF) :: this type(WaveFunction) :: wfObjects(*) - type(Libint2Interface), optional :: libint2Objects(*) - + type(Libint2Interface) :: libint2Objects(:) + character(*), optional :: method + integer :: numberOfSpecies integer :: wfnUnit, densUnit integer :: speciesID, otherSpeciesID, i @@ -832,6 +878,8 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects) character(50) :: integralsFile integer :: integralsUnit + if( .not. present(method) ) method=CONTROL_instance%METHOD + !! Open file for wfn wfnUnit = 300 wfnFile = "lowdin.wfn" @@ -842,7 +890,7 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects) densUnit=78 densFile="lowdin.densmatrix" - numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies + numberOfSpecies = this%molSys%numberOfQuantumSpecies if (CONTROL_instance%LOCALIZE_ORBITALS) then @@ -850,7 +898,7 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects) open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted") rewind(wfnUnit) do speciesID=1, numberOfSpecies - labels(2) = MolecularSystem_getNameOfSpecies(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys) labels(1) = "COEFFICIENTS" call Matrix_writeToFile(wfObjects(speciesID)%waveFunctionCoefficients, unit=wfnUnit, binary=.true., arguments = labels ) labels(1) = "ORBITALS" @@ -868,7 +916,7 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects) write(*,*) "==============================" write(*,*) "" do speciesID=1, numberOfSpecies - if(MolecularSystem_getMass( speciesID ) .lt. 10.0 .and. MolecularSystem_getOcupationNumber( speciesID ) .gt. 1) then !We assume that heavy particle orbitals are naturally localized + if(MolecularSystem_getMass(speciesID,this%molSys) .lt. 10.0 .and. MolecularSystem_getOcupationNumber(speciesID,this%molSys) .gt. 1) then !We assume that heavy particle orbitals are naturally localized call OrbitalLocalizer_erkaleLocal(speciesID,& wfObjects( speciesID )%densityMatrix,& wfObjects( speciesID )%fockMatrix, & @@ -895,10 +943,10 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects) !Forces equal coefficients for E-ALPHA and E-BETA in open shell calculations if ( CONTROL_instance%FORCE_CLOSED_SHELL .and. & (CONTROL_instance%METHOD .eq. "UKS" .or. CONTROL_instance%METHOD .eq. "UHF") ) then - speciesID=MolecularSystem_getSpecieIDFromSymbol( trim("E-ALPHA") ) - otherSpeciesID=MolecularSystem_getSpecieIDFromSymbol( trim("E-BETA") ) + speciesID=MolecularSystem_getSpecieIDFromSymbol(trim("E-ALPHA"),this%molSys) + otherSpeciesID=MolecularSystem_getSpecieIDFromSymbol(trim("E-BETA"),this%molSys) - if(MolecularSystem_getNumberOfParticles(speciesID) .eq. MolecularSystem_getNumberOfParticles(otherSpeciesID) ) then + if(MolecularSystem_getNumberOfParticles(speciesID,this%molSys) .eq. MolecularSystem_getNumberOfParticles(otherSpeciesID,this%molSys)) then wfObjects(otherSpeciesID)%waveFunctionCoefficients%values= wfObjects(speciesID)%waveFunctionCoefficients%values wfObjects(otherSpeciesID)%densityMatrix%values= wfObjects(speciesID)%densityMatrix%values end if @@ -912,7 +960,7 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects) call system("lowdin-DFT.x BUILD_FINAL_GRID "//trim(densFile)) call system("lowdin-DFT.x FINAL_DFT "//trim(densFile)) else - call WaveFunction_getDFTContributions(wfObjects,"FINAL") + call WaveFunction_getDFTContributions(wfObjects,this%DFTGrids,this%DFTGridsCommonPoints,"FINAL") end if end if @@ -927,16 +975,16 @@ subroutine MultiSCF_obtainFinalEnergy(this,wfObjects,libint2Objects) call WaveFunction_readExchangeCorrelationMatrix(wfObjects(speciesID)) end if - call WaveFunction_buildTwoParticlesMatrix(wfObjects(speciesID)) + call WaveFunction_buildTwoParticlesMatrix(wfObjects(speciesID),libint2Objects=libint2Objects(:)) !Separate coulomb and exchange contributions to two particles matrix call WaveFunction_buildTwoParticlesMatrix(wfObjects(speciesID), & - twoParticlesMatrixOUT=wfObjects(speciesID)%hartreeMatrix(speciesID), factorIN=0.0_8 ) + twoParticlesMatrixOUT=wfObjects(speciesID)%hartreeMatrix(speciesID), factorIN=0.0_8, libint2Objects=libint2Objects(:) ) wfObjects(speciesID)%exchangeHFMatrix%values= wfObjects(speciesID)%twoParticlesMatrix%values & -wfObjects(speciesID)%hartreeMatrix(speciesID)%values - call WaveFunction_buildCouplingMatrix(wfObjects,speciesID) + call WaveFunction_buildCouplingMatrix(wfObjects,speciesID, libint2Objects=libint2Objects(:)) call WaveFunction_buildFockMatrix(wfObjects(speciesID)) @@ -976,13 +1024,14 @@ subroutine MultiSCF_showResults(this,wfObjects) !! Show results !! Shows iterations by species + if ( this%printSCFiterations ) then if(.not. CONTROL_instance%ELECTRONIC_WaveFunction_ANALYSIS ) then - do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies() + do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies(this%molSys) - nameOfSpecies = MolecularSystem_getNameOfSpecies(speciesID) + nameOfSpecies = MolecularSystem_getNameOfSpecies(speciesID,this%molSys) numberOfIterations = List_size( wfObjects(speciesID)%energySCF ) call List_begin( wfObjects(speciesID)%energySCF ) @@ -1034,12 +1083,12 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) "" if ( CONTROL_instance%HF_PRINT_EIGENVALUES ) then - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + do speciesID = 1, this%molSys%numberOfQuantumSpecies write(*,*) "" - write(*,*) " Eigenvalues for: ", trim( MolecularSystem_instance%species(speciesID)%name ) + write(*,*) " Eigenvalues for: ", trim( this%molSys%species(speciesID)%name ) write(*,*) "-----------------" write(*,*) "" - numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) + numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,this%molSys) do i = 1 , numberOfContractions write(6,"(T2,I4,F25.12)") i,wfObjects(speciesID)%molecularOrbitalsEnergy%values(i) end do @@ -1050,14 +1099,14 @@ subroutine MultiSCF_showResults(this,wfObjects) if ( trim(CONTROL_instance%HF_PRINT_EIGENVECTORS) .eq. "ALL" .or. trim(CONTROL_instance%HF_PRINT_EIGENVECTORS) .eq. "OCCUPIED" ) then - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + do speciesID = 1, this%molSys%numberOfQuantumSpecies - numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) + numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,this%molSys) if ( trim(CONTROL_instance%HF_PRINT_EIGENVECTORS) .eq. "ALL") then write(*,*) "" - write(*,*) " Eigenvectors for: ", trim( MolecularSystem_instance%species(speciesID)%name ) + write(*,*) " Eigenvectors for: ", trim( this%molSys%species(speciesID)%name ) write(*,*) "-----------------" write(*,*) "" @@ -1072,13 +1121,13 @@ subroutine MultiSCF_showResults(this,wfObjects) else if ( trim(CONTROL_instance%HF_PRINT_EIGENVECTORS) .eq. "OCCUPIED" ) then write(*,*) "" - write(*,*) " Occupied Eigenvectors for: ", trim( MolecularSystem_instance%species(speciesID)%name ) + write(*,*) " Occupied Eigenvectors for: ", trim( this%molSys%species(speciesID)%name ) write(*,*) "--------------------------- " write(*,*) "" - call Matrix_constructor(coefficientsShow,int(numberOfContractions,8),int(MolecularSystem_getOcupationNumber(speciesID),8),0.0_8) + call Matrix_constructor(coefficientsShow,int(numberOfContractions,8),int(MolecularSystem_getOcupationNumber(speciesID,this%molSys),8),0.0_8) do i=1, numberOfContractions - do j=1, MolecularSystem_getOcupationNumber(speciesID) + do j=1, MolecularSystem_getOcupationNumber(speciesID,this%molSys) coefficientsShow%values(i,j)=wfObjects(speciesID)%waveFunctionCoefficients%values(i,j) end do end do @@ -1086,8 +1135,8 @@ subroutine MultiSCF_showResults(this,wfObjects) end if call Matrix_show(coefficientsShow , & - rowkeys = MolecularSystem_getlabelsofcontractions( speciesID ), & - columnkeys = string_convertvectorofrealstostring( wfObjects(speciesID)%molecularOrbitalsEnergy ),& + rowkeys = MolecularSystem_getlabelsofcontractions(speciesID,this%molSys), & + columnkeys = string_convertvectorofrealstostring(wfObjects(speciesID)%molecularOrbitalsEnergy ),& flags=WITH_BOTH_KEYS) call Matrix_destructor(coefficientsShow) @@ -1108,11 +1157,11 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) "-----------------------------" write(*,*) "" - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & + do speciesID = 1, this%molSys%numberOfQuantumSpecies + write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // & " Kinetic energy = ", wfObjects(speciesID)%kineticEnergy end do - this%totalKineticEnergy = sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%kineticEnergy) + this%totalKineticEnergy = sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%kineticEnergy) write(*,"(T38,A25)") "___________________________" write(*,"(A38,F25.12)") "Total kinetic energy = ", this%totalKineticEnergy @@ -1122,10 +1171,10 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) "-------------------------------" write(*,*) "" - puntualInteractionEnergy = MolecularSystem_getPointChargesEnergy() + puntualInteractionEnergy = MolecularSystem_getPointChargesEnergy(this%molSys) write(*,"(A38,F25.12)") "Fixed potential energy = ", puntualInteractionEnergy - puntualMMInteractionEnergy = MolecularSystem_getMMPointChargesEnergy() + puntualMMInteractionEnergy = MolecularSystem_getMMPointChargesEnergy(this%molSys) if(CONTROL_instance%CHARGES_MM) then write(*,"(A38,F25.12)") "Self MM potential energy = ", puntualMMInteractionEnergy end if @@ -1135,11 +1184,11 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) "----------------------------------" write(*,*) "" - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & + do speciesID = 1, this%molSys%numberOfQuantumSpecies + write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // & "/Fixed interact. energy = ", wfObjects(speciesID)%puntualInteractionEnergy end do - totalQuantumPuntualInteractionEnergy = sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%puntualInteractionEnergy ) + totalQuantumPuntualInteractionEnergy = sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%puntualInteractionEnergy ) write(*,"(T38,A25)") "___________________________" write(*,"(A38,F25.12)") "Total Q/Fixed energy = ", totalQuantumPuntualInteractionEnergy @@ -1148,16 +1197,16 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) "------------------" write(*,*) "" totalHartreeEnergy=0.0 - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - "/"//trim( MolecularSystem_instance%species(speciesID)%name ) // & + do speciesID = 1, this%molSys%numberOfQuantumSpecies + write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // & + "/"//trim( this%molSys%species(speciesID)%name ) // & " Hartree energy = ", wfObjects(speciesID)%hartreeEnergy(speciesID) totalHartreeEnergy=totalHartreeEnergy+wfObjects(speciesID)%hartreeEnergy(speciesID) end do - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - do otherSpeciesID = speciesID + 1, MolecularSystem_instance%numberOfQuantumSpecies - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // & + do speciesID = 1, this%molSys%numberOfQuantumSpecies + do otherSpeciesID = speciesID + 1, this%molSys%numberOfQuantumSpecies + write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // & + "/"//trim( this%molSys%species(otherSpeciesID)%name ) // & " Hartree energy = ", wfObjects(speciesID)%hartreeEnergy(otherSpeciesID) totalHartreeEnergy=totalHartreeEnergy+wfObjects(speciesID)%hartreeEnergy(otherSpeciesID) end do @@ -1169,11 +1218,11 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) " Exchange(HF) energy: " write(*,*) "----------------------" write(*,*) "" - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & + do speciesID = 1, this%molSys%numberOfQuantumSpecies + write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // & " Exchange energy = ", wfObjects(speciesID)%exchangeHFEnergy end do - totalExchangeHFEnergy=sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%exchangeHFEnergy) + totalExchangeHFEnergy=sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%exchangeHFEnergy) write(*,"(T38,A25)") "___________________________" write(*,"(A38,F25.12)") "Total Exchange energy = ", totalExchangeHFEnergy @@ -1184,15 +1233,15 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) "-----------------------------------" write(*,*) "" totalExchangeCorrelationEnergy=0.0 - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & + do speciesID = 1, this%molSys%numberOfQuantumSpecies + write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // & " Exc.Corr. energy = ", wfObjects(speciesID)%exchangeCorrelationEnergy(speciesID) totalExchangeCorrelationEnergy=totalExchangeCorrelationEnergy+wfObjects(speciesID)%exchangeCorrelationEnergy(speciesID) end do - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - do otherSpeciesID = speciesID + 1, MolecularSystem_instance%numberOfQuantumSpecies - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name ) // & - "/"//trim( MolecularSystem_instance%species(otherSpeciesID)%name ) // & + do speciesID = 1, this%molSys%numberOfQuantumSpecies + do otherSpeciesID = speciesID + 1, this%molSys%numberOfQuantumSpecies + write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name ) // & + "/"//trim( this%molSys%species(otherSpeciesID)%name ) // & " Corr. energy = ", wfObjects(speciesID)%exchangeCorrelationEnergy(otherSpeciesID) totalExchangeCorrelationEnergy=totalExchangeCorrelationEnergy+wfObjects(speciesID)%exchangeCorrelationEnergy(otherSpeciesID) end do @@ -1209,11 +1258,11 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) "----------------------------" write(*,*) "" - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - write(*,"(A38,F25.12)") trim( MolecularSystem_instance%species(speciesID)%name) // & + do speciesID = 1, this%molSys%numberOfQuantumSpecies + write(*,"(A38,F25.12)") trim( this%molSys%species(speciesID)%name) // & " Ext Pot energy = ", wfObjects(speciesID)%externalPotentialEnergy end do - totalExternalPotentialEnergy=sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%externalPotentialEnergy) + totalExternalPotentialEnergy=sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%externalPotentialEnergy) write(*,"(T38,A25)") "___________________________" write(*,"(A38,F25.12)") "Total External Potential energy = ", totalExternalPotentialEnergy @@ -1224,7 +1273,7 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) " COSMO ENERGY: " write(*,*) "--------------" write(*,*) "" - totalCosmoEnergy = sum(wfObjects(1:MolecularSystem_instance%numberOfQuantumSpecies)%cosmoEnergy) + totalCosmoEnergy = sum(wfObjects(1:this%molSys%numberOfQuantumSpecies)%cosmoEnergy) write(*,"(A38,F25.12)") "Total Cosmo Energy = ", totalCosmoEnergy write(*,"(A38,F25.12)") "Cosmo 3 Energy = ", this%cosmo3Energy end if @@ -1259,7 +1308,7 @@ subroutine MultiSCF_showResults(this,wfObjects) write(*,*) " COSMO CHARGE: " write(*,*) "--------------" write(*,*) "" - call WaveFunction_cosmoQuantumCharge() + call WaveFunction_cosmoQuantumCharge(this%molSys) end if end subroutine MultiSCF_showResults @@ -1297,11 +1346,11 @@ subroutine MultiSCF_saveWfn(this,wfObjects) labels = "" - numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies + numberOfSpecies = this%molSys%numberOfQuantumSpecies do speciesID = 1, numberOfSpecies - labels(2) = MolecularSystem_getNameOfSpecies(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys) labels(1) = "REMOVED-ORBITALS" call Vector_writeToFile(unit=wfnUnit, binary=.true., value=real(wfObjects(speciesID)%removedOrbitals,8), arguments= labels ) @@ -1374,7 +1423,7 @@ subroutine MultiSCF_saveWfn(this,wfObjects) vecFile = trim(CONTROL_instance%INPUT_FILE)//"vec" open(unit=vecUnit, file=trim(vecFile), form="unformatted", status='replace') do speciesID = 1, numberOfSpecies - labels(2) = MolecularSystem_getNameOfSpecies(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys) labels(1) = "COEFFICIENTS" call Matrix_writeToFile(wfObjects(speciesID)%waveFunctionCoefficients, & unit=vecUnit, binary=.true., arguments = labels) @@ -1389,7 +1438,7 @@ subroutine MultiSCF_saveWfn(this,wfObjects) open(unit=vecUnit, file=trim(vecFile), form="formatted", status='replace') do speciesID = 1, numberOfSpecies - labels(2) = MolecularSystem_getNameOfSpecies(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID,this%molSys) labels(1) = "COEFFICIENTS" call Matrix_writeToFile(wfObjects(speciesID)%waveFunctionCoefficients, & unit=vecUnit, binary=.false., arguments = labels) @@ -1412,7 +1461,7 @@ subroutine MultiSCF_saveWfn(this,wfObjects) call Vector_writeToFile(unit=wfnUnit, binary=.true., value=this%totalCouplingEnergy, arguments=["COUPLINGENERGY"]) - call Vector_writeToFile(unit=wfnUnit, binary=.true., value=MolecularSystem_getPointChargesEnergy(), arguments=["PUNTUALINTERACTIONENERGY"]) + call Vector_writeToFile(unit=wfnUnit, binary=.true., value=MolecularSystem_getPointChargesEnergy(this%molSys), arguments=["PUNTUALINTERACTIONENERGY"]) call Vector_writeToFile(unit=wfnUnit, binary=.true., value=- ( this%totalPotentialEnergy / this%totalKineticEnergy) , arguments=["VIRIAL"]) @@ -1429,9 +1478,9 @@ subroutine MultiSCF_reorderIonizedCoefficients(this,wfObjects) type(Vector) :: auxVector integer :: occupationNumber, newOccupationNumber, i, j, speciesID - do speciesID=1, MolecularSystem_getNumberOfQuantumSpecies() + do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies(this%molSys) if (trim(wfObjects(speciesID)%name) .eq. trim(CONTROL_instance%IONIZE_SPECIES(1)) ) then - occupationNumber=MolecularSystem_getOcupationNumber(speciesID) + occupationNumber=MolecularSystem_getOcupationNumber(speciesID,this%molSys) newOccupationNumber=occupationNumber call Matrix_copyConstructor(auxMatrix,wfObjects(speciesID)%waveFunctionCoefficients) call Vector_copyConstructor(auxVector,wfObjects(speciesID)%molecularOrbitalsEnergy) @@ -1446,9 +1495,9 @@ subroutine MultiSCF_reorderIonizedCoefficients(this,wfObjects) newOccupationNumber=newOccupationNumber-1 end if end do - molecularSystem_instance%species(speciesID)%ocupationNumber=newOccupationNumber + this%molSys%species(speciesID)%ocupationNumber=newOccupationNumber if(CONTROL_instance%DEBUG_SCFS) then - print *, "newOccupationNumber for", trim(wfObjects(speciesID)%name), molecularSystem_instance%species(speciesID)%ocupationNumber + print *, "newOccupationNumber for", trim(wfObjects(speciesID)%name), this%molSys%species(speciesID)%ocupationNumber call Matrix_show(wfObjects(speciesID)%waveFunctionCoefficients) end if end if diff --git a/src/scf/OrbitalLocalizer.f90 b/src/scf/OrbitalLocalizer.f90 index b959c306..28e4ca88 100644 --- a/src/scf/OrbitalLocalizer.f90 +++ b/src/scf/OrbitalLocalizer.f90 @@ -117,7 +117,7 @@ subroutine OrbitalLocalizer_erkaleLocal(speciesID,densityMatrix,fockMatrix,orbit !! Convert lowdin fchk files to erkale chk files - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID) numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) open(unit=30, file="erkale.read", status="replace", form="formatted") @@ -294,7 +294,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() do speciesID=1, numberOfSpecies - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID) numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) numberOfCenters = size(MolecularSystem_instance%species(speciesID)%particles) occupationNumber = MolecularSystem_getOcupationNumber( speciesID ) @@ -491,7 +491,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() !!Reduce basis set loops do speciesID=1, numberOfSpecies - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID) numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) numberOfCenters = size(MolecularSystem_instance%species(speciesID)%particles) overlapMatrix=WaveFunction_instance( speciesID )%OverlapMatrix @@ -578,7 +578,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() end do do speciesID=1, numberOfSpecies - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID) numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) !Adds diagonal proyection elements to orbitals with small contributions to A orbitals - small mulliken population @@ -673,7 +673,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() write(*,"(A15,A15,A15,A15,A15)") "Species", "Occupied A","Virtual A","Occupied B", "Virtual B" write(*,"(A75)") "---------------------------------------------------------------------------" do speciesID=1, numberOfSpecies - write(*,"(A15,I7,F7.1,A,I7,F7.1,A,I7,F7.1,A,I7,F7.1,A)") trim(MolecularSystem_getNameOfSpecie(speciesID)), & + write(*,"(A15,I7,F7.1,A,I7,F7.1,A,I7,F7.1,A,I7,F7.1,A)") trim(MolecularSystem_getNameOfSpecies(speciesID)), & OrbitalLocalizer_instance(speciesID)%occupiedOrbitalsA,& 100.0_8*OrbitalLocalizer_instance(speciesID)%occupiedOrbitalsA/(OrbitalLocalizer_instance(speciesID)%occupiedOrbitalsA+OrbitalLocalizer_instance(speciesID)%occupiedOrbitalsB),& "%",& @@ -699,7 +699,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() !Two particles and coupling matrices do speciesID=1, numberOfSpecies - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID) !Only Coulomb (factor=0.0) call WaveFunction_buildTwoParticlesMatrix(WaveFunction_instance(speciesID),& densityMatrixIN=densityMatrixB(speciesID),& @@ -814,7 +814,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() !Calculates the fock matrix with the new subsystem density do speciesID=1, numberOfSpecies numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID) !Updates two particles matrix - only Coulomb (factor=0.0) call WaveFunction_buildTwoParticlesMatrix(WaveFunction_instance(speciesID),& @@ -991,7 +991,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() !Calculates the subsystem orbitals with the new fock matrix do speciesID=1, numberOfSpecies numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) - nameOfSpecies=MolecularSystem_getNameOfSpecie(speciesID) + nameOfSpecies=MolecularSystem_getNameOfSpecies(speciesID) call Matrix_copyConstructor( fockMatrixTransformed, OrbitalLocalizer_instance(speciesID)%fockMatrixA ) @@ -1833,7 +1833,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() !! Start the wavefunction object deallocate(WaveFunction_instance) - call WaveFunction_constructor(WaveFunction_instance) + call WaveFunction_constructor(WaveFunction_instance,numberOfSpecies) do speciesID=1, numberOfSpecies call WaveFunction_readOverlapMatrix(WaveFunction_instance(speciesID), "lowdin.opints") @@ -1930,7 +1930,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted") rewind(wfnUnit) do speciesID = 1, numberOfSpecies - labels(2) = MolecularSystem_getNameOfSpecie(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID) labels(1) = "DENSITY" call Matrix_writeToFile(WaveFunction_instance(speciesID)%densityMatrix, unit=wfnUnit, binary=.true., arguments = labels ) end do @@ -2103,7 +2103,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() do speciesID = 1, numberOfSpecies - labels(2) = MolecularSystem_getNameOfSpecie(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID) labels(1) = "REMOVED-ORBITALS" call Vector_writeToFile(unit=wfnUnit, binary=.true., value=real(WaveFunction_instance(speciesID)%removedOrbitals,8), arguments= labels ) @@ -2162,7 +2162,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() vecFile = trim(CONTROL_instance%INPUT_FILE)//"subvec" open(unit=vecUnit, file=trim(vecFile), form="unformatted", status='replace') do speciesID = 1, numberOfSpecies - labels(2) = MolecularSystem_getNameOfSpecie(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID) labels(1) = "COEFFICIENTS" call Matrix_writeToFile(WaveFunction_instance(speciesID)%waveFunctionCoefficients, & unit=vecUnit, binary=.true., arguments = labels) @@ -2177,7 +2177,7 @@ subroutine OrbitalLocalizer_levelShiftSubsystemOrbitals() open(unit=vecUnit, file=trim(vecFile), form="formatted", status='replace') do speciesID = 1, numberOfSpecies - labels(2) = MolecularSystem_getNameOfSpecie(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID) labels(1) = "COEFFICIENTS" call Matrix_writeToFile(WaveFunction_instance(speciesID)%waveFunctionCoefficients, & unit=vecUnit, binary=.false., arguments = labels) diff --git a/src/scf/SCF.f90 b/src/scf/SCF.f90 index 906e1e7a..187810d9 100644 --- a/src/scf/SCF.f90 +++ b/src/scf/SCF.f90 @@ -67,7 +67,7 @@ program SCF !! Start the MultiSCF object allocate(WaveFunction_instance(MolecularSystem_instance%numberOfQuantumSpecies)) - call MultiSCF_constructor(MultiSCF_instance,WaveFunction_instance,CONTROL_instance%ITERATION_SCHEME) + call MultiSCF_constructor(MultiSCF_instance,WaveFunction_instance,CONTROL_instance%ITERATION_SCHEME,molecularSystem_instance) !! Calculate one-particle integrals if ( CONTROL_instance%INTEGRAL_STORAGE == "DISK" ) & @@ -87,7 +87,7 @@ program SCF wfnFile = "lowdin.wfn" open(unit=wfnUnit, file=trim(wfnFile), status="replace", form="unformatted") do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - labels(2) = MolecularSystem_getNameOfSpecie(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID) labels(1) = "DENSITY" call Matrix_writeToFile(WaveFunction_instance(speciesID)%densityMatrix, unit=wfnUnit, binary=.true., arguments = labels ) end do diff --git a/src/scf/SingleSCF.f90 b/src/scf/SingleSCF.f90 index 6d528083..6cb85fd1 100644 --- a/src/scf/SingleSCF.f90 +++ b/src/scf/SingleSCF.f90 @@ -155,7 +155,7 @@ subroutine SingleSCF_iterate(wfObject) real(8) :: hold ! wfnFile = trim(CONTROL_instance%INPUT_FILE)//"lowdin.vec" - numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species ) + numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species, wfObject%molSys ) !!********************************************************************************************** @@ -281,7 +281,7 @@ subroutine SingleSCF_reset(wfObject) call Convergence_destructor(wfObject%convergenceMethod) call Convergence_constructor(wfObject%convergenceMethod, & - wfObject%name,CONTROL_instance%CONVERGENCE_METHOD) + wfObject%name,CONTROL_instance%CONVERGENCE_METHOD,wfObject%molSys) call Convergence_reset() @@ -300,7 +300,7 @@ end subroutine SingleSCF_reset ! wfObject%name = "E-" ! if ( present(wfObject%name ) ) wfObject%name= trim(wfObject%name ) - ! wfObject%species = MolecularSystem_getSpecieID(wfObject%name=trim(wfObject%name ) ) + ! wfObject%species = MolecularSystem_getSpecieID(wfObject%name=trim(wfObject%name,wfObject%molSys ) ) ! !! Determina la desviacion estandar de los elementos de la matriz de densidad ! call Matrix_copyConstructor(wfObject%beforeDensityMatrix, wfObject%densityMatrix ) @@ -365,7 +365,7 @@ subroutine SingleSCF_orbitalExchange(wfObject,previousWavefunctionCoefficients) !When the user explicitly requires EXCHANGE_ORBITALS_IN_SCF to have a solution with max overlap to the guess function !Or when an orbital is selected for partial ionization if(CONTROL_instance%EXCHANGE_ORBITALS_IN_SCF) then - activeOrbitals = MolecularSystem_getOcupationNumber(wfObject%species) + activeOrbitals = MolecularSystem_getOcupationNumber(wfObject%species,wfObject%molSys) call Vector_constructorInteger(orbitalsVector,activeOrbitals) do i=1,activeOrbitals orbitalsVector%values(i)=i @@ -388,7 +388,7 @@ subroutine SingleSCF_orbitalExchange(wfObject,previousWavefunctionCoefficients) call Matrix_copyConstructor(auxOverlapMatrix,wfObject%overlapMatrix) - numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species ) + numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species,wfObject%molSys) call Matrix_constructor (matchingMatrix, int(activeOrbitals,8), int(activeOrbitals,8)) @@ -499,10 +499,10 @@ subroutine SingleSCF_readFrozenOrbitals(wfObject) integer :: wfnUnit wfnUnit = 30 - numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species ) + numberOfContractions = MolecularSystem_getTotalnumberOfContractions(wfObject%species,wfObject%molSys) !! NO SCF cicle for electrons or non-electrons - if ( CONTROL_instance%FREEZE_ELECTRONIC_ORBITALS .and. .not. MolecularSystem_instance%species(wfObject%species)%isElectron) return - if ( CONTROL_instance%FREEZE_NON_ELECTRONIC_ORBITALS .and. MolecularSystem_instance%species(wfObject%species)%isElectron ) return + if ( CONTROL_instance%FREEZE_ELECTRONIC_ORBITALS .and. .not. wfObject%molSys%species(wfObject%species)%isElectron) return + if ( CONTROL_instance%FREEZE_NON_ELECTRONIC_ORBITALS .and. wfObject%molSys%species(wfObject%species)%isElectron ) return !! Read coefficients from various possible files if (CONTROL_instance%READ_FCHK) then @@ -513,7 +513,7 @@ subroutine SingleSCF_readFrozenOrbitals(wfObject) call Matrix_destructor(auxiliaryMatrix) else if (CONTROL_instance%READ_COEFFICIENTS) then - arguments(2) = MolecularSystem_getNameOfSpecie(wfObject%species) + arguments(2) = MolecularSystem_getNameOfSpecies(wfObject%species,wfObject%molSys) arguments(1) = "COEFFICIENTS" wfnFile=trim(CONTROL_instance%INPUT_FILE)//"plainvec" diff --git a/src/scf/WaveFunction.f90 b/src/scf/WaveFunction.f90 index 76ec3a86..117ad0a0 100644 --- a/src/scf/WaveFunction.f90 +++ b/src/scf/WaveFunction.f90 @@ -28,6 +28,7 @@ module WaveFunction_ use CosmoCore_ use DirectIntegralManager_ use DensityFunctionalTheory_ + use Libint2Interface_ implicit none @@ -47,6 +48,7 @@ module WaveFunction_ !!Identity character(30) :: name integer :: species + type(MolecularSystem), pointer :: molSys !!************************************************************** !! Matrices requeridas y alteradas en la realizacion del ciclo SCF @@ -121,35 +123,36 @@ module WaveFunction_ !> !! @brief Define el constructor para la clase - subroutine WaveFunction_constructor(these ) + subroutine WaveFunction_constructor(these,nspecies,molsystem) implicit none - type(WaveFunction) :: these(*) + type(WaveFunction) :: these(nspecies) + integer :: nspecies + type(MolecularSystem), optional, target :: molsystem integer :: speciesID, otherSpeciesID integer(8) :: numberOfContractions, otherNumberOfContractions - character(50) :: labels(2) - character(50) :: dftFile - integer :: dftUnit - + !! Allocate memory for specie in system and load some matrices. - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + do speciesID = 1, nspecies + if( present(molsystem) ) then + these(speciesID)%molSys=>molsystem + else + these(speciesID)%molSys=>MolecularSystem_instance + end if these(speciesID)%species=speciesID - these(speciesID)%name=trim(MolecularSystem_getNameOfSpecies(speciesID)) + these(speciesID)%name=trim(MolecularSystem_getNameOfSpecies(speciesID,these(speciesID)%molSys)) - - labels = "" - labels(2) = trim(MolecularSystem_getNameOfSpecies(speciesID)) - numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) + numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,these(speciesID)%molSys) if(allocated(these(speciesID)%hartreeMatrix)) deallocate(these(speciesID)%hartreeMatrix) if(allocated(these(speciesID)%hartreeEnergy)) deallocate(these(speciesID)%hartreeEnergy) if(allocated(these(speciesID)%exchangeCorrelationEnergy)) deallocate(these(speciesID)%exchangeCorrelationEnergy) - allocate(these(speciesID)%hartreeMatrix( MolecularSystem_instance%numberOfQuantumSpecies)) - allocate(these(speciesID)%hartreeEnergy( MolecularSystem_instance%numberOfQuantumSpecies)) - allocate(these(speciesID)%exchangeCorrelationEnergy( MolecularSystem_instance%numberOfQuantumSpecies)) + allocate(these(speciesID)%hartreeMatrix( nspecies)) + allocate(these(speciesID)%hartreeEnergy( nspecies)) + allocate(these(speciesID)%exchangeCorrelationEnergy( nspecies)) !! Parametros Asociados con el SCF @@ -159,7 +162,7 @@ subroutine WaveFunction_constructor(these ) !! Instancia un objeto para manejo de aceleracion y convergencia del metodo SCF call Convergence_constructor(these( speciesID )%convergenceMethod, & - these(speciesID)%name,CONTROL_instance%CONVERGENCE_METHOD) + these(speciesID)%name,CONTROL_instance%CONVERGENCE_METHOD,these(speciesID)%molSys) !! Set defaults these(speciesID)%totalEnergyForSpecies = 0.0_8 @@ -189,7 +192,7 @@ subroutine WaveFunction_constructor(these ) call Matrix_constructor( these(speciesID)%couplingMatrix, numberOfContractions, numberOfContractions, 0.0_8 ) call Matrix_constructor( these(speciesID)%externalPotentialMatrix, numberOfContractions, numberOfContractions, 0.0_8 ) - do otherSpeciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + do otherSpeciesID = 1, nspecies call Matrix_constructor( these(speciesID)%hartreeMatrix(otherSpeciesID), numberOfContractions, numberOfContractions, 0.0_8 ) end do @@ -212,37 +215,15 @@ subroutine WaveFunction_constructor(these ) if (CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then if(allocated(these(speciesID)%fourCenterIntegrals)) deallocate(these(speciesID)%fourCenterIntegrals) - allocate(these(speciesID)%fourCenterIntegrals(MolecularSystem_instance%numberOfQuantumSpecies)) + allocate(these(speciesID)%fourCenterIntegrals(nspecies)) !its not necessary to allocate all the species - do otherSpeciesID=speciesID, MolecularSystem_instance%numberOfQuantumSpecies - otherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID) + do otherSpeciesID=speciesID, nspecies + otherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,these(speciesID)%molSys) call Matrix_fourIndexConstructor(these(speciesID)%fourCenterIntegrals(otherSpeciesID),& otherNumberOfContractions,otherNumberOfContractions,numberOfContractions,numberOfContractions,0.0_8) end do end if end do - - !!Initialize DFT: Calculate Grids and build functionals - if ( CONTROL_instance%METHOD .eq. "RKS" .or. CONTROL_instance%METHOD .eq. "UKS" ) then - if (CONTROL_instance%GRID_STORAGE .eq. "DISK") then - call system ("lowdin-DFT.x BUILD_SCF_GRID") - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies - dftUnit = 77 - dftFile = "lowdin."//trim(MolecularSystem_getNameOfSpecies(speciesID))//".grid" - open(unit = dftUnit, file=trim(dftFile), status="old", form="unformatted") - - labels(2) = MolecularSystem_getNameOfSpecies(speciesID) - labels(1) = "EXACT-EXCHANGE-FRACTION" - - call Vector_getFromFile(unit=dftUnit, binary=.true., value=these(speciesID)%exactExchangeFraction, arguments=labels) - close(unit=dftUnit) - ! print *, "el tormento tuyo", speciesID, these(speciesID)%exactExchangeFraction - end do - else - call DensityFunctionalTheory_buildSCFGrid(these(1:MolecularSystem_instance%numberOfQuantumSpecies)%exactExchangeFraction) - end if - end if - if ( sum(abs(CONTROL_instance%ELECTRIC_FIELD )) .ne. 0 ) then write (*,"(T2,A15,3F12.8)") "ELECTRIC FIELD:", CONTROL_instance%ELECTRIC_FIELD @@ -262,19 +243,19 @@ subroutine WaveFunction_readOverlapMatrix(this, file) character(10) :: arguments(2) arguments(1) = "OVERLAP" - arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) !! Open file unit = 34 open(unit = unit, file=trim(file), status="old", form="unformatted") !! Get number of shells and number of cartesian contractions - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) + totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) this%overlapMatrix = Matrix_getFromFile(rows=totalNumberOfContractions, columns=totalNumberOfContractions, & unit=unit, binary=.true., arguments=arguments) close(34) !! DEBUG if ( CONTROL_instance%DEBUG_SCFS) then - print *,"Matriz de overlap: ", trim(MolecularSystem_getNameOfSpecies(this%species)) + print *,"Matriz de overlap: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) call Matrix_show(this%overlapMatrix) end if end subroutine WaveFunction_readOverlapMatrix @@ -291,19 +272,19 @@ subroutine WaveFunction_readKineticMatrix(this, file) character(10) :: arguments(2) arguments(1) = "KINETIC" - arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) !! Open file unit = 34 open(unit = unit, file=trim(file), status="old", form="unformatted") !! Get number of shells and number of cartesian contractions - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) + totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) this%kineticMatrix = Matrix_getFromFile(rows=totalNumberOfContractions, columns=totalNumberOfContractions, & unit=unit, binary=.true., arguments=arguments) close(34) !! DEBUG if ( CONTROL_instance%DEBUG_SCFS) then - print *,"Matriz de kinetic: ", trim(MolecularSystem_getNameOfSpecies(this%species)) + print *,"Matriz de kinetic: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) call Matrix_show(this%kineticMatrix) end if end subroutine WaveFunction_readKineticMatrix @@ -320,19 +301,19 @@ subroutine WaveFunction_readPuntualInteractionMatrix(this, file) character(10) :: arguments(2) arguments(1) = "ATTRACTION" - arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) !! Open file unit = 34 open(unit = unit, file=trim(file), status="old", form="unformatted") !! Get number of shells and number of cartesian contractions - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) + totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) this%puntualInteractionMatrix = Matrix_getFromFile(rows=totalNumberOfContractions, columns=totalNumberOfContractions, & unit=unit, binary=.true., arguments=arguments) close(34) !! DEBUG if ( CONTROL_instance%DEBUG_SCFS) then - print *,"Matriz de puntual interaction: ", trim(MolecularSystem_getNameOfSpecies(this%species)) + print *,"Matriz de puntual interaction: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) call Matrix_show(this%puntualInteractionMatrix) end if end subroutine WaveFunction_readPuntualInteractionMatrix @@ -348,12 +329,12 @@ subroutine WaveFunction_readElectricFieldMatrices(this, file) integer :: totalNumberOfContractions character(10) :: arguments(2) - arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) !! Open file unit = 34 open(unit = unit, file=trim(file), status="old", form="unformatted") !! Get number of shells and number of cartesian contractions - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) + totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) arguments(1) = "MOMENTX" this%electricField(1) = Matrix_getFromFile(rows=totalNumberOfContractions, & columns=totalNumberOfContractions, & @@ -370,7 +351,7 @@ subroutine WaveFunction_readElectricFieldMatrices(this, file) !! DEBUG if ( CONTROL_instance%DEBUG_SCFS) then - print *,"External electric field Matrix: ", trim(MolecularSystem_getNameOfSpecies(this%species)) + print *,"External electric field Matrix: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) call Matrix_show(this%electricField(1)) call Matrix_show(this%electricField(2)) call Matrix_show(this%electricField(3)) @@ -388,12 +369,12 @@ subroutine WaveFunction_readHarmonicOscillatorMatrix( this, file) integer :: totalNumberOfContractions character(10) :: arguments(2) - arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) !! Open file unit = 34 open(unit = unit, file=trim(file), status="old", form="unformatted") !! Get number of shells and number of cartesian contractions - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) + totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) arguments(1) = "HARMONIC" this%harmonic = Matrix_getFromFile(rows=totalNumberOfContractions, & columns=totalNumberOfContractions, & @@ -402,7 +383,7 @@ subroutine WaveFunction_readHarmonicOscillatorMatrix( this, file) !! DEBUG if ( CONTROL_instance%DEBUG_SCFS) then - print *,"Harmonic oscillator Matrix: ", trim(MolecularSystem_getNameOfSpecies(this%species)) + print *,"Harmonic oscillator Matrix: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) call Matrix_show(this%harmonic ) end if @@ -421,7 +402,7 @@ subroutine WaveFunction_buildTransformationMatrix(this, typeOfOrthogonalization integer :: i, j !! Numero de contracciones "totales" - numberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) + numberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) if ( numberOfContractions > 1) then call Vector_constructor( eigenValues, int(numberOfContractions) ) @@ -449,7 +430,7 @@ subroutine WaveFunction_buildTransformationMatrix(this, typeOfOrthogonalization end do if (this%removedOrbitals .gt. 0 .and. CONTROL_instance%PRINT_LEVEL .gt. 0) & write(*,"(A,I5,A,A,A,ES9.3)") "Removed ", this%removedOrbitals , " orbitals for species ", & - trim(MolecularSystem_getNameOfSpecies(this%species)), " with overlap eigen threshold of ", CONTROL_instance%OVERLAP_EIGEN_THRESHOLD + trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)), " with overlap eigen threshold of ", CONTROL_instance%OVERLAP_EIGEN_THRESHOLD !! !!**************************************************************** @@ -479,7 +460,7 @@ subroutine WaveFunction_buildTransformationMatrix(this, typeOfOrthogonalization !! DEBUG if ( CONTROL_instance%DEBUG_SCFS) then - print *,"Matriz de transformation: ", trim(MolecularSystem_getNameOfSpecies(this%species)) + print *,"Matriz de transformation: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) call Matrix_show(this%transformationMatrix) end if @@ -497,48 +478,42 @@ subroutine WaveFunction_buildHCoreMatrix(this) integer :: owner, owner_2 real(8) :: auxCharge real(8) :: auxOmega - integer :: numberOfContractions - integer :: totalNumberOfContractions - - !! Get number of shells and number of cartesian contractions - numberOfContractions = MolecularSystem_getNumberOfContractions(this%species) - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) !! Incluiding mass effect if ( CONTROL_instance%REMOVE_TRANSLATIONAL_CONTAMINATION ) then this%kineticMatrix%values = & this%kineticMatrix%values * & - ( 1.0_8/MolecularSystem_getMass(this%species) -1.0_8 / MolecularSystem_getTotalMass() ) + ( 1.0_8/MolecularSystem_getMass(this%species,this%molSys) -1.0_8 / MolecularSystem_getTotalMass(this%molSys) ) else this%kineticMatrix%values = & this%kineticMatrix%values / & - MolecularSystem_getMass(this%species) + MolecularSystem_getMass(this%species,this%molSys) end if !! Finite Nuclear Mass Correction if ( CONTROL_instance%FINITE_MASS_CORRECTION ) then k=1 - do particleID = 1, size(MolecularSystem_instance%species(this%species)%particles) - do contractionID = 1, size(MolecularSystem_instance%species(this%species)%particles(particleID)%basis%contraction) + do particleID = 1, size(this%molSys%species(this%species)%particles) + do contractionID = 1, size(this%molSys%species(this%species)%particles(particleID)%basis%contraction) - numberOfCartesiansOrbitals = MolecularSystem_instance%species(this%species)%particles(particleID)%basis%contraction(contractionID)%numCartesianOrbital - owner = MolecularSystem_instance%species(this%species)%particles(particleID)%basis%contraction(contractionID)%owner + numberOfCartesiansOrbitals = this%molSys%species(this%species)%particles(particleID)%basis%contraction(contractionID)%numCartesianOrbital + owner = this%molSys%species(this%species)%particles(particleID)%basis%contraction(contractionID)%owner do s = 1, numberOfCartesiansOrbitals l=k - do particleID_2 = 1, size(MolecularSystem_instance%species(this%species)%particles) - do contractionID_2 = 1, size(MolecularSystem_instance%species(this%species)%particles(particleID_2)%basis%contraction) + do particleID_2 = 1, size(this%molSys%species(this%species)%particles) + do contractionID_2 = 1, size(this%molSys%species(this%species)%particles(particleID_2)%basis%contraction) - numberOfCartesiansOrbitals_2 = MolecularSystem_instance%species(this%species)%particles(particleID_2)%basis%contraction(contractionID_2)%numCartesianOrbital - owner_2 = MolecularSystem_instance%species(this%species)%particles(particleID_2)%basis%contraction(contractionID_2)%owner + numberOfCartesiansOrbitals_2 = this%molSys%species(this%species)%particles(particleID_2)%basis%contraction(contractionID_2)%numCartesianOrbital + owner_2 = this%molSys%species(this%species)%particles(particleID_2)%basis%contraction(contractionID_2)%owner do r = 1, numberOfCartesiansOrbitals_2 if ( owner .eq. owner_2) then this%kineticMatrix%values(k,l)=& this%kineticMatrix%values(k,l)*& - ( 1 + MolecularSystem_getMass(this%species) / MolecularSystem_instance%species(this%species)%particles(particleID)%mass ) + ( 1 + MolecularSystem_getMass(this%species,this%molSys) / this%molSys%species(this%species)%particles(particleID)%mass ) this%kineticMatrix%values(l,k)=& this%kineticMatrix%values(k,l) @@ -555,7 +530,7 @@ subroutine WaveFunction_buildHCoreMatrix(this) end if !! Incluiding charge effect - auxcharge = MolecularSystem_getCharge(this%species) + auxcharge = MolecularSystem_getCharge(this%species,this%molSys) this%puntualInteractionMatrix%values = & this%puntualInteractionMatrix%values * (-auxCharge) @@ -578,17 +553,17 @@ subroutine WaveFunction_buildHCoreMatrix(this) !! Add harmonic oscillator potential 1/2 m omega**2 < \mu | r**2 | \nu > - auxOmega = MolecularSystem_getOmega(this%species) + auxOmega = MolecularSystem_getOmega(this%species,this%molSys) if ( auxOmega .ne. 0.0_8 ) then this%HCoreMatrix%values = this%HCoreMatrix%values + & - (1.0/2.0) * MolecularSystem_getMass( this%species ) * auxOmega**2 * this%harmonic%values + (1.0/2.0) * MolecularSystem_getMass(this%species,this%molSys) * auxOmega**2 * this%harmonic%values end if !! DEBUG if ( CONTROL_instance%DEBUG_SCFS) then - print *,"Matriz de hcore: ", trim(MolecularSystem_getNameOfSpecies(this%species)) + print *,"Matriz de hcore: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) call Matrix_show(this%HCoreMatrix) end if @@ -604,7 +579,7 @@ subroutine WaveFunction_obtainEnergyComponentsForSpecies(this) integer :: otherSpeciesID real(8) :: auxCharge - auxcharge = MolecularSystem_getCharge(this%species) + auxcharge = MolecularSystem_getCharge(this%species,this%molSys) !! Remove the electric field matrix to calculate the energy components if ( sum(abs(CONTROL_instance%ELECTRIC_FIELD )) .ne. 0 ) then @@ -659,7 +634,7 @@ subroutine WaveFunction_obtainEnergyComponentsForSpecies(this) this%externalPotentialMatrix%values)) !! Calcula energia de acoplamiento por especies - do otherSpeciesID=1, MolecularSystem_instance%numberOfQuantumSpecies + do otherSpeciesID=1, this%molSys%numberOfQuantumSpecies if (this%species .ne. otherSpeciesID) then this%hartreeEnergy( otherSpeciesID ) = & sum( transpose( this%densityMatrix%values ) * & @@ -685,7 +660,7 @@ subroutine WaveFunction_obtainEnergyComponentsForSpecies(this) write(*,*)"COSMO energy contributions" - write(*,*)"Especie = ",trim(MolecularSystem_instance%species(this%species)%name) + write(*,*)"Especie = ",trim(this%molSys%species(this%species)%name) this%cosmoEnergy = & 0.5_8* (sum( transpose( this%densitymatrix%values ) * & @@ -720,7 +695,7 @@ subroutine WaveFunction_obtainEnergyComponentsForSpecies(this) ! print *, "__________________ ENERGY COMPONENTS _______________________" - ! print *, " Specie ", MolecularSystem_getNameOfSpecies(this%species) + ! print *, " Specie ", MolecularSystem_getNameOfSpecies(this%species,this%molSys) ! print *, " Total Energy =", this%totalEnergyForSpecies ! print *, " Indepent Specie Energy =", this%independentSpeciesEnergy ! print *, " Kinetic Energy =",this%kineticEnergy @@ -746,7 +721,6 @@ subroutine WaveFunction_cosmoHCoreMatrix(this,file) ! integer :: numberOfCartesiansOrbitals, numberOfCartesiansOrbitals_2 ! integer :: owner, owner_2 ! integer :: auxCharge - integer :: numberOfContractions integer :: totalNumberOfContractions character(10) :: arguments(2) @@ -754,12 +728,11 @@ subroutine WaveFunction_cosmoHCoreMatrix(this,file) unit = 44 open(unit = unit, file=trim(file), status="old", form="unformatted") - arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) !! Get number of shells and number of cartesian contractions - numberOfContractions = MolecularSystem_getNumberOfContractions(this%species) - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) + totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) !! Load electron potential vs clasical charges cosmo matrix @@ -770,7 +743,7 @@ subroutine WaveFunction_cosmoHCoreMatrix(this,file) ! DEBUG - ! print *,"Matriz cosmo1: ", trim(MolecularSystem_getNameOfSpecies(this%species)) + ! print *,"Matriz cosmo1: ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) ! call Matrix_show( this%cosmo1 ) !! Load clasical potential vs quantum charges cosmo matrix @@ -782,7 +755,7 @@ subroutine WaveFunction_cosmoHCoreMatrix(this,file) !! DEBUG - ! print *,"Matriz cosmo 4 ", trim(MolecularSystem_getNameOfSpecies(this%species)) + ! print *,"Matriz cosmo 4 ", trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) ! call Matrix_show( this%cosmo4 ) close(44) @@ -804,12 +777,12 @@ subroutine WaveFunction_readExternalPotentialMatrix(this, file) character(50) :: arguments(2) arguments(1) = "EXTERNAL_POTENTIAL" - arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species)) + arguments(2) = trim(MolecularSystem_getNameOfSpecies(this%species,this%molSys)) !! Open file unit = 34 open(unit = unit, file=trim(file), status="old", form="unformatted") !! Get number of shells and number of cartesian contractions - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) + totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) this%externalPotentialMatrix = Matrix_getFromFile(rows=totalNumberOfContractions, & columns=totalNumberOfContractions, & unit=unit, binary=.true., arguments=arguments(1:2)) @@ -841,13 +814,14 @@ end subroutine WaveFunction_readExternalPotentialMatrix !> !! @brief Builds two-particles matrix. - subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN, twoParticlesMatrixOUT ) + subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN, twoParticlesMatrixOUT, Libint2Objects ) implicit none type(WaveFunction) :: this type(Matrix), optional :: densityMatrixIN real(8), optional :: factorIN type(Matrix), optional :: twoParticlesMatrixOUT - + type(Libint2Interface), optional :: Libint2Objects(:) + real(8) :: coulomb real(8) :: exchange real(8) :: factor @@ -871,8 +845,8 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN integer :: nthreads integer :: threadid integer :: unitid - - totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) + + totalNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) call Matrix_constructor(densityMatrix, int(totalNumberOfContractions,8), int(totalNumberOfContractions,8), 0.0_8 ) if ( present(densityMatrixIN)) then @@ -882,15 +856,15 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN end if if ( present(factorIN)) then - factor = MolecularSystem_getFactorOfExchangeIntegrals(this%species)*factorIN + factor = MolecularSystem_getFactorOfExchangeIntegrals(this%species,this%molSys)*factorIN else - factor = MolecularSystem_getFactorOfExchangeIntegrals(this%species)*this%exactExchangeFraction + factor = MolecularSystem_getFactorOfExchangeIntegrals(this%species,this%molSys)*this%exactExchangeFraction end if call Matrix_constructor(twoParticlesMatrix, int(totalNumberOfContractions,8), int(totalNumberOfContractions,8), 0.0_8 ) !! This matrix is only calculated if there are more than one particle for this%species or if the user want to calculate it. - if ( MolecularSystem_getNumberOfParticles(this%species) > 1 .or. CONTROL_instance%BUILD_TWO_PARTICLES_MATRIX_FOR_ONE_PARTICLE ) then + if ( MolecularSystem_getNumberOfParticles(this%species,this%molSys) > 1 .or. CONTROL_instance%BUILD_TWO_PARTICLES_MATRIX_FOR_ONE_PARTICLE ) then if ( CONTROL_instance%INTEGRAL_STORAGE == "DISK" ) then @@ -902,7 +876,7 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN write(fileid,*) threadid fileid = trim(adjustl(fileid)) - if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(this%species)%isElectron) then + if(CONTROL_instance%IS_OPEN_SHELL .and. this%molSys%species(this%species)%isElectron) then open( UNIT=unitid,FILE=trim(fileid)//"E-ALPHA.ints", status='old', access='stream', form='Unformatted') else open( UNIT=unitid,FILE=trim(fileid)//trim(this%name)//".ints", status='old', access='stream', form='Unformatted') @@ -1072,7 +1046,7 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN end do if ( .not. InterPotential_instance%isInstanced) & - twoParticlesMatrix%values=twoParticlesMatrix%values*(MolecularSystem_getCharge(speciesID=this%species))**2.0_8 + twoParticlesMatrix%values=twoParticlesMatrix%values*(MolecularSystem_getCharge(this%species,this%molSys))**2.0_8 else if ( CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then @@ -1116,27 +1090,52 @@ subroutine WaveFunction_buildTwoParticlesMatrix( this, densityMatrixIN, factorIN end do end do if ( .not. InterPotential_instance%isInstanced) & - twoParticlesMatrix%values=twoParticlesMatrix%values*(MolecularSystem_getCharge(speciesID=this%species))**2.0_8 + twoParticlesMatrix%values=twoParticlesMatrix%values*(MolecularSystem_getCharge(this%species,this%molSys))**2.0_8 else !! Direct if ( .not. InterPotential_instance%isInstanced) then !!regular integrals - call DirectIntegralManager_getDirectIntraRepulsionMatrix(& - this%species, & - trim(CONTROL_instance%INTEGRAL_SCHEME), & - densityMatrix, & - tmpTwoParticlesMatrix, & - factor) + if( present(Libint2Objects) ) then + call DirectIntegralManager_getDirectIntraRepulsionMatrix(& + this%species, & + trim(CONTROL_instance%INTEGRAL_SCHEME), & + densityMatrix, & + tmpTwoParticlesMatrix, & + factor, & + this%molSys, & + Libint2Objects(:)) + else + call DirectIntegralManager_getDirectIntraRepulsionMatrix(& + this%species, & + trim(CONTROL_instance%INTEGRAL_SCHEME), & + densityMatrix, & + tmpTwoParticlesMatrix, & + factor, & + this%molSys, & + Libint2Instance) + end if tmpTwoParticlesMatrix = & - tmpTwoParticlesMatrix * ( MolecularSystem_getCharge(speciesID=this%species ) )**2.0_8 + tmpTwoParticlesMatrix * ( MolecularSystem_getCharge(this%species,this%molSys) )**2.0_8 else !! G12 integrals - call DirectIntegralManager_getDirectIntraRepulsionG12Matrix(& - this%species, & - densityMatrix, & - tmpTwoParticlesMatrix, & - factor) + if( present(Libint2Objects) ) then + call DirectIntegralManager_getDirectIntraRepulsionG12Matrix(& + this%species, & + densityMatrix, & + tmpTwoParticlesMatrix, & + factor,& + this%molSys, & + Libint2Objects(:)) + else + call DirectIntegralManager_getDirectIntraRepulsionG12Matrix(& + this%species, & + densityMatrix, & + tmpTwoParticlesMatrix, & + factor,& + this%molSys, & + Libint2Instance) + end if end if twoParticlesMatrix%values = tmpTwoParticlesMatrix @@ -1161,13 +1160,14 @@ end subroutine WaveFunction_buildTwoParticlesMatrix !> !! @brief Builds the coupling matrix for the selected speciesID. - subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN, couplingMatrixOUT, hartreeMatricesOUT ) + subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN, couplingMatrixOUT, hartreeMatricesOUT, Libint2Objects) implicit none type(WaveFunction) :: these(*) integer :: speciesID type(Matrix), optional :: densityMatricesIN(*) type(Matrix), optional :: couplingMatrixOUT type(Matrix), optional :: hartreeMatricesOUT(*) + type(Libint2Interface), optional :: Libint2Objects(:) character(30) :: nameOfSpecies character(30) :: nameOfOtherSpecies @@ -1199,8 +1199,8 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN nameOfSpecies=these(speciesID)%name - numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies() - numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID) + numberOfSpecies=MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys) + numberOfContractions = MolecularSystem_getTotalNumberOfContractions(speciesID,these(1)%molSys) allocate(densityMatrices(numberOfSpecies)) allocate(hartreeMatrices(numberOfSpecies)) @@ -1238,8 +1238,8 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN do otherSpeciesID = 1, numberOfSpecies - nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID ) - OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID) + nameOfOtherSpecies = MolecularSystem_getNameOfSpecies(otherSpeciesID,these(otherSpeciesID)%molSys) + OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,these(otherSpeciesID)%molSys) !! Restringe suma de terminos repulsivos de la misma especie. if ( otherSpeciesID .eq. speciesID ) cycle @@ -1252,14 +1252,14 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN !! open file for integrals if(CONTROL_instance%IS_OPEN_SHELL .and. & - MolecularSystem_instance%species(speciesID)%isElectron .and. & - MolecularSystem_instance%species(otherSpeciesID)%isElectron ) then + these(speciesID)%molSys%species(speciesID)%isElectron .and. & + these(speciesID)%molSys%species(otherSpeciesID)%isElectron ) then open(UNIT=unitid,FILE=trim(fileid)//"E-ALPHA.E-BETA.ints", & STATUS='OLD', ACCESS='stream', FORM='Unformatted') - else if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(otherSpeciesID)%isElectron) then + else if(CONTROL_instance%IS_OPEN_SHELL .and. these(speciesID)%molSys%species(otherSpeciesID)%isElectron) then open(UNIT=unitid,FILE=trim(fileid)//"E-ALPHA."//trim(nameOfSpecies)//".ints", & STATUS='OLD', ACCESS='stream', FORM='Unformatted') - else if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(speciesID)%isElectron) then + else if(CONTROL_instance%IS_OPEN_SHELL .and. these(speciesID)%molSys%species(speciesID)%isElectron) then open(UNIT=unitid,FILE=trim(fileid)//trim(nameOfOtherSpecies)//".E-ALPHA.ints", & STATUS='OLD', ACCESS='stream', FORM='Unformatted') else @@ -1296,7 +1296,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN close(unitid) if ( .not. InterPotential_instance%isInstanced) & - auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID ) * MolecularSystem_getCharge( otherSpeciesID ) + auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID,these(speciesID)%molSys ) * MolecularSystem_getCharge( otherSpeciesID,these(otherSpeciesID)%molSys ) do i = 1 , numberOfContractions do j = i , numberOfContractions @@ -1312,14 +1312,14 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN !! open file for integrals if(CONTROL_instance%IS_OPEN_SHELL .and. & - MolecularSystem_instance%species(speciesID)%isElectron .and. & - MolecularSystem_instance%species(otherSpeciesID)%isElectron ) then + these(speciesID)%molSys%species(speciesID)%isElectron .and. & + these(speciesID)%molSys%species(otherSpeciesID)%isElectron ) then open(UNIT=unitid,FILE=trim(fileid)//"E-ALPHA.E-BETA.ints", & STATUS='OLD', ACCESS='stream', FORM='Unformatted') - else if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(otherSpeciesID)%isElectron) then + else if(CONTROL_instance%IS_OPEN_SHELL .and. these(speciesID)%molSys%species(otherSpeciesID)%isElectron) then open(UNIT=unitid,FILE=trim(fileid)//trim(nameOfSpecies)//".E-ALPHA.ints", & STATUS='OLD', ACCESS='stream', FORM='Unformatted') - else if(CONTROL_instance%IS_OPEN_SHELL .and. MolecularSystem_instance%species(speciesID)%isElectron) then + else if(CONTROL_instance%IS_OPEN_SHELL .and. these(speciesID)%molSys%species(speciesID)%isElectron) then open(UNIT=unitid,FILE=trim(fileid)//"E-ALPHA."//trim(nameOfOtherSpecies)//".ints", & STATUS='OLD', ACCESS='stream', FORM='Unformatted') else @@ -1356,7 +1356,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN close(unitid) if ( .not. InterPotential_instance%isInstanced) & - auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID ) * MolecularSystem_getCharge( otherSpeciesID ) + auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID,these(speciesID)%molSys ) * MolecularSystem_getCharge( otherSpeciesID,these(otherSpeciesID)%molSys ) do i = 1 , numberOfContractions do j = i , numberOfContractions @@ -1377,7 +1377,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN else if ( CONTROL_instance%INTEGRAL_STORAGE == "MEMORY" ) then do otherSpeciesID = 1, numberOfSpecies if ( otherSpeciesID .eq. speciesID ) cycle - OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID) + OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,these(otherSpeciesID)%molSys) !integral storage order if( speciesID < otherSpeciesID) then do v = 1 , numberOfContractions @@ -1424,7 +1424,8 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN end do end do if ( .not. InterPotential_instance%isInstanced) & - hartreeMatrices(otherSpeciesID)%values=hartreeMatrices(otherSpeciesID)%values*MolecularSystem_getCharge(speciesID)*MolecularSystem_getCharge(otherSpeciesID) + hartreeMatrices(otherSpeciesID)%values=hartreeMatrices(otherSpeciesID)%values*& + MolecularSystem_getCharge(speciesID,these(speciesID)%molSys)*MolecularSystem_getCharge(otherSpeciesID,these(otherSpeciesID)%molSys) end do @@ -1436,19 +1437,42 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN if ( otherSpeciesID .eq. speciesID ) cycle if ( .not. InterPotential_instance%isInstanced) then !!regular integrals - call DirectIntegralManager_getDirectInterRepulsionMatrix(& - speciesID, OtherSpeciesID, & - trim(CONTROL_instance%INTEGRAL_SCHEME), & - densityMatrices(otherSpeciesID), & - auxMatrix ) + if(present(Libint2Objects)) then + call DirectIntegralManager_getDirectInterRepulsionMatrix(& + speciesID, OtherSpeciesID, & + trim(CONTROL_instance%INTEGRAL_SCHEME), & + densityMatrices(otherSpeciesID), & + auxMatrix, & + these(speciesID)%molSys, & + Libint2Objects(:)) + else + call DirectIntegralManager_getDirectInterRepulsionMatrix(& + speciesID, OtherSpeciesID, & + trim(CONTROL_instance%INTEGRAL_SCHEME), & + densityMatrices(otherSpeciesID), & + auxMatrix, & + these(speciesID)%molSys, & + Libint2Instance) + end if auxMatrix = auxMatrix * MolecularSystem_getCharge(speciesID ) * MolecularSystem_getCharge( otherSpeciesID ) else !! G12 integrals - call DirectIntegralManager_getDirectInterRepulsionG12Matrix(& - speciesID, OtherSpeciesID, & - densityMatrices(otherSpeciesID), & - auxMatrix ) + if(present(Libint2Objects)) then + call DirectIntegralManager_getDirectInterRepulsionG12Matrix(& + speciesID, OtherSpeciesID, & + densityMatrices(otherSpeciesID), & + auxMatrix, & + these(speciesID)%molSys, & + Libint2Objects(:)) + else + call DirectIntegralManager_getDirectInterRepulsionG12Matrix(& + speciesID, OtherSpeciesID, & + densityMatrices(otherSpeciesID), & + auxMatrix, & + these(speciesID)%molSys, & + Libint2Instance) + end if end if hartreeMatrices(otherSpeciesID)%values = & @@ -1473,7 +1497,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN end do end do - nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID ) + nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID,these(otherSpeciesID)%molSys ) if ( nameOfOtherSpecies .ne. CONTROL_instance%SCF_GHOST_SPECIES ) & couplingMatrix%values = couplingMatrix%values + hartreeMatrices(otherSpeciesID)%values @@ -1500,7 +1524,7 @@ subroutine WaveFunction_buildCouplingMatrix( these, speciesID, densityMatricesIN if ( CONTROL_instance%DEBUG_SCFS) then do otherSpeciesID = 1, numberOfSpecies if ( otherSpeciesID .eq. speciesID ) cycle - nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID ) + nameOfOtherSpecies = MolecularSystem_getNameOfSpecies( otherSpeciesID,these(otherSpeciesID)%molSys ) write(*,*) "Hartree Matrix for: ", trim(nameOfSpecies), trim(nameOfOtherSpecies) call Matrix_show( these(speciesID)%hartreeMatrix(otherSpeciesID) ) end do @@ -1533,8 +1557,8 @@ subroutine WaveFunction_readExchangeCorrelationMatrix( this, excFileIN, & character(50) :: labels(2) integer :: excUnit - numberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species) - numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies() + numberOfContractions = MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys) + numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(this%molSys) allocate(exchangeCorrelationEnergy(numberOfSpecies)) !! Open file from dft and read matrices @@ -1556,7 +1580,7 @@ subroutine WaveFunction_readExchangeCorrelationMatrix( this, excFileIN, & binary=.true., arguments=labels(1:2)) do otherSpeciesID = this%species, numberOfSpecies - otherNameOfSpecies=trim(MolecularSystem_getNameOfSpecies(otherSpeciesID)) + otherNameOfSpecies=trim(MolecularSystem_getNameOfSpecies(otherSpeciesID,this%molSys)) labels(1) = "EXCHANGE-CORRELATION-ENERGY" labels(2) = trim(this%name)//trim(otherNameOfSpecies) call Vector_getFromFile(unit=excUnit, binary=.true., value=exchangeCorrelationEnergy(otherSpeciesID), arguments= labels ) @@ -1587,10 +1611,11 @@ end subroutine WaveFunction_readExchangeCorrelationMatrix !> !! @brief Builds exchange correlation contributions Matrix for DFT calculations (FELIX) - subroutine WaveFunction_getDFTContributions( these, status, densityMatricesIN, & + subroutine WaveFunction_getDFTContributions( these, DFTGrids, DFTGridCommonPoints, status, densityMatricesIN, & exchangeCorrelationMatricesOUT, exchangeCorrelationEnergyOUT, particlesInGridOUT ) implicit none type(WaveFunction) :: these(*) + type(Grid) :: DFTGrids(:), DFTGridCommonPoints(:,:) character(*) :: status type(Matrix), optional :: densityMatricesIN(*) type(Matrix), optional :: exchangeCorrelationMatricesOUT(*) @@ -1602,7 +1627,7 @@ subroutine WaveFunction_getDFTContributions( these, status, densityMatricesIN, & type(Matrix) :: energyMatrix integer :: numberOfSpecies, i,j - numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies() + numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys) allocate(densityMatrices(numberOfSpecies), exchangeCorrelationMatrices(numberOfSpecies), particlesInGrid(numberOfSpecies)) if ( present(densityMatricesIN)) then @@ -1618,7 +1643,7 @@ subroutine WaveFunction_getDFTContributions( these, status, densityMatricesIN, & call Matrix_constructor(energyMatrix, int(numberOfSpecies,8), int(numberOfSpecies,8), 0.0_8 ) if (status .eq. "SCF" ) then - call DensityFunctionalTheory_SCFDFT(densityMatrices, & + call DensityFunctionalTheory_SCFDFT(DFTGrids, DFTGridCommonPoints, densityMatrices, & exchangeCorrelationMatrices, & energyMatrix, & particlesInGrid) @@ -1631,9 +1656,9 @@ subroutine WaveFunction_getDFTContributions( these, status, densityMatricesIN, & energyMatrix%values(i,j)=these(i)%exchangeCorrelationEnergy(j) end do end do - call DensityFunctionalTheory_buildFinalGrid() + call DensityFunctionalTheory_buildFinalGrid(DFTGrids, DFTGridCommonPoints, these(1)%molSys) - call DensityFunctionalTheory_finalDFT(densityMatrices, & + call DensityFunctionalTheory_finalDFT(DFTGrids, DFTGridCommonPoints,densityMatrices, & exchangeCorrelationMatrices, & energyMatrix, & particlesInGrid) @@ -1712,7 +1737,7 @@ subroutine WaveFunction_writeDensityMatricesToFile( these, densityFileOUT, densi integer :: densUnit character(50) :: labels(2) - numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies() + numberOfSpecies = MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys) allocate(densityMatrices(numberOfSpecies)) densUnit = 78 @@ -1728,7 +1753,7 @@ subroutine WaveFunction_writeDensityMatricesToFile( these, densityFileOUT, densi open(unit = densUnit, file=trim(densityFileOUT), status="replace", form="unformatted") labels(1) = "DENSITY-MATRIX" do speciesID = 1, numberOfSpecies - labels(2) = MolecularSystem_getNameOfSpecies(speciesID) + labels(2) = MolecularSystem_getNameOfSpecies(speciesID,these(speciesID)%molSys) call Matrix_writeToFile(densityMatrices(speciesID), unit=densUnit, binary=.true., arguments = labels ) call Matrix_destructor(densityMatrices(speciesID)) end do @@ -1815,7 +1840,7 @@ subroutine WaveFunction_buildDensityMatrix(this) orderMatrix = size( this%densityMatrix%values, DIM = 1 ) - ocupationNumber = MolecularSystem_getOcupationNumber(this%species) + ocupationNumber = MolecularSystem_getOcupationNumber(this%species,this%molSys) this%densityMatrix%values = 0.0_8 @@ -1842,7 +1867,7 @@ subroutine WaveFunction_buildDensityMatrix(this) end do end do - this%densityMatrix%values = MolecularSystem_getEta(this%species) * this%densityMatrix%values + this%densityMatrix%values = MolecularSystem_getEta(this%species,this%molSys) * this%densityMatrix%values !!DEBUG if ( CONTROL_instance%DEBUG_SCFS) then @@ -1910,7 +1935,7 @@ subroutine WaveFunction_obtainTotalEnergy( these, totalEnergy, totalCouplingEner cosmo3Energy = 0.0_8 !! Adicionado energia de interaccion entre particulas puntuales - totalEnergy = MolecularSystem_getPointChargesEnergy() + totalEnergy = MolecularSystem_getPointChargesEnergy(these(1)%molSys) !! cosmo potential nuclei-charges nuclei if(CONTROL_instance%COSMO)then @@ -1920,7 +1945,7 @@ subroutine WaveFunction_obtainTotalEnergy( these, totalEnergy, totalCouplingEner totalEnergy=totalEnergy+cosmo3Energy end if - do speciesID = 1, MolecularSystem_instance%numberOfQuantumSpecies + do speciesID = 1, these(1)%molSys%numberOfQuantumSpecies !! Calula enegia de especie independiente ( sin considerar el termino de acoplamiento ) these(speciesID)%independentSpeciesEnergy = & @@ -1958,8 +1983,8 @@ subroutine WaveFunction_obtainTotalEnergy( these, totalEnergy, totalCouplingEner end do !! Adicionar energia de acoplamiento y recalcula matrices de acoplamiento, including E-ALPHA/E-BETA - do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies() - do otherSpeciesID = speciesID+1, MolecularSystem_getNumberOfQuantumSpecies() + do speciesID = 1, MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys) + do otherSpeciesID = speciesID+1, MolecularSystem_getNumberOfQuantumSpecies(these(1)%molSys) totalCouplingEnergy = totalCouplingEnergy + (sum( transpose(these(speciesID)%densityMatrix%values) & * (these(speciesID)%hartreeMatrix(otherSpeciesID)%values))) totalEnergy = totalEnergy+these(speciesID)%exchangeCorrelationEnergy(otherSpeciesID) @@ -2220,7 +2245,7 @@ subroutine WaveFunction_buildCosmo2Matrix(this) integer:: auxLabelsOfContractions integer:: a, b, c - specieSelected=MolecularSystem_instance%species(this%species) + specieSelected=this%molSys%species(this%species) open(unit=110, file=trim(this%name)//"_qq.inn", status='old', form="unformatted") read(110)m @@ -2233,14 +2258,14 @@ subroutine WaveFunction_buildCosmo2Matrix(this) if(allocated(labels)) deallocate(labels) - allocate(labels(MolecularSystem_instance%species(this%species)%basisSetSize)) + allocate(labels(this%molSys%species(this%species)%basisSetSize)) if(allocated(ints_mat_aux)) deallocate(ints_mat_aux) - allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(this%species), MolecularSystem_getTotalNumberOfContractions(this%species))) + allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys), MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys))) if(allocated(cosmo2_aux)) deallocate(cosmo2_aux) - allocate(cosmo2_aux(MolecularSystem_getTotalNumberOfContractions(this%species), MolecularSystem_getTotalNumberOfContractions(this%species))) + allocate(cosmo2_aux(MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys), MolecularSystem_getTotalNumberOfContractions(this%species,this%molSys))) auxLabelsOfContractions = 1 @@ -2266,35 +2291,35 @@ subroutine WaveFunction_buildCosmo2Matrix(this) m = 0 ii = 0 - do g = 1, size(MolecularSystem_instance%species(this%species)%particles) - do h = 1, size(MolecularSystem_instance%species(this%species)%particles(g)%basis%contraction) + do g = 1, size(this%molSys%species(this%species)%particles) + do h = 1, size(this%molSys%species(this%species)%particles(g)%basis%contraction) hh = h ii = ii + 1 jj = ii - 1 - do i = g, size(MolecularSystem_instance%species(this%species)%particles) - do j = hh, size(MolecularSystem_instance%species(this%species)%particles(i)%basis%contraction) + do i = g, size(this%molSys%species(this%species)%particles) + do j = hh, size(this%molSys%species(this%species)%particles(i)%basis%contraction) jj = jj + 1 !!saving integrals on Matrix - do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(this%species)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1) - do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(this%species)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1) + do k = labels(ii), labels(ii) + (this%molSys%species(this%species)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1) + do l = labels(jj), labels(jj) + (this%molSys%species(this%species)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1) iii=0 - do gg = 1, size(MolecularSystem_instance%species(this%species)%particles) - do ll = 1, size(MolecularSystem_instance%species(this%species)%particles(gg)%basis%contraction) + do gg = 1, size(this%molSys%species(this%species)%particles) + do ll = 1, size(this%molSys%species(this%species)%particles(gg)%basis%contraction) hhh = ll iii = iii + 1 jjj = iii - 1 - do p = gg, size(MolecularSystem_instance%species(this%species)%particles) - do o = hhh, size(MolecularSystem_instance%species(this%species)%particles(p)%basis%contraction) + do p = gg, size(this%molSys%species(this%species)%particles) + do o = hhh, size(this%molSys%species(this%species)%particles(p)%basis%contraction) jjj = jjj + 1 !!saving integrals on Matrix - do pp = labels(iii), labels(iii) + (MolecularSystem_instance%species(this%species)%particles(gg)%basis%contraction(ll)%numCartesianOrbital - 1) - do oo = labels(jjj), labels(jjj) + (MolecularSystem_instance%species(this%species)%particles(p)%basis%contraction(o)%numCartesianOrbital - 1) + do pp = labels(iii), labels(iii) + (this%molSys%species(this%species)%particles(gg)%basis%contraction(ll)%numCartesianOrbital - 1) + do oo = labels(jjj), labels(jjj) + (this%molSys%species(this%species)%particles(p)%basis%contraction(o)%numCartesianOrbital - 1) m = m + 1 read(110)cosmo_int @@ -2369,12 +2394,12 @@ subroutine WaveFunction_buildCosmoCoupling(this) integer:: a, b, c - currentSpeciesID = MolecularSystem_getSpecieID( nameOfSpecie=this%name ) - numberOfContractions = MolecularSystem_getTotalNumberOfContractions(currentSpeciesID) - specieSelected=MolecularSystem_instance%species(currentSpeciesID) + currentSpeciesID = MolecularSystem_getSpecieID(this%name,this%molSys) + numberOfContractions = MolecularSystem_getTotalNumberOfContractions(currentSpeciesID,this%molSys) + specieSelected=this%molSys%species(currentSpeciesID) if(allocated(labels)) deallocate(labels) - allocate(labels(MolecularSystem_instance%species(currentSpeciesID)%basisSetSize)) + allocate(labels(this%molSys%species(currentSpeciesID)%basisSetSize)) this%cosmoCoupling%values(:,:)=0.0_8 @@ -2398,16 +2423,16 @@ subroutine WaveFunction_buildCosmoCoupling(this) end do - if( MolecularSystem_getNumberOfQuantumSpecies() > 1 ) then + if( MolecularSystem_getNumberOfQuantumSpecies(this%molSys) > 1 ) then this%cosmoCoupling%values = 0.0_8 - do speciesIterator = 1, MolecularSystem_getNumberOfQuantumSpecies() + do speciesIterator = 1, MolecularSystem_getNumberOfQuantumSpecies(this%molSys) otherSpeciesID = speciesIterator - nameOfOtherSpecie = MolecularSystem_getNameOfSpecies( otherSpeciesID ) - OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID) - otherSpecieSelected=MolecularSystem_instance%species(otherSpeciesID) + nameOfOtherSpecie = MolecularSystem_getNameOfSpecies(otherSpeciesID,this%molSys) + OtherNumberOfContractions = MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,this%molSys) + otherSpecieSelected=this%molSys%species(otherSpeciesID) if ( otherSpeciesID /= currentSpeciesID ) then @@ -2424,7 +2449,7 @@ subroutine WaveFunction_buildCosmoCoupling(this) if(allocated(otherLabels)) deallocate(otherLabels) - allocate(otherLabels(MolecularSystem_instance%species(otherSpeciesID)%basisSetSize)) + allocate(otherLabels(this%molSys%species(otherSpeciesID)%basisSetSize)) otherAuxLabelsOfContractions=1 @@ -2445,48 +2470,48 @@ subroutine WaveFunction_buildCosmoCoupling(this) if(allocated(ints_mat_aux)) deallocate(ints_mat_aux) - allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(otherSpeciesID), MolecularSystem_getTotalNumberOfContractions(otherSpeciesID))) + allocate(ints_mat_aux(MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,this%molSys), MolecularSystem_getTotalNumberOfContractions(otherSpeciesID,this%molSys))) ints_mat_aux=0.0_8 if(allocated(cosmoCoup_aux)) deallocate(cosmoCoup_aux) - allocate(cosmoCoup_aux(MolecularSystem_getTotalNumberOfContractions(currentSpeciesID), MolecularSystem_getTotalNumberOfContractions(currentSpeciesID))) + allocate(cosmoCoup_aux(MolecularSystem_getTotalNumberOfContractions(currentSpeciesID,this%molSys), MolecularSystem_getTotalNumberOfContractions(currentSpeciesID,this%molSys))) m = 0 ii = 0 - do g = 1, size(MolecularSystem_instance%species(currentSpeciesID)%particles) - do h = 1, size(MolecularSystem_instance%species(currentSpeciesID)%particles(g)%basis%contraction) + do g = 1, size(this%molSys%species(currentSpeciesID)%particles) + do h = 1, size(this%molSys%species(currentSpeciesID)%particles(g)%basis%contraction) hh = h ii = ii + 1 jj = ii - 1 - do i = g, size(MolecularSystem_instance%species(currentSpeciesID)%particles) - do j = hh, size(MolecularSystem_instance%species(currentSpeciesID)%particles(i)%basis%contraction) + do i = g, size(this%molSys%species(currentSpeciesID)%particles) + do j = hh, size(this%molSys%species(currentSpeciesID)%particles(i)%basis%contraction) jj = jj + 1 !!saving integrals on Matrix - do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(currentSpeciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1) - do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(currentSpeciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1) + do k = labels(ii), labels(ii) + (this%molSys%species(currentSpeciesID)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1) + do l = labels(jj), labels(jj) + (this%molSys%species(currentSpeciesID)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1) iii=0 - do gg = 1, size(MolecularSystem_instance%species(otherSpeciesID)%particles) - do ll = 1, size(MolecularSystem_instance%species(otherSpeciesID)%particles(gg)%basis%contraction) + do gg = 1, size(this%molSys%species(otherSpeciesID)%particles) + do ll = 1, size(this%molSys%species(otherSpeciesID)%particles(gg)%basis%contraction) hhh = ll iii = iii + 1 jjj = iii - 1 - do p = gg, size(MolecularSystem_instance%species(otherSpeciesID)%particles) - do o = hhh, size(MolecularSystem_instance%species(otherSpeciesID)%particles(p)%basis%contraction) + do p = gg, size(this%molSys%species(otherSpeciesID)%particles) + do o = hhh, size(this%molSys%species(otherSpeciesID)%particles(p)%basis%contraction) jjj = jjj + 1 !!saving integrals on Matrix - do pp = otherlabels(iii), otherlabels(iii) + (MolecularSystem_instance%species(otherSpeciesID)%particles(gg)%basis%contraction(ll)%numCartesianOrbital - 1) - do oo = otherlabels(jjj), otherlabels(jjj) + (MolecularSystem_instance%species(otherSpeciesID)%particles(p)%basis%contraction(o)%numCartesianOrbital - 1) + do pp = otherlabels(iii), otherlabels(iii) + (this%molSys%species(otherSpeciesID)%particles(gg)%basis%contraction(ll)%numCartesianOrbital - 1) + do oo = otherlabels(jjj), otherlabels(jjj) + (this%molSys%species(otherSpeciesID)%particles(p)%basis%contraction(o)%numCartesianOrbital - 1) m = m + 1 ! write(*,*)"m,cosmo_int(m),P_element,pp,oo",m,cosmo_int(m),wavefunction_instance(otherSpeciesID)%densityMatrix%values(pp,oo),pp,oo @@ -2550,7 +2575,8 @@ subroutine WaveFunction_buildCosmoCoupling(this) end subroutine WaveFunction_buildCosmoCoupling - subroutine WaveFunction_cosmoQuantumCharge() + subroutine WaveFunction_cosmoQuantumCharge(molSys) + type(MolecularSystem) :: molSys integer :: f,g,a,c,b integer :: m,k,l integer :: h,hh,i,ii,jj,j @@ -2591,18 +2617,18 @@ subroutine WaveFunction_cosmoQuantumCharge() ! write(*,*)"Cosmo Clasical Charges : ", qTotalCosmo(:) ! write(*,*)"sum Cosmo Clasical Charges : ", sum(qTotalCosmo(:)) - numberOfSpecies = MolecularSystem_instance%numberOfQuantumSpecies + numberOfSpecies = molSys%numberOfQuantumSpecies do f = 1, numberOfSpecies - specieSelected=MolecularSystem_instance%species(f) + specieSelected=molSys%species(f) if(allocated(labels)) deallocate(labels) - allocate(labels(MolecularSystem_instance%species(f)%basisSetSize)) + allocate(labels(molSys%species(f)%basisSetSize)) - orderOfMatrix = MolecularSystem_getTotalNumberOfContractions(f) + orderOfMatrix = MolecularSystem_getTotalNumberOfContractions(f,molSys) - arguments(2) = MolecularSystem_getNameOfSpecies(f) + arguments(2) = MolecularSystem_getNameOfSpecies(f,molSys) arguments(1) = "DENSITY" densityMatrix = & @@ -2626,23 +2652,23 @@ subroutine WaveFunction_cosmoQuantumCharge() end do end do - charges_file="cosmo"//trim( MolecularSystem_getNameOfSpecies( f ) )//".charges" + charges_file="cosmo"//trim( MolecularSystem_getNameOfSpecies( f,molSys ) )//".charges" open(unit=100, file=trim(charges_file), status='old', form="unformatted") read(100)m if(allocated(qiDensityCosmo)) deallocate(qiDensityCosmo) allocate(qiDensityCosmo(orderOfMatrix, orderOfMatrix,numberOfPointCharges)) ii = 0 - do g = 1, size(MolecularSystem_instance%species(f)%particles) - do h = 1, size(MolecularSystem_instance%species(f)%particles(g)%basis%contraction) + do g = 1, size(molSys%species(f)%particles) + do h = 1, size(molSys%species(f)%particles(g)%basis%contraction) hh = h ii = ii + 1 jj = ii - 1 - do i = g, size(MolecularSystem_instance%species(f)%particles) - do j = hh, size(MolecularSystem_instance%species(f)%particles(i)%basis%contraction) + do i = g, size(molSys%species(f)%particles) + do j = hh, size(molSys%species(f)%particles(i)%basis%contraction) jj = jj + 1 - do k = labels(ii), labels(ii) + (MolecularSystem_instance%species(f)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1) - do l = labels(jj), labels(jj) + (MolecularSystem_instance%species(f)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1) + do k = labels(ii), labels(ii) + (molSys%species(f)%particles(g)%basis%contraction(h)%numCartesianOrbital - 1) + do l = labels(jj), labels(jj) + (molSys%species(f)%particles(i)%basis%contraction(j)%numCartesianOrbital - 1) read(100)(qiCosmo(m),m=1,numberOfPointCharges) do m=1, numberOfPointCharges qiDensityCosmo(k, l, m) = densityMatrix%values(k,l)*qiCosmo(m) @@ -2670,7 +2696,7 @@ subroutine WaveFunction_cosmoQuantumCharge() end do ! write(*,*)"Cosmo Quantum Charges : ", qiCosmo(:) - write(*,*) "COSMO Charges for ",MolecularSystem_getNameOfSpecies( f )," = ", sum(qiCosmo(:)) + write(*,*) "COSMO Charges for ",MolecularSystem_getNameOfSpecies( f,molSys )," = ", sum(qiCosmo(:)) end do close(wfnUnit) @@ -2696,7 +2722,7 @@ subroutine Wavefunction_removeOrbitalsBelowEigenThreshold(this) real(8) :: normCheck integer :: i, j, mu, nu, index - numberOfContractions = MolecularSystem_getTotalnumberOfContractions(this%species) + numberOfContractions = MolecularSystem_getTotalnumberOfContractions(this%species,this%molSys) i=0 do index = 1 , numberOfContractions diff --git a/test/H2O.APMO.FCI.py b/test/H2O.APMO.FCI.py index e5bff62c..e59c55a6 100644 --- a/test/H2O.APMO.FCI.py +++ b/test/H2O.APMO.FCI.py @@ -18,14 +18,14 @@ refValues = { "HF energy" : [-75.895520937848,1E-8], "HF dipole" : [1.06383820,1E-7], -"HF quadrupole xx" : [-7.21841981,1E-7], -"HF quadrupole yy" : [-4.02024678,1E-7], -"HF quadrupole zz" : [-6.20812552,1E-7], +"HF quadrupole xx" : [-7.21841981,1E-6], +"HF quadrupole yy" : [-4.02024678,1E-6], +"HF quadrupole zz" : [-6.20812552,1E-6], "CI 1" : [-75.911063510564,1E-8], "CI dipole" : [1.01277057,1E-7], -"CI quadrupole xx" : [-7.26705299,1E-7], -"CI quadrupole yy" : [-4.21742308,1E-7], -"CI quadrupole zz" : [-6.30621482,1E-7] +"CI quadrupole xx" : [-7.26705299,1E-6], +"CI quadrupole yy" : [-4.21742308,1E-6], +"CI quadrupole zz" : [-6.30621482,1E-6] } testValues = dict(refValues) #copy diff --git a/test/HCl.ROCI-DFT.lowdin b/test/HCl.ROCI-DFT.lowdin new file mode 100644 index 00000000..5e08ce9b --- /dev/null +++ b/test/HCl.ROCI-DFT.lowdin @@ -0,0 +1,25 @@ +GEOMETRY + e-(Cl) CC-PVDZ 0.00 0.00 0.00 addParticles=0 + e-(H) CC-PVDZ 1.284 0.00 0.00 + Cl dirac 0.00 0.00 0.00 + H_1 DZSPNB 1.284 0.00 0.00 +END GEOMETRY + +TASKS + method = "RKS" + nonOrthogonalConfigurationInteraction=.T. +END TASKS + +CONTROL + computeROCIformula=.T. + rotationAroundZMaxAngle=35 + rotationAroundZStep=5 + numberOfCIStates=5 + electronExchangeCorrelationFunctional="B3LYP" + nuclearElectronCorrelationFunctional="epc17-2" + integralStorage="MEMORY" + gridStorage="MEMORY" + readCoefficients=.F. + nonElectronicLevelShifting=0.005 +END CONTROL + diff --git a/test/HCl.ROCI-DFT.py b/test/HCl.ROCI-DFT.py new file mode 100644 index 00000000..8b697004 --- /dev/null +++ b/test/HCl.ROCI-DFT.py @@ -0,0 +1,92 @@ +#!/usr/bin/env python +from __future__ import print_function +import os +import sys +from colorstring import * + +if len(sys.argv)==2: + lowdinbin = sys.argv[1] +else: + lowdinbin = "lowdin2" + +testName = sys.argv[0][:-3] +inputName = testName + ".lowdin" +outputName = testName + ".out" + +# Reference values and tolerance + +refValues = { +"KS energy" : [-460.740603426038,1E-6], +"CI 1" : [-460.763938669911,1E-6], +"CI 2" : [-460.763767549387,1E-6], +"H_1 Kin 1" : [0.004031326872,1E-6], +"H_1 Kin 2" : [0.004117680624,1E-6], +"E-/H_1 Corr 1" : [-0.026900321722,1E-4], +"E-/H_1 Corr 2" : [-0.026900318425,1E-4], +"scaled CI 1" : [-460.753068611851,1E-6], +"scaled CI 2" : [-460.752986688385,1E-6], +} + +testValues = dict(refValues) #copy +for value in testValues: #reset + testValues[value] = 0 #reset + +# Run calculation + +status = os.system(lowdinbin + " -i " + inputName) + +if status: + print(testName + str_red(" ... NOT OK")) + sys.exit(1) + +output = open(outputName, "r") +outputRead = output.readlines() + +# Values +stateFlag=0 +for i in range(0,len(outputRead)): + line = outputRead[i] + if "TOTAL ENERGY =" in line: + testValues["KS energy"] = float(line.split()[3]) + if "STATE: 1 ENERGY =" in line: + testValues["CI 1"] = float(line.split()[4]) + stateFlag=1 + if "STATE: 2 ENERGY =" in line: + testValues["CI 2"] = float(line.split()[4]) + stateFlag=2 + if "H_1 Kinetic energy =" in line: + if stateFlag == 1: + testValues["H_1 Kin 1"] = float(line.split()[4]) + elif stateFlag == 2: + testValues["H_1 Kin 2"] = float(line.split()[4]) + if "E-/H_1 DFTcorrelation energy =" in line: + if stateFlag == 1: + testValues["E-/H_1 Corr 1"] = float(line.split()[4]) + elif stateFlag == 2: + testValues["E-/H_1 Corr 2"] = float(line.split()[4]) + if "STATE: 3 ENERGY =" in line: + stateFlag = 3 + if "STATE: 1 SCALED ENERGY =" in line: + testValues["scaled CI 1"] = float(line.split()[5]) + stateFlag=1 + if "STATE: 2 SCALED ENERGY =" in line: + testValues["scaled CI 2"] = float(line.split()[5]) + stateFlag=2 + +passTest = True + +for value in refValues: + diffValue = abs(refValues[value][0] - testValues[value]) + if ( diffValue <= refValues[value][1] ): + passTest = passTest * True + else : + passTest = passTest * False + print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue)) + +if passTest : + print(testName + str_green(" ... OK")) +else: + print(testName + str_red(" ... NOT OK")) + sys.exit(1) + +output.close() diff --git a/test/HOO+.ROCI-HF.lowdin b/test/HOO+.ROCI-HF.lowdin new file mode 100644 index 00000000..0bd2a74a --- /dev/null +++ b/test/HOO+.ROCI-HF.lowdin @@ -0,0 +1,23 @@ +GEOMETRY + e-(O) CC-PVDZ 0.00 0.00 1.2274 addParticles=-1 multiplicity=3 + e-(O) CC-PVDZ 0.00 0.00 0.00 + e-(H) CC-PVDZ 0.9271944658 0.00 -0.4197943098 + O dirac 0.00 0.00 1.2274 + O dirac 0.00 0.00 0.00 + H_1 DZSPNB 0.9271944658 0.00 -0.4197943098 +END GEOMETRY + +TASKS + method = "UHF" + nonOrthogonalConfigurationInteraction=.T. +END TASKS + +CONTROL + computeROCIformula=.T. + rotationAroundZMaxAngle=40 + rotationAroundZStep=5 + numberOfCIStates=5 + integralStorage="MEMORY" + readCoefficients=.F. +END CONTROL + diff --git a/test/HOO+.ROCI-HF.py b/test/HOO+.ROCI-HF.py new file mode 100644 index 00000000..482a5afc --- /dev/null +++ b/test/HOO+.ROCI-HF.py @@ -0,0 +1,76 @@ +#!/usr/bin/env python +from __future__ import print_function +import os +import sys +from colorstring import * + +if len(sys.argv)==2: + lowdinbin = sys.argv[1] +else: + lowdinbin = "lowdin2" + +testName = sys.argv[0][:-3] +inputName = testName + ".lowdin" +outputName = testName + ".out" + +# Reference values and tolerance + +refValues = { +"HF energy" : [-149.774990836259,1E-8], +"CI 1" : [-149.784025139570,1E-7], +"CI 2" : [-149.783893009711,1E-7], +"H_1 Kin 1" : [0.010857088555,1E-7], +"H_1 Kin 2" : [0.010941452494,1E-7], +} + +testValues = dict(refValues) #copy +for value in testValues: #reset + testValues[value] = 0 #reset + +# Run calculation + +status = os.system(lowdinbin + " -i " + inputName) + +if status: + print(testName + str_red(" ... NOT OK")) + sys.exit(1) + +output = open(outputName, "r") +outputRead = output.readlines() + +# Values +stateFlag=0 +for i in range(0,len(outputRead)): + line = outputRead[i] + if "TOTAL ENERGY =" in line: + testValues["HF energy"] = float(line.split()[3]) + if "STATE: 1 ENERGY =" in line: + testValues["CI 1"] = float(line.split()[4]) + stateFlag=1 + if "STATE: 2 ENERGY =" in line: + testValues["CI 2"] = float(line.split()[4]) + stateFlag=2 + if "H_1 Kinetic energy =" in line: + if stateFlag == 1: + testValues["H_1 Kin 1"] = float(line.split()[4]) + elif stateFlag == 2: + testValues["H_1 Kin 2"] = float(line.split()[4]) + break + +passTest = True + +for value in refValues: + diffValue = abs(refValues[value][0] - testValues[value]) + if ( diffValue <= refValues[value][1] ): + passTest = passTest * True + else : + passTest = passTest * False + print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue)) + +if passTest : + print(testName + str_green(" ... OK")) +else: + print(testName + str_red(" ... NOT OK")) + sys.exit(1) + +output.close() diff --git a/test/PsCl-B3LYP-PSNAP.lowdin b/test/PsCl-B3LYP-PSNAP.lowdin new file mode 100644 index 00000000..668be420 --- /dev/null +++ b/test/PsCl-B3LYP-PSNAP.lowdin @@ -0,0 +1,20 @@ +SYSTEM_DESCRIPTION='Molecula de H2' + +GEOMETRY +e-(Cl) AUG-CC-PVTZ 0.0000 0.00000 0.0000 addParticles=1 +e+ PSX-TZ 0.0000 0.00000 0.0000 +Cl dirac 0.0000 0.00000 0.0000 +END GEOMETRY + +TASKS +method = "RKS" +END TASKS + +CONTROL +readCoefficients=.F. +electronExchangeCorrelationFunctional="B3LYP" +positronElectronCorrelationFunctional="PSNAP" +END CONTROL + + + diff --git a/test/PsCl-B3LYP-PSNAP.py b/test/PsCl-B3LYP-PSNAP.py new file mode 100644 index 00000000..fa1dd4e1 --- /dev/null +++ b/test/PsCl-B3LYP-PSNAP.py @@ -0,0 +1,62 @@ +#!/usr/bin/env python +from __future__ import print_function +import os +import sys +from colorstring import * + +if len(sys.argv)==2: + lowdinbin = sys.argv[1] +else: + lowdinbin = "lowdin2" + +testName = sys.argv[0][:-3] +inputName = testName + ".lowdin" +outputName = testName + ".out" + +# Reference values and tolerance + +refValues = { +"KS energy" : [-460.482424811788,1E-6], +"E+/E- Corr energy" : [-0.113810155630,1E-3], +} + +testValues = dict(refValues) #copy +for value in testValues: #reset + testValues[value] = 0 #reset + +# Run calculation + +status = os.system(lowdinbin + " -i " + inputName) + +if status: + print(testName + str_red(" ... NOT OK")) + sys.exit(1) + +output = open(outputName, "r") +outputRead = output.readlines() + +# Values +for i in range(0,len(outputRead)): + line = outputRead[i] + if "TOTAL ENERGY =" in line: + testValues["KS energy"] = float(line.split()[3]) + if "E-/POSITRON Corr. energy =" in line: + testValues["E+/E- Corr energy"] = float(line.split()[4]) + +passTest = True + +for value in refValues: + diffValue = abs(refValues[value][0] - testValues[value]) + if ( diffValue <= refValues[value][1] ): + passTest = passTest * True + else : + passTest = passTest * False + print("%s %.8f %.8f %.2e" % ( value, refValues[value][0], testValues[value], diffValue)) + +if passTest : + print(testName + str_green(" ... OK")) +else: + print(testName + str_red(" ... NOT OK")) + sys.exit(1) + +output.close() diff --git a/test/runtest.sh b/test/runtest.sh old mode 100644 new mode 100755