print_reports Subroutine

private subroutine print_reports(reports, iw, threshold, sort_by_exclusiv_cost, cost_type, report_maxloc, mp_env)

Print the collected reports

Arguments

Type IntentOptional Attributes Name
type(list_routinereport_type), intent(in) :: reports
integer, intent(in) :: iw
real(kind=dp), intent(in) :: threshold
logical, intent(in) :: sort_by_exclusiv_cost
integer, intent(in) :: cost_type
logical, intent(in) :: report_maxloc
type(dbcsr_mp_obj), intent(in) :: mp_env

Source Code

   SUBROUTINE print_reports(reports, iw, threshold, sort_by_exclusiv_cost, cost_type, report_maxloc, mp_env)
      !! Print the collected reports
      TYPE(list_routinereport_type), INTENT(IN)          :: reports
      INTEGER, INTENT(IN)                                :: iw
      REAL(KIND=dp), INTENT(IN)                          :: threshold
      LOGICAL, INTENT(IN)                                :: sort_by_exclusiv_cost
      INTEGER, INTENT(IN)                                :: cost_type
      LOGICAL, INTENT(IN)                                :: report_maxloc
      TYPE(dbcsr_mp_obj), INTENT(IN)                     :: mp_env

      CHARACTER(LEN=4)                                   :: label
      CHARACTER(LEN=default_string_length)               :: fmt, title
      INTEGER                                            :: decimals, i, j, num_routines
      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: indices
      REAL(KIND=dp)                                      :: asd, maxcost, mincost
      REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: max_costs
      TYPE(routine_report_type), POINTER                 :: r_report_i, r_report_j

      NULLIFY (r_report_i, r_report_j)
      IF (.NOT. list_isready(reports)) &
         DBCSR_ABORT("BUG")

      ! are we printing timing or energy ?
      SELECT CASE (cost_type)
      CASE (cost_type_energy)
         title = "E N E R G Y"
         label = "ENER"
      CASE (cost_type_time)
         title = "T I M I N G"
         label = "TIME"
      CASE DEFAULT
         DBCSR_ABORT("BUG")
      END SELECT

      ! write banner
      WRITE (UNIT=iw, FMT="(/,T2,A)") REPEAT("-", 79)
      WRITE (UNIT=iw, FMT="(T2,A,T80,A)") "-", "-"
      WRITE (UNIT=iw, FMT="(T2,A,T35,A,T80,A)") "-", TRIM(title), "-"
      WRITE (UNIT=iw, FMT="(T2,A,T80,A)") "-", "-"
      WRITE (UNIT=iw, FMT="(T2,A)") REPEAT("-", 79)
      IF (report_maxloc) THEN
         WRITE (UNIT=iw, FMT="(T2,A,T35,A,T41,A,T45,2A18,A8)") &
            "SUBROUTINE", "CALLS", " ASD", "SELF "//label, "TOTAL "//label, "MAXRANK"
      ELSE
         WRITE (UNIT=iw, FMT="(T2,A,T35,A,T41,A,T45,2A18)") &
            "SUBROUTINE", "CALLS", " ASD", "SELF "//label, "TOTAL "//label
      END IF

      WRITE (UNIT=iw, FMT="(T33,A)") &
         "MAXIMUM       AVERAGE  MAXIMUM  AVERAGE  MAXIMUM"

      ! sort statistics
      num_routines = list_size(reports)
      ALLOCATE (max_costs(num_routines))
      DO i = 1, num_routines
         r_report_i => list_get(reports, i)
         IF (sort_by_exclusiv_cost) THEN
            max_costs(i) = r_report_i%max_ecost
         ELSE
            max_costs(i) = r_report_i%max_icost
         END IF
      END DO
      ALLOCATE (indices(num_routines))
      CALL sort(max_costs, num_routines, indices)

      maxcost = MAXVAL(max_costs)
      mincost = maxcost*threshold

      ! adjust fmt dynamically based on the max walltime.
      ! few clocks have more than 3 digits resolution, so stop there
      decimals = 3
      IF (maxcost >= 10000) decimals = 2
      IF (maxcost >= 100000) decimals = 1
      IF (maxcost >= 1000000) decimals = 0
      IF (report_maxloc) THEN
         WRITE (UNIT=fmt, FMT="(A,I0,A)") &
            "(T2,A30,1X,I7,1X,F4.1,4(1X,F8.", decimals, "),I8)"
      ELSE
         WRITE (UNIT=fmt, FMT="(A,I0,A)") &
            "(T2,A30,1X,I7,1X,F4.1,4(1X,F8.", decimals, "))"
      END IF

      !write output
      DO i = num_routines, 1, -1
         IF (max_costs(i) >= mincost) THEN
            j = indices(i)
            r_report_j => list_get(reports, j)
            ! average stack depth
            asd = REAL(r_report_j%sum_stackdepth, KIND=dp)/ &
                  REAL(MAX(1_int_8, r_report_j%sum_total_calls), KIND=dp)
            IF (report_maxloc) THEN
               WRITE (UNIT=iw, FMT=fmt) &
                  ADJUSTL(r_report_j%routineN(1:31)), &
                  r_report_j%max_total_calls, &
                  asd, &
                  r_report_j%sum_ecost/mp_env%mp%numnodes, &
                  r_report_j%max_ecost, &
                  r_report_j%sum_icost/mp_env%mp%numnodes, &
                  r_report_j%max_icost, &
                  r_report_j%max_erank
            ELSE
               WRITE (UNIT=iw, FMT=fmt) &
                  ADJUSTL(r_report_j%routineN(1:31)), &
                  r_report_j%max_total_calls, &
                  asd, &
                  r_report_j%sum_ecost/mp_env%mp%numnodes, &
                  r_report_j%max_ecost, &
                  r_report_j%sum_icost/mp_env%mp%numnodes, &
                  r_report_j%max_icost
            END IF
         END IF
      END DO
      WRITE (UNIT=iw, FMT="(T2,A,/)") REPEAT("-", 79)

   END SUBROUTINE print_reports