print_cc_amplitudes Subroutine

public subroutine print_cc_amplitudes(hash_table, hash_size)

Uses

Arguments

Type IntentOptional Attributes Name
type(cc_hash), intent(in), optional, pointer :: hash_table(:)
integer, intent(in), optional :: hash_size

Contents

Source Code


Source Code

    subroutine print_cc_amplitudes(hash_table, hash_size)
        ! routine to print out the cc-amplitudes to check there
        ! magnitude
        use util_mod, only: get_free_unit, get_unique_filename
        type(cc_hash), pointer, intent(in), optional :: hash_table(:)
        integer, intent(in), optional :: hash_size
        character(*), parameter :: this_routine = "print_cc_amplitudes"
        integer :: i, j, iunit
        character(12) :: filename
        character(1) :: x1
        type(cc_hash), pointer :: temp_node

        if (.not. allocated(cc_ops)) then
            print *, "cc amplitudes not yet allocated! cant print!"
            return
        end if

        if (present(hash_table)) then
            ASSERT(present(hash_size))

            iunit = get_free_unit()
            call get_unique_filename('cc_amps_4_wf', .true., .true., 1, &
                                     filename)

            open(iunit, file=filename, status='unknown')

            ! i have to do the quads special since it is stored in a hash..
            print *, "hash size_wf: ", hash_size
            do i = 1, hash_size
                temp_node => hash_table(i)

                if (temp_node%found) then
                    write(iunit, '(f15.7)') abs(temp_node%amp)

                end if

                do while (associated(temp_node%next))
                    if (temp_node%next%found) then
                        write(iunit, '(f15.7)') abs(temp_node%next%amp)
                    end if

                    temp_node => temp_node%next

                end do
            end do
            close(iunit)

            return
        end if

        if (iProcIndex == root) then
            do i = 1, 3
                ! open 4 files to print the cc-amps
                iunit = get_free_unit()
                write(x1, '(I1)') i
                call get_unique_filename('cc_amps_'//trim(x1), .true., .true., 1, &
                                         filename)
                open(iunit, file=filename, status='unknown')

                do j = 1, cc_ops(i)%n_ops
                    if (abs(cc_ops(i)%get_amp(j)) < EPS) cycle
                    write(iunit, '(f15.7)') abs(cc_ops(i)%get_amp(j))
                end do

                close(iunit)

            end do

            iunit = get_free_unit()
            call get_unique_filename('cc_amps_4', .true., .true., 1, &
                                     filename)

            open(iunit, file=filename, status='unknown')

            ! i have to do the quads special since it is stored in a hash..
            print *, "hash size: ", quad_hash_size
            do i = 1, quad_hash_size
                temp_node => quad_hash(i)

                if (temp_node%found) then
                    write(iunit, '(f15.7)') abs(temp_node%amp)

                end if

                do while (associated(temp_node%next))
                    if (temp_node%next%found) then
                        write(iunit, '(f15.7)') abs(temp_node%next%amp)
                    end if

                    temp_node => temp_node%next

                end do
            end do
            close(iunit)
        end if

    end subroutine print_cc_amplitudes