write_tau_opt Subroutine

private subroutine write_tau_opt(parent)

Arguments

Type IntentOptional Attributes Name
integer(kind=hid_t), intent(in) :: parent

Contents

Source Code


Source Code

    subroutine write_tau_opt(parent)

        use FciMCData, only: pSingles, pDoubles, pParallel
        use tc_three_body_data, only: pTriples

        integer(hid_t), intent(in) :: parent
        integer(hid_t) :: tau_grp
        integer(hdf_err) :: err

        real(dp) :: max_gam_sing, max_gam_doub, max_gam_trip, max_gam_opp, max_gam_par
        real(dp) :: max_max_death_cpt
        logical :: all_en_sing, all_en_doub, all_en_trip, all_en_opp, all_en_par
        integer :: max_cnt_sing, max_cnt_doub, max_cnt_trip, max_cnt_opp, max_cnt_par

        real(dp) :: all_pdoub, all_psing, all_ppar, all_tau, all_ptrip

        ! Create the group
        call h5gcreate_f(parent, nm_tau_grp, tau_grp, err)

        ! We want to use the maximised values across all the processors
        ! (there is nothing ensuring that all the processors are adjusted to
        ! the same values...)
        call MPIAllReduce(tau_search_stats%gamma_sing, MPI_MAX, max_gam_sing)
        call MPIAllReduce(tau_search_stats%gamma_doub, MPI_MAX, max_gam_doub)
        call MPIAllReduce(tau_search_stats%gamma_trip, MPI_MAX, max_gam_trip)
        call MPIAllReduce(tau_search_stats%gamma_opp, MPI_MAX, max_gam_opp)
        call MPIAllReduce(tau_search_stats%gamma_par, MPI_MAX, max_gam_par)
        call MPIAllReduce(max_death_cpt, MPI_MAX, max_max_death_cpt)
        call MPIAllLORLogical(tau_search_stats%enough_sing, all_en_sing)
        call MPIAllLORLogical(tau_search_stats%enough_doub, all_en_doub)
        call MPIAllLORLogical(tau_search_stats%enough_trip, all_en_trip)
        call MPIAllLORLogical(tau_search_stats%enough_opp, all_en_opp)
        call MPIAllLORLogical(tau_search_stats%enough_par, all_en_par)
        call MPIAllReduce(tau_search_stats%cnt_sing, MPI_MAX, max_cnt_sing)
        call MPIAllReduce(tau_search_stats%cnt_doub, MPI_MAX, max_cnt_doub)
        call MPIAllReduce(tau_search_stats%cnt_trip, MPI_MAX, max_cnt_trip)
        call MPIAllReduce(tau_search_stats%cnt_opp, MPI_MAX, max_cnt_opp)
        call MPIAllReduce(tau_search_stats%cnt_par, MPI_MAX, max_cnt_par)

        if (.not. near_zero(max_gam_sing)) &
            call write_dp_scalar(tau_grp, nm_gam_sing, max_gam_sing)
        if (.not. near_zero(max_gam_doub)) &
            call write_dp_scalar(tau_grp, nm_gam_doub, max_gam_doub)
        if (.not. near_zero(max_gam_trip)) &
            call write_dp_scalar(tau_grp, nm_gam_trip, max_gam_trip)
        if (.not. near_zero(max_gam_opp)) &
            call write_dp_scalar(tau_grp, nm_gam_opp, max_gam_opp)
        if (.not. near_zero(max_gam_par)) &
            call write_dp_scalar(tau_grp, nm_gam_par, max_gam_par)
        if (.not. near_zero(max_max_death_cpt)) &
            call write_dp_scalar(tau_grp, nm_max_death, max_max_death_cpt)
        if (all_en_sing) &
            call write_log_scalar(tau_grp, nm_en_sing, all_en_sing)
        if (all_en_doub) &
            call write_log_scalar(tau_grp, nm_en_doub, all_en_doub)
        if (all_en_trip) &
            call write_log_scalar(tau_grp, nm_en_trip, all_en_trip)
        if (all_en_opp) &
            call write_log_scalar(tau_grp, nm_en_opp, all_en_opp)
        if (all_en_par) &
            call write_log_scalar(tau_grp, nm_en_par, all_en_par)
        if (max_cnt_sing /= 0) &
            call write_int64_scalar(tau_grp, nm_cnt_sing, max_cnt_sing)
        if (max_cnt_doub /= 0) &
            call write_int64_scalar(tau_grp, nm_cnt_doub, max_cnt_doub)
        if (max_cnt_trip /= 0) &
            call write_int64_scalar(tau_grp, nm_cnt_trip, max_cnt_trip)
        if (max_cnt_opp /= 0) &
            call write_int64_scalar(tau_grp, nm_cnt_opp, max_cnt_opp)
        if (max_cnt_par /= 0) &
            call write_int64_scalar(tau_grp, nm_cnt_par, max_cnt_par)

        ! Use the probability values from the head node
        all_psing = pSingles; all_pdoub = pDoubles; all_ptrip = pTriples; all_ppar = pParallel
        all_tau = tau
        call MPIBcast(all_psing)
        call MPIBcast(all_pdoub)
        call MPIBCast(all_ptrip)
        call MPIBcast(all_ppar)
        call MPIBcast(all_tau)

        call write_dp_scalar(tau_grp, nm_psingles, all_psing)
        call write_dp_scalar(tau_grp, nm_pdoubles, all_pdoub)
        call write_dp_scalar(tau_grp, nm_ptriples, all_ptrip)
        call write_dp_scalar(tau_grp, nm_pparallel, all_ppar)
        call write_dp_scalar(tau_grp, nm_tau, all_tau)

        ! [W.D.]:
        ! for the new hist-tau search i essentially only need to indicat
        ! that a histogramming tau-search was used:
        if (allocated(input_tau_search_method)) then
            if (input_tau_search_method == possible_tau_search_methods%HISTOGRAMMING) then
                call write_log_scalar(tau_grp, nm_hist_tau, .true.)
            end if
        end if

        ! Clear up
        call h5gclose_f(tau_grp, err)

    end subroutine write_tau_opt