1!/*****************************************************************************/
2! *
3! *  Elmer, A Finite Element Software for Multiphysical Problems
4! *
5! *  Copyright 1st April 1995 - , CSC - IT Center for Science Ltd., Finland
6! *
7! * This library is free software; you can redistribute it and/or
8! * modify it under the terms of the GNU Lesser General Public
9! * License as published by the Free Software Foundation; either
10! * version 2.1 of the License, or (at your option) any later version.
11! *
12! * This library is distributed in the hope that it will be useful,
13! * but WITHOUT ANY WARRANTY; without even the implied warranty of
14! * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15! * Lesser General Public License for more details.
16! *
17! * You should have received a copy of the GNU Lesser General Public
18! * License along with this library (in file ../LGPL-2.1); if not, write
19! * to the Free Software Foundation, Inc., 51 Franklin Street,
20! * Fifth Floor, Boston, MA  02110-1301  USA
21! *
22! *****************************************************************************/
23!
24!/******************************************************************************
25! *
26! *  Authors: Juha Ruokolainen
27! *  Email:   Juha.Ruokolainen@csc.fi
28! *  Web:     http://www.csc.fi/elmer
29! *  Address: CSC - IT Center for Science Ltd.
30! *           Keilaranta 14
31! *           02101 Espoo, Finland
32! *
33! *  Original Date: 2002
34! *
35! *****************************************************************************/
36
37!> \ingroup ElmerLib
38!> \{
39
40
41!-------------------------------------------------------------------------------
42!>  Message output routines for sending information and dealing with exceptions.
43!-------------------------------------------------------------------------------
44MODULE Messages
45
46   IMPLICIT NONE
47   CHARACTER(LEN=512) :: Message = ' '
48   INTEGER, PRIVATE :: i
49   LOGICAL :: OutputPrefix=.FALSE., OutputCaller=.TRUE.
50   LOGICAL :: OutputLevelMask(0:31) = .TRUE.
51   INTEGER :: MaxOutputLevel=31, MinOutputLevel=0, OutputPE = 0
52   INTEGER :: MaxOutputPE = 0, MinOutputPE = 0
53
54   INTEGER, PARAMETER :: EXIT_OK=0, EXIT_ERROR=1
55
56CONTAINS
57
58!-----------------------------------------------------------------------
59!> Prints information on the standard output if the requested or
60!> default output level does not surpass the maximum output level.
61!-----------------------------------------------------------------------
62   SUBROUTINE Info( Caller, String, noAdvance, Level )
63!-----------------------------------------------------------------------
64     CHARACTER(LEN=*) :: Caller, String
65     INTEGER, OPTIONAL :: Level
66     LOGICAL, OPTIONAL :: noAdvance
67!-----------------------------------------------------------------------
68
69     LOGICAL :: nadv, nadv1 = .FALSE.
70     INTEGER :: n
71     INTEGER, PARAMETER :: DefLevel = 4
72     SAVE nadv1
73
74!-----------------------------------------------------------------------
75
76     IF ( OutputPE < 0 ) RETURN
77
78     IF ( PRESENT( Level ) ) THEN
79       if (Level > MaxOutputLevel) RETURN
80       IF ( .NOT. OutputLevelMask(Level) ) RETURN
81     ELSE
82       ! The default level of info
83       !-------------------------------------------
84       IF( .NOT. OutputLevelMask(DefLevel) ) RETURN
85     END IF
86
87     nadv = .FALSE.
88     IF ( PRESENT( noAdvance ) ) nadv = noAdvance
89
90     IF(.NOT. nadv1 ) THEN
91       IF ( OutputPrefix ) THEN
92         WRITE( *,'(A)', ADVANCE = 'NO' ) 'INFO:: '
93       END IF
94
95       IF ( OutputCaller ) THEN
96         WRITE( *,'(A)', ADVANCE = 'NO' ) TRIM(Caller) // ': '
97       END IF
98     END IF
99
100
101     IF ( nadv ) THEN
102       ! If there are several partitions to be saved than plot the partition too
103       IF( MaxOutputPE > 0 ) THEN
104         WRITE( *,'(A,I0,A,A)', ADVANCE = 'NO' ) 'Part',OutputPE,': ',TRIM(String)
105       ELSE
106         WRITE( *,'(A)', ADVANCE = 'NO' )  TRIM(String)
107       END IF
108     ELSE
109       IF( MaxOutputPE > 0 ) THEN
110         WRITE( *,'(A,I0,A,A)', ADVANCE = 'YES' ) 'Part',OutputPE,': ',TRIM(String)
111       ELSE
112         WRITE( *,'(A)', ADVANCE = 'YES' ) TRIM(String)
113       END IF
114     END IF
115     nadv1 = nadv
116
117     CALL FLUSH(6)
118!-----------------------------------------------------------------------
119   END SUBROUTINE Info
120!-----------------------------------------------------------------------
121
122!-----------------------------------------------------------------------
123!> May be used to skip computation that only relates to printing info.
124!-----------------------------------------------------------------------
125   FUNCTION InfoActive( Level ) RESULT( Show )
126!-----------------------------------------------------------------------
127     INTEGER, OPTIONAL :: Level
128     LOGICAL :: Show
129!-----------------------------------------------------------------------
130     INTEGER, PARAMETER :: DefLevel = 4
131!-----------------------------------------------------------------------
132
133     IF ( PRESENT( Level ) ) THEN
134       Show = OutputLevelMask(Level)
135     ELSE
136       Show = OutputLevelMask(DefLevel)
137     END IF
138
139!-----------------------------------------------------------------------
140   END FUNCTION InfoActive
141!-----------------------------------------------------------------------
142
143
144
145!-----------------------------------------------------------------------
146!> When a suspicious incident takes place this subroutine may be used
147!> to inform the user.
148!-----------------------------------------------------------------------
149   SUBROUTINE Warn( Caller, String, noAdvance )
150!-----------------------------------------------------------------------
151     CHARACTER(LEN=*) :: Caller, String
152     LOGICAL, OPTIONAL :: noAdvance
153!-----------------------------------------------------------------------
154
155     LOGICAL :: nadv, nadv1 = .FALSE.
156     SAVE nadv1
157
158!-----------------------------------------------------------------------
159     IF ( .NOT. OutputLevelMask(2) ) RETURN
160
161     nadv = .FALSE.
162     IF ( PRESENT( noAdvance ) ) nadv = noAdvance
163
164     IF ( nadv ) THEN
165       IF ( MaxOutputPE > 0 ) THEN
166         WRITE( *, '(A,A,A,I0,A,A)', ADVANCE='NO' ) &
167             'WARNING:: ', TRIM(Caller), ': Part',OutputPE,':', TRIM(String)
168       ELSE
169         WRITE( *, '(A,A,A,A)', ADVANCE='NO' ) &
170             'WARNING:: ', TRIM(Caller), ': ', TRIM(String)
171       END IF
172     ELSE
173       IF ( .NOT. nadv1 ) THEN
174         IF( MaxOutputPE > 0 ) THEN
175           WRITE( *, '(A,A,A,I0,A,A)', ADVANCE='YES' ) &
176               'WARNING:: ', TRIM(Caller), ': Part',OutputPE,':', TRIM(String)
177         ELSE
178           WRITE( *, '(A,A,A,A)', ADVANCE='YES' ) &
179               'WARNING:: ', TRIM(Caller), ': ', TRIM(String)
180         END IF
181       ELSE
182         WRITE( *, '(A)', ADVANCE='YES' ) TRIM(String)
183       END IF
184     END IF
185     nadv1 = nadv
186     CALL FLUSH(6)
187!-----------------------------------------------------------------------
188   END SUBROUTINE Warn
189!-----------------------------------------------------------------------
190
191
192
193!-----------------------------------------------------------------------
194!> This routine may be used to inform the user of an error.
195!-----------------------------------------------------------------------
196   SUBROUTINE Error( Caller, String, noAdvance )
197!-----------------------------------------------------------------------
198     CHARACTER(LEN=*) :: Caller, String
199     LOGICAL, OPTIONAL :: noAdvance
200!-----------------------------------------------------------------------
201
202     LOGICAL :: nadv, nadv1 = .FALSE.
203     SAVE nadv1
204
205!-----------------------------------------------------------------------
206     IF ( .NOT. OutputLevelMask(1) ) RETURN
207
208     nadv = .FALSE.
209     IF ( PRESENT( noAdvance ) ) nadv = noAdvance
210
211     IF ( nadv ) THEN
212        WRITE( *, '(A,A,A,A)', ADVANCE='NO' ) &
213          'ERROR:: ', TRIM(Caller), ': ', TRIM(String )
214     ELSE
215        IF ( .NOT. nadv1 ) THEN
216           WRITE( *, '(A,A,A,A)', ADVANCE='YES' ) &
217             'ERROR:: ', TRIM(Caller), ': ', TRIM(String)
218        ELSE
219           WRITE( *, '(A)', ADVANCE='YES' ) TRIM(String)
220        END IF
221     END IF
222     nadv1 = nadv
223     CALL FLUSH(6)
224!-----------------------------------------------------------------------
225   END SUBROUTINE Error
226!-----------------------------------------------------------------------
227
228!-----------------------------------------------------------------------
229!> This routine may be used to terminate the program in the case of an error.
230!-----------------------------------------------------------------------
231   SUBROUTINE Fatal( Caller, String, noAdvance )
232!-----------------------------------------------------------------------
233     CHARACTER(LEN=*) :: Caller, String
234     LOGICAL, OPTIONAL :: noAdvance
235!-----------------------------------------------------------------------
236
237     LOGICAL :: nadv, nadv1 = .FALSE.
238     SAVE nadv1
239
240!-----------------------------------------------------------------------
241     IF ( .NOT. OutputLevelMask(0) ) STOP EXIT_ERROR
242
243     nadv = .FALSE.
244     IF ( PRESENT( noAdvance ) ) nadv = noAdvance
245
246     IF ( nadv ) THEN
247        WRITE( *, '(A,A,A,A)', ADVANCE='NO' ) &
248          'ERROR:: ', TRIM(Caller), ': ', TRIM(String )
249     ELSE
250        IF ( .NOT. nadv1 ) THEN
251           WRITE( *, '(A,A,A,A)', ADVANCE='YES' ) &
252             'ERROR:: ', TRIM(Caller), ': ', TRIM(String)
253        ELSE
254           WRITE( *, '(A)', ADVANCE='YES' ) TRIM(String)
255        END IF
256        STOP EXIT_ERROR
257     END IF
258     nadv1 = nadv
259     CALL FLUSH(6)
260!-----------------------------------------------------------------------
261   END SUBROUTINE Fatal
262!-----------------------------------------------------------------------
263
264END MODULE Messages
265
266!> \}
267