(git:0de0cc2)
print_messages.F
Go to the documentation of this file.
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 ! **************************************************************************************************
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  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  IF (PRESENT(after)) THEN
66  blank_lines_after = max(after, 0)
67  ELSE
68  blank_lines_after = 1
69  END IF
70 
71  IF (PRESENT(before)) THEN
72  blank_lines_before = max(before, 0)
73  ELSE
74  blank_lines_before = 1
75  END IF
76 
77  IF (PRESENT(declev)) THEN
78  decoration_level = max(declev, 0)
79  ELSE
80  decoration_level = 0
81  END IF
82 
83  IF (decoration_level == 0) THEN
84  rowlen = 78
85  ELSE
86  rowlen = 70
87  END IF
88 
89  msglen = len_trim(message)
90 
91  ! Calculate number of rows
92 
93  nrow = msglen/(rowlen + 1) + 1
94 
95  ! Calculate appropriate row length
96 
97  rowlen = min(msglen, rowlen)
98 
99  ! Generate the blank lines before the message
100 
101  DO i = 1, blank_lines_before
102  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  IF (ipos2 < msglen) THEN
113  i = index(message(ipos1:ipos2), " ", back=.true.)
114  IF (i == 0) THEN
115  ibreak = ipos2
116  ELSE
117  ibreak = ipos1 + i - 2
118  END IF
119  ELSE
120  ibreak = ipos2
121  END IF
122 
123  maxrowlen = max(maxrowlen, ibreak - ipos1 + 1)
124 
125  ipos1 = ibreak + 2
126  ipos2 = min(msglen, ipos1 + rowlen - 1)
127 
128  ! When the last row is processed, exit loop
129 
130  IF (ipos1 > msglen) EXIT
131 
132  END DO
133 
134  ! Generate the first set of star rows
135 
136  IF (decoration_level > 1) THEN
137  DO i = 1, decoration_level - 1
138  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  IF (ipos2 < msglen) THEN
149  i = index(message(ipos1:ipos2), " ", back=.true.)
150  IF (i == 0) THEN
151  ibreak = ipos2
152  ELSE
153  ibreak = ipos1 + i - 2
154  END IF
155  ELSE
156  ibreak = ipos2
157  END IF
158 
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)//"***"
164  END IF
165 
166  ipos1 = ibreak + 2
167  ipos2 = min(msglen, ipos1 + rowlen - 1)
168 
169  ! When the last row is processed, exit loop
170 
171  IF (ipos1 > msglen) EXIT
172  END DO
173 
174  ! Generate the second set star rows
175 
176  IF (decoration_level > 1) THEN
177  DO i = 1, decoration_level - 1
178  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  DO i = 1, blank_lines_after
185  WRITE (unit=output_unit, fmt="(A)") ""
186  END DO
187 
188  END SUBROUTINE print_message
189 
190 END MODULE print_messages
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...