diff --git a/releaseNotes.txt b/releaseNotes.txt new file mode 100644 index 00000000..70dfc9e6 --- /dev/null +++ b/releaseNotes.txt @@ -0,0 +1,23 @@ +Release Notes for MQCPack + +This file is meant to document key functionality changes developers +implement within MQCPack and push into our public repositories. Whenever +the list of new/modified/changes features/options becomes meaningful, Hrant +(hhratchian@ucmerced.edu) will update the version numbers. Such version +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. + + +February 19, 2024 +* MQCPack version set to 24.2.1. +* Top-of-file version text has been updated in all source files. +* LT has added new functionality to the CI matrix element building +procedures. + + +February 8, 2024 +* MQCPack version set to 24.2.0. +* HPH qdded the binary object module, mqc_binary.F03, to the src directory. It +is not yet implemented with the build scripts or other code. That will come +soon. diff --git a/src/mqc_FullWavefunction.F03 b/src/mqc_FullWavefunction.F03 index cf440856..66d55ee5 100644 --- a/src/mqc_FullWavefunction.F03 +++ b/src/mqc_FullWavefunction.F03 @@ -1,22 +1,18 @@ ! A generic linked list object module MQC_FullWavefunction -! +! ! ********************************************************************** ! ********************************************************************** ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_algebra.F03 b/src/mqc_algebra.F03 index a43c1331..99fbf925 100644 --- a/src/mqc_algebra.F03 +++ b/src/mqc_algebra.F03 @@ -38,17 +38,13 @@ Module MQC_Algebra ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_algebra2.F03 b/src/mqc_algebra2.F03 index 0fbcd2ba..650f0fd3 100644 --- a/src/mqc_algebra2.F03 +++ b/src/mqc_algebra2.F03 @@ -7,17 +7,13 @@ Module MQC_Algebra2 ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_binary.F03 b/src/mqc_binary.F03 new file mode 100644 index 00000000..4d62be98 --- /dev/null +++ b/src/mqc_binary.F03 @@ -0,0 +1,427 @@ + module MQC_Binary +! +! ********************************************************************** +! ********************************************************************** +! ** ** +! ** The Merced Quantum Chemistry Package ** +! ** (MQCPack) ** +! ** ** +! ** Written By: ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** +! ** ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** +! ** ** +! ** ** +! ** Modules beloning to MQCPack: ** +! ** 1. MQC_General ** +! ** 2. MQC_DataStructures ** +! ** 3. MQC_Algebra ** +! ** 4. MQC_Files ** +! ** 5. MQC_Molecule ** +! ** 6. MQC_EST ** +! ** 7. MQC_Gaussian ** +! ** ** +! ********************************************************************** +! ********************************************************************** +! +! NEED TO ADD COMMENTS +! +! + USE MQC_General + USE iso_fortran_env, only: int64, real64 +! +!---------------------------------------------------------------- +! | +! TYPE AND CLASS DEFINITIONS | +! | +!---------------------------------------------------------------- + implicit none +! +! mqc_bits + type :: mqc_bits + integer(kind=int64)::nBitsPerInteger=3 + integer(kind=int64)::nBits,nIntegers + integer(kind=int64),dimension(:),allocatable::integerList + end type mqc_bits +! +! +!---------------------------------------------------------------- +! | +! PROCEDURE INTERFACES | +! | +!---------------------------------------------------------------- +! +! +! Interface MQC_Bits to the custom constructor. + interface mqc_bits + module procedure MQC_Bits_Initialize + end interface mqc_bits +! +! +!---------------------------------------------------------------- +! | +! SUBROUTINES AND FUNCTIONS | +! | +!---------------------------------------------------------------- +! +! + CONTAINS +! +!PROCEDURE MQC_Bits_Initialize + function MQC_Bits_Initialize(nBits) result(mqc_bits_out) +! +! This function is used to initialize an MQC_Bit object. Input dummy +! argument is the number of bits requested by the user. Keep in mind +! that bit 0 counts as a bit in this count. As such, requesting 8 bits +! provides bit numbers 0-7. +! +! H. P. Hratchian, 2021. +! +! + implicit none + type(mqc_bits),intent(out)::mqc_bits_out + integer(kind=int64),intent(in),optional::nBits +! + integer(kind=int64)::my_nBits,nIntegers +! +! +! Start by setting up my_nBits. +! + if(PRESENT(nBits)) then + my_nBits = nBits + else + my_nBits = bit_size(nIntegers) + endIf +! +! Set nIntegers. +! + nIntegers = my_nBits/mqc_bits_out%nBitsPerInteger + if(MOD(my_nBits,mqc_bits_out%nBitsPerInteger).ne.0) & + nIntegers = nIntegers+1 +! +! Set mqc_bits_out%nBits. Then allocate the integer array in the bit object +! and set all the values to 0. +! + mqc_bits_out%nBits = my_nBits + mqc_bits_out%nIntegers = nIntegers + Allocate(mqc_bits_out%integerList(nIntegers)) + mqc_bits_out%integerList = 0 +! + return + end function MQC_Bits_Initialize +! +! +!PROCEDURE MQC_Bits_Print + subroutine MQC_Bits_Print(mqc_bits_in,iUnit,Header,Blank_At_Top, & + Blank_At_Bottom,verbose) +! +! This subroutine is used to print out the bits in mqc_bits_in. +! +! H. P. Hratchian, 2021. +! +! + implicit none + type(mqc_bits),intent(in)::mqc_bits_in + integer(kind=int64),intent(in),optional::iUnit + character(len=*),intent(in),optional::Header + logical,intent(in),optional::Blank_At_Top,Blank_At_Bottom,verbose +! + integer(kind=int64)::my_iUnit,i + logical::my_verbose + character(len=256)::formatText,charTemp +! +! +! Format Statements +! + 1000 format(1x,'Binary number: ') + 1100 format(1x,A,' ') +! +! +! Start by setting up my_iUnit and my_verbose. +! + if(PRESENT(iUnit)) then + my_iUnit = iUnit + else + my_iUnit = 6 + endIf + my_verbose = .false. + if(PRESENT(verbose)) my_verbose = verbose +! +! Print blank at top if requested. +! + if(PRESENT(Blank_At_Top)) then + if(Blank_At_Top) write(my_iUnit) + endIf +! +! Set up the format string. +! + charTemp = num2char(mqc_bits_in%nBitsPerInteger) + if(my_verbose) then + if(PRESENT(Header)) then + write(my_iUnit,1100) TRIM(Header) + else + write(my_iUnit,1000) + endIf + formatText = '(1x,I2,'':'',B'//TRIM(charTemp)//'.'//TRIM(charTemp)//')' + else + if(PRESENT(Header)) then + write(UNIT=my_iUnit,FMT=1100,ADVANCE="no") TRIM(Header) + else + write(UNIT=my_iUnit,FMT=1000,ADVANCE="no") + endIf + formatText = '(B'//TRIM(charTemp)//'.'//TRIM(charTemp)//')' + endIf +! +! Write out the binary number. +! + if(my_verbose) then + do i = 1,mqc_bits_in%nIntegers + write(UNIT=my_iUnit,FMT=formatText,ADVANCE="yes") i,mqc_bits_in%integerList(i) + endDo + else + do i = mqc_bits_in%nIntegers,2,-1 + write(UNIT=my_iUnit,FMT=formatText,ADVANCE="no") mqc_bits_in%integerList(i) + endDo + write(UNIT=my_iUnit,FMT=formatText,ADVANCE="yes") mqc_bits_in%integerList(1) + endIf +! +! Print blank at bottom if requested. +! + if(PRESENT(Blank_At_Bottom)) then + if(Blank_At_Bottom) write(my_iUnit) + endIf +! + return + end subroutine MQC_Bits_Print +! +! +!PROCEDURE MQC_BitPosition + subroutine MQC_BitPosition(mqc_bits_in,bitnum,iInteger,iBitnum) +! +! This subroutine is used to determine which integer and which +! bit within that integer in an MQC_Bits object correspond the +! overall bit . +! +! H. P. Hratchian, 2021. +! +! + implicit none + type(mqc_bits),intent(in)::mqc_bits_in + integer(kind=int64),intent(in)::bitnum + integer(kind=int64),intent(out)::iInteger,iBitnum +! +! +! Do the work. +! + iInteger = (bitnum+1)/mqc_bits_in%nBitsPerInteger + if(MOD((bitnum+1),mqc_bits_in%nBitsPerInteger).ne.0) & + iInteger = iInteger+1 + iBitnum = MOD(bitnum,mqc_bits_in%nBitsPerInteger) +! + return + end subroutine MQC_BitPosition +! +! +!PROCEDURE MQC_BTest + function MQC_BTest(mqc_bits_in,bitnum) result(bitValue) +! +! This function tests the switch in bit number in and +! returns TRUE or FALSE accordingly. +! +! H. P. Hratchian, 2022. +! +! + implicit none + type(mqc_bits),intent(In)::mqc_bits_in + integer(kind=int64),intent(in)::bitNum + logical,intent(out)::bitValue +! + integer(kind=int64)::iInteger,iBitNum +! +! +! Do the work. +! + call MQC_BitPosition(mqc_bits_in,bitNum,iInteger,iBitNum) + bitValue = BTest(mqc_bits_in%integerList(iInteger),iBitnum) +! + return + end function MQC_BTest +! +! +!PROCEDURE MQC_IBitSet + subroutine MQC_IBitSet(mqc_bits_in,bitnum) +! +! This subroutine is used to set a bit in mqc_bits_in. +! +! H. P. Hratchian, 2021. +! +! + implicit none + type(mqc_bits),intent(inOut)::mqc_bits_in + integer(kind=int64),intent(in)::bitnum +! + integer(kind=int64)::iInteger,iBitnum +! +! +! Do the work. +! + call MQC_BitPosition(mqc_bits_in,bitnum,iInteger,iBitnum) + mqc_bits_in%integerList(iInteger) = IBSet(mqc_bits_in%integerList(iInteger),iBitnum) +! + return + end subroutine MQC_IBitSet +! +! +!PROCEDURE MQC_IBitClr + subroutine MQC_IBitClr(mqc_bits_in,bitnum) +! +! This subroutine is used to clear a bit in mqc_bits_in. +! +! H. P. Hratchian, 2022. +! +! + implicit none + type(mqc_bits),intent(inOut)::mqc_bits_in + integer(kind=int64),intent(in)::bitnum +! + integer(kind=int64)::iInteger,iBitnum +! +! +! Do the work. +! + call MQC_BitPosition(mqc_bits_in,bitnum,iInteger,iBitnum) + mqc_bits_in%integerList(iInteger) = IBClr(mqc_bits_in%integerList(iInteger),iBitnum) +! + return + end subroutine MQC_IBitClr +! +! +!PROCEDURE MQC_IAnd + function MQC_IAnd(mqc_bits_in1,mqc_bits_in2) result(mqc_bits_out) +! +! This function carries out the IAnd operation on two MQC_Bit objects. The +! output is the resulting MQC_Bit object. +! +! H. P. Hratchian, 2022. +! +! + implicit none + type(mqc_bits),intent(in)::mqc_bits_in1,mqc_bits_in2 + type(mqc_bits),intent(out)::mqc_bits_out +! + integer(kind=int64)::i +! +! +! Do the work. +! + if((mqc_bits_in1%nIntegers.eq.mqc_bits_in2%nIntegers).and. & + (mqc_bits_in1%nBits.eq.mqc_bits_in2%nBits)) then + mqc_bits_out = MQC_Bits_Initialize(mqc_bits_in1%nBits) + do i = 1,mqc_bits_in1%nIntegers + mqc_bits_out%integerList(i) = & + IAND(mqc_bits_in1%integerList(i),mqc_bits_in2%integerList(i)) + endDo + else + call mqc_error('MQC_IAnd: Non-conformable bit objects.') + endIf +! + return + end function MQC_IAnd +! +! +!PROCEDURE MQC_IEOR + function MQC_IEOR(mqc_bits_in1,mqc_bits_in2) result(mqc_bits_out) +! +! This function carries out the EXCLUSIVE OR operation on two MQC_Bit +! objects. The output is the resulting MQC_Bit object. +! +! H. P. Hratchian, 2022. +! +! + implicit none + type(mqc_bits),intent(in)::mqc_bits_in1,mqc_bits_in2 + type(mqc_bits),intent(out)::mqc_bits_out +! + integer(kind=int64)::i +! +! +! Do the work. +! + if((mqc_bits_in1%nIntegers.eq.mqc_bits_in2%nIntegers).and. & + (mqc_bits_in1%nBits.eq.mqc_bits_in2%nBits)) then + mqc_bits_out = MQC_Bits_Initialize(mqc_bits_in1%nBits) + do i = 1,mqc_bits_in1%nIntegers + mqc_bits_out%integerList(i) = & + IEOR(mqc_bits_in1%integerList(i),mqc_bits_in2%integerList(i)) + endDo + else + call mqc_error('MQC_IEOR: Non-conformable bit objects.') + endIf +! + return + end function MQC_IEOR +! +! +!PROCEDURE MQC_IOR + function MQC_IOR(mqc_bits_in1,mqc_bits_in2) result(mqc_bits_out) +! +! This function carries out the INCLUSIVE OR operation on two MQC_Bit +! objects. The output is the resulting MQC_Bit object. +! +! H. P. Hratchian, 2022. +! +! + implicit none + type(mqc_bits),intent(in)::mqc_bits_in1,mqc_bits_in2 + type(mqc_bits),intent(out)::mqc_bits_out +! + integer(kind=int64)::i +! +! +! Do the work. +! + if((mqc_bits_in1%nIntegers.eq.mqc_bits_in2%nIntegers).and. & + (mqc_bits_in1%nBits.eq.mqc_bits_in2%nBits)) then + mqc_bits_out = MQC_Bits_Initialize(mqc_bits_in1%nBits) + do i = 1,mqc_bits_in1%nIntegers + mqc_bits_out%integerList(i) = & + IOR(mqc_bits_in1%integerList(i),mqc_bits_in2%integerList(i)) + endDo + else + call mqc_error('MQC_IOR: Non-conformable bit objects.') + endIf +! + return + end function MQC_IOR +! +! +!PROCEDURE MQC_PopCnt + function MQC_PopCnt(mqc_bits_in) result(bits_on) +! +! This function returns the number of "ON" bits in input dummy argument +! . The output of the function is an int64 integer. +! +! H. P. Hratchian, 2022. +! +! + implicit none + type(mqc_bits),intent(in)::mqc_bits_in + integer(kind=int64),intent(out)::bits_on +! + integer(kind=int64)::i +! +! +! Do the work. +! + bits_on = 0 + do i = 0,mqc_bits_in%nBits-1 + if(mqc_BTest(mqc_bits_in,i)) bits_on = bits_on+1 + endDo +! + return + end function MQC_PopCnt + + + end module MQC_Binary diff --git a/src/mqc_datastructures.F03 b/src/mqc_datastructures.F03 index c3def07e..8ce9f624 100644 --- a/src/mqc_datastructures.F03 +++ b/src/mqc_datastructures.F03 @@ -5,17 +5,13 @@ Module MQC_DataStructures ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_est.F03 b/src/mqc_est.F03 index 3de79e34..1179168b 100644 --- a/src/mqc_est.F03 +++ b/src/mqc_est.F03 @@ -33,17 +33,13 @@ Module MQC_EST ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -11907,6 +11903,62 @@ end subroutine build_trci_ph_list ! !===================================================================== ! +! PROCEDURE MQC_DetString_to_OccArray +! +!> \brief MQC_DetString_to_OccArray takes as an argument a bit string +!> and returns an integer array with locations of occupied orbitals +! +!> \par Purpose: +! ============= +!> +!> \verbatim +!> +!> MQC_DetString_to_OccArray is a function that takes as an argument a +!> bit string array and returns an integer array with locations where +!> bits are set equal to one. The value of the routine is that it can +!> be used in conjuction with mqc_integral_output_orbitals to return +!> an mqc_scf_integral object containing the set of occupied orbitals. +!> +!> \endverbatim +! +! Arguments: +! ========== +!> \param[in] String +!> \verbatim +!> String is Type(MQC_Vector) +!> The bit string to be analyzed. +!> \endverbatim +! +! Authors: +! ======== +!> \author L. M. Thompson +!> \date 2024 +! + function mqc_detString_to_occArray(string) result(arrayOut) + + implicit none + type(mqc_vector),intent(in)::string + integer(kind=int64),dimension(:),allocatable::arrayOut + + integer::nBitInts,temp_int,i,j,nBasis + type(mqc_vector)::tmpArray + + nBitInts = size(string) + nBasis = nBitInts*Bit_Size(0) + + do i = 1, nBitInts + temp_int = string%at(i) + do j = 0, Bit_Size(0)-1 + if(btest(temp_int,j)) call tmpArray%push((i-1)*(Bit_Size(0)-1)+(j+1)) + endDo + endDo + allocate(arrayOut(size(tmpArray))) + arrayOut = tmpArray + + end function mqc_detstring_to_occArray +! +!===================================================================== +! ! PROCEDURE SLATER_CONDON ! !> \brief SLATER_CONDON is a function that returns an operator matrix diff --git a/src/mqc_files.F03 b/src/mqc_files.F03 index 981321dd..7418223f 100644 --- a/src/mqc_files.F03 +++ b/src/mqc_files.F03 @@ -5,17 +5,13 @@ Module MQC_Files ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_gaussian.F03 b/src/mqc_gaussian.F03 index 8f34c33b..8505eb35 100644 --- a/src/mqc_gaussian.F03 +++ b/src/mqc_gaussian.F03 @@ -5,17 +5,13 @@ Module MQC_Gaussian ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** diff --git a/src/mqc_general.F03 b/src/mqc_general.F03 index ac68ed1a..8cd0e692 100644 --- a/src/mqc_general.F03 +++ b/src/mqc_general.F03 @@ -5,17 +5,13 @@ Module MQC_General ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -175,10 +171,10 @@ subroutine mqc_version(major,minor,revision,versionString) integer,OPTIONAL,intent(out)::major,minor,revision character(len=*),OPTIONAL,intent(out)::versionString ! - if(PRESENT(major)) major = 23 - if(PRESENT(minor)) minor = 11 + if(PRESENT(major)) major = 24 + if(PRESENT(minor)) minor = 2 if(PRESENT(revision)) revision = 1 - if(PRESENT(versionString)) versionString = '23.11.1' + if(PRESENT(versionString)) versionString = '24.02.1' ! return end subroutine mqc_version diff --git a/src/mqc_general_lapack.F03 b/src/mqc_general_lapack.F03 index ec4d504c..5608309b 100644 --- a/src/mqc_general_lapack.F03 +++ b/src/mqc_general_lapack.F03 @@ -4,17 +4,13 @@ ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -30,7 +26,6 @@ ! ********************************************************************** ! ! -! ! This include file provides a set of routines/functions that serve as ! wrappers for LAPACK routines. ! diff --git a/src/mqc_interface.F03 b/src/mqc_interface.F03 index 63518a69..c1d07d41 100644 --- a/src/mqc_interface.F03 +++ b/src/mqc_interface.F03 @@ -4,17 +4,13 @@ ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -28,13 +24,9 @@ ! ** ** ! ********************************************************************** ! ********************************************************************** -! ! ! ! -! This module includes procedures that provide a variety of general purpose -! utilities. The subroutines and functions provided by this module are -! grouped into the following sections: ! ! C to Fortran 2003 Interface ! diff --git a/src/mqc_matwrapper.F03 b/src/mqc_matwrapper.F03 index aa8ddadb..01355f65 100644 --- a/src/mqc_matwrapper.F03 +++ b/src/mqc_matwrapper.F03 @@ -6,17 +6,13 @@ Module MQC_MatWrapper ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Dave Mullally ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: ** @@ -32,14 +28,6 @@ Module MQC_MatWrapper ! ********************************************************************** ! ! -! -! -! This module includes procedures that provide a variety of general purpose -! utilities. The subroutines and functions provided by this module are -! grouped into the following sections: -! -! C to Fortran 2003 Interface -! use mqc_general use iso_fortran_env, only: int32, int64, real64 ! @@ -423,34 +411,6 @@ Function Lind5(Check,N1,N2,N3,N4,N5,ASym,I,J,K,L,M,Sign) result(Lind8) Lind8 = L8nd5(Check,N1,N2,N3,N4,N5,ASym,I,J,K,L,M,Sign) End Function Lind5 -!hph+ -! Function NumNZA(NR,NTot,X) result(Numz) -! Implicit None -! -! Integer(kind=int64),Intent(InOUT)::NR,NTot -! Real(kind=real64),Dimension(:),Intent(InOut)::X -! -! Integer(kind=int64), external::N8mNZA -! Integer(kind=int64)::Numz -! -! Numz = N8mNZA(NR,NTot,X) -! End Function NumNZA -!hph- - -!hph+ -! Function NumNZR(NR,NTot,X) result(Numz) -! Implicit None -! -! Integer(kind=int64),Intent(InOUT)::NR,NTot -! Real(kind=real64),Dimension(:),Intent(InOut)::X -! -! Integer(kind=int64), external::N8mNZr -! Integer(kind=int64)::Numz -! -! Numz = N8mNZR(NR,NTot,X) -! End Function NumNZR -!hph- - Subroutine Rd_2E1(IU,LR,NTot,LenBuf,RArr) Implicit None diff --git a/src/mqc_molecule.F03 b/src/mqc_molecule.F03 index 009a554b..3d93847f 100644 --- a/src/mqc_molecule.F03 +++ b/src/mqc_molecule.F03 @@ -5,17 +5,13 @@ Module MQC_Molecule ! ** ** ! ** The Merced Quantum Chemistry Package ** ! ** (MQCPack) ** -! ** Development Version ** -! ** Based On: ** -! ** Development Version 0.1 ** -! ** ** ! ** ** ! ** Written By: ** -! ** Lee M. Thompson, Xianghai Sheng, and Hrant P. Hratchian ** -! ** ** +! ** Lee M. Thompson, Dave Mullaly, Xianghai Sheng, and Hrant P. ** +! ** Hratchian ** ! ** ** -! ** Version 1.0 Completed ** -! ** May 1, 2017 ** +! ** Version 24.02.1 ** +! ** Feburary 19, 2024 ** ! ** ** ! ** ** ! ** Modules beloning to MQCPack: **