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