Line data Source code
1 : !------------------------------------------------------------------------------- 2 : ! $Id$ 3 : !------------------------------------------------------------------------------- 4 : 5 : module error_code 6 : 7 : ! Description: 8 : ! Since f90/95 lacks enumeration, we're stuck numbering each 9 : ! error code by hand like this. 10 : 11 : ! We are "enumerating" error codes to be used with CLUBB. Adding 12 : ! additional codes is as simple adding an additional integer 13 : ! parameter. The error codes are ranked by severity, the higher 14 : ! number being more servere. When two errors occur, assign the 15 : ! most servere to the output. 16 : 17 : ! This code also handles subroutines related to debug_level. See 18 : ! the 'set_clubb_debug_level' description for more detail. 19 : 20 : ! References: 21 : ! None 22 : !------------------------------------------------------------------------------- 23 : 24 : implicit none 25 : 26 : private ! Default Scope 27 : 28 : public :: & 29 : clubb_at_least_debug_level, & 30 : set_clubb_debug_level, & 31 : initialize_error_headers 32 : 33 : private :: clubb_debug_level 34 : 35 : ! Model-Wide Debug Level 36 : integer, save :: clubb_debug_level = 0 37 : 38 : integer, public :: err_code = 0; 39 : 40 : character(len=35), public :: err_header 41 : 42 : !$omp threadprivate(err_code,err_header) 43 : 44 : ! Error Code Values 45 : integer, parameter, public :: & 46 : clubb_no_error = 0, & 47 : clubb_fatal_error = 99 48 : 49 : contains 50 : !------------------------------------------------------------------------------- 51 : ! Description: 52 : ! Checks to see if clubb has been set to a specified debug level 53 : !------------------------------------------------------------------------------- 54 353746674 : logical function clubb_at_least_debug_level( level ) 55 : 56 : implicit none 57 : 58 : ! Input variable 59 : integer, intent(in) :: level ! The debug level being checked against the current setting 60 : 61 : ! ---- Begin Code ---- 62 : 63 353746674 : clubb_at_least_debug_level = ( level <= clubb_debug_level ) 64 : 65 : return 66 : 67 : end function clubb_at_least_debug_level 68 : 69 : 70 1536 : subroutine initialize_error_headers 71 : 72 : implicit none 73 : 74 : #ifdef _OPENMP 75 : integer :: omp_get_thread_num 76 : write(err_header,'(A7,I7,A20)') "Thread ", omp_get_thread_num(), " -- CLUBB -- ERROR: " 77 : #else 78 : #ifndef CLUBB_CAM 79 : ! This code cannot be used for CAM because 80 : ! it causes issues when tested with the 81 : ! NAG compiler. 82 : integer :: getpid 83 : write(err_header,'(A7,I7,A20)') "Process ", getpid(), " -- CLUBB -- ERROR: " 84 : #else 85 1536 : write(err_header,'(A20)') " -- CLUBB -- ERROR: " 86 : #endif /* CLUBB_CAM */ 87 : #endif 88 : 89 : 90 1536 : end subroutine initialize_error_headers 91 : 92 : 93 : !------------------------------------------------------------------------------- 94 : ! Description: 95 : ! Accessor for clubb_debug_level 96 : ! 97 : ! 0 => Print no debug messages to the screen 98 : ! 1 => Print lightweight debug messages, e.g. print statements 99 : ! 2 => Print debug messages that require extra testing, 100 : ! e.g. checks for NaNs and spurious negative values. 101 : ! References: 102 : ! None 103 : !------------------------------------------------------------------------------- 104 1536 : subroutine set_clubb_debug_level( level ) 105 : 106 : implicit none 107 : 108 : ! Input variable 109 : integer, intent(in) :: level ! The debug level being checked against the current setting 110 : 111 : ! ---- Begin Code ---- 112 : 113 1536 : clubb_debug_level = max(level,0) 114 : 115 1536 : return 116 : end subroutine set_clubb_debug_level 117 : 118 : end module error_code