source: palm/trunk/SOURCE/handle_palm_message.f90 @ 215

Last change on this file since 215 was 213, checked in by raasch, 15 years ago

Output message can be handled with new subroutine handle_palm_message. All output messages will be replaced by this routine step by step within the next revisions

  • Property svn:keywords set to Id
File size: 4.7 KB
Line 
1 SUBROUTINE handle_palm_message( routine_name, message_identifier,             &
2                                 requested_action, message_level, output_on_pe,&
3                                 file_id, flush )
4
5!------------------------------------------------------------------------------!
6! Actual revisions:
7! -----------------
8! Initial revision
9!
10! Former revisions:
11! -----------------
12! $Id: handle_palm_message.f90 213 2008-11-13 10:26:18Z raasch $
13!
14! Description:
15! ------------
16! Handling of the different kinds of messages.
17! Meaning of formal parameters:
18! requested_action: 0 - continue, 1 - abort by stop, 2 - abort by mpi_abort
19! message_level: 0 - informative, 1 - warning, 2 - error
20! output_on_pe: -1 - all, else - output on specified PE
21! file_id: 6 - stdout (*)
22! flush: 0 - no action, 1 - flush the respective output buffer
23!------------------------------------------------------------------------------!
24
25    USE pegrid
26    USE control_parameters
27
28    IMPLICIT NONE
29
30    CHARACTER(LEN=6)   ::  message_identifier
31    CHARACTER(LEN=*)   ::  routine_name
32    CHARACTER(LEN=200) ::  header_string
33
34    INTEGER ::  file_id, flush, i, message_level, output_on_pe, requested_action
35
36    LOGICAL ::  do_output, pe_out_of_range
37
38
39    do_output       = .FALSE.
40    pe_out_of_range = .FALSE.
41
42!    print*, '#1'
43!
44!-- Create the complete output string, starting with the message level
45    IF ( message_level == 0 )  THEN
46       header_string = '--- informative message ---  ID:'
47    ELSEIF ( message_level == 1 )  THEN
48       header_string = '+++ warning message ---  ID:'
49    ELSEIF ( message_level == 2 )  THEN
50       header_string = '+++ error message ---  ID:'
51    ELSE
52       WRITE( header_string,'(A,I2)' )  '+++ unknown message level: ', &
53                                        message_level
54    ENDIF
55
56!    print*, '#2'
57!
58!-- Add the message identifier and the generating routine
59    header_string = TRIM( header_string ) // ' ' // message_identifier // &
60                    '   generated by routine: ' // TRIM( routine_name )
61
62!    print*, '#3'
63!
64!-- Output the output string and the corresponding message string which had
65!-- been already assigned in the calling subroutine.
66!
67!-- First find out if output shall be done on this PE.
68    IF ( output_on_pe == -1 )  THEN
69       do_output = .TRUE.
70    ELSEIF ( myid == output_on_pe )  THEN
71       do_output = .TRUE.
72    ENDIF
73!    print*, '#4'
74#if defined( __parallel )
75!
76!-- In case of illegal pe number output on pe0
77    IF ( output_on_pe > numprocs-1 )  THEN
78       pe_out_of_range = .TRUE.
79       IF ( myid == 0 )  do_output = .TRUE.
80    ENDIF
81!    print*, '#5'
82#endif
83
84!
85!-- Now do the output
86    IF ( do_output )  THEN
87!    print*, '#6'
88       IF ( file_id == 6 )  THEN
89!
90!--       Output on stdout
91          WRITE( *, '(A/)' )  TRIM( header_string )
92!    print*, '#7'
93!
94!--       Cut message string into pieces and output one piece per line.
95!--       Remove leading blanks.
96          message_string = ADJUSTL( message_string )
97          i = INDEX( message_string, '&' )
98          DO WHILE ( i /= 0 )
99             WRITE( *, '(4X,A)' )  ADJUSTL( message_string(1:i-1) )
100             message_string = ADJUSTL( message_string(i+1:) )
101             i = INDEX( message_string, '&' )
102          ENDDO
103          WRITE( *, '(4X,A)' )  TRIM( message_string )
104!    print*, '#8'
105
106       ELSE
107!    print*, '#9'
108!
109!--       Output on requested file id (file must have been opened elsewhere!)
110          WRITE( file_id, '(A/)' )  TRIM( header_string )
111!
112!--       Cut message string into pieces and output one piece per line.
113!--       Remove leading blanks.
114          message_string = ADJUSTL( message_string )
115          i = INDEX( message_string, '&' )
116          DO WHILE ( i /= 0 )
117             WRITE( file_id, '(4X,A)' )  ADJUSTL( message_string(1:i-1) )
118             message_string = ADJUSTL( message_string(i+1:) )
119             i = INDEX( message_string, '&' )
120          ENDDO
121          WRITE( file_id, '(4X,A)' )  TRIM( message_string )
122
123!
124!--       Flush buffer, if requested
125          IF ( flush == 1 )  CALL local_flush( file_id )
126       ENDIF
127!    print*, '#10'
128
129       IF ( pe_out_of_range )  THEN
130          WRITE ( *, '(A)' )  '+++ WARNING from handle_palm_message:'
131          WRITE ( *, '(A,I6,A)' )  '    PE ', output_on_pe, &
132                                   ' choosed for output is larger '
133          WRITE ( *, '(A,I6)' )  '    than the maximum number of used PEs', &
134                                 numprocs-1
135          WRITE ( *, '(A)' )  '    Output is done on PE0 instead'
136       ENDIF
137!    print*, '#11'
138
139    ENDIF
140
141!
142!-- Abort execution, if requested
143!    print*, '#12'
144    IF ( requested_action > 0 )  THEN
145       abort_mode = requested_action
146       CALL local_stop
147    ENDIF
148!    print*, '#13'
149
150 END SUBROUTINE handle_palm_message
Note: See TracBrowser for help on using the repository browser.