From a16c89ef98018089a2d513181618ff2cf758112f Mon Sep 17 00:00:00 2001 From: "Hrant P. Hratchian" Date: Mon, 13 Jul 2026 23:26:10 -0700 Subject: [PATCH] Updates to 26.7.1, including writing characters to FAFs. --- .other_libs/build_fcns/configure.ac_FormCHK | 2 +- .../build_fcns/configure.ac_MatrixFile | 2 +- README.md | 2 +- releaseNotes.txt | 15 ++ src/mqc_FullWavefunction.F03 | 2 +- src/mqc_algebra.F03 | 2 +- src/mqc_algebra2.F03 | 2 +- src/mqc_binary.F03 | 2 +- src/mqc_datastructures.F03 | 2 +- src/mqc_est.F03 | 2 +- src/mqc_files.F03 | 2 +- src/mqc_gaussian.F03 | 242 +++++++++++++++-- src/mqc_general.F03 | 6 +- src/mqc_general_lapack.F03 | 2 +- src/mqc_integrals.F03 | 2 +- src/mqc_interface.F03 | 2 +- src/mqc_matwrapper.F03 | 249 ++++++++++++++++-- src/mqc_molecule.F03 | 2 +- 18 files changed, 477 insertions(+), 63 deletions(-) diff --git a/.other_libs/build_fcns/configure.ac_FormCHK b/.other_libs/build_fcns/configure.ac_FormCHK index 493aca3d..5819f371 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], [26.7.0], [hhratchian@ucmerced.edu]) +AC_INIT([MQC_Pack], [26.7.1], [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 4dcb1677..21610bb9 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], [26.7.0], [hhratchian@ucmerced.edu]) +AC_INIT([MQC_Pack], [26.7.1], [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 73aa3fca..4907d71b 100644 --- a/README.md +++ b/README.md @@ -16,7 +16,7 @@ ** ** ** The Merced Quantum Chemistry Package ** ** (MQCPack) ** - ** Version 26.7.0 ** + ** Version 26.7.1 ** ** July 13, 2026 ** ** ** ** ** diff --git a/releaseNotes.txt b/releaseNotes.txt index 0ddd6d12..e9a0c744 100644 --- a/releaseNotes.txt +++ b/releaseNotes.txt @@ -8,6 +8,21 @@ 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. +July 13, 2026 +* MQCPack version set to 26.7.1. +* Added support for writing character scalar and fixed-width vector + MQC_Variable objects to Gaussian FAF/MatrixFile files through + MQC_Gaussian_Unformatted_Matrix_File%writeArray2. +* Added support for reading character scalar and fixed-width vector + MQC_Variable objects from Gaussian FAF/MatrixFile files through + MQC_Gaussian_Unformatted_Matrix_File%getArray. +* Added character scalar and vector support to the mqc_print and + mqc_print_mqcvariable interfaces. +* Added defined assignment for MQC_Gaussian_Unformatted_Matrix_File objects, + copying persistent metadata while leaving the destination disconnected. +* Improved FAF character-record compatibility, layout handling, file-unit + cleanup, and Gaussian-scalar caching. + July 13, 2026 * MQCPack version set to 26.7.0. * Added character handling to MQC_Variable objects in MQC_Algebra2. diff --git a/src/mqc_FullWavefunction.F03 b/src/mqc_FullWavefunction.F03 index 141cc799..79b46877 100644 --- a/src/mqc_FullWavefunction.F03 +++ b/src/mqc_FullWavefunction.F03 @@ -11,7 +11,7 @@ module MQC_FullWavefunction ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_algebra.F03 b/src/mqc_algebra.F03 index 595dc0ef..40fab08b 100644 --- a/src/mqc_algebra.F03 +++ b/src/mqc_algebra.F03 @@ -43,7 +43,7 @@ Module MQC_Algebra ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_algebra2.F03 b/src/mqc_algebra2.F03 index 4a4cb097..bba03046 100644 --- a/src/mqc_algebra2.F03 +++ b/src/mqc_algebra2.F03 @@ -12,7 +12,7 @@ Module MQC_Algebra2 ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_binary.F03 b/src/mqc_binary.F03 index 25aa3dd5..11db4627 100644 --- a/src/mqc_binary.F03 +++ b/src/mqc_binary.F03 @@ -10,7 +10,7 @@ module MQC_Binary ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_datastructures.F03 b/src/mqc_datastructures.F03 index 5920dc4e..81e99aeb 100644 --- a/src/mqc_datastructures.F03 +++ b/src/mqc_datastructures.F03 @@ -10,7 +10,7 @@ Module MQC_DataStructures ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_est.F03 b/src/mqc_est.F03 index 4d4a8152..556f6d3c 100644 --- a/src/mqc_est.F03 +++ b/src/mqc_est.F03 @@ -38,7 +38,7 @@ Module MQC_EST ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_files.F03 b/src/mqc_files.F03 index 6b4a8c88..e0fddad5 100644 --- a/src/mqc_files.F03 +++ b/src/mqc_files.F03 @@ -10,7 +10,7 @@ Module MQC_Files ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_gaussian.F03 b/src/mqc_gaussian.F03 index 20185617..4976dcfb 100644 --- a/src/mqc_gaussian.F03 +++ b/src/mqc_gaussian.F03 @@ -10,7 +10,7 @@ Module MQC_Gaussian ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** @@ -67,6 +67,7 @@ Module MQC_Gaussian gaussianScalars_read=.false. character(len=1)::readWriteMode=' ' character(len=64)::LabFil=' ',GVers=' ',Title=' ' + type(MQC_MatrixFile_Layout)::matrixFileLayout integer,allocatable::natoms,nbasis,nbasisUse,icharge,multiplicity,nelectrons,icgu, & NFC,NFV,ITran,IDum9,NShlAO,NPrmAO,NShlDB,NPrmDB,NBTot integer,dimension(:),allocatable::atomicNumbers,atomTypes,basisFunction2Atom, & @@ -130,6 +131,19 @@ Module MQC_Gaussian ! !---------------------------------------------------------------- ! | +! OPERATOR INTERFACES | +! | +!---------------------------------------------------------------- +! +! +! Assignment interface (=). + interface assignment (=) + module procedure MQC_Gaussian_Unformatted_Matrix_Assign + end interface +! +! +!---------------------------------------------------------------- +! | ! MODULE VARIABLES/CONSTANTS | ! | !---------------------------------------------------------------- @@ -693,32 +707,40 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Close(fileinfo) ! ! This Routine is used to close a Gaussian unformatted matrix file. ! -! H. P. Hratchian, 2017. +! H. P. Hratchian, 2017, 2026. ! ! ! Variable Declarations. ! implicit none class(MQC_Gaussian_Unformatted_Matrix_File),intent(inout)::fileinfo + integer(kind=int64)::unitNumber ! ! ! Close the matrix file using the gauopen routines. ! - if(fileinfo%isOpen()) call Close_MatF(fileinfo%UnitNumber) + unitNumber = fileinfo%UnitNumber + if(fileinfo%isOpen()) then + call Close_MatF(unitNumber) + call MQC_setOff_unitNumbersOpened(unitNumber) + endIf fileinfo%filename = ' ' fileinfo%CurrentlyOpen = .false. fileinfo%UnitNumber = 0 fileinfo%declared = .false. fileinfo%header_read = .false. fileinfo%header_written = .false. + fileinfo%gaussianScalars_read = .false. fileinfo%readWriteMode = ' ' fileinfo%LabFil = ' ' fileinfo%GVers = ' ' fileinfo%Title = ' ' + fileinfo%matrixFileLayout = MQC_MatrixFile_Layout() if(allocated(fileinfo%atomicNumbers)) deallocate(fileinfo%atomicNumbers) if(allocated(fileinfo%atomTypes)) deallocate(fileinfo%atomTypes) if(allocated(fileinfo%basisFunction2Atom)) deallocate(fileinfo%basisFunction2Atom) if(allocated(fileinfo%IBasisFunctionType)) deallocate(fileinfo%IBasisFunctionType) + if(allocated(fileinfo%IgaussianScalars)) deallocate(fileinfo%IgaussianScalars) if(allocated(fileinfo%atomicCharges)) deallocate(fileinfo%atomicCharges) if(allocated(fileinfo%atomicWeights)) deallocate(fileinfo%atomicWeights) if(allocated(fileinfo%cartesians)) deallocate(fileinfo%cartesians) @@ -739,12 +761,99 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Close(fileinfo) if(allocated(fileinfo%NPrmDB)) deallocate(fileinfo%NPrmDB) if(allocated(fileinfo%NBTot)) deallocate(fileinfo%NBTot) if(allocated(fileinfo%gaussianScalars)) deallocate(fileinfo%gaussianScalars) - call MQC_setOff_unitNumbersOpened(fileinfo%UnitNumber) ! return end Subroutine MQC_Gaussian_Unformatted_Matrix_Close +!===================================================================== +! +!PROCEDURE MQC_Gaussian_Unformatted_Matrix_Assign + subroutine MQC_Gaussian_Unformatted_Matrix_Assign(fileinfoOut, & + fileinfoIn) +! +! Copy the persistent header and molecular metadata from one Gaussian +! unformatted matrix-file object to another. The output object is left +! disconnected so it can safely be associated with a different file. +! In particular, filename, unit number, open state, read/write mode, and +! header I/O state retain their default values. +! +! H. P. Hratchian, 2026. +! + implicit none + type(MQC_Gaussian_Unformatted_Matrix_File),intent(inout)::fileinfoOut + type(MQC_Gaussian_Unformatted_Matrix_File),intent(in)::fileinfoIn +! +! Clear any existing connection and data owned by the output object. +! + call fileinfoOut%closeFile() +! +! Copy fixed header and file-layout metadata. +! + fileinfoOut%gaussianScalars_read = fileinfoIn%gaussianScalars_read + fileinfoOut%LabFil = fileinfoIn%LabFil + fileinfoOut%GVers = fileinfoIn%GVers + fileinfoOut%Title = fileinfoIn%Title + fileinfoOut%matrixFileLayout = fileinfoIn%matrixFileLayout +! +! Copy allocatable header scalars and arrays. Intrinsic allocatable +! assignment gives the output object independent storage. +! + if(allocated(fileinfoIn%natoms)) & + fileinfoOut%natoms = fileinfoIn%natoms + if(allocated(fileinfoIn%nbasis)) & + fileinfoOut%nbasis = fileinfoIn%nbasis + if(allocated(fileinfoIn%nbasisUse)) & + fileinfoOut%nbasisUse = fileinfoIn%nbasisUse + if(allocated(fileinfoIn%icharge)) & + fileinfoOut%icharge = fileinfoIn%icharge + if(allocated(fileinfoIn%multiplicity)) & + fileinfoOut%multiplicity = fileinfoIn%multiplicity + if(allocated(fileinfoIn%nelectrons)) & + fileinfoOut%nelectrons = fileinfoIn%nelectrons + if(allocated(fileinfoIn%icgu)) & + fileinfoOut%icgu = fileinfoIn%icgu + if(allocated(fileinfoIn%NFC)) & + fileinfoOut%NFC = fileinfoIn%NFC + if(allocated(fileinfoIn%NFV)) & + fileinfoOut%NFV = fileinfoIn%NFV + if(allocated(fileinfoIn%ITran)) & + fileinfoOut%ITran = fileinfoIn%ITran + if(allocated(fileinfoIn%IDum9)) & + fileinfoOut%IDum9 = fileinfoIn%IDum9 + if(allocated(fileinfoIn%NShlAO)) & + fileinfoOut%NShlAO = fileinfoIn%NShlAO + if(allocated(fileinfoIn%NPrmAO)) & + fileinfoOut%NPrmAO = fileinfoIn%NPrmAO + if(allocated(fileinfoIn%NShlDB)) & + fileinfoOut%NShlDB = fileinfoIn%NShlDB + if(allocated(fileinfoIn%NPrmDB)) & + fileinfoOut%NPrmDB = fileinfoIn%NPrmDB + if(allocated(fileinfoIn%NBTot)) & + fileinfoOut%NBTot = fileinfoIn%NBTot + if(allocated(fileinfoIn%atomicNumbers)) & + fileinfoOut%atomicNumbers = fileinfoIn%atomicNumbers + if(allocated(fileinfoIn%atomTypes)) & + fileinfoOut%atomTypes = fileinfoIn%atomTypes + if(allocated(fileinfoIn%basisFunction2Atom)) & + fileinfoOut%basisFunction2Atom = fileinfoIn%basisFunction2Atom + if(allocated(fileinfoIn%IBasisFunctionType)) & + fileinfoOut%IBasisFunctionType = fileinfoIn%IBasisFunctionType + if(allocated(fileinfoIn%IgaussianScalars)) & + fileinfoOut%IgaussianScalars = fileinfoIn%IgaussianScalars + if(allocated(fileinfoIn%atomicCharges)) & + fileinfoOut%atomicCharges = fileinfoIn%atomicCharges + if(allocated(fileinfoIn%atomicWeights)) & + fileinfoOut%atomicWeights = fileinfoIn%atomicWeights + if(allocated(fileinfoIn%cartesians)) & + fileinfoOut%cartesians = fileinfoIn%cartesians + if(allocated(fileinfoIn%gaussianScalars)) & + fileinfoOut%gaussianScalars = fileinfoIn%gaussianScalars +! + return + end subroutine MQC_Gaussian_Unformatted_Matrix_Assign + + !===================================================================== ! !PROCEDURE MQC_Gaussian_Unformatted_Matrix_Read_Header @@ -767,7 +876,7 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Read_Header(fileinfo, & ! routine first. In that case, this routine will first call ! Routine MQC_Gaussian_Unformatted_Matrix_Open. ! -! H. P. Hratchian, 2017. +! H. P. Hratchian, 2017, 2026. ! ! ! Variable Declarations. @@ -779,7 +888,7 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Read_Header(fileinfo, & integer::iout=6 ! ! Temporary local variables used when calling the gauopen routines. - integer::IVers,NLab,Len12L,Len4L,IOpCl + integer(kind=int64)::IVers,NLab,Len12L,Len4L,IOpCl ! integer::NFC,NFV,ITran,IDum9,NShlAO,NPrmAO,NShlDB,NPrmDB,NBTot character(len=64)::cBuffer ! @@ -853,6 +962,7 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Read_Header(fileinfo, & fileinfo%natoms,fileinfo%nbasis,fileinfo%nbasisUse, & fileinfo%icharge,fileinfo%multiplicity,fileinfo%nelectrons,len12l, & len4l,iopcl,fileinfo%icgu) + call fileinfo%matrixFileLayout%set(IVers,NLab,Len12L,Len4L) call MQC_setOn_unitNumbersOpened(fileinfo%UnitNumber) allocate(fileinfo%atomicNumbers(fileinfo%natoms), & fileinfo%atomTypes(fileinfo%natoms), & @@ -902,6 +1012,7 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Write_Header(fileinfo, & ! the filename in fileinfo is used. ! ! L. M. Thompson, 2017. +! H. P. Hratchian, 2026. ! ! ! Variable Declarations. @@ -1066,6 +1177,7 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Write_Header(fileinfo, & fileinfo%natoms,fileinfo%nbasis,fileinfo%nbasisUse, & fileinfo%icharge,fileinfo%multiplicity,fileinfo%nelectrons,iopcl, & fileinfo%icgu) + call fileinfo%matrixFileLayout%setForWrite() ! call Wr_Head(fileinfo%unitNumber,fileinfo%natoms,nAt3,fileinfo%nbasis, & fileinfo%atomicNumbers,fileinfo%atomTypes,fileinfo%atomicCharges, & @@ -1115,7 +1227,7 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Read_Array(fileinfo, & ! label. Currently only implemented for the case '2ERIS-SYMSYMR4TENSOR' so ! that we can access Raffenetti 2 and Raffenetti 3 integrals. ! -! H. P. Hratchian, 2017, 2018. +! H. P. Hratchian, 2017, 2018, 2026. ! L. M. Thompson, 2017, 2020 ! ! Variable Declarations. @@ -1134,20 +1246,24 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Read_Array(fileinfo, & integer::iout=6 ! ! Temporary local variables used when calling the gauopen routines. - integer::IVers,NI,NR,NTot,LenBuf,N1,N2,N3,N4,N5,NRI,LR,TypeA + integer(kind=int64)::NI,NR,NTot,LenBuf,N1,N2,N3,N4,N5,NRI,LR,TypeA character(len=64)::cBuffer,tmpLabel logical::EOF,ASym ! ! Local temp variables. - integer::i,nOutputArrays,LNZ,myArrayNum + integer(kind=int64)::i,nOutputArrays,LNZ,myArrayNum,iCharacter, & + firstCharacter,lastCharacter ! integer,external::LenArr - integer,allocatable,dimension(:)::integerTmp + integer(kind=int64),allocatable,dimension(:)::integerTmp real,allocatable,dimension(:)::arrayTmp complex(kind=8),allocatable,dimension(:)::complexTmp + character(len=:),allocatable::characterBuffer + character(len=:),dimension(:),allocatable::characterTmp character(len=256)::my_filename,errorMsg logical::DEBUG=.false.,ok,found integer::nBasis real,allocatable,dimension(:,:,:,:)::arrayTmp2 + type(MQC_MatrixFile_Character_Record_Layout)::characterRecordLayout ! ! ! Format statements. @@ -1224,7 +1340,8 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Read_Array(fileinfo, & found = .false. outerLoop:do i = 1,2 EOF = .false. - Call Rd_Labl_TypeA(fileinfo%UnitNumber,IVers,cBuffer,NI,NR,NTot, & + Call Rd_Labl_TypeA(fileinfo%UnitNumber, & + fileinfo%matrixFileLayout%fileVersion,cBuffer,NI,NR,NTot, & LenBuf,N1,N2,N3,N4,N5,TypeA,NRI,EOF) ASym = TypeA.ne.0 LR = LenArr(N1,N2,N3,N4,N5) @@ -1261,6 +1378,34 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Read_Array(fileinfo, & MQC_Gaussian_Unformatted_Matrix_Array_Type(NI,NR,N1,N2,N3,N4,N5,NRI,ASym,TypeA) endIf select case(MQC_Gaussian_Unformatted_Matrix_Array_Type(NI,NR,N1,N2,N3,N4,N5,NRI,ASym,TypeA)) + case('CHARACTER') + if(.not.Present(mqcVarOut)) & + call mqc_error('Reading a character array from a Gaussian '// & + 'matrix file requires mqcVarOut.',6) + characterRecordLayout = & + MQC_MatrixFile_Get_Character_Record_Layout( & + fileinfo%matrixFileLayout,NTot,LenBuf,N1,N2,N3,N4,N5, & + TypeA) + allocate(character(len=characterRecordLayout%payloadCharacters):: & + characterBuffer) + call Rd_ChBuf(fileinfo%unitNumber, & + characterRecordLayout%payloadCharacters, & + characterRecordLayout%bufferCharacters,characterBuffer) + allocate(character(len=characterRecordLayout%elementWidth):: & + characterTmp(characterRecordLayout%elementCount)) + do iCharacter = 1,characterRecordLayout%elementCount + firstCharacter = (iCharacter-1)* & + characterRecordLayout%elementWidth+1 + lastCharacter = iCharacter*characterRecordLayout%elementWidth + characterTmp(iCharacter) = & + characterBuffer(firstCharacter:lastCharacter) + endDo + if(characterRecordLayout%elementCount.eq.1) then + mqcVarOut = characterTmp(1) + else + mqcVarOut = characterTmp + endIf + deallocate(characterTmp,characterBuffer) case('INTEGER-VECTOR') allocate(integerTmp(LR)) call Rd_IBuf(fileinfo%unitNumber,NTot,LenBuf,integerTmp) @@ -1558,9 +1703,23 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Read_Array(fileinfo, & found = .true. exit outerLoop elseIf(NTot.gt.0) then - Call Rd_Skip(fileinfo%UnitNumber,NTot,LenBuf) + if(NI.eq.1.and.NR.eq.0.and.TypeA.gt.0) then + characterRecordLayout = & + MQC_MatrixFile_Get_Character_Record_Layout( & + fileinfo%matrixFileLayout,NTot,LenBuf,N1,N2,N3,N4,N5, & + TypeA) + allocate(character(len=characterRecordLayout%payloadCharacters):: & + characterBuffer) + call Rd_ChBuf(fileinfo%unitNumber, & + characterRecordLayout%payloadCharacters, & + characterRecordLayout%bufferCharacters,characterBuffer) + deallocate(characterBuffer) + else + Call Rd_Skip(fileinfo%UnitNumber,NTot,LenBuf) + endIf endIf - Call Rd_Labl_TypeA(fileinfo%UnitNumber,IVers,cBuffer,NI,NR,NTot, & + Call Rd_Labl_TypeA(fileinfo%UnitNumber, & + fileinfo%matrixFileLayout%fileVersion,cBuffer,NI,NR,NTot, & LenBuf,N1,N2,N3,N4,N5,TypeA,NRI,EOF) ASym = TypeA.ne.0 LR = LenArr(N1,N2,N3,N4,N5) @@ -1615,7 +1774,7 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Write_Array2(fileinfo, & ! this routine will first call Routine MQC_Gaussian_Unformatted_Matrix_Open. ! ! L. M. Thompson, 2017. -! H. P. Hratchian, 2022. +! H. P. Hratchian, 2022, 2026. ! ! ! Variable Declarations. @@ -1629,12 +1788,11 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Write_Array2(fileinfo, & integer::iout=6 ! ! Temporary local variables used when calling the gauopen routines. - integer::LenBuf character(len=64)::tmpLabel ! ! Local temp variables. integer::i,nInputArrays - integer,parameter::IOne=1 + integer(kind=int64),parameter::IOne=1_int64,LenBuf=4000_int64 real,allocatable,dimension(:,:)::realMatrixTmp real,pointer,dimension(:)::realMatrixTmpV integer,allocatable,dimension(:,:)::intMatrixTmp @@ -1642,10 +1800,14 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Write_Array2(fileinfo, & real,allocatable,dimension(:)::realVectorTmp integer,allocatable,dimension(:)::intVectorTmp complex(kind=real64),allocatable,dimension(:)::compVectorTmp + character(len=:),allocatable::characterBuffer,characterScalarTmp + character(len=:),dimension(:),allocatable::characterVectorTmp type(MQC_Matrix)::matrixInUse + type(MQC_MatrixFile_Character_Record_Layout)::characterRecordLayout + integer(kind=int64)::characterElementCount,characterElementWidth, & + iCharacter,firstCharacter,lastCharacter character(len=256)::my_filename,my_storage logical::DEBUG=.false.,ok - Parameter(LenBuf=4000) ! ! Format statements. ! @@ -1707,6 +1869,51 @@ subroutine MQC_Gaussian_Unformatted_Matrix_Write_Array2(fileinfo, & call String_Change_Case(label,'u',tmpLabel) select case(MQC_Variable_getTypeCode(mqcVariable)) ! +! Character scalar or fixed-width vector. + case(4) + characterElementWidth = LEN(mqcVariable) + select case(RANK(mqcVariable)) + case(0) + characterElementCount = 1 + case(1) + characterElementCount = SIZE(mqcVariable) + case default + call mqc_error('Invalid character mqcVariable rank sent to '// & + 'MQC_Gaussian_Unformatted_Matrix_Write_Array2.') + end select + characterRecordLayout = & + MQC_MatrixFile_Get_Character_Write_Layout( & + fileinfo%matrixFileLayout,characterElementCount, & + characterElementWidth,LenBuf) + allocate(character(len=characterRecordLayout%payloadCharacters):: & + characterBuffer) + characterBuffer = REPEAT(' ', & + characterRecordLayout%payloadCharacters) + if(RANK(mqcVariable).eq.0) then + allocate(character(len=characterElementWidth)::characterScalarTmp) + characterScalarTmp = mqcVariable + characterBuffer = characterScalarTmp + deallocate(characterScalarTmp) + else + characterVectorTmp = mqcVariable + do iCharacter = 1,characterElementCount + firstCharacter = (iCharacter-1)*characterElementWidth+1 + lastCharacter = iCharacter*characterElementWidth + characterBuffer(firstCharacter:lastCharacter) = & + characterVectorTmp(iCharacter) + endDo + deallocate(characterVectorTmp) + endIf + call Wr_Labl_TypeA(fileinfo%unitNumber,TRIM(tmpLabel),1_int64, & + 0_int64,characterRecordLayout%payloadWords, & + characterRecordLayout%bufferWords, & + characterRecordLayout%payloadWords,1_int64,1_int64,1_int64, & + 1_int64,characterRecordLayout%elementWidth) + call Wr_ChBuf(fileinfo%unitNumber, & + characterRecordLayout%payloadCharacters, & + characterRecordLayout%bufferCharacters,characterBuffer) + deallocate(characterBuffer) +! ! Integer Array case(3) select case(RANK(mqcVariable)) @@ -5832,6 +6039,7 @@ Function MQC_Gaussian_Unformatted_Matrix_Get_Value_Real(fileinfo,label,fileName) if(Allocated(fileinfo%gaussianScalars)) & call MQC_Error('Logic error loading gaussianScalars.') fileinfo%gaussianScalars = mqcTmp + fileinfo%gaussianScalars_read = .true. endIf ! ! Do the work... diff --git a/src/mqc_general.F03 b/src/mqc_general.F03 index fd14788b..9a170261 100644 --- a/src/mqc_general.F03 +++ b/src/mqc_general.F03 @@ -10,7 +10,7 @@ Module MQC_General ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** @@ -215,8 +215,8 @@ subroutine mqc_version(major,minor,revision,versionString) ! if(PRESENT(major)) major = 26 if(PRESENT(minor)) minor = 7 - if(PRESENT(revision)) revision = 0 - if(PRESENT(versionString)) versionString = '26.7.0' + if(PRESENT(revision)) revision = 1 + if(PRESENT(versionString)) versionString = '26.7.1' ! return end subroutine mqc_version diff --git a/src/mqc_general_lapack.F03 b/src/mqc_general_lapack.F03 index 1f718d97..205ef145 100644 --- a/src/mqc_general_lapack.F03 +++ b/src/mqc_general_lapack.F03 @@ -9,7 +9,7 @@ ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_integrals.F03 b/src/mqc_integrals.F03 index 658c6f7b..ce8741c5 100644 --- a/src/mqc_integrals.F03 +++ b/src/mqc_integrals.F03 @@ -10,7 +10,7 @@ module MQC_Integrals ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_interface.F03 b/src/mqc_interface.F03 index 928ffb74..edcad365 100644 --- a/src/mqc_interface.F03 +++ b/src/mqc_interface.F03 @@ -9,7 +9,7 @@ ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** diff --git a/src/mqc_matwrapper.F03 b/src/mqc_matwrapper.F03 index 0cb02eed..f771275d 100644 --- a/src/mqc_matwrapper.F03 +++ b/src/mqc_matwrapper.F03 @@ -11,7 +11,7 @@ Module MQC_MatWrapper ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** ** @@ -33,11 +33,211 @@ Module MQC_MatWrapper use mqc_general use iso_fortran_env, only: int32, int64, real64 ! +! Matrix-file layout metadata... +! + type MQC_MatrixFile_Layout + integer(kind=int32)::integerBytes=0 + integer(kind=int64)::fileVersion=0 + integer(kind=int64)::nHeaderRecords=0 + integer(kind=int64)::len12Bytes=0 + integer(kind=int64)::len4Bytes=0 + logical::rawFormat=.false. + contains + procedure,public::set => MQC_MatrixFile_Layout_Set + procedure,public::setForWrite => MQC_MatrixFile_Layout_Set_For_Write + end type MQC_MatrixFile_Layout +! +! Logical and stored sizes for one fixed-width character record. +! + type MQC_MatrixFile_Character_Record_Layout + integer(kind=int64)::elementCount=0 + integer(kind=int64)::elementWidth=0 + integer(kind=int64)::payloadCharacters=0 + integer(kind=int64)::bufferCharacters=0 + integer(kind=int64)::payloadWords=0 + integer(kind=int64)::bufferWords=0 + end type MQC_MatrixFile_Character_Record_Layout +! ! ! ! Subroutines/Functions... ! CONTAINS +!PROCEDURE MQC_MatrixFile_Layout_Set + subroutine MQC_MatrixFile_Layout_Set(layout,fileVersion, & + nHeaderRecords,len12Bytes,len4Bytes) +! +! Store layout metadata read from a Gaussian matrix-file header. The +! integer byte width selects the matching GauOpen wrapper implementation, +! while Len12L and Len4L retain the file-format word sizes. +! +! H. P. Hratchian, 2026. +! + implicit none + class(MQC_MatrixFile_Layout),intent(inout)::layout + integer(kind=int64),intent(in)::fileVersion,nHeaderRecords, & + len12Bytes,len4Bytes +! + integer(kind=int32)::intPrecision,callTest + character(len=64)::name +! + callTest = 0 + call MQC_Mat_Precision(name,intPrecision,callTest) + if(intPrecision.ne.4.and.intPrecision.ne.8) & + call MQC_Error_I('MQC_MatrixFile_Layout_Set: Matrix-file integer '// & + 'width must be 4 or 8 bytes.',6,'intPrecision', & + INT(intPrecision,kind=int64)) + if(len12Bytes.le.0) & + call MQC_Error_I('MQC_MatrixFile_Layout_Set: Len12L must be '// & + 'positive.',6,'len12Bytes',len12Bytes) + if(len4Bytes.le.0) & + call MQC_Error_I('MQC_MatrixFile_Layout_Set: Len4L must be '// & + 'positive.',6,'len4Bytes',len4Bytes) +! + layout%integerBytes = intPrecision + layout%fileVersion = fileVersion + layout%nHeaderRecords = nHeaderRecords + layout%len12Bytes = len12Bytes + layout%len4Bytes = len4Bytes + layout%rawFormat = .false. +! + return + end subroutine MQC_MatrixFile_Layout_Set + + +!PROCEDURE MQC_MatrixFile_Layout_Set_For_Write + subroutine MQC_MatrixFile_Layout_Set_For_Write(layout) +! +! Initialize layout metadata for a newly written Gaussian matrix file. +! The active GauOpen integer precision determines both file word sizes. +! +! H. P. Hratchian, 2026. +! + implicit none + class(MQC_MatrixFile_Layout),intent(inout)::layout +! + integer(kind=int32)::intPrecision,callTest + character(len=64)::name +! + callTest = 0 + call MQC_Mat_Precision(name,intPrecision,callTest) + if(intPrecision.ne.4.and.intPrecision.ne.8) & + call MQC_Error_I('MQC_MatrixFile_Layout_Set_For_Write: Matrix-'// & + 'file integer width must be 4 or 8 bytes.',6,'intPrecision', & + INT(intPrecision,kind=int64)) +! + layout%integerBytes = intPrecision + layout%fileVersion = 3 + layout%nHeaderRecords = 11 + layout%len12Bytes = intPrecision + layout%len4Bytes = intPrecision + layout%rawFormat = .false. +! + return + end subroutine MQC_MatrixFile_Layout_Set_For_Write + + +!PROCEDURE MQC_MatrixFile_Get_Character_Record_Layout + function MQC_MatrixFile_Get_Character_Record_Layout(layout,nTot, & + lenBuf,n1,n2,n3,n4,n5,typeA) result(recordLayout) +! +! Translate raw GauOpen character-record word counts into logical fixed- +! width character elements. A positive TypeA identifies character data. +! TypeA=1 is the legacy marker for one character scalar spanning the full +! payload; larger TypeA values are explicit fixed element widths. NTot and +! LenBuf are expressed in Len4L-sized file words. This normalization +! follows Gaussian's RdBAF1 routine. +! +! H. P. Hratchian, 2026. +! + implicit none + type(MQC_MatrixFile_Layout),intent(in)::layout + integer(kind=int64),intent(in)::nTot,lenBuf,n1,n2,n3,n4,n5,typeA + type(MQC_MatrixFile_Character_Record_Layout)::recordLayout + integer(kind=int64)::rawElementCount +! + if(layout%len4Bytes.le.0) & + call MQC_Error_I('Character FAF record has invalid Len4L.',6, & + 'layout%len4Bytes',layout%len4Bytes) + if(nTot.le.0) & + call MQC_Error_I('Character FAF record has invalid NTot.',6, & + 'nTot',nTot) + if(lenBuf.le.0) & + call MQC_Error_I('Character FAF record has invalid LenBuf.',6, & + 'lenBuf',lenBuf) + if(typeA.le.0) & + call MQC_Error_I('Character FAF record has invalid TypeA.',6, & + 'typeA',typeA) +! + rawElementCount = LenArr(n1,n2,n3,n4,n5) + if(rawElementCount.le.0) & + call MQC_Error_I('Character FAF record has invalid raw dimensions.', & + 6,'rawElementCount',rawElementCount) + recordLayout%payloadCharacters = layout%len4Bytes*nTot + recordLayout%payloadWords = nTot + if(typeA.eq.1) then + recordLayout%elementWidth = recordLayout%payloadCharacters + else + recordLayout%elementWidth = typeA + endIf + if(MOD(recordLayout%payloadCharacters, & + recordLayout%elementWidth).ne.0) & + call MQC_Error('Character FAF payload length is not divisible by '// & + 'the logical element width.',6) + recordLayout%elementCount = recordLayout%payloadCharacters/ & + recordLayout%elementWidth + recordLayout%bufferCharacters = layout%len4Bytes*lenBuf + recordLayout%bufferWords = lenBuf +! + return + end function MQC_MatrixFile_Get_Character_Record_Layout + + +!PROCEDURE MQC_MatrixFile_Get_Character_Write_Layout + function MQC_MatrixFile_Get_Character_Write_Layout(layout, & + elementCount,elementWidth,bufferWords) result(recordLayout) +! +! Translate logical fixed-width character elements into raw GauOpen word +! and character counts for writing. The payload must end on a complete +! Len4L word so the logical shape is preserved when Gaussian normalizes +! the record. TypeA=1 is reserved for the legacy scalar marker. +! +! H. P. Hratchian, 2026. +! + implicit none + type(MQC_MatrixFile_Layout),intent(in)::layout + integer(kind=int64),intent(in)::elementCount,elementWidth,bufferWords + type(MQC_MatrixFile_Character_Record_Layout)::recordLayout +! + if(layout%len4Bytes.le.0) & + call MQC_Error_I('Character FAF write has invalid Len4L.',6, & + 'layout%len4Bytes',layout%len4Bytes) + if(elementCount.le.0) & + call MQC_Error_I('Character FAF write has no logical elements.',6, & + 'elementCount',elementCount) + if(elementWidth.le.1) & + call MQC_Error_I('Character FAF element width must be greater than '// & + 'one; TypeA=1 is the legacy scalar marker.',6,'elementWidth', & + elementWidth) + if(bufferWords.le.0) & + call MQC_Error_I('Character FAF write has invalid buffer words.',6, & + 'bufferWords',bufferWords) +! + recordLayout%elementCount = elementCount + recordLayout%elementWidth = elementWidth + recordLayout%payloadCharacters = elementCount*elementWidth + if(MOD(recordLayout%payloadCharacters,layout%len4Bytes).ne.0) & + call MQC_Error('Character FAF payload must occupy a whole number '// & + 'of Len4L words.',6) + recordLayout%payloadWords = recordLayout%payloadCharacters/ & + layout%len4Bytes + recordLayout%bufferWords = bufferWords + recordLayout%bufferCharacters = layout%len4Bytes*bufferWords +! + return + end function MQC_MatrixFile_Get_Character_Write_Layout + + Subroutine MQC_Read_Mat_Precision_Test(MatFileName, IntPrecision) Implicit None ! @@ -501,7 +701,6 @@ Subroutine Rd_Labl_TypeA(IU,IVers,CBuf,NI,NR,NTot,LenBuf,N1,N2, & N3_4,N4_4,N5_4,TypeA_4,NRI_4 Logical::ASym - Integer(kind=int64)::LR Integer(kind=int32)::IntPrecision, Call_Test Character(Len=64)::Name @@ -553,20 +752,6 @@ Subroutine Rd_Labl_TypeA(IU,IVers,CBuf,NI,NR,NTot,LenBuf,N1,N2, & endIf #endif endif -! -! UCM GauOpen stores character data in integer-sized chunks. Normalize -! character labels so TypeA is the fixed character width and NTot is the -! number of fixed-width character fields. -! -#ifdef UCMGAUOPEN - if(.not.EOF.and.NI.eq.1.and.NR.eq.0.and.TypeA.gt.0) then - LR = LenArr(N1,N2,N3,N4,N5) - if(LR.gt.0) then - TypeA = (IntPrecision*NTot)/LR - NTot = LR - endIf - endIf -#endif Return End Subroutine Rd_Labl_TypeA @@ -725,18 +910,20 @@ Subroutine Wr_Labl_TypeA(IU,CBuf,NI,NR,NTot,LenBuf,N1,N2,N3,N4,N5, & N5_4 = N5 TypeA_4 = TypeA #ifdef UCMGAUOPEN +! +! GauOpen's label writer preserves the exact field sequence expected +! by RdLabl. A negative TypeA requests the two-real-block convention, +! which is encoded by negating the nonnegative NR value. +! if(NR_4.lt.0) then Call MQC_Error('Wr_Labl_TypeA: NR must be nonnegative.') endIf - if(TypeA_4.gt.0) then - write(IU_4) CBuf,NI_4,NR_4,1,NTot_4,LenBuf_4,N1_4,N2_4, & - N3_4,N4_4,N5_4,TypeA_4 - elseIf(TypeA_4.lt.0) then - write(IU_4) CBuf,NI_4,-NR_4,2,NTot_4,LenBuf_4,N1_4, & - N2_4,N3_4,N4_4,N5_4,TypeA_4 + if(TypeA_4.lt.0) then + Call WrLabl4(IU_4,CBuf,NI_4,-NR_4,NTot_4,LenBuf_4,N1_4, & + N2_4,N3_4,N4_4,N5_4,TypeA_4) else - write(IU_4) CBuf,NI_4,NR_4,1,NTot_4,LenBuf_4,N1_4,N2_4, & - N3_4,N4_4,N5_4,TypeA_4 + Call WrLabl4(IU_4,CBuf,NI_4,NR_4,NTot_4,LenBuf_4,N1_4, & + N2_4,N3_4,N4_4,N5_4,TypeA_4) endIf #else ASym = TypeA.ne.0 @@ -748,15 +935,19 @@ Subroutine Wr_Labl_TypeA(IU,CBuf,NI,NR,NTot,LenBuf,N1,N2,N3,N4,N5, & ! File requires 64-bit integers, so no change. ! #ifdef UCMGAUOPEN +! +! Keep the 8-byte label record identical to the 4-byte convention +! above. +! if(NR.lt.0) then Call MQC_Error('Wr_Labl_TypeA: NR must be nonnegative.') endIf - if(TypeA.gt.0) then - write(IU) CBuf,NI,NR,1,NTot,LenBuf,N1,N2,N3,N4,N5,TypeA - elseIf(TypeA.lt.0) then - write(IU) CBuf,NI,-NR,2,NTot,LenBuf,N1,N2,N3,N4,N5,TypeA + if(TypeA.lt.0) then + Call WrLabl8(IU,CBuf,NI,-NR,NTot,LenBuf,N1,N2,N3,N4,N5, & + TypeA) else - write(IU) CBuf,NI,NR,1,NTot,LenBuf,N1,N2,N3,N4,N5,TypeA + Call WrLabl8(IU,CBuf,NI,NR,NTot,LenBuf,N1,N2,N3,N4,N5, & + TypeA) endIf #else ASym = TypeA.ne.0 diff --git a/src/mqc_molecule.F03 b/src/mqc_molecule.F03 index 8ca98499..82a42a31 100644 --- a/src/mqc_molecule.F03 +++ b/src/mqc_molecule.F03 @@ -31,7 +31,7 @@ Module MQC_Molecule ! ** Lee M. Thompson, Xianghai Sheng, Andrew D. Mahler, Dave ** ! ** Mullally, and Hrant P. Hratchian ** ! ** ** -! ** Version 26.7.0 ** +! ** Version 26.7.1 ** ! ** July 13, 2026 ** ! ** ** ! ** **