From f23bf415fdc01318eb357f5af261ea5990b1a0fb Mon Sep 17 00:00:00 2001 From: "Hrant P. Hratchian" Date: Fri, 15 Aug 2025 11:48:08 -0700 Subject: [PATCH 1/2] Updates to next revision number. --- .other_libs/build_fcns/configure.ac_FormCHK | 2 +- .../build_fcns/configure.ac_MatrixFile | 4 +- README.md | 4 +- releaseNotes.txt | 4 + src/mqc_FullWavefunction.F03 | 4 +- src/mqc_algebra.F03 | 4 +- src/mqc_algebra2.F03 | 4 +- src/mqc_binary.F03 | 4 +- src/mqc_datastructures.F03 | 4 +- src/mqc_est.F03 | 4 +- src/mqc_files.F03 | 4 +- src/mqc_gaussian.F03 | 5 +- src/mqc_general.F03 | 50 +++++++- src/mqc_general_lapack.F03 | 114 +++++++++++++++++- src/mqc_integrals.F03 | 4 +- src/mqc_interface.F03 | 4 +- src/mqc_matwrapper.F03 | 4 +- src/mqc_molecule.F03 | 4 +- 18 files changed, 189 insertions(+), 38 deletions(-) diff --git a/.other_libs/build_fcns/configure.ac_FormCHK b/.other_libs/build_fcns/configure.ac_FormCHK index d32528d2..304ba692 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.7.3], [hhratchian@ucmerced.edu]) +AC_INIT([MQC_Pack], [25.8.0], [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 f2fde709..5767d216 100644 --- a/.other_libs/build_fcns/configure.ac_MatrixFile +++ b/.other_libs/build_fcns/configure.ac_MatrixFile @@ -1,5 +1,5 @@ -AC_INIT([MQC_Pack], [25.7.3], [hhratchian@ucmerced.edu]) -AM_INIT_AUTOMAKE([foreign]) +AC_INIT([MQC_Pack], [25.8.0], [hhratchian@ucmerced.edu]) +AM_INIT_AUTOMAugust 1, 2025 AC_CONFIG_SRCDIR([src/mqc_general.F03]) AC_LANG([Fortran]) AC_PROG_CPP diff --git a/README.md b/README.md index 6407378e..94a2a4a6 100644 --- a/README.md +++ b/README.md @@ -16,8 +16,8 @@ ** ** ** The Merced Quantum Chemistry Package ** ** (MQCPack) ** - ** Version 25.7.3 ** - ** July 30, 2025 ** + ** Version 25.8.0 ** + ** August 1, 2025 ** ** ** ** ** ** Written By: ** diff --git a/releaseNotes.txt b/releaseNotes.txt index 6bf8f177..67a80eea 100644 --- a/releaseNotes.txt +++ b/releaseNotes.txt @@ -8,6 +8,10 @@ number updates will be documented here. Note that the minor version number will often be updated near the start of the month and the revision number in that case will be set to 0. +August 1, 2025 +* MQCPack version set to 25.8.0. +* Minor updates for printing logical arrays made to MQC_General. + July 30, 2025 * MQCPack version set to 25.7.3. * Several updates to MQC_Integrals. diff --git a/src/mqc_FullWavefunction.F03 b/src/mqc_FullWavefunction.F03 index 359ac83f..8a5016ce 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_algebra.F03 b/src/mqc_algebra.F03 index c9b9863e..81fa7bc3 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_algebra2.F03 b/src/mqc_algebra2.F03 index c3384304..dfbef967 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_binary.F03 b/src/mqc_binary.F03 index 787fc140..43148a7d 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_datastructures.F03 b/src/mqc_datastructures.F03 index ffb151c4..f4a6192e 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_est.F03 b/src/mqc_est.F03 index fde1be32..6901fcc5 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_files.F03 b/src/mqc_files.F03 index dac43bd2..51beb748 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_gaussian.F03 b/src/mqc_gaussian.F03 index 7ca7eec1..501fc135 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -351,7 +351,6 @@ Subroutine MQC_Gaussian_FChk_Open(FileInfo,FileName,UnitNumber, & Return End Subroutine MQC_Gaussian_FChk_Open - ! !PROCEDURE Find_FChk_Entry Subroutine Find_FChk_Entry(FChkFile,EntryTag,FoundEntry, & diff --git a/src/mqc_general.F03 b/src/mqc_general.F03 index 04401a96..14c727fc 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -179,9 +179,9 @@ subroutine mqc_version(major,minor,revision,versionString) character(len=*),OPTIONAL,intent(out)::versionString ! if(PRESENT(major)) major = 25 - if(PRESENT(minor)) minor = 7 - if(PRESENT(revision)) revision = 3 - if(PRESENT(versionString)) versionString = '25.7.3' + if(PRESENT(minor)) minor = 8 + if(PRESENT(revision)) revision = 0 + if(PRESENT(versionString)) versionString = '25.8.0' ! return end subroutine mqc_version @@ -1243,6 +1243,46 @@ Subroutine MQC_Print_Vector_Array_Complex(vector,iOut,Header,Blank_At_Top, & Return End Subroutine MQC_Print_Vector_Array_Complex +! +!PROCEDURE MQC_Print_Vector_Array_Logical + subroutine MQC_Print_Vector_Array_Logical(Vector,iOut,Header,Blank_At_Top, & + Blank_At_Bottom) +! +! This subroutine is used to print a Vector array type variable. +! +! H. P. Hratchian, 2025. +! +! +! Variable Declarations. + implicit none + integer(kind=int64),Intent(In)::IOut + logical,Dimension(:),Intent(In)::Vector + character(Len=*),Intent(In),Optional::Header + logical(kind=int64),Intent(In),Optional::Blank_At_Top,Blank_At_Bottom + integer(kind=int64)::I,Length + Character(Len=256)::FormatLine +! + 1000 Format(1x,A) + 1001 Format(1x,I7,2x,L14) + 1002 Format(1x,I7,2X,F14.6) + 1003 Format(1x,I7,2x,A) + 1020 Format(' ') +! + If(PRESENT(Blank_At_Top)) then + If(Blank_At_Top) Write(IOut,1020) + EndIf + if(Present(Header)) Write(IOut,1000) TRIM(Header) + Length = Size(Vector) + Do I = 1, Length + Write(IOut,1001) I, Vector(I) + EndDo + If(PRESENT(Blank_At_Bottom)) then + If(Blank_At_Bottom) Write(IOut,1020) + EndIf +! + Return + End Subroutine MQC_Print_Vector_Array_Logical + ! !PROCEDURE MQC_Print_R4Tensor_Array_Integer Subroutine MQC_Print_R4Tensor_Array_Integer(Array,iOut,Header,Blank_At_Top, & diff --git a/src/mqc_general_lapack.F03 b/src/mqc_general_lapack.F03 index 81d74925..155413fa 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -114,7 +114,6 @@ subroutine mqc_dsyev_eigensystem_symmFull(matrix,eigenValues,eigenVectors) return end subroutine mqc_dsyev_eigensystem_symmFull - ! !PROCEDURE mqc_dgeev_eigensystem_Full subroutine mqc_dgeev_eigensystem_Full(matrix,eigenValues, & @@ -318,3 +317,112 @@ end subroutine mqc_dgeev_eigensystem_Full ! return ! end subroutine mqc_eigensystem_symmFull !hph + + + +! +!PROCEDURE mqc_dgesvd_svd_Full + subroutine mqc_dgesvd_svd_Full(matrix,singularValues, & + leftSingularVectors,rightSingularVectorsT) +! +! This subroutine wraps the LAPACK SVD routine DGESVD for a general real +! rectangular matrix A. If the optional outputs are PRESENT, it returns full +! U (M×M) and full VT (N×N). +! +! H. P. Hratchian, 2025. +! + implicit none + real(kind=real64),dimension(:,:),intent(in)::matrix + real(kind=real64),dimension(:),allocatable,intent(out)::singularValues + real(kind=real64),dimension(:,:),allocatable,OPTIONAL,intent(out)::leftSingularVectors + real(kind=real64),dimension(:,:),allocatable,OPTIONAL,intent(out)::rightSingularVectorsT +! + integer::M,N,LDU,LDVT,INFO,LWORK + real(kind=real64),dimension(:,:),allocatable::matrixCopy + real(kind=real64),dimension(:),allocatable::Work + real(kind=real64),dimension(1)::WorkTmp + real(kind=real64),dimension(1,1)::Utmp,VTtmp + character(len=1)::JOBU,JOBVT +! +! Do initial checks and figure out dimensions for arrays needed below. Then +! allocate space and figure out a few LAPack flags. +! + M = SIZE(matrix,1) + N = SIZE(matrix,2) + Allocate(matrixCopy(M,N)) + matrixCopy = matrix + if(Allocated(singularValues)) then + if(SIZE(singularValues).ne.min(M,N)) then + DeAllocate(singularValues) + Allocate(singularValues(min(M,N))) + endIf + else + Allocate(singularValues(min(M,N))) + endIf + if(PRESENT(leftSingularVectors)) then + JOBU = 'A' + LDU = M + if(Allocated(leftSingularVectors)) then + if(SIZE(leftSingularVectors,1).ne.M.or.SIZE(leftSingularVectors,2).ne.M) then + DeAllocate(leftSingularVectors) + Allocate(leftSingularVectors(M,M)) + endIf + else + Allocate(leftSingularVectors(M,M)) + endIf + else + JOBU = 'N' + LDU = 1 + endIf + if(PRESENT(rightSingularVectorsT)) then + JOBVT = 'A' + LDVT = N + if(Allocated(rightSingularVectorsT)) then + if(SIZE(rightSingularVectorsT,1).ne.N.or.SIZE(rightSingularVectorsT,2).ne.N) then + DeAllocate(rightSingularVectorsT) + Allocate(rightSingularVectorsT(N,N)) + endIf + else + Allocate(rightSingularVectorsT(N,N)) + endIf + else + JOBVT = 'N' + LDVT = 1 + endIf +! +!----- Workspace query + INFO = 0 + if(JOBU.eq.'N') then + Utmp(1,1) = 0.0_real64 + endIf + if(JOBVT.eq.'N') then + VTtmp(1,1) = 0.0_real64 + endIf +! + call dgesvd(JOBU,JOBVT,M,N,matrixCopy,M,singularValues, & + merge(leftSingularVectors,Utmp, PRESENT(leftSingularVectors)),LDU, & + merge(rightSingularVectorsT,VTtmp, PRESENT(rightSingularVectorsT)),LDVT, & + WorkTmp,-1,INFO) + if(INFO.ne.0) call mqc_error( & + 'mqc_dgesvd_svd_Full: Failure in DGESVD getting WORK length.') +! +!----- Allocate optimal workspace and compute + LWORK = int(WorkTmp(1)) + if(LWORK.lt.1) LWORK = 1 + Allocate(Work(LWORK)) +! + call dgesvd(JOBU,JOBVT,M,N,matrixCopy,M,singularValues, & + merge(leftSingularVectors,Utmp, PRESENT(leftSingularVectors)),LDU, & + merge(rightSingularVectorsT,VTtmp, PRESENT(rightSingularVectorsT)),LDVT, & + Work,LWORK,INFO) + if(INFO.gt.0) then + call mqc_error('mqc_dgesvd_svd_Full: DGESVD did not converge.') + elseIf(INFO.lt.0) then + call mqc_error('mqc_dgesvd_svd_Full: Illegal argument in DGESVD call.') + endIf +! +!----- Cleanup + DeAllocate(matrixCopy,Work) + return + end subroutine mqc_dgesvd_svd_Full + diff --git a/src/mqc_integrals.F03 b/src/mqc_integrals.F03 index 02a3db52..a1a458dc 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_interface.F03 b/src/mqc_interface.F03 index f4892311..322b7203 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_matwrapper.F03 b/src/mqc_matwrapper.F03 index e0b9e040..6ed8b9d1 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_molecule.F03 b/src/mqc_molecule.F03 index 33d02046..d016ed1c 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.7.3 ** -! ** July 30, 2025 ** +! ** Version 25.8.0 ** +! ** August 1, 2025 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** From d101386f048c44118e06a9f1799db1ea81268412 Mon Sep 17 00:00:00 2001 From: "Hrant P. Hratchian" Date: Sat, 16 Aug 2025 11:35:30 -0700 Subject: [PATCH 2/2] Merged in code from Thompson Group and updated the version number to 25.8.0. --- .other_libs/build_fcns/configure.ac_MatrixFile | 2 +- releaseNotes.txt | 3 ++- src/mqc_general_lapack.F03 | 15 +++++---------- 3 files changed, 8 insertions(+), 12 deletions(-) diff --git a/.other_libs/build_fcns/configure.ac_MatrixFile b/.other_libs/build_fcns/configure.ac_MatrixFile index 5767d216..98ce5241 100644 --- a/.other_libs/build_fcns/configure.ac_MatrixFile +++ b/.other_libs/build_fcns/configure.ac_MatrixFile @@ -1,5 +1,5 @@ AC_INIT([MQC_Pack], [25.8.0], [hhratchian@ucmerced.edu]) -AM_INIT_AUTOMAugust 1, 2025 +AM_INIT_AUTOMAKE([foreign]) AC_CONFIG_SRCDIR([src/mqc_general.F03]) AC_LANG([Fortran]) AC_PROG_CPP diff --git a/releaseNotes.txt b/releaseNotes.txt index 67a80eea..08843560 100644 --- a/releaseNotes.txt +++ b/releaseNotes.txt @@ -8,9 +8,10 @@ number updates will be documented here. Note that the minor version number will often be updated near the start of the month and the revision number in that case will be set to 0. -August 1, 2025 +August 16, 2025 * MQCPack version set to 25.8.0. * Minor updates for printing logical arrays made to MQC_General. +* Merged in updates from the Thompson Group. July 30, 2025 * MQCPack version set to 25.7.3. diff --git a/src/mqc_general_lapack.F03 b/src/mqc_general_lapack.F03 index 155413fa..79476f21 100644 --- a/src/mqc_general_lapack.F03 +++ b/src/mqc_general_lapack.F03 @@ -389,15 +389,15 @@ subroutine mqc_dgesvd_svd_Full(matrix,singularValues, & JOBVT = 'N' LDVT = 1 endIf -! -!----- Workspace query INFO = 0 if(JOBU.eq.'N') then - Utmp(1,1) = 0.0_real64 + Utmp(1,1) = mqc_float(0) endIf if(JOBVT.eq.'N') then - VTtmp(1,1) = 0.0_real64 + VTtmp(1,1) = mqc_float(0) endIf +! +! Call LAPack routine DGESVD. ! call dgesvd(JOBU,JOBVT,M,N,matrixCopy,M,singularValues, & merge(leftSingularVectors,Utmp, PRESENT(leftSingularVectors)),LDU, & @@ -405,12 +405,9 @@ subroutine mqc_dgesvd_svd_Full(matrix,singularValues, & WorkTmp,-1,INFO) if(INFO.ne.0) call mqc_error( & 'mqc_dgesvd_svd_Full: Failure in DGESVD getting WORK length.') -! -!----- Allocate optimal workspace and compute LWORK = int(WorkTmp(1)) if(LWORK.lt.1) LWORK = 1 Allocate(Work(LWORK)) -! call dgesvd(JOBU,JOBVT,M,N,matrixCopy,M,singularValues, & merge(leftSingularVectors,Utmp, PRESENT(leftSingularVectors)),LDU, & merge(rightSingularVectorsT,VTtmp, PRESENT(rightSingularVectorsT)),LDVT, & @@ -420,9 +417,7 @@ subroutine mqc_dgesvd_svd_Full(matrix,singularValues, & elseIf(INFO.lt.0) then call mqc_error('mqc_dgesvd_svd_Full: Illegal argument in DGESVD call.') endIf -! -!----- Cleanup DeAllocate(matrixCopy,Work) +! return end subroutine mqc_dgesvd_svd_Full -