subroutine PrintROFCIDUMP()
! This prints out a new FCIDUMP file in the same format as the old one.
integer :: i, j, k, l, iunit
character(len=5) :: Label
character(len=20) :: LabelFull
PrintROFCIDUMP_Time%timer_name = 'PrintROFCIDUMP'
call set_timer(PrintROFCIDUMP_Time, 30)
Label = ''
LabelFull = ''
write(Label, '(I5)') NoFrozenVirt
LabelFull = 'ROFCIDUMP-'//adjustl(Label)
iunit = get_free_unit()
open(iunit, file=LabelFull, status='unknown')
write(iunit, '(2A6, I3, A7, I3, A5, I2, A)') '&FCI ', 'NORB = ', (NoOrbs - (NoFrozenVirt)), ', NELEC = ', NEl, ', MS2 = ', LMS, ','
write(iunit, '(A9)', advance='no') 'ORBSYM = '
do i = 1, (NoOrbs - (NoFrozenVirt))
if ((tUseMP2VarDenMat .or. tFindCINatOrbs) .and. (.not. lNoSymmetry) .and. tTruncRODump) then
write(iunit, '(I1, A1)', advance='no') (SymOrbs_rot(i) + 1), ','
else
if (tStoreSpinOrbs) then
write(iunit, '(I1, A1)', advance='no') (int(G1(i)%sym%S) + 1), ','
else
write(iunit, '(I1, A1)', advance='no') (int(G1(i * 2)%sym%S) + 1), ','
end if
end if
end do
write(iunit, *) ''
if (tStoreSpinOrbs) then
write(iunit, '(A7, I1, A11)') 'ISYM = ', 1, ' UHF = .TRUE.'
else
write(iunit, '(A7, I1)') 'ISYM = ', 1
end if
write(iunit, '(A5)') '&end'
do i = 1, (NoOrbs - (NoFrozenVirt))
do k = 1, i
do j = 1, (NoOrbs - (NoFrozenVirt))
! Potential to put symmetry in here, have currently taken
! it out, because when we're only printing non-zero values,
! it is kind of unnecessary - although it may be used to
! speed things up.
do l = 1, j
if (.not. near_zero(real(UMat(UMatInd(i, j, k, l)), dp))) &
&write(iunit, '(F21.12, 4I3)') real(UMat(UMatInd(i, j, k, l)), dp), i, k, j, l
end do
end do
end do
end do
! TMAT2D stored as spin orbitals.
do k = 1, (NoOrbs - (NoFrozenVirt))
! Symmetry?
do i = k, (NoOrbs - (NoFrozenVirt))
if (tStoreSpinOrbs) then
if (.not. near_zero(real(TMAT2D(i, k), dp))) write(iunit, '(F21.12, 4I3)') real(TMAT2D(i, k), dp), i, k, 0, 0
else
if (.not. near_zero(real(TMAT2D(2 * i, 2 * k), dp))) write(iunit, '(F21.12, 4I3)') real(TMAT2D(2 * i, 2 * k), dp), i, k, 0, 0
end if
end do
end do
! ARR has the energies of the orbitals (eigenvalues). ARR(:,2) has ordering we want.
! ARR is stored as spin orbitals.
do k = 1, (NoOrbs - (NoFrozenVirt))
if (tStoreSpinOrbs) then
write(iunit, '(F21.12, 4I3)') Arr(k, 2), k, 0, 0, 0
else
write(iunit, '(F21.12, 4I3)') Arr(2 * k, 2), k, 0, 0, 0
end if
end do
write(iunit, '(F21.12, 4I3)') ECore, 0, 0, 0, 0
call neci_flush(iunit)
close(iunit)
call halt_timer(PrintROFCIDUMP_Time)
end subroutine PrintROFCIDUMP