SetupUMatTransTable Subroutine

    SUBROUTINE SetupUMatTransTable(OldNew, nOld, nNew)
        ! Set up translational table for freezing.
        ! In:
        !    nOld: # of old states.
        !    nNew: # of new states.
        !    OldNew: convert index in the old (pre-freezing) indexing scheme to
        !            the new (post-freezing) indexing scheme.
        INTEGER nNew, nOld, I
        INTEGER OldNew(*), ierr
        LOGICAL tDiff
        character(*), parameter :: thisroutine = 'SetupUMatTransTable'
        allocate(TransTable(nNew / 2), STAT=ierr)
        call LogMemAlloc('TransTable', nNew / 2, 4, thisroutine, tagTransTable, ierr)
        allocate(InvTransTable(nOld / 2), STAT=ierr)
        call LogMemAlloc('InvTransTable', nOld / 2, 4, thisroutine, tagInvTransTable, ierr)
        InvTransTable(1:nOld / 2) = 0
        tDiff = .FALSE.
        DO I = 2, nOld, 2
            IF (OldNew(I) /= 0) THEN
                TransTable(OldNew(I) / 2) = I / 2
                InvTransTable(I / 2) = OldNew(I) / 2
                IF (OldNew(I) / 2 /= I / 2) tDiff = .TRUE.
            end if
        end do
        IF (tDiff) THEN
            write(stdout, *) "New->Old State Translation Table"
            DO I = 1, nNew / 2
                write(stdout, *) I, TransTable(I)
            end do
        end if
        TTRANSFINDX = .TRUE.
    END SUBROUTINE SetupUMatTransTable