order_one_rdm Subroutine

public subroutine order_one_rdm(rdm)

Arguments

Type IntentOptional Attributes Name
type(one_rdm_t), intent(inout) :: rdm

Contents

Source Code


Source Code

    subroutine order_one_rdm(rdm)

        ! Here, if symmetry is kept, we are going to have to reorder the
        ! eigenvectors according to the size of the eigenvalues, while taking
        ! the orbital labels (and therefore symmetries) with them. This will
        ! be put back into MP2VDM from MP2VDMTemp.

        ! Want to reorder the eigenvalues from largest to smallest, taking the
        ! eigenvectors with them and the symmetry as well. If using spin
        ! orbitals, do this for the alpha spin and then the beta.

        ! The newly sorted SymLabelList2_rot and SymLabelListInv_rot will be
        ! stored in rdm%sym_list_no and rdm%sym_list_inv_no (as they are
        ! specific to this RDM).

        use MemoryManager, only: LogMemAlloc
        use rdm_data, only: tOpenShell, one_rdm_t
        use sort_mod, only: sort
        use SystemData, only: nbasis

        type(one_rdm_t), intent(inout) :: rdm

        integer :: spin, i, j, ierr, StartSort, EndSort
        character(len=*), parameter :: t_r = 'order_one_rdm'
        integer, allocatable :: SymLabelList_temp(:)
        real(dp), allocatable :: one_rdm_Temp(:, :), EvaluesTemp(:)
        integer :: Orb, New_Pos

        ! Temporary arrays.
        allocate(one_rdm_Temp(NoOrbs, NoOrbs), stat=ierr)
        allocate(SymLabelList_temp(NoOrbs), stat=ierr)
        allocate(EvaluesTemp(NoOrbs), stat=ierr)

        ! This is just a temporary array for some sorting.
        SymLabelList_temp = SymLabelList2_rot

        ! This object will contain the updated version of SymLabelList2_rot,
        ! specifically for this RDM, and ordered with the 1-RDM eigenvalues.
        rdm%sym_list_no = SymLabelList2_rot

        StartSort = 1
        EndSort = SpatOrbs

        ! Unfortunately this sort routine orders the orbitals in ascending
        ! order... which is not quite what we want.  Just remember this when
        ! printing out the Evalues.
        call sort(rdm%EValues(startSort:endSort), &
                  rdm%matrix(1:NoOrbs, startSort:endSort), &
                  rdm%sym_list_no(startSort:endSort))

        if (tOpenShell) then
            StartSort = SpatOrbs + 1
            EndSort = nBasis

            call sort(rdm%EValues(startSort:endSort), &
                      rdm%matrix(1:NoOrbs, startSort:endSort), &
                      rdm%sym_list_no(startSort:endSort))

        end if

        ! We now have the NO's ordered according to the size of their Evalues
        ! (occupation numbers).  This will have jumbled up their symmetries.
        ! Want to reorder the MO's to match this ordering (so that we only
        ! have one SymLabelList array).

        ! Need a new SymLabelListInv_rot too. This will be stored in
        ! rdm%sym_list_inv_no.
        rdm%sym_list_inv_no = 0
        do i = 1, NoOrbs
            rdm%sym_list_inv_no(rdm%sym_list_no(NoOrbs - i + 1)) = i
        end do

        one_rdm_Temp = rdm%matrix
        rdm%matrix = 0.0_dp

        do i = 1, NoOrbs
            do j = 1, NoOrbs

                ! In position j, the MO orbital Orb is currently there.
                Orb = SymLabelList_temp(j)

                ! Want to move it to the position the NO's are in.
                New_Pos = rdm%sym_list_inv_no(Orb)

                ! But we also want to reverse the order of everything...
                rdm%matrix(New_Pos, NoOrbs - i + 1) = one_rdm_Temp(j, i)
            end do
        end do

        SymLabelList_temp = rdm%sym_list_no
        EvaluesTemp = rdm%evalues
        do i = 1, NoOrbs
            rdm%sym_list_no(i) = SymLabelList_temp(NoOrbs - i + 1)
            rdm%evalues(i) = EvaluesTemp(NoOrbs - i + 1)
        end do

        deallocate(one_rdm_Temp)
        deallocate(SymLabelList_temp)
        deallocate(EvaluesTemp)

    end subroutine order_one_rdm