Merge pull request #148 from leethomo86/master

Merges from Hratchian Group

src/mqc_algebra.F03

@@ -75,15 +75,11 @@ Module MQC_Algebra
 !     Scalars...
 !
 !>    \brief <b> Rank 0 array variable</b>
-
-!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 <b> Print the MQC Scalar</b>
         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.
+
+!
 !
 !----------------------------------------------------------------
 !                                                               |
@@ -933,6 +933,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 <b> Factorial returns the factorial of an integer</b>
@@ -7315,6 +7334,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.
@@ -11697,8 +11718,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
@@ -11752,7 +11773,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
@@ -11761,7 +11782,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)

src/mqc_est.F03

@@ -11463,11 +11463,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)
 !
@@ -11719,7 +11718,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
@@ -11746,7 +11744,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)
@@ -11773,36 +11770,34 @@ 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
       else
         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

src/mqc_general.F03

@@ -176,9 +176,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      = 1
+      if(PRESENT(versionString)) versionString = '23.11.1'
 !
       return
       end subroutine mqc_version

src/mqc_matwrapper.F03

@@ -1,4 +1,4 @@
-!hph#define UCMGAUOPEN
+!hph #define UCMGAUOPEN
       Module MQC_MatWrapper
 !
 !     **********************************************************************