Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! Harmonized Emissions Component (HEMCO) !
3 : !------------------------------------------------------------------------------
4 : !BOP
5 : !
6 : ! !MODULE: hco_error_mod.F90
7 : !
8 : ! !DESCRIPTION: Module HCO\_Error\_Mod contains routines and variables
9 : ! for error handling and logfile messages in HEMCO. It also contains
10 : ! definitions of some globally used parameter, such as the single/double
11 : ! precision as well as the HEMCO precision definitions. The HEMCO precision
12 : ! is used for almost all HEMCO internal data arrays and can be changed below
13 : ! if required.
14 : !\\
15 : !\\
16 : ! The error settings are specified in the HEMCO configuration file and
17 : ! error handling is performed according to these settings. They include:
18 : !
19 : ! \begin{enumerate}
20 : ! \item HEMCO logfile: all HEMCO information is written into the specified
21 : ! logfile. The logfile can be set to the wildcard character, in which
22 : ! case the standard output will be used (this may be another opened
23 : ! logfile).
24 : ! \item Verbose: Number indicating the verbose level to be used.
25 : ! 0 = no verbose, 3 = very verbose. The verbose level can be set in
26 : ! the HEMCO configuration file. The default value is 0.
27 : ! \item Warnings: Number indicating the warning level to be shown.
28 : ! 0 = no warnings, 3 = all warnings.
29 : ! \end{enumerate}
30 : !
31 : ! The error settings are set via subroutine HCO\_ERROR\_SET, called when
32 : ! reading section 'settings' of the HEMCO configuration file (subroutine
33 : ! Config\_ReadFile in hco\_config\_mod.F90). The currently active verbose
34 : ! settings can be checked using subroutines HCO\_IsVerb and
35 : ! HCO\_VERBOSE\_INQ. Messages can be written into the logfile using
36 : ! subroutine HCO\_MSG. Note that the logfile actively need to be opened
37 : ! (HCO\_LOGFILE\_OPEN) before writing to it.
38 : !\\
39 : !\\
40 : ! The verbose and warning settings are all set to false if it's not the
41 : ! root CPU.
42 : !\\
43 : !\\
44 : ! As of HEMCO v2.0, all HEMCO error variables are organized in derived
45 : ! type object HcoErr. HcoErr is a component of the HEMCO configuration
46 : ! object (type ConfigObj, see hco\_types\_mod.F90). It must be passed
47 : ! explicitly to all error routines. This design allows the invocation
48 : ! of multiple independent HEMCO instances at the same time (which may
49 : ! have different HEMCO error settings).
50 : ! !INTERFACE:
51 : !
52 : MODULE HCO_Error_Mod
53 : !
54 : ! !USES:
55 : !
56 : #if defined( MAPL_ESMF )
57 : USE MAPL_Base, ONLY: MAPL_UNDEF
58 : #endif
59 : USE ISO_Fortran_Env, ONLY : INT32, INT64, REAL32, REAL64
60 :
61 : IMPLICIT NONE
62 : PRIVATE
63 : !
64 : ! !PUBLIC MEMBER FUNCTIONS:
65 : !
66 : PUBLIC :: HCO_ERROR
67 : PUBLIC :: HCO_WARNING
68 : PUBLIC :: HCO_MSG
69 : PUBLIC :: HCO_ENTER
70 : PUBLIC :: HCO_LEAVE
71 : PUBLIC :: HCO_ERROR_SET
72 : PUBLIC :: HCO_ERROR_FINAL
73 : PUBLIC :: HCO_IsVerb
74 : PUBLIC :: HCO_LOGFILE_OPEN
75 : PUBLIC :: HCO_LOGFILE_CLOSE
76 : !
77 : ! !MODULE VARIABLES:
78 : !
79 : ! Double and single precision definitions
80 : INTEGER, PARAMETER, PUBLIC :: dp = REAL64 ! Double (r8)
81 : INTEGER, PARAMETER, PUBLIC :: sp = REAL32 ! Single (r4)
82 : #ifdef USE_REAL8
83 : INTEGER, PARAMETER, PUBLIC :: hp = dp ! HEMCO precision = r8
84 : #else
85 : INTEGER, PARAMETER, PUBLIC :: hp = sp ! HEMCO precision = r4
86 : #endif
87 : INTEGER, PARAMETER, PUBLIC :: i4 = INT32 ! FourByteInt
88 : INTEGER, PARAMETER, PUBLIC :: i8 = INT64 ! EightByteInt
89 :
90 : ! Error success/failure definitions
91 : INTEGER, PARAMETER, PUBLIC :: HCO_SUCCESS = 0
92 : INTEGER, PARAMETER, PUBLIC :: HCO_FAIL = -999
93 :
94 : ! Tiny value for math operations:
95 : ! --> deprecated. Use TINY(1.0_hp) instead!
96 : REAL(hp), PARAMETER, PUBLIC :: HCO_TINY = 1.0e-32_hp
97 :
98 : ! Missing value
99 : ! Note: define missing value as single precision because all data arrays
100 : ! are read/stored in single precision.
101 : #if defined( MAPL_ESMF )
102 : REAL(sp), PARAMETER, PUBLIC :: HCO_MISSVAL = MAPL_UNDEF
103 : #else
104 : REAL(sp), PARAMETER, PUBLIC :: HCO_MISSVAL = -1.e31_sp
105 : #endif
106 :
107 : ! HEMCO version number.
108 : CHARACTER(LEN=12), PARAMETER, PUBLIC :: HCO_VERSION = '3.9.0'
109 :
110 : INTERFACE HCO_Error
111 : MODULE PROCEDURE HCO_ErrorNoErr
112 : MODULE PROCEDURE HCO_ErrorErr
113 : END INTERFACE HCO_Error
114 :
115 : INTERFACE HCO_Warning
116 : MODULE PROCEDURE HCO_WarningNoErr
117 : MODULE PROCEDURE HCO_WarningErr
118 : END INTERFACE HCO_Warning
119 :
120 : INTERFACE HCO_MSG
121 : MODULE PROCEDURE HCO_MsgNoErr
122 : MODULE PROCEDURE HCO_MsgErr
123 : END INTERFACE HCO_MSG
124 :
125 : !
126 : ! !REVISION HISTORY:
127 : ! 23 Sep 2013 - C. Keller - Initialization
128 : ! See https://github.com/geoschem/hemco for complete history
129 : !EOP
130 : !------------------------------------------------------------------------------
131 : !BOC
132 : !
133 : ! !PRIVATE VARIABLES:
134 : !
135 : TYPE, PUBLIC :: HcoErr
136 : LOGICAL :: FirstOpen = .TRUE.
137 : LOGICAL :: IsRoot = .FALSE.
138 : LOGICAL :: LogIsOpen = .FALSE.
139 : LOGICAL :: doVerbose = .FALSE.
140 : INTEGER :: nWarnings = 0
141 : INTEGER :: CurrLoc = -1
142 : CHARACTER(LEN=255), POINTER :: Loc(:) => NULL()
143 : CHARACTER(LEN=255) :: LogFile = ''
144 : INTEGER :: Lun = -1
145 : END TYPE HcoErr
146 :
147 : ! MAXNEST is the maximum accepted subroutines nesting level.
148 : ! This only applies to routines with activated error tracking,
149 : ! i.e. which use HCO_ENTER/HCO_LEAVE statements.
150 : INTEGER, PARAMETER :: MAXNEST = 10
151 :
152 : CONTAINS
153 : !EOC
154 : !------------------------------------------------------------------------------
155 : ! Harmonized Emissions Component (HEMCO) !
156 : !------------------------------------------------------------------------------
157 : !BOP
158 : !
159 : ! !IROUTINE: HCO_Error
160 : !
161 : ! !DESCRIPTION: Subroutine HCO\_Error promts an error message and sets RC to
162 : ! HCO\_FAIL. Note that this routine does not stop a run, but it will cause a
163 : ! stop at higher level (when RC gets evaluated).
164 : !\\
165 : !\\
166 : ! !INTERFACE:
167 : !
168 0 : SUBROUTINE HCO_ErrorErr( Err, ErrMsg, RC, THISLOC )
169 : !
170 : ! !INPUT PARAMETERS:
171 : !
172 : TYPE(HcoErr), POINTER :: Err
173 : CHARACTER(LEN=*), INTENT(IN ) :: ErrMsg
174 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: THISLOC
175 : !
176 : ! !INPUT/OUTPUT PARAMETERS:
177 : !
178 : INTEGER, INTENT(INOUT) :: RC
179 : !
180 : ! !REVISION HISTORY:
181 : ! 23 Sep 2013 - C. Keller - Initialization
182 : ! See https://github.com/geoschem/hemco for complete history
183 : !EOP
184 : !------------------------------------------------------------------------------
185 : !BOC
186 : INTEGER :: I, J
187 : CHARACTER(LEN=1023) :: MSG
188 :
189 : !======================================================================
190 : ! HCO_ERROR begins here
191 : !======================================================================
192 :
193 : ! Print error message
194 0 : MSG = 'HEMCO ERROR: ' // TRIM(ErrMsg)
195 0 : CALL HCO_MSG ( Err, MSG, SEP1='!' )
196 :
197 : ! Print error location
198 0 : IF ( PRESENT(THISLOC) ) THEN
199 0 : MSG = 'ERROR LOCATION: ' // TRIM( THISLOC )
200 0 : CALL HCO_MSG ( Err, MSG )
201 :
202 : ! Traceback
203 : ELSE
204 0 : DO I = 0, Err%CurrLoc-1
205 0 : J = Err%CurrLoc-I
206 0 : MSG = 'ERROR LOCATION: ' // TRIM( Err%Loc(J) )
207 0 : CALL HCO_MSG ( Err, MSG )
208 : ENDDO
209 : ENDIF
210 :
211 0 : MSG = ''
212 0 : CALL HCO_MSG ( Err, MSG, SEP2='!' )
213 :
214 : ! Return w/ error
215 0 : RC = HCO_FAIL
216 :
217 0 : END SUBROUTINE HCO_ErrorErr
218 : !EOC
219 : !------------------------------------------------------------------------------
220 : ! Harmonized Emissions Component (HEMCO) !
221 : !------------------------------------------------------------------------------
222 : !BOP
223 : !
224 : ! !IROUTINE: HCO_Error
225 : !
226 : ! !DESCRIPTION: Subroutine HCO\_Error promts an error message and sets RC to
227 : ! HCO\_FAIL. Note that this routine does not stop a run, but it will cause a
228 : ! stop at higher level (when RC gets evaluated).
229 : !\\
230 : !\\
231 : ! !INTERFACE:
232 : !
233 0 : SUBROUTINE HCO_ErrorNoErr( ErrMsg, RC, THISLOC )
234 : !
235 : ! !USES:
236 : !
237 : #if defined( ESMF_ )
238 : #include "MAPL_Generic.h"
239 : USE ESMF
240 : USE MAPLBase_Mod
241 : #endif
242 : !
243 : ! !INPUT PARAMETERS:
244 : !
245 : CHARACTER(LEN=*), INTENT(IN ) :: ErrMsg
246 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: THISLOC
247 : !
248 : ! !INPUT/OUTPUT PARAMETERS:
249 : !
250 : INTEGER, INTENT(INOUT) :: RC
251 : !
252 : ! !REVISION HISTORY:
253 : ! 23 Sep 2013 - C. Keller - Initialization
254 : ! See https://github.com/geoschem/hemco for complete history
255 : !EOP
256 : !------------------------------------------------------------------------------
257 : !BOC
258 : INTEGER :: I, J
259 : CHARACTER(LEN=1023) :: MSG, MSG1, MSG2
260 : #if defined( ESMF_)
261 : INTEGER :: localPET, STATUS
262 : CHARACTER(4) :: localPETchar
263 : TYPE(ESMF_VM) :: VM
264 : #endif
265 :
266 : !======================================================================
267 : ! HCO_ERROR begins here
268 : !======================================================================
269 :
270 : ! Construct error message
271 : #if defined( ESMF_ )
272 : ! Get current thread number
273 : CALL ESMF_VMGetCurrent(VM, RC=STATUS)
274 : CALL ESMF_VmGet( VM, localPET=localPET, __RC__ )
275 : WRITE(localPETchar,'(I4.4)') localPET
276 : MSG1 = 'HEMCO ERROR ['//TRIM(localPETchar)//']: '//TRIM(ErrMsg)
277 : #else
278 0 : MSG1 = 'HEMCO ERROR: '//TRIM(ErrMsg)
279 : #endif
280 0 : MSG2 = ''
281 0 : IF ( PRESENT(THISLOC) ) THEN
282 0 : MSG2 = NEW_LINE('a') // ' --> LOCATION: ' // TRIM( THISLOC )
283 : ENDIF
284 0 : MSG = NEW_LINE('a') // TRIM(MSG1) // TRIM(MSG2)
285 :
286 : ! Print error message
287 0 : WRITE(*,*) TRIM(MSG)
288 :
289 : ! Return w/ error
290 0 : RC = HCO_FAIL
291 :
292 0 : END SUBROUTINE HCO_ErrorNoErr
293 : !EOC
294 : !------------------------------------------------------------------------------
295 : ! Harmonized Emissions Component (HEMCO) !
296 : !------------------------------------------------------------------------------
297 : !BOP
298 : !
299 : ! !IROUTINE: HCO_Warning
300 : !
301 : ! !DESCRIPTION: Subroutine HCO\_Warning promts a warning message without
302 : ! forcing HEMCO to stop, i.e. return code is set to HCO\_SUCCESS.
303 : !\\
304 : !\\
305 : ! !INTERFACE:
306 : !
307 0 : SUBROUTINE HCO_WarningErr( Err, ErrMsg, RC, THISLOC )
308 : !
309 : ! !INPUT PARAMETERS"
310 : !
311 : TYPE(HcoErr), POINTER :: Err
312 : CHARACTER(LEN=*), INTENT(IN ) :: ErrMsg
313 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: THISLOC
314 : !
315 : ! !INPUT/OUTPUT PARAMETERS:
316 : !
317 : INTEGER, INTENT(INOUT) :: RC
318 : !
319 : ! !REVISION HISTORY:
320 : ! 23 Sep 2013 - C. Keller - Initialization
321 : ! See https://github.com/geoschem/hemco for complete history
322 : !EOP
323 : !------------------------------------------------------------------------------
324 : !BOC
325 : INTEGER :: WLEV
326 : CHARACTER(LEN=255) :: MSG
327 :
328 : !======================================================================
329 : ! HCO_WARNING begins here
330 : !======================================================================
331 :
332 : ! Only print warnings when verbose output is requested
333 0 : IF ( HCO_IsVerb( Err ) ) THEN
334 :
335 : ! Print warning
336 0 : MSG = 'HEMCO WARNING: ' // TRIM( ErrMsg )
337 0 : CALL HCO_MSG ( Err, MSG )
338 :
339 : ! Print location
340 0 : IF ( PRESENT(THISLOC) ) THEN
341 0 : MSG = '--> LOCATION: ' // TRIM(THISLOC)
342 0 : CALL HCO_MSG ( Err, MSG )
343 0 : ELSEIF ( Err%CurrLoc > 0 ) THEN
344 0 : MSG = '--> LOCATION: ' // TRIM(Err%Loc(Err%CurrLoc))
345 0 : CALL HCO_MSG ( Err, MSG )
346 : ENDIF
347 :
348 : ! Increase # of warnings
349 0 : Err%nWarnings = Err%nWarnings + 1
350 : ENDIF
351 :
352 : ! Return w/ success
353 0 : RC = HCO_SUCCESS
354 :
355 0 : END SUBROUTINE HCO_WarningErr
356 : !EOC
357 : !------------------------------------------------------------------------------
358 : ! Harmonized Emissions Component (HEMCO) !
359 : !------------------------------------------------------------------------------
360 : !BOP
361 : !
362 : ! !IROUTINE: HCO_Warning
363 : !
364 : ! !DESCRIPTION: Subroutine HCO\_Warning promts a warning message without
365 : ! forcing HEMCO to stop, i.e. return code is set to HCO\_SUCCESS.
366 : !\\
367 : !\\
368 : ! !INTERFACE:
369 : !
370 0 : SUBROUTINE HCO_WarningNoErr( ErrMsg, RC, verb, THISLOC )
371 : !
372 : ! !INPUT PARAMETERS"
373 : !
374 : CHARACTER(LEN=*), INTENT(IN ) :: ErrMsg
375 : LOGICAL , INTENT(IN ), OPTIONAL :: verb
376 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: THISLOC
377 : !
378 : ! !INPUT/OUTPUT PARAMETERS:
379 : !
380 : INTEGER, INTENT(INOUT) :: RC
381 : !
382 : ! !REVISION HISTORY:
383 : ! 23 Sep 2013 - C. Keller - Initialization
384 : ! See https://github.com/geoschem/hemco for complete history
385 : !EOP
386 : !------------------------------------------------------------------------------
387 : !BOC
388 : INTEGER :: WLEV
389 : CHARACTER(LEN=255) :: MSG
390 :
391 : !======================================================================
392 : ! HCO_WARNING begins here
393 : !======================================================================
394 :
395 : ! Exit if verbose output is not requested
396 0 : IF ( .not. verb ) RETURN
397 :
398 : ! Print warning
399 0 : MSG = 'HEMCO WARNING: ' // TRIM( ErrMsg )
400 0 : WRITE( 6, '(a)' ) TRIM(MSG)
401 :
402 : ! Print location
403 0 : IF ( PRESENT(THISLOC) ) THEN
404 0 : MSG = '--> LOCATION: ' // TRIM(THISLOC)
405 0 : WRITE( 6, '(a)' ) TRIM(MSG)
406 : ENDIF
407 :
408 : ! Return w/ success
409 0 : RC = HCO_SUCCESS
410 :
411 : END SUBROUTINE HCO_WarningNoErr
412 : !EOC
413 : !------------------------------------------------------------------------------
414 : ! Harmonized Emissions Component (HEMCO) !
415 : !------------------------------------------------------------------------------
416 : !BOP
417 : !
418 : ! !IROUTINE: HCO_MSG
419 : !
420 : ! !DESCRIPTION: Subroutine HCO\_MSG passes message msg to the HEMCO
421 : ! logfile (or to standard output if the logfile is not open).
422 : ! Sep1 and Sep2 denote line delimiters before and after the message,
423 : ! respectively.
424 : ! The optional argument Verb denotes the minimum verbose level associated
425 : ! with this message. The message will only be prompted if the verbose level
426 : ! on this CPU (e.g. of this Err object) is at least as high as Verb.
427 : !\\
428 : !\\
429 : ! !INTERFACE:
430 : !
431 0 : SUBROUTINE HCO_MSGErr( Err, Msg, Sep1, Sep2 )
432 : !
433 : ! !INPUT PARAMETERS:
434 : !
435 : TYPE(HcoErr), POINTER :: Err
436 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: Msg
437 : CHARACTER(LEN=1), INTENT(IN ), OPTIONAL :: Sep1
438 : CHARACTER(LEN=1), INTENT(IN ), OPTIONAL :: Sep2
439 : !
440 : ! !REMARKS:
441 : ! Refactored to avoid ELSE statements, which are a computational bottleneck.
442 : !
443 : ! !REVISION HISTORY:
444 : ! 23 Sep 2013 - C. Keller - Initialization
445 : ! See https://github.com/geoschem/hemco for complete history
446 : !EOP
447 : !------------------------------------------------------------------------------
448 : !BOC
449 : INTEGER :: LUN
450 :
451 : !=======================================================================
452 : ! HCO_MSG begins here
453 : !=======================================================================
454 :
455 : ! Exit if Err is NULL
456 0 : IF ( .NOT. ASSOCIATED( Err) ) RETURN
457 :
458 : ! Exit if we are not on the root core
459 0 : IF ( .NOT. Err%IsRoot ) RETURN
460 :
461 : ! Exit if Verbose is turned off
462 0 : IF ( .not. Err%doVerbose ) RETURN
463 :
464 : !=======================================================================
465 : ! Write message
466 : !=======================================================================
467 :
468 : ! Get the file unit, or if the file is not open, use stdout
469 0 : LUN = Err%LUN
470 0 : IF ( ( .not. Err%LogIsOpen ) .or. ( LUN <= 0 ) ) LUN = 6
471 :
472 : ! If logfile is open then write to it
473 : ! Otherwise write to stdout (unit #6)
474 0 : IF ( PRESENT(SEP1) ) THEN
475 0 : WRITE( LUN,'(a)' ) REPEAT( SEP1, 79 )
476 : ENDIF
477 0 : IF ( PRESENT(MSG) ) THEN
478 0 : WRITE( LUN,'(a)' ) TRIM( MSG )
479 : ENDIF
480 0 : IF ( PRESENT(SEP2) ) THEN
481 0 : WRITE( LUN,'(a)' ) REPEAT( SEP2, 79 )
482 : ENDIF
483 :
484 : END SUBROUTINE HCO_MsgErr
485 : !EOC
486 : !------------------------------------------------------------------------------
487 : ! Harmonized Emissions Component (HEMCO) !
488 : !------------------------------------------------------------------------------
489 : !BOP
490 : !
491 : ! !IROUTINE: HCO_MSG
492 : !
493 : ! !DESCRIPTION: Subroutine HCO\_MSG passes message msg to the HEMCO
494 : ! logfile (or to standard output if the logfile is not open).
495 : ! Sep1 and Sep2 denote line delimiters before and after the message,
496 : ! respectively.
497 : ! The optional argument Verb denotes the minimum verbose level associated
498 : ! with this message. The message will only be prompted if the verbose level
499 : ! on this CPU (e.g. of this Err object) is at least as high as Verb.
500 : !\\
501 : !\\
502 : ! !INTERFACE:
503 : !
504 0 : SUBROUTINE HCO_MSGnoErr( Msg, Sep1, Sep2, Verb )
505 : !
506 : ! !INPUT PARAMETERS:
507 : !
508 : CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: Msg
509 : CHARACTER(LEN=1), INTENT(IN ), OPTIONAL :: Sep1
510 : CHARACTER(LEN=1), INTENT(IN ), OPTIONAL :: Sep2
511 : LOGICAL, INTENT(IN ), OPTIONAL :: Verb
512 : !
513 : ! !REVISION HISTORY:
514 : ! 23 Sep 2013 - C. Keller - Initialization
515 : ! See https://github.com/geoschem/hemco for complete history
516 : !EOP
517 : !------------------------------------------------------------------------------
518 : !BOC
519 :
520 : !======================================================================
521 : ! HCO_MSG begins here
522 : !======================================================================
523 :
524 : ! Exit if verbose is not requested
525 0 : IF ( .not. Verb ) RETURN
526 :
527 : ! Print message and optional separator lines
528 0 : IF ( PRESENT( SEP1 ) ) THEN
529 0 : WRITE( 6, '(a)' ) REPEAT( SEP1, 79 )
530 : ENDIF
531 0 : IF ( PRESENT( msg ) ) THEN
532 0 : WRITE( 6, '(a)' ) TRIM( msg )
533 : ENDIF
534 0 : IF ( PRESENT( SEP2 ) ) THEN
535 0 : WRITE( 6, '(a)' ) REPEAT( SEP2, 79 )
536 : ENDIF
537 :
538 0 : END SUBROUTINE HCO_MsgNoErr
539 : !EOC
540 : !------------------------------------------------------------------------------
541 : ! Harmonized Emissions Component (HEMCO) !
542 : !------------------------------------------------------------------------------
543 : !BOP
544 : !
545 : ! !IROUTINE: HCO_Enter
546 : !
547 : ! !DESCRIPTION: Subroutine HCO\_Enter is called upon entering a routine.
548 : ! It organizes the traceback handling. It is recommended to call this
549 : ! routine for 'big' routines but NOT for routines/functions that are
550 : ! frequently called, e.g. inside of loops!
551 : !\\
552 : !\\
553 : ! Note that all subroutines calling HCO\_Enter must also call HCO\_Leave!
554 : !\\
555 : !\\
556 : ! !INTERFACE:
557 : !
558 0 : SUBROUTINE HCO_Enter( Err, thisLoc, RC )
559 : !
560 : ! !INPUT PARAMETERS:
561 : !
562 : TYPE(HcoErr), POINTER :: Err
563 : CHARACTER(LEN=*), INTENT(IN ) :: thisLoc
564 : !
565 : ! !INPUT/OUTPUT PARAMETERS:
566 : !
567 : INTEGER, INTENT(INOUT) :: RC
568 : !
569 : ! !REVISION HISTORY:
570 : ! 23 Sep 2013 - C. Keller - Initialization
571 : ! See https://github.com/geoschem/hemco for complete history
572 : !EOP
573 : !------------------------------------------------------------------------------
574 : !BOC
575 : CHARACTER(LEN=255) :: Msg, Loc
576 :
577 : !======================================================================
578 : ! HCO_ENTER begins here
579 : !======================================================================
580 :
581 0 : IF ( .NOT. ASSOCIATED(Err) ) RETURN
582 :
583 : ! Increment position
584 0 : Err%CurrLoc = Err%CurrLoc + 1
585 0 : IF ( Err%CurrLoc > MaxNest ) THEN
586 0 : Msg = 'MaxNest too low, cannot enter ' // TRIM(thisLoc)
587 0 : CALL HCO_Error( Err, Msg, RC )
588 0 : RETURN
589 : ENDIF
590 :
591 : ! Error trap
592 0 : IF ( Err%CurrLoc <= 0 ) THEN
593 0 : Msg = 'CurrLoc is zero, cannot enter: ' // TRIM(thisLoc)
594 0 : CALL HCO_Error( Err, Msg, RC )
595 0 : RETURN
596 : ENDIF
597 :
598 : ! Register current routine
599 0 : Err%Loc(Err%CurrLoc) = thisLoc
600 :
601 : ! Track location if enabled
602 0 : IF ( HCO_IsVerb( Err ) ) THEN
603 0 : WRITE(MSG,100) TRIM(thisLoc), Err%CurrLoc
604 0 : CALL HCO_Msg( Err, MSG )
605 : ENDIF
606 :
607 : ! Set RC to success
608 0 : RC = HCO_SUCCESS
609 :
610 : 100 FORMAT( 'HEMCO: Entering ', a, ' (', i2, ')' )
611 :
612 0 : END SUBROUTINE HCO_Enter
613 : !EOC
614 : !------------------------------------------------------------------------------
615 : ! Harmonized Emissions Component (HEMCO) !
616 : !------------------------------------------------------------------------------
617 : !BOP
618 : !
619 : ! !IROUTINE: HCO_Leave
620 : !
621 : ! !DESCRIPTION: Subroutine HCO\_Leave is called upon leaving a routine.
622 : ! It organizes the traceback handling. It is recommended to call this
623 : ! routine for 'big' routines but NOT for routines/functions that are
624 : ! frequently called, e.g. inside of loops!
625 : !\\
626 : !\\
627 : ! Note that all subroutines calling HCO\_Leave must also call HCO\_Enter!
628 : !\\
629 : !\\
630 : ! !INTERFACE:
631 : !
632 0 : SUBROUTINE HCO_Leave( Err, RC )
633 : !
634 : ! !INPUT/OUTPUT PARAMETERS:
635 : !
636 : TYPE(HcoErr), POINTER :: Err
637 : INTEGER, INTENT(INOUT) :: RC
638 : !
639 : ! !REVISION HISTORY:
640 : ! 23 Sep 2013 - C. Keller - Initialization
641 : ! See https://github.com/geoschem/hemco for complete history
642 : !EOP
643 : !------------------------------------------------------------------------------
644 : !BOC
645 : CHARACTER(LEN=255) :: MSG, LOC
646 :
647 : !======================================================================
648 : ! HCO_LEAVE begins here
649 : !======================================================================
650 :
651 0 : IF ( .NOT. ASSOCIATED(Err) ) RETURN
652 :
653 : ! Track location if enabled
654 0 : IF ( HCO_IsVerb( Err ) ) THEN
655 0 : WRITE(MSG,110) TRIM(Err%Loc(Err%CurrLoc)), Err%CurrLoc
656 0 : CALL HCO_MSG( Err, MSG )
657 : ENDIF
658 :
659 : ! Remove from list
660 0 : Err%Loc(Err%CurrLoc) = ''
661 :
662 : ! Remove current position
663 0 : Err%CurrLoc = Err%CurrLoc - 1
664 :
665 : ! Error trap
666 0 : IF ( Err%CurrLoc < 0 ) THEN
667 0 : Msg = 'CurrLoc is below zero, this should never happen!!'
668 0 : CALL HCO_ERROR ( Err, Msg, RC )
669 0 : RETURN
670 : ENDIF
671 :
672 : ! Return w/ success
673 0 : RC = HCO_SUCCESS
674 :
675 : 110 FORMAT( 'HEMCO: Leaving ', a, ' (', i2, ')' )
676 :
677 : END SUBROUTINE HCO_Leave
678 : !EOC
679 : !------------------------------------------------------------------------------
680 : ! Harmonized Emissions Component (HEMCO) !
681 : !------------------------------------------------------------------------------
682 : !BOP
683 : !
684 : ! !IROUTINE: HCO_Error_Set
685 : !
686 : ! !DESCRIPTION: Subroutine HCO\_Error\_Set defines the HEMCO error
687 : ! settings. This routine is called at the beginning of a HEMCO
688 : ! simulation. Its input parameter are directly taken from the
689 : ! HEMCO configuration file. If LogFile is set to '*' (asterik),
690 : ! all output is directed to the standard output.
691 : !\\
692 : !\\
693 : ! !INTERFACE:
694 : !
695 0 : SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, &
696 : doVerbose, doVerboseOnRoot, RC )
697 :
698 : !
699 : ! !INPUT PARAMETERS:
700 : !
701 : LOGICAL, INTENT(IN) :: am_I_Root ! Root CPU?
702 : TYPE(HcoErr), POINTER :: Err ! Error object
703 : CHARACTER(LEN=*), INTENT(IN) :: LogFile ! logfile path+name
704 : !
705 : ! !INPUT/OUTPUT PARAMETERS:
706 : !
707 : LOGICAL, INTENT(INOUT) :: doVerbose ! Verbose output T/F?
708 : LOGICAL, INTENT(INOUT) :: doVerboseOnRoot ! =T: Verbose on root
709 : ! =F: Verbose on all
710 : INTEGER, INTENT(INOUT) :: RC
711 : !
712 : ! !REVISION HISTORY:
713 : ! 23 Sep 2013 - C. Keller - Initialization
714 : ! See https://github.com/geoschem/hemco for complete history
715 : !EOP
716 : !------------------------------------------------------------------------------
717 : !BOC
718 :
719 : INTEGER :: Lun
720 :
721 : !======================================================================
722 : ! HCO_ERROR_SET begins here
723 : !======================================================================
724 :
725 : ! Nothing to do if already defined
726 0 : RC = HCO_SUCCESS
727 0 : IF ( ASSOCIATED(Err) ) RETURN
728 :
729 : ! Allocate error type
730 0 : ALLOCATE(Err)
731 0 : ALLOCATE(Err%Loc(MAXNEST))
732 0 : Err%Loc(:) = ''
733 :
734 : ! Pass values
735 0 : Err%IsRoot = am_I_Root
736 0 : Err%LogFile = TRIM(LogFile)
737 :
738 : ! Specify if verbose will be printed on the root core, or all cores
739 0 : IF ( doVerboseOnRoot ) THEN
740 0 : Err%doVerbose = ( doVerbose .and. am_I_Root )
741 : ELSE
742 0 : Err%doVerbose = doVerbose
743 : ENDIF
744 :
745 : ! Init misc. values
746 0 : Err%FirstOpen = .TRUE.
747 0 : Err%LogIsOpen = .FALSE.
748 0 : Err%CurrLoc = 0
749 :
750 : ! If Logfile is set to '*', set lun to -1 (--> write into default file).
751 : ! Otherwise, set lun to 0 (--> write into specified logfile)
752 0 : IF ( TRIM(Err%LogFile) == '*' ) THEN
753 : LUN = -1
754 : ELSE
755 0 : LUN = 0
756 : ENDIF
757 0 : Err%Lun = LUN
758 :
759 : ! Return w/ success
760 0 : RC = HCO_SUCCESS
761 :
762 : END SUBROUTINE HCO_ERROR_SET
763 : !EOC
764 : !------------------------------------------------------------------------------
765 : ! Harmonized Emissions Component (HEMCO) !
766 : !------------------------------------------------------------------------------
767 : !BOP
768 : !
769 : ! !IROUTINE: HCO_Error_Final
770 : !
771 : ! !DESCRIPTION: Subroutine HCO\_Error\_Final finalizes the error type.
772 : !\\
773 : !\\
774 : ! !INTERFACE:
775 : !
776 0 : SUBROUTINE HCO_Error_Final ( Err )
777 : !
778 : ! !INPUT/OUTPUT PARAMETERS:
779 : !
780 : TYPE(HcoErr), POINTER :: Err ! Error object
781 : !
782 : ! !REVISION HISTORY:
783 : ! 23 Sep 2013 - C. Keller - Initialization
784 : ! See https://github.com/geoschem/hemco for complete history
785 : !EOP
786 : !------------------------------------------------------------------------------
787 : !BOC
788 :
789 : INTEGER :: STAT
790 :
791 : !======================================================================
792 : ! HCO_ERROR_FINAL begins here
793 : !======================================================================
794 :
795 : ! Eventually close logfile
796 0 : CALL HCO_Logfile_Close( Err, ShowSummary=.TRUE. )
797 :
798 0 : IF ( ASSOCIATED(Err) ) THEN
799 0 : IF ( ASSOCIATED(Err%Loc) ) DEALLOCATE(Err%Loc)
800 0 : DEALLOCATE(Err)
801 : ENDIF
802 0 : Err => NULL()
803 :
804 0 : END SUBROUTINE HCO_Error_Final
805 : !EOC
806 : !------------------------------------------------------------------------------
807 : ! Harmonized Emissions Component (HEMCO) !
808 : !------------------------------------------------------------------------------
809 : !BOP
810 : !
811 : ! !IROUTINE: HCO_IsVerb
812 : !
813 : ! !DESCRIPTION: Returns true if the HEMCO verbose output is turned on.
814 : !\\
815 : !\\
816 : ! !INTERFACE:
817 : !
818 0 : FUNCTION HCO_IsVerb( Err ) RESULT ( IsVerb )
819 : !
820 : ! !INPUT PARAMETERS:
821 : !
822 : TYPE(HcoErr), POINTER :: Err ! Error object
823 : !
824 : ! !OUTPUT PARAMETERS:
825 : !
826 : LOGICAL :: isVerb
827 : !EOP
828 : !------------------------------------------------------------------------------
829 : !BOC
830 :
831 : !======================================================================
832 : ! HCO_IsVerb begins here
833 : !======================================================================
834 :
835 : ! Initialize
836 0 : isVerb = .FALSE.
837 :
838 : ! Return if the Err object is null
839 0 : IF ( .not. ASSOCIATED( Err ) ) RETURN
840 :
841 : ! Check if "Verbose: 3" was set in the HEMCO_Config.rc file
842 0 : isVerb = Err%doVerbose
843 :
844 0 : END FUNCTION HCO_IsVerb
845 : !EOC
846 : !------------------------------------------------------------------------------
847 : ! Harmonized Emissions Component (HEMCO) !
848 : !------------------------------------------------------------------------------
849 : !BOP
850 : !
851 : ! !ROUTINE: HCO_LOGFILE_OPEN
852 : !
853 : ! !DESCRIPTION: Subroutine HCO\_LOGFILE\_OPEN opens the HEMCO logfile
854 : ! (if not yet open).
855 : !\\
856 : !\\
857 : ! !INTERFACE:
858 : !
859 0 : SUBROUTINE HCO_LogFile_Open( Err, RC )
860 : !
861 : ! !USES:
862 : !
863 : USE HCO_inquireMod, ONLY : findFreeLUN
864 : !
865 : ! !INPUT/OUTPUT PARAMETERS:
866 : !
867 : TYPE(HcoErr), POINTER :: Err ! Error object
868 : INTEGER, INTENT(INOUT) :: RC
869 : !
870 : ! !REVISION HISTORY:
871 : ! 23 Sep 2013 - C. Keller - Initialization
872 : ! See https://github.com/geoschem/hemco for complete history
873 : !EOP
874 : !------------------------------------------------------------------------------
875 : !BOC
876 : CHARACTER(LEN=255) :: MSG
877 : INTEGER :: IOS, LUN, FREELUN
878 : LOGICAL :: isopen, exists
879 :
880 : !======================================================================
881 : ! HCO_LOGFILE_OPEN begins here
882 : !======================================================================
883 :
884 : ! Init
885 0 : RC = HCO_SUCCESS
886 :
887 : ! Check if object exists
888 0 : IF ( .NOT. ASSOCIATED(Err)) THEN
889 0 : PRINT *, 'Cannot open logfile - Err object not defined!'
890 0 : RC = HCO_FAIL
891 0 : RETURN
892 : ENDIF
893 :
894 : ! Never open if we are not on the root CPU
895 0 : IF ( .NOT. Err%IsRoot ) RETURN
896 :
897 : ! Don't do anything if we write into standard output!
898 0 : IF ( Err%LUN < 0 ) THEN
899 0 : Err%LogIsOpen = .TRUE.
900 :
901 : ! Explicit HEMCO logfile:
902 : ELSE
903 :
904 : ! Find free LUN just in case we need it!
905 0 : FREELUN = findFreeLun()
906 :
907 : ! Inquire if file is already open
908 0 : INQUIRE( FILE=TRIM(Err%LogFile), OPENED=isOpen, EXIST=exists, NUMBER=LUN )
909 :
910 : ! File exists and is opened ==> nothing to do
911 0 : IF ( exists .AND. isOpen ) THEN
912 0 : Err%LUN = LUN
913 0 : Err%LogIsOpen = .TRUE.
914 :
915 : ! File exists but not opened ==> reopen
916 0 : ELSEIF (exists .AND. .NOT. isOpen ) THEN
917 :
918 : ! Replace existing file on first call
919 0 : IF ( Err%FirstOpen ) THEN
920 : OPEN ( UNIT=FREELUN, FILE=TRIM(Err%LogFile), STATUS='REPLACE', &
921 0 : ACTION='WRITE', FORM='FORMATTED', IOSTAT=IOS )
922 0 : IF ( IOS /= 0 ) THEN
923 0 : PRINT *, 'Cannot create logfile: ' // TRIM(Err%LogFile)
924 0 : RC = HCO_FAIL
925 0 : RETURN
926 : ENDIF
927 :
928 : ! File exists and is opened ==> nothing to do
929 :
930 :
931 : ! Reopen otherwise
932 : ELSE
933 : OPEN ( UNIT=FREELUN, FILE=TRIM(Err%LogFile), STATUS='OLD', &
934 : ACTION='WRITE', POSITION='APPEND', FORM='FORMATTED', & ! NAG did not like ACCESS='APPEND' -- use standard-compliant position='append'
935 0 : IOSTAT=IOS )
936 0 : IF ( IOS /= 0 ) THEN
937 0 : PRINT *, 'Cannot reopen logfile: ' // TRIM(Err%LogFile)
938 0 : RC = HCO_FAIL
939 0 : RETURN
940 : ENDIF
941 : ENDIF
942 :
943 0 : Err%LUN = FREELUN
944 0 : Err%LogIsOpen = .TRUE.
945 :
946 : ! File does not yet exist ==> open new file
947 : ELSE
948 : OPEN ( UNIT=FREELUN, FILE=TRIM(Err%LogFile), &
949 : STATUS='NEW', ACTION='WRITE', IOSTAT=IOS, &
950 0 : FORM='FORMATTED' )
951 0 : IF ( IOS /= 0 ) THEN
952 0 : PRINT *, 'Cannot create logfile: ' // TRIM(Err%LogFile)
953 0 : RC = HCO_FAIL
954 0 : RETURN
955 : ENDIF
956 0 : Err%LUN = FREELUN
957 0 : Err%LogIsOpen = .TRUE.
958 : ENDIF
959 : ENDIF
960 :
961 : ! Write header on first call
962 0 : IF ( Err%FirstOpen ) THEN
963 0 : LUN = Err%Lun ! Log gets written to file
964 0 : IF ( Err%LUN < 0 ) LUN = 6 ! or to stdout if file isn't open
965 :
966 : ! Only write the version info if verbose output is requested
967 0 : IF ( HCO_IsVerb( Err ) ) THEN
968 :
969 : ! Write header
970 0 : WRITE( LUN, '(a)' ) REPEAT( '-', 79)
971 0 : WRITE( LUN, '(a12, a)' ) 'Using HEMCO ', HCO_VERSION
972 0 : WRITE( LUN, '(a)' )
973 : #ifdef USE_REAL8
974 0 : WRITE( LUN, 100 )
975 : 100 FORMAT('HEMCO precision (hp) is set to is 8-byte real (aka REAL*8)')
976 : #else
977 : WRITE( LUN, 110 )
978 : 110 FORMAT('HEMCO precision (hp) is set to is 4-byte real (aka REAL*4)')
979 : #endif
980 0 : WRITE( LUN, '(a)' ) REPEAT( '-', 79)
981 : ENDIF
982 :
983 0 : Err%FirstOpen = .FALSE.
984 : ENDIF
985 :
986 : ! Return w/ success
987 0 : RC = HCO_SUCCESS
988 :
989 : END SUBROUTINE HCO_Logfile_Open
990 : !EOC
991 : !------------------------------------------------------------------------------
992 : ! Harmonized Emissions Component (HEMCO) !
993 : !------------------------------------------------------------------------------
994 : !BOP
995 : !
996 : ! !IROUTINE: HCO_LogFile_Close
997 : !
998 : ! !DESCRIPTION: Subroutine HCO\_LOGFILE\_CLOSE closes the HEMCO logfile.
999 : ! If argument ShowSummary is enabled, it will prompt a summary of the
1000 : ! HEMCO run up to this point (number of warnings, etc.).
1001 : !\\
1002 : !\\
1003 : ! !INTERFACE:
1004 : !
1005 0 : SUBROUTINE HCO_LogFile_Close( Err, ShowSummary )
1006 : !
1007 : ! !INPUT PARAMETERS:
1008 : !
1009 : TYPE(HcoErr), POINTER :: Err ! Error object
1010 : LOGICAL, INTENT(IN), OPTIONAL :: ShowSummary
1011 : !
1012 : ! !REVISION HISTORY:
1013 : ! 23 Sep 2013 - C. Keller - Initialization
1014 : ! See https://github.com/geoschem/hemco for complete history
1015 : !EOP
1016 : !------------------------------------------------------------------------------
1017 : !BOC
1018 : INTEGER :: IOS
1019 : LOGICAL :: Summary
1020 : CHARACTER(LEN=255) :: MSG
1021 :
1022 : !======================================================================
1023 : ! HCO_LOGFILE_CLOSE begins here
1024 : !======================================================================
1025 :
1026 : ! Check if object exists
1027 0 : IF ( .NOT. ASSOCIATED(Err)) RETURN
1028 0 : IF ( .NOT. Err%LogIsOpen ) RETURN
1029 0 : IF ( .NOT. Err%IsRoot ) RETURN
1030 :
1031 : ! Show summary?
1032 0 : IF ( PRESENT(ShowSummary) ) THEN
1033 0 : Summary = ShowSummary
1034 : ELSE
1035 : Summary = .FALSE.
1036 : ENDIF
1037 :
1038 : ! Eventually print summary
1039 0 : IF ( Summary ) THEN
1040 0 : MSG = ' '
1041 0 : CALL HCO_MSG ( Err, MSG )
1042 0 : MSG = 'HEMCO ' // TRIM(HCO_VERSION) // ' FINISHED.'
1043 0 : CALL HCO_MSG ( Err, MSG, SEP1='-' )
1044 :
1045 : WRITE(MSG,'(A16,I1,A12,I6)') &
1046 0 : 'Warnings: ', Err%nWarnings
1047 0 : CALL HCO_MSG ( Err, MSG, SEP2='-' )
1048 : ENDIF
1049 :
1050 : ! Close logfile only if lun is defined
1051 0 : IF ( Err%Lun>0 ) THEN
1052 0 : CLOSE ( UNIT=Err%Lun, IOSTAT=IOS )
1053 0 : IF ( IOS/= 0 ) THEN
1054 0 : PRINT *, 'Cannot close logfile: ' // TRIM(Err%LogFile)
1055 : ENDIF
1056 : ENDIF
1057 0 : Err%LogIsOpen = .FALSE.
1058 :
1059 : END SUBROUTINE HCO_LogFile_Close
1060 : !EOC
1061 0 : END MODULE HCO_Error_Mod
|