Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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 17350 : 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 : CHARACTER(LEN=1), PARAMETER :: decoration_char = "*"
62 :
63 : INTEGER :: blank_lines_after, blank_lines_before, &
64 : decoration_level, i, ibreak, ipos1, &
65 : ipos2, maxrowlen, msglen, nrow, rowlen
66 :
67 17350 : IF (PRESENT(after)) THEN
68 17350 : blank_lines_after = MAX(after, 0)
69 : ELSE
70 : blank_lines_after = 1
71 : END IF
72 :
73 17350 : IF (PRESENT(before)) THEN
74 17350 : blank_lines_before = MAX(before, 0)
75 : ELSE
76 : blank_lines_before = 1
77 : END IF
78 :
79 17350 : IF (PRESENT(declev)) THEN
80 17350 : decoration_level = MAX(declev, 0)
81 : ELSE
82 : decoration_level = 0
83 : END IF
84 :
85 17350 : IF (decoration_level == 0) THEN
86 : rowlen = 78
87 : ELSE
88 17330 : rowlen = 70
89 : END IF
90 :
91 17350 : msglen = LEN_TRIM(message)
92 :
93 : ! Calculate number of rows
94 :
95 17350 : nrow = msglen/(rowlen + 1) + 1
96 :
97 : ! Calculate appropriate row length
98 :
99 17350 : rowlen = MIN(msglen, rowlen)
100 :
101 : ! Generate the blank lines before the message
102 :
103 34680 : DO i = 1, blank_lines_before
104 34680 : WRITE (UNIT=output_unit, FMT="(A)") ""
105 : END DO
106 :
107 : ! Scan for the longest row
108 :
109 : ipos1 = 1
110 : ipos2 = rowlen
111 : maxrowlen = 0
112 :
113 : DO
114 36864 : IF (ipos2 < msglen) THEN
115 19514 : i = INDEX(message(ipos1:ipos2), " ", BACK=.TRUE.)
116 19514 : IF (i == 0) THEN
117 : ibreak = ipos2
118 : ELSE
119 19514 : ibreak = ipos1 + i - 2
120 : END IF
121 : ELSE
122 : ibreak = ipos2
123 : END IF
124 :
125 36864 : maxrowlen = MAX(maxrowlen, ibreak - ipos1 + 1)
126 :
127 36864 : ipos1 = ibreak + 2
128 36864 : ipos2 = MIN(msglen, ipos1 + rowlen - 1)
129 :
130 : ! When the last row is processed, exit loop
131 :
132 36864 : IF (ipos1 > msglen) EXIT
133 :
134 : END DO
135 :
136 : ! Generate the first set of star rows
137 :
138 17350 : IF (decoration_level > 1) THEN
139 0 : DO i = 1, decoration_level - 1
140 0 : WRITE (UNIT=output_unit, FMT="(T2,A)") &
141 0 : REPEAT(decoration_char, maxrowlen + 8)
142 : END DO
143 : END IF
144 :
145 : ! Break long messages
146 :
147 : ipos1 = 1
148 : ipos2 = rowlen
149 :
150 : DO
151 36864 : IF (ipos2 < msglen) THEN
152 19514 : i = INDEX(message(ipos1:ipos2), " ", BACK=.TRUE.)
153 19514 : IF (i == 0) THEN
154 : ibreak = ipos2
155 : ELSE
156 19514 : ibreak = ipos1 + i - 2
157 : END IF
158 : ELSE
159 : ibreak = ipos2
160 : END IF
161 :
162 36864 : IF (decoration_level == 0) THEN
163 48 : WRITE (UNIT=output_unit, FMT="(T2,A)") message(ipos1:ibreak)
164 36816 : ELSE IF (decoration_level > 0) THEN
165 : WRITE (UNIT=output_unit, FMT="(T2,A)") &
166 0 : REPEAT(decoration_char, 3)//" "//message(ipos1:ibreak)// &
167 : REPEAT(" ", ipos1 + maxrowlen - ibreak)// &
168 446071 : REPEAT(decoration_char, 3)
169 : END IF
170 :
171 36864 : ipos1 = ibreak + 2
172 36864 : ipos2 = MIN(msglen, ipos1 + rowlen - 1)
173 :
174 : ! When the last row is processed, exit loop
175 :
176 36864 : IF (ipos1 > msglen) EXIT
177 : END DO
178 :
179 : ! Generate the second set star rows
180 :
181 17350 : IF (decoration_level > 1) THEN
182 0 : DO i = 1, decoration_level - 1
183 0 : WRITE (UNIT=output_unit, FMT="(T2,A)") &
184 0 : REPEAT(decoration_char, maxrowlen + 8)
185 : END DO
186 : END IF
187 :
188 : ! Generate the blank lines after the message
189 :
190 34680 : DO i = 1, blank_lines_after
191 34680 : WRITE (UNIT=output_unit, FMT="(A)") ""
192 : END DO
193 :
194 17350 : END SUBROUTINE print_message
195 :
196 : END MODULE print_messages
|
