22 #include "../base/base_uses.f90"
27 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'print_messages'
57 CHARACTER(LEN=*),
INTENT(IN) :: message
58 INTEGER,
INTENT(IN) :: output_unit
59 INTEGER,
INTENT(IN),
OPTIONAL :: declev, before, after
61 INTEGER :: blank_lines_after, blank_lines_before, &
62 decoration_level, i, ibreak, ipos1, &
63 ipos2, maxrowlen, msglen, nrow, rowlen
65 IF (
PRESENT(after))
THEN
66 blank_lines_after = max(after, 0)
71 IF (
PRESENT(before))
THEN
72 blank_lines_before = max(before, 0)
74 blank_lines_before = 1
77 IF (
PRESENT(declev))
THEN
78 decoration_level = max(declev, 0)
83 IF (decoration_level == 0)
THEN
89 msglen = len_trim(message)
93 nrow = msglen/(rowlen + 1) + 1
97 rowlen = min(msglen, rowlen)
101 DO i = 1, blank_lines_before
102 WRITE (unit=output_unit, fmt=
"(A)")
""
112 IF (ipos2 < msglen)
THEN
113 i = index(message(ipos1:ipos2),
" ", back=.true.)
117 ibreak = ipos1 + i - 2
123 maxrowlen = max(maxrowlen, ibreak - ipos1 + 1)
126 ipos2 = min(msglen, ipos1 + rowlen - 1)
130 IF (ipos1 > msglen)
EXIT
136 IF (decoration_level > 1)
THEN
137 DO i = 1, decoration_level - 1
138 WRITE (unit=output_unit, fmt=
"(T2,A)") repeat(
"*", maxrowlen + 8)
148 IF (ipos2 < msglen)
THEN
149 i = index(message(ipos1:ipos2),
" ", back=.true.)
153 ibreak = ipos1 + i - 2
159 IF (decoration_level == 0)
THEN
160 WRITE (unit=output_unit, fmt=
"(T2,A)") message(ipos1:ibreak)
161 ELSE IF (decoration_level > 0)
THEN
162 WRITE (unit=output_unit, fmt=
"(T2,A)") &
163 "*** "//message(ipos1:ibreak)//repeat(
" ", ipos1 + maxrowlen - ibreak)//
"***"
167 ipos2 = min(msglen, ipos1 + rowlen - 1)
171 IF (ipos1 > msglen)
EXIT
176 IF (decoration_level > 1)
THEN
177 DO i = 1, decoration_level - 1
178 WRITE (unit=output_unit, fmt=
"(T2,A)") repeat(
"*", maxrowlen + 8)
184 DO i = 1, blank_lines_after
185 WRITE (unit=output_unit, fmt=
"(A)")
""
Perform an abnormal program termination.
subroutine, public 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 sta...