print_abort_message Subroutine

   SUBROUTINE print_abort_message(message, location, output_unit)
      !! Prints a nicely formatted abort message box
      CHARACTER(LEN=*), INTENT(IN)                       :: message, location
      INTEGER, INTENT(IN)                                :: output_unit

      CHARACTER(LEN=*), PARAMETER :: img = "   ___   "//"  /   \  "//" [ABORT] "//"  \___/  "// &
                                     "    |    "//"  O/|    "//" /| |    "//" / \     "
      INTEGER, PARAMETER :: img_height = 8, img_width = 9, screen_width = 80, &
                            txt_width = screen_width - img_width - 5

      CHARACTER(LEN=screen_width)                        :: msg_line
      INTEGER                                            :: a, b, c, fill, i, img_start, indent, &
                                                            msg_height, msg_start

! count message lines

      a = 1; b = -1; msg_height = 0
      DO WHILE (b < LEN_TRIM(message))
         b = next_linebreak(message, a, txt_width)
         a = b + 1
         msg_height = msg_height + 1
      END DO

      ! calculate message and image starting lines
      IF (img_height > msg_height) THEN
         msg_start = (img_height - msg_height)/2 + 1
         img_start = 1
      ELSE
         msg_start = 1
         img_start = msg_height - img_height + 2
      END IF

      ! print empty line
      WRITE (UNIT=output_unit, FMT="(A)") ""

      ! print opening line
      WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", screen_width - 1)

      ! print body
      a = 1; b = -1; c = 1
      DO i = 1, MAX(img_height - 1, msg_height)
         WRITE (UNIT=output_unit, FMT="(A)", advance='no') " *"
         IF (i < img_start) THEN
            WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", img_width)
         ELSE
            WRITE (UNIT=output_unit, FMT="(A)", advance='no') img(c:c + img_width - 1)
            c = c + img_width
         END IF
         IF (i < msg_start) THEN
            WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", txt_width + 2)
         ELSE
            b = next_linebreak(message, a, txt_width)
            msg_line = message(a:b)
            a = b + 1
            fill = (txt_width - LEN_TRIM(msg_line))/2 + 1
            indent = txt_width - LEN_TRIM(msg_line) - fill + 2
            WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", indent)
            WRITE (UNIT=output_unit, FMT="(A)", advance='no') TRIM(msg_line)
            WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", fill)
         END IF
         WRITE (UNIT=output_unit, FMT="(A)", advance='yes') "*"
      END DO

      ! print location line
      WRITE (UNIT=output_unit, FMT="(A)", advance='no') " *"
      WRITE (UNIT=output_unit, FMT="(A)", advance='no') img(c:c + img_width - 1)
      indent = txt_width - LEN_TRIM(location) + 1
      WRITE (UNIT=output_unit, FMT="(A)", advance='no') REPEAT(" ", indent)
      WRITE (UNIT=output_unit, FMT="(A)", advance='no') TRIM(location)
      WRITE (UNIT=output_unit, FMT="(A)", advance='yes') " *"

      ! print closing line
      WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", screen_width - 1)

      ! print empty line
      WRITE (UNIT=output_unit, FMT="(A)") ""

   END SUBROUTINE print_abort_message