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