SUBROUTINE CALCHFBASIS(NBASIS, NBASISMAX, G1, BRR, ECORE, &
UMAT, HFE, HFBASIS, NHFIT, NEL, MS, HFMIX, EDELTA, CDELTA, TRHF, &
IHFMETHOD, TREADHF, FRAND, HFDET, ILOGGING)
INTEGER NSPINS, NSBASIS
INTEGER NBASIS, nBasisMax(5, *)
TYPE(BasisFN) G1(nBasis)
real(dp) UMAT(*)
real(dp) ECORE
INTEGER BRR(NBASIS)
HElement_t(dp) HFBASIS(NBASIS, NBASIS)
real(dp) HFE(NBASIS)
HElement_t(dp), allocatable :: FMAT(:), OFMAT(:)
HElement_t(dp), allocatable :: DMAT(:), ODMAT(:)
HElement_t(dp), allocatable :: WORK(:)
real(dp), allocatable :: HFES(:)
HElement_t(dp), allocatable :: R1(:), R2(:)
integer(TagIntType), save :: tagR1 = 0, tagR2 = 0, tagHFES = 0
integer(TagIntType), save :: tagFMAT = 0, tagOFMat = 0
integer(TagIntType), save :: tagWork = 0, tagDMAT = 0, tagODMat = 0
INTEGER NHFIT, NEL
real(dp) HFMIX, EDELTA, CDELTA
INTEGER MS, IHFMETHOD
LOGICAL TRHF, TREADHF
real(dp) FRAND
INTEGER HFDET(NEL)
INTEGER ILOGGING
character(*), parameter :: this_routine = 'CALCHFBASIS'
NSPINS = 1 + (NBASISMAX(4, 2) - NBASISMAX(4, 1)) / 2
NSBASIS = NBASIS / NSPINS
allocate(FMAT(NSBASIS * NSBASIS * NSPINS))
call LogMemAlloc('FMAT', NSBASIS * NSBASIS * NSPINS, HElement_t_size * 8, this_routine, tagFMAT)
allocate(OFMAT(NSBASIS * NSBASIS * NSPINS))
call LogMemAlloc('OFMAT', NSBASIS * NSBASIS * NSPINS, HElement_t_size * 8, this_routine, tagOFMAT)
allocate(DMAT(NSBASIS * NSBASIS * NSPINS))
call LogMemAlloc('DMAT', NSBASIS * NSBASIS * NSPINS, HElement_t_size * 8, this_routine, tagDMAT)
allocate(ODMAT(NSBASIS * NSBASIS * NSPINS))
call LogMemAlloc('ODMAT', NSBASIS * NSBASIS * NSPINS, HElement_t_size * 8, this_routine, tagODMAT)
allocate(WORK(NSBASIS * 3))
call LogMemAlloc('WORK', NSBASIS * 3, HElement_t_size * 8, this_routine, tagWORK)
allocate(R1(NSBASIS * NSBASIS))
call LogMemAlloc('R1', NSBASIS * NSBASIS, HElement_t_size * 8, this_routine, tagR1)
allocate(R2(NSBASIS * NSBASIS))
call LogMemAlloc('R2', NSBASIS * NSBASIS, HElement_t_size * 8, this_routine, tagR2)
allocate(HFES(NSBASIS * NSPINS))
call LogMemAlloc('HFES', NSBASIS * NSPINS, 8, this_routine, tagHFES)
!.. Generate initial HFBASIS vectors as the energy ordered single
!.. particle basis fns, separated into up and down blocks
FMAT = (0.0_dp)
DMAT = (0.0_dp)
IF (IHFMETHOD == 0 .OR. IHFMETHOD == -1) THEN
CALL UHFSCF(NBASIS, G1, BRR, ECORE, HFE, HFBASIS, NHFIT, NEL, MS, FMAT, &
DMAT, ODMAT, WORK, NSPINS, NSBASIS, HFES, OFMAT, &
HFMIX, EDELTA, CDELTA, TRHF, R1, R2, &
IHFMETHOD, TREADHF, FRAND, HFDET, ILOGGING)
ELSE
CALL UHFGRADDESC(NBASIS, NBASISMAX, G1, BRR, ECORE, &
UMAT, HFE, HFBASIS, NHFIT, NEL, MS, NSPINS, NSBASIS, HFES, &
HFMIX, FMAT, OFMAT, DMAT, ODMAT, EDELTA, CDELTA, R1, R2, WORK, TRHF, &
IHFMETHOD, TREADHF, FRAND, HFDET, ILOGGING)
END IF
deallocate(FMAT, OFMAT, DMAT, ODMAT, WORK, R1, R2, HFES)
call LogMemDealloc(this_routine, tagFMAT)
call LogMemDealloc(this_routine, tagOFMAT)
call LogMemDealloc(this_routine, tagDMAT)
call LogMemDealloc(this_routine, tagODMAT)
call LogMemDealloc(this_routine, tagWORK)
call LogMemDealloc(this_routine, tagR1)
call LogMemDealloc(this_routine, tagR2)
call LogMemDealloc(this_routine, tagHFES)
END subroutine CALCHFBASIS