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

Last change on this file since 3247 was 3247, checked in by sward, 6 years ago

parin_fail_message now also outputs the line number at which namelist reading failed

  • Property svn:keywords set to Id
File size: 11.4 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-2018 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: message.f90 3247 2018-09-14 07:06:30Z sward $
27! Subroutine description updated and parin_fail_message now also outputs
28! the line number in which namelist reading failed
29!
30! 3246 2018-09-13 15:14:50Z sward
31! Added SUBROUTINE parin_fail_message for error handling of input namelists
32!
33! 3241 2018-09-12 15:02:00Z raasch
34! unused variables removed
35!
36! 3019 2018-05-13 07:05:43Z maronga
37! Temporaraly deactivate MPI_BARRIER as long as nested systems freeze due to
38! asynchronous calls of location_message.
39!
40! 2961 2018-04-12 10:13:48Z suehring
41! Synchronize location message between parent and child. Message will be not
42! flushed before all models finished their respective task. 
43!
44! 2932 2018-03-26 09:39:22Z maronga
45! Corrected "Former revisions" section
46!
47! 2696 2017-12-14 17:12:51Z kanani
48! Change in file header (GPL part)
49!
50! 2101 2017-01-05 16:42:31Z suehring
51!
52! 2000 2016-08-20 18:09:15Z knoop
53! Forced header and separation lines into 80 columns
54!
55! 1808 2016-04-05 19:44:00Z raasch
56! routine local_flush replaced by FORTRAN statement
57!
58! 1764 2016-02-28 12:45:19Z raasch
59! nest id added to header string, add linefeed to stdout to get messages better
60! seperated from the location messages,
61! in case of nested runs, location messages are given only by the root domain
62!
63! 1682 2015-10-07 23:56:08Z knoop
64! Code annotations made doxygen readable
65!
66! 1664 2015-09-23 06:18:12Z knoop
67! updated information_string_2 to meet the new server structure
68!
69! 1402 2014-05-09 14:25:13Z raasch
70! formatting of messages modified
71!
72! 1384 2014-05-02 14:31:06Z raasch
73! routine location_message added
74!
75! 1320 2014-03-20 08:40:49Z raasch
76! ONLY-attribute added to USE-statements,
77! kind-parameters added to all INTEGER and REAL declaration statements,
78! revision history before 2012 removed,
79! comment fields (!:) to be used for variable explanations added to
80! all variable declaration statements
81!
82! 1036 2012-10-22 13:43:42Z raasch
83! code put under GPL (PALM 3.9)
84!
85! 213 2008-11-13 10:26:18Z raasch
86! Initial revision
87!
88! Description:
89! ------------
90!> Handling of the different kinds of messages.
91!> Meaning of formal parameters:
92!> requested_action: 0 - continue, 1 - abort by stop, 2 - abort by mpi_abort
93!>                   3 - abort by mpi_abort using MPI_COMM_WORLD
94!> message_level: 0 - informative, 1 - warning, 2 - error
95!> output_on_pe: -1 - all, else - output on specified PE
96!> file_id: 6 - stdout (*)
97!> flush_file: 0 - no action, 1 - flush the respective output buffer
98!------------------------------------------------------------------------------!
99 SUBROUTINE message( routine_name, message_identifier, requested_action, &
100                     message_level, output_on_pe, file_id, flush_file )
101 
102    USE control_parameters,                                                    &
103        ONLY:  abort_mode, message_string
104
105    USE kinds
106
107    USE pegrid
108
109    USE pmc_interface,                                                         &
110        ONLY:  cpl_id, nested_run
111
112    IMPLICIT NONE
113
114    CHARACTER(LEN=6)   ::  message_identifier            !<
115    CHARACTER(LEN=20)  ::  nest_string                   !< nest id information
116    CHARACTER(LEN=*)   ::  routine_name                  !<
117    CHARACTER(LEN=200) ::  header_string                 !<
118    CHARACTER(LEN=200) ::  information_string_1          !<
119    CHARACTER(LEN=200) ::  information_string_2          !<
120
121    INTEGER(iwp) ::  file_id                             !<
122    INTEGER(iwp) ::  flush_file                          !<
123    INTEGER(iwp) ::  i                                   !<
124    INTEGER(iwp) ::  message_level                       !<
125    INTEGER(iwp) ::  output_on_pe                        !<
126    INTEGER(iwp) ::  requested_action                    !<
127
128    LOGICAL ::  do_output                                !<
129    LOGICAL ::  pe_out_of_range                          !<
130
131
132    do_output       = .FALSE.
133    pe_out_of_range = .FALSE.
134
135!
136!-- In case of nested runs create the nest id informations
137    IF ( nested_run )  THEN
138       WRITE( nest_string, '(1X,A,I2.2)' )  'from nest-id ', cpl_id
139    ELSE
140       nest_string = ''
141    ENDIF
142!
143!-- Create the complete output string, starting with the message level
144    IF ( message_level == 0 )  THEN
145       header_string = '--- informative message' // TRIM(nest_string) //       &
146                       ' ---  ID:'
147    ELSEIF ( message_level == 1 )  THEN
148       header_string = '+++ warning message' // TRIM(nest_string) // ' ---  ID:'
149    ELSEIF ( message_level == 2 )  THEN
150       header_string = '+++ error message' // TRIM(nest_string) // ' ---  ID:'
151    ELSE
152       WRITE( header_string,'(A,I2)' )  '+++ unknown message level' //         &
153                                        TRIM(nest_string) // ': ',             &
154                                        message_level
155    ENDIF
156
157!
158!-- Add the message identifier and the generating routine
159    header_string = TRIM( header_string ) // ' ' // message_identifier // &
160                    '   generated by routine: ' // TRIM( routine_name )
161 
162    information_string_1 = 'Further information can be found at'
163    IF(message_identifier(1:2) == 'NC') THEN
164       information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc' // &
165                              '/app/errmsg#NC'
166    ELSE
167       information_string_2 = 'http://palm.muk.uni-hannover.de/trac/wiki/doc' // &
168                              '/app/errmsg#' // message_identifier
169    ENDIF
170   
171
172!
173!-- Output the output string and the corresponding message string which had
174!-- been already assigned in the calling subroutine.
175!
176!-- First find out if output shall be done on this PE.
177    IF ( output_on_pe == -1 )  THEN
178       do_output = .TRUE.
179    ELSEIF ( myid == output_on_pe )  THEN
180       do_output = .TRUE.
181    ENDIF
182#if defined( __parallel )
183!
184!-- In case of illegal pe number output on pe0
185    IF ( output_on_pe > numprocs-1 )  THEN
186       pe_out_of_range = .TRUE.
187       IF ( myid == 0 )  do_output = .TRUE.
188    ENDIF
189#endif
190
191!
192!-- Now do the output
193    IF ( do_output )  THEN
194
195       IF ( file_id == 6 )  THEN
196!
197!--       Output on stdout
198          WRITE( *, '(//A/)' )  TRIM( header_string )
199!
200!--       Cut message string into pieces and output one piece per line.
201!--       Remove leading blanks.
202          message_string = ADJUSTL( message_string )
203          i = INDEX( message_string, '&' )
204          DO WHILE ( i /= 0 )
205             WRITE( *, '(4X,A)' )  ADJUSTL( message_string(1:i-1) )
206             message_string = ADJUSTL( message_string(i+1:) )
207             i = INDEX( message_string, '&' )
208          ENDDO
209          WRITE( *, '(4X,A)' )  TRIM( message_string )
210          WRITE( *, '(4X,A)' )  ''
211          WRITE( *, '(4X,A)' )  TRIM( information_string_1 ) 
212          WRITE( *, '(4X,A)' )  TRIM( information_string_2 ) 
213          WRITE( *, '(4X,A)' )  ''
214
215       ELSE
216!
217!--       Output on requested file id (file must have been opened elsewhere!)
218          WRITE( file_id, '(A/)' )  TRIM( header_string )
219!
220!--       Cut message string into pieces and output one piece per line.
221!--       Remove leading blanks.
222          message_string = ADJUSTL( message_string )
223          i = INDEX( message_string, '&' )
224          DO WHILE ( i /= 0 )
225             WRITE( file_id, '(4X,A)' )  ADJUSTL( message_string(1:i-1) )
226             message_string = ADJUSTL( message_string(i+1:) )
227             i = INDEX( message_string, '&' )
228          ENDDO
229          WRITE( file_id, '(4X,A)' )  TRIM( message_string )
230          WRITE( file_id, '(4X,A)' )  ''
231          WRITE( file_id, '(4X,A)' )  TRIM( information_string_1 ) 
232          WRITE( file_id, '(4X,A)' )  TRIM( information_string_2 ) 
233          WRITE( file_id, '(4X,A)' )  ''
234!
235!--       Flush buffer, if requested
236          IF ( flush_file == 1 )  FLUSH( file_id )
237       ENDIF
238
239       IF ( pe_out_of_range )  THEN
240          WRITE ( *, '(A)' )  '+++ WARNING from routine message:'
241          WRITE ( *, '(A,I6,A)' )  '    PE ', output_on_pe, &
242                                   ' choosed for output is larger '
243          WRITE ( *, '(A,I6)' )  '    than the maximum number of used PEs', &
244                                 numprocs-1
245          WRITE ( *, '(A)' )  '    Output is done on PE0 instead'
246       ENDIF
247
248    ENDIF
249
250!
251!-- Abort execution, if requested
252    IF ( requested_action > 0 )  THEN
253       abort_mode = requested_action
254       CALL local_stop
255    ENDIF
256
257 END SUBROUTINE message
258
259
260!------------------------------------------------------------------------------!
261! Description:
262! ------------
263!> Prints out the given location on stdout
264!------------------------------------------------------------------------------!
265 
266 SUBROUTINE location_message( location, advance )
267
268
269    USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                        &
270        ONLY:  OUTPUT_UNIT
271
272    USE pegrid
273
274    USE pmc_interface,                                                         &
275        ONLY:  cpl_id
276
277    IMPLICIT NONE
278
279    CHARACTER(LEN=*) ::  location !< text to be output on stdout
280    LOGICAL          ::  advance  !< switch for advancing/noadvancing I/O
281
282!
283!-- Output for nested runs only on the root domain
284    IF ( cpl_id /= 1 )  RETURN
285
286    IF ( myid == 0 )  THEN
287       IF ( advance )  THEN
288          WRITE ( OUTPUT_UNIT, '(6X,''--- '',A)' )  TRIM( location )
289       ELSE
290          WRITE ( OUTPUT_UNIT, '(6X,''... '',A)', ADVANCE='NO' )               &
291                TRIM( location )
292       ENDIF
293       FLUSH( OUTPUT_UNIT )
294    ENDIF
295
296 END SUBROUTINE location_message
297
298
299!------------------------------------------------------------------------------!
300! Description:
301! ------------
302!> Abort routine for failures durin reading of namelists
303!------------------------------------------------------------------------------!
304 
305 SUBROUTINE parin_fail_message( location, line )
306
307    USE control_parameters,                                                    &
308        ONLY:  message_string
309
310    USE kinds
311
312    IMPLICIT NONE
313
314    CHARACTER(LEN=*) ::  location !< text to be output on stdout
315    CHARACTER(LEN=*) ::  line
316
317    CHARACTER(LEN=80) ::  line_dum
318
319    INTEGER(iwp) ::  line_counter
320
321    line_dum = ' '
322    line_counter = 0
323
324    REWIND( 11 )
325    DO   WHILE ( INDEX( line_dum, TRIM(line) ) == 0 )
326         READ ( 11, '(A)', END=20 )  line_dum
327         line_counter = line_counter + 1
328    ENDDO
329
330 20 WRITE( message_string, '(A,I3,A)' )                                        &
331                   'Error(s) in NAMELIST '// TRIM(location) //                 &
332                   '&Reading fails on line ', line_counter,                    &
333                   ' at&' // line
334          CALL message( 'parin', 'PA0271', 1, 2, 0, 6, 0 )
335
336 END SUBROUTINE parin_fail_message
Note: See TracBrowser for help on using the repository browser.