From 93da5076b1cf4a611ad199c1b44e4f9c06347130 Mon Sep 17 00:00:00 2001 From: "Hrant P. Hratchian" Date: Tue, 17 Oct 2023 13:24:12 -0700 Subject: [PATCH 1/3] Updates to MQCPack from HPH. --- src/mqc_matwrapper.F03 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mqc_matwrapper.F03 b/src/mqc_matwrapper.F03 index fd1dde07..aa8ddadb 100644 --- a/src/mqc_matwrapper.F03 +++ b/src/mqc_matwrapper.F03 @@ -1,4 +1,4 @@ -!hph#define UCMGAUOPEN +!hph #define UCMGAUOPEN Module MQC_MatWrapper ! ! ********************************************************************** From 94eb797f1d7fd075f0146712037cd3e0bcdfb756 Mon Sep 17 00:00:00 2001 From: "Hrant P. Hratchian" Date: Mon, 27 Nov 2023 21:45:51 -0800 Subject: [PATCH 2/3] Updated version info to 23.11.0. --- src/mqc_general.F03 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/mqc_general.F03 b/src/mqc_general.F03 index 3a82ecc9..ec3e6318 100644 --- a/src/mqc_general.F03 +++ b/src/mqc_general.F03 @@ -173,9 +173,9 @@ subroutine mqc_version(major,minor,revision,versionString) character(len=*),OPTIONAL,intent(out)::versionString ! if(PRESENT(major)) major = 23 - if(PRESENT(minor)) minor = 6 - if(PRESENT(revision)) revision = 2 - if(PRESENT(versionString)) versionString = '23.06.2' + if(PRESENT(minor)) minor = 11 + if(PRESENT(revision)) revision = 0 + if(PRESENT(versionString)) versionString = '23.11.0' ! return end subroutine mqc_version From e02c98c286a768783fb51e7208c28afa14d1ca36 Mon Sep 17 00:00:00 2001 From: "Hrant P. Hratchian" Date: Tue, 28 Nov 2023 15:50:41 -0800 Subject: [PATCH 3/3] Updated runtime bug found in MQC_EST and MQC_Algebra when running determinant building routines and compiled using NVidia/PGI compiler. --- src/mqc_algebra.F03 | 39 ++++++++++++++++++++++++++++++--------- src/mqc_est.F03 | 27 +++++++++++---------------- src/mqc_general.F03 | 4 ++-- 3 files changed, 43 insertions(+), 27 deletions(-) diff --git a/src/mqc_algebra.F03 b/src/mqc_algebra.F03 index c2b48f9d..ed9e4038 100644 --- a/src/mqc_algebra.F03 +++ b/src/mqc_algebra.F03 @@ -75,15 +75,11 @@ Module MQC_Algebra ! Scalars... ! !> \brief Rank 0 array variable - -!hph+ Type MQC_Scalar Real(kind=real64),Public,Allocatable::ScaR Integer(kind=int64),Public,Allocatable::ScaI Complex(Kind=real64),Public,Allocatable::ScaC Character(Len=64),Public::Data_Type ! Real,Integer,Complex -!hph- - Contains !> \brief Print the MQC Scalar Procedure, Public::print => MQC_Print_Scalar_Algebra1 @@ -111,7 +107,7 @@ Module MQC_Algebra Type MQC_Vector Integer(kind=int64),Private::Length=0 Logical,Private::Column=.True. - Character(Len=64),Private::Data_Type ! Real,Integer,Complex + Character(Len=64),Public::Data_Type ! Real,Integer,Complex Real(kind=real64),Private,Dimension(:),Allocatable::VecR Integer(kind=int64),Private,Dimension(:),Allocatable::VecI Complex(Kind=real64),Private,Dimension(:),Allocatable::VecC @@ -306,6 +302,10 @@ Module MQC_Algebra Procedure, Public::init => MQC_R4Tensor_Initialize End Type MQC_R4Tensor ! +! + logical::MQC_Algebra_DEBUG=.false. + +! ! !---------------------------------------------------------------- ! | @@ -923,6 +923,25 @@ Module MQC_Algebra CONTAINS ! ! +! PROCEDURE MQC_Algebra_SetDEBUG +! + subroutine MQC_Algebra_SetDEBUG(setDebugValue) +! +! This subroutine is called to set a Module-Wide DEBUG flag to .TRUE. or +! .FALSE. +! +! H. P. Hratchian, 2023. +! +! + implicit none + logical,intent(IN)::setDebugValue +! + MQC_Algebra_DEBUG = setDebugValue +! + return + end subroutine MQC_Algebra_SetDEBUG +! +! ! PROCEDURE Factorial ! !> \brief Factorial returns the factorial of an integer @@ -7197,6 +7216,8 @@ Subroutine MQC_Allocate_Vector(N,Vector,Data_Type) Vector%Data_Type = 'Complex' If(Allocated(Vector%vecc)) DeAllocate(Vector%vecc) Allocate(Vector%vecc(N)) + else + call MQC_Error('Unknown Data_Type sent to MQC_Allocate_Vector.') EndIf Vector%Length = N Vector%Column = .True. @@ -11579,8 +11600,8 @@ Function MQC_Vector_MinLoc(Vector) result(Output) ! Variable Declarations. implicit none class(mqc_vector),intent(in)::vector - integer,dimension(:),allocatable::tmpvec - integer::i,output + integer(kind=int64),dimension(1)::tmpvec + integer(kind=int64)::output ! if(mqc_length_vector(vector).eq.0) then return @@ -11634,7 +11655,7 @@ Function MQC_Vector_ArgSort(Vector) result(Output) class(mqc_vector),intent(in)::vector type(mqc_vector)::output,tmpvec type(mqc_scalar)::one,ilowsca - integer::i,ilow + integer(kind=int64)::i,ilow ! one = 1.0 if(mqc_length_vector(vector).eq.0) then @@ -11643,7 +11664,7 @@ Function MQC_Vector_ArgSort(Vector) result(Output) tmpvec = vector call output%init(vector%size(),0) do i = 1, vector%size() - ilow = tmpvec%minloc() + ilow = minloc(tmpvec) ilowsca = ilow call output%put(ilowsca,i) call tmpvec%put(vector%maxval()+one,ilow) diff --git a/src/mqc_est.F03 b/src/mqc_est.F03 index 9bfc4b8d..9ace86ee 100644 --- a/src/mqc_est.F03 +++ b/src/mqc_est.F03 @@ -11451,11 +11451,10 @@ subroutine TRCI_DETS_STRING(iOut,iPrint,nBasisIn,nAlphaIn,nBetaIn,& class default call mqc_error('NCoreIn type is not integer or MQC scalar') end Select - write(iOut,'(A,I4,A)') 'Adding ',nCore,' core orbitals to string' + write(iOut,'(A,I4,A)') 'Adding ',nCore,' core orbitals to string.' else nCore = 0 endIf - call trci_dets_arr(nBasis,nAlpha,nBeta,substitutions,alpha_arr_hole, & alpha_arr_part,beta_arr_hole,beta_arr_part,nah,nap,nbh,nbp) ! @@ -11707,7 +11706,6 @@ subroutine TRCI_DETS_ARR(nBasisIn,nAlphaIn,nBetaIn,substitutions,alpha_arr_hole, type(mqc_vector),intent(inOut),optional::nums_alpha_hole_out,& nums_alpha_part_out,nums_beta_hole_out,nums_beta_part_out integer::i,alpha_elems,beta_elems,arrayind - select type (nBasisIn) type is (integer) nBasis = nBasisIn @@ -11734,7 +11732,6 @@ subroutine TRCI_DETS_ARR(nBasisIn,nAlphaIn,nBetaIn,substitutions,alpha_arr_hole, class default call mqc_error('NBetaIn type is not integer or MQC scalar') end select - subs = substitutions call subs%sort() call nums_alpha_hole%init(size(subs),0) @@ -11761,22 +11758,20 @@ subroutine TRCI_DETS_ARR(nBasisIn,nAlphaIn,nBetaIn,substitutions,alpha_arr_hole, nums_beta_part = nums_alpha_part endIf endDo - - alpha_elems = int(nums_alpha_hole%sum())*int(nums_alpha_part%sum()) - beta_elems = int(nums_beta_hole%sum())*int(nums_beta_part%sum()) - call alpha_arr_hole%init(int(nums_alpha_hole%sum()),int(subs%maxval()),0) - call beta_arr_hole%init(int(nums_beta_hole%sum()),int(subs%maxval()),0) - call alpha_arr_part%init(int(nums_alpha_part%sum()),int(subs%maxval()),0) - call beta_arr_part%init(int(nums_beta_part%sum()),int(subs%maxval()),0) - + alpha_elems = int(sum(nums_alpha_hole))*int(sum(nums_alpha_part)) + beta_elems = int(sum(nums_beta_hole))*int(sum(nums_beta_part)) + call alpha_arr_hole%init(int(sum(nums_alpha_hole)),int(maxval(subs)),0) + call beta_arr_hole%init(int(sum(nums_beta_hole)),int(maxval(subs)),0) + call alpha_arr_part%init(int(sum(nums_alpha_part)),int(maxval(subs)),0) + call beta_arr_part%init(int(sum(nums_beta_part)),int(maxval(subs)),0) arrayind=1 - call tmpvec%init(int(subs%maxval()),0) + call tmpvec%init(int(maxval(subs)),0) do i = 1,size(subs) call build_trci_ph_list(alpha_arr_hole,arrayind,1,nAlpha,1,int(subs%at(i)),tmpvec) endDo if(nAlpha.ne.nBeta) then arrayind=1 - call tmpvec%init(int(subs%maxval()),0) + call tmpvec%init(int(maxval(subs)),0) do i = 1,size(subs) call build_trci_ph_list(beta_arr_hole,arrayind,1,nBeta,1,int(subs%at(i)),tmpvec) endDo @@ -11784,13 +11779,13 @@ subroutine TRCI_DETS_ARR(nBasisIn,nAlphaIn,nBetaIn,substitutions,alpha_arr_hole, beta_arr_hole = alpha_arr_hole endIf arrayind=1 - call tmpvec%init(int(subs%maxval()),0) + call tmpvec%init(int(maxval(subs)),0) do i = 1,size(subs) call build_trci_ph_list(alpha_arr_part,arrayind,NAlpha+1,nBasis,1,int(subs%at(i)),tmpvec) endDo if(nAlpha.ne.nBeta) then arrayind=1 - call tmpvec%init(int(subs%maxval()),0) + call tmpvec%init(int(maxval(subs)),0) do i = 1,size(subs) call build_trci_ph_list(beta_arr_part,arrayind,NBeta+1,nBasis,1,int(subs%at(i)),tmpvec) endDo diff --git a/src/mqc_general.F03 b/src/mqc_general.F03 index ec3e6318..11a3ebef 100644 --- a/src/mqc_general.F03 +++ b/src/mqc_general.F03 @@ -174,8 +174,8 @@ subroutine mqc_version(major,minor,revision,versionString) ! if(PRESENT(major)) major = 23 if(PRESENT(minor)) minor = 11 - if(PRESENT(revision)) revision = 0 - if(PRESENT(versionString)) versionString = '23.11.0' + if(PRESENT(revision)) revision = 1 + if(PRESENT(versionString)) versionString = '23.11.1' ! return end subroutine mqc_version