read_1rdm Subroutine

public subroutine read_1rdm(rdm_defs, one_rdm, irdm)

Arguments

Type IntentOptional Attributes Name
type(rdm_definitions_t), intent(in) :: rdm_defs
type(one_rdm_t), intent(inout) :: one_rdm
integer, intent(in) :: irdm

Contents

Source Code


Source Code

    subroutine read_1rdm(rdm_defs, one_rdm, irdm)

        ! Read a 1-RDM POPSFILE file (with filename stem 'OneRDM_POPS.'), with
        ! label irdm. Copy it into the one_Rdm object.

        use rdm_data, only: one_rdm_t, rdm_definitions_t
        use RotateOrbsData, only: SymLabelListInv_rot
        use util_mod, only: get_free_unit, int_fmt

        type(rdm_definitions_t), intent(in) :: rdm_defs
        type(one_rdm_t), intent(inout) :: one_rdm
        integer, intent(in) :: irdm

        integer :: one_rdm_unit, file_end, i, j
        real(dp) :: rdm_sign
        logical :: file_exists
        character(20) :: filename
        character(len=*), parameter :: t_r = 'read_1rdm'

        write(stdout, '(1X,"Reading in the 1-RDMs...")')

        associate(state_labels => rdm_defs%state_labels, repeat_label => rdm_defs%repeat_label)
            if (state_labels(1, irdm) == state_labels(2, irdm)) then
                write(filename, '("OneRDM_POPS.",'//int_fmt(state_labels(1, irdm), 0)//')') irdm
            else
                write(filename, '("OneRDM_POPS.",'//int_fmt(state_labels(1, irdm), 0)//',"_",' &
                       //int_fmt(state_labels(2, irdm), 0)//',".",i1)') &
                    state_labels(1, irdm), state_labels(2, irdm), repeat_label(irdm)
            end if
        end associate

        inquire (file=trim(filename), exist=file_exists)

        if (.not. file_exists) then
            call stop_all(t_r, "Attempting to read in the 1-RDM from "//trim(filename)//", but this file does not exist.")
        end if

        one_rdm_unit = get_free_unit()
        open(one_rdm_unit, file=trim(filename), status='old', form='unformatted')

        do
            read(one_rdm_unit, iostat=file_end) i, j, rdm_sign
            if (file_end > 0) call stop_all(t_r, "Error reading "//trim(filename)//".")
            ! file_end < 0 => end of file reached.
            if (file_end < 0) exit

            one_rdm%matrix(SymLabelListInv_rot(i), SymLabelListInv_rot(j)) = rdm_sign
        end do

        close(one_rdm_unit)

    end subroutine read_1rdm