gtool5 Fortran 90/95 Library 1.0.0-rc5
日本語
Loading...
Searching...
No Matches
Data Types | Functions/Subroutines | Variables
dc_trace Module Reference

Debug tracing module. More...

Data Types

interface  datadump
 
interface  debug
 

Functions/Subroutines

integer function, public sublevel ()
 
subroutine, public dbg_scratch (on)
 
subroutine, public setdebug (debug)
 
subroutine, public beginsub (name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
 
subroutine, public endsub (name, fmt, i, r, d, l, n, c1, c2, c3, ca)
 
subroutine, public dbgmessage (fmt, i, r, d, l, n, c1, c2, c3, ca)
 

Variables

integer, save, public dbg = -1
 

Detailed Description

Debug tracing module.

Author
Yasuhiro MORIKAWA, Eizi TOYODA

Function/Subroutine Documentation

◆ beginsub()

subroutine, public dc_trace::beginsub ( character(*), intent(in)  name,
character(*), intent(in), optional  fmt,
integer, dimension(:), intent(in), optional  i,
real, dimension(:), intent(in), optional  r,
real(dp), dimension(:), intent(in), optional  d,
logical, dimension(:), intent(in), optional  l,
integer, dimension(:), intent(in), optional  n,
character(*), intent(in), optional  c1,
character(*), intent(in), optional  c2,
character(*), intent(in), optional  c3,
character(*), dimension(:), intent(in), optional  ca,
character(*), intent(in), optional  version 
)

Output subprogram start message

Outputs the subprogram name given to name as follows:

# call name

By calling multiple times, messages are output showing the hierarchical structure (see dc_trace Overview). Make sure to call EndSub the same number of times as BeginSub.

Additional messages can be output by providing fmt and subsequent arguments:

# call name : fmt

See dc_string::CPrintf for format specification.

The version argument specifies the version number of the subprogram. The version string is displayed only on the first call of a subprogram.

Parameters
[in]nameSubprogram name
[in]fmtFormat string for additional message (optional)
[in]iInteger array for formatting
[in]rReal array for formatting
[in]dDouble precision array for formatting
[in]LLogical array for formatting
[in]nInteger array for formatting
[in]c1Character string 1 for formatting
[in]c2Character string 2 for formatting
[in]c3Character string 3 for formatting
[in]caCharacter array for formatting
[in]versionVersion number of the subprogram (optional)

Definition at line 455 of file dc_trace.f90.

457 use dc_types, only: string, dp
458 use dc_string, only: cprintf, strinclude
459 character(*), intent(in) :: name
460 character(*), intent(in), optional:: fmt
461 integer, intent(in), optional:: i(:), n(:)
462 real, intent(in), optional:: r(:)
463 real(DP), intent(in), optional:: d(:)
464 logical, intent(in), optional:: L(:)
465 character(*), intent(in), optional:: c1, c2, c3
466 character(*), intent(in), optional:: ca(:)
467 character(*), intent(in), optional:: version
468 character(STRING) :: cbuf
469 character(STRING) :: name_ver
470 logical :: dbg_mode, print_version
471 integer :: alloc_size
472 continue
473 if ( dbg < 0 ) return
474 if (lfirst) call initialize
475 call debug( dbg_mode )
476 if ( dbg_mode ) then
477 name_ver = name
478 print_version = .false.
479 !---------------------------------
480 ! Print Version check
481 if (present(version)) then
482 if (.not. allocated(called_subname)) then
483 allocate(called_subname(1))
484 called_subname(1) = name
485 print_version = .true.
486 else
487 if (.not. strinclude(called_subname, trim(name))) then
488 alloc_size = size(called_subname)
489 allocate(called_subname_tmp(alloc_size))
490 called_subname_tmp = called_subname
491 deallocate(called_subname)
492 allocate(called_subname(alloc_size + 1))
493 called_subname(1:alloc_size) = called_subname_tmp
494 deallocate(called_subname_tmp)
495 called_subname(alloc_size + 1) = name
496 print_version = .true.
497 end if
498 end if
499 if (print_version) then
500 name_ver = cprintf('%c version=<%c>', &
501 & c1=trim(name), c2=trim(version))
502 end if
503 end if
504 !---------------------------------
505 ! Print Debug message
506 if (present(fmt)) then
507 cbuf = cprintf(fmt, i, r, d, l, n, c1, c2, c3, ca)
508 write(dbg, "(A, A, 'call ', A, ' : ', A)") trim(head), &
509 & repeat(indent, level), trim(name_ver), trim(cbuf)
510 else
511 write(dbg, "(A, A, 'call ',A)") trim(head), &
512 & repeat(indent, level), trim(name_ver)
513 endif
514 endif
515 ! call errtra ! --- for Fujitsu debug
516 if (level > size(table)) return
517 level = level + 1
518 table(level) = name
Handling character types.
Definition dc_string.f90:83
Provides kind type parameter values.
Definition dc_types.f90:55
integer, parameter, public dp
Double Precision Real number
Definition dc_types.f90:92
integer, parameter, public string
Character length for string
Definition dc_types.f90:137

References dbg, dc_types::dp, and dc_types::string.

◆ dbg_scratch()

subroutine, public dc_trace::dbg_scratch ( logical, intent(in)  on)

Erase debug messages

Operation has not been confirmed. Please use with caution.

By giving .true. to the logical variable on, subsequent debug messages can be erased.

By giving .false. to the logical variable on, messages since the previous Dbg_Scratch call will be output as debug messages again, and subsequent debug messages will also be output.

Parameters
[in]onIf .true., erase subsequent debug messages. If .false., output erased messages and resume normal output.

Definition at line 233 of file dc_trace.f90.

234 logical, intent(in):: on
235 integer, save:: saved_dbg = -1
236 logical:: x, p
237 character(80):: line
238 integer:: ios
239 continue
240 if (on) then
241 if (dbg < 0) return
242 saved_dbg = dbg
243 ! 有効な 1 〜 99 の装置番号の内の大きめの値を設定 (?)
244 dbg = 98
245 do
246 inquire(unit=dbg, exist=x, opened=p)
247 ! 装置番号 dbg が接続可能で、かつ未接続の場合
248 if (x .and. .not. p) then
249 ! 装置番号 deg をスクラッチファイルとして開く。
250 ! ※ スクラッチファイルとは、特殊な外部ファイルである。
251 ! これは名前なしの一時ファイルであり、開いている
252 ! 間だけ存在する。つまり、プログラムが終了すると
253 ! 存在しなくなる。
254 open(unit=dbg, status='SCRATCH')
255 ! 開く事が出来ればそれで終了。
256 return
257 endif
258 ! 装置番号 dbg が利用不可、または利用済の場合は 0 以下に
259 ! なるまで dbg - 1 して繰り返す。
260 dbg = dbg - 1
261 if (dbg < 0) exit
262 enddo
263 ! 装置番号 dbg が開けない場合、dbg と saved_dbg を初期化
264 dbg = saved_dbg
265 saved_dbg = -1
266 else
267 ! 以前に装置番号 dbg = 98〜0 でスクラッチファイルを開けてい
268 ! なければそれで終了
269 if (saved_dbg < 0) return
270 ! 装置番号 dbg に接続されたスクラッチファイルをその開始位置
271 ! に位置付ける。エラーが生じたら「100 continue」へ
272 rewind(dbg, err=100)
273 do
274 ! 装置番号 dbg に接続されたスクラッチファイルの一行を
275 ! line へ
276 read(dbg, '(A)', iostat=ios) line
277 if (ios /= 0) exit
278 ! line を装置番号 saved_dbg へ書き出す。
279 write(saved_dbg, '(A)', iostat=ios) trim(line)
280 if (ios /= 0) exit
281 enddo
282 100 continue
283 close(dbg, iostat=ios)
284 ! 最後に dbg と saved_dbg を初期化
285 dbg = saved_dbg
286 saved_dbg = -1
287 endif

References dbg.

◆ dbgmessage()

subroutine, public dc_trace::dbgmessage ( character(*), intent(in)  fmt,
integer, dimension(:), intent(in), optional  i,
real, dimension(:), intent(in), optional  r,
real(dp), dimension(:), intent(in), optional  d,
logical, dimension(:), intent(in), optional  l,
integer, dimension(:), intent(in), optional  n,
character(*), intent(in), optional  c1,
character(*), intent(in), optional  c2,
character(*), intent(in), optional  c3,
character(*), dimension(:), intent(in), optional  ca 
)

Output debug message

Outputs debug messages according to the format string fmt. See dc_string::CPrintf for format specification.

See dc_trace Example for usage examples.

Note
This subroutine does not change the internal variable level.
Parameters
[in]fmtFormat string
[in]iInteger array for formatting
[in]rReal array for formatting
[in]dDouble precision array for formatting
[in]LLogical array for formatting
[in]nInteger array for formatting
[in]c1Character string 1 for formatting
[in]c2Character string 2 for formatting
[in]c3Character string 3 for formatting
[in]caCharacter array for formatting

Definition at line 660 of file dc_trace.f90.

661 use dc_types, only: string, dp
662 use dc_string, only: cprintf, tochar
663 character(*), intent(in) :: fmt
664 integer, intent(in), optional:: i(:), n(:)
665 real, intent(in), optional:: r(:)
666 real(DP), intent(in), optional:: d(:)
667 logical, intent(in), optional:: L(:)
668 character(*), intent(in), optional:: c1, c2, c3
669 character(*), intent(in), optional:: ca(:)
670 character(STRING):: cbuf
671 character(STRING):: meshead_tmp
672 integer :: meshead_len
673 continue
674 if ( dbg < 0 ) return
675 cbuf = cprintf(fmt, i, r, d, l, n, c1, c2, c3, ca)
676 if (level < 1) then
677 meshead_tmp = ''
678 meshead_len = 0
679 else
680 meshead_tmp = meshead
681 meshead_len = len(meshead)
682 endif
683 write(dbg, "(A, A, A, A)") &
684 & trim(head), repeat( indent, max(level-1, 0) ), &
685 & meshead_tmp(1:meshead_len), trim(cbuf)

References dbg, dc_types::dp, and dc_types::string.

◆ endsub()

subroutine, public dc_trace::endsub ( character(*), intent(in)  name,
character(*), intent(in), optional  fmt,
integer, dimension(:), intent(in), optional  i,
real, dimension(:), intent(in), optional  r,
real(dp), dimension(:), intent(in), optional  d,
logical, dimension(:), intent(in), optional  l,
integer, dimension(:), intent(in), optional  n,
character(*), intent(in), optional  c1,
character(*), intent(in), optional  c2,
character(*), intent(in), optional  c3,
character(*), dimension(:), intent(in), optional  ca 
)

Output subprogram end message

Outputs the subprogram name given to name as follows:

# end name

This corresponds one-to-one with BeginSub, so give the same name as the corresponding BeginSub argument.

Additional messages can be output by providing fmt and subsequent arguments:

# end name fmt

See dc_string::CPrintf for format specification.

Parameters
[in]nameSubprogram name
[in]fmtFormat string for additional message (optional)
[in]iInteger array for formatting
[in]rReal array for formatting
[in]dDouble precision array for formatting
[in]LLogical array for formatting
[in]nInteger array for formatting
[in]c1Character string 1 for formatting
[in]c2Character string 2 for formatting
[in]c3Character string 3 for formatting
[in]caCharacter array for formatting

Definition at line 579 of file dc_trace.f90.

580 use dc_types, only: dp
581 use dc_string, only: cprintf
582 character(*), intent(in) :: name
583 character(*), intent(in), optional:: fmt
584 integer, intent(in), optional:: i(:), n(:)
585 real, intent(in), optional:: r(:)
586 real(DP), intent(in), optional:: d(:)
587 logical, intent(in), optional:: L(:)
588 character(*), intent(in), optional:: c1, c2, c3
589 character(*), intent(in), optional:: ca(:)
590 character(STRING):: cbuf
591 logical:: debug_mode
592 continue
593 if ( dbg < 0 ) return
594 if (lfirst) call initialize
595 ! call errtra ! --- for Fujitsu debug
596 if (level <= 0) then
597 write(*, "(A, 'Warning EndSub[',A,'] without BeginSub')") &
598 & trim(head), trim(name)
599 else if (name /= table(level)) then
600 write(*, "(A, 'Warning EndSub[',A,'] but tos[',A,']')") &
601 & trim(head), trim(name), trim(table(level))
602 else
603 level = level - 1
604 endif
605 call debug( debug_mode )
606 if ( debug_mode ) then
607 if (present(fmt)) then
608 cbuf = cprintf(fmt, i, r, d, l, n, c1, c2, c3, ca)
609 write(dbg, "(A, A, 'end ', A, ' : ', A)") trim(head), &
610 & repeat(indent, level), trim(name), trim(cbuf)
611 else
612 write(dbg, "(A, A, 'end ', A)") trim(head), &
613 & repeat(indent, level), trim(name)
614 endif
615 endif

References dbg, and dc_types::dp.

◆ setdebug()

subroutine, public dc_trace::setdebug ( integer, intent(in), optional  debug)

Turn debug mode on/off

Call this subroutine when you want to output debug messages.

If the integer variable debug is given, debug messages from subsequent subroutines will be output to that unit number. If debug is not given, debug messages will be output to unit number 0 (standard error output). If output to unit number 0 fails, debug messages will be output to unit number 6 (standard output) instead.

If a negative integer is given to debug, debug mode is disabled and no debug messages will be output.

When SetDebug is called, the following message is displayed:

#SetDebug: dbg = debug
Parameters
[in]debugUnit number for debug message output (optional). If not given, standard error output is used. If negative, debug mode is disabled.

Definition at line 335 of file dc_trace.f90.

336 use dc_types, only: stdout, stderr
337 implicit none
338 integer, intent(in), optional:: debug
339 integer:: ios
340 continue
341 if (present(debug)) then
342 ! debug が与えられる時は装置番号として deg を用いる。
343 dbg = debug
344 write(dbg, "(A, 'SetDebug: dbg =', i4)", iostat=ios) &
345 & trim(head), dbg
346 if (ios == 0) return
347 else
348 ! debug が与えられ無い時は装置番号 0 (標準エラー出力)
349 dbg = stderr
350 write(dbg, "(A, 'SetDebug: dbg = ', I0)", iostat=ios) trim(head), dbg
351 if (ios == 0) return
352 ! 装置番号 0 への出力が失敗したら装置番号 6 (標準出力)
353 dbg = stdout
354 write(dbg, "(A, 'SetDebug: dbg = ', I0)", iostat=ios) trim(head), dbg
355 if (ios == 0) return
356 endif
357 ! 例外処理として dbg の初期化
358 dbg = -1
integer, parameter, public stdout
Unit number for Standard OUTPUT
Definition dc_types.f90:117
integer, parameter, public stderr
Unit number for Standard ERROR
Definition dc_types.f90:122

References dbg, dc_types::stderr, and dc_types::stdout.

◆ sublevel()

integer function, public dc_trace::sublevel

Return the hierarchical level of subprograms

Returns the hierarchical level of subprograms. The default level is 0. The level increases by 1 with BeginSub and decreases by 1 with EndSub.

Returns
Hierarchical level of subprograms

Definition at line 198 of file dc_trace.f90.

199 result = level

Variable Documentation

◆ dbg

integer, save, public dc_trace::dbg = -1

Definition at line 156 of file dc_trace.f90.

156 integer, save, public :: dbg = -1 ! SetDebug で設定された