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

Last change on this file since 1402 was 1402, checked in by raasch, 7 years ago

output of location messages complemented, output of location bar added
(Makefile, check_parameters, cpulog, init_pegrid, init_3d_model, message, palm, parin, time_integration, new: progress_bar)
preprocessor switch intel_compiler added, -r8 compiler options removed
(.mrun.config.default, .mrun.config.imuk, .mrun.config.kiaps)

batch_job added to envpar-NAMELIST
(mrun, parin)

  • Property svn:keywords set to Id
File size: 8.0 KB
Line 
1 SUBROUTINE message( routine_name, message_identifier, requested_action, &
2                     message_level, output_on_pe, file_id, flush )
3
4!--------------------------------------------------------------------------------!
5! This file is part of PALM.
6!
7! PALM is free software: you can redistribute it and/or modify it under the terms
8! of the GNU General Public License as published by the Free Software Foundation,
9! either version 3 of the License, or (at your option) any later version.
10!
11! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
12! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14!
15! You should have received a copy of the GNU General Public License along with
16! PALM. If not, see <http://www.gnu.org/licenses/>.
17!
18! Copyright 1997-2014 Leibniz Universitaet Hannover
19!--------------------------------------------------------------------------------!
20!
21! Current revisions:
22! -----------------
23! formatting of messages modified
24!
25! Former revisions:
26! -----------------
27! $Id: message.f90 1402 2014-05-09 14:25:13Z raasch $
28!
29! 1384 2014-05-02 14:31:06Z raasch
30! routine location_message added
31!
32! 1320 2014-03-20 08:40:49Z raasch
33! ONLY-attribute added to USE-statements,
34! kind-parameters added to all INTEGER and REAL declaration statements,
35! revision history before 2012 removed,
36! comment fields (!:) to be used for variable explanations added to
37! all variable declaration statements
38!
39! 1036 2012-10-22 13:43:42Z raasch
40! code put under GPL (PALM 3.9)
41!
42! 213 2008-11-13 10:26:18Z raasch
43! Initial revision
44!
45! Description:
46! ------------
47! Handling of the different kinds of messages.
48! Meaning of formal parameters:
49! requested_action: 0 - continue, 1 - abort by stop, 2 - abort by mpi_abort
50! message_level: 0 - informative, 1 - warning, 2 - error
51! output_on_pe: -1 - all, else - output on specified PE
52! file_id: 6 - stdout (*)
53! flush: 0 - no action, 1 - flush the respective output buffer
54!------------------------------------------------------------------------------!
55
56    USE control_parameters,                                                    &
57        ONLY:  abort_mode, message_string
58
59    USE kinds
60
61    USE pegrid
62
63    IMPLICIT NONE
64
65    CHARACTER(LEN=6)   ::  message_identifier            !:
66    CHARACTER(LEN=*)   ::  routine_name                  !:
67    CHARACTER(LEN=200) ::  header_string                 !:
68    CHARACTER(LEN=200) ::  information_string_1          !:
69    CHARACTER(LEN=200) ::  information_string_2          !:
70
71    INTEGER(iwp) ::  file_id                             !:
72    INTEGER(iwp) ::  flush                               !:
73    INTEGER(iwp) ::  i                                   !:
74    INTEGER(iwp) ::  message_level                       !:
75    INTEGER(iwp) ::  output_on_pe                        !:
76    INTEGER(iwp) ::  requested_action                    !:
77
78    LOGICAL ::  do_output                                !:
79    LOGICAL ::  pe_out_of_range                          !:
80
81
82    do_output       = .FALSE.
83    pe_out_of_range = .FALSE.
84
85!
86!-- Create the complete output string, starting with the message level
87    IF ( message_level == 0 )  THEN
88       header_string = '--- informative message ---  ID:'
89    ELSEIF ( message_level == 1 )  THEN
90       header_string = '+++ warning message ---  ID:'
91    ELSEIF ( message_level == 2 )  THEN
92       header_string = '+++ error message ---  ID:'
93    ELSE
94       WRITE( header_string,'(A,I2)' )  '+++ unknown message level: ', &
95                                        message_level
96    ENDIF
97
98!
99!-- Add the message identifier and the generating routine
100    header_string = TRIM( header_string ) // ' ' // message_identifier // &
101                    '   generated by routine: ' // TRIM( routine_name )
102 
103    information_string_1 = 'Further information can be found at'
104    IF(message_identifier(1:2) == 'NC') THEN
105       information_string_2 = 'http://palm.muk.uni-hannover.de/wiki/doc' // &
106                              '/app/errmsg#NC'
107    ELSE
108       information_string_2 = 'http://palm.muk.uni-hannover.de/wiki/doc' // &
109                              '/app/errmsg#' // message_identifier
110    END IF
111   
112
113!
114!-- Output the output string and the corresponding message string which had
115!-- been already assigned in the calling subroutine.
116!
117!-- First find out if output shall be done on this PE.
118    IF ( output_on_pe == -1 )  THEN
119       do_output = .TRUE.
120    ELSEIF ( myid == output_on_pe )  THEN
121       do_output = .TRUE.
122    ENDIF
123#if defined( __parallel )
124!
125!-- In case of illegal pe number output on pe0
126    IF ( output_on_pe > numprocs-1 )  THEN
127       pe_out_of_range = .TRUE.
128       IF ( myid == 0 )  do_output = .TRUE.
129    ENDIF
130#endif
131
132!
133!-- Now do the output
134    IF ( do_output )  THEN
135
136       IF ( file_id == 6 )  THEN
137!
138!--       Output on stdout
139          WRITE( *, '(A/)' )  TRIM( header_string )
140!
141!--       Cut message string into pieces and output one piece per line.
142!--       Remove leading blanks.
143          message_string = ADJUSTL( message_string )
144          i = INDEX( message_string, '&' )
145          DO WHILE ( i /= 0 )
146             WRITE( *, '(4X,A)' )  ADJUSTL( message_string(1:i-1) )
147             message_string = ADJUSTL( message_string(i+1:) )
148             i = INDEX( message_string, '&' )
149          ENDDO
150          WRITE( *, '(4X,A)' )  TRIM( message_string )
151          WRITE( *, '(4X,A)' )  ''
152          WRITE( *, '(4X,A)' )  TRIM( information_string_1 ) 
153          WRITE( *, '(4X,A)' )  TRIM( information_string_2 ) 
154          WRITE( *, '(4X,A)' )  ''
155
156       ELSE
157!
158!--       Output on requested file id (file must have been opened elsewhere!)
159          WRITE( file_id, '(A/)' )  TRIM( header_string )
160!
161!--       Cut message string into pieces and output one piece per line.
162!--       Remove leading blanks.
163          message_string = ADJUSTL( message_string )
164          i = INDEX( message_string, '&' )
165          DO WHILE ( i /= 0 )
166             WRITE( file_id, '(4X,A)' )  ADJUSTL( message_string(1:i-1) )
167             message_string = ADJUSTL( message_string(i+1:) )
168             i = INDEX( message_string, '&' )
169          ENDDO
170          WRITE( file_id, '(4X,A)' )  TRIM( message_string )
171          WRITE( file_id, '(4X,A)' )  ''
172          WRITE( file_id, '(4X,A)' )  TRIM( information_string_1 ) 
173          WRITE( file_id, '(4X,A)' )  TRIM( information_string_2 ) 
174          WRITE( file_id, '(4X,A)' )  ''
175!
176!--       Flush buffer, if requested
177          IF ( flush == 1 )  CALL local_flush( file_id )
178       ENDIF
179
180       IF ( pe_out_of_range )  THEN
181          WRITE ( *, '(A)' )  '+++ WARNING from routine message:'
182          WRITE ( *, '(A,I6,A)' )  '    PE ', output_on_pe, &
183                                   ' choosed for output is larger '
184          WRITE ( *, '(A,I6)' )  '    than the maximum number of used PEs', &
185                                 numprocs-1
186          WRITE ( *, '(A)' )  '    Output is done on PE0 instead'
187       ENDIF
188
189    ENDIF
190
191!
192!-- Abort execution, if requested
193    IF ( requested_action > 0 )  THEN
194       abort_mode = requested_action
195       CALL local_stop
196    ENDIF
197
198 END SUBROUTINE message
199
200
201 SUBROUTINE location_message( location, advance )
202
203!------------------------------------------------------------------------------!
204! Description:
205! ------------
206! Prints out the given location on stdout
207!------------------------------------------------------------------------------!
208
209    USE, INTRINSIC ::  ISO_FORTRAN_ENV,                                        &
210        ONLY :  OUTPUT_UNIT
211
212    USE pegrid,                                                                &
213        ONLY :  myid
214
215    IMPLICIT NONE
216
217    CHARACTER(LEN=*) ::  location !: text to be output on stdout
218    LOGICAL          ::  advance  !: switch for advancing/noadvancing I/O
219
220
221    IF ( myid == 0 )  THEN
222       IF ( advance )  THEN
223          WRITE ( OUTPUT_UNIT, '(6X,''--- '',A)' )  TRIM( location )
224       ELSE
225          WRITE ( OUTPUT_UNIT, '(6X,''... '',A)', ADVANCE='NO' )               &
226                TRIM( location )
227       ENDIF
228       CALL local_flush( OUTPUT_UNIT )
229    ENDIF
230
231 END SUBROUTINE location_message
Note: See TracBrowser for help on using the repository browser.