Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Perform an abnormal program termination.
10 : !> \note These routines are low-level and thus provide also an error recovery
11 : !> when dependencies do not allow the use of the error logger. Only
12 : !> the master (root) process will dump, if para_env is available and
13 : !> properly specified. Otherwise (without any information about the
14 : !> parallel environment) most likely more than one process or even all
15 : !> processes will send their error dump to the default output unit.
16 : !> \par History
17 : !> - Routine external_control moved to a separate module
18 : !> - Delete stop_memory routine, rename module
19 : !> \author Matthias Krack (12.02.2001)
20 : ! **************************************************************************************************
21 : MODULE print_messages
22 : #include "../base/base_uses.f90"
23 : IMPLICIT NONE
24 :
25 : PRIVATE
26 :
27 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'print_messages'
28 :
29 : PUBLIC :: print_message
30 :
31 : CONTAINS
32 :
33 : ! **************************************************************************************************
34 : !> \brief Perform a basic blocking of the text in message and print it
35 : !> optionally decorated with a frame of stars as defined by declev.
36 : !> \param message ...
37 : !> \param output_unit ...
38 : !> \param declev ...
39 : !> \param before ...
40 : !> \param after ...
41 : !> \date 28.08.1996
42 : !> \par History
43 : !> - Translated to Fortran 90/95 (07.10.1999, Matthias Krack)
44 : !> - CP2K by JH 21.08.2000
45 : !> - Bugs in the dynamic format generation removed (09.02.2001, MK)
46 : !> - Revised (26.01.2011,MK)
47 : !> \author Matthias Krack (MK)
48 : !> \note
49 : !> after : Number of empty lines after the message.
50 : !> before : Number of empty lines before the message.
51 : !> declev : Decoration level (0,1,2, ... star lines).
52 : !> message : String with the message text.
53 : !> output_unit: Logical unit number of output unit.
54 : ! **************************************************************************************************
55 16106 : SUBROUTINE print_message(message, output_unit, declev, before, after)
56 :
57 : CHARACTER(LEN=*), INTENT(IN) :: message
58 : INTEGER, INTENT(IN) :: output_unit
59 : INTEGER, INTENT(IN), OPTIONAL :: declev, before, after
60 :
61 : INTEGER :: blank_lines_after, blank_lines_before, &
62 : decoration_level, i, ibreak, ipos1, &
63 : ipos2, maxrowlen, msglen, nrow, rowlen
64 :
65 16106 : IF (PRESENT(after)) THEN
66 16106 : blank_lines_after = MAX(after, 0)
67 : ELSE
68 : blank_lines_after = 1
69 : END IF
70 :
71 16106 : IF (PRESENT(before)) THEN
72 16106 : blank_lines_before = MAX(before, 0)
73 : ELSE
74 : blank_lines_before = 1
75 : END IF
76 :
77 16106 : IF (PRESENT(declev)) THEN
78 16106 : decoration_level = MAX(declev, 0)
79 : ELSE
80 : decoration_level = 0
81 : END IF
82 :
83 16106 : IF (decoration_level == 0) THEN
84 : rowlen = 78
85 : ELSE
86 16086 : rowlen = 70
87 : END IF
88 :
89 16106 : msglen = LEN_TRIM(message)
90 :
91 : ! Calculate number of rows
92 :
93 16106 : nrow = msglen/(rowlen + 1) + 1
94 :
95 : ! Calculate appropriate row length
96 :
97 16106 : rowlen = MIN(msglen, rowlen)
98 :
99 : ! Generate the blank lines before the message
100 :
101 32192 : DO i = 1, blank_lines_before
102 32192 : WRITE (UNIT=output_unit, FMT="(A)") ""
103 : END DO
104 :
105 : ! Scan for the longest row
106 :
107 : ipos1 = 1
108 : ipos2 = rowlen
109 : maxrowlen = 0
110 :
111 : DO
112 33740 : IF (ipos2 < msglen) THEN
113 17634 : i = INDEX(message(ipos1:ipos2), " ", BACK=.TRUE.)
114 17634 : IF (i == 0) THEN
115 : ibreak = ipos2
116 : ELSE
117 17634 : ibreak = ipos1 + i - 2
118 : END IF
119 : ELSE
120 : ibreak = ipos2
121 : END IF
122 :
123 33740 : maxrowlen = MAX(maxrowlen, ibreak - ipos1 + 1)
124 :
125 33740 : ipos1 = ibreak + 2
126 33740 : ipos2 = MIN(msglen, ipos1 + rowlen - 1)
127 :
128 : ! When the last row is processed, exit loop
129 :
130 33740 : IF (ipos1 > msglen) EXIT
131 :
132 : END DO
133 :
134 : ! Generate the first set of star rows
135 :
136 16106 : IF (decoration_level > 1) THEN
137 0 : DO i = 1, decoration_level - 1
138 0 : WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", maxrowlen + 8)
139 : END DO
140 : END IF
141 :
142 : ! Break long messages
143 :
144 : ipos1 = 1
145 : ipos2 = rowlen
146 :
147 : DO
148 33740 : IF (ipos2 < msglen) THEN
149 17634 : i = INDEX(message(ipos1:ipos2), " ", BACK=.TRUE.)
150 17634 : IF (i == 0) THEN
151 : ibreak = ipos2
152 : ELSE
153 17634 : ibreak = ipos1 + i - 2
154 : END IF
155 : ELSE
156 : ibreak = ipos2
157 : END IF
158 :
159 33740 : IF (decoration_level == 0) THEN
160 48 : WRITE (UNIT=output_unit, FMT="(T2,A)") message(ipos1:ibreak)
161 33692 : ELSE IF (decoration_level > 0) THEN
162 : WRITE (UNIT=output_unit, FMT="(T2,A)") &
163 418191 : "*** "//message(ipos1:ibreak)//REPEAT(" ", ipos1 + maxrowlen - ibreak)//"***"
164 : END IF
165 :
166 33740 : ipos1 = ibreak + 2
167 33740 : ipos2 = MIN(msglen, ipos1 + rowlen - 1)
168 :
169 : ! When the last row is processed, exit loop
170 :
171 33740 : IF (ipos1 > msglen) EXIT
172 : END DO
173 :
174 : ! Generate the second set star rows
175 :
176 16106 : IF (decoration_level > 1) THEN
177 0 : DO i = 1, decoration_level - 1
178 0 : WRITE (UNIT=output_unit, FMT="(T2,A)") REPEAT("*", maxrowlen + 8)
179 : END DO
180 : END IF
181 :
182 : ! Generate the blank lines after the message
183 :
184 32192 : DO i = 1, blank_lines_after
185 32192 : WRITE (UNIT=output_unit, FMT="(A)") ""
186 : END DO
187 :
188 16106 : END SUBROUTINE print_message
189 :
190 : END MODULE print_messages
|
