Perform a basic blocking of the text in message and print it optionally decorated with a frame of stars as defined by declev.
after : Number of empty lines after the message. before : Number of empty lines before the message. declev : Decoration level (0,1,2, ... star lines). message : String with the message text. output_unit: Logical unit number of output unit.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | message | |||
integer, | intent(in) | :: | output_unit | |||
integer, | intent(in), | optional | :: | declev | ||
integer, | intent(in), | optional | :: | before | ||
integer, | intent(in), | optional | :: | after |
SUBROUTINE print_message(message, output_unit, declev, before, after)
!! Perform a basic blocking of the text in message and print it
!! optionally decorated with a frame of stars as defined by declev.
!! @note
!! after : Number of empty lines after the message.
!! before : Number of empty lines before the message.
!! declev : Decoration level (0,1,2, ... star lines).
!! message : String with the message text.
!! output_unit: Logical unit number of output unit.
CHARACTER(LEN=*), INTENT(IN) :: message
INTEGER, INTENT(IN) :: output_unit
INTEGER, INTENT(IN), OPTIONAL :: declev, before, after
INTEGER :: blank_lines_after, blank_lines_before, &
decoration_level, i, ibreak, ipos1, &
ipos2, maxrowlen, msglen, nrow, rowlen
IF (PRESENT(after)) THEN
blank_lines_after = MAX(after, 0)
ELSE
blank_lines_after = 1
END IF
IF (PRESENT(before)) THEN
blank_lines_before = MAX(before, 0)
ELSE
blank_lines_before = 1
END IF
IF (PRESENT(declev)) THEN
decoration_level = MAX(declev, 0)
ELSE
decoration_level = 0
END IF
IF (decoration_level == 0) THEN
rowlen = 78
ELSE
rowlen = 70
END IF
msglen = LEN_TRIM(message)
! Calculate number of rows
nrow = msglen/(rowlen + 1) + 1
! Calculate appropriate row length
rowlen = MIN(msglen, rowlen)
! Generate the blank lines before the message
DO i = 1, blank_lines_before
WRITE (UNIT=output_unit, FMT="(A)") ""
END DO
! Scan for the longest row
ipos1 = 1
ipos2 = rowlen
maxrowlen = 0
DO
IF (ipos2 < msglen) THEN
i = INDEX(message(ipos1:ipos2), " ", BACK=.TRUE.)
IF (i == 0) THEN
ibreak = ipos2
ELSE
ibreak = ipos1 + i - 2
END IF
ELSE
ibreak = ipos2
END IF
maxrowlen = MAX(maxrowlen, ibreak - ipos1 + 1)
ipos1 = ibreak + 2
ipos2 = MIN(msglen, ipos1 + rowlen - 1)
! When the last row is processed, exit loop
IF (ipos1 > msglen) EXIT
END DO
! Generate the first set of star rows
IF (decoration_level > 1) THEN
DO i = 1, decoration_level - 1
WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", maxrowlen + 8)
END DO
END IF
! Break long messages
ipos1 = 1
ipos2 = rowlen
DO
IF (ipos2 < msglen) THEN
i = INDEX(message(ipos1:ipos2), " ", BACK=.TRUE.)
IF (i == 0) THEN
ibreak = ipos2
ELSE
ibreak = ipos1 + i - 2
END IF
ELSE
ibreak = ipos2
END IF
IF (decoration_level == 0) THEN
WRITE (UNIT=output_unit, FMT="(T2,A)") message(ipos1:ibreak)
ELSE IF (decoration_level > 0) THEN
WRITE (UNIT=output_unit, FMT="(T2,A)") &
"*** "//message(ipos1:ibreak)//REPEAT(" ", ipos1 + maxrowlen - ibreak)//"***"
END IF
ipos1 = ibreak + 2
ipos2 = MIN(msglen, ipos1 + rowlen - 1)
! When the last row is processed, exit loop
IF (ipos1 > msglen) EXIT
END DO
! Generate the second set star rows
IF (decoration_level > 1) THEN
DO i = 1, decoration_level - 1
WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", maxrowlen + 8)
END DO
END IF
! Generate the blank lines after the message
DO i = 1, blank_lines_after
WRITE (UNIT=output_unit, FMT="(A)") ""
END DO
END SUBROUTINE print_message