-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathHMC_Module_Tools_Debug.f90
320 lines (257 loc) · 16.7 KB
/
HMC_Module_Tools_Debug.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
!------------------------------------------------------------------------------------------
! File: HMC_Module_Tools_Debug.f90
! Author: Fabio Delogu
! Created on May 12, 2015, 2:54 PM
!
! Module to define debug tools
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Module header
module HMC_Module_Tools_Debug
!------------------------------------------------------------------------------------------
! Declaration of global variable(s)
implicit none
integer(kind = 4) :: iDEBUG = 0
integer(kind = 4), parameter :: iINFO_Basic = 0, iINFO_Main = 1, iINFO_Verbose = 2, iINFO_Extra = 3
integer(kind = 4), parameter :: iWARN = 20, iERROR = 30
integer(kind = 4) :: iFlagDebugSet
integer(kind = 4) :: iDebugLevelSet = iINFO_Basic
integer(kind = 4) :: iDebugUnit = -1
logical :: bDebugLogUnit = .false.
logical :: bDebugLogName = .false.
logical :: bLineLogFile = .false.
logical :: bLineDebug = .false.
logical :: bLineInfo = .false.
logical :: bLineWarn = .false.
logical :: bLineError = .false.
!------------------------------------------------------------------------------------------
contains
!------------------------------------------------------------------------------------------
! Subroutine to set debug unit
subroutine HMC_Tools_Debug_SetUnit(iDebugUnitMin, iDebugUnitMax, iDebugUnitInit)
!------------------------------------------------------------------------------------------
! Variable(s) declaration
logical :: bIsUsed
integer(kind = 4) :: iDebugUnitMin, iDebugUnitMax
integer(kind = 4),intent(out) :: iDebugUnitInit
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Initialization of debug unit
iDebugUnitInit = -1
! Search debug unit
do iDebugUnitInit = iDebugUnitMin, iDebugUnitMax
inquire(unit = iDebugUnitInit, opened = bIsUsed)
if (.not. bIsUsed) exit
end do
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Pass to global variables
iDebugUnit = iDebugUnitInit
bDebugLogUnit = .true.
!------------------------------------------------------------------------------------------
end subroutine HMC_Tools_Debug_SetUnit
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Subroutine to set debug level
subroutine HMC_Tools_Debug_SetLevel(iFlagDebugSetInit, iDebugLevelInit)
!------------------------------------------------------------------------------------------
! Variable(s) declaration
integer(kind = 4), intent(in) :: iFlagDebugSetInit, iDebugLevelInit
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Set debug level
if (iFlagDebugSetInit .gt. 0) then
!------------------------------------------------------------------------------------------
! Pass to global variables
iDEBUG = iFlagDebugSetInit
iDebugLevelSet = iDebugLevelInit
!------------------------------------------------------------------------------------------
else
!------------------------------------------------------------------------------------------
! Debug level == 0; info == iINFO_Basic
iDEBUG = 0
iDebugLevelSet = iINFO_Basic
!------------------------------------------------------------------------------------------
endif
!------------------------------------------------------------------------------------------
end subroutine HMC_Tools_Debug_SetLevel
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Subroutine to print debug message
! call mprintf(.true., iINFO_Basic, ' Check basic information ')
! call mprintf(.true., iINFO_Main, ' Check main information ')
! call mprintf(.true., iINFO_Verbose, ' Check verbose information ')
! call mprintf(.true., iINFO_Extra, ' Check extra information ')
! call mprintf(.true., iWARN, ' Check warning')
! call mprintf(.true., iERROR, ' Check error')
subroutine mprintf(bAssertion, iDebugLevelCall, sFmtString)
!------------------------------------------------------------------------------------------
! Arguments
logical, intent(in) :: bAssertion
integer, intent(in) :: iDebugLevelCall
character (len=*), intent(in) :: sFmtString
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Local variables
integer(kind = 4) :: iStrStart, iStrEnd
character (len=8) :: sCurrenteDate
character (len=10) :: sCurrentTime
character (len=10) :: sPrintDate
character (len=12) :: sPrintTime
character (len=1024) :: sFileName
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Check level debug call, if less then debug level set, then return
if (( iDebugLevelCall .ne. iERROR ) .and. ( iDebugLevelCall .ne. iWARN) ) then
if (iDebugLevelCall .gt. iDebugLevelSet) return
endif
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Set date and time
call date_and_time(date=sCurrenteDate, time=sCurrentTime)
write(sPrintDate,'(a10)') sCurrenteDate(1:4)//'-'//sCurrenteDate(5:6)//'-'//sCurrenteDate(7:8)
write(sPrintTime,'(a12)') sCurrentTime(1:2)//':'//sCurrentTime(3:4)//':'//sCurrentTime(5:10)
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Open file (hmc.log)
if (.not. bDebugLogName) then
sFileName = 'hmc.log'
if (.not. bDebugLogUnit) then
call HMC_Tools_Debug_SetUnit(80, 100, iDebugUnit)
bDebugLogUnit = .true.
endif
open(unit=iDebugUnit, file = trim(sFileName), status = 'replace', form ='formatted')
write(iDebugUnit,'(a)') '----------------------------------------------'
write(iDebugUnit,'(a)') ' HMC LOGGER '
write(iDebugUnit,'(a)') ' StartLog: '//sPrintDate//' '//sPrintTime
write(iDebugUnit,'(a)') '----------------------------------------------'
bDebugLogName = .true.
end if
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Initialize variable(s)
iStrStart = 1; iStrEnd = len_trim(sFmtString)
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Check assertion
if (bAssertion) then
!------------------------------------------------------------------------------------------
! Check info level (1=Main, 4=Verbose, 5=Extra; 2=Warning; 3=Error)
if ( iDebugLevelCall .eq. iINFO_Basic) then
write(iDebugUnit,'(a)') ' ['//sPrintDate//' '//sPrintTime//'] INFO: '//sFmtString(iStrStart:iStrEnd)!//achar(10)
write(6,*) ' ----> '//sFmtString(iStrStart:iStrEnd)
elseif ( iDebugLevelCall .eq. iINFO_Main) then
write(iDebugUnit,'(a)') ' ['//sPrintDate//' '//sPrintTime//'] INFO: '//sFmtString(iStrStart:iStrEnd)!//achar(10)
write(6,*) ' ----> '//sFmtString(iStrStart:iStrEnd)
elseif ( iDebugLevelCall .eq. iINFO_Verbose) then
write(iDebugUnit,'(a)') ' ['//sPrintDate//' '//sPrintTime//'] INFO: '//sFmtString(iStrStart:iStrEnd)!//achar(10)
write(6,*) ' ----> '//sFmtString(iStrStart:iStrEnd)
elseif ( iDebugLevelCall .eq. iINFO_Extra) then
write(iDebugUnit,'(a)') ' ['//sPrintDate//' '//sPrintTime//'] INFO: '//sFmtString(iStrStart:iStrEnd)!//achar(10)
write(6,*) ' ----> '//sFmtString(iStrStart:iStrEnd)
elseif ( iDebugLevelCall .eq. iWARN) then
write(iDebugUnit,'(a)') ' ['//sPrintDate//' '//sPrintTime//'] WARNING: '//sFmtString(iStrStart:iStrEnd) !//achar(10)
write(6,*) ' ------> WARNING: '//sFmtString(iStrStart:iStrEnd)
elseif ( iDebugLevelCall .eq. iERROR) then
write(iDebugUnit,'(a)') ' ['//sPrintDate//' '//sPrintTime//'] ERROR: '//sFmtString(iStrStart:iStrEnd)!//achar(10)
write(6,*) ' --------> ERROR: '//sFmtString(iStrStart:iStrEnd)
endif
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Flush on file (to update each step or comment to update at the end of program)
call flush(iDebugUnit)
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Level Debug == Error
if (iDebugLevelCall == iERROR) then
close(iDebugUnit)
stop "Stopped"
endif
!------------------------------------------------------------------------------------------
end if
!------------------------------------------------------------------------------------------
end subroutine mprintf
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Function to check variable 2d (max, min and mean values)
function checkvar(a2dVarValue, a2iVarMask, sVarName) result(sVarCheck)
!------------------------------------------------------------------------------------
! Variable(s) declaration
integer(kind = 4), dimension(:,:) :: a2iVarMask
real(kind = 4), dimension(:,:) :: a2dVarValue
character(len = *), optional :: sVarName
real(kind = 4) :: dVarMaxValue, dVarMinValue, dVarMeanValue
character(len = 20) :: sVarMaxValue, sVarMinValue, sVarMeanValue
character(len = 200) :: sVarCheck
!------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------
! Initialize variable(s)
dVarMaxValue = -9999.0; dVarMinValue = -9999.0; dVarMeanValue = -9999.0
sVarCheck = ""
!------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------
! Define name if not defined
if (.not. present(sVarName)) then
sVarName = 'VAR'
endif
!------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------
! Compute maximum value
dVarMaxValue = maxval(a2dVarValue, mask=a2iVarMask.gt.0.0)
write(sVarMaxValue, *) dVarMaxValue
! Compute minimum value
dVarMinValue = minval(a2dVarValue, mask=a2iVarMask.gt.0.0)
write(sVarMinValue, *) dVarMinValue
! Compute average value
dVarMeanValue = sum(a2dVarValue, mask=a2iVarMask.gt.0.0)/max(1,count(a2iVarMask.gt.0.0))
write(sVarMeanValue, *) dVarMeanValue
!------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------
! Print check message
sVarCheck = trim(sVarName)//" :: Max: "//trim(sVarMaxValue)//" - Min: "//trim(sVarMinValue)// &
" - Mean: "//trim(sVarMeanValue)
!------------------------------------------------------------------------------------
end function checkvar
!------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Function to check variable 1d (max, min and mean values)
function checkarray(a1dVarValue, sVarName) result(sVarCheck)
!------------------------------------------------------------------------------------
! Variable(s) declaration
real(kind = 4), dimension(:) :: a1dVarValue
character(len = *), optional :: sVarName
real(kind = 4) :: dVarMaxValue, dVarMinValue, dVarMeanValue
character(len = 20) :: sVarMaxValue, sVarMinValue, sVarMeanValue
character(len = 200) :: sVarCheck
!------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------
! Initialize variable(s)
dVarMaxValue = -9999.0; dVarMinValue = -9999.0; dVarMeanValue = -9999.0
sVarCheck = ""
!------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------
! Define name if not defined
if (.not. present(sVarName)) then
sVarName = 'VAR'
endif
!------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------
! Compute maximum value
dVarMaxValue = maxval(a1dVarValue, mask=a1dVarValue.ge.0.0)
write(sVarMaxValue, *) dVarMaxValue
! Compute minimum value
dVarMinValue = minval(a1dVarValue, mask=a1dVarValue.ge.0.0)
write(sVarMinValue, *) dVarMinValue
! Compute average value
dVarMeanValue = sum(a1dVarValue, mask=a1dVarValue.ge.0.0)/max(1,count(a1dVarValue.gt.0.0))
write(sVarMeanValue, *) dVarMeanValue
!------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------
! Print check message
sVarCheck = trim(sVarName)//" :: Max: "//trim(sVarMaxValue)//" - Min: "//trim(sVarMinValue)// &
" - Mean: "//trim(sVarMeanValue)
!------------------------------------------------------------------------------------
end function checkarray
!------------------------------------------------------------------------------------
end module HMC_Module_Tools_Debug
!------------------------------------------------------------------------------------------