File: C:\NOAA\NEMS_11731\src\chem\gocart\src\GMAO_Shared\GMAO_pilgrim\debugutilitiesmodule.F90

1     !-------------------------------------------------------------------------
2     !         Nasa/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS
3     !-------------------------------------------------------------------------
4           MODULE debugutilitiesmodule
5     !BOP
6     !
7     ! !MODULE: debugutilitiesmodule
8     !
9     ! !USES:
10     #ifdef STAND_ALONE 
11     # define iulog 6
12     #else
13           use cam_logfile, only: iulog
14     #endif
15           IMPLICIT NONE
16     
17     #define  MAX_STACK_LEVEL 20
18     #define  MAX_STRING_LEN  40
19     !
20     ! !PUBLIC MEMBER FUNCTIONS:
21           PUBLIC     DumAssert, DumEnter, DumLeave
22     
23     !
24     ! !DESCRIPTION:
25     !
26     !      This module provides the basic utilities to support debugging
27     !
28     !      \begin{tabular}{|l|l|} \hline \hline
29     !        DumAssert         & Make an assertion \\ \hline
30     !        DumEnter          & Tracing: enter a subroutine \\ \hline
31     !        DumLeave          & Tracing: leave a subroutine   \\ \hline
32     !      \end{tabular}
33     !
34     !      The DumAssert makes an assertion (i.e., claims that a boolean
35     !      argument is true) for a given line of code in a given source
36     !      file.  DumEnter and DumLeave to be used as a pair and placed at the
37     !      beginning and end of routines to be traced.
38     !
39     !      It is not intended for the user to make use of these routines
40     !      directly but rather in conjunction with the CPP macros defined
41     !      in the "Debug.h" file in the INCLUDE directory.  The CPP 
42     !      macros define the calls to the three above-mention routines if
43     !      the -DDEBUG\_ON option is set on the compile line.  The line
44     !      \#include "Debug.h" statement in any routine which makes use 
45     !      of these facilities.  In production compilations where DEBUG\_ON
46     !      is not set, "Debug.h" defines blank lines and thus does not
47     !      affect code performance.  The CPP definition of DEBUG\_LEVEL in
48     !      the compile line, e.g., -DDEBUG\_LEVEL=2, denotes the level
49     !      of debugging performed.  A higher level performs all the 
50     !      debugging at the lower levels and then some.
51     !
52     !      Note that, unlike other include statements, "Debug.h" must be 
53     !      included {\it before} the IMPLICIT NONE statement (since "Debug.h"
54     !      contains a USE DebugModule statement.
55     !
56     !      Compile options used:  {\tt MPI\_VER}, {\tt DEBUG\_LEVEL}
57     !
58     ! !LOCAL VARIABLES:
59           CHARACTER(len=MAX_STRING_LEN) :: TraceStack( MAX_STACK_LEVEL )
60           INTEGER    :: StackLevel = 0
61     !
62     ! !REVISION HISTORY:
63     !   97.09.30   Sawyer     Creation
64     !   98.03.09   Sawyer     Added documentation for walkthrough
65     !   01.02.12   Sawyer     Converted to free format
66     !
67     ! !BUGS:
68     !
69     !EOP
70           CONTAINS
71     !-----------------------------------------------------------------------
72     
73     !-----------------------------------------------------------------------
74     !BOP
75     ! !IROUTINE: DumAssert --- Raise Assertion
76     !
77     ! !INTERFACE: 
78           SUBROUTINE DumAssert ( Condition, FileName, Linenumber )
79     !
80     ! !USES:
81           IMPLICIT NONE
82     !
83     ! !INPUT PARAMETERS:
84           LOGICAL, INTENT(IN)       :: Condition      ! Condition asserted
85           CHARACTER(*), INTENT(IN)  :: FileName       ! Source file
86           INTEGER, INTENT( IN )     :: LineNumber     ! Source line
87     
88     ! !DESCRIPTION:
89     !     Condition is claimed by the calling Routine in Filename at
90     !     Linenumber to be true.  If it is, do nothing.  If not, print
91     !     as much information as possible.  
92     !
93     !      \begin{tabular}{|c|l|} \hline \hline
94     !        {\bf Debug Level} & {\bf Action} \\ \hline \hline
95     !        0                 & Return immediately \\ \hline
96     !        1                 & Print assertion failed \\ \hline
97     !        2                 & Print assertion failed and trace stack \\ \hline
98     !      \end{tabular}
99     !
100     ! !LOCAL VARIABLES:
101           INTEGER I, MyID, Ierror
102     !
103     ! !SYSTEM ROUTINES:
104     !
105     ! !REVISION HISTORY:
106     !   97.09.30   Sawyer     Creation
107     !
108     !EOP
109     !-----------------------------------------------------------------------
110     !BOC
111     
112     #if !defined(DEBUG_LEVEL)
113     #define DEBUG_LEVEL 1
114     #endif
115     
116     #if ( DEBUG_LEVEL > 0 )
117           IF (.NOT. Condition) THEN
118             write(iulog,*) 'Assertion failed:',                                    &
119                       ' source file: ', FileName,                            &
120                       ' source line: ', LineNumber
121     !
122     !  Check if trace available
123     !
124     #if ( DEBUG_LEVEL > 1 )
125             PRINT *, "Printing Trace: "
126             DO I = 1, StackLevel
127               PRINT *, "Level ", StackLevel,                                 &
128                        " Called ", TraceStack( StackLevel )
129             ENDDO
130     #endif
131           ENDIF
132     #endif
133           RETURN
134     !EOC
135           END SUBROUTINE DumAssert
136     !-----------------------------------------------------------------------
137     
138     !-----------------------------------------------------------------------
139     !BOP
140     ! !IROUTINE: DumEnter --- Tracing: Enter a Subroutine
141     !
142     ! !INTERFACE: 
143           SUBROUTINE DumEnter ( RoutineName )
144     !
145     ! !USES:
146           IMPLICIT NONE
147     !
148     ! !INPUT PARAMETERS:
149           CHARACTER(*), INTENT(IN)     :: RoutineName    ! Source file
150     
151     ! !DESCRIPTION:
152     !      This routine marks the beginning of a region to be traced,
153     !      usually a subroutine.  
154     !      
155     !      \begin{tabular}{|c|l|} \hline \hline
156     !        {\bf Debug Level} & {\bf Action} \\ \hline \hline
157     !        0                 & Return immediately \\ \hline
158     !        1                 & Perform bookkeeping \\ \hline
159     !        2                 & Perform bookkeeping, print trace \\ \hline
160     !      \end{tabular}
161     !
162     ! !LOCAL VARIABLES:
163           INTEGER MyID, Ierror
164     ! !REVISION HISTORY:
165     !   97.09.30   Sawyer     Creation
166     !
167     !EOP
168     !-----------------------------------------------------------------------
169     !BOC
170     #if !defined(DEBUG_LEVEL)
171     #define DEBUG_LEVEL 1
172     #endif
173     
174     #if ( DEBUG_LEVEL > 0 ) 
175           StackLevel = StackLevel + 1
176           IF ( StackLevel .GT. MAX_STACK_LEVEL ) THEN
177             PRINT *, "StackLevel overflow: ", StackLevel, " Stopping"
178             STOP
179           ENDIF
180           TraceStack( StackLevel ) = RoutineName      
181     #if ( DEBUG_LEVEL > 1 )
182           PRINT *, "Level ", StackLevel, " Entering ", RoutineName
183     #endif
184     #endif
185           RETURN
186     !EOC
187           END SUBROUTINE DumEnter
188     !-----------------------------------------------------------------------
189     
190     !-----------------------------------------------------------------------
191     !BOP
192     ! !IROUTINE: DumLeave --- Tracing: Leave a Subroutine
193     !
194     ! !INTERFACE: 
195           SUBROUTINE DumLeave ( RoutineName )
196     !
197     ! !USES:
198           IMPLICIT NONE
199     !
200     ! !INPUT PARAMETERS:
201           CHARACTER(*), INTENT(IN)     :: RoutineName    ! Source file
202     
203     ! !DESCRIPTION:
204     !     Tracing facility: leave a subroutine, remove the history trail.
205     !     Depending on the debugging level, do nothing (0), update the
206     !     stack only (1), or update stack and print trace message (2) to
207     !     stdout.  The CALL to Leave should be placed just before every
208     !     egress of the subroutine (hopefully the exit point is unique).
209     !
210     !      \begin{tabular}{|c|l|} \hline \hline
211     !        {\bf Debug Level} & {\bf Action} \\ \hline \hline
212     !        0                 & Return immediately \\ \hline
213     !        1                 & Perform bookkeeping, consistency check \\ \hline
214     !        2                 & Bookkeeping, consistency, print trace \\ \hline
215     !      \end{tabular}
216     !
217     ! !LOCAL VARIABLES:
218           INTEGER MyID, Ierror
219     ! !REVISION HISTORY:
220     !   97.09.30   Sawyer     Creation
221     !
222     !EOP
223     !-----------------------------------------------------------------------
224     !BOC
225     #if !defined(DEBUG_LEVEL)
226     #define DEBUG_LEVEL 1
227     #endif
228     
229     #if ( DEBUG_LEVEL > 0 ) 
230     !
231     !  Make sure that the Enter and Leave correspond
232     !
233           IF ( TraceStack(StackLevel) .NE. RoutineName ) THEN
234             PRINT *, "Expected: ", TraceStack(StackLevel),                   &
235          &           "Got: ", RoutineName, " STOPPING "
236             STOP 
237           ENDIF
238     #if ( DEBUG_LEVEL > 1 )
239           PRINT *, "Level ", StackLevel, " Leaving ", RoutineName
240     #endif
241           IF ( StackLevel .LE. 0 ) THEN
242             PRINT *, "StackLevel underflow: ", StackLevel, " Stopping"
243             STOP
244           ENDIF
245           TraceStack( StackLevel ) = ""
246           StackLevel = StackLevel - 1
247     #endif
248           RETURN
249     !EOC
250           END SUBROUTINE DumLeave
251     !-----------------------------------------------------------------------
252     
253           END MODULE debugutilitiesmodule
254