Home

Context Navigation

source: palm/trunk/SOURCE/message.f90 @ 4542

Last change on this file since 4542 was 4536, checked in by raasch, 5 years ago
messages and debug output converted to PALM routines (restart_data_mpi_io_mod), binary version number set to 5.0, heeader output for restart data format added, restart data filesize and I/O transfer speed added in cpu_measures, handling of single restart files (created with MPI-I/O) added to palmrun, bugfix: preprocessor directive adjusted (virtual_measurement_mod), location message format changed
Property svn:keywords set to `Id`
File size: 13.1 KB

Line
1	!> @file message.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2020 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: message.f90 4536 2020-05-17 17:24:13Z raasch $
27	! location message format changed
28	!
29	! 4360 2020-01-07 11:25:50Z suehring
30	! Corrected "Former revisions" section
31	!
32	! 4097 2019-07-15 11:59:11Z suehring
33	! Avoid overlong lines - limit is 132 characters per line
34	!
35	! 3987 2019-05-22 09:52:13Z kanani
36	! Improved formatting of job logfile output,
37	! changed output of DEBUG file
38	!
39	! 3885 2019-04-11 11:29:34Z kanani
40	! Changes related to global restructuring of location messages and introduction
41	! of additional debug messages
42	!
43	! 3655 2019-01-07 16:51:22Z knoop
44	! Minor formating changes
45	!
46	! 213 2008-11-13 10:26:18Z raasch
47	! Initial revision
48	!
49	! Description:
50	! ------------
51	!> Handling of the different kinds of messages.
52	!> Meaning of formal parameters:
53	!> requested_action: 0 - continue, 1 - abort by stop, 2 - abort by mpi_abort
54	!> 3 - abort by mpi_abort using MPI_COMM_WORLD
55	!> message_level: 0 - informative, 1 - warning, 2 - error
56	!> output_on_pe: -1 - all, else - output on specified PE
57	!> file_id: 6 - stdout (*)
58	!> flush_file: 0 - no action, 1 - flush the respective output buffer
59	!------------------------------------------------------------------------------!
60	SUBROUTINE message( routine_name, message_identifier, requested_action, &
61	message_level, output_on_pe, file_id, flush_file )
62
63	USE control_parameters, &
64	ONLY: abort_mode, message_string
65
66	USE kinds
67
68	USE pegrid
69
70	USE pmc_interface, &
71	ONLY: cpl_id, nested_run
72
73	IMPLICIT NONE
74
75	CHARACTER(LEN=6) :: message_identifier !<
76	CHARACTER(LEN=20) :: nest_string !< nest id information
77	CHARACTER(LEN=*) :: routine_name !<
78	CHARACTER(LEN=200) :: header_string !<
79	CHARACTER(LEN=200) :: header_string_2 !< for message ID and routine name
80	CHARACTER(LEN=200) :: information_string_1 !<
81	CHARACTER(LEN=200) :: information_string_2 !<
82
83	INTEGER(iwp) :: file_id !<
84	INTEGER(iwp) :: flush_file !<
85	INTEGER(iwp) :: i !<
86	INTEGER(iwp) :: message_level !<
87	INTEGER(iwp) :: output_on_pe !<
88	INTEGER(iwp) :: requested_action !<
89
90	LOGICAL :: do_output !<
91	LOGICAL :: pe_out_of_range !<
92
93
94	do_output = .FALSE.
95	pe_out_of_range = .FALSE.
96
97	!
98	!-- In case of nested runs create the nest id informations
99	IF ( nested_run ) THEN
100	WRITE( nest_string, '(1X,A,I2.2)' ) 'from nest-id ', cpl_id
101	ELSE
102	nest_string = ''
103	ENDIF
104	!
105	!-- Create the complete output string, starting with the message level
106	IF ( message_level == 0 ) THEN
107	header_string = '--- informative message' // TRIM(nest_string) // &
108	' ---'
109	ELSEIF ( message_level == 1 ) THEN
110	header_string = '+++ warning message' // TRIM(nest_string) // ' ---'
111	ELSEIF ( message_level == 2 ) THEN
112	header_string = '+++ error message' // TRIM(nest_string) // ' ---'
113	ELSE
114	WRITE( header_string,'(A,I2)' ) '+++ unknown message level' // &
115	TRIM(nest_string) // ': ', &
116	message_level
117	ENDIF
118
119	!
120	!-- Add the message identifier and the generating routine
121	header_string_2 = 'ID: ' // message_identifier // &
122	' generated by routine: ' // TRIM( routine_name )
123
124	information_string_1 = 'Further information can be found at'
125	IF(message_identifier(1:2) == 'NC') THEN
126	information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc' // &
127	'/app/errmsg#NC'
128	ELSE
129	information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc' // &
130	'/app/errmsg#' // message_identifier
131	ENDIF
132
133
134	!
135	!-- Output the output string and the corresponding message string which had
136	!-- been already assigned in the calling subroutine.
137	!
138	!-- First find out if output shall be done on this PE.
139	IF ( output_on_pe == -1 ) THEN
140	do_output = .TRUE.
141	ELSEIF ( myid == output_on_pe ) THEN
142	do_output = .TRUE.
143	ENDIF
144	#if defined( __parallel )
145	!
146	!-- In case of illegal pe number output on pe0
147	IF ( output_on_pe > numprocs-1 ) THEN
148	pe_out_of_range = .TRUE.
149	IF ( myid == 0 ) do_output = .TRUE.
150	ENDIF
151	#endif
152
153	!
154	!-- Now do the output
155	IF ( do_output ) THEN
156
157	IF ( file_id == 6 ) THEN
158	!
159	!-- Output on stdout
160	WRITE( *, '(16X,A)' ) TRIM( header_string )
161	WRITE( *, '(20X,A)' ) TRIM( header_string_2 )
162	!
163	!-- Cut message string into pieces and output one piece per line.
164	!-- Remove leading blanks.
165	message_string = ADJUSTL( message_string )
166	i = INDEX( message_string, '&' )
167	DO WHILE ( i /= 0 )
168	WRITE( *, '(20X,A)' ) ADJUSTL( message_string(1:i-1) )
169	message_string = ADJUSTL( message_string(i+1:) )
170	i = INDEX( message_string, '&' )
171	ENDDO
172	WRITE( *, '(20X,A)' ) ''
173	WRITE( *, '(20X,A)' ) TRIM( message_string )
174	WRITE( *, '(20X,A)' ) ''
175	WRITE( *, '(20X,A)' ) TRIM( information_string_1 )
176	WRITE( *, '(20X,A)' ) TRIM( information_string_2 )
177	WRITE( *, '(20X,A)' ) ''
178
179	ELSE
180	!
181	!-- Output on requested file id (file must have been opened elsewhere!)
182	WRITE( file_id, '(A/)' ) TRIM( header_string )
183	!
184	!-- Cut message string into pieces and output one piece per line.
185	!-- Remove leading blanks.
186	message_string = ADJUSTL( message_string )
187	i = INDEX( message_string, '&' )
188	DO WHILE ( i /= 0 )
189	WRITE( file_id, '(4X,A)' ) ADJUSTL( message_string(1:i-1) )
190	message_string = ADJUSTL( message_string(i+1:) )
191	i = INDEX( message_string, '&' )
192	ENDDO
193	WRITE( file_id, '(4X,A)' ) TRIM( message_string )
194	WRITE( file_id, '(4X,A)' ) ''
195	WRITE( file_id, '(4X,A)' ) TRIM( information_string_1 )
196	WRITE( file_id, '(4X,A)' ) TRIM( information_string_2 )
197	WRITE( file_id, '(4X,A)' ) ''
198	!
199	!-- Flush buffer, if requested
200	IF ( flush_file == 1 ) FLUSH( file_id )
201	ENDIF
202
203	IF ( pe_out_of_range ) THEN
204	WRITE ( *, '(A)' ) '+++ WARNING from routine message:'
205	WRITE ( *, '(A,I6,A)' ) ' PE ', output_on_pe, &
206	' choosed for output is larger '
207	WRITE ( *, '(A,I6)' ) ' than the maximum number of used PEs', &
208	numprocs-1
209	WRITE ( *, '(A)' ) ' Output is done on PE0 instead'
210	ENDIF
211
212	ENDIF
213
214	!
215	!-- Abort execution, if requested
216	IF ( requested_action > 0 ) THEN
217	abort_mode = requested_action
218	CALL local_stop
219	ENDIF
220
221	END SUBROUTINE message
222
223
224	!--------------------------------------------------------------------------------------------------!
225	! Description:
226	! ------------
227	!> Prints out the given location on stdout
228	!--------------------------------------------------------------------------------------------------!
229
230	SUBROUTINE location_message( location, message_type )
231
232
233	USE, INTRINSIC :: ISO_FORTRAN_ENV, &
234	ONLY: OUTPUT_UNIT
235
236	USE pegrid
237
238	USE pmc_interface, &
239	ONLY: cpl_id
240
241	IMPLICIT NONE
242
243	CHARACTER(LEN=*) :: location !< text to be output on stdout
244	CHARACTER(LEN=60) :: location_string = ' ' !<
245	CHARACTER(LEN=*) :: message_type !< attribute marking 'start' or 'end' of routine
246	CHARACTER(LEN=11) :: message_type_string = ' ' !<
247	CHARACTER(LEN=10) :: system_time !< system clock time
248	CHARACTER(LEN=10) :: time
249	!
250	!-- Output for nested runs only on the root domain
251	IF ( cpl_id /= 1 ) RETURN
252
253	IF ( myid == 0 ) THEN
254	!
255	!-- Get system time for debug info output (helpful to estimate the required computing time for
256	!-- specific parts of code
257	CALL date_and_time( TIME=time )
258	system_time = time(1:2)//':'//time(3:4)//':'//time(5:6)
259	!
260	!-- Write pre-string depending on message_type
261	IF ( TRIM( message_type ) == 'start' ) WRITE( message_type_string, * ) '-', TRIM( message_type ), '----'
262	IF ( TRIM( message_type ) == 'finished' ) WRITE( message_type_string, * ) '-', TRIM( message_type ), '-'
263	!
264	!-- Write dummy location_string in order to allow left-alignment of text despite the fixed (=A60)
265	!-- format.
266	WRITE( location_string, * ) TRIM( location )
267	!
268	!-- Write and flush debug location or info message to file
269	WRITE( OUTPUT_UNIT, 200 ) TRIM( system_time ), TRIM( message_type_string ), &
270	TRIM( location_string )
271	FLUSH( OUTPUT_UNIT )
272	!
273	!-- Message formats
274	200 FORMAT ( 3X, A, 3x, A, 2X, A )
275
276	ENDIF
277
278	END SUBROUTINE location_message
279
280
281	!--------------------------------------------------------------------------------------------------!
282	! Description:
283	! ------------
284	!> Prints out the given debug information to unit 9 (DEBUG files in temporary directory)
285	!> for each PE on each domain.
286	!--------------------------------------------------------------------------------------------------!
287
288	SUBROUTINE debug_message( debug_string, message_type )
289
290
291	USE control_parameters, &
292	ONLY: time_since_reference_point
293
294	IMPLICIT NONE
295
296
297	CHARACTER(LEN=*) :: debug_string !< debug message to be output on unit 9
298	CHARACTER(LEN=*) :: message_type !< 'start', 'end', 'info'
299	CHARACTER(LEN=10) :: message_type_string = ' ' !<
300	CHARACTER(LEN=10) :: system_time !< system clock time
301	CHARACTER(LEN=10) :: time
302
303	INTEGER, PARAMETER :: debug_output_unit = 9
304
305	!
306	!-- Get system time for debug info output (helpful to estimate the required computing time for
307	!-- specific parts of code
308	CALL date_and_time( TIME=time )
309	system_time = time(1:2)//':'//time(3:4)//':'//time(5:6)
310	!
311	!-- Write pre-string depending on message_type
312	IF ( TRIM( message_type ) == 'start' ) WRITE( message_type_string, * ) '-', TRIM( message_type ), '-'
313	IF ( TRIM( message_type ) == 'end' ) WRITE( message_type_string, * ) '-', TRIM( message_type ), '---'
314	IF ( TRIM( message_type ) == 'info' ) WRITE( message_type_string, * ) '-', TRIM( message_type ), '--'
315	!
316	!-- Write and flush debug location or info message to file
317	WRITE( debug_output_unit, 201 ) TRIM( system_time ), time_since_reference_point, &
318	TRIM( message_type_string ), TRIM( debug_string )
319	FLUSH( debug_output_unit )
320
321	!
322	!-- Message formats
323	201 FORMAT ( 'System time: ', A, ' \| simulated time (s): ', F12.3, ' \| ', A, ' ', A )
324
325
326	END SUBROUTINE debug_message
327
328
329	!------------------------------------------------------------------------------!
330	! Description:
331	! ------------
332	!> Abort routine for failures durin reading of namelists
333	!------------------------------------------------------------------------------!
334
335	SUBROUTINE parin_fail_message( location, line )
336
337	USE control_parameters, &
338	ONLY: message_string
339
340	USE kinds
341
342	IMPLICIT NONE
343
344	CHARACTER(LEN=*) :: location !< text to be output on stdout
345	CHARACTER(LEN=*) :: line
346
347	CHARACTER(LEN=80) :: line_dum
348
349	INTEGER(iwp) :: line_counter
350
351	line_dum = ' '
352	line_counter = 0
353
354	REWIND( 11 )
355	DO WHILE ( INDEX( line_dum, TRIM(line) ) == 0 )
356	READ ( 11, '(A)', END=20 ) line_dum
357	line_counter = line_counter + 1
358	ENDDO
359
360	20 WRITE( message_string, '(A,I3,A)' ) &
361	'Error(s) in NAMELIST '// TRIM(location) // &
362	'&Reading fails on line ', line_counter, &
363	' at&' // line
364	CALL message( 'parin', 'PA0271', 1, 2, 0, 6, 0 )
365
366	END SUBROUTINE parin_fail_message

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |