DetInit Module Subroutine

module subroutine DetInit()

Arguments

None

Contents

Source Code


Source Code

    module subroutine DetInit()
        real(dp) :: DNDET
        integer :: i, j
        integer(int64) :: nDet
        integer :: alpha, beta, symalpha, symbeta, endsymstate
        LOGICAL :: tSuccess, tFoundOrbs(nBasis)

        write (stdout, *) "SYMMETRY MULTIPLICATION TABLE"
        CALL WRITESYMTABLE(stdout)

        CALL GENSymStatePairs(NBASIS / 2, .false.)

!iActiveBasis is a copy of nPaths
        IF (iActiveBasis == -2) then
!  PATHS ACTIVE SETS
            Call GenActiveBasis(ARR, nBasis, nEl, nActiveBasis, nActiveSpace(1), nActiveSpace(2))
        else if (iActiveBasis == -3) then
!  PATHS ACTIVE ORBITALS
            nActiveBasis(1) = nEl + 1 - nActiveSpace(1)
            nActiveBasis(2) = nEl + nActiveSpace(2)
            write (stdout, *) "Active space:", nActiveBasis(1), " TO ", nActiveBasis(2), " (ordered labels)."
            write (stdout, *) "Active space electrons:", nEl - nActiveBasis(1) + 1
        else
            nActiveBasis(1) = 1
            nActiveBasis(2) = nBasis
        end if
!C.. Work out a preliminary Fermi det
!      IF(FDET(1).EQ.0) THEN

!C.. Check if we're blocking the hamiltonian
!C      IF(THFBASIS.AND.TBLOCK) THEN
!C         write(stdout,*) "THFBASIS set and NBLK=0.  ",
!C     &         "Cannot block diagonalize in HF Basis."
!C         STOP
!C      end if
!C      CALL SYMGENEXCITS(FDET,NEL,NBASIS)
!C      CALL LeaveMemoryManager
!C      STOP

!C.. in order to calculate the H matrix, we need to work out all the determinants
!C.. beware with NPATHS - it calcs the list of dets even if we don't calc H
!C.. Could be big.
!C..Now we see how many determinants we need
!C      IF(nBasis.GT.170) THEN
!C..This fix is to stop floating overflow as taking the factorial of (nBasis.GT.170) crashes
!C  using the old FACTRL routine.
        NDET = 1
        DNDET = 1.0_dp
        DO I = 0, NEL - 1
            NDET = (NDET * (nBasis - I)) / (I + 1)
            DNDET = (DNDET * real(nBasis - I, dp)) / real(I + 1, dp)
        end do

        IF (abs(real(NDET) - dndet) > 1.0e-6) THEN
!         write(stdout,*) ' NUMBER OF DETERMINANTS : ' , DNDET
            NDET = -1
        ELSE
!         write(stdout,*) ' NUMBER OF DETERMINANTS : ' , NDET
        end if

!C      CALL TC(I_HMAX,I_P,NWHTAY)

!Check that the symmetry routines have set the symmetry up correctly...
        tSuccess = .true.
        tFoundOrbs(:) = .false.

        IF ((.not. tHub) .and. (.not. tUEG) .and. TwoCycleSymGens) THEN
            do i = 1, nSymLabels
                EndSymState = SymLabelCounts(1, i) + SymLabelCounts(2, i) - 1
                do j = SymLabelCounts(1, i), EndSymState

                    Beta = (2 * SymLabelList(j)) - 1
                    Alpha = (2 * SymLabelList(j))
                    SymAlpha = INT((G1(Alpha)%Sym%S), 4)
                    SymBeta = INT((G1(Beta)%Sym%S), 4)

                    IF (.not. tFoundOrbs(Beta)) THEN
                        tFoundOrbs(Beta) = .true.
                    ELSE
                        CALL Stop_All("SetupParameters", "Orbital specified twice")
                    end if
                    IF (.not. tFoundOrbs(Alpha)) THEN
                        tFoundOrbs(Alpha) = .true.
                    ELSE
                        CALL Stop_All("SetupParameters", "Orbital specified twice")
                    end if

                    IF (G1(Beta)%Ms /= -1) THEN
                        tSuccess = .false.
                    else if (G1(Alpha)%Ms /= 1) THEN
                        tSuccess = .false.
                    else if ((SymAlpha /= (i - 1)) .or. (SymBeta /= (i - 1))) THEN
                        tSuccess = .false.
                    end if
                end do
            end do
            do i = 1, nBasis
                IF (.not. tFoundOrbs(i)) THEN
                    write (stdout, *) "Orbital: ", i, " not found."
                    CALL Stop_All("SetupParameters", "Orbital not found")
                end if
            end do
        end if
        ! SpinOrbSymSetup currently sets up the symmetry arrays for use with
        ! symrandexcit2 excitation routines. These are not currently
        ! compatible with non-abelian symmetry groups, which CPMD jobs
        ! invariably used. To avoid this complication, this symmetry
        ! setup will not be used with CPMD, and thus these excitation
        ! generators won't work.
        IF (.not. tCPMD) THEN
            IF (.not. tSuccess) THEN
                write (stdout, *) "************************************************"
                write (stdout, *) "**                 WARNING!!!                 **"
                write (stdout, *) "************************************************"
                write (stdout, *) "Symmetry information not set up correctly in NECI initialisation"
                write (stdout, *) "Will attempt to set up the symmetry again, but now in terms of spin orbitals"
                write (stdout, *) "Old excitation generators will not work"
                write (stdout, *) "I strongly suggest you check that the reference energy is correct."
                !CALL SpinOrbSymSetup() !.true.)
            ELSE
                write (stdout, *) "Symmetry and spin of orbitals correctly set up for excitation generators."
                write (stdout, *) "Simply transferring this into a spin orbital representation."
                !CALL SpinOrbSymSetup() !.false.)
            end if

            if (tPickVirtUniform) then
                call virt_uniform_sym_setup()
            else
                ! Includes normal & HPHF
                call SpinOrbSymSetup()
            end if

        end if
! From now on, the orbitals are also contained in symlabellist2 and symlabelcounts2.
! These are stored using spin orbitals.
    end subroutine DetInit