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