stats_collect_from_ranks Subroutine

private subroutine stats_collect_from_ranks(report, group)

Collects statistics from all MPI-ranks

Arguments

Type IntentOptional Attributes Name
type(stats_type), intent(inout) :: report
type(mp_comm_type), intent(in) :: group

Source Code

   SUBROUTINE stats_collect_from_ranks(report, group)
      !! Collects statistics from all MPI-ranks
      TYPE(stats_type), INTENT(INOUT)                    :: report
      TYPE(mp_comm_type), INTENT(IN)                                :: group

      INTEGER                                            :: i, myrank, nranks, sending_rank
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: mnk_collected
      INTEGER, DIMENSION(3)                              :: mnk

!$OMP     MASTER

      CALL mp_environ(nranks, myrank, group)

      report%max_acc_flop = report%acc_flop
      CALL mp_max(report%max_acc_flop, group)
      report%max_smm_flop = report%smm_flop
      CALL mp_max(report%max_smm_flop, group)
      report%max_cpu_flop = report%cpu_flop
      CALL mp_max(report%max_cpu_flop, group)

      CALL mp_sum(report%acc_flop, group)
      CALL mp_sum(report%smm_flop, group)
      CALL mp_sum(report%cpu_flop, group)
      CALL mp_sum(report%cpu_num_stacks, group)
      CALL mp_sum(report%smm_num_stacks, group)
      CALL mp_sum(report%acc_num_stacks, group)

      ! array mnk_collected is used as a logical-array, allows to use minloc
      ALLOCATE (mnk_collected(SIZE(report%num_mnk_stacks, 1)))
      mnk_collected = 0 ! init all to false

      ! broadcast stats of all mnk-combinations, which occurred on any mpi rank
      DO
         ! each rank with uncollected stats tries to become the sending_rank
         sending_rank = -1
         IF (.NOT. ALL(mnk_collected == 1)) sending_rank = myrank
         CALL mp_max(sending_rank, group)
         IF (sending_rank < 0) EXIT ! every rank got all mnk collected

         IF (sending_rank == myrank) THEN
            i = MINLOC(mnk_collected, dim=1)
            mnk = INT(report%num_mnk_stacks(i, 1:3), kind=int_4)
         END IF
         CALL mp_bcast(msg=mnk, source=sending_rank, gid=group)

         CALL stats_add(report, m=mnk(1), n=mnk(2), k=mnk(3), stacksize_cpu=0_int_8, stacksize_acc=0_int_8)
         DO i = 1, SIZE(report%num_mnk_stacks, 1)
            IF (ALL(report%num_mnk_stacks(i, 1:3) == mnk)) THEN
               IF (i <= SIZE(mnk_collected)) mnk_collected(i) = 1
               CALL mp_sum(report%num_mnk_stacks(i, 4:10), group)
            END IF
         END DO
      END DO
!$OMP     END MASTER
   END SUBROUTINE stats_collect_from_ranks