Subroutine DetPreFreezeInit_old() integer :: ierr, ms, iEl, flagAlpha, msTmp integer :: i, j, Lz, OrbOrder(8, 2), FDetTemp(NEl) type(BasisFn) s logical :: tGenFDet HElement_t(dp) :: OrbE character(25), parameter :: this_routine = 'DetPreFreezeInit_old' ! seems this is only used in one place in the code, and only for GUGA. write(stdout, "(A)") "WARNING: Routine DetPreFreezeInit_old is deprecated. " & // "Use DetPreFreezeInit instead." allocate (FDet(nEl), stat=ierr) LogAlloc(ierr, 'FDet', nEl, 4, tagFDet) IF (tDefineDet) THEN write (stdout, *) 'Defining FDet according to input' do i = 1, NEl FDet(i) = DefDet(i) end do call assignOccOrbs() ! A quick check that we have defined a reasonable det. ms = sum(get_spin_pn(fdet(1:nel))) if (abs(ms) /= abs(lms)) then write (stdout, *) 'LMS', lms write (stdout, *) 'Calculated Ms', ms call stop_all(this_routine, "Defined determinant has the " & // "wrong Ms value. Change DEFINEDET or " & // "SPIN-RESTRICT") end if if (tGUGA) then ms = abs(ms) if (ms < 0 .or. ms /= STOT) then write (stdout, *) "S: ", STOT write (stdout, *) "calculated S of inputted CSF: ", ms call stop_all(this_routine, " Defined CSF has the " & // "wrong total spin quantum number. Change DEFINEDET or " & // "S quantum numnber!") end if end if tRef_Not_HF = .true. else if ((sum(nOccOrbs) + sum(nClosedOrbs)) == nel) then tGenFDet = .false. iEl = 1 msTmp = -1 * lms do i = 1, nIrreps ! doubly occupy the closed orbs do j = 1, nClosedOrbs(i) FDet(iEl) = irrepOrbOffset(i) + 2 * j - 1 iEl = iEl + 1 FDet(iEl) = irrepOrbOffset(i) + 2 * j iEl = iEl + 1 end do ! now distribute electrons to the open orbs ! such that the total sz matches the requested ! only consider occ orbs which are not closed do j = nClosedOrbs(i) + 1, nOccOrbs(i) if (msTmp < 0) then flagAlpha = 0 else flagAlpha = 1 end if FDet(iEl) = irrepOrbOffset(i) + 2 * j - flagAlpha iEl = iEl + 1 msTmp = msTmp + (1 - 2 * flagAlpha) end do end do call sort(FDet) else CALL GENFDET(FDET) call assignOccOrbs() IF (tUEGSpecifyMomentum) THEN write (stdout, *) 'Defining FDet according to a momentum input' CALL ModifyMomentum(FDET) end if tRef_Not_HF = .false. end if end if write (stdout, "(A)", advance='no') " Fermi det (D0):" call write_det(stdout, FDET, .true.) Call GetSym(FDet, nEl, G1, nBasisMax, s) write (stdout, "(A)", advance='no') " Symmetry: " Call writesym(stdout, s%Sym, .true.) IF (tFixLz) THEN Call GetLz(FDet, nEl, Lz) write (stdout, "(A,I5)") "Lz of Fermi det:", Lz end if CALL NECI_ICOPY(NEL, FDET, 1, NUHFDET, 1) if (tMolpro) then !Orbitals are ordered by occupation number from MOLPRO, and not reordered in NECI !Therefore, we know HF determinant is first four occupied orbitals. write (stdout, "(A)") "NECI called from MOLPRO, so assuming orbitals ordered by occupation number." if (.not. tDefineDet) then FDetTemp(:) = FDet(:) else !We have defined our own reference determinant, but still use the first orbitals for the calculation !of 'orbital energies' CALL GENFDET(FDETTEMP) end if write (stdout, "(A)") "Calculating orbital energies..." do i = 1, nBasis OrbE = CalcFockOrbEnergy(i, FDetTemp) Arr(i, 1) = real(OrbE, dp) Brr(i) = i end do write (stdout, "(A)") "Reordering basis by orbital energies..." OrbOrder(:, :) = 0 call ORDERBASIS(NBASIS, Arr, Brr, OrbOrder, nBasisMax, G1) !However, we reorder them here call writebasis(stdout, G1, nBasis, Arr, Brr) end if E0HFDET = ECORE DO I = 1, NEL E0HFDET = E0HFDET + ARR(NUHFDET(i), 2) end do write (stdout, *) "Fock operator energy:", E0HFDET ! Store the value of Ms for use in other areas calculated_ms = sum(get_spin_pn(fdet(1:nel))) if (tGUGA) then calculated_ms = abs(calculated_ms) end if contains subroutine assignOccOrbs integer :: k ! assign the occ/closed orbs nOccOrbs = 0 nClosedOrbs = 0 do k = 1, nel if (k > 1) then if (is_alpha(FDet(k)) .and. FDet(k - 1) == FDet(k) - 1) then ! we do not need to resolve the irrep anymore (not relevant ! for further usage) nClosedOrbs(1) = nClosedOrbs(1) + 1 cycle end if end if nOccOrbs(1) = nOccOrbs(1) + 1 end do end subroutine assignOccOrbs End Subroutine DetPreFreezeInit_old