diff --git a/.other_libs/build_fcns/configure.ac_FormCHK b/.other_libs/build_fcns/configure.ac_FormCHK index 4d84c9ee..6ba8b451 100644 --- a/.other_libs/build_fcns/configure.ac_FormCHK +++ b/.other_libs/build_fcns/configure.ac_FormCHK @@ -1,4 +1,4 @@ -AC_INIT([MQC_Pack], [25.11.1], [hhratchian@ucmerced.edu]) +AC_INIT([MQC_Pack], [25.11.2], [hhratchian@ucmerced.edu]) AM_INIT_AUTOMAKE([foreign]) AC_CONFIG_SRCDIR([src/mqc_general.F03]) AC_PROG_CPP diff --git a/.other_libs/build_fcns/configure.ac_MatrixFile b/.other_libs/build_fcns/configure.ac_MatrixFile index 6890e5ff..8a5804f1 100644 --- a/.other_libs/build_fcns/configure.ac_MatrixFile +++ b/.other_libs/build_fcns/configure.ac_MatrixFile @@ -1,4 +1,4 @@ -AC_INIT([MQC_Pack], [25.11.1], [hhratchian@ucmerced.edu]) +AC_INIT([MQC_Pack], [25.11.2], [hhratchian@ucmerced.edu]) AM_INIT_AUTOMAKE([foreign]) AC_CONFIG_SRCDIR([src/mqc_general.F03]) AC_LANG([Fortran]) diff --git a/README.md b/README.md index 83be9214..ea36d04c 100644 --- a/README.md +++ b/README.md @@ -16,8 +16,8 @@ ** ** ** The Merced Quantum Chemistry Package ** ** (MQCPack) ** - ** Version 25.11.1 ** - ** November 10, 2025 ** + ** Version 25.11.2 ** + ** November 11, 2025 ** ** ** ** ** ** Written By: ** diff --git a/src/mqc_FullWavefunction.F03 b/src/mqc_FullWavefunction.F03 index 49a6c82c..dec450c7 100644 --- a/src/mqc_FullWavefunction.F03 +++ b/src/mqc_FullWavefunction.F03 @@ -11,8 +11,8 @@ module MQC_FullWavefunction ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_algebra.F03 b/src/mqc_algebra.F03 index 64a7891f..6d4bbc2b 100644 --- a/src/mqc_algebra.F03 +++ b/src/mqc_algebra.F03 @@ -43,8 +43,8 @@ Module MQC_Algebra ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_algebra2.F03 b/src/mqc_algebra2.F03 index 68f97f64..72f6dd04 100644 --- a/src/mqc_algebra2.F03 +++ b/src/mqc_algebra2.F03 @@ -12,8 +12,8 @@ Module MQC_Algebra2 ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_binary.F03 b/src/mqc_binary.F03 index 8cdd0016..ea9dadb7 100644 --- a/src/mqc_binary.F03 +++ b/src/mqc_binary.F03 @@ -10,8 +10,8 @@ module MQC_Binary ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_datastructures.F03 b/src/mqc_datastructures.F03 index d9599243..be36eca7 100644 --- a/src/mqc_datastructures.F03 +++ b/src/mqc_datastructures.F03 @@ -10,8 +10,8 @@ Module MQC_DataStructures ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_est.F03 b/src/mqc_est.F03 index 04303cc1..8c9a053f 100644 --- a/src/mqc_est.F03 +++ b/src/mqc_est.F03 @@ -38,8 +38,8 @@ Module MQC_EST ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_files.F03 b/src/mqc_files.F03 index d6e0cf39..87a1580f 100644 --- a/src/mqc_files.F03 +++ b/src/mqc_files.F03 @@ -10,8 +10,8 @@ Module MQC_Files ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_gaussian.F03 b/src/mqc_gaussian.F03 index a26e0e8a..8a55b5a8 100644 --- a/src/mqc_gaussian.F03 +++ b/src/mqc_gaussian.F03 @@ -10,8 +10,8 @@ Module MQC_Gaussian ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_general.F03 b/src/mqc_general.F03 index 8a18f79c..cd0b84b5 100644 --- a/src/mqc_general.F03 +++ b/src/mqc_general.F03 @@ -10,8 +10,8 @@ Module MQC_General ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -192,8 +192,8 @@ subroutine mqc_version(major,minor,revision,versionString) ! if(PRESENT(major)) major = 25 if(PRESENT(minor)) minor = 11 - if(PRESENT(revision)) revision = 1 - if(PRESENT(versionString)) versionString = '25.11.1' + if(PRESENT(revision)) revision = 2 + if(PRESENT(versionString)) versionString = '25.11.2' ! return end subroutine mqc_version diff --git a/src/mqc_general_lapack.F03 b/src/mqc_general_lapack.F03 index c645b06f..172c2fde 100644 --- a/src/mqc_general_lapack.F03 +++ b/src/mqc_general_lapack.F03 @@ -9,8 +9,8 @@ ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -240,85 +240,112 @@ subroutine mqc_dgeev_eigensystem_Full(matrix,eigenValues, & return end subroutine mqc_dgeev_eigensystem_Full -!hph -!! -!!PROCEDURE mqc_dsyev_eigensystem_symm -! subroutine mqc_dsyev_eigensystem_symm(matrix,eigenValues,eigenVectors) -!! -!! This subroutine wraps the LAPACK eigensystem routines for a symmetric -!! matrix in full/dense memory storage format. -!! -!! H. P. Hratchian, 2020 -!! -! implicit none -! real(kind=real64),dimension(:,:),intent(in)::matrix -! real(kind=real64),dimension(:),allocatable,intent(out)::eigenValues -! real(kind=real64),dimension(:,:),allocatable,OPTIONAL,intent(out)::eigenVectors -!! -! integer::i,N,INFO,LWORK -! real(kind=real64),dimension(:,:),allocatable::matrixCopy -! real(kind=real64),dimension(:),allocatable::Work -! real(kind=real64),dimension(1)::WorkTmp -! character(len=1)::JOBZ -!! -!! -!! Do some initial checking of matrix to ensure it's square. Next, figure out -!! the dimension of , . Then, allocate space for and -!! copy matrix into that space so that the LAPACK routine DSYEV can use this -!! space as working memory. Finally, allocate space for and, if -!! sent, . -!! -! if(SIZE(matrix,1).ne.SIZE(matrix,2)) call mqc_error( & -! 'mqc_eigensystem_symmMatrixFull: Rectangular matrix sent.') -! N = SIZE(matrix,1) -! Allocate(matrixCopy(N,N)) -! matrixCopy = matrix -! if(Allocated(eigenValues)) then -! if(SIZE(eigenValues).ne.N) then -! DeAllocate(eigenValues) -! Allocate(eigenValues(N)) -! endIf -! else -! Allocate(eigenValues(N)) -! endIf -! if(PRESENT(eigenVectors)) then -! JOBZ = 'V' -! if(Allocated(eigenVectors)) then -! if(SIZE(eigenVectors,1).ne.N.or.SIZE(eigenVectors,2).ne.N) then -! DeAllocate(eigenVectors) -! Allocate(eigenVectors(N,N)) -! endIf -! else -! Allocate(eigenVectors(N,N)) -! endIf -! else -! JOBZ = 'N' -! endIf -!! -!! Call LAPCK routine DSYEV. -!! -! call dsyev(JOBZ,'U',N,matrixCopy,N,eigenValues,WorkTmp,-1,INFO) -! if(INFO.ne.0) call mqc_error( & -! 'mqc_eigensystem_symmMatrixFull: Failure in DSYEV getting WORK length.') -! LWork = WorkTmp(1) -! Allocate(Work(LWork)) -! call dsyev(JOBZ,'U',N,matrixCopy,N,eigenValues,Work,LWork,INFO) -! if(INFO.ne.0) call mqc_error( & -! 'mqc_eigensystem_symmMatrixFull: Failure in DSYEV diagonalizing matrix.') -! if(PRESENT(eigenVectors)) then -! eigenVectors = matrixCopy -! do i = 1,N -! call mqc_vectorPhase(eigenVectors(:,i),.true.) -! endDo -! endIf -! -! deAllocate(matrixCopy,Work) -!! -! return -! end subroutine mqc_eigensystem_symmFull -!hph +! +!PROCEDURE mqc_dsyevr_eigensystem_symmFull + subroutine mqc_dsyevr_eigensystem_symmFull(matrix,eigenValues,eigenVectors) +! +! Wraps LAPACK DSYEVR to compute eigenvalues (and optionally eigenvectors) +! of a real symmetric matrix in full/dense storage. +! +! +! H. P. Hratchian, 2025. +! +! + implicit none + real(kind=real64),dimension(:,:),intent(in)::matrix + real(kind=real64),dimension(:),allocatable,intent(out)::eigenValues + real(kind=real64),dimension(:,:),allocatable,optional,intent(out)::eigenVectors +! + integer::i,N,INFO,LDA,LDZ,LWORK,LIWORK,M + character(len=1)::JOBZ + real(kind=real64)::ABSTOL + real(kind=real64),dimension(:,:),allocatable::matrixCopy,Zloc + real(kind=real64),dimension(:),allocatable::Work,Wtmp + integer,dimension(:),allocatable::IWork,IWtmp,ISUPPZ +! +! Quick checks and setup +! + if(SIZE(matrix,1).ne.SIZE(matrix,2)) call mqc_error( & + 'mqc_dsyevr_eigensystem_symmFull: Rectangular matrix sent.') + N = SIZE(matrix,1) + LDA = N +! +! Copy input so LAPACK can overwrite it. +! + allocate(matrixCopy(N,N)) + matrixCopy = matrix +! +! Prepare outputs... +! + if (allocated(eigenValues)) then + if (SIZE(eigenValues) .ne. N) then + deallocate(eigenValues) + allocate(eigenValues(N)) + end if + else + allocate(eigenValues(N)) + end if + if(present(eigenVectors)) then + JOBZ = 'V' + LDZ = N + if (allocated(eigenVectors)) then + if (SIZE(eigenVectors,1) .ne. N .or. SIZE(eigenVectors,2) .ne. N) then + deallocate(eigenVectors) + allocate(eigenVectors(N,N)) + end if + else + allocate(eigenVectors(N,N)) + end if + allocate(Zloc(N,N)) + else + JOBZ = 'N' + LDZ = 1 +! Minimal dummy Z to satisfy the interface (not referenced when JOBZ='N') + allocate(Zloc(1,1)) + end if +! +! ISUPPZ size: 2*max(1,M); we don't know M until after the call, but for +! RANGE='A' we have M=N. Allocate for N. +! + allocate(ISUPPZ(2*max(1,N))) +! +! Workspace check... +! + allocate(Wtmp(1), IWtmp(1)) + ABSTOL = 2.0_real64 * mqc_small + INFO = 0 + call dsyevr(JOBZ,'A','L',N,matrixCopy,LDA,0.0_real64,0.0_real64,0,0,& + ABSTOL,M,eigenValues,Zloc,LDZ,ISUPPZ,Wtmp,-1,IWtmp,-1,INFO) + if(INFO.ne.0) call mqc_error( & + & 'mqc_dsyevr_eigensystem_symmFull: Workspace query failed in DSYEVR.') + LWORK = int(Wtmp(1)) + LIWORK = IWtmp(1) + deallocate(Wtmp,IWtmp) + allocate(Work(LWORK),IWork(LIWORK)) +! +! Actual computation (RANGE='A' ⇒ all eigenpairs; eigenvalues ascending) +! + INFO = 0 + call dsyevr(JOBZ,'A','L',N,matrixCopy,LDA,0.0_real64,0.0_real64,0,0,& + ABSTOL,M,eigenValues,Zloc,LDZ,ISUPPZ,Work,LWORK,IWork,LIWORK,INFO) + if(INFO.ne.0) call mqc_error( & + 'mqc_dsyevr_eigensystem_symmFull: Failure in DSYEVR.') +! +! If vectors requested, return them (columns) and phase-normalize like DSYEV wrapper +! + if(present(eigenVectors)) then + eigenVectors = Zloc(:,1:M) ! here M should equal N for RANGE='A' + do i = 1,N + call mqc_vectorPhase(eigenVectors(:,i),.true.) + end do + end if +! Cleanup + deallocate(matrixCopy,Zloc,ISUPPZ,Work,IWork) +! + return + end subroutine mqc_dsyevr_eigensystem_symmFull ! !PROCEDURE mqc_dgesvd_svd_Full @@ -476,26 +503,28 @@ subroutine mqc_dgesv_mat(A,B,X,infoOut) LDB = N allocate(IPIV(N)) INFO = 0 - call dgesv(N, NRHS, Acopy, LDA, IPIV, Bcopy, LDB, INFO) + call dgesv(N,NRHS,Acopy,LDA,IPIV,Bcopy,LDB,INFO) ! ! Check for errors in the LAPack run. ! - if(present(infoOut)) infoOut = INFO - if(INFO.ne.0) & - call mqc_error('mqc_dgesv: DGESV failed (INFO /= 0).') + if(present(infoOut)) then + infoOut = INFO + if(INFO.ne.0) return + endIf + call mqc_error('mqc_dgesv_mat: DGESV failed (INFO /= 0).') ! ! Move Bcopy into the output argument X. Then, DeAllocate the temporary ! memory space this routine has allocated. ! X = Bcopy - deallocate(Acopy, Bcopy, IPIV) + deallocate(Acopy,Bcopy,IPIV) ! return end subroutine mqc_dgesv_mat !PROCEDURE mqc_dgesv_vec - subroutine mqc_dgesv_vec(A, b, x, infoOut) + subroutine mqc_dgesv_vec(A,b,x,infoOut) ! ! This routine is a wrapper for the LAPack routine DGESV for cases where the ! right hand side of the linear system of equations is a vector. @@ -544,19 +573,22 @@ subroutine mqc_dgesv_vec(A, b, x, infoOut) LDB = N allocate(IPIV(N)) INFO = 0 - call dgesv(N, NRHS, Acopy, LDA, IPIV, Bcopy, LDB, INFO) + call dgesv(N,NRHS,Acopy,LDA,IPIV,Bcopy,LDB,INFO) ! ! Check for errors in the LAPack run. ! - if(present(infoOut)) infoOut = INFO + if(present(infoOut)) then + infoOut = INFO + if(INFO.ne.0) return + endIf if(INFO.ne.0) & - call mqc_error('mqc_dgesv: DGESV failed (INFO /= 0).') + call mqc_error('mqc_dgesv_vec: DGESV failed (INFO /= 0).') ! ! Move Bcopy into the output argument X. Then, DeAllocate the temporary ! memory space this routine has allocated. ! x = Bcopy(:,1) - deallocate(Acopy, Bcopy, IPIV) + deallocate(Acopy,Bcopy,IPIV) ! return end subroutine mqc_dgesv_vec diff --git a/src/mqc_integrals.F03 b/src/mqc_integrals.F03 index 1211c7cd..5378fce2 100644 --- a/src/mqc_integrals.F03 +++ b/src/mqc_integrals.F03 @@ -10,8 +10,8 @@ module MQC_Integrals ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_interface.F03 b/src/mqc_interface.F03 index c2f60449..9fb1714d 100644 --- a/src/mqc_interface.F03 +++ b/src/mqc_interface.F03 @@ -9,8 +9,8 @@ ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_matwrapper.F03 b/src/mqc_matwrapper.F03 index a90273f8..70aa2335 100644 --- a/src/mqc_matwrapper.F03 +++ b/src/mqc_matwrapper.F03 @@ -11,8 +11,8 @@ Module MQC_MatWrapper ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_molecule.F03 b/src/mqc_molecule.F03 index e71ddc93..fd4373c7 100644 --- a/src/mqc_molecule.F03 +++ b/src/mqc_molecule.F03 @@ -31,8 +31,8 @@ Module MQC_Molecule ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 25.11.1 ** -! ** November 10, 2025 ** +! ** Version 25.11.2 ** +! ** November 11, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: **