FreezeUMAT2D Subroutine

    SUBROUTINE FreezeUMAT2D(OldBasis, NewBasis, OrbTrans, iSS)
        INTEGER NewBasis, OldBasis, iSS, ierr, OrbTrans(OldBasis), i, j
        HElement_t(dp), POINTER :: NUMat2D(:, :)
        integer(TagIntType) :: tagNUMat2D = 0
        character(len=*), parameter :: thisroutine = 'FreezeUMat2D'

        allocate(NUMat2D(NewBasis / iSS, NewBasis / iSS), STAT=ierr)
        call LogMemAlloc('UMat2D',(NewBasis / iSS)**2, 8 * HElement_t_size, thisroutine, tagNUMat2D, ierr)
        NUMat2D(:, :) = (0.0_dp)
        DO i = 1, OldBasis / 2
            IF (OrbTrans(i * 2) /= 0) THEN
                DO j = 1, OldBasis / 2
                    IF (OrbTrans(j * 2) /= 0) THEN
                        NUMat2D(OrbTrans(i * 2) / 2, OrbTrans(j * 2) / 2) = UMat2D(i, j)
                    end if
                end do
            end if
        end do
        call LogMemDealloc(thisroutine, tagUMat2D)
        Deallocate(UMat2D)
        UMat2D => NUMat2D
        NULLIFY(NUMat2D)
        tagUMat2D = tagNUMat2D
        RETURN
    END SUBROUTINE FreezeUMAT2D