print_averaged_ci_coeff Subroutine

private subroutine print_averaged_ci_coeff()

Arguments

None

Contents


Source Code

    subroutine print_averaged_ci_coeff
        integer  :: i, ic, ex(2, 4), iCI, unit_CIav
        real(dp) :: sign_tmp(lenof_sign), ref_coef
        logical  :: tPar

        totEntCoeff(:, :) = 0
        iCILoop0: do iCI = 0, n_store_ci_level
            if (iCI /= 0) open (newunit=unit_CIav, file='ci_coeff_'//str(iCI)//'_av', status='replace')
            ! loop over the total entries of CI coefficients
            do i = 1, root_first_free_entry
                ic = n_store_ci_level + 1
                ! gets the excitation level of the CI coefficient
                call get_bit_excitmat(iLutRef(:, 1), root_ciCoeff_storage(:, i), ex, ic)
                if (iCI == ic) then
                    ! gets the value of the CI coefficient (i.e. the number of walkers)
                    call extract_sign(root_ciCoeff_storage(:, i), sign_tmp)
                    ex(1, 1) = ic
                    ! gets the sign of the CI coef (tPar=true if odd number of permutations)
                    call GetBitExcitation(ilutRef(:, 1), root_ciCoeff_storage(:, i), ex, tPar)
                    if (tPar) sign_tmp = -sign_tmp

                    select case (iCI) ! writing averaged CI coefficients
                    case (0)  ! reference
                        write (stdout, "(A45,F14.3)") 'Instantaneous number of walkers on HF     : ', AllNoatHF
                        ref_coef = -sign_tmp(1)
                        write (stdout, "(A45,F14.3)") 'Averaged number of walkers on HF          : ', -sign_tmp/nCyc
                        write (stdout, "(A45,I10)") 'Total entries of CI coefficients          : ', root_first_free_entry
                    case (1)  ! singles
                        totEntCoeff(iCI, 1) = totEntCoeff(iCI, 1) + 1        ! total entries for singles
                        if (.not. near_zero(sign_tmp(1))) then
                            totEntCoeff(iCI, 2) = totEntCoeff(iCI, 2) + 1    ! total entries for singles without zeros
                            write (unit_CIav, '(G20.12,2I5)') sign_tmp/ref_coef, ex(1, 1), ex(2, 1)
                        end if
                    case (2)  ! doubles
                        totEntCoeff(iCI, 1) = totEntCoeff(iCI, 1) + 1        ! total entries for doubles
                        if (.not. near_zero(sign_tmp(1))) then
                            totEntCoeff(iCI, 2) = totEntCoeff(iCI, 2) + 1    ! total entries for doubles without zeros
                            write (unit_CIav, '(G20.12,4I5)') sign_tmp/ref_coef, ex(1, 1), ex(2, 1), &
                                                                                 ex(1, 2), ex(2, 2)
                        end if
                    case (3)  ! triples
                        totEntCoeff(iCI, 1) = totEntCoeff(iCI, 1) + 1        ! total entries for triples
                        if (.not. near_zero(sign_tmp(1))) then
                            totEntCoeff(iCI, 2) = totEntCoeff(iCI, 2) + 1    ! total entries for triples without zeros
                            write (unit_CIav, '(G20.12,6I5)') sign_tmp/ref_coef, ex(1, 1), ex(2, 1), &
                                                             ex(1, 2), ex(2, 2), ex(1, 3), ex(2, 3)
                        end if
                    end select
                end if
            end do
            if (iCI /= 0) then
                close (unit_CIav)
                write (stdout, "(A31,I1,A12,I11)") 'total entries CI coeff. with ', iCI, 'excit.    :', totEntCoeff(iCI, 1)
                if (totEntCoeff(iCI, 1) /= totEntCoeff(iCI, 2)) then
                    write (stdout, "(A17,A27,I11)") '- without zeros', ':', totEntCoeff(iCI, 2)
                end if
            end if
        end do iCILoop0
    end subroutine print_averaged_ci_coeff